cfac_sol_l0omp_m.F

Go to the documentation of this file.

C
C  This file is part of MUMPS 5.5.1, released
C  on Tue Jul 12 13:17:24 UTC 2022
C
C
C  Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  Mumps Technologies, University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license 
C  (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
C  https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
C
      MODULE cmumps_facsol_l0omp_m
      PRIVATE
      PUBLIC :: cmumps_init_l0_omp_factors
     &        , cmumps_free_l0_omp_factors
     &        , cmumps_save_restore_l0facarray
      CONTAINS
      SUBROUTINE cmumps_init_l0_omp_factors(id_L0_OMP_FACTORS)
      USE cmumps_struc_def, ONLY : cmumps_l0ompfac_t
      IMPLICIT NONE
      TYPE (cmumps_l0ompfac_t), DIMENSION(:), POINTER ::
     &                                             id_l0_omp_factors
      INTEGER i
      IF (associated(id_l0_omp_factors)) THEN
        DO i=1, size(id_l0_omp_factors)
          NULLIFY(id_l0_omp_factors(i)%A)
        ENDDO
      ENDIF
      RETURN
      END SUBROUTINE cmumps_init_l0_omp_factors
      SUBROUTINE cmumps_free_l0_omp_factors(id_L0_OMP_FACTORS)
      USE cmumps_struc_def, ONLY : cmumps_l0ompfac_t
      IMPLICIT NONE
      TYPE (cmumps_l0ompfac_t), DIMENSION(:), POINTER ::
     &                                              id_l0_omp_factors
      INTEGER i
      IF (associated(id_l0_omp_factors)) THEN
        DO i=1, size(id_l0_omp_factors)
          IF (associated(id_l0_omp_factors(i)%A)) THEN
            DEALLOCATE(id_l0_omp_factors(i)%A)
            NULLIFY(id_l0_omp_factors(i)%A)
          ENDIF
        ENDDO
        DEALLOCATE(id_l0_omp_factors)
        NULLIFY(id_l0_omp_factors)
      ENDIF
      RETURN
      END SUBROUTINE cmumps_free_l0_omp_factors
      SUBROUTINE cmumps_save_restore_l0facarray(L0_OMP_FACTORS
     &                 ,unit,MYID,mode
     &                 ,SIZE_GEST,SIZE_VARIABLES
     &                 ,SIZE_INT,SIZE_INT8,SIZE_ARITH_DEP
     &                 ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
     &                 ,size_read,size_allocated,size_written
     &                 ,INFO)
      USE cmumps_struc_def, ONLY : cmumps_l0ompfac_t
      IMPLICIT NONE
      TYPE (cmumps_l0ompfac_t), DIMENSION(:), POINTER :: l0_omp_factors
      INTEGER,intent(IN)::unit,myid
      CHARACTER(len=*),intent(IN) :: mode
      INTEGER,INTENT(OUT) :: size_gest
      INTEGER(8),intent(OUT) :: size_variables
      INTEGER,intent(INOUT):: info(2)
      INTEGER,intent(IN):: size_int, size_int8, size_arith_dep
      INTEGER(8),intent(IN) :: total_file_size,total_struc_size
      INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
      INTEGER:: j1,nbrecords,nbsubrecords,size_array1,dummy,allocok,err
      INTEGER:: size_gest_l0fac_array,
     &          size_gest_l0fac_array_j1
      INTEGER(4) :: i4
      INTEGER(8):: size_variables_l0fac_array,
     &             size_variables_l0fac_array_j1
      size_gest = 0
      size_variables = 0_8
      size_gest_l0fac_array=0
      size_variables_l0fac_array=0
      size_gest_l0fac_array_j1=0
      size_variables_l0fac_array_j1=0
      nbrecords = 0
      IF (trim(mode).EQ."memory_save") THEN
        IF (associated(l0_omp_factors)) THEN
          nbrecords      = 1 
          size_gest      = size_int 
          size_variables = 0
          DO j1=1,size(l0_omp_factors)
            CALL cmumps_save_restore_l0fac(
     &           l0_omp_factors(j1)
     &           ,unit,myid,"memory_save"
     &           ,size_gest_l0fac_array_j1
     &           ,size_variables_l0fac_array_j1
     &           ,size_int,size_int8,size_arith_dep
     &           ,total_file_size,total_struc_size
     &           ,size_read,size_allocated,size_written
     &           ,info)
            size_gest_l0fac_array=size_gest_l0fac_array+
     &           size_gest_l0fac_array_j1
            size_variables_l0fac_array=size_variables_l0fac_array+
     &           size_variables_l0fac_array_j1
            IF ( info(1) .LT. 0 ) GOTO 100
          ENDDO
        ELSE
          nbrecords      = 2
          size_gest      = 2*size_int
          size_variables = 0
        ENDIF
      ELSEIF (trim(mode).EQ."save") THEN
        IF (associated(l0_omp_factors)) THEN
          nbrecords      = 1 
          size_gest      = size_int
          size_variables = 0
          write(unit,iostat=err) size(l0_omp_factors)
          if(err.ne.0) then
             info(1) = -72
             CALL mumps_seti8toi4(total_file_size-size_written,
     &            info(2))
          endif
          IF ( info(1) .LT. 0 ) GOTO 100
          DO j1=1,size(l0_omp_factors)
            CALL cmumps_save_restore_l0fac(
     &           l0_omp_factors(j1)
     &           ,unit,myid,"save"
     &           ,size_gest_l0fac_array_j1
     &           ,size_variables_l0fac_array_j1
     &           ,size_int,size_int8,size_arith_dep
     &           ,total_file_size,total_struc_size
     &           ,size_read,size_allocated,size_written
     &           ,info)
          ENDDO
        ELSE
            nbrecords=2
            size_gest=size_int*2
            size_variables=0
            write(unit,iostat=err) -999
            if(err.ne.0) then
               info(1) = -72
               CALL mumps_seti8toi4(total_file_size-size_written,
     &              info(2))
            endif
            IF ( info(1) .LT. 0 ) GOTO 100
            write(unit,iostat=err) -999
            if(err.ne.0) then
               info(1) = -72
               CALL mumps_seti8toi4(total_file_size-size_written,
     &              info(2))
            endif
            IF ( info(1) .LT. 0 ) GOTO 100
        ENDIF
      ELSE IF (trim(mode).EQ."restore") THEN
        NULLIFY(l0_omp_factors)
         read(unit,iostat=err) size_array1
         if(err.ne.0) THEN
            info(1) = -75
            CALL mumps_seti8toi4(total_file_size-size_read
     &           ,info(2))
         endif
         IF ( info(1) .LT. 0 ) GOTO 100
         if(size_array1.EQ.-999) then
            nbrecords=2
            size_gest=size_int*2
            size_variables=0
            read(unit,iostat=err) dummy
            if(err.ne.0) THEN
               info(1) = -75
               CALL mumps_seti8toi4(total_file_size-size_read
     &              ,info(2))
            endif
            IF ( info(1) .LT. 0 ) GOTO 100
         else
           nbrecords=1
           size_gest=size_int
           size_variables=0
           allocate(l0_omp_factors(size_array1), stat=allocok)
           if (allocok .GT. 0) THEN
              info(1) = -78
              CALL mumps_seti8toi4(
     &             total_struc_size-size_allocated
     &             ,info(2))
           endif
           DO j1=1,size(l0_omp_factors)
             CALL cmumps_save_restore_l0fac(
     &            l0_omp_factors(j1)
     &            ,unit,myid,"restore"
     &            ,size_gest_l0fac_array_j1
     &            ,size_variables_l0fac_array_j1
     &            ,size_int, size_int8, size_arith_dep
     &            ,total_file_size,total_struc_size
     &            ,size_read,size_allocated,size_written
     &            ,info)
             size_gest_l0fac_array=size_gest_l0fac_array+
     &            size_gest_l0fac_array_j1
             size_variables_l0fac_array=size_variables_l0fac_array+
     &            size_variables_l0fac_array_j1
             IF ( info(1) .LT. 0 ) GOTO 100
           ENDDO
         endif
      ENDIF
      if(trim(mode).EQ."memory_save") then
         nbsubrecords=int(size_variables/huge(i4))
         IF(nbsubrecords.GT.0) then
            nbrecords=nbrecords+nbsubrecords
         ENDIF
      elseif(trim(mode).EQ."save") then
         size_written=size_written+size_variables
     &        +int(size_gest,kind=8)
#if !defined(MUMPS_F2003)
         size_written=size_written
     &        +int(2*size_int*nbrecords,kind=8)
#endif
      elseif(trim(mode).EQ."restore") then
         size_allocated=size_allocated+SIZE_VARIABLES
         size_read=size_read+SIZE_VARIABLES
     &        +int(SIZE_GEST,kind=8)
#if !defined(MUMPS_F2003)
         size_read=size_read
     &        +int(2*SIZE_INT*NbRecords,kind=8)
#endif
      endif
.EQ.      if(trim(mode)"memory_save") then
         SIZE_VARIABLES=SIZE_VARIABLES+SIZE_VARIABLES_L0FAC_ARRAY
         SIZE_GEST=SIZE_GEST+SIZE_GEST_L0FAC_ARRAY
#if !defined(MUMPS_F2003)
         SIZE_GEST=SIZE_GEST+2*SIZE_INT*NbRecords
#endif
      endif
 100  continue
      RETURN
      END SUBROUTINE CMUMPS_SAVE_RESTORE_L0FACARRAY
      SUBROUTINE CMUMPS_SAVE_RESTORE_L0FAC(
     &            L0_OMP_FACTORS_1THREAD
     &            ,unit,MYID,mode
     &            ,Local_SIZE_GEST, Local_SIZE_VARIABLES
     &            ,SIZE_INT, SIZE_INT8, SIZE_ARITH_DEP
     &            ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
     &            ,size_read,size_allocated,size_written
     &            ,INFO)
      USE CMUMPS_STRUC_DEF, ONLY : CMUMPS_L0OMPFAC_T
      IMPLICIT NONE
      TYPE (CMUMPS_L0OMPFAC_T) :: L0_OMP_FACTORS_1THREAD
      INTEGER,intent(IN)::unit,MYID
      CHARACTER(len=*),intent(IN) :: mode
      INTEGER,INTENT(OUT) :: Local_SIZE_GEST
      INTEGER(8),intent(OUT) :: Local_SIZE_VARIABLES
      INTEGER,intent(INOUT):: INFO(2)
      INTEGER,intent(IN):: SIZE_INT, SIZE_INT8, SIZE_ARITH_DEP
      INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
      INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
      INTEGER:: Local_NbRecords, allocok, err
      INTEGER(8) :: itmp
      Local_NbRecords = 0
      Local_SIZE_GEST = 0
      Local_SIZE_VARIABLES = 0_8
      Local_NbRecords = Local_NbRecords+1
.EQ.      IF (trim(mode)  "memory_save") THEN
        Local_SIZE_VARIABLES = Local_SIZE_VARIABLES + SIZE_INT8
.EQ.      ELSE IF (trim(mode)  "save") THEN
        Local_SIZE_VARIABLES = Local_SIZE_VARIABLES + SIZE_INT8
        WRITE(unit,iostat=err) L0_OMP_FACTORS_1THREAD%LA
.NE.        IF (err  0) THEN
          INFO(1)=-72
          CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
     &                         INFO(2))
          GOTO 100
        ENDIF
        size_written=size_written+SIZE_INT8
