/[MITgcm]/MITgcm/model/src/write_pickup.F
ViewVC logotype

Diff of /MITgcm/model/src/write_pickup.F

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

revision 1.3 by jmc, Fri Oct 19 14:36:47 2007 UTC revision 1.12 by jmc, Fri Nov 9 22:37:05 2012 UTC
# Line 27  C     !USES: Line 27  C     !USES:
27  #include "RESTART.h"  #include "RESTART.h"
28  #include "DYNVARS.h"  #include "DYNVARS.h"
29  #include "SURFACE.h"  #include "SURFACE.h"
30    #ifdef ALLOW_GENERIC_ADVDIFF
31    # include "GAD.h"
32    #endif
33  #ifdef ALLOW_NONHYDROSTATIC  #ifdef ALLOW_NONHYDROSTATIC
34  #include "NH_VARS.h"  # include "NH_VARS.h"
35    #endif
36    #ifdef ALLOW_ADDFLUID
37    # include "FFIELDS.h"
38  #endif  #endif
39  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
40  #include "MNC_PARAMS.h"  # include "MNC_PARAMS.h"
41  #endif  #endif
42    
43  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 46  C     myThid          :: Thread number f Line 52  C     myThid          :: Thread number f
52  CEOP  CEOP
53    
54  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
55  C     fn     :: Temp. for building file name string.  C     fp          :: pickup-file precision
56  C     fp     :: file precision  C     glf         :: local flag for "globalFiles"
57    C     fn          :: Temp. for building file name.
58    C     nWrFlds     :: number of fields being written
59    C     n3D         :: number of 3-D fields being written
60    C     listDim     :: dimension of "wrFldList" local array
61    C     wrFldList   :: list of written fields
62    C     m1,m2       :: 6.th dim index (AB-3) corresponding to time-step N-1 & N-2
63    C     j           :: loop index / field number
64    C     nj          :: record number
65    C     msgBuf      :: Informational/error message buffer
66        INTEGER fp        INTEGER fp
67        INTEGER i, nj        LOGICAL  glf
68          _RL      timList(1)
69        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
70          INTEGER listDim, nWrFlds, n3D
71          PARAMETER( listDim = 20 )
72          CHARACTER*(8) wrFldList(listDim)
73    #ifdef ALLOW_ADAMSBASHFORTH_3
74          INTEGER m1, m2
75    #endif
76          INTEGER j, nj
77          CHARACTER*(MAX_LEN_MBUF) msgBuf
78    #ifndef ALLOW_GENERIC_ADVDIFF
79          LOGICAL AdamsBashforthGt
80          LOGICAL AdamsBashforthGs
81          LOGICAL AdamsBashforth_T
82          LOGICAL AdamsBashforth_S
83          PARAMETER ( AdamsBashforthGt = .FALSE. ,
84         &            AdamsBashforthGs = .FALSE. ,
85         &            AdamsBashforth_T = .FALSE. ,
86         &            AdamsBashforth_S = .FALSE. )
87    #endif
88    
89    C-    Initialise:
90          DO j=1,listDim
91            wrFldList(j) = ' '
92          ENDDO
93    
94  C     Write model fields  C     Write model fields
95        DO i = 1,MAX_LEN_FNAM        DO j = 1,MAX_LEN_FNAM
96          fn(i:i) = ' '          fn(j:j) = ' '
97        ENDDO        ENDDO
98        IF ( permPickup ) THEN        IF ( permPickup ) THEN
99          WRITE(fn,'(A,I10.10)') 'pickup.',myIter          WRITE(fn,'(A,I10.10)') 'pickup.',myIter
# Line 63  C     Write model fields Line 102  C     Write model fields
102        ENDIF        ENDIF
103    
104  C     Going to really do some IO. Make everyone except master thread wait.  C     Going to really do some IO. Make everyone except master thread wait.
105        _BARRIER  C     this is done within IO routines => no longer needed
106    c     _BARRIER
107    
108        IF (pickup_write_mdsio) THEN        IF (pickup_write_mdsio) THEN
109    
110          fp = precFloat64          fp = precFloat64
111            j  = 0
112    C     record number < 0 : a hack not to write meta files now:
113    
114    C---  write State 3-D fields for restart
115            j = j + 1
116            CALL WRITE_REC_3D_RL( fn, fp, Nr, uVel,   -j, myIter, myThid )
117            IF (j.LE.listDim) wrFldList(j) = 'Uvel    '
118            j = j + 1
119            CALL WRITE_REC_3D_RL( fn, fp, Nr, vVel,   -j, myIter, myThid )
120            IF (j.LE.listDim) wrFldList(j) = 'Vvel    '
121    
122            j = j + 1
123            CALL WRITE_REC_3D_RL( fn, fp, Nr, theta,  -j, myIter, myThid )
124            IF (j.LE.listDim) wrFldList(j) = 'Theta   '
125            j = j + 1
126            CALL WRITE_REC_3D_RL( fn, fp, Nr, salt,   -j, myIter, myThid )
127            IF (j.LE.listDim) wrFldList(j) = 'Salt    '
128    C---  write 3-D fields for AB-restart
129  #ifdef ALLOW_ADAMSBASHFORTH_3  #ifdef ALLOW_ADAMSBASHFORTH_3
130          CALL WRITE_REC_3D_RL( fn, fp, Nr, uVel,  1, myIter, myThid )          m1 = 1 + MOD(myIter+1,2)
131          CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm(1-Olx,1-Oly,1,1,1,1),          m2 = 1 + MOD( myIter ,2)
132       &                                           2, myIter, myThid )        IF ( momStepping ) THEN
133          CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm(1-Olx,1-Oly,1,1,1,2),  C--   U velocity:
134       &                                           3, myIter, myThid )         IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
135          CALL WRITE_REC_3D_RL( fn, fp, Nr, vVel,  4, myIter, myThid )          j = j + 1
136          CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm(1-Olx,1-Oly,1,1,1,1),          CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm(1-OLx,1-OLy,1,1,1,m1),
137       &                                           5, myIter, myThid )       &                                            -j, myIter, myThid )
138          CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm(1-Olx,1-Oly,1,1,1,2),          IF (j.LE.listDim) wrFldList(j) = 'GuNm1   '
139       &                                           6, myIter, myThid )         ENDIF
140          CALL WRITE_REC_3D_RL( fn, fp, Nr, theta, 7, myIter, myThid )         IF ( beta_AB.NE.0. ) THEN
141          CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm(1-Olx,1-Oly,1,1,1,1),          j = j + 1
142       &                                           8, myIter, myThid )          CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm(1-OLx,1-OLy,1,1,1,m2),
143          CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm(1-Olx,1-Oly,1,1,1,2),       &                                            -j, myIter, myThid )
144       &                                           9, myIter, myThid )          IF (j.LE.listDim) wrFldList(j) = 'GuNm2   '
145          CALL WRITE_REC_3D_RL( fn, fp, Nr, salt, 10, myIter, myThid )         ENDIF
146          CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm(1-Olx,1-Oly,1,1,1,1),  C--   V velocity:
147       &                                          11, myIter, myThid )         IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
148          CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm(1-Olx,1-Oly,1,1,1,2),          j = j + 1
149       &                                          12, myIter, myThid )          CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm(1-OLx,1-OLy,1,1,1,m1),
150          nj = 12       &                                            -j, myIter, myThid )
151            IF (j.LE.listDim) wrFldList(j) = 'GvNm1   '
152           ENDIF
153           IF ( beta_AB.NE.0. ) THEN
154            j = j + 1
155            CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm(1-OLx,1-OLy,1,1,1,m2),
156         &                                            -j, myIter, myThid )
157            IF (j.LE.listDim) wrFldList(j) = 'GvNm2   '
158           ENDIF
159          ENDIF
160    C--   Temperature:
161          IF ( AdamsBashforthGt.OR.AdamsBashforth_T ) THEN
162           IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
163            j = j + 1
164            CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm(1-OLx,1-OLy,1,1,1,m1),
165         &                                            -j, myIter, myThid )
166            IF (j.LE.listDim) THEN
167             IF ( AdamsBashforthGt ) wrFldList(j) = 'GtNm1   '
168             IF ( AdamsBashforth_T ) wrFldList(j) = 'TempNm1 '
169            ENDIF
170           ENDIF
171           IF ( beta_AB.NE.0. ) THEN
172            j = j + 1
173            CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm(1-OLx,1-OLy,1,1,1,m2),
174         &                                            -j, myIter, myThid )
175            IF (j.LE.listDim) THEN
176             IF ( AdamsBashforthGt ) wrFldList(j) = 'GtNm2   '
177             IF ( AdamsBashforth_T ) wrFldList(j) = 'TempNm2 '
178            ENDIF
179           ENDIF
180          ENDIF
181    C--   Salinity:
182          IF ( AdamsBashforthGs.OR.AdamsBashforth_S ) THEN
183           IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
184            j = j + 1
185            CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm(1-OLx,1-OLy,1,1,1,m1),
186         &                                            -j, myIter, myThid )
187            IF (j.LE.listDim) THEN
188             IF ( AdamsBashforthGs ) wrFldList(j) = 'GsNm1   '
189             IF ( AdamsBashforth_S ) wrFldList(j) = 'SaltNm1 '
190            ENDIF
191           ENDIF
192           IF ( beta_AB.NE.0. ) THEN
193            j = j + 1
194            CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm(1-OLx,1-OLy,1,1,1,m2),
195         &                                            -j, myIter, myThid )
196            IF (j.LE.listDim) THEN
197             IF ( AdamsBashforthGs ) wrFldList(j) = 'GsNm2   '
198             IF ( AdamsBashforth_S ) wrFldList(j) = 'SaltNm2 '
199            ENDIF
200           ENDIF
201          ENDIF
202    #ifdef ALLOW_NONHYDROSTATIC
203    C--   W velocity:
204          IF ( nonHydrostatic ) THEN
205           IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
206            j = j + 1
207            CALL WRITE_REC_3D_RL( fn, fp, Nr, gwNm(1-OLx,1-OLy,1,1,1,m1),
208         &                                            -j, myIter, myThid )
209            IF (j.LE.listDim) wrFldList(j) = 'GwNm1   '
210           ENDIF
211           IF ( beta_AB.NE.0. ) THEN
212            j = j + 1
213            CALL WRITE_REC_3D_RL( fn, fp, Nr, gwNm(1-OLx,1-OLy,1,1,1,m2),
214         &                                            -j, myIter, myThid )
215            IF (j.LE.listDim) wrFldList(j) = 'GwNm2   '
216           ENDIF
217          ENDIF
218    #endif /* ALLOW_NONHYDROSTATIC */
219  #else /*  ALLOW_ADAMSBASHFORTH_3 */  #else /*  ALLOW_ADAMSBASHFORTH_3 */
220          CALL WRITE_REC_3D_RL( fn, fp, Nr, uVel,  1, myIter, myThid )         IF ( momStepping ) THEN
221          CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm1, 2, myIter, myThid )          j = j + 1
222          CALL WRITE_REC_3D_RL( fn, fp, Nr, vVel,  3, myIter, myThid )          CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm1,  -j, myIter, myThid )
223          CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm1, 4, myIter, myThid )          IF (j.LE.listDim) wrFldList(j) = 'GuNm1   '
224          CALL WRITE_REC_3D_RL( fn, fp, Nr, theta, 5, myIter, myThid )          j = j + 1
225          CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm1, 6, myIter, myThid )          CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm1,  -j, myIter, myThid )
226          CALL WRITE_REC_3D_RL( fn, fp, Nr, salt,  7, myIter, myThid )          IF (j.LE.listDim) wrFldList(j) = 'GvNm1   '
227          CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm1, 8, myIter, myThid )         ENDIF
228          nj = 8         IF ( AdamsBashforthGt ) THEN
229            j = j + 1
230            CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm1,  -j, myIter, myThid )
231            IF (j.LE.listDim) wrFldList(j) = 'GtNm1   '
232           ENDIF
233           IF ( AdamsBashforthGs ) THEN
234            j = j + 1
235            CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm1,  -j, myIter, myThid )
236            IF (j.LE.listDim) wrFldList(j) = 'GsNm1   '
237           ENDIF
238    #ifdef ALLOW_NONHYDROSTATIC
239           IF ( nonHydrostatic ) THEN
240            j = j + 1
241            CALL WRITE_REC_3D_RL( fn, fp, Nr, gwNm1,  -j, myIter, myThid )
242            IF (j.LE.listDim) wrFldList(j) = 'GwNm1   '
243           ENDIF
244    #endif /* ALLOW_NONHYDROSTATIC */
245  #endif /*  ALLOW_ADAMSBASHFORTH_3 */  #endif /*  ALLOW_ADAMSBASHFORTH_3 */
246          CALL WRITE_REC_3D_RL( fn, fp, 1,etaN, nj*Nr+1, myIter, myThid )  
247    C-    write Full Pressure for EOS in pressure:
248           IF ( useDynP_inEos_Zc ) THEN
249            j = j + 1
250            CALL WRITE_REC_3D_RL( fn, fp, Nr,totPhiHyd,-j,myIter, myThid )
251            IF (j.LE.listDim) wrFldList(j) = 'PhiHyd  '
252           ENDIF
253    #ifdef ALLOW_NONHYDROSTATIC
254           IF ( use3Dsolver ) THEN
255            j = j + 1
256            CALL WRITE_REC_3D_RL( fn, fp, Nr, phi_nh, -j, myIter, myThid )
257            IF (j.LE.listDim) wrFldList(j) = 'Phi_NHyd'
258           ENDIF
259    #endif /* ALLOW_NONHYDROSTATIC */
260    #ifdef ALLOW_ADDFLUID
261    C-    write mass source/sink of fluid (but not needed if selectAddFluid=-1)
262           IF ( selectAddFluid.NE.0 ) THEN
263            j = j + 1
264            CALL WRITE_REC_3D_RL( fn, fp, Nr,addMass,-j,myIter, myThid )
265            IF (j.LE.listDim) wrFldList(j) = 'AddMass '
266           ENDIF
267    #endif /* ALLOW_ADDFLUID */
268    
269            n3D = j
270    C---  Write 2-D fields, starting with Eta:
271            j = j + 1
272            nj = -( n3D*(Nr-1) + j )
273            CALL WRITE_REC_3D_RL( fn, fp, 1 , etaN,   nj, myIter, myThid )
274            IF (j.LE.listDim) wrFldList(j) = 'EtaN    '
275    #ifdef ALLOW_NONHYDROSTATIC
276           IF ( selectNHfreeSurf.GE.1 ) THEN
277            j = j + 1
278            nj = -( n3D*(Nr-1) + j )
279            CALL WRITE_REC_3D_RL( fn, fp, 1, dPhiNH,  nj, myIter, myThid )
280            IF (j.LE.listDim) wrFldList(j) = 'dPhiNH  '
281           ENDIF
282    #endif /* ALLOW_NONHYDROSTATIC */
283  #ifdef EXACT_CONSERV  #ifdef EXACT_CONSERV
284          CALL WRITE_REC_3D_RL( fn, fp, 1,dEtaHdt,nj*Nr+2,myIter,myThid )  c      IF ( exactConserv ) THEN
285          CALL WRITE_REC_3D_RL( fn, fp, 1,etaHnm1,nj*Nr+3,myIter,myThid )          j = j + 1
286            nj = -( n3D*(Nr-1) + j )
287            CALL WRITE_REC_3D_RL( fn, fp, 1, dEtaHdt, nj, myIter, myThid )
288            IF (j.LE.listDim) wrFldList(j) = 'dEtaHdt '
289    c      ENDIF
290    C- note: always write dEtaHdt & EtaH but read only if exactConserv & nonlinFreeSurf
291    C        this works only because nonlinFreeSurf > 0 => exactConserv=T
292    c      IF ( nonlinFreeSurf.GT.0 ) THEN
293            j = j + 1
294            nj = -( n3D*(Nr-1) + j )
295            CALL WRITE_REC_3D_RL( fn, fp, 1, etaHnm1, nj, myIter, myThid )
296            IF (j.LE.listDim) wrFldList(j) = 'EtaH    '
297    c      ENDIF
298  #endif /* EXACT_CONSERV */  #endif /* EXACT_CONSERV */
299          IF ( useDynP_inEos_Zc ) THEN  C--------------------------
300            IF ( permPickup ) THEN          nWrFlds = j
301              WRITE(fn,'(A,I10.10)') 'pickup_ph.',myIter          IF ( nWrFlds.GT.listDim ) THEN
302            ELSE            WRITE(msgBuf,'(2A,I5,A)') 'WRITE_PICKUP: ',
303              WRITE(fn,'(A,A)') 'pickup_ph.',checkPtSuff(nCheckLev)       &     'trying to write ',nWrFlds,' fields'
304            ENDIF            CALL PRINT_ERROR( msgBuf, myThid )
305            CALL WRITE_REC_3D_RL( fn,fp,Nr, totPhiHyd,1, myIter,myThid )            WRITE(msgBuf,'(2A,I5,A)') 'WRITE_PICKUP: ',
306          ENDIF       &     'field-list dimension (listDim=',listDim,') too small'
307  #ifdef ALLOW_NONHYDROSTATIC            CALL PRINT_ERROR( msgBuf, myThid )
308          IF ( use3Dsolver ) THEN            STOP 'ABNORMAL END: S/R WRITE_PICKUP (list-size Pb)'
           IF ( permPickup ) THEN  
             WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter  
           ELSE  
             WRITE(fn,'(A,A)') 'pickup_nh.',checkPtSuff(nCheckLev)  
           ENDIF  
           CALL WRITE_REC_3D_RL( fn,fp,Nr, phi_nh, 1, myIter, myThid )  
           CALL WRITE_REC_3D_RL( fn,fp,Nr, gwNm1,  2, myIter, myThid )  
