pkg/kpp/kpp_output.F

2fa42a6013 Alis*0001 #include "KPP_OPTIONS.h"
141e734c73 Jean*0002 #ifdef ALLOW_GMREDI
                0003 # include "GMREDI_OPTIONS.h"
                0004 #endif
3b6d2d02e0 Mart*0005 #undef  MULTIPLE_RECORD_KPP_STATE_FILES
8b6db0f7a7 Jean*0006
3b6d2d02e0 Mart*0007 CBOP
cd56dd0428 Jean*0008 C     !ROUTINE: KPP_OUTPUT
c9c3d7103f Ed H*0009
3b6d2d02e0 Mart*0010 C     !INTERFACE:
cd56dd0428 Jean*0011       SUBROUTINE KPP_OUTPUT( myTime, myIter, myThid )
c9c3d7103f Ed H*0012
cd56dd0428 Jean*0013 C     !DESCRIPTION:
                0014 C     Create the KPP diagnostic output.
c9c3d7103f Ed H*0015 C
                0016 C     The following CPP flag (MULTIPLE_RECORD_KPP_STATE_FILES) is
                0017 C     #define/#undefed here since it is specific to this routine and
                0018 C     very user-preference specific.
cd56dd0428 Jean*0019 C
c9c3d7103f Ed H*0020 C     If #undefed (default) the state files are written as in all
                0021 C     versions prior to checkpoint32, where a file is created per
                0022 C     variable, per time and per tile. This *has* to be the default
                0023 C     because most users use this mode and all utilities and scripts
                0024 C     (diagnostic) assume this form.  It is also robust, as explained
                0025 C     below.
cd56dd0428 Jean*0026 C
c9c3d7103f Ed H*0027 C     If #defined, subsequent snap-shots are written as records in the
                0028 C     same file (no iteration number in filenames).
                0029 C
                0030 C     Advantages:
                0031 C     - fewer files
                0032 C     - for small problems, is easy to copy the output around
                0033 C     Disadvantages:
                0034 C     - breaks a lot of diagnostic scripts
                0035 C     - for large or long problems this creates huge files
                0036 C     - is an unexpected, unsolicited change in behaviour which came
                0037 C     as a surprise (in c32) and inconvenience to several users
                0038 C     - can not accomodate changing the frequency of output
                0039 C     after a pickup (this is trivial in previous method
                0040 C     but needs new code and parameters in this new method)
3b6d2d02e0 Mart*0041
ef080e1d37 Dimi*0042 C     !USES:
2fa42a6013 Alis*0043       IMPLICIT NONE
                0044 #include "SIZE.h"
                0045 #include "EEPARAMS.h"
                0046 #include "PARAMS.h"
                0047 #include "KPP.h"
                0048 #include "KPP_PARAMS.h"
141e734c73 Jean*0049 #ifdef ALLOW_GMREDI
                0050 # include "GMREDI.h"
                0051 #endif
                0052 #ifdef ALLOW_MNC
                0053 # include "MNC_PARAMS.h"
                0054 #endif
02f4da180f Oliv*0055 #ifdef ALLOW_OFFLINE
                0056 # include "OFFLINE_SWITCH.h"
                0057 #endif
2fa42a6013 Alis*0058
3b6d2d02e0 Mart*0059 C     !INPUT/OUTPUT PARAMETERS:
cd56dd0428 Jean*0060 C     myTime :: my time in simulation ( s )
                0061 C     myIter :: my Iteration number
                0062 C     myThid :: my Thread Id number
fc64655a31 Dimi*0063       _RL     myTime
2fa42a6013 Alis*0064       INTEGER myIter
                0065       INTEGER myThid
                0066
                0067 #ifdef ALLOW_KPP
                0068
8b6db0f7a7 Jean*0069 C     !FUNCTIONS:
94a46dfe0d Jean*0070       LOGICAL  DIFFERENT_MULTIPLE
                0071       EXTERNAL DIFFERENT_MULTIPLE
141e734c73 Jean*0072 #ifdef ALLOW_DIAGNOSTICS
                0073       LOGICAL  DIAGNOSTICS_IS_ON
                0074       EXTERNAL DIAGNOSTICS_IS_ON
                0075 #endif
8b6db0f7a7 Jean*0076
                0077 C     !LOCAL VARIABLES:
b7411f1a84 Jean*0078 C     variable in local common block:
141e734c73 Jean*0079 C     kpp_drctrec  :: next record to dump for KPP files
                0080       INTEGER kpp_drctrec
                0081       COMMON / KPP_RECORDNUM1 / kpp_drctrec
                0082 C     local variable:
df5a9764ba Jean*0083       CHARACTER*(10) suff
b7411f1a84 Jean*0084 #ifdef ALLOW_DIAGNOSTICS
8b6db0f7a7 Jean*0085       INTEGER bi, bj
141e734c73 Jean*0086       INTEGER i, j, k
                0087       _RL tmpFac
                0088       _RL tmpLoc(1:sNx,1:sNy,Nr)
                0089 #endif
