model/src/write_pickup.F

92e77d50bf Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
                0003
                0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0005 CBOP
                0006 C     !ROUTINE: WRITE_PICKUP
                0007 C     !INTERFACE:
                0008       SUBROUTINE WRITE_PICKUP(
528fbbe5ca Jean*0009      I                 permPickup, suffix,
92e77d50bf Jean*0010      I                 myTime, myIter, myThid )
                0011
                0012 C     !DESCRIPTION:
                0013 C     Write the main-model pickup-file and do it NOW.
                0014 C     It writes both "rolling-pickup" files (ckptA,ckptB) and
                0015 C     permanent pickup files (with iteration number in the file name).
                0016 C     It calls routines from other packages (\textit{eg.} rw and mnc)
                0017 C     to do the per-variable writes.
                0018
                0019 C     !USES:
                0020       IMPLICIT NONE
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
9fafc42509 Jean*0024 #include "RESTART.h"
92e77d50bf Jean*0025 #include "DYNVARS.h"
fdf5fb6af0 Jean*0026 #include "NH_VARS.h"
92e77d50bf Jean*0027 #include "SURFACE.h"
fd6656ef94 Jean*0028 #include "FFIELDS.h"
d6ed4854d6 Jean*0029 #ifdef ALLOW_GENERIC_ADVDIFF
                0030 # include "GAD.h"
                0031 #endif
92e77d50bf Jean*0032 #ifdef ALLOW_MNC
229ac9feb6 Jean*0033 # include "MNC_PARAMS.h"
92e77d50bf Jean*0034 #endif
eda0e8da44 Mich*0035 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
bcc58d6972 Mich*0036 # include "GMREDI.h"
                0037 #endif
92e77d50bf Jean*0038
                0039 C     !INPUT PARAMETERS:
                0040 C     permPickup      :: Is or is not a permanent pickup.
528fbbe5ca Jean*0041 C     suffix          :: pickup-name suffix
92e77d50bf Jean*0042 C     myTime          :: Current time of simulation ( s )
                0043 C     myIter          :: Iteration number
                0044 C     myThid          :: Thread number for this instance of the routine.
                0045       LOGICAL permPickup
4af7bf2738 Jean*0046       CHARACTER*(*) suffix
92e77d50bf Jean*0047       _RL     myTime
                0048       INTEGER myIter
                0049       INTEGER myThid
                0050 CEOP
                0051
                0052 C     !LOCAL VARIABLES:
d6ed4854d6 Jean*0053 C     fp          :: pickup-file precision
                0054 C     glf         :: local flag for "globalFiles"
                0055 C     fn          :: Temp. for building file name.
                0056 C     nWrFlds     :: number of fields being written
                0057 C     n3D         :: number of 3-D fields being written
                0058 C     listDim     :: dimension of "wrFldList" local array
                0059 C     wrFldList   :: list of written fields
                0060 C     m1,m2       :: 6.th dim index (AB-3) corresponding to time-step N-1 & N-2
                0061 C     j           :: loop index / field number
                0062 C     nj          :: record number
                0063 C     msgBuf      :: Informational/error message buffer
92e77d50bf Jean*0064       INTEGER fp
d6ed4854d6 Jean*0065       LOGICAL  glf
1706a6e971 Jean*0066       _RL      timList(1)
92e77d50bf Jean*0067       CHARACTER*(MAX_LEN_FNAM) fn
d6ed4854d6 Jean*0068       INTEGER listDim, nWrFlds, n3D
                0069       PARAMETER( listDim = 20 )
                0070       CHARACTER*(8) wrFldList(listDim)
                0071 #ifdef ALLOW_ADAMSBASHFORTH_3
                0072       INTEGER m1, m2
                0073 #endif
                0074       INTEGER j, nj
                0075       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0076 #ifndef ALLOW_GENERIC_ADVDIFF
                0077       LOGICAL AdamsBashforthGt
                0078       LOGICAL AdamsBashforthGs
                0079       LOGICAL AdamsBashforth_T
                0080       LOGICAL AdamsBashforth_S
                0081       PARAMETER ( AdamsBashforthGt = .FALSE. ,
                0082      &            AdamsBashforthGs = .FALSE. ,
                0083      &            AdamsBashforth_T = .FALSE. ,
                0084      &            AdamsBashforth_S = .FALSE. )
                0085 #endif
                0086
                0087 C-    Initialise:
                0088       DO j=1,listDim
                0089         wrFldList(j) = ' '
                0090       ENDDO
