pkg/generic_advdiff/gad_read_pickup.F

d7ce0d34f8 Jean*0001 #include "GAD_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: GAD_READ_PICKUP
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE GAD_READ_PICKUP( myIter, myThid )
                0009
                0010 C     !DESCRIPTION:
                0011 C     Reads current state of 2nd.Order moments from a pickup file
                0012
                0013 C     !USES:
                0014       IMPLICIT NONE
                0015 #include "SIZE.h"
                0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
                0018 #include "GAD.h"
                0019 #include "GAD_SOM_VARS.h"
                0020 #ifdef ALLOW_MNC
                0021 #include "MNC_PARAMS.h"
                0022 #endif
                0023
                0024 C     !INPUT PARAMETERS:
                0025 C     myIter  :: time-step number
                0026 C     myThid  :: thread number
                0027       INTEGER myIter
                0028       INTEGER myThid
                0029
6e23417f74 Jean*0030 #ifdef GAD_ALLOW_TS_SOM_ADV
d7ce0d34f8 Jean*0031
                0032 C     !LOCAL VARIABLES:
                0033 C     n       :: 2nd.O. moment loop index
                0034 C     iRec    :: record number
                0035 C     fn      :: character buffer for creating filename
                0036 C     prec    :: precision of pickup files
150f5cb459 Jean*0037       INTEGER n, prec, iRec
df5a9764ba Jean*0038       CHARACTER*(10) suff
150f5cb459 Jean*0039       CHARACTER*(MAX_LEN_FNAM) fn, filNam
                0040       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0041       INTEGER ioUnit
c8b148d42e Jean*0042       LOGICAL useCurrentDir, fileExist
d7ce0d34f8 Jean*0043 CEOP
                0044
                0045 C-    Need to synchronize here before doing master-thread IO
150f5cb459 Jean*0046 C note: not presently needed (synchronized through MDS_CHECK4FILE call)
                0047 c     _BARRIER
                0048       ioUnit = errorMessageUnit
d7ce0d34f8 Jean*0049
                0050 #ifdef ALLOW_MNC
                0051       IF ( useMNC .AND. pickup_read_mnc ) THEN
                0052 c      IF ( tempSOM_Advection ) THEN
                0053 C       Read variables from the pickup file
                0054 c       WRITE(fn,'(a)') 'pickup_som'
                0055 c       CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
                0056 c       CALL MNC_CW_SET_UDIM(fn, 1, myThid)
                0057 c       CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
                0058 c       prefix = 'somT_'
                0059 c       DO n = 1,nSOM
                0060 c         CALL MNC_CW_RL_R('D',fn,0,0, som_name,
                0061 c    &         som_T(1-OLx,1-OLy,1,1,1,n),myThid)
                0062 c       ENDDO
                0063 c      ENDIF
                0064       ENDIF
                0065 #endif /*  ALLOW_MNC  */
                0066
                0067 c     IF ( pickup_read_mdsio .AND. tempSOM_Advection ) THEN
                0068       IF ( tempSOM_Advection ) THEN
                0069 C--   Pot. Temp. 2nd.Order moments
                0070
                0071         IF (pickupSuff .EQ. ' ') THEN
df5a9764ba Jean*0072           IF ( rwSuffixType.EQ.0 ) THEN
                0073             WRITE(fn,'(A,I10.10)') 'pickup_somT.', myIter
                0074           ELSE
                0075             CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
                0076             WRITE(fn,'(A,A)') 'pickup_somT.', suff
                0077           ENDIF
d7ce0d34f8 Jean*0078         ELSE
                0079           WRITE(fn,'(A,A10)') 'pickup_somT.', pickupSuff
                0080         ENDIF
150f5cb459 Jean*0081
                0082 C-      First check if pickup file exist
c8b148d42e Jean*0083 #ifdef ALLOW_MDSIO
                0084         useCurrentDir = .FALSE.
150f5cb459 Jean*0085         CALL MDS_CHECK4FILE(
                0086      I                       fn, '.data', 'GAD_READ_PICKUP',
                0087      O                       filNam, fileExist,
c8b148d42e Jean*0088      I                       useCurrentDir, myThid )
                0089 #else
                0090         STOP 'ABNORMAL END: S/R GAD_READ_PICKUP: Needs MDSIO pkg'
                0091 #endif
