Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:41:41 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
89992793c5 Jean*0001 #include "LAND_OPTIONS.h"
                0002 
                0003 CBOP
439d922c37 Jean*0004 C     !ROUTINE: LAND_OUTPUT
89992793c5 Jean*0005 C     !INTERFACE:
439d922c37 Jean*0006       SUBROUTINE LAND_OUTPUT( myTime, myIter, myThid )
89992793c5 Jean*0007 C     !DESCRIPTION: \bv
                0008 C     *==========================================================*
439d922c37 Jean*0009 C     | S/R LAND_OUTPUT
                0010 C     | o general routine for Land output
                0011 C     *==========================================================*
                0012 C     | - write snap-shot & time-average output
                0013 C     | - call monitor to write global quantities
89992793c5 Jean*0014 C     *==========================================================*
                0015 C     \ev
                0016 
                0017 C     !USES:
                0018       IMPLICIT NONE
                0019 
                0020 C     === Global variables ===
                0021 #include "LAND_SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
                0024 #include "LAND_PARAMS.h"
439d922c37 Jean*0025 #include "LAND_VARS.h"
89992793c5 Jean*0026 #include "LAND_TAVE.h"
                0027 #ifdef ALLOW_AIM
                0028 #include "AIM_FFIELDS.h"
                0029 #endif
                0030 
                0031 C     !INPUT/OUTPUT PARAMETERS:
                0032 C     == Routine arguments ==
                0033 C     myTime - Current time of simulation ( s )
                0034 C     myIter - Iteration number
                0035 C     myThid - Number of this instance of the routine
                0036       _RL     myTime
                0037       INTEGER myIter
                0038       INTEGER myThid
                0039 CEOP
                0040 
                0041 #ifdef ALLOW_LAND
                0042 
233fabd09d Jean*0043 C     !FUNCTIONS:
94a46dfe0d Jean*0044       LOGICAL  DIFFERENT_MULTIPLE
                0045       EXTERNAL DIFFERENT_MULTIPLE
89992793c5 Jean*0046 
233fabd09d Jean*0047 C     !LOCAL VARIABLES:
89992793c5 Jean*0048 C     == Local variables ==
e024b9fa7f Jean*0049       INTEGER bi, bj, k
439d922c37 Jean*0050       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0051       CHARACTER*(MAX_LEN_FNAM) fn
e024b9fa7f Jean*0052       CHARACTER*(10) suff
439d922c37 Jean*0053 #ifdef ALLOW_MNC
b22b541fe9 Ed H*0054       CHARACTER*(1) pf
439d922c37 Jean*0055 #endif
89992793c5 Jean*0056 
                0057 #ifdef ALLOW_AIM
59c106d641 Jean*0058       IF ( land_monFreq.NE.0. ) THEN
89992793c5 Jean*0059         CALL LAND_MONITOR( aim_landFr, myTime, myIter, myThid )
                0060       ENDIF
                0061 #endif
                0062 
439d922c37 Jean*0063 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0064 
e024b9fa7f Jean*0065       IF (
439d922c37 Jean*0066      &     DIFFERENT_MULTIPLE( land_diagFreq, myTime, land_deltaT )
                0067      &  .OR. dumpInitAndLast.AND.( myTime.EQ.endTime .OR.
                0068      &                             myTime.EQ.startTime  )
                0069      &   ) THEN
                0070 
e024b9fa7f Jean*0071 C--   Write snap-shot
439d922c37 Jean*0072 C jmc: previously done from LAND_DO_DIAGS, but much better here.
                0073 
                0074         IF ( land_snapshot_mdsio ) THEN
                0075 
df5a9764ba Jean*0076           IF ( rwSuffixType.EQ.0 ) THEN
                0077             WRITE(suff,'(I10.10)') myIter
                0078           ELSE
                0079             CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0080           ENDIF
439d922c37 Jean*0081 
                0082 C--   Write ground Temp and soil moisture :