92e77d50bf Jean*0091
                0092 C     Write model fields
                0093
                0094 C     Going to really do some IO. Make everyone except master thread wait.
3365bdc872 Jean*0095 C     this is done within IO routines => no longer needed
                0096 c     _BARRIER
92e77d50bf Jean*0097
                0098       IF (pickup_write_mdsio) THEN
                0099
528fbbe5ca Jean*0100         WRITE(fn,'(A,A)') 'pickup.', suffix
92e77d50bf Jean*0101         fp = precFloat64
d6ed4854d6 Jean*0102         j  = 0
04b6a7043d Jean*0103 C     record number < 0 : a hack not to write meta files now:
92e77d50bf Jean*0104
04b6a7043d Jean*0105 C---  write State 3-D fields for restart
d6ed4854d6 Jean*0106         j = j + 1
                0107         CALL WRITE_REC_3D_RL( fn, fp, Nr, uVel,   -j, myIter, myThid )
                0108         IF (j.LE.listDim) wrFldList(j) = 'Uvel    '
                0109         j = j + 1
                0110         CALL WRITE_REC_3D_RL( fn, fp, Nr, vVel,   -j, myIter, myThid )
                0111         IF (j.LE.listDim) wrFldList(j) = 'Vvel    '
                0112
eda0e8da44 Mich*0113 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
bcc58d6972 Mich*0114         IF (GM_InMomAsStress) THEN
                0115           j = j + 1
fd6656ef94 Jean*0116           CALL WRITE_REC_3D_RL( fn, fp, Nr, uEulerMean,
                0117      &                                            -j, myIter, myThid )
                0118           IF (j.LE.listDim) wrFldList(j) = 'UEulerM '
bcc58d6972 Mich*0119           j = j + 1
fd6656ef94 Jean*0120           CALL WRITE_REC_3D_RL( fn, fp, Nr, vEulerMean,
                0121      &                                            -j, myIter, myThid )
                0122           IF (j.LE.listDim) wrFldList(j) = 'VEulerM '
bcc58d6972 Mich*0123       ENDIF
                0124 #endif
                0125
d6ed4854d6 Jean*0126         j = j + 1
                0127         CALL WRITE_REC_3D_RL( fn, fp, Nr, theta,  -j, myIter, myThid )
                0128         IF (j.LE.listDim) wrFldList(j) = 'Theta   '
                0129         j = j + 1
                0130         CALL WRITE_REC_3D_RL( fn, fp, Nr, salt,   -j, myIter, myThid )
                0131         IF (j.LE.listDim) wrFldList(j) = 'Salt    '
04b6a7043d Jean*0132 C---  write 3-D fields for AB-restart
92e77d50bf Jean*0133 #ifdef ALLOW_ADAMSBASHFORTH_3
fdf5fb6af0 Jean*0134
d6ed4854d6 Jean*0135         m1 = 1 + MOD(myIter+1,2)
                0136         m2 = 1 + MOD( myIter ,2)
04b6a7043d Jean*0137       IF ( momStepping ) THEN
                0138 C--   U velocity:
d6ed4854d6 Jean*0139        IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
                0140         j = j + 1
229ac9feb6 Jean*0141         CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm(1-OLx,1-OLy,1,1,1,m1),
d6ed4854d6 Jean*0142      &                                            -j, myIter, myThid )
                0143         IF (j.LE.listDim) wrFldList(j) = 'GuNm1   '
                0144        ENDIF
                0145        IF ( beta_AB.NE.0. ) THEN
                0146         j = j + 1
229ac9feb6 Jean*0147         CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm(1-OLx,1-OLy,1,1,1,m2),
d6ed4854d6 Jean*0148      &                                            -j, myIter, myThid )
                0149         IF (j.LE.listDim) wrFldList(j) = 'GuNm2   '
                0150        ENDIF