150f5cb459 Jean*0092
                0093         IF ( fileExist ) THEN
                0094 C-      Read 2nd Order moments as consecutive records
                0095           prec = precFloat64
                0096           DO n=1,nSOM
                0097             iRec = n
                0098             CALL READ_REC_3D_RL( fn, prec, Nr,
df5a9764ba Jean*0099      O                som_T(1-OLx,1-OLy,1,1,1,n),
150f5cb459 Jean*0100      I                iRec, myIter, myThid )
                0101           ENDDO
                0102         ELSE
                0103           IF ( pickupStrictlyMatch ) THEN
                0104             WRITE(msgBuf,'(4A)') 'GAD_READ_PICKUP: ',
                0105      &        'try with " pickupStrictlyMatch=.FALSE.,"',
                0106      &        ' in file: "data", NameList: "PARM03"'
                0107             CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0108             STOP 'ABNORMAL END: S/R GAD_READ_PICKUP'
                0109           ELSE
                0110             WRITE(msgBuf,'(2A)') 'WARNING >> GAD_READ_PICKUP: ',
                0111      &        'approximated restart: reset SOM_T to zero'
                0112             CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0113           ENDIF
                0114         ENDIF
d7ce0d34f8 Jean*0115
                0116       ENDIF
                0117
                0118 c     IF ( pickup_read_mdsio .AND. saltSOM_Advection ) THEN
                0119       IF ( saltSOM_Advection ) THEN
                0120 C--   Salinity 2nd.Order moments
                0121
                0122         IF (pickupSuff .EQ. ' ') THEN
df5a9764ba Jean*0123           IF ( rwSuffixType.EQ.0 ) THEN
                0124             WRITE(fn,'(A,I10.10)') 'pickup_somS.', myIter
                0125           ELSE
                0126             CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
                0127             WRITE(fn,'(A,A)') 'pickup_somS.', suff
                0128           ENDIF
d7ce0d34f8 Jean*0129         ELSE
                0130           WRITE(fn,'(A,A10)') 'pickup_somS.', pickupSuff
                0131         ENDIF
150f5cb459 Jean*0132
                0133 C-      First check if pickup file exist
c8b148d42e Jean*0134 #ifdef ALLOW_MDSIO
                0135         useCurrentDir = .FALSE.
150f5cb459 Jean*0136         CALL MDS_CHECK4FILE(
                0137      I                       fn, '.data', 'GAD_READ_PICKUP',
                0138      O                       filNam, fileExist,
c8b148d42e Jean*0139      I                       useCurrentDir, myThid )
                0140 #else
                0141         STOP 'ABNORMAL END: S/R GAD_READ_PICKUP: Needs MDSIO pkg'
                0142 #endif
150f5cb459 Jean*0143
                0144         IF ( fileExist ) THEN
                0145 C-      Read 2nd Order moments as consecutive records
                0146           prec = precFloat64
                0147           DO n=1,nSOM
                0148             iRec = n
                0149             CALL READ_REC_3D_RL( fn, prec, Nr,
df5a9764ba Jean*0150      O                som_S(1-OLx,1-OLy,1,1,1,n),
150f5cb459 Jean*0151      I                iRec, myIter, myThid )
                0152           ENDDO
                0153         ELSE
                0154           IF ( pickupStrictlyMatch ) THEN
                0155             WRITE(msgBuf,'(4A)') 'GAD_READ_PICKUP: ',
                0156      &        'try with " pickupStrictlyMatch=.FALSE.,"',
                0157      &        ' in file: "data", NameList: "PARM03"'
                0158             CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0159             STOP 'ABNORMAL END: S/R GAD_READ_PICKUP'
                0160           ELSE
                0161             WRITE(msgBuf,'(2A)') 'WARNING >> GAD_READ_PICKUP: ',
                0162      &        'approximated restart: reset SOM_S to zero'
                0163             CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0164           ENDIF
                0165         ENDIF
d7ce0d34f8 Jean*0166
                0167       ENDIF
                0168
6e23417f74 Jean*0169 #endif /* GAD_ALLOW_TS_SOM_ADV */
d7ce0d34f8 Jean*0170
                0171       RETURN
                0172       END