/[MITgcm]/MITgcm/pkg/dic/dic_write_pickup.F
ViewVC logotype

Diff of /MITgcm/pkg/dic/dic_write_pickup.F

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

revision 1.2 by dfer, Fri Apr 4 21:37:06 2008 UTC revision 1.7 by jmc, Thu Aug 25 22:19:17 2011 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
 #include "GCHEM_OPTIONS.h"  
4  #include "DIC_OPTIONS.h"  #include "DIC_OPTIONS.h"
5    
6        SUBROUTINE DIC_WRITE_PICKUP( permPickup, suff,  CBOP
7       I                               myTime, myIter, myThid )  C !ROUTINE: DIC_WRITE_PICKUP
8    
9    C !INTERFACE: ==========================================================
10          SUBROUTINE DIC_WRITE_PICKUP( permPickup,
11         I                             suff, myTime, myIter, myThid )
12    
13    C !DESCRIPTION:
14    C     Writes DIC arrays (needed for a restart) to a pickup file
15    
16    C !USES: ===============================================================
17        IMPLICIT NONE        IMPLICIT NONE
18  C     === Global variables ===  C     === Global variables ===
19  #include "SIZE.h"  #include "SIZE.h"
20  #include "EEPARAMS.h"  #include "EEPARAMS.h"
21  #include "PARAMS.h"  #include "PARAMS.h"
22  #include "DIC_VARS.h"  #include "DIC_VARS.h"
23    #include "DIC_ATMOS.h"
24    
25  C     == Routine arguments ==  C !INPUT PARAMETERS: ===================================================
26  C     permPickup :: write a permanent pickup  C     permPickup :: write a permanent pickup
27  C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)  C     suff       :: suffix for pickup file (eg. ckptA or 0000000010)
28  C     myTime  :: Current time in simulation  C     myTime     :: Current time in simulation
29  C     myIter  :: Current iteration number in simulation  C     myIter     :: Current iteration number in simulation
30  C     myThid  :: My Thread Id number  C     myThid     :: My Thread Id number
31        LOGICAL permPickup        LOGICAL permPickup
32        CHARACTER*(*) suff        CHARACTER*(*) suff
33        _RL     myTime        _RL     myTime
34        INTEGER myIter        INTEGER myIter
35        INTEGER myThid        INTEGER myThid
36    CEOP
37    
38  #ifdef ALLOW_DIC  #ifdef ALLOW_DIC
 #ifdef DIC_BIOTIC  
39    
40  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
41  C     == Local variables ==  C     == Local variables ==
42        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
43        INTEGER prec        INTEGER prec
44  c     CHARACTER*(MAX_LEN_MBUF) msgBuf  #ifndef USE_ATMOSCO2
45  CEOP        INTEGER ioUnit
46          _RL tmpFld(2)
47          _RS dummyRS(1)
48    #endif
49    #ifdef DIC_BIOTIC
50          LOGICAL glf
51          _RL     timList(1)
52          INTEGER j, nj
53          INTEGER listDim, nWrFlds
54          PARAMETER( listDim = 2 )
55          CHARACTER*(8) wrFldList(listDim)
56          CHARACTER*(MAX_LEN_MBUF) msgBuf
57    #endif
58    
59    c     IF ( DIC_pickup_write_mdsio ) THEN
60            prec = precFloat64
61    
62    #ifndef USE_ATMOSCO2
63            IF ( dic_int1.EQ.3 ) THEN
64              WRITE(fn,'(A,A)') 'pickup_dic_co2atm.',suff
65              ioUnit = 0
66              tmpFld(1) = total_atmos_carbon
67              tmpFld(2) = atpco2
68    #ifdef ALLOW_MDSIO
69              CALL MDS_WRITEVEC_LOC(
70         I                         fn, prec, ioUnit,
71         I                         'RL', 2, tmpFld, dummyRS,
72         I                         0, 0, 1, myIter, myThid )
73    #endif
74            ENDIF
75    #endif /* ndef USE_ATMOSCO2 */
76    
77    #ifdef DIC_BIOTIC
78            WRITE(fn,'(A,A)') 'pickup_dic.',suff
79            j = 0
80    
81    C     Firstly, write 3-D fields as consecutive records,
82    
83    C-    switch to 2-D fields:
84            nj = -j*Nr
85    
86    C       record number < 0 : a hack not to write meta files now:
87            j = j + 1
88            nj = nj-1
89            CALL WRITE_REC_3D_RL( fn, prec, 1, pH, nj, myIter, myThid )
90            IF (j.LE.listDim) wrFldList(j) = 'DIC_pH2d'
91    
92    C--------------------------
93            nWrFlds = j
94            IF ( nWrFlds.GT.listDim ) THEN
95              WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
96         &     'trying to write ',nWrFlds,' fields'
97              CALL PRINT_ERROR( msgBuf, myThid )
98              WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
99         &     'field-list dimension (listDim=',listDim,') too small'
100              CALL PRINT_ERROR( msgBuf, myThid )
101              STOP 'ABNORMAL END: S/R DIC_WRITE_PICKUP (list-size Pb)'
102            ENDIF
103    
104    #ifdef ALLOW_MDSIO
105    C     uses this specific S/R to write (with more informations) only meta
106    C     files
107            j  = 1
108            nj = ABS(nj)
109            IF ( nWrFlds*Nr .EQ. nj ) THEN
110              j  = Nr
111              nj = nWrFlds
112            ENDIF
113            glf  = globalFiles
114            timList(1) = myTime
115            CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE.,
116         &                         0, 0, j, ' ',
117         &                         nWrFlds, wrFldList,
118         &                         1, timList,
119         &                         nj, myIter, myThid )
120    #endif /* ALLOW_MDSIO */
121    C--------------------------
122    
123        prec = precFloat64  #endif /* DIC_BIOTIC  */
       WRITE(fn,'(A,A)') 'pickup_dic.',suff  
124    
125        CALL WRITE_REC_3D_RL( fn, prec, 1, pH, 1, myIter, myThid )  c     ENDIF /* DIC_pickup_write_mdsio */
126    
127  #endif /*  DIC_BIOTIC  */  #endif /* ALLOW_DIC  */
 #endif /*  ALLOW_DIC  */  
128    
129        RETURN        RETURN
130        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22