04b6a7043d Jean*0151 C--   V velocity:
d6ed4854d6 Jean*0152        IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
                0153         j = j + 1
229ac9feb6 Jean*0154         CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm(1-OLx,1-OLy,1,1,1,m1),
d6ed4854d6 Jean*0155      &                                            -j, myIter, myThid )
                0156         IF (j.LE.listDim) wrFldList(j) = 'GvNm1   '
                0157        ENDIF
                0158        IF ( beta_AB.NE.0. ) THEN
                0159         j = j + 1
229ac9feb6 Jean*0160         CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm(1-OLx,1-OLy,1,1,1,m2),
d6ed4854d6 Jean*0161      &                                            -j, myIter, myThid )
                0162         IF (j.LE.listDim) wrFldList(j) = 'GvNm2   '
                0163        ENDIF
04b6a7043d Jean*0164       ENDIF
                0165 C--   Temperature:
d6ed4854d6 Jean*0166       IF ( AdamsBashforthGt.OR.AdamsBashforth_T ) THEN
                0167        IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
                0168         j = j + 1
229ac9feb6 Jean*0169         CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm(1-OLx,1-OLy,1,1,1,m1),
d6ed4854d6 Jean*0170      &                                            -j, myIter, myThid )
                0171         IF (j.LE.listDim) THEN
                0172          IF ( AdamsBashforthGt ) wrFldList(j) = 'GtNm1   '
                0173          IF ( AdamsBashforth_T ) wrFldList(j) = 'TempNm1 '
                0174         ENDIF
                0175        ENDIF
                0176        IF ( beta_AB.NE.0. ) THEN
                0177         j = j + 1
229ac9feb6 Jean*0178         CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm(1-OLx,1-OLy,1,1,1,m2),
d6ed4854d6 Jean*0179      &                                            -j, myIter, myThid )
                0180         IF (j.LE.listDim) THEN
                0181          IF ( AdamsBashforthGt ) wrFldList(j) = 'GtNm2   '
                0182          IF ( AdamsBashforth_T ) wrFldList(j) = 'TempNm2 '
                0183         ENDIF
                0184        ENDIF
                0185       ENDIF
04b6a7043d Jean*0186 C--   Salinity:
d6ed4854d6 Jean*0187       IF ( AdamsBashforthGs.OR.AdamsBashforth_S ) THEN
                0188        IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
                0189         j = j + 1
229ac9feb6 Jean*0190         CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm(1-OLx,1-OLy,1,1,1,m1),
d6ed4854d6 Jean*0191      &                                            -j, myIter, myThid )
                0192         IF (j.LE.listDim) THEN
                0193          IF ( AdamsBashforthGs ) wrFldList(j) = 'GsNm1   '
                0194          IF ( AdamsBashforth_S ) wrFldList(j) = 'SaltNm1 '
                0195         ENDIF
                0196        ENDIF
                0197        IF ( beta_AB.NE.0. ) THEN
                0198         j = j + 1
229ac9feb6 Jean*0199         CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm(1-OLx,1-OLy,1,1,1,m2),
d6ed4854d6 Jean*0200      &                                            -j, myIter, myThid )
                0201         IF (j.LE.listDim) THEN
                0202          IF ( AdamsBashforthGs ) wrFldList(j) = 'GsNm2   '
                0203          IF ( AdamsBashforth_S ) wrFldList(j) = 'SaltNm2 '
                0204         ENDIF
                0205        ENDIF
                0206       ENDIF
cba4501825 Jean*0207 #ifdef ALLOW_NONHYDROSTATIC
                0208 C--   W velocity:
                0209       IF ( nonHydrostatic ) THEN
                0210        IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
                0211         j = j + 1
229ac9feb6 Jean*0212         CALL WRITE_REC_3D_RL( fn, fp, Nr, gwNm(1-OLx,1-OLy,1,1,1,m1),
cba4501825 Jean*0213      &                                            -j, myIter, myThid )
                0214         IF (j.LE.listDim) wrFldList(j) = 'GwNm1   '
                0215        ENDIF
                0216        IF ( beta_AB.NE.0. ) THEN
                0217         j = j + 1