.EQ.      ELSE IF (trim(mode)  "restore") THEN
        Local_SIZE_VARIABLES = Local_SIZE_VARIABLES + SIZE_INT8
        READ(unit,iostat=err) L0_OMP_FACTORS_1THREAD%LA
.NE.        IF (err  0) THEN
          INFO(1) = -75
          CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read,
     &                         INFO(2))
          GOTO 100
        ENDIF
        size_read=size_read+SIZE_INT8
      ENDIF
.EQ.      IF (trim(mode)"memory_save") THEN
        IF (associated(L0_OMP_FACTORS_1THREAD%A)) THEN
          Local_NbRecords = Local_NbRecords + 2
          Local_SIZE_GEST = Local_SIZE_GEST + SIZE_INT8
          Local_SIZE_VARIABLES = Local_SIZE_VARIABLES + 
     &           max(1_8,L0_OMP_FACTORS_1THREAD%LA)*SIZE_ARITH_DEP
        ELSE
          Local_NbRecords = Local_NbRecords + 1
          Local_SIZE_GEST = Local_SIZE_GEST + SIZE_INT8
          Local_SIZE_VARIABLES = Local_SIZE_VARIABLES + 0
        ENDIF
.EQ.      ELSEIF (trim(mode)"save") THEN
        IF (associated(L0_OMP_FACTORS_1THREAD%A)) THEN
          Local_NbRecords = Local_NbRecords + 2
          write(unit,iostat=err) int(0,8) 
