Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:37:36 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
c04db39328 Jean*0001 #include "ATM_CPL_OPTIONS.h"
a9cdd26a43 Jean*0002 
4ff1cd5702 Jean*0003 CBOP
                0004 C     !ROUTINE: CPL_WRITE_PICKUP
                0005 C     !INTERFACE:
a9cdd26a43 Jean*0006       SUBROUTINE CPL_WRITE_PICKUP(
cc04975b16 Jean*0007      I                             suff, myTime, myIter, myThid )
4ff1cd5702 Jean*0008 
                0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE CPL_WRITE_PICKUP
                0012 C     | o Store coupling state for restart.
                0013 C     | - Atmospheric version -
                0014 C     *==========================================================*
                0015 C     \ev
                0016 
                0017 C     !USES:
a9cdd26a43 Jean*0018       IMPLICIT NONE
                0019 
                0020 C     == Global variables ==
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
c04db39328 Jean*0024 #include "CPL_PARAMS.h"
a9cdd26a43 Jean*0025 #include "ATMCPL.h"
                0026 
4ff1cd5702 Jean*0027 C     !INPUT/OUTPUT PARAMETERS:
a9cdd26a43 Jean*0028 C     == Routine arguments ==
cc04975b16 Jean*0029 C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
                0030 C     myTime  :: Current time in simulation
                0031 C     myIter  :: Current iteration number in simulation
                0032 C     myThid  :: My Thread Id number
                0033       CHARACTER*(*) suff
                0034       _RL     myTime
4ff1cd5702 Jean*0035       INTEGER myIter
                0036       INTEGER myThid
                0037 CEOP
a9cdd26a43 Jean*0038 
5a2fc21c93 Jean*0039 #ifdef COMPONENT_MODULE
d1469cc589 Jean*0040 C     === Functions ====
                0041       INTEGER  ILNBLNK
                0042       EXTERNAL ILNBLNK
                0043 
                0044 C !LOCAL VARIABLES: ====================================================
                0045 C     j           :: loop index / field number
                0046 C     nj          :: record number
                0047 C     fp          :: pickup-file precision
                0048 C     glf         :: local flag for "globalFiles"
                0049 C     fn          :: character buffer for creating filename
                0050 C     nWrFlds     :: number of fields being written
                0051 C     listDim     :: dimension of "wrFldList" local array
                0052 C     wrFldList   :: list of written fields
                0053 C     msgBuf      :: Informational/error message buffer
                0054       INTEGER j, nj, fp, lChar
                0055       LOGICAL glf
                0056       _RL     timList(1)
a9cdd26a43 Jean*0057       CHARACTER*(MAX_LEN_FNAM) fn
d1469cc589 Jean*0058       INTEGER listDim, nWrFlds
                0059       PARAMETER( listDim = 18 )
                0060       CHARACTER*(8) wrFldList(listDim)
                0061       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0062 CEOP
                0063 
                0064       lChar = ILNBLNK(suff)
                0065       IF ( lChar.EQ.0 ) THEN
                0066         WRITE(fn,'(2A)') 'pickup_cpl'
                0067       ELSE
                0068         WRITE(fn,'(2A)') 'pickup_cpl.',suff(1:lChar)
                0069       ENDIF
                0070       fp = precFloat64
                0071       j  = 0
                0072 
                0073 C-    Firstly, write 3-D fields as consecutive records
                0074 C-    Then switch to 2-D fields:
                0075 c       nj = -j*Nr
                0076 C     record number < 0 : a hack not to write meta files now:
                0077 c       nj = nj-1
                0078         j = j + 1
                0079         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0080      &                        HeatFlux  , -j, myIter, myThid )
                0081         IF (j.LE.listDim) wrFldList(j) = 'qHeatFlx'
                0082 
                0083         j = j + 1
                0084         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0085      &                        qShortWave, -j, myIter, myThid )
                0086         IF (j.LE.listDim) wrFldList(j) = 'qShortW '