229ac9feb6 Jean*0218         CALL WRITE_REC_3D_RL( fn, fp, Nr, gwNm(1-OLx,1-OLy,1,1,1,m2),
cba4501825 Jean*0219      &                                            -j, myIter, myThid )
                0220         IF (j.LE.listDim) wrFldList(j) = 'GwNm2   '
                0221        ENDIF
                0222       ENDIF
                0223 #endif /* ALLOW_NONHYDROSTATIC */
fdf5fb6af0 Jean*0224 #ifdef ALLOW_QHYD_STAGGER_TS
                0225 C--   Quasi-Hydrostatic Adams-Bashforth variables:
                0226       IF ( quasiHydrostatic .AND. staggerTimeStep ) THEN
                0227        IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
                0228         j = j + 1
                0229         CALL WRITE_REC_3D_RL( fn,fp, Nr, QHydGwNm(1-OLx,1-OLy,1,1,1,m1),
                0230      &                                            -j, myIter, myThid )
                0231         IF (j.LE.listDim) wrFldList(j) = 'QH_GwNm1'
                0232        ENDIF
                0233        IF ( beta_AB.NE.0. ) THEN
                0234         j = j + 1
                0235         CALL WRITE_REC_3D_RL( fn,fp, Nr, QHydGwNm(1-OLx,1-OLy,1,1,1,m2),
                0236      &                                            -j, myIter, myThid )
                0237         IF (j.LE.listDim) wrFldList(j) = 'QH_GwNm2'
                0238        ENDIF
                0239       ENDIF
                0240 #endif /* ALLOW_QHYD_STAGGER_TS */
                0241
92e77d50bf Jean*0242 #else /*  ALLOW_ADAMSBASHFORTH_3 */
fdf5fb6af0 Jean*0243
04b6a7043d Jean*0244        IF ( momStepping ) THEN
d6ed4854d6 Jean*0245         j = j + 1
                0246         CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm1,  -j, myIter, myThid )
                0247         IF (j.LE.listDim) wrFldList(j) = 'GuNm1   '
                0248         j = j + 1
                0249         CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm1,  -j, myIter, myThid )
                0250         IF (j.LE.listDim) wrFldList(j) = 'GvNm1   '
04b6a7043d Jean*0251        ENDIF
b4f60a0901 Jean*0252        IF ( AdamsBashforthGt.OR.AdamsBashforth_T ) THEN
d6ed4854d6 Jean*0253         j = j + 1
                0254         CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm1,  -j, myIter, myThid )
b4f60a0901 Jean*0255         IF (j.LE.listDim) THEN
                0256          IF ( AdamsBashforthGt ) wrFldList(j) = 'GtNm1   '
                0257          IF ( AdamsBashforth_T ) wrFldList(j) = 'TempNm1 '
                0258         ENDIF
d6ed4854d6 Jean*0259        ENDIF
b4f60a0901 Jean*0260        IF ( AdamsBashforthGs.OR.AdamsBashforth_S ) THEN
d6ed4854d6 Jean*0261         j = j + 1
                0262         CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm1,  -j, myIter, myThid )
b4f60a0901 Jean*0263         IF (j.LE.listDim) THEN
                0264          IF ( AdamsBashforthGs ) wrFldList(j) = 'GsNm1   '
                0265          IF ( AdamsBashforth_S ) wrFldList(j) = 'SaltNm1 '
                0266         ENDIF
d6ed4854d6 Jean*0267        ENDIF
cba4501825 Jean*0268 #ifdef ALLOW_NONHYDROSTATIC
                0269        IF ( nonHydrostatic ) THEN
                0270         j = j + 1
                0271         CALL WRITE_REC_3D_RL( fn, fp, Nr, gwNm1,  -j, myIter, myThid )
                0272         IF (j.LE.listDim) wrFldList(j) = 'GwNm1   '
                0273        ENDIF
                0274 #endif /* ALLOW_NONHYDROSTATIC */