.ne.          if(err0) then
            INFO(1) = -72
            CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
     &                    INFO(2))
            GOTO 100
          endif
          size_written=size_written+SIZE_INT8
          write(unit,iostat=err) L0_OMP_FACTORS_1THREAD%A
.ne.          if(err0) then
            INFO(1) = -72
            CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
     &                    INFO(2))
            GOTO 100
          endif
          size_written = size_written +
     &              max(L0_OMP_FACTORS_1THREAD%LA,1_8)*SIZE_ARITH_DEP
        ELSE
          Local_NbRecords = Local_NbRecords + 1
          write(unit,iostat=err) int(-999,8)
.ne.          if(err0) then
            INFO(1) = -72
            CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
     &                    INFO(2))
            GOTO 100
          endif
          size_written=size_written+SIZE_INT8
        ENDIF
.EQ.      ELSEIF (trim(mode)"restore") THEN
        NULLIFY(L0_OMP_FACTORS_1THREAD%A)
        READ(unit,iostat=err) itmp
.ne.        if(err0) THEN
          INFO(1) = -75
          CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
     &         ,INFO(2))
          GOTO 100
        endif
        size_read      = size_read      + SIZE_INT8
        size_allocated = size_allocated + SIZE_INT8
.eq.        IF (itmp  -999) THEN
          Local_NbRecords = Local_NbRecords + 1
        ELSE
          Local_NbRecords = Local_NbRecords + 2
          ALLOCATE(L0_OMP_FACTORS_1THREAD%A(
     &             max(L0_OMP_FACTORS_1THREAD%LA,1_8)),
     &             stat=allocok)
