pkg/gchem/gchem_diagnostics_init.F

8c664c8b58 Jean*0001 #include "GCHEM_OPTIONS.h"
                0002
                0003 C !INTERFACE: ==========================================================
e1fb02e8f0 Jean*0004       SUBROUTINE GCHEM_DIAGNOSTICS_INIT( myThid )
8c664c8b58 Jean*0005
                0006 C !DESCRIPTION:
                0007 C define diagnostics for gchem package
                0008 C experiment
                0009
                0010 C !USES: ===============================================================
                0011       IMPLICIT NONE
                0012 #include "SIZE.h"
                0013 #include "EEPARAMS.h"
d652e84639 Jean*0014 #include "PARAMS.h"
3c00322f26 Jean*0015 #include "PTRACERS_SIZE.h"
d652e84639 Jean*0016 #include "PTRACERS_PARAMS.h"
3c00322f26 Jean*0017 #include "GCHEM.h"
                0018 c#include "GAD.h"
8c664c8b58 Jean*0019
                0020 C !INPUT PARAMETERS: ===================================================
                0021 C  myThid               :: thread number
                0022       INTEGER myThid
                0023 CEOP
                0024
                0025 #ifdef ALLOW_DIAGNOSTICS
d652e84639 Jean*0026 #ifdef GCHEM_SEPARATE_FORCING
                0027
                0028 C     Functions ::
                0029       INTEGER     ILNBLNK
                0030       EXTERNAL    ILNBLNK
c3c6ac25ae Jean*0031 c     CHARACTER*4 GAD_DIAG_SUFX
                0032 c     EXTERNAL    GAD_DIAG_SUFX
8c664c8b58 Jean*0033
                0034 C     !LOCAL VARIABLES:
d652e84639 Jean*0035       INTEGER       diagNum
                0036       CHARACTER*8   diagName
                0037       CHARACTER*16  diagCode
                0038       CHARACTER*16  diagUnits
                0039       CHARACTER*(80) diagTitle
                0040
c3c6ac25ae Jean*0041       INTEGER      iTrc, ilnb
d652e84639 Jean*0042       CHARACTER*7  trcUnits
                0043       CHARACTER*30 locName
8c664c8b58 Jean*0044
                0045 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0046
c3c6ac25ae Jean*0047 C--   Define diagnostics Names :
0d757b67fd Jean*0048       DO iTrc=1,MIN( gchem_sepFTr_num, PTRACERS_num )
c3c6ac25ae Jean*0049 C-     Set default name & tracer Units:
9449c1a0bb Jean*0050        WRITE(locName,'(A,I4.4,A)') 'Tracer ',iTrc
d652e84639 Jean*0051        trcUnits  = '(kg/kg)'
9449c1a0bb Jean*0052 C-     use units & (short) name from data.ptracers :
d652e84639 Jean*0053        ilnb = ILNBLNK(PTRACERS_units(iTrc))
                0054        IF ( ilnb.GE.1 ) THEN
                0055          ilnb = LEN(trcUnits)
                0056          trcUnits = PTRACERS_units(iTrc)(1:ilnb)
                0057        ENDIF
9449c1a0bb Jean*0058        ilnb = ILNBLNK(PTRACERS_names(iTrc))
d652e84639 Jean*0059        IF ( ilnb.GE.1 ) THEN
                0060          ilnb = MIN(LEN(locName),ilnb)
9449c1a0bb Jean*0061          WRITE(locName,'(A)') PTRACERS_names(iTrc)(1:ilnb)
d652e84639 Jean*0062        ENDIF
                0063        ilnb = MAX(ILNBLNK(locName),1)
                0064
                0065        WRITE(diagName,'(A5,A2,A1)') 'GC_Tr',PTRACERS_ioLabel(iTrc),' '
                0066        WRITE(diagTitle,'(2A)') locName(1:ilnb),
                0067      &                         ' concentration before GCHEM'
                0068        diagUnits = trcUnits//'         '
                0069        diagCode  = 'SMR     MR      '
                0070        CALL DIAGNOSTICS_ADDTOLIST( diagNum,
                0071      I           diagName, diagCode, diagUnits, diagTitle, 0, myThid )
                0072
                0073       ENDDO
                0074
c3c6ac25ae Jean*0075 C--   Other diagnostics should be initialized in each package called by gchem
8c664c8b58 Jean*0076
                0077 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0078
d652e84639 Jean*0079 #endif /* GCHEM_SEPARATE_FORCING */
8c664c8b58 Jean*0080 #endif /* ALLOW_DIAGNOSTICS */
                0081
                0082       RETURN
                0083       END