fdf5fb6af0 Jean*0275 #ifdef ALLOW_QHYD_STAGGER_TS
                0276 C--   Quasi-Hydrostatic Adams-Bashforth variables:
                0277       IF ( quasiHydrostatic .AND. staggerTimeStep ) THEN
                0278         j = j + 1
                0279         CALL WRITE_REC_3D_RL( fn,fp, Nr, QHydGwNm, -j, myIter, myThid )
                0280         IF (j.LE.listDim) wrFldList(j) = 'QH_GwNm1'
                0281       ENDIF
                0282 #endif /* ALLOW_QHYD_STAGGER_TS */
                0283
92e77d50bf Jean*0284 #endif /*  ALLOW_ADAMSBASHFORTH_3 */
d6ed4854d6 Jean*0285
04b6a7043d Jean*0286 C-    write Full Pressure for EOS in pressure:
901f12b7bc Jean*0287        IF ( storePhiHyd4Phys ) THEN
d6ed4854d6 Jean*0288         j = j + 1
                0289         CALL WRITE_REC_3D_RL( fn, fp, Nr,totPhiHyd,-j,myIter, myThid )
                0290         IF (j.LE.listDim) wrFldList(j) = 'PhiHyd  '
                0291        ENDIF
92e77d50bf Jean*0292 #ifdef ALLOW_NONHYDROSTATIC
d6ed4854d6 Jean*0293        IF ( use3Dsolver ) THEN
                0294         j = j + 1
                0295         CALL WRITE_REC_3D_RL( fn, fp, Nr, phi_nh, -j, myIter, myThid )
                0296         IF (j.LE.listDim) wrFldList(j) = 'Phi_NHyd'
                0297        ENDIF
92e77d50bf Jean*0298 #endif /* ALLOW_NONHYDROSTATIC */
2d5bb917cc Jean*0299 #ifdef ALLOW_SMAG_3D_DIFFUSIVITY
                0300 C-    With synchronous time-stepping, Smag-3D diffusivity is lagging by 1 time-step
                0301 C     (i.e., used before being updated meaning field is from previous time-step calc)
                0302 C     --> needs to be stored in pickup file
                0303        IF ( smag3D_diffCoeff.GT.zeroRL .AND. .NOT.staggerTimeStep ) THEN
                0304         j = j + 1
                0305         CALL WRITE_REC_3D_RL( fn, fp, Nr, smag3D_diffK,
                0306      &                                            -j, myIter, myThid )
                0307         IF (j.LE.listDim) wrFldList(j) = 'SmagDiff'
                0308        ENDIF
                0309 #endif /* ALLOW_SMAG_3D_DIFFUSIVITY */
d2a11ab670 Jean*0310 #ifdef ALLOW_ADDFLUID
                0311 C-    write mass source/sink of fluid (but not needed if selectAddFluid=-1)
                0312        IF ( selectAddFluid.NE.0 ) THEN
                0313         j = j + 1
fd6656ef94 Jean*0314         CALL WRITE_REC_3D_RL( fn, fp, Nr, addMass,-j, myIter, myThid )
d2a11ab670 Jean*0315         IF (j.LE.listDim) wrFldList(j) = 'AddMass '
                0316        ENDIF
                0317 #endif /* ALLOW_ADDFLUID */
fd6656ef94 Jean*0318 #ifdef ALLOW_FRICTION_HEATING
                0319 C-    needs frictional heating when using synchronous time-stepping
                0320        IF ( addFrictionHeating .AND. .NOT.staggerTimeStep ) THEN
                0321         j = j + 1
                0322         CALL WRITE_REC_3D_RS( fn, fp, Nr, frictionHeating,
                0323      &                                            -j, myIter, myThid )
                0324         IF (j.LE.listDim) wrFldList(j) = 'FricHeat'
                0325        ENDIF
                0326 #endif /* ALLOW_FRICTION_HEATING */
