/[MITgcm]/MITgcm/pkg/thsice/thsice_write_pickup.F
ViewVC logotype

Diff of /MITgcm/pkg/thsice/thsice_write_pickup.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by edhill, Fri Jun 24 04:36:54 2005 UTC revision 1.5 by jmc, Fri Oct 19 03:21:39 2007 UTC
# Line 5  C $Name$ Line 5  C $Name$
5  CBOP  CBOP
6  C     !ROUTINE: THSICE_WRITE_PICKUP  C     !ROUTINE: THSICE_WRITE_PICKUP
7  C     !INTERFACE:  C     !INTERFACE:
8        SUBROUTINE THSICE_WRITE_PICKUP(        SUBROUTINE THSICE_WRITE_PICKUP( permPickup, suff,
9       I                       prec, lgf, permCheckPoint,       I                                myTime, myIter, myThid )
      I                                  myIter, myThid )  
10    
11  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
12  C     *==========================================================*  C     *==========================================================*
# Line 26  C     === Global variables === Line 25  C     === Global variables ===
25  #include "THSICE_PARAMS.h"  #include "THSICE_PARAMS.h"
26  #include "THSICE_VARS.h"  #include "THSICE_VARS.h"
27    
 C     == Common blocks ==  
       COMMON /PCKP_GBLFLS/ globalFile  
       LOGICAL globalFile  
   
28  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
29  C     == Routine arguments ==  C     == Routine arguments ==
30        INTEGER prec  C     permPickup :: write a permanent pickup
31        LOGICAL lgf  C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
32        LOGICAL permCheckPoint  C     myTime  :: Current time in simulation
33    C     myIter  :: Current iteration number in simulation
34    C     myThid  :: My Thread Id number
35          LOGICAL permPickup
36          CHARACTER*(*) suff
37          _RL     myTime
38        INTEGER myIter        INTEGER myIter
39        INTEGER myThid        INTEGER myThid
40  CEOP  CEOP
41    
42  #ifdef ALLOW_THSICE  #ifdef ALLOW_THSICE
43    
44  C     == Local variables ==        C     == Local variables ==
45        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
46          INTEGER prec
       IF ( permCheckPoint ) THEN  
         WRITE(fn,'(A,I10.10)') 'pickup_ic.',myIter  
       ELSE  
         WRITE(fn,'(A,A)') 'pickup_ic.',checkPtSuff(nCheckLev)  
       ENDIF  
47    
48        IF ( thSIce_pickup_write_mdsio ) THEN        IF ( thSIce_pickup_write_mdsio ) THEN
49          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,iceMask,   1,          prec = precFloat64
50       &                                               myIter,myThid)          WRITE(fn,'(A,A)') 'pickup_ic.',suff
51          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,iceHeight, 2,  
52       &                                               myIter,myThid)          CALL WRITE_REC_3D_RL( fn,prec, 1, iceMask,  1, myIter,myThid )
53          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,snowHeight,3,          CALL WRITE_REC_3D_RL( fn,prec, 1, iceHeight,2, myIter,myThid )
54       &                                               myIter,myThid)          CALL WRITE_REC_3D_RL( fn,prec, 1,snowHeight,3, myIter,myThid )
55          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Tsrf,   4, myIter,myThid)          CALL WRITE_REC_3D_RL( fn,prec, 1, Tsrf,     4, myIter,myThid )
56          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Tice1,  5, myIter,myThid)          CALL WRITE_REC_3D_RL( fn,prec, 1, Tice1,    5, myIter,myThid )
57          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Tice2,  6, myIter,myThid)          CALL WRITE_REC_3D_RL( fn,prec, 1, Tice2,    6, myIter,myThid )
58          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Qice1,  7, myIter,myThid)          CALL WRITE_REC_3D_RL( fn,prec, 1, Qice1,    7, myIter,myThid )
59          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Qice2,  8, myIter,myThid)          CALL WRITE_REC_3D_RL( fn,prec, 1, Qice2,    8, myIter,myThid )
60          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,snowAge,9, myIter,myThid)          CALL WRITE_REC_3D_RL( fn,prec, 1, snowAge,  9, myIter,myThid )
61    
62          IF ( stepFwd_oceMxL ) THEN          IF ( stepFwd_oceMxL ) THEN
63          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,tOceMxL,10,myIter,myThid)           CALL WRITE_REC_3D_RL( fn,prec,1, tOceMxL, 10, myIter,myThid )
64          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,sOceMxL,11,myIter,myThid)           CALL WRITE_REC_3D_RL( fn,prec,1, sOceMxL, 11, myIter,myThid )
65          ENDIF          ENDIF
66        ENDIF        ENDIF
67    
68  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
69        IF ( thSIce_pickup_write_mnc ) THEN        IF ( thSIce_pickup_write_mnc ) THEN
70          CALL MNC_CW_SET_UDIM(fn, -1, myThid)          IF ( permPickup ) THEN
71          CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)            WRITE(fn,'(A)') 'pickup_ic'
72            ELSE
73              WRITE(fn,'(A,A)') 'pickup_ic.',suff
74            ENDIF
75    C       First ***define*** the file group name
76          CALL MNC_CW_SET_UDIM(fn, 0, myThid)          CALL MNC_CW_SET_UDIM(fn, 0, myThid)
77            IF ( permPickup ) THEN
78              CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
79            ELSE
80              CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
81            ENDIF
82    C       Then set the actual unlimited dimension
83            CALL MNC_CW_SET_UDIM(fn, 1, myThid)
84            CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
85  C       CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)  C       CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
86          CALL MNC_CW_RL_W('D',fn,0,0,'iceMask',   iceMask,   myThid)          CALL MNC_CW_RL_W('D',fn,0,0,'iceMask',   iceMask,   myThid)
87          CALL MNC_CW_RL_W('D',fn,0,0,'iceHeight', iceHeight, myThid)          CALL MNC_CW_RL_W('D',fn,0,0,'iceHeight', iceHeight, myThid)
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22