Back to home page

MITgcm
 
 

    

File indexing completed on 2025-09-11 05:13:14 UTC

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