/[MITgcm]/MITgcm/pkg/ptracers/ptracers_write_pickup.F
ViewVC logotype

Diff of /MITgcm/pkg/ptracers/ptracers_write_pickup.F

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

revision 1.4 by jmc, Mon Nov 5 18:48:04 2007 UTC revision 1.5 by jmc, Mon Dec 17 22:05:48 2007 UTC
# Line 20  C !USES: =============================== Line 20  C !USES: ===============================
20  #include "PARAMS.h"  #include "PARAMS.h"
21  #include "PTRACERS_SIZE.h"  #include "PTRACERS_SIZE.h"
22  #include "PTRACERS_PARAMS.h"  #include "PTRACERS_PARAMS.h"
23    #include "PTRACERS_RESTART.h"
24  #include "PTRACERS_FIELDS.h"  #include "PTRACERS_FIELDS.h"
25    
26  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
# Line 44  C     === Functions ==== Line 45  C     === Functions ====
45        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
46    
47  C !LOCAL VARIABLES: ====================================================  C !LOCAL VARIABLES: ====================================================
48  C  iTracer              :: loop indices  C     iTracer     :: tracer index
49  C  iRec                 :: record number  C     j           :: loop index / field number
50  C  fn                   :: character buffer for creating filename  C     prec        :: pickup-file precision
51  C  prec                 :: precision of pickup files  C     glf         :: local flag for "globalFiles"
52        INTEGER iTracer,prec,iRec,lChar  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 iTracer, j, prec, lChar
58          LOGICAL glf
59        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
60          INTEGER listDim, nWrFlds
61          PARAMETER( listDim = 3*PTRACERS_num )
62          CHARACTER*(8) wrFldList(listDim)
63          CHARACTER*(MAX_LEN_MBUF) msgBuf
64  CEOP  CEOP
65    
66  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
# Line 98  C       step since we're saving the gpTr Line 109  C       step since we're saving the gpTr
109          ENDIF          ENDIF
110          prec = precFloat64          prec = precFloat64
111    
112  C       Write fields & tendencies (needed for AB) as consecutive  C       Firstly, write ptracer fields as consecutive records,
113  C       records, one tracer after the other, for all available tracers.  C       one tracer after the other, for all tracers "InUse".
114  C       note: this allow to restart from a pickup with a different  
115  C       number of tracers, with read_pickup reading only the tracers          j  = 0
116  C       "InUse".  C     record number < 0 : a hack not to write meta files now:
117          DO iTracer=1,PTRACERS_num          DO iTracer = 1, PTRACERS_numInUse
118            iRec = 2*iTracer - 1            j = j + 1
119            CALL WRITE_REC_3D_RL( fn, prec, Nr,            CALL WRITE_REC_3D_RL( fn, prec, Nr,
120       &         pTracer(1-Olx,1-Oly,1,1,1,iTracer),       &         pTracer(1-Olx,1-Oly,1,1,1,iTracer),
121       &         iRec, myIter, myThid )       &         -j, myIter, myThid )
122            iRec = 2*iTracer            IF (j.LE.listDim)
123         &      wrFldList(j) = 'pTr'//PTRACERS_ioLabel(iTracer)//'   '
124            ENDDO
125    
126    C       Then write ptracer tendencies (if this tracer is using AB time-stepping)
127            DO iTracer = 1, PTRACERS_numInUse
128             IF ( PTRACERS_AdamsBashGtr(iTracer) ) THEN
129              j = j + 1
130            CALL WRITE_REC_3D_RL( fn, prec, Nr,            CALL WRITE_REC_3D_RL( fn, prec, Nr,
131       &         gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),       &         gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
132       &         iRec, myIter, myThid )       &         -j, myIter, myThid )
133              IF (j.LE.listDim)
134         &      wrFldList(j) = 'gPtr'//PTRACERS_ioLabel(iTracer)//'m1'
135             ENDIF
136    
137          ENDDO          ENDDO
138    
139    C--------------------------
140            nWrFlds = j
141            IF ( nWrFlds.GT.listDim ) THEN
142              WRITE(msgBuf,'(2A,I5,A)') 'PTRACERS_WRITE_PICKUP: ',
143         &     'trying to write ',nWrFlds,' fields'
144              CALL PRINT_ERROR( msgBuf, myThid )
145              WRITE(msgBuf,'(2A,I5,A)') 'PTRACERS_WRITE_PICKUP: ',
146         &     'field-list dimension (listDim=',listDim,') too small'
147              CALL PRINT_ERROR( msgBuf, myThid )
148              STOP 'ABNORMAL END: S/R PTRACERS_WRITE_PICKUP (list-size Pb)'
149            ENDIF
150    #ifdef ALLOW_MDSIO
151    C     uses this specific S/R to write (with more informations) only meta files
152            glf  = globalFiles
153            CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE.,
154         &                         0, 0, Nr, ' ',
155         &                         nWrFlds, wrFldList,
156         &                         1, myTime,
157         &                         j, myIter, myThid )
158    #endif /* ALLOW_MDSIO */
159    C--------------------------
160        ENDIF        ENDIF
161    
162  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22