pkg/thsice/thsice_read_pickup.F

87ea84cac6 Jean*0001 #include "THSICE_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: THSICE_READ_PICKUP
                0005 C     !INTERFACE:
af20bc5e19 Jean*0006       SUBROUTINE THSICE_READ_PICKUP( myIter, myThid )
87ea84cac6 Jean*0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | S/R THSICE_READ_PICKUP
                0011 C     | o Read 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 ==
                0027       INTEGER myIter
                0028       INTEGER myThid
                0029 CEOP
                0030
                0031 #ifdef ALLOW_THSICE
                0032
                0033 C     == Local variables ==
af20bc5e19 Jean*0034       INTEGER prec
                0035       CHARACTER*(10) suff
87ea84cac6 Jean*0036       CHARACTER*(MAX_LEN_FNAM) fn
af20bc5e19 Jean*0037
df4e8f7bcf Ed H*0038       IF ( .NOT. thSIce_pickup_write_mnc ) THEN
87ea84cac6 Jean*0039
af20bc5e19 Jean*0040         prec = precFloat64
                0041         IF ( pickupSuff.EQ.' ' ) THEN
                0042           IF ( rwSuffixType.EQ.0 ) THEN
                0043             WRITE(fn,'(A,I10.10)') 'pickup_ic.', myIter
                0044           ELSE
                0045             CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
                0046             WRITE(fn,'(A,A)') 'pickup_ic.', suff
                0047           ENDIF
231824e980 Jean*0048         ELSE
af20bc5e19 Jean*0049           WRITE(fn,'(A,A10)')    'pickup_ic.', pickupSuff
231824e980 Jean*0050         ENDIF
                0051         CALL READ_REC_3D_RL( fn, prec, 1, iceMask,  1, myIter,myThid )
                0052         CALL READ_REC_3D_RL( fn, prec, 1, iceHeight,2, myIter,myThid )
                0053         CALL READ_REC_3D_RL( fn, prec, 1,snowHeight,3, myIter,myThid )
                0054         CALL READ_REC_3D_RL( fn, prec, 1, Tsrf,     4, myIter,myThid )
                0055         CALL READ_REC_3D_RL( fn, prec, 1, Tice1,    5, myIter,myThid )
                0056         CALL READ_REC_3D_RL( fn, prec, 1, Tice2,    6, myIter,myThid )
                0057         CALL READ_REC_3D_RL( fn, prec, 1, Qice1,    7, myIter,myThid )
                0058         CALL READ_REC_3D_RL( fn, prec, 1, Qice2,    8, myIter,myThid )
                0059         CALL READ_REC_3D_RL( fn, prec, 1, snowAge,  9, myIter,myThid )
87ea84cac6 Jean*0060
df4e8f7bcf Ed H*0061         IF ( stepFwd_oceMxL .AND. startIceModel.EQ.0 )  THEN
231824e980 Jean*0062           CALL READ_REC_3D_RL( fn,prec,1, tOceMxL, 10, myIter,myThid )
                0063           CALL READ_REC_3D_RL( fn,prec,1, sOceMxL, 11, myIter,myThid )
df4e8f7bcf Ed H*0064         ENDIF
                0065
                0066       ENDIF
                0067
                0068 #ifdef ALLOW_MNC
                0069       IF ( thSIce_pickup_write_mnc ) THEN
c29c5d093c Ed H*0070         WRITE(fn,'(A)') 'pickup_ic'
df4e8f7bcf Ed H*0071         CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
                0072         CALL MNC_CW_SET_UDIM(fn, 1, myThid)
1198af0cb0 Mart*0073         CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
df4e8f7bcf Ed H*0074         CALL MNC_CW_RL_R('D',fn,0,0,'iceMask',   iceMask,   myThid)
                0075         CALL MNC_CW_RL_R('D',fn,0,0,'iceHeight', iceHeight, myThid)
                0076         CALL MNC_CW_RL_R('D',fn,0,0,'snowHeight',snowHeight,myThid)
                0077         CALL MNC_CW_RL_R('D',fn,0,0,'Tsrf',      Tsrf,      myThid)
                0078         CALL MNC_CW_RL_R('D',fn,0,0,'Tice1',     Tice1,     myThid)
                0079         CALL MNC_CW_RL_R('D',fn,0,0,'Tice2',     Tice1,     myThid)
                0080         CALL MNC_CW_RL_R('D',fn,0,0,'Qice1',     Qice1,     myThid)
                0081         CALL MNC_CW_RL_R('D',fn,0,0,'Qice2',     Qice2,     myThid)
                0082         CALL MNC_CW_RL_R('D',fn,0,0,'snowAge',   snowAge,   myThid)
                0083         IF ( stepFwd_oceMxL ) THEN
                0084           CALL MNC_CW_RL_R('D',fn,0,0,'tOceMxL',tOceMxL,myThid)
                0085           CALL MNC_CW_RL_R('D',fn,0,0,'sOceMxL',sOceMxL,myThid)
                0086         ENDIF
                0087       ENDIF
                0088 #endif  /* ALLOW_MNC */
87ea84cac6 Jean*0089
                0090 #endif  /* ALLOW_THSICE */
                0091       RETURN
                0092       END