.GT.          IF (allocok  0) THEN
            INFO(1) = -78
            CALL MUMPS_SETI8TOI4(
     &           TOTAL_STRUC_SIZE-size_allocated
     &           ,INFO(2))
            GOTO 100
          ENDIF
          READ(unit,iostat=err) L0_OMP_FACTORS_1THREAD%A
.ne.          if(err0) THEN
            INFO(1) = -75
            CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
     &           ,INFO(2))
            GOTO 100
          endif
          size_read      = size_read +
     &             max(1_8,L0_OMP_FACTORS_1THREAD%LA)*SIZE_ARITH_DEP
          size_allocated = size_allocated+
     &             max(1_8,L0_OMP_FACTORS_1THREAD%LA)*SIZE_ARITH_DEP
        ENDIF
      ENDIF
#if !defined(MUMPS_F2003)
.EQ.      IF (trim(mode)"memory_save") THEN
        Local_SIZE_GEST = Local_SIZE_GEST+2*SIZE_INT*Local_NbRecords
.EQ.      ELSE IF (trim(mode)"save") THEN
        size_written = size_written+2*SIZE_INT*Local_NbRecords
.EQ.      ELSE IF (trim(mode)"restore") THEN
        size_read = size_read+2*SIZE_INT*Local_NbRecords
      ENDIF
#endif
  100 CONTINUE
      RETURN
      END SUBROUTINE CMUMPS_SAVE_RESTORE_L0FAC
      END MODULE CMUMPS_FACSOL_L0OMP_M