pkg/shelfice/shelfice_write_pickup.F

198f6904ea Dani*0001 #include "SHELFICE_OPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: SHELFICE_WRITE_PICKUP
                0005
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE SHELFICE_WRITE_PICKUP( permPickup,
                0008      &                    suff, myTime, myIter, myThid )
                0009
                0010 C !DESCRIPTION:
                0011 C     Writes current state of passive tracers to a pickup file
                0012
                0013 C !USES: ===============================================================
                0014       IMPLICIT NONE
                0015 #include "SIZE.h"
                0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
                0018 #include "SHELFICE.h"
                0019
                0020 C !INPUT PARAMETERS: ===================================================
                0021 C     permPickup      :: write a permanent pickup
                0022 C     suff            :: suffix for pickup file (eg. ckptA or 0000000010)
                0023 C     myTime          :: model time
                0024 C     myIter          :: time-step number
                0025 C     myThid          :: thread number
                0026       LOGICAL permPickup
                0027       CHARACTER*(*) suff
                0028       _RL myTime
                0029       INTEGER myIter
                0030       INTEGER myThid
                0031
                0032 C !OUTPUT PARAMETERS: ==================================================
                0033 C  none
                0034
                0035 #ifdef ALLOW_SHELFICE
                0036 C     === Functions ====
                0037       INTEGER  ILNBLNK
                0038       EXTERNAL ILNBLNK
                0039
                0040 C !LOCAL VARIABLES: ====================================================
                0041 C     j           :: loop index / field number
                0042 C     nj          :: record number
                0043 C     fp          :: pickup-file precision
                0044 C     glf         :: local flag for "globalFiles"
                0045 C     fn          :: character buffer for creating filename
                0046 C     nWrFlds     :: number of fields being written
                0047 C     listDim     :: dimension of "wrFldList" local array
                0048 C     wrFldList   :: list of written fields
                0049 C     msgBuf      :: Informational/error message buffer
                0050       INTEGER j, nj, fp, lChar
                0051       LOGICAL glf
                0052       _RL     timList(1)
                0053       CHARACTER*(MAX_LEN_FNAM) fn
                0054       INTEGER listDim, nWrFlds
                0055       PARAMETER( listDim = 12 )
                0056       CHARACTER*(8) wrFldList(listDim)
                0057       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0058 CEOP
                0059
9952f046d7 dngo*0060       IF ( SHELFICEMassStepping .OR.
                0061      &     SHELFICEremeshFrequency.GT.zeroRL ) THEN
198f6904ea Dani*0062         lChar = ILNBLNK(suff)
                0063         IF ( lChar.EQ.0 ) THEN
                0064           WRITE(fn,'(2A)') 'pickup_shelfice'
                0065         ELSE
                0066           WRITE(fn,'(2A)') 'pickup_shelfice.',suff(1:lChar)
                0067         ENDIF
                0068         fp = precFloat64
                0069         j  = 0
                0070
                0071 C       Firstly, write 3-D fields as consecutive records,
                0072
                0073 C-    switch to 2-D fields:
                0074         nj = -j*Nr
                0075
9952f046d7 dngo*0076       IF ( SHELFICEMassStepping ) THEN
                0077
198f6904ea Dani*0078         j = j + 1
                0079         nj = nj-1
                0080         CALL WRITE_REC_3D_RL( fn, fp, 1, ShelficeMass,
                0081      &                        nj, myIter, myThid )
                0082         IF (j.LE.listDim) wrFldList(j) = 'SHI_mass'
                0083
9952f046d7 dngo*0084       ENDIF ! SHELFICEMassStepping
                0085
                0086 #ifdef ALLOW_SHELFICE_REMESHING
                0087       IF ( SHELFICEremeshFrequency.GT.zeroRL ) THEN
                0088
                0089         j = j + 1
                0090         nj = nj-1
3b86795949 Jean*0091         CALL WRITE_REC_3D_RS( fn, fp, 1, R_shelfIce,
9952f046d7 dngo*0092      &                        nj, myIter, myThid )
                0093         IF (j.LE.listDim) wrFldList(j) = 'R_Shelfi'
                0094
                0095       ENDIF ! shelfice-remeshing
                0096 #endif /* ALLOW_SHELFICE_REMESHING */
198f6904ea Dani*0097
                0098 C--------------------------
                0099         nWrFlds = j
                0100         IF ( nWrFlds.GT.listDim ) THEN
                0101           WRITE(msgBuf,'(2A,I5,A)') 'SHELFICE_WRITE_PICKUP: ',
                0102      &     'trying to write ',nWrFlds,' fields'
                0103           CALL PRINT_ERROR( msgBuf, myThid )
                0104           WRITE(msgBuf,'(2A,I5,A)') 'SHELFICE_WRITE_PICKUP: ',
                0105      &     'field-list dimension (listDim=',listDim,') too small'
                0106           CALL PRINT_ERROR( msgBuf, myThid )
                0107           CALL ALL_PROC_DIE( myThid )
                0108           STOP 'ABNORMAL END: S/R SHELFICE_WRITE_PICKUP (list-size Pb)'
                0109         ENDIF
                0110 #ifdef ALLOW_MDSIO
                0111 C     uses this specific S/R to write (with more informations) only meta files
                0112         j  = 1
                0113         nj = ABS(nj)
                0114         IF ( nWrFlds*Nr .EQ. nj ) THEN
                0115           j  = Nr
                0116           nj = nWrFlds
                0117         ENDIF
                0118         glf  = globalFiles
                0119         timList(1) = myTime
                0120         CALL MDS_WR_METAFILES( fn, fp, glf, .FALSE.,
                0121      &                         0, 0, j, ' ',
                0122      &                         nWrFlds, wrFldList,
                0123      &                         1, timList, oneRL,
                0124      &                         nj, myIter, myThid )
                0125 #endif /* ALLOW_MDSIO */
                0126 C--------------------------
9952f046d7 dngo*0127       ENDIF
198f6904ea Dani*0128
                0129 #endif /* ALLOW_SHELFICE */
                0130
                0131       RETURN
                0132       END