1 |
C $Header: /u/gcmpack/MITgcm/pkg/atm_compon_interf/cpl_write_pickup.F,v 1.8 2016/01/06 00:42:51 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "ATM_CPL_OPTIONS.h" |
5 |
|
6 |
CBOP |
7 |
C !ROUTINE: CPL_WRITE_PICKUP |
8 |
C !INTERFACE: |
9 |
SUBROUTINE CPL_WRITE_PICKUP( |
10 |
I suff, myTime, myIter, myThid ) |
11 |
|
12 |
C !DESCRIPTION: \bv |
13 |
C *==========================================================* |
14 |
C | SUBROUTINE CPL_WRITE_PICKUP |
15 |
C | o Store coupling state for restart. |
16 |
C | - Atmospheric version - |
17 |
C *==========================================================* |
18 |
C \ev |
19 |
|
20 |
C !USES: |
21 |
IMPLICIT NONE |
22 |
|
23 |
C == Global variables == |
24 |
#include "SIZE.h" |
25 |
#include "EEPARAMS.h" |
26 |
#include "PARAMS.h" |
27 |
#include "CPL_PARAMS.h" |
28 |
#include "ATMCPL.h" |
29 |
|
30 |
C !INPUT/OUTPUT PARAMETERS: |
31 |
C == Routine arguments == |
32 |
C suff :: suffix for pickup file (eg. ckptA or 0000000010) |
33 |
C myTime :: Current time in simulation |
34 |
C myIter :: Current iteration number in simulation |
35 |
C myThid :: My Thread Id number |
36 |
CHARACTER*(*) suff |
37 |
_RL myTime |
38 |
INTEGER myIter |
39 |
INTEGER myThid |
40 |
CEOP |
41 |
|
42 |
#ifdef COMPONENT_MODULE |
43 |
C === Functions ==== |
44 |
INTEGER ILNBLNK |
45 |
EXTERNAL ILNBLNK |
46 |
|
47 |
C !LOCAL VARIABLES: ==================================================== |
48 |
C j :: loop index / field number |
49 |
C nj :: record number |
50 |
C fp :: pickup-file precision |
51 |
C glf :: local flag for "globalFiles" |
52 |
C fn :: character buffer for creating filename |
53 |
C nWrFlds :: number of fields being written |
54 |
C listDim :: dimension of "wrFldList" local array |
55 |
C wrFldList :: list of written fields |
56 |
C msgBuf :: Informational/error message buffer |
57 |
INTEGER j, nj, fp, lChar |
58 |
LOGICAL glf |
59 |
_RL timList(1) |
60 |
CHARACTER*(MAX_LEN_FNAM) fn |
61 |
INTEGER listDim, nWrFlds |
62 |
PARAMETER( listDim = 18 ) |
63 |
CHARACTER*(8) wrFldList(listDim) |
64 |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
65 |
CEOP |
66 |
|
67 |
lChar = ILNBLNK(suff) |
68 |
IF ( lChar.EQ.0 ) THEN |
69 |
WRITE(fn,'(2A)') 'pickup_cpl' |
70 |
ELSE |
71 |
WRITE(fn,'(2A)') 'pickup_cpl.',suff(1:lChar) |
72 |
ENDIF |
73 |
fp = precFloat64 |
74 |
j = 0 |
75 |
|
76 |
C- Firstly, write 3-D fields as consecutive records |
77 |
C- Then switch to 2-D fields: |
78 |
c nj = -j*Nr |
79 |
C record number < 0 : a hack not to write meta files now: |
80 |
c nj = nj-1 |
81 |
j = j + 1 |
82 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
83 |
& HeatFlux , -j, myIter, myThid ) |
84 |
IF (j.LE.listDim) wrFldList(j) = 'qHeatFlx' |
85 |
|
86 |
j = j + 1 |
87 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
88 |
& qShortWave, -j, myIter, myThid ) |
89 |
IF (j.LE.listDim) wrFldList(j) = 'qShortW ' |
90 |
|
91 |
j = j + 1 |
92 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
93 |
& tauX , -j, myIter, myThid ) |
94 |
IF (j.LE.listDim) wrFldList(j) = 'surfTauX' |
95 |
|
96 |
j = j + 1 |
97 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
98 |
& tauY , -j, myIter, myThid ) |
99 |
IF (j.LE.listDim) wrFldList(j) = 'surfTauY' |
100 |
|
101 |
j = j + 1 |
102 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
103 |
& EvMPrFlux , -j, myIter, myThid ) |
104 |
IF (j.LE.listDim) wrFldList(j) = 'Evp-Prec' |
105 |
|
106 |
#ifdef ALLOW_LAND |
107 |
IF ( atm_cplExch_RunOff ) THEN |
108 |
j = j + 1 |
109 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
110 |
& RunOffFlux, -j, myIter, myThid ) |
111 |
IF (j.LE.listDim) wrFldList(j) = 'RunOffFx' |
112 |
j = j + 1 |
113 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
114 |
& RunOffEnFx, -j, myIter, myThid ) |
115 |
IF (j.LE.listDim) wrFldList(j) = 'RnOfEnFx' |
116 |
ENDIF |
117 |
#endif /* ALLOW_LAND */ |
118 |
#ifdef ALLOW_THSICE |
119 |
IF ( atm_cplExch1W_sIce ) THEN |
120 |
j = j + 1 |
121 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
122 |
& iceSaltFlx, -j, myIter, myThid ) |
123 |
IF (j.LE.listDim) wrFldList(j) = 'saltFlux' |
124 |
ENDIF |
125 |
IF ( atm_cplExch_SaltPl ) THEN |
126 |
j = j + 1 |
127 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
128 |
& saltPlmFlx_cpl, -j, myIter, myThid ) |
129 |
IF (j.LE.listDim) wrFldList(j) = 'sltPlmFx' |
130 |
ENDIF |
131 |
#endif /* ALLOW_THSICE */ |
132 |
#ifdef ALLOW_AIM |
133 |
IF ( atm_cplExch_DIC ) THEN |
134 |
j = j + 1 |
135 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
136 |
& airCO2 , -j, myIter, myThid ) |
137 |
IF (j.LE.listDim) wrFldList(j) = 'atm-CO2 ' |
138 |
j = j + 1 |
139 |
CALL WRITE_REC_3D_RL( fn, fp, 1, |
140 |
& sWSpeed , -j, myIter, myThid ) |
141 |
IF (j.LE.listDim) wrFldList(j) = 'wndSpeed' |
142 |
ENDIF |
143 |
#endif /* ALLOW_AIM */ |
144 |
C- with only 2-D fields: |
145 |
nj = -j |
146 |
|
147 |
C-------------------------- |
148 |
nWrFlds = j |
149 |
IF ( nWrFlds.GT.listDim ) THEN |
150 |
WRITE(msgBuf,'(2A,I5,A)') 'CPL_WRITE_PICKUP: ', |
151 |
& 'trying to write ',nWrFlds,' fields' |
152 |
CALL PRINT_ERROR( msgBuf, myThid ) |
153 |
WRITE(msgBuf,'(2A,I5,A)') 'CPL_WRITE_PICKUP: ', |
154 |
& 'field-list dimension (listDim=',listDim,') too small' |
155 |
CALL PRINT_ERROR( msgBuf, myThid ) |
156 |
CALL ALL_PROC_DIE( myThid ) |
157 |
STOP 'ABNORMAL END: S/R CPL_WRITE_PICKUP (list-size Pb)' |
158 |
ENDIF |
159 |
#ifdef ALLOW_MDSIO |
160 |
C uses this specific S/R to write (with more informations) only meta files |
161 |
j = 1 |
162 |
nj = ABS(nj) |
163 |
IF ( nWrFlds*Nr .EQ. nj ) THEN |
164 |
j = Nr |
165 |
nj = nWrFlds |
166 |
ENDIF |
167 |
glf = globalFiles |
168 |
timList(1) = myTime |
169 |
CALL MDS_WR_METAFILES( fn, fp, glf, .FALSE., |
170 |
& 0, 0, j, ' ', |
171 |
& nWrFlds, wrFldList, |
172 |
& 1, timList, oneRL, |
173 |
& nj, myIter, myThid ) |
174 |
#endif /* ALLOW_MDSIO */ |
175 |
C-------------------------- |
176 |
|
177 |
#endif /* COMPONENT_MODULE */ |
178 |
|
179 |
RETURN |
180 |
END |