pkg/thsice/thsice_write_pickup.F

87ea84cac6 Jean*0001 #include "THSICE_OPTIONS.h"
                0002 CBOP
                0003 C     !ROUTINE: THSICE_WRITE_PICKUP
                0004 C     !INTERFACE:
cc04975b16 Jean*0005       SUBROUTINE THSICE_WRITE_PICKUP( permPickup, suff,
                0006      I                                myTime, myIter, myThid )
87ea84cac6 Jean*0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | S/R THSICE_WRITE_PICKUP
                0011 C     | o Write thsice pickup file
                0012 C     *==========================================================*
                0013 C     \ev
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017
                0018 C     === Global variables ===
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "THSICE_PARAMS.h"
                0023 #include "THSICE_VARS.h"
                0024
                0025 C     !INPUT/OUTPUT PARAMETERS:
                0026 C     == Routine arguments ==
cc04975b16 Jean*0027 C     permPickup :: write a permanent pickup
                0028 C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
                0029 C     myTime  :: Current time in simulation
                0030 C     myIter  :: Current iteration number in simulation
                0031 C     myThid  :: My Thread Id number
                0032       LOGICAL permPickup
                0033       CHARACTER*(*) suff
                0034       _RL     myTime
87ea84cac6 Jean*0035       INTEGER myIter
                0036       INTEGER myThid
                0037 CEOP
                0038
                0039 #ifdef ALLOW_THSICE
cc04975b16 Jean*0040 C     == Local variables ==
87ea84cac6 Jean*0041       CHARACTER*(MAX_LEN_FNAM) fn
cc04975b16 Jean*0042       INTEGER prec
87ea84cac6 Jean*0043
60cad0f1a5 Jean*0044 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0045
                0046 #ifdef ALLOW_OCN_COMPON_INTERF
                0047       IF ( useCoupler .AND. thSIce_skipThermo ) RETURN
                0048 #endif /* ALLOW_OCN_COMPON_INTERF */
                0049
df4e8f7bcf Ed H*0050       IF ( thSIce_pickup_write_mdsio ) THEN
cc04975b16 Jean*0051         prec = precFloat64
                0052         WRITE(fn,'(A,A)') 'pickup_ic.',suff
                0053
                0054         CALL WRITE_REC_3D_RL( fn,prec, 1, iceMask,  1, myIter,myThid )
                0055         CALL WRITE_REC_3D_RL( fn,prec, 1, iceHeight,2, myIter,myThid )
                0056         CALL WRITE_REC_3D_RL( fn,prec, 1,snowHeight,3, myIter,myThid )
                0057         CALL WRITE_REC_3D_RL( fn,prec, 1, Tsrf,     4, myIter,myThid )
                0058         CALL WRITE_REC_3D_RL( fn,prec, 1, Tice1,    5, myIter,myThid )
                0059         CALL WRITE_REC_3D_RL( fn,prec, 1, Tice2,    6, myIter,myThid )
                0060         CALL WRITE_REC_3D_RL( fn,prec, 1, Qice1,    7, myIter,myThid )
                0061         CALL WRITE_REC_3D_RL( fn,prec, 1, Qice2,    8, myIter,myThid )
                0062         CALL WRITE_REC_3D_RL( fn,prec, 1, snowAge,  9, myIter,myThid )
87ea84cac6 Jean*0063
df4e8f7bcf Ed H*0064         IF ( stepFwd_oceMxL ) THEN
cc04975b16 Jean*0065          CALL WRITE_REC_3D_RL( fn,prec,1, tOceMxL, 10, myIter,myThid )
                0066          CALL WRITE_REC_3D_RL( fn,prec,1, sOceMxL, 11, myIter,myThid )
df4e8f7bcf Ed H*0067         ENDIF
                0068       ENDIF
                0069
                0070 #ifdef ALLOW_MNC
                0071       IF ( thSIce_pickup_write_mnc ) THEN
cc04975b16 Jean*0072         IF ( permPickup ) THEN
c29c5d093c Ed H*0073           WRITE(fn,'(A)') 'pickup_ic'
                0074         ELSE
cc04975b16 Jean*0075           WRITE(fn,'(A,A)') 'pickup_ic.',suff
c29c5d093c Ed H*0076         ENDIF
                0077 C       First ***define*** the file group name
df4e8f7bcf Ed H*0078         CALL MNC_CW_SET_UDIM(fn, 0, myThid)
cc04975b16 Jean*0079         IF ( permPickup ) THEN
c29c5d093c Ed H*0080           CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
                0081         ELSE
                0082           CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
                0083         ENDIF
                0084 C       Then set the actual unlimited dimension
                0085         CALL MNC_CW_SET_UDIM(fn, 1, myThid)
                0086         CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
df4e8f7bcf Ed H*0087 C       CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
                0088         CALL MNC_CW_RL_W('D',fn,0,0,'iceMask',   iceMask,   myThid)
                0089         CALL MNC_CW_RL_W('D',fn,0,0,'iceHeight', iceHeight, myThid)
                0090         CALL MNC_CW_RL_W('D',fn,0,0,'snowHeight',snowHeight,myThid)
                0091         CALL MNC_CW_RL_W('D',fn,0,0,'Tsrf',      Tsrf,      myThid)
                0092         CALL MNC_CW_RL_W('D',fn,0,0,'Tice1',     Tice1,     myThid)
                0093         CALL MNC_CW_RL_W('D',fn,0,0,'Tice2',     Tice1,     myThid)
                0094         CALL MNC_CW_RL_W('D',fn,0,0,'Qice1',     Qice1,     myThid)
                0095         CALL MNC_CW_RL_W('D',fn,0,0,'Qice2',     Qice2,     myThid)
                0096         CALL MNC_CW_RL_W('D',fn,0,0,'snowAge',   snowAge,   myThid)
                0097         IF ( stepFwd_oceMxL ) THEN
                0098           CALL MNC_CW_RL_W('D',fn,0,0,'tOceMxL',tOceMxL,myThid)
                0099           CALL MNC_CW_RL_W('D',fn,0,0,'sOceMxL',sOceMxL,myThid)
                0100         ENDIF
                0101       ENDIF
                0102 #endif  /* ALLOW_MNC */
87ea84cac6 Jean*0103
                0104 #endif  /* ALLOW_THSICE */
                0105       RETURN
                0106       END