pkg/cd_code/cd_code_write_pickup.F

86c9075df5 Jean*0001 #include "CD_CODE_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: CD_CODE_WRITE_PICKUP
                0006
                0007 C     !INTERFACE:
958248ce20 Jean*0008       SUBROUTINE CD_CODE_WRITE_PICKUP(
cc04975b16 Jean*0009      I                         permPickup, suff,
                0010      I                         myTime, myIter, myThid )
86c9075df5 Jean*0011
                0012 C     !DESCRIPTION:
                0013 C     Read the pickup.
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
958248ce20 Jean*0020 #include "CD_CODE_VARS.h"
86c9075df5 Jean*0021 #ifdef ALLOW_MNC
                0022 #include "MNC_PARAMS.h"
                0023 #endif
                0024
                0025 C     !INPUT/OUTPUT PARAMETERS:
cc04975b16 Jean*0026 C     permPickup :: Is or is not a permanent pickup
                0027 C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
                0028 C     myTime  :: Current time in simulation
                0029 C     myIter  :: Current iteration number in simulation
                0030 C     myThid  :: My Thread Id number
                0031       LOGICAL permPickup
                0032       CHARACTER*(*) suff
                0033       _RL     myTime
86c9075df5 Jean*0034       INTEGER myIter
                0035       INTEGER myThid
                0036 CEOP
                0037
                0038 #ifdef ALLOW_CD_CODE
                0039
                0040 C     !LOCAL VARIABLES:
                0041       CHARACTER*(MAX_LEN_FNAM) fn
cc04975b16 Jean*0042       INTEGER prec
86c9075df5 Jean*0043
                0044 #ifdef ALLOW_MNC
                0045       IF (useMNC .AND. pickup_write_mnc) THEN
cc04975b16 Jean*0046
                0047         IF ( permPickup ) THEN
                0048           WRITE(fn,'(A)') 'pickup_cd'
                0049         ELSE
                0050           WRITE(fn,'(A,A)') 'pickup_cd.',suff
                0051         ENDIF
                0052
86c9075df5 Jean*0053 C       Read variables from the pickup file
                0054         CALL MNC_CW_SET_UDIM(fn, 1, myThid)
cc04975b16 Jean*0055         IF ( permPickup ) THEN
86c9075df5 Jean*0056           CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
                0057         ELSE
                0058           CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
                0059         ENDIF
                0060         CALL MNC_CW_SET_UDIM(fn, 1, myThid)
                0061         CALL MNC_CW_RL_W('D',fn,0,0,'uVelD',uVelD, myThid)
                0062         CALL MNC_CW_RL_W('D',fn,0,0,'vVelD',vVelD, myThid)
                0063         CALL MNC_CW_RL_W('D',fn,0,0,'Unm1',Unm1, myThid)
                0064         CALL MNC_CW_RL_W('D',fn,0,0,'Vnm1',Vnm1, myThid)
                0065         CALL MNC_CW_RL_W('D',fn,0,0,'etaNm1', etaNm1, myThid)
9ad36f5d9b Ed H*0066         CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
86c9075df5 Jean*0067       ENDIF
                0068 #endif /*  ALLOW_MNC  */
                0069
                0070       IF (pickup_write_mdsio) THEN
cc04975b16 Jean*0071
                0072         prec = precFloat64
                0073         WRITE(fn,'(A,A)') 'pickup_cd.',suff
                0074
958248ce20 Jean*0075         CALL WRITE_REC_3D_RL( fn, prec, Nr, uVelD, 1, myIter, myThid )
                0076         CALL WRITE_REC_3D_RL( fn, prec, Nr, vVelD, 2, myIter, myThid )
                0077         CALL WRITE_REC_3D_RL( fn, prec, Nr, uNM1,  3, myIter, myThid )
                0078         CALL WRITE_REC_3D_RL( fn, prec, Nr, vNM1,  4, myIter, myThid )
                0079         CALL WRITE_REC_3D_RL( fn, prec, 1,etaNm1,4*Nr+1,myIter,myThid)
86c9075df5 Jean*0080       ENDIF
                0081
                0082 #endif /*  ALLOW_CD_CODE  */
                0083
                0084       RETURN
                0085       END