pkg/generic_advdiff/gad_write_pickup.F

d7ce0d34f8 Jean*0001 #include "GAD_OPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: GAD_WRITE_PICKUP
                0005
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE GAD_WRITE_PICKUP( suff,
                0008      I                             myTime, myIter, myThid )
                0009
                0010 C !DESCRIPTION:
                0011 C     Writes current state of 2nd.Order moments to 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     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
                0026 C     myTime  :: model time
                0027 C     myIter  :: time-step number
                0028 C     myThid  :: thread number
                0029       CHARACTER*(*) suff
                0030       _RL     myTime
                0031       INTEGER myIter
                0032       INTEGER myThid
                0033
                0034 C !OUTPUT PARAMETERS: ==================================================
                0035 C  none
                0036
6e23417f74 Jean*0037 #ifdef GAD_ALLOW_TS_SOM_ADV
d7ce0d34f8 Jean*0038 C     === Functions ====
                0039       INTEGER  ILNBLNK
                0040       EXTERNAL ILNBLNK
                0041
                0042 C !LOCAL VARIABLES: ====================================================
                0043 C     n       :: 2nd.O. moment loop index
                0044 C     iRec    :: record number
                0045 C     fn      :: character buffer for creating filename
                0046 C     prec    :: precision of pickup files
                0047 C     msgBuf  :: Informational/error meesage buffer
                0048       INTEGER n,prec,iRec,lChar
                0049       CHARACTER*(MAX_LEN_FNAM) fn
890dad7807 Jean*0050 #ifdef ALLOW_MNC
d7ce0d34f8 Jean*0051       CHARACTER*(MAX_LEN_MBUF) msgBuf
890dad7807 Jean*0052 #endif
d7ce0d34f8 Jean*0053 CEOP
                0054
                0055 #ifdef ALLOW_MNC
                0056       IF ( useMNC .AND. pickup_write_mnc ) THEN
                0057        IF ( tempSOM_Advection .OR. saltSOM_Advection ) THEN
                0058         WRITE(msgBuf,'(A)') 'GAD_WRITE_PICKUP: MNC not yet coded',
                0059      &                      ' => write bin file instead'
                0060         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0061      &                      SQUEEZE_RIGHT, myThid)
                0062        ENDIF
                0063       ENDIF
                0064 #endif /*  ALLOW_MNC  */
                0065
                0066 c     IF ( pickup_write_mdsio ) THEN
                0067       IF ( .TRUE. ) THEN
                0068        lChar = ILNBLNK(suff)
                0069
                0070        IF ( tempSOM_Advection ) THEN
                0071 C--   Pot. Temp. 2nd.Order moments
                0072         IF ( lChar.EQ.0 ) THEN
                0073           WRITE(fn,'(2A)') 'pickup_somT'
                0074         ELSE
                0075           WRITE(fn,'(2A)') 'pickup_somT.',suff(1:lChar)
                0076         ENDIF
                0077         prec = precFloat64
                0078 C       Write 2nd Order moments as consecutive records
                0079         DO n=1,nSOM
                0080           iRec = n
                0081           CALL WRITE_REC_3D_RL( fn, prec, Nr,
                0082      I               som_T(1-Olx,1-Oly,1,1,1,n),
                0083      I               iRec, myIter, myThid )
                0084         ENDDO
                0085        ENDIF
                0086
                0087        IF ( saltSOM_Advection ) THEN
                0088 C--   Salinity 2nd.Order moments
                0089         IF ( lChar.EQ.0 ) THEN
                0090           WRITE(fn,'(2A)') 'pickup_somS'
                0091         ELSE
                0092           WRITE(fn,'(2A)') 'pickup_somS.',suff(1:lChar)
                0093         ENDIF
                0094         prec = precFloat64
                0095 C       Write 2nd Order moments as consecutive records
                0096         DO n=1,nSOM
                0097           iRec = n
                0098           CALL WRITE_REC_3D_RL( fn, prec, Nr,
                0099      I               som_S(1-Olx,1-Oly,1,1,1,n),
                0100      I               iRec, myIter, myThid )
                0101         ENDDO
                0102        ENDIF
                0103
                0104       ENDIF
                0105
6e23417f74 Jean*0106 #endif /* GAD_ALLOW_TS_SOM_ADV */
d7ce0d34f8 Jean*0107
                0108       RETURN
                0109       END