5a2fc21c93 Jean*0087 
d1469cc589 Jean*0088         j = j + 1
                0089         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0090      &                        tauX      , -j, myIter, myThid )
                0091         IF (j.LE.listDim) wrFldList(j) = 'surfTauX'
                0092 
                0093         j = j + 1
                0094         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0095      &                        tauY      , -j, myIter, myThid )
                0096         IF (j.LE.listDim) wrFldList(j) = 'surfTauY'
                0097 
                0098         j = j + 1
                0099         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0100      &                        EvMPrFlux , -j, myIter, myThid )
                0101         IF (j.LE.listDim) wrFldList(j) = 'Evp-Prec'
                0102 
                0103 #ifdef ALLOW_LAND
                0104       IF ( atm_cplExch_RunOff ) THEN
                0105         j = j + 1
                0106         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0107      &                        RunOffFlux, -j, myIter, myThid )
                0108         IF (j.LE.listDim) wrFldList(j) = 'RunOffFx'
                0109         j = j + 1
                0110         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0111      &                        RunOffEnFx, -j, myIter, myThid )
                0112         IF (j.LE.listDim) wrFldList(j) = 'RnOfEnFx'
                0113       ENDIF
                0114 #endif /* ALLOW_LAND */
                0115 #ifdef ALLOW_THSICE
                0116       IF ( atm_cplExch1W_sIce ) THEN
                0117         j = j + 1
                0118         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0119      &                        iceSaltFlx, -j, myIter, myThid )
                0120         IF (j.LE.listDim) wrFldList(j) = 'saltFlux'
                0121       ENDIF
c121b6d611 Jean*0122       IF ( atm_cplExch_SaltPl ) THEN
                0123         j = j + 1
                0124         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0125      &                        saltPlmFlx_cpl, -j, myIter, myThid )
                0126         IF (j.LE.listDim) wrFldList(j) = 'sltPlmFx'
                0127       ENDIF
d1469cc589 Jean*0128 #endif /* ALLOW_THSICE */
                0129 #ifdef ALLOW_AIM
c04db39328 Jean*0130       IF ( atm_cplExch_DIC ) THEN
d1469cc589 Jean*0131         j = j + 1
                0132         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0133      &                        airCO2    , -j, myIter, myThid )
                0134         IF (j.LE.listDim) wrFldList(j) = 'atm-CO2 '
                0135         j = j + 1
                0136         CALL WRITE_REC_3D_RL( fn, fp, 1,
                0137      &                        sWSpeed   , -j, myIter, myThid )
                0138         IF (j.LE.listDim) wrFldList(j) = 'wndSpeed'
4ff1cd5702 Jean*0139       ENDIF
d1469cc589 Jean*0140 #endif /* ALLOW_AIM */
                0141 C-    with only 2-D fields:
                0142         nj = -j
                0143 
                0144 C--------------------------
                0145         nWrFlds = j
                0146         IF ( nWrFlds.GT.listDim ) THEN
                0147           WRITE(msgBuf,'(2A,I5,A)') 'CPL_WRITE_PICKUP: ',
                0148      &     'trying to write ',nWrFlds,' fields'
                0149           CALL PRINT_ERROR( msgBuf, myThid )
                0150           WRITE(msgBuf,'(2A,I5,A)') 'CPL_WRITE_PICKUP: ',
                0151      &     'field-list dimension (listDim=',listDim,') too small'
                0152           CALL PRINT_ERROR( msgBuf, myThid )
                0153           CALL ALL_PROC_DIE( myThid )
                0154           STOP 'ABNORMAL END: S/R CPL_WRITE_PICKUP (list-size Pb)'
                0155         ENDIF
                0156 #ifdef ALLOW_MDSIO
                0157 C     uses this specific S/R to write (with more informations) only meta files
                0158         j  = 1
                0159         nj = ABS(nj)
                0160         IF ( nWrFlds*Nr .EQ. nj ) THEN
                0161           j  = Nr
                0162           nj = nWrFlds
                0163         ENDIF
                0164         glf  = globalFiles
                0165         timList(1) = myTime
                0166         CALL MDS_WR_METAFILES( fn, fp, glf, .FALSE.,
                0167      &                         0, 0, j, ' ',
                0168      &                         nWrFlds, wrFldList,
                0169      &                         1, timList, oneRL,
                0170      &                         nj, myIter, myThid )
                0171 #endif /* ALLOW_MDSIO */
                0172 C--------------------------
                0173 
5a2fc21c93 Jean*0174 #endif /* COMPONENT_MODULE */
a9cdd26a43 Jean*0175 
                0176       RETURN
                0177       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!