92e77d50bf Jean*0327
d6ed4854d6 Jean*0328         n3D = j
04b6a7043d Jean*0329 C---  Write 2-D fields, starting with Eta:
d6ed4854d6 Jean*0330         j = j + 1
                0331         nj = -( n3D*(Nr-1) + j )
                0332         CALL WRITE_REC_3D_RL( fn, fp, 1 , etaN,   nj, myIter, myThid )
                0333         IF (j.LE.listDim) wrFldList(j) = 'EtaN    '
0320e25227 Mart*0334        IF ( usingPCoords .AND. useSEAICE ) THEN
                0335         j = j + 1
                0336         nj = -( n3D*(Nr-1) + j )
                0337         CALL WRITE_REC_3D_RL( fn, fp, 1, phiHydLow, nj,myIter,myThid )
                0338         IF (j.LE.listDim) wrFldList(j) = 'Phi_rLow'
                0339        ENDIF
cba4501825 Jean*0340 #ifdef ALLOW_NONHYDROSTATIC
                0341        IF ( selectNHfreeSurf.GE.1 ) THEN
                0342         j = j + 1
                0343         nj = -( n3D*(Nr-1) + j )
                0344         CALL WRITE_REC_3D_RL( fn, fp, 1, dPhiNH,  nj, myIter, myThid )
                0345         IF (j.LE.listDim) wrFldList(j) = 'dPhiNH  '
                0346        ENDIF
                0347 #endif /* ALLOW_NONHYDROSTATIC */
d6ed4854d6 Jean*0348 #ifdef EXACT_CONSERV
                0349 c      IF ( exactConserv ) THEN
                0350         j = j + 1
                0351         nj = -( n3D*(Nr-1) + j )
                0352         CALL WRITE_REC_3D_RL( fn, fp, 1, dEtaHdt, nj, myIter, myThid )
                0353         IF (j.LE.listDim) wrFldList(j) = 'dEtaHdt '
                0354 c      ENDIF
                0355 C- note: always write dEtaHdt & EtaH but read only if exactConserv & nonlinFreeSurf
                0356 C        this works only because nonlinFreeSurf > 0 => exactConserv=T
                0357 c      IF ( nonlinFreeSurf.GT.0 ) THEN
                0358         j = j + 1
                0359         nj = -( n3D*(Nr-1) + j )
                0360         CALL WRITE_REC_3D_RL( fn, fp, 1, etaHnm1, nj, myIter, myThid )
                0361         IF (j.LE.listDim) wrFldList(j) = 'EtaH    '
                0362 c      ENDIF
                0363 #endif /* EXACT_CONSERV */
                0364 C--------------------------
                0365         nWrFlds = j
                0366         IF ( nWrFlds.GT.listDim ) THEN
                0367           WRITE(msgBuf,'(2A,I5,A)') 'WRITE_PICKUP: ',
                0368      &     'trying to write ',nWrFlds,' fields'
                0369           CALL PRINT_ERROR( msgBuf, myThid )
                0370           WRITE(msgBuf,'(2A,I5,A)') 'WRITE_PICKUP: ',
                0371      &     'field-list dimension (listDim=',listDim,') too small'
                0372           CALL PRINT_ERROR( msgBuf, myThid )
                0373           STOP 'ABNORMAL END: S/R WRITE_PICKUP (list-size Pb)'
                0374         ENDIF
f0c86ab3b9 Jean*0375 #ifdef ALLOW_MDSIO
ff02675122 Jean*0376 C-    Note: temporary: since it is a pain to add more arguments to
d6ed4854d6 Jean*0377 C     all MDSIO S/R, uses instead this specific S/R to write only
                0378 C     meta files but with more informations in it.
                0379         nj = ABS(nj)
                0380         glf  = globalFiles