8b6db0f7a7 Jean*0090 #ifdef ALLOW_MNC
b22b541fe9 Ed H*0091       CHARACTER*(1) pf
8b6db0f7a7 Jean*0092 #endif
ef080e1d37 Dimi*0093 CEOP
2fa42a6013 Alis*0094
8b6db0f7a7 Jean*0095 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0096
02f4da180f Oliv*0097 #ifdef ALLOW_OFFLINE
                0098       IF ( .NOT.(useOffLine.AND.offlineLoadKPP) ) THEN
                0099 #else
                0100       IF ( .TRUE. ) THEN
                0101 #endif
                0102
b7411f1a84 Jean*0103 C     Initialize record numbers
8b6db0f7a7 Jean*0104       IF ( myIter.EQ.nIter0 ) THEN
                0105         _BEGIN_MASTER( myThid )
                0106         kpp_drctrec = 1
                0107         _END_MASTER( myThid )
                0108         _BARRIER
b22b541fe9 Ed H*0109       ENDIF
                0110
2fa42a6013 Alis*0111 C----------------------------------------------------------------
                0112 C     Dump snapshot of KPP variables.
                0113
cd56dd0428 Jean*0114       IF ( myIter.NE.nIter0 .AND.
94a46dfe0d Jean*0115      &     DIFFERENT_MULTIPLE(kpp_dumpFreq,myTime,deltaTClock)
2fa42a6013 Alis*0116      &     ) THEN
cd56dd0428 Jean*0117
c9c3d7103f Ed H*0118         IF (KPPwriteState .AND. snapshot_mdsio) THEN
3b6d2d02e0 Mart*0119 #ifdef MULTIPLE_RECORD_KPP_STATE_FILES
c9c3d7103f Ed H*0120 C         Write each snap-shot as a new record in one file per variable
108c31e771 Ed H*0121 C         - creates relatively few files but these files can become huge
                0122 C         NOTE: file size and number problems are *SOLVED* by MNC
c9c3d7103f Ed H*0123           CALL WRITE_REC_XYZ_RL('KPPviscAz',KPPviscAz,kpp_drctrec,
                0124      &         myIter,myThid)
                0125           CALL WRITE_REC_XYZ_RL('KPPdiffKzT',KPPdiffKzT,kpp_drctrec,
                0126      &         myIter,myThid)
                0127           CALL WRITE_REC_XYZ_RL('KPPdiffKzS',KPPdiffKzS,kpp_drctrec,
                0128      &         myIter,myThid)
                0129           CALL WRITE_REC_XYZ_RL('KPPghat',KPPghat,kpp_drctrec,
                0130      &         myIter,myThid)
                0131           CALL WRITE_REC_XY_RL('KPPhbl',KPPhbl,kpp_drctrec,
                0132      &         myIter,myThid)
cd56dd0428 Jean*0133 C--     Increment record counter
                0134           _BARRIER
                0135           _BEGIN_MASTER( myThid )
                0136           kpp_drctrec = kpp_drctrec + 1
                0137           _END_MASTER( myThid )
                0138           _BARRIER
3b6d2d02e0 Mart*0139 #else /* MULTIPLE_RECORD_KPP_STATE_FILES */
c9c3d7103f Ed H*0140 C         Write each snap-shot as a new file - creates many files but
108c31e771 Ed H*0141 C         for large configurations is easier to transfer
                0142 C         NOTE: file size and number problems are *SOLVED* by MNC
df5a9764ba Jean*0143           IF ( rwSuffixType.EQ.0 ) THEN
                0144             WRITE(suff,'(I10.10)') myIter
                0145           ELSE
                0146             CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0147           ENDIF
c9c3d7103f Ed H*0148           CALL WRITE_FLD_XYZ_RL('KPPviscAz.',suff,KPPviscAz,
                0149      &         myIter,myThid)
                0150           CALL WRITE_FLD_XYZ_RL('KPPdiffKzT.',suff,KPPdiffKzT,
                0151      &         myIter,myThid)
                0152           CALL WRITE_FLD_XYZ_RL('KPPdiffKzS.',suff,KPPdiffKzS,
                0153      &         myIter,myThid)
                0154           CALL WRITE_FLD_XYZ_RL('KPPghat.',suff,KPPghat,
                0155      &         myIter,myThid)
                0156           CALL WRITE_FLD_XY_RL('KPPhbl.',suff,KPPhbl,
                0157      &         myIter,myThid)
3b6d2d02e0 Mart*0158 #endif /* MULTIPLE_RECORD_KPP_STATE_FILES */
c9c3d7103f Ed H*0159         ENDIF
2fa42a6013 Alis*0160
c9c3d7103f Ed H*0161 #ifdef ALLOW_MNC
6e5c016417 Patr*0162         IF (KPPwriteState .AND. useMNC .AND. snapshot_mnc) THEN
8b6db0f7a7 Jean*0163           IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
                0164             pf(1:1) = 'D'
                0165           ELSE
                0166             pf(1:1) = 'R'
                0167           ENDIF