309          ENDIF          ENDIF
310  #endif /* ALLOW_NONHYDROSTATIC */  #ifdef ALLOW_MDSIO
311    C-    Note: temporary: since it is a pain to add more arguments to
312    C     all MDSIO S/R, uses instead this specific S/R to write only
313    C     meta files but with more informations in it.
314            nj = ABS(nj)
315            glf  = globalFiles
316            timList(1) = myTime
317            CALL MDS_WR_METAFILES( fn, fp, glf, .FALSE.,
318         &                         0, 0, 1, ' ',
319         &                         nWrFlds, wrFldList,
320         &                         1, timList,
321         &                         nj, myIter, myThid )
322    #endif /* ALLOW_MDSIO */
323    C--------------------------
324        ENDIF        ENDIF
325    
326  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
# Line 166  C       Then set the actual unlimited di Line 360  C       Then set the actual unlimited di
360          IF ( use3Dsolver ) THEN          IF ( use3Dsolver ) THEN
361            CALL MNC_CW_RL_W('D',fn,0,0,'phi_nh', phi_nh, myThid)            CALL MNC_CW_RL_W('D',fn,0,0,'phi_nh', phi_nh, myThid)
362  c         CALL MNC_CW_RL_W('D',fn,0,0,'gW', gW, myThid)  c         CALL MNC_CW_RL_W('D',fn,0,0,'gW', gW, myThid)
363    #ifndef ALLOW_ADAMSBASHFORTH_3
364            CALL MNC_CW_RL_W('D',fn,0,0,'gWnm1', gwNm1, myThid)            CALL MNC_CW_RL_W('D',fn,0,0,'gWnm1', gwNm1, myThid)
365    #endif
366          ENDIF          ENDIF
367  #endif  #endif
368          IF ( useDynP_inEos_Zc ) THEN          IF ( useDynP_inEos_Zc ) THEN
# Line 177  c         CALL MNC_CW_RL_W('D',fn,0,0,'g Line 373  c         CALL MNC_CW_RL_W('D',fn,0,0,'g
373  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
374    
375  C--   Every one else must wait until writing is done.  C--   Every one else must wait until writing is done.
376        _BARRIER  C     this is done within IO routines => no longer needed
377    c     _BARRIER
378    
379        RETURN        RETURN
380        END        END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22