1706a6e971 Jean*0381         timList(1) = myTime
d6ed4854d6 Jean*0382         CALL MDS_WR_METAFILES( fn, fp, glf, .FALSE.,
                0383      &                         0, 0, 1, ' ',
                0384      &                         nWrFlds, wrFldList,
ba68d2f969 Jean*0385      &                         1, timList, oneRL,
d6ed4854d6 Jean*0386      &                         nj, myIter, myThid )
f0c86ab3b9 Jean*0387 #endif /* ALLOW_MDSIO */
d6ed4854d6 Jean*0388 C--------------------------
92e77d50bf Jean*0389       ENDIF
                0390
                0391 #ifdef ALLOW_MNC
                0392       IF (useMNC .AND. pickup_write_mnc) THEN
                0393         IF ( permPickup ) THEN
                0394           WRITE(fn,'(A)') 'pickup'
                0395         ELSE
                0396           WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
                0397         ENDIF
                0398 C       First ***define*** the file group name
                0399         CALL MNC_CW_SET_UDIM(fn, 0, myThid)
                0400         IF ( permPickup ) THEN
                0401           CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
                0402         ELSE
                0403           CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
                0404         ENDIF
                0405 C       Then set the actual unlimited dimension
                0406         CALL MNC_CW_SET_UDIM(fn, 1, myThid)
                0407         CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
                0408         CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
                0409         CALL MNC_CW_RL_W('D',fn,0,0,'U', uVel, myThid)
                0410         CALL MNC_CW_RL_W('D',fn,0,0,'V', vVel, myThid)
eda0e8da44 Mich*0411 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
bcc58d6972 Mich*0412         IF (GM_InMomAsStress) THEN
fd6656ef94 Jean*0413           CALL MNC_CW_RL_W('D',fn,0,0,'UEulerM', uEulerMean, myThid)
                0414           CALL MNC_CW_RL_W('D',fn,0,0,'VEulerM', vEulerMean, myThid)
bcc58d6972 Mich*0415         ENDIF
                0416 #endif
92e77d50bf Jean*0417         CALL MNC_CW_RL_W('D',fn,0,0,'Temp', theta, myThid)
                0418         CALL MNC_CW_RL_W('D',fn,0,0,'S', salt, myThid)
                0419         CALL MNC_CW_RL_W('D',fn,0,0,'Eta', etaN, myThid)
                0420 #ifndef ALLOW_ADAMSBASHFORTH_3
                0421         CALL MNC_CW_RL_W('D',fn,0,0,'gUnm1', guNm1, myThid)
                0422         CALL MNC_CW_RL_W('D',fn,0,0,'gVnm1', gvNm1, myThid)
                0423         CALL MNC_CW_RL_W('D',fn,0,0,'gTnm1', gtNm1, myThid)
                0424         CALL MNC_CW_RL_W('D',fn,0,0,'gSnm1', gsNm1, myThid)
                0425 #endif /* ALLOW_ADAMSBASHFORTH_3 */
                0426 #ifdef EXACT_CONSERV
                0427         CALL MNC_CW_RL_W('D',fn,0,0,'dEtaHdt', dEtaHdt, myThid)
                0428         CALL MNC_CW_RL_W('D',fn,0,0,'EtaH', etaHnm1, myThid)
                0429 #endif
                0430 #ifdef ALLOW_NONHYDROSTATIC
                0431         IF ( use3Dsolver ) THEN
                0432           CALL MNC_CW_RL_W('D',fn,0,0,'phi_nh', phi_nh, myThid)
                0433 c         CALL MNC_CW_RL_W('D',fn,0,0,'gW', gW, myThid)
cba4501825 Jean*0434 #ifndef ALLOW_ADAMSBASHFORTH_3
92e77d50bf Jean*0435           CALL MNC_CW_RL_W('D',fn,0,0,'gWnm1', gwNm1, myThid)
cba4501825 Jean*0436 #endif
92e77d50bf Jean*0437         ENDIF
                0438 #endif
901f12b7bc Jean*0439         IF ( storePhiHyd4Phys ) THEN
92e77d50bf Jean*0440           CALL MNC_CW_RL_W('D',fn,0,0,'phiHyd', totPhiHyd, myThid)
                0441         ENDIF
9ad36f5d9b Ed H*0442         CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
92e77d50bf Jean*0443       ENDIF
                0444 #endif /*  ALLOW_MNC  */
                0445
                0446 C--   Every one else must wait until writing is done.
3365bdc872 Jean*0447 C     this is done within IO routines => no longer needed
                0448 c     _BARRIER
92e77d50bf Jean*0449
                0450       RETURN
                0451       END