c9c3d7103f Ed H*0168           CALL MNC_CW_SET_UDIM('kpp_state', -1, myThid)
987ff12cb6 Ed H*0169           CALL MNC_CW_RL_W_S('D','kpp_state',0,0,'T',myTime,myThid)
5220a1ccab Ed H*0170           CALL MNC_CW_SET_UDIM('kpp_state', 0, myThid)
987ff12cb6 Ed H*0171           CALL MNC_CW_I_W_S('I','kpp_state',0,0,'iter',myIter,myThid)
b22b541fe9 Ed H*0172           CALL MNC_CW_RL_W(pf,'kpp_state',0,0,
c9c3d7103f Ed H*0173      &         'KPPviscAz', KPPviscAz, myThid)
b22b541fe9 Ed H*0174           CALL MNC_CW_RL_W(pf,'kpp_state',0,0,
c9c3d7103f Ed H*0175      &         'KPPdiffKzT', KPPdiffKzT, myThid)
b22b541fe9 Ed H*0176           CALL MNC_CW_RL_W(pf,'kpp_state',0,0,
c9c3d7103f Ed H*0177      &         'KPPdiffKzS', KPPdiffKzS, myThid)
b22b541fe9 Ed H*0178           CALL MNC_CW_RL_W(pf,'kpp_state',0,0,
6e5c016417 Patr*0179      &         'KPPGHAT', KPPghat, myThid)
b22b541fe9 Ed H*0180           CALL MNC_CW_RL_W(pf,'kpp_state',0,0,
6e5c016417 Patr*0181      &         'KPPHBL', KPPhbl, myThid)
c9c3d7103f Ed H*0182         ENDIF
                0183 #endif /*  ALLOW_MNC  */
2fa42a6013 Alis*0184
                0185       ENDIF
cd56dd0428 Jean*0186
2fa42a6013 Alis*0187 C----------------------------------------------------------------
7e819019d5 Dimi*0188
                0189 #ifdef ALLOW_DIAGNOSTICS
c3cd6c250f Jean*0190 C     do not fill during call from INITIALISE_VARIA
afb6ba5661 Oliv*0191       IF ( useDiagnostics .AND. myIter.NE.nIter0 ) THEN
7e819019d5 Dimi*0192        CALL DIAGNOSTICS_FILL(KPPviscAz ,'KPPviscA',0,Nr,0,1,1,myThid)
                0193        CALL DIAGNOSTICS_FILL(KPPdiffKzS,'KPPdiffS',0,Nr,0,1,1,myThid)
                0194        CALL DIAGNOSTICS_FILL(KPPdiffKzT,'KPPdiffT',0,Nr,0,1,1,myThid)
141e734c73 Jean*0195        IF ( DIAGNOSTICS_IS_ON( 'KPPghatK', myThid ) ) THEN
                0196         IF ( useGMRedi .AND. KPP_ghatUseTotalDiffus ) THEN
                0197           tmpFac = 1. _d 0
                0198         ELSE
                0199           tmpFac = 0. _d 0
                0200         ENDIF
                0201         DO bj = myByLo(myThid), myByHi(myThid)
                0202          DO bi = myBxLo(myThid), myBxHi(myThid)
                0203           DO j=1,sNy
                0204             DO i=1,sNx
                0205               tmpLoc(i,j,1) = 0. _d 0
                0206             ENDDO
                0207           ENDDO
                0208           DO k=2,Nr
                0209            DO j=1,sNy
                0210             DO i=1,sNx
                0211               tmpLoc(i,j,k) = KPPghat(i,j,k-1,bi,bj)*
                0212      &                      ( KPPdiffKzS(i,j,k,bi,bj)
                0213 #ifdef ALLOW_GMREDI
                0214      &                      + tmpFac*Kwz(i,j,k,bi,bj)
                0215 #endif
                0216      &                      )
                0217             ENDDO
                0218            ENDDO
                0219           ENDDO
                0220           CALL DIAGNOSTICS_FILL(tmpLoc,'KPPghatK',0,Nr,3,bi,bj,myThid)
                0221          ENDDO
                0222         ENDDO
                0223        ENDIF
7e819019d5 Dimi*0224        CALL DIAGNOSTICS_FILL(KPPhbl    ,'KPPhbl  ',0,1 ,0,1,1,myThid)
                0225        CALL DIAGNOSTICS_FILL(KPPfrac   ,'KPPfrac ',0,1 ,0,1,1,myThid)
30c6f5b1cd An T*0226 #ifdef ALLOW_SALT_PLUME
                0227        CALL DIAGNOSTICS_FILL(KPPplumefrac,'KPPpfrac',0,1 ,0,1,1,myThid)
                0228 #endif /* ALLOW_SALT_PLUME */
7e819019d5 Dimi*0229       ENDIF
                0230 #endif /* ALLOW_DIAGNOSTICS */
cd56dd0428 Jean*0231
02f4da180f Oliv*0232 C--   end if useOffLine
                0233       ENDIF
                0234
0e5cee27f0 Jean*0235 #endif /* ALLOW_KPP */
cd56dd0428 Jean*0236
2fa42a6013 Alis*0237       RETURN
                0238       END