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
d800a455f8 Jean*0079 C     Firstly, write 3-D fields as consecutive records,
                0080
                0081 C-    switch to 2-D fields:
                0082         nj = -j*Nr
                0083
                0084 C       record number < 0 : a hack not to write meta files now:
                0085         j = j + 1
                0086         nj = nj-1
                0087         CALL WRITE_REC_3D_RL( fn, prec, 1, pH, nj, myIter, myThid )
                0088         IF (j.LE.listDim) wrFldList(j) = 'DIC_pH2d'
                0089
                0090 C--------------------------
                0091         nWrFlds = j
                0092         IF ( nWrFlds.GT.listDim ) THEN
                0093           WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
                0094      &     'trying to write ',nWrFlds,' fields'
                0095           CALL PRINT_ERROR( msgBuf, myThid )
                0096           WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
                0097      &     'field-list dimension (listDim=',listDim,') too small'
                0098           CALL PRINT_ERROR( msgBuf, myThid )
                0099           STOP 'ABNORMAL END: S/R DIC_WRITE_PICKUP (list-size Pb)'
                0100         ENDIF
                0101
                0102 #ifdef ALLOW_MDSIO
                0103 C     uses this specific S/R to write (with more informations) only meta
                0104 C     files
                0105         j  = 1
                0106         nj = ABS(nj)
                0107         IF ( nWrFlds*Nr .EQ. nj ) THEN
                0108           j  = Nr
                0109           nj = nWrFlds
                0110         ENDIF
                0111         glf  = globalFiles
1706a6e971 Jean*0112         timList(1) = myTime
d800a455f8 Jean*0113         CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE.,
                0114      &                         0, 0, j, ' ',
                0115      &                         nWrFlds, wrFldList,
ba68d2f969 Jean*0116      &                         1, timList, oneRL,
d800a455f8 Jean*0117      &                         nj, myIter, myThid )
                0118 #endif /* ALLOW_MDSIO */
                0119 C--------------------------
                0120
175a18b00a Jean*0121 #endif /* DIC_BIOTIC  */
                0122
d800a455f8 Jean*0123 c     ENDIF /* DIC_pickup_write_mdsio */
7f407c2fb7 Davi*0124
175a18b00a Jean*0125 #endif /* ALLOW_DIC  */
7f407c2fb7 Davi*0126
                0127       RETURN
                0128       END