pkg/ecco/stergloh_output.F

906a61c194 Ou W*0001 #include "ECCO_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C !ROUTINE: STERGLOH_OUTPUT
                0006
                0007 C !INTERFACE:
                0008       SUBROUTINE STERGLOH_OUTPUT( myTime, myIter, myThid )
                0009
                0010 C !DESCRIPTION: \bv
                0011 C     *==========================================================*
                0012 C     | SUBROUTINE STERGLOH_OUTPUT
                0013 C     | o Ouput the global steric height change (Greatbatch correction)
                0014 C     *==========================================================*
                0015
                0016 C !USES:
                0017       IMPLICIT NONE
                0018 C     === Global variables ===
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0023 # include "ECCO_SIZE.h"
                0024 # include "ECCO.h"
906a61c194 Ou W*0025 #endif
                0026
                0027 C !INPUT PARAMETERS:
                0028 C     myTime    :: my time in simulation ( s )
                0029 C     myIter    :: my Iteration number
                0030 C     myThid    :: my Thread Id number
                0031       _RL     myTime
                0032       INTEGER myIter
                0033       INTEGER myThid
                0034
                0035 #ifdef ALLOW_ECCO
                0036 #ifdef ALLOW_PSBAR_STERIC
                0037
                0038 C !FUNCTIONS:
                0039 c     LOGICAL  DIFFERENT_MULTIPLE
                0040 c     EXTERNAL DIFFERENT_MULTIPLE
                0041
                0042 C--   Local variables shared by S/R within this file (stergloh_output.F)
                0043 C     IOunit_outpFile :: IO-unit of binary output file
                0044       INTEGER IOunit_outpFile
                0045       COMMON /STERGLOH_OUTPUT_LOCAL/ IOunit_outpFile
                0046
                0047 C !LOCAL VARIABLES:
                0048 C     fName     :: output file name
                0049 C     msgBuf    :: Informational/error message buffer
                0050       CHARACTER*(10) suff
                0051       CHARACTER*(MAX_LEN_FNAM) fName
                0052       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0053       INTEGER irecord
                0054       INTEGER ioUnit
753b4aeb66 Jean*0055       _RL     tmpVar(1)
906a61c194 Ou W*0056       _RS     dummyRS(1)
                0057
                0058 C-----------------------------------------------------------------
                0059 C     Save the global mean steric heigt change at every time step
                0060 C-----------------------------------------------------------------
                0061
                0062       IF ( ecco_output_sterGloH ) THEN
                0063         irecord = myIter - nIter0 + 1
                0064
                0065 #ifdef ALLOW_MDSIO
                0066         IF ( rwSuffixType.EQ.0 ) THEN
                0067           WRITE(fName,'(A,I10.10)') 'sterGloH_global.', nIter0
                0068         ELSE
                0069           CALL RW_GET_SUFFIX( suff, startTime, nIter0, myThid )
                0070           WRITE(fName,'(A,A)') 'sterGloH_global.', suff
                0071         ENDIF
                0072
                0073         IF ( ecco_keepTSeriesOutp_open ) THEN
                0074           IF ( myIter .EQ. nIter0 ) THEN
                0075 C-    to open new IO unit and keep it open
                0076             ioUnit = -1
                0077           ELSE
                0078 C-    to write to already open IO unit
                0079             ioUnit = IOunit_outpFile
                0080           ENDIF
                0081 C-    skip writing meta file (unless last time to write to file)
                0082           IF ( myIter .NE. nEndIter ) irecord = -irecord
                0083         ELSE
                0084 C-    to open new IO unit, write and close it all within same call
                0085           ioUnit  = 0
                0086         ENDIF
                0087
753b4aeb66 Jean*0088         tmpVar(1) = sterGloH
906a61c194 Ou W*0089         CALL MDS_WRITEVEC_LOC(
                0090      I             fName, precFloat64, ioUnit,
753b4aeb66 Jean*0091      I             'RL', 1, tmpVar, dummyRS,
906a61c194 Ou W*0092      I             0, 0, irecord, myIter, myThid )
                0093
                0094         IF ( ecco_keepTSeriesOutp_open ) THEN
                0095 C-      multi-threaded: only master-thread save IO-unit to shared variable
                0096 C                 (in common block) and close open file (after last write)
                0097           _BEGIN_MASTER(myThid)
                0098           IF ( myIter .EQ. nIter0 ) THEN
                0099 C-      save for next write to same file:
                0100             IOunit_outpFile = ioUnit
                0101           ENDIF
69d9f8202f Jean*0102           IF ( myIter .EQ. nEndIter .AND. ioUnit .GT. 0 ) THEN
906a61c194 Ou W*0103 C-      after last write, close IO-unit:
                0104             IF ( debugLevel.GE.debLevC ) THEN
69d9f8202f Jean*0105               WRITE(msgBuf,'(A,I8,3A)')
                0106      &          ' STERGLOH_OUTPUT: close ioUnit=', ioUnit,
                0107      &          ', file: ', fName(1:26), '.data'
906a61c194 Ou W*0108               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0109      &                            SQUEEZE_RIGHT, myThid )
                0110             ENDIF
                0111             CLOSE( ioUnit )
69d9f8202f Jean*0112           ELSEIF ( myIter .EQ. nEndIter .AND. debugMode ) THEN
                0113             WRITE(msgBuf,'(2A,I10,A)')
                0114      &          ' STERGLOH_OUTPUT: no file to close',
                0115      &          ' (ioUnit=', ioUnit, ' )'
                0116             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0117      &                          SQUEEZE_RIGHT, myThid )
906a61c194 Ou W*0118           ENDIF
                0119           _END_MASTER(myThid)
                0120         ENDIF
                0121
                0122 #endif /* ALLOW_MDSIO */
                0123       ENDIF
                0124
                0125 #endif /* ALLOW_PSBAR_STERIC */
                0126 #endif /* ALLOW_ECCO */
                0127
                0128       RETURN
                0129       END