/[MITgcm]/MITgcm_contrib/torge/itd/code/seaice_write_pickup.F
ViewVC logotype

Annotation of /MITgcm_contrib/torge/itd/code/seaice_write_pickup.F

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

Revision 1.1 - (hide annotations) (download)
Fri Apr 27 22:22:17 2012 UTC (13 years, 3 months ago) by dimitri
Branch: MAIN 
check-in original code, before itd modifications
seaice_advdiff.F,v 1.60 2012/02/16 01:22:02
seaice_check_pickup.F,v 1.7 2012/03/05 15:21:44
seaice_diagnostics_init.F,v 1.33 2012/02/16 01:22:02
seaice_growth.F,v 1.162 2012/03/15 03:07:31
seaice_init_fixed.F,v 1.19 2012/03/11 13:41:38
seaice_init_varia.F,v 1.72 2012/03/14 22:55:53
seaice_readparms.F,v 1.120 2012/03/14 22:55:53
seaice_write_pickup.F,v 1.14 2012/03/05 15:21:45
seaice_read_pickup.F,v 1.16 2012/03/05 15:21:44
seaice_model.F,v 1.100 2012/03/02 18:56:06
SEAICE.h,v 1.62 2012/03/06 16:51:21
SEAICE_OPTIONS.h,v 1.63 2012/03/08 01:15:02
SEAICE_PARAMS.h,v 1.91 2012/03/11 13:41:38
SEAICE_SIZE.h,v 1.5 2012/03/06 16:51:21
SIZE.h,v 1.28 2009/05/17 21:15:07
1 dimitri 1.1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_write_pickup.F,v 1.14 2012/03/05 15:21:45 gforget Exp $
2     C $Name: $
3    
4     #include "SEAICE_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: SEAICE_WRITE_PICKUP
8     C !INTERFACE:
9     SUBROUTINE SEAICE_WRITE_PICKUP ( permPickup, suff,
10     I myTime, myIter, myThid )
11    
12     C !DESCRIPTION: \bv
13     C *==========================================================*
14     C | SUBROUTINE SEAICE_WRITE_PICKUP
15     C | o Write sea ice pickup file for restarting.
16     C *==========================================================*
17     C \ev
18    
19     C !USES:
20     IMPLICIT NONE
21    
22     C == Global variables ===
23     #include "SIZE.h"
24     #include "EEPARAMS.h"
25     #include "PARAMS.h"
26     #include "SEAICE_SIZE.h"
27     #include "SEAICE_PARAMS.h"
28     #include "SEAICE.h"
29     #include "SEAICE_TRACER.h"
30    
31     C !INPUT/OUTPUT PARAMETERS:
32     C == Routine arguments ==
33     C permPickup :: write a permanent pickup
34     C suff :: suffix for pickup file (eg. ckptA or 0000000010)
35     C myTime :: Current time in simulation
36     C myIter :: Current iteration number in simulation
37     C myThid :: My Thread Id number
38     LOGICAL permPickup
39     CHARACTER*(*) suff
40     _RL myTime
41     INTEGER myIter
42     INTEGER myThid
43    
44     C !LOCAL VARIABLES:
45     C == Local variables ==
46     C fp :: pickup-file precision ( precFloat64 )
47     C glf :: local flag for "globalFiles"
48     C fn :: Temp. for building file name.
49     C nWrFlds :: number of fields being written
50     C listDim :: dimension of "wrFldList" local array
51     C wrFldList :: list of written fields
52     C j :: loop index / field number
53     C nj :: record number
54     C msgBuf :: Informational/error message buffer
55     INTEGER fp
56     LOGICAL glf
57     _RL timList(1)
58     CHARACTER*(MAX_LEN_FNAM) fn
59     INTEGER listDim, nWrFlds
60     PARAMETER( listDim = 20 )
61     CHARACTER*(8) wrFldList(listDim)
62     INTEGER j, nj
63     CHARACTER*(MAX_LEN_MBUF) msgBuf
64     #ifdef ALLOW_SITRACER
65     CHARACTER*(8) fldName
66     INTEGER iTrac
67     #endif
68     CEOP
69    
70     C-- Write model fields
71     WRITE(fn,'(A,A)') 'pickup_seaice.',suff
72    
73     c IF ( seaice_pickup_write_mdsio ) THEN
74    
75     fp = precFloat64
76     j = 0
77     nj = 0
78     C record number < 0 : a hack not to write meta files now:
79    
80     C-- write Sea-Ice Thermodynamics State variables, starting with 3-D fields:
81     IF ( .NOT.useThSIce ) THEN
82     IF (SEAICE_multDim.GT.1) THEN
83     j = j + 1
84     nj = nj-1
85     CALL WRITE_REC_3D_RL(fn,fp,MULTDIM,TICES, nj, myIter, myThid )
86     IF (j.LE.listDim) wrFldList(j) = 'siTICES '
87     C- switch to 2-D fields:
88     nj = nj*MULTDIM
89     ELSE
90     j = j + 1
91     nj = nj-1
92     CALL WRITE_REC_3D_RL( fn, fp, 1, TICE , nj, myIter, myThid )
93     IF (j.LE.listDim) wrFldList(j) = 'siTICE '
94     ENDIF
95    
96     C--- continue to write 2-D fields:
97     j = j + 1
98     nj = nj-1
99     CALL WRITE_REC_3D_RL( fn, fp, 1, AREA , nj, myIter, myThid )
100     IF (j.LE.listDim) wrFldList(j) = 'siAREA '
101    
102     j = j + 1
103     nj = nj-1
104     CALL WRITE_REC_3D_RL( fn, fp, 1, HEFF , nj, myIter, myThid )
105     IF (j.LE.listDim) wrFldList(j) = 'siHEFF '
106    
107     j = j + 1
108     nj = nj-1
109     CALL WRITE_REC_3D_RL( fn, fp, 1, HSNOW , nj, myIter, myThid )
110     IF (j.LE.listDim) wrFldList(j) = 'siHSNOW '
111     #ifdef SEAICE_VARIABLE_SALINITY
112     j = j + 1
113     nj = nj-1
114     CALL WRITE_REC_3D_RL( fn, fp, 1, HSALT , nj, myIter, myThid )
115     IF (j.LE.listDim) wrFldList(j) = 'siHSALT '
116     #endif
117     #ifdef ALLOW_SITRACER
118     DO iTrac = 1, SItrNumInUse
119     WRITE(fldName,'(A6,I2.2)') 'siTrac', iTrac
120     j = j + 1
121     nj = nj-1
122     CALL WRITE_REC_3D_RL( fn, fp, 1,
123     & SItracer(1-Olx,1-Oly,1,1,iTrac),
124     & nj, myIter, myThid )
125     IF (j.LE.listDim) wrFldList(j) = fldName
126     ENDDO
127     #endif
128     ENDIF
129    
130     C-- write Sea-Ice Dynamics variables (all 2-D fields):
131     j = j + 1
132     nj = nj-1
133     CALL WRITE_REC_3D_RL( fn, fp, 1, UICE , nj, myIter, myThid )
134     IF (j.LE.listDim) wrFldList(j) = 'siUICE '
135    
136     j = j + 1
137     nj = nj-1
138     CALL WRITE_REC_3D_RL( fn, fp, 1, VICE , nj, myIter, myThid )
139     IF (j.LE.listDim) wrFldList(j) = 'siVICE '
140    
141     #if (defined(SEAICE_CGRID) && defined(SEAICE_ALLOW_EVP))
142     IF ( SEAICEuseEVP ) THEN
143     j = j + 1
144     nj = nj-1
145     CALL WRITE_REC_3D_RL( fn, fp, 1, seaice_sigma1,
146     & nj, myIter, myThid )
147     IF (j.LE.listDim) wrFldList(j) = 'siSigm1 '
148    
149     j = j + 1
150     nj = nj-1
151     CALL WRITE_REC_3D_RL( fn, fp, 1, seaice_sigma2,
152     & nj, myIter, myThid )
153     IF (j.LE.listDim) wrFldList(j) = 'siSigm2 '
154    
155     j = j + 1
156     nj = nj-1
157     CALL WRITE_REC_3D_RL( fn, fp, 1, seaice_sigma12,
158     & nj, myIter, myThid )
159     IF (j.LE.listDim) wrFldList(j) = 'siSigm12'
160     ENDIF
161     #endif /* SEAICE_ALLOW_EVP */
162    
163     nWrFlds = j
164     IF ( nWrFlds.GT.listDim ) THEN
165     WRITE(msgBuf,'(2A,I5,A)') 'WRITE_SEAICE_PICKUP: ',
166     & 'trying to write ',nWrFlds,' fields'
167     CALL PRINT_ERROR( msgBuf, myThid )
168     WRITE(msgBuf,'(2A,I5,A)') 'WRITE_SEAICE_PICKUP: ',
169     & 'field-list dimension (listDim=',listDim,') too small'
170     CALL PRINT_ERROR( msgBuf, myThid )
171     STOP 'ABNORMAL END: S/R WRITE_SEAICE_PICKUP (list-size Pb)'
172     ENDIF
173    
174     #ifdef ALLOW_MDSIO
175     C uses this specific S/R to write (with more informations) only meta files
176     nj = ABS(nj)
177     glf = globalFiles
178     timList(1) = myTime
179     CALL MDS_WR_METAFILES( fn, fp, glf, .FALSE.,
180     & 0, 0, 1, ' ',
181     & nWrFlds, wrFldList,
182     & 1, timList,
183     & nj, myIter, myThid )
184     C
185     #endif /* ALLOW_MDSIO */
186     C--------------------------
187     c ENDIF
188    
189     RETURN
190     END
  ViewVC Help
Powered by ViewVC 1.1.22