pkg/dic/dic_write_pickup.F

7f407c2fb7 Davi*0001 #include "DIC_OPTIONS.h"
                0002
6ac17d82f2 Jean*0003 CBOP
                0004 C !ROUTINE: DIC_WRITE_PICKUP
7f407c2fb7 Davi*0005
6ac17d82f2 Jean*0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE DIC_WRITE_PICKUP( permPickup,
                0008      I                             suff, myTime, myIter, myThid )
                0009
                0010 C !DESCRIPTION:
                0011 C     Writes DIC arrays (needed for a restart) to a pickup file
                0012
                0013 C !USES: ===============================================================
7f407c2fb7 Davi*0014       IMPLICIT NONE
                0015 C     === Global variables ===
                0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
                0018 #include "PARAMS.h"
2ef8966791 Davi*0019 #include "DIC_VARS.h"
175a18b00a Jean*0020 #include "DIC_ATMOS.h"
7f407c2fb7 Davi*0021
6ac17d82f2 Jean*0022 C !INPUT PARAMETERS: ===================================================
7f407c2fb7 Davi*0023 C     permPickup :: write a permanent pickup
6ac17d82f2 Jean*0024 C     suff       :: suffix for pickup file (eg. ckptA or 0000000010)
                0025 C     myTime     :: Current time in simulation
                0026 C     myIter     :: Current iteration number in simulation
                0027 C     myThid     :: My Thread Id number
7f407c2fb7 Davi*0028       LOGICAL permPickup
                0029       CHARACTER*(*) suff
                0030       _RL     myTime
                0031       INTEGER myIter
                0032       INTEGER myThid
6ac17d82f2 Jean*0033 CEOP
7f407c2fb7 Davi*0034
                0035 #ifdef ALLOW_DIC
                0036
                0037 C     !LOCAL VARIABLES:
                0038 C     == Local variables ==
                0039       CHARACTER*(MAX_LEN_FNAM) fn
175a18b00a Jean*0040       INTEGER prec
                0041       INTEGER ioUnit
aef6063cdf Jean*0042       _RL tmpFld(2)
175a18b00a Jean*0043       _RS dummyRS(1)
                0044 #ifdef DIC_BIOTIC
d800a455f8 Jean*0045       LOGICAL glf
1706a6e971 Jean*0046       _RL     timList(1)
175a18b00a Jean*0047       INTEGER j, nj
d800a455f8 Jean*0048       INTEGER listDim, nWrFlds
                0049       PARAMETER( listDim = 2 )
                0050       CHARACTER*(8) wrFldList(listDim)
                0051       CHARACTER*(MAX_LEN_MBUF) msgBuf
175a18b00a Jean*0052 #endif
                0053
d800a455f8 Jean*0054 c     IF ( DIC_pickup_write_mdsio ) THEN
                0055         prec = precFloat64
175a18b00a Jean*0056
                0057         IF ( dic_int1.EQ.3 ) THEN
                0058           WRITE(fn,'(A,A)') 'pickup_dic_co2atm.',suff
                0059           ioUnit = 0
0701be6da6 Jean*0060 #ifdef ALLOW_OPENAD
                0061           tmpFld(1) = total_atmos_carbon%v
                0062           tmpFld(2) = atpco2%v
                0063 #else /* ALLOW_OPENAD */
aef6063cdf Jean*0064           tmpFld(1) = total_atmos_carbon
                0065           tmpFld(2) = atpco2
0701be6da6 Jean*0066 #endif /* ALLOW_OPENAD */
175a18b00a Jean*0067 #ifdef ALLOW_MDSIO
                0068           CALL MDS_WRITEVEC_LOC(
                0069      I                         fn, prec, ioUnit,
aef6063cdf Jean*0070      I                         'RL', 2, tmpFld, dummyRS,
175a18b00a Jean*0071      I                         0, 0, 1, myIter, myThid )
                0072 #endif
                0073         ENDIF
                0074
                0075 #ifdef DIC_BIOTIC
d800a455f8 Jean*0076         WRITE(fn,'(A,A)') 'pickup_dic.',suff
                0077         j = 0
7f407c2fb7 Davi*0078
ae2be6150b Jona*0079 C--   write DIC 3-D fields for restart
                0080 #ifdef DIC_CALCITE_SAT
                0081         IF ( useCalciteSaturation ) THEN
                0082          j = j + 1
                0083 C       record number < 0 : a hack not to write meta files now:
                0084          CALL WRITE_REC_3D_RL( fn, prec, Nr, pH3D, -j, myIter, myThid )
                0085          IF (j.LE.listDim) wrFldList(j) = 'DIC_pH3d'
                0086         ENDIF
                0087 #endif
d800a455f8 Jean*0088
                0089 C-    switch to 2-D fields:
                0090         nj = -j*Nr
                0091
ae2be6150b Jona*0092 C--   write DIC 2-D fields for restart
d800a455f8 Jean*0093         j = j + 1
                0094         nj = nj-1
                0095         CALL WRITE_REC_3D_RL( fn, prec, 1, pH, nj, myIter, myThid )
                0096         IF (j.LE.listDim) wrFldList(j) = 'DIC_pH2d'
                0097
                0098 C--------------------------
                0099         nWrFlds = j
                0100         IF ( nWrFlds.GT.listDim ) THEN
                0101           WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
                0102      &     'trying to write ',nWrFlds,' fields'
                0103           CALL PRINT_ERROR( msgBuf, myThid )
                0104           WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
                0105      &     'field-list dimension (listDim=',listDim,') too small'
                0106           CALL PRINT_ERROR( msgBuf, myThid )
                0107           STOP 'ABNORMAL END: S/R DIC_WRITE_PICKUP (list-size Pb)'
                0108         ENDIF
                0109
                0110 #ifdef ALLOW_MDSIO
                0111 C     uses this specific S/R to write (with more informations) only meta
                0112 C     files
                0113         j  = 1
                0114         nj = ABS(nj)
                0115         IF ( nWrFlds*Nr .EQ. nj ) THEN
                0116           j  = Nr
                0117           nj = nWrFlds
                0118         ENDIF
                0119         glf  = globalFiles
1706a6e971 Jean*0120         timList(1) = myTime
d800a455f8 Jean*0121         CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE.,
                0122      &                         0, 0, j, ' ',
                0123      &                         nWrFlds, wrFldList,
ba68d2f969 Jean*0124      &                         1, timList, oneRL,
d800a455f8 Jean*0125      &                         nj, myIter, myThid )
                0126 #endif /* ALLOW_MDSIO */
                0127 C--------------------------
                0128
175a18b00a Jean*0129 #endif /* DIC_BIOTIC  */
                0130
d800a455f8 Jean*0131 c     ENDIF /* DIC_pickup_write_mdsio */
7f407c2fb7 Davi*0132
175a18b00a Jean*0133 #endif /* ALLOW_DIC  */
7f407c2fb7 Davi*0134
                0135       RETURN
                0136       END