pkg/darwin/darwin_write_pickup.F

8fbfd1f382 Oliv*0001 #include "DARWIN_OPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: DARWIN_WRITE_PICKUP
                0005
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE DARWIN_WRITE_PICKUP( permPickup,
                0008      I                             suff, myTime, myIter, myThid )
                0009
                0010 C !DESCRIPTION:
                0011 C     Writes PAR_day array (needed for a restart) to a pickup file
                0012
                0013 C !USES: ===============================================================
                0014       IMPLICIT NONE
                0015 C     === Global variables ===
                0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
                0018 #include "PARAMS.h"
                0019 #include "PTRACERS_SIZE.h"
                0020 #include "PTRACERS_PARAMS.h"
                0021 #include "DARWIN_SIZE.h"
                0022 #include "DARWIN_FIELDS.h"
                0023
                0024 C !INPUT PARAMETERS: ===================================================
                0025 C     permPickup :: write a permanent pickup
                0026 C     suff       :: suffix for pickup file (eg. ckptA or 0000000010)
                0027 C     myTime     :: Current time in simulation
                0028 C     myIter     :: Current iteration number in simulation
                0029 C     myThid     :: My Thread Id number
                0030       LOGICAL permPickup
                0031       CHARACTER*(*) suff
                0032       _RL     myTime
                0033       INTEGER myIter
                0034       INTEGER myThid
                0035 CEOP
                0036
                0037 #ifdef ALLOW_DARWIN
                0038 C add more ALLOWs here for other fields in pickup
5bc6c7edbe Oliv*0039 #if defined(DARWIN_ALLOW_CARBON) || ((defined(DARWIN_ALLOW_GEIDER) || defined(ALLOW_RADTRANS)) && !defined(DARWIN_ALLOW_CHLQUOTA))
8fbfd1f382 Oliv*0040
                0041 C     !LOCAL VARIABLES:
                0042 C     == Local variables ==
                0043       CHARACTER*(MAX_LEN_FNAM) fn
                0044       LOGICAL glf
                0045       _RL     timList(1)
                0046       INTEGER prec, irec, ifld, np
                0047       INTEGER listDim, nWrFlds
                0048       PARAMETER( listDim = 1+nPhoto )
                0049       CHARACTER*(8) wrFldList(listDim)
                0050       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0051
                0052 c     IF ( DARWIN_pickup_write_mdsio ) THEN
                0053         prec = precFloat64
                0054         WRITE(fn,'(A,A)') 'pickup_darwin.',suff
                0055
                0056         ifld = 0
                0057         irec = 0
                0058
                0059 #ifdef DARWIN_ALLOW_CARBON
                0060         ifld = ifld + 1
                0061         irec = irec - 1
                0062         CALL WRITE_REC_3D_RL( fn, prec, nR, pH, irec, myIter, myThid )
                0063         IF (ifld.LE.listDim) wrFldList(ifld) = 'pH'
                0064 #endif
                0065
5bc6c7edbe Oliv*0066 #if (defined(DARWIN_ALLOW_GEIDER) || defined(ALLOW_RADTRANS)) && !defined(DARWIN_ALLOW_CHLQUOTA)
8fbfd1f382 Oliv*0067 #ifdef ALLOW_RADTRANS
                0068         DO np = 1, nPhoto
                0069         ifld = ifld + 1
                0070         irec = irec - 1
                0071         CALL WRITE_REC_3D_RL( fn, prec, nR,
                0072      &                        ChlPrev(1-OLx,1-OLy,1,1,1,np),
                0073      &                        irec, myIter, myThid )
                0074         IF (ifld.LE.listDim) THEN
                0075          wrFldList(ifld)(1:6) = 'ChlPhy'
                0076          wrFldList(ifld)(7:8) = PTRACERS_ioLabel(np)
                0077         ENDIF
                0078         ENDDO
                0079 #else
                0080         ifld = ifld + 1
                0081         irec = irec - 1
                0082         CALL WRITE_REC_3D_RL( fn, prec, nR, ChlPrev,
                0083      &                        irec, myIter, myThid )
                0084         IF (ifld.LE.listDim) THEN
                0085          wrFldList(ifld) = 'Chl'
                0086         ENDIF
                0087 #endif
                0088 #endif
                0089
                0090 C--------------------------
                0091         nWrFlds = ifld
                0092         IF ( nWrFlds.GT.listDim ) THEN
                0093           WRITE(msgBuf,'(2A,I5,A)') 'DARWIN_WRITE_PICKUP: ',
                0094      &     'trying to write ',nWrFlds,' fields'
                0095           CALL PRINT_ERROR( msgBuf, myThid )
                0096           WRITE(msgBuf,'(2A,I5,A)') 'DARWIN_WRITE_PICKUP: ',
                0097      &     'field-list dimension (listDim=',listDim,') too small'
                0098           CALL PRINT_ERROR( msgBuf, myThid )
                0099           STOP 'ABNORMAL END: S/R DARWIN_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         glf  = globalFiles
                0106         timList(1) = myTime
                0107         irec = ABS(irec)
                0108         CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE.,
                0109      &                         0, 0, nR, ' ',
                0110      &                         nWrFlds, wrFldList,
                0111      &                         1, timList, oneRL,
                0112      &                         irec, myIter, myThid )
                0113 #endif /* ALLOW_MDSIO */
                0114 C--------------------------
                0115
                0116 c     ENDIF /* DARWIN_pickup_write_mdsio */
                0117
                0118 #endif /*  need pickup  */
                0119 #endif /*  ALLOW_DARWIN  */
                0120
                0121       RETURN
                0122       END