e024b9fa7f Jean*0083           CALL WRITE_FLD_3D_RL( 'land_groundT.', suff, land_nLev,
439d922c37 Jean*0084      &                           land_groundT, myIter, myThid )
e024b9fa7f Jean*0085           CALL WRITE_FLD_3D_RL( 'land_enthalp.', suff, land_nLev,
439d922c37 Jean*0086      &                           land_enthalp, myIter, myThid )
e024b9fa7f Jean*0087           CALL WRITE_FLD_3D_RL( 'land_groundW.', suff, land_nLev,
439d922c37 Jean*0088      &                           land_groundW, myIter, myThid )
                0089 C--   other (2-D) state variables:
                0090           CALL WRITE_FLD_XY_RL(
e024b9fa7f Jean*0091      &         'land_skinT.', suff, land_skinT, myIter, myThid )
439d922c37 Jean*0092           CALL WRITE_FLD_XY_RL(
e024b9fa7f Jean*0093      &         'land_hSnow.', suff, land_hSnow, myIter, myThid )
439d922c37 Jean*0094           CALL WRITE_FLD_XY_RL(
e024b9fa7f Jean*0095      &         'land_snAge.', suff, land_snowAge, myIter, myThid )
439d922c37 Jean*0096 
                0097           IF ( myIter.NE.nIter0 ) THEN
                0098 C--   fluxes (2-D map):
                0099           CALL WRITE_FLD_XY_RL(
e024b9fa7f Jean*0100      &         'land_RunOff.', suff, land_runOff, myIter, myThid )
439d922c37 Jean*0101           CALL WRITE_FLD_XY_RL(
e024b9fa7f Jean*0102      &         'land_enRnOf.', suff, land_enRnOf, myIter, myThid )
439d922c37 Jean*0103           CALL WRITE_FLD_XY_RL(
e024b9fa7f Jean*0104      &         'land_HeatFx.', suff, land_HeatFlx, myIter, myThid )
439d922c37 Jean*0105           CALL WRITE_FLD_XY_RL(
e024b9fa7f Jean*0106      &         'land_frWaFx.', suff, land_Pr_m_Ev, myIter, myThid )
439d922c37 Jean*0107           CALL WRITE_FLD_XY_RL(
e024b9fa7f Jean*0108      &         'land_EnWaFx.', suff, land_EnWFlux, myIter, myThid )
439d922c37 Jean*0109           ENDIF
                0110 
                0111         ENDIF
                0112 
                0113 #ifdef ALLOW_MNC
                0114         IF ( land_snapshot_mnc ) THEN
233fabd09d Jean*0115           _BARRIER
439d922c37 Jean*0116 
                0117           IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
                0118             pf(1:1) = 'D'
                0119           ELSE
                0120             pf(1:1) = 'R'
                0121           ENDIF
204b79e930 Jean*0122           WRITE(fn,'(A)') 'land_snapshot'
                0123           CALL MNC_CW_SET_UDIM(fn, -1, myThid)
                0124           CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
                0125           CALL MNC_CW_SET_UDIM(fn, 0, myThid)
                0126           CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
439d922c37 Jean*0127 
204b79e930 Jean*0128           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0129      &         'land_groundT', land_groundT, myThid)
204b79e930 Jean*0130           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0131      &         'land_enthalp', land_enthalp, myThid)
204b79e930 Jean*0132           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0133      &         'land_groundW', land_groundW, myThid)
                0134 
204b79e930 Jean*0135           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0136      &         'land_skinT', land_skinT, myThid)
204b79e930 Jean*0137           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0138      &         'land_hSnow', land_hSnow, myThid)
204b79e930 Jean*0139           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0140      &         'land_snAge', land_snowAge, myThid)
204b79e930 Jean*0141           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0142      &         'land_RunOff', land_runOff, myThid)
204b79e930 Jean*0143           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0144      &         'land_enRnOf', land_enRnOf, myThid)
                0145 
204b79e930 Jean*0146           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0147      &         'land_HeatFx', land_HeatFlx, myThid)
204b79e930 Jean*0148           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0149      &         'land_frWaFx', land_Pr_m_Ev, myThid)
204b79e930 Jean*0150           CALL MNC_CW_RL_W(pf,fn,0,0,
439d922c37 Jean*0151      &         'land_EnWaFx', land_EnWFlux, myThid)
                0152 
233fabd09d Jean*0153           _BARRIER
439d922c37 Jean*0154         ENDIF
                0155 #endif
                0156 
                0157       ENDIF
89992793c5 Jean*0158 
                0159 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0160 
439d922c37 Jean*0161 #ifdef ALLOW_LAND_TAVE
                0162 
89992793c5 Jean*0163       IF (land_taveFreq.LE.0.) RETURN
                0164 
                0165       IF ( myIter.EQ.nIter0 ) THEN
                0166 C      Initialize time-average arrays to zero
                0167        DO bj = myByLo(myThid), myByHi(myThid)
                0168         DO bi = myBxLo(myThid), myBxHi(myThid)
                0169          CALL TIMEAVE_RESET(land_grTtave,land_nLev, bi, bj, myThid)
                0170          CALL TIMEAVE_RESET(land_entave, land_nLev, bi, bj, myThid)
                0171          CALL TIMEAVE_RESET(land_grWtave,land_nLev, bi, bj, myThid)
                0172          CALL TIMEAVE_RESET(land_sTtave,         1, bi, bj, myThid)
                0173          CALL TIMEAVE_RESET(land_hStave,         1, bi, bj, myThid)
                0174          CALL TIMEAVE_RESET(land_sAtave,         1, bi, bj, myThid)
                0175          CALL TIMEAVE_RESET(land_ROftave,        1, bi, bj, myThid)
                0176          CALL TIMEAVE_RESET(land_eROtave,        1, bi, bj, myThid)
0bff449f75 Jean*0177          land_timeAve(bi,bj) = 0.
89992793c5 Jean*0178         ENDDO
                0179        ENDDO
                0180 
                0181 C     Dump files and restart average computation if needed
e024b9fa7f Jean*0182       ELSEIF (
439d922c37 Jean*0183      &     DIFFERENT_MULTIPLE( land_taveFreq, myTime, land_deltaT )
89992793c5 Jean*0184      &       ) THEN
                0185 
                0186 C      Normalize by integrated time
                0187        DO bj = myByLo(myThid), myByHi(myThid)
                0188         DO bi = myBxLo(myThid), myBxHi(myThid)
0bff449f75 Jean*0189          CALL TIMEAVE_NORMALIZE( land_grTtave, land_timeAve,
                0190      &                           land_nLev, bi, bj, myThid )
                0191          CALL TIMEAVE_NORMALIZE( land_entave,  land_timeAve,
                0192      &                           land_nLev, bi, bj, myThid )
                0193          CALL TIMEAVE_NORMALIZE( land_grWtave, land_timeAve,
                0194      &                           land_nLev, bi, bj, myThid )
                0195          CALL TIMEAVE_NORMALIZE( land_sTtave,  land_timeAve,
                0196      &                                   1, bi, bj, myThid )
                0197          CALL TIMEAVE_NORMALIZE( land_hStave,  land_timeAve,
                0198      &                                   1, bi, bj, myThid )
                0199          CALL TIMEAVE_NORMALIZE( land_sAtave,  land_timeAve,
                0200      &                                   1, bi, bj, myThid )
                0201          CALL TIMEAVE_NORMALIZE( land_ROftave, land_timeAve,
                0202      &                                   1, bi, bj, myThid )
                0203          CALL TIMEAVE_NORMALIZE( land_eROtave, land_timeAve,
                0204      &                                   1, bi, bj, myThid )
89992793c5 Jean*0205         ENDDO
                0206        ENDDO
                0207 
3f81645eae Ed H*0208        IF ( land_timeave_mdsio ) THEN
                0209 
df5a9764ba Jean*0210         IF ( rwSuffixType.EQ.0 ) THEN
                0211           WRITE(suff,'(I10.10)') myIter
                0212         ELSE
                0213           CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0214         ENDIF
                0215         WRITE(fn,'(2A)') 'land_tave.', suff
e024b9fa7f Jean*0216         CALL WRITE_REC_3D_RL( fn, writeBinaryPrec, land_nLev,
                0217      &                        land_grTtave, 1, myIter, myThid )
                0218         CALL WRITE_REC_3D_RL( fn, writeBinaryPrec, land_nLev,
                0219      &                        land_entave,  2, myIter, myThid )
                0220         CALL WRITE_REC_3D_RL( fn, writeBinaryPrec, land_nLev,
                0221      &                        land_grWtave, 3, myIter, myThid )
                0222         k = 3*land_nLev
                0223         CALL WRITE_REC_XY_RL( fn, land_sTtave,  k+1, myIter, myThid )
                0224         CALL WRITE_REC_XY_RL( fn, land_hStave,  k+2, myIter, myThid )
                0225         CALL WRITE_REC_XY_RL( fn, land_sAtave,  k+3, myIter, myThid )
                0226         CALL WRITE_REC_XY_RL( fn, land_ROftave, k+4, myIter, myThid )
                0227         CALL WRITE_REC_XY_RL( fn, land_eROtave, k+5, myIter, myThid )
89992793c5 Jean*0228 
3f81645eae Ed H*0229        ENDIF
                0230 
                0231 #ifdef ALLOW_MNC
                0232        IF ( land_timeave_mnc ) THEN
0bff449f75 Jean*0233          _BARRIER
e024b9fa7f Jean*0234 
439d922c37 Jean*0235          IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
                0236            pf(1:1) = 'D'
                0237          ELSE
                0238            pf(1:1) = 'R'
                0239          ENDIF
204b79e930 Jean*0240          WRITE(fn,'(A)') 'land_tave'
3f81645eae Ed H*0241          CALL MNC_CW_SET_UDIM(fn, -1, myThid)
                0242          CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
                0243          CALL MNC_CW_SET_UDIM(fn, 0, myThid)
                0244          CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
b22b541fe9 Ed H*0245          CALL MNC_CW_RL_W(pf,fn,0,0,
3f81645eae Ed H*0246      &        'land_groundT', land_grTtave, myThid)
b22b541fe9 Ed H*0247          CALL MNC_CW_RL_W(pf,fn,0,0,
3f81645eae Ed H*0248      &        'land_enthalp', land_entave, myThid)
b22b541fe9 Ed H*0249          CALL MNC_CW_RL_W(pf,fn,0,0,
3f81645eae Ed H*0250      &        'land_groundW', land_grWtave, myThid)
e024b9fa7f Jean*0251 
b22b541fe9 Ed H*0252          CALL MNC_CW_RL_W(pf,fn,0,0,
3f81645eae Ed H*0253      &        'land_skinT', land_sTtave, myThid)
b22b541fe9 Ed H*0254          CALL MNC_CW_RL_W(pf,fn,0,0,
3f81645eae Ed H*0255      &        'land_hSnow', land_hStave, myThid)
b22b541fe9 Ed H*0256          CALL MNC_CW_RL_W(pf,fn,0,0,
3f81645eae Ed H*0257      &        'land_snAge', land_sAtave, myThid)
b22b541fe9 Ed H*0258          CALL MNC_CW_RL_W(pf,fn,0,0,
3f81645eae Ed H*0259      &        'land_RunOff', land_ROftave, myThid)
b22b541fe9 Ed H*0260          CALL MNC_CW_RL_W(pf,fn,0,0,
3f81645eae Ed H*0261      &        'land_enRnOf', land_eROtave, myThid)
e024b9fa7f Jean*0262 
0bff449f75 Jean*0263          _BARRIER
3f81645eae Ed H*0264        ENDIF
                0265 #endif
                0266 
e024b9fa7f Jean*0267        WRITE(msgBuf,'(A,I10)')
                0268      &  '// Land Time-average  written, t-step', myIter
                0269        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0270      &                     SQUEEZE_RIGHT, myThid )
                0271        WRITE(msgBuf,'(A)') ' '
                0272        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0273      &                     SQUEEZE_RIGHT, myThid )
                0274 
89992793c5 Jean*0275 C      Reset averages to zero
                0276        DO bj = myByLo(myThid), myByHi(myThid)
                0277         DO bi = myBxLo(myThid), myBxHi(myThid)
                0278          CALL TIMEAVE_RESET(land_grTtave,land_nLev, bi, bj, myThid)
                0279          CALL TIMEAVE_RESET(land_entave, land_nLev, bi, bj, myThid)
                0280          CALL TIMEAVE_RESET(land_grWtave,land_nLev, bi, bj, myThid)
                0281          CALL TIMEAVE_RESET(land_sTtave,         1, bi, bj, myThid)
                0282          CALL TIMEAVE_RESET(land_hStave,         1, bi, bj, myThid)
                0283          CALL TIMEAVE_RESET(land_sAtave,         1, bi, bj, myThid)
                0284          CALL TIMEAVE_RESET(land_ROftave,        1, bi, bj, myThid)
                0285          CALL TIMEAVE_RESET(land_eROtave,        1, bi, bj, myThid)
0bff449f75 Jean*0286          land_timeAve(bi,bj) = 0.
89992793c5 Jean*0287         ENDDO
                0288        ENDDO
                0289 
                0290       ENDIF
                0291 
                0292 #endif /* ALLOW_LAND_TAVE */
                0293 
                0294 #endif /* ALLOW_LAND */
                0295 
                0296       RETURN
                0297       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!