Sola/GEOS-Chem-adjoint-v35-note
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
master
GEOS-Chem-adjoint-v35-note/code/modified/geos_chem_mod.f~
Xuesong (Steve) cffebb9cd6 Add files via upload
2018-08-28 00:37:54 -04:00

2973 lines
106 KiB
FortranFixed
Raw Permalink Blame History

! $Id:
! - Now fixed minor bug that inverted TROPP1 and TROPP2 (phs)
! - Bug fix: now define LLTROP_FIX for GCAP in CMN_SIZE (phs)
! - a3_read_mod.f: added SNOW and GETWETTOP fields for GCAP (phs)
! - main.f: remove duplicate call for unzip in GCAP case (phs)
! - time_mod.f: fix leap year problem in get_time_ahead for GCAP (phs)
! - extra fixes for the variable tropopause (phs)
! - minor diagnostic updates (phs)
! - now save SOA quantities GPROD & APROD to restart files (tmf, havala, bmy)
! - Updated TOMS/SBUV O3 columns for FAST-J photolysis (symeon, bmy)
! - Bug fix in regridding 1x1 mass quantities to 4x5 GEOS grid (tw,bmy)
!
! Revision 1.42 2006/10/17 17:51:14 bmy
! GEOS-Chem v7-04-10, includes the following modifications:
! - Includes variable tropopause with ND54 diagnostic
! - Added GFED2 biomass emissions for SO2, NH3, BC, OC, CO2
! - Rewrote default biomass emissions routines for clarity
! - Updates for GCAP: future emissions, met-field reading, TOMS-O3
! - Bug fix in planeflight_mod.f: set NCS variable correctly
! - Bug fix in SOA_LUMP; other minor bug fixes
!
! GEOS-Chem v7-04-09, includes the following modifications:
! - Updated CO for David Streets (2001 for China, 2000 elsewhere)
! - Now reset negative SPHU to a very small positive #
! - Remove use of TINY(1d0) to avoid NaN's on SUN platform
! - Minor bug fixes and deleted obsolete code
!
! Revision 1.38 2006/08/14 17:58:10 bmy
! GEOS-Chem v7-04-08, includes the following modifications:
! - Now add David Streets' emissions for China & SE Asia
! - Removed support for GEOS-1 and GEOS-STRAT met fields
! - Removed support for LINUX_IFC and LINUX_EFC compilers
!
! Revision 1.37 2006/06/28 17:26:52 bmy
! GEOS-Chem v7-04-06, includes the following modifications:
! - Now add BRAVO emissions (NOx, CO, SO2) over N. Mexico
! - Turn off HO2 uptake by aerosols in SMVGEAR mechanism
! - Bug fix: GEOS-4 convection now conserves mixing ratio
! - Other minor bug fixes & improvements
!
! Revision 1.36 2006/06/06 14:26:07 bmy
! GEOS-Chem v7-04-05, includes the following modifications:
! - Now gets ISOP that has reacted w/ OH from SMVGEAR (cf. D. Henze)
! - Incorporated IPCC future emission scale factors (cf. S. Wu)
! - Other minor bug fixes
!
! Revision 1.35 2006/05/26 17:45:24 bmy
! GEOS-Chem v7-04-04, includes the following modifications:
! - Now updated for SOA production from ISOP (cf D. Henze)
! - Now archive SOA concentrations in [ug/m3] ("diag42_mod.f")
! - Other minor bug fixes
!
! Revision 1.34 2006/05/15 17:52:52 bmy
! GEOS-Chem v7-04-03, includes the following modifications:
! - Added near-land formulation for lightning
! - Now can use CTH, MFLUX, PRECON params for lightning
! (NOTE: new lightning is only applied for GEOS-4 for time being)
! - Added ND56 diagnostic for lightning flash rates
! - Fixed Feb 28 -> Mar 1 transition for GCAP (i.e. no leap years)
! - Other minor bug fixes
!
! Revision 1.33 2006/03/24 20:22:53 bmy
! GEOS-CHEM v7-04-01, includes the following modifications:
! - Updates to new Hg simulation (eck, cdh, sas)
! - Changed Reynold's # criterion for aerodyn smooth surfaces in drydep
! - Standardized several bug fixes implemented in v7-03-06 patch
! - Bug fix: Now call MAKE_RH from "main.f" to avoid problems in drydep
! - Removed obsolete code
!
MODULE GEOS_CHEM_MOD
!
!******************************************************************************
!
!
! GGGGGG EEEEEEE OOOOO SSSSSSS CCCCCC H H EEEEEEE M M
! G E O O S C H H E M M M M
! G GGG EEEEEE O O SSSSSSS C HHHHHHH EEEEEE M M M
! G G E O O S C H H E M M
! GGGGGG EEEEEEE OOOOO SSSSSSS CCCCCC H H EEEEEEE M M
!
!
! (formerly known as the Harvard-GEOS model)
! for 4 x 5, 2 x 2.5 global grids and 1 x 1 nested grids
!
! Contact: Bob Yantosca, Harvard University (bmy@io.as.harvard.edu)
!
!******************************************************************************
!
! See the GEOS-Chem Web Site:
!
! http://www.as.harvard.edu/chemistry/trop/geos/
!
! and the GEOS-Chem User's Guide:
!
! http://www.as.harvard.edu/chemistry/trop/geos/doc/man/
!
! and the GEOS-Chem wiki:
!
! http://wiki.seas.harvard.edu/geos-chem/
!
! for the most up-to-date GEOS-CHEM documentation on the following topics:
!
! - installation, compilation, and execution
! - coding practice and style
! - input files and met field data files
! - horizontal and vertical resolution
! - modification history
!
!******************************************************************************
!
! adj_group (dkh, 10/15/09)
# include "../adjoint/define_adj.h"
! References to F90 modules
USE A3_READ_MOD, ONLY : GET_A3_FIELDS
USE A3_READ_MOD, ONLY : OPEN_A3_FIELDS
USE A3_READ_MOD, ONLY : UNZIP_A3_FIELDS
USE A6_READ_MOD, ONLY : GET_A6_FIELDS
USE A6_READ_MOD, ONLY : OPEN_A6_FIELDS
USE A6_READ_MOD, ONLY : UNZIP_A6_FIELDS
USE BENCHMARK_MOD, ONLY : STDRUN
USE CARBON_MOD, ONLY : WRITE_GPROD_APROD
USE CHEMISTRY_MOD, ONLY : DO_CHEMISTRY
USE CONVECTION_MOD, ONLY : DO_CONVECTION
USE COMODE_MOD, ONLY : INIT_COMODE
USE DIAG_MOD, ONLY : DIAGCHLORO
USE DIAG41_MOD, ONLY : DIAG41, ND41
USE DIAG42_MOD, ONLY : DIAG42, ND42
USE DIAG48_MOD, ONLY : DIAG48, ITS_TIME_FOR_DIAG48
USE DIAG49_MOD, ONLY : DIAG49, ITS_TIME_FOR_DIAG49
USE DIAG50_MOD, ONLY : DIAG50, DO_SAVE_DIAG50
USE DIAG51_MOD, ONLY : DIAG51, DO_SAVE_DIAG51
USE DIAG51b_MOD, ONLY : DIAG51b, DO_SAVE_DIAG51b
USE DIAG51c_MOD, ONLY : DIAG51c, DO_SAVE_DIAG51c
USE DIAG51d_MOD, ONLY : DIAG51d, DO_SAVE_DIAG51d
! diag59 added, (lz,10/11/10)
USE DIAG59_MOD, ONLY : DIAG59, ND59
USE DIAG_OH_MOD, ONLY : PRINT_DIAG_OH
USE DAO_MOD, ONLY : AD, AIRQNT
USE DAO_MOD, ONLY : AVGPOLE, CLDTOPS
USE DAO_MOD, ONLY : CONVERT_UNITS, COPY_I6_FIELDS
USE DAO_MOD, ONLY : COSSZA, INIT_DAO
USE DAO_MOD, ONLY : INTERP, PS1
USE DAO_MOD, ONLY : PS2, PSC2
USE DAO_MOD, ONLY : T, TS
USE DAO_MOD, ONLY : SUNCOS, SUNCOSB
USE DAO_MOD, ONLY : SUNCOS_5hr
USE DAO_MOD, ONLY : MAKE_RH
! geos-fp (lzh, 04/09/2014)
USE GEOSFP_READ_MOD
USE DRYDEP_MOD, ONLY : DO_DRYDEP
USE EMISSIONS_MOD, ONLY : DO_EMISSIONS
USE ERROR_MOD, ONLY : DEBUG_MSG
USE FILE_MOD, ONLY : IU_BPCH, IU_DEBUG
USE FILE_MOD, ONLY : IU_ND48, IU_SMV2LOG
USE FILE_MOD, ONLY : CLOSE_FILES
USE GLOBAL_CH4_MOD, ONLY : INIT_GLOBAL_CH4, CH4_AVGTP
USE GCAP_READ_MOD, ONLY : GET_GCAP_FIELDS
USE GCAP_READ_MOD, ONLY : OPEN_GCAP_FIELDS
USE GCAP_READ_MOD, ONLY : UNZIP_GCAP_FIELDS
USE GWET_READ_MOD, ONLY : GET_GWET_FIELDS
USE GWET_READ_MOD, ONLY : OPEN_GWET_FIELDS
USE GWET_READ_MOD, ONLY : UNZIP_GWET_FIELDS
USE I6_READ_MOD, ONLY : GET_I6_FIELDS_1
USE I6_READ_MOD, ONLY : GET_I6_FIELDS_2
USE I6_READ_MOD, ONLY : OPEN_I6_FIELDS
USE I6_READ_MOD, ONLY : UNZIP_I6_FIELDS
USE INPUT_MOD, ONLY : READ_INPUT_FILE
USE LAI_MOD, ONLY : RDISOLAI
USE LIGHTNING_NOX_MOD, ONLY : LIGHTNING
USE LOGICAL_MOD, ONLY : LEMIS, LCHEM, LUNZIP, LDUST
USE LOGICAL_MOD, ONLY : LLIGHTNOX, LPRT, LSTDRUN, LSVGLB
USE LOGICAL_MOD, ONLY : LWAIT, LTRAN, LUPBD, LCONV
USE LOGICAL_MOD, ONLY : LWETD, LTURB, LDRYD, LMEGAN
USE LOGICAL_MOD, ONLY : LDYNOCEAN, LSOA, LVARTROP, LSULF
USE MEGAN_MOD, ONLY : INIT_MEGAN
USE MEGAN_MOD, ONLY : UPDATE_T_15_AVG
USE MEGAN_MOD, ONLY : UPDATE_T_DAY
USE PBL_MIX_MOD, ONLY : DO_PBL_MIX
USE OCEAN_MERCURY_MOD, ONLY : MAKE_OCEAN_Hg_RESTART
USE OCEAN_MERCURY_MOD, ONLY : READ_OCEAN_Hg_RESTART
USE PLANEFLIGHT_MOD, ONLY : PLANEFLIGHT
USE PLANEFLIGHT_MOD, ONLY : SETUP_PLANEFLIGHT
USE PRESSURE_MOD, ONLY : INIT_PRESSURE
USE PRESSURE_MOD, ONLY : SET_FLOATING_PRESSURE, get_pedge
USE PRESSURE_MOD, ONLY : GET_PFLT
USE TIME_MOD, ONLY : GET_NYMDb, GET_NHMSb
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
USE TIME_MOD, ONLY : GET_A3_TIME, GET_FIRST_A3_TIME
USE TIME_MOD, ONLY : GET_A6_TIME, GET_FIRST_A6_TIME
USE TIME_MOD, ONLY : GET_I6_TIME, GET_MONTH
USE TIME_MOD, ONLY : GET_TAU, GET_TAUb
USE TIME_MOD, ONLY : GET_TS_CHEM, GET_TS_DYN
USE TIME_MOD, ONLY : GET_ELAPSED_SEC, GET_TIME_AHEAD
USE TIME_MOD, ONLY : GET_DAY_OF_YEAR, ITS_A_NEW_DAY
USE TIME_MOD, ONLY : ITS_A_NEW_SEASON, GET_SEASON
USE TIME_MOD, ONLY : ITS_A_NEW_MONTH, GET_NDIAGTIME
USE TIME_MOD, ONLY : ITS_A_LEAPYEAR, GET_YEAR
USE TIME_MOD, ONLY : ITS_TIME_FOR_A3, ITS_TIME_FOR_A6
USE TIME_MOD, ONLY : ITS_TIME_FOR_I6, ITS_TIME_FOR_CHEM
USE TIME_MOD, ONLY : ITS_TIME_FOR_CONV,ITS_TIME_FOR_DEL
USE TIME_MOD, ONLY : ITS_TIME_FOR_DIAG,ITS_TIME_FOR_DYN
USE TIME_MOD, ONLY : ITS_TIME_FOR_EMIS,ITS_TIME_FOR_EXIT
USE TIME_MOD, ONLY : ITS_TIME_FOR_UNIT,ITS_TIME_FOR_UNZIP
USE TIME_MOD, ONLY : ITS_TIME_FOR_BPCH
USE TIME_MOD, ONLY : SET_CT_CONV, SET_CT_DYN
USE TIME_MOD, ONLY : SET_CT_EMIS, SET_CT_CHEM
USE TIME_MOD, ONLY : SET_DIAGb, SET_DIAGe
USE TIME_MOD, ONLY : SET_CURRENT_TIME, PRINT_CURRENT_TIME
USE TIME_MOD, ONLY : SET_ELAPSED_MIN, SYSTEM_TIMESTAMP
USE TRACER_MOD, ONLY : CHECK_STT, N_TRACERS, STT, TCVV
USE TRACER_MOD, ONLY : CHECK_STT_05x0666
USE TRACER_MOD, ONLY : ITS_AN_AEROSOL_SIM
USE TRACER_MOD, ONLY : ITS_A_CH4_SIM
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM
USE TRACER_MOD, ONLY : ITS_A_H2HD_SIM
USE TRACER_MOD, ONLY : ITS_A_MERCURY_SIM
USE TRACER_MOD, ONLY : ITS_A_TAGCO_SIM
USE TRANSPORT_MOD, ONLY : DO_TRANSPORT
USE TROPOPAUSE_MOD, ONLY : READ_TROPOPAUSE, CHECK_VAR_TROP
USE RESTART_MOD, ONLY : MAKE_RESTART_FILE, READ_RESTART_FILE
USE UVALBEDO_MOD, ONLY : READ_UVALBEDO
USE WETSCAV_MOD, ONLY : INIT_WETSCAV, DO_WETDEP
USE XTRA_READ_MOD, ONLY : GET_XTRA_FIELDS, OPEN_XTRA_FIELDS
USE XTRA_READ_MOD, ONLY : UNZIP_XTRA_FIELDS
USE ERROR_MOD, ONLY : IT_IS_NAN, IT_IS_FINITE !yxw
!! geos-fp (lzh, 04/10/2014)
USE TIME_MOD, ONLY : GET_A1_TIME, GET_FIRST_A1_TIME
USE TIME_MOD, ONLY : ITS_TIME_FOR_A1
USE TIME_MOD, ONLY : GET_I3_TIME, GET_FIRST_I3_TIME
USE TIME_MOD, ONLY : ITS_TIME_FOR_I3
USE TRACER_MOD, ONLY : CHECK_STT_025x03125
! To save CSPEC_FULL restart (dkh, 02/12/09)
USE LOGICAL_MOD, ONLY : LSVCSPEC
USE RESTART_MOD, ONLY : MAKE_CSPEC_FILE
! For strat chem (hml, 07/01/11, adj32_25)
!USE UPBDFLX_MOD, ONLY : DO_UPBDFLX, UPBDFLX_NOY
USE LOGICAL_MOD, ONLY : LLINOZ
USE LINOZ_MOD, ONLY : LINOZ_READ
! adj_group added the following:
USE ERROR_MOD, ONLY : ERROR_STOP
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
USE TIME_MOD, ONLY : SET_DIRECTION
USE CHECKPT_MOD, ONLY : CHK_PSC, MAKE_CHK_CON_FILE
USE CHECKPT_MOD, ONLY : CHK_STT_CON
USE CHECKPT_MOD, ONLY : CHK_STT_BEFCHEM
USE CHECKPT_MOD, ONLY : INIT_CHECKPT
#if defined ( IMPROVE_SO4_NIT_OBS )
USE IMPROVE_MOD, ONLY : IMPROVE_DATAPROC,
& INIT_IMPROVE, READ_IMPRV_BPCH
#endif
! (yhmao, dkh, 01/13/12, adj32_013)
#if defined ( IMPROVE_BC_OC_OBS )
USE IMPROVE_BC_MOD, ONLY : IMPROVE_DATAPROC,
& INIT_IMPROVE, READ_IMPRV_BPCH
#endif
#if defined ( CASTNET_NH4_OBS )
USE CASTNET_MOD, ONLY : CASTNET_DATAPROC,
& INIT_CASTNET, READ_CAST_BPCH
#endif
#if defined ( PM_ATTAINMENT )
USE ATTAINMENT_MOD, ONLY : INIT_ATTAINMENT
#endif
#if defined ( SOMO35_ATTAINMENT )
USE O3_ATTAIN_MOD, ONLY : INIT_O3_ATTAIN
#endif
#if defined ( TES_NH3_OBS )
USE TES_NH3_MOD, ONLY : INIT_TES_NH3
#endif
USE ADJ_ARRAYS_MOD, ONLY : EMS_SF, IFD, JFD, LFD, NFD
USE ADJ_ARRAYS_MOD, ONLY : ICSFD, DO_CHK_FILE
USE TRACERID_MOD, ONLY : IDTNOX, IDTH2O2
USE LOGICAL_ADJ_MOD, ONLY : LPRINTFD, LADJ
! mkeller: weak constraint stuff
USE WEAK_CONSTRAINT_MOD, ONLY : READ_FORCE_U_FILE
USE WEAK_CONSTRAINT_MOD, ONLY : GET_FORCE_U_FROM_X_U
USE WEAK_CONSTRAINT_MOD, ONLY : MAKE_FORCE_U_FILE
USE WEAK_CONSTRAINT_MOD, ONLY : FORCE_U_FULLGRID
USE WEAK_CONSTRAINT_MOD, ONLY : DO_WEAK_CONSTRAINT
USE WEAK_CONSTRAINT_MOD, ONLY : ITS_TIME_FOR_U
USE WEAK_CONSTRAINT_MOD, ONLY : SET_CT_U
USE WEAK_CONSTRAINT_MOD, ONLY : SET_CT_MAIN_U
USE WEAK_CONSTRAINT_MOD, ONLY : CT_SUB_U
USE WEAK_CONSTRAINT_MOD, ONLY : CT_MAIN_U
USE WEAK_CONSTRAINT_MOD, ONLY : PERTURB_STT_U
USE WEAK_CONSTRAINT_MOD, ONLY : N_TRACER_U
USE DAO_MOD, ONLY : CONVERT_UNITS_FORCING
USE GRID_MOD, ONLY : GET_XMID
USE GRID_MOD, ONLY : GET_YMID
! mkeller: HIPPO stuff
USE HIPPO_MOD, ONLY : INIT_HIPPO, CLEANUP_HIPPO, READ_HIPPO_DATA
USE HIPPO_MOD, ONLY : COMPARE_HIPPO_DATA, WRITE_HIPPO_DATA
! Force all variables to be declared explicitly
IMPLICIT NONE
! Header files
# include "CMN_SIZE" ! Size parameters
# include "CMN_DIAG" ! Diagnostic switches, NJDAY
# include "CMN_GCTM" ! Physical constants
! Local variables
LOGICAL :: FIRST = .TRUE.
LOGICAL :: LXTRA
INTEGER :: I, IOS, J, K, L
INTEGER :: N, JDAY, NDIAGTIME, N_DYN
INTEGER :: N_DYN_STEPS, NSECb, N_STEP, DATE(2)
INTEGER :: YEAR, MONTH, DAY, DAY_OF_YEAR
INTEGER :: SEASON, NYMD, NYMDb, NHMS
INTEGER :: ELAPSED_SEC, NHMSb
INTEGER :: DATE1(2), YYYYMMDD1
REAL*8 :: TAU, TAUb
CHARACTER(LEN=255) :: ZTYPE
! mkeller: weak constraint stuff
INTEGER :: IMK, JMK, KMK, NMK
LOGICAL :: FIRST_FORCE_U = .TRUE.
CONTAINS
SUBROUTINE DO_GEOS_CHEM
! adj_group
USE LOGICAL_ADJ_MOD, ONLY : LADJ
!=================================================================
! GEOS-CHEM starts here!
!=================================================================
! Display current grid resolution and data set type
CALL DISPLAY_GRID_AND_MODEL
!=================================================================
! ***** I N I T I A L I Z A T I O N *****
!=================================================================
! adj_group: set DIRECTION to indicate that it's forward integration
CALL INIT_HIPPO
CALL READ_HIPPO_DATA
CALL SET_DIRECTION( 1 )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a READ_INPUT_FILE' )
! Initialize met field arrays from "dao_mod.f"
CALL INIT_DAO
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a INIT_DAO' )
! Initialize diagnostic arrays and counters
CALL INITIALIZE( 2 )
CALL INITIALIZE( 3 )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a INITIALIZE' )
! Initialize the new hybrid pressure module. Define Ap and Bp.
CALL INIT_PRESSURE
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a INIT_PRESSURE' )
! Read annual mean tropopause if not a variable tropopause
! read_tropopause is obsolete with variable tropopause
IF ( .not. LVARTROP ) THEN
CALL READ_TROPOPAUSE
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a READ_TROPOPAUSE' )
ENDIF
! Initialize allocatable SMVGEAR arrays
IF ( LEMIS .or. LCHEM ) THEN
IF ( ITS_A_FULLCHEM_SIM() ) CALL INIT_COMODE
IF ( ITS_AN_AEROSOL_SIM() ) CALL INIT_COMODE
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a INIT_COMODE' )
ENDIF
! ( hml, 07/01/11 )
! Added to read input file for linoz strat (dbj, jliu, bmy, 10/16/09)
IF ( LLINOZ ) CALL LINOZ_READ
! adj_group: add support for CH4 (adj32_023)
! Allocate arrays from "global_ch4_mod.f" for CH4 run
IF ( ITS_A_CH4_SIM() ) CALL INIT_GLOBAL_CH4
! Initialize MEGAN arrays, get 15-day avg temperatures
IF ( LMEGAN ) THEN
CALL INIT_MEGAN
CALL INITIALIZE( 2 )
CALL INITIALIZE( 3 )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a INIT_MEGAN' )
ENDIF
! adj_group
#if defined ( IMPROVE_SO4_NIT_OBS )
CALL INIT_IMPROVE
#endif
! (yhmao, dkh, 01/13/12, adj32_013)
#if defined ( IMPROVE_BC_OC_OBS )
CALL INIT_IMPROVE
#endif
#if defined ( TES_NH3_OBS )
CALL INIT_TES_NH3
#endif
#if defined ( CASTNET_NH4_OBS )
CALL INIT_CASTNET
#endif
#if defined ( PM_ATTAINMENT )
CALL INIT_ATTAINMENT
#endif
#if defined ( SOMO35_ATTAINMENT )
CALL INIT_O3_ATTAIN
#endif
! dkh : use these for making data:
!CALL IMPROVE_DATAPROC
!CALL READ_IMPRV_BPCH( 20050730 )
!CALL CASTNET_DATAPROC
!CALL READ_CAST_BPCH( 20020122 )
!CALL ERROR_STOP('force exit', 'on purpose')
! yhmao : use for making data (adj32_013)
!DATE1(1) = GET_NYMD()
!YYYYMMDD1=DATE1(1)
!DO while (YYYYMMDD1<=20060105)
!CALL IMPROVE_DATAPROC (YYYYMMDD1)
!CALL READ_IMPRV_BPCH( YYYYMMDD1)
!print*,'YYYYMMDD',YYYYMMDD1
!YYYYMMDD1=YYYYMMDD1+3
!enddo
! Local flag for reading XTRA fields for GEOS-3
!LXTRA = ( LDUST .or. LMEGAN )
LXTRA = LMEGAN
! Define time variables for use below
NHMS = GET_NHMS()
NHMSb = GET_NHMSb()
NYMD = GET_NYMD()
NYMDb = GET_NYMDb()
TAU = GET_TAU()
TAUb = GET_TAUb()
!!! (lzh, 04/09/2014)
#if defined( GEOS_FP )
! Read time-invariant data
CALL GEOSFP_READ_CN
! Read 1-hr time-averaged data
DATE = GET_FIRST_A1_TIME()
CALL GEOSFP_READ_A1( DATE(1), DATE(2) )
! Read 3-hr time averaged data
DATE = GET_FIRST_A3_TIME()
CALL GEOSFP_READ_A3( DATE(1), DATE(2) )
! Read 3-hr time averaged data
DATE = GET_FIRST_I3_TIME()
CALL GEOSFP_READ_I3_1( DATE(1), DATE(2) )
#else
!=================================================================
! ***** U N Z I P M E T F I E L D S @ start of run *****
!=================================================================
IF ( LUNZIP ) THEN
!---------------------
! Remove all files
!---------------------
! Type of unzip operation
ZTYPE = 'remove all'
! Remove any leftover A-3, A-6, I-6, in temp dir
CALL UNZIP_A3_FIELDS( ZTYPE )
CALL UNZIP_A6_FIELDS( ZTYPE )
CALL UNZIP_I6_FIELDS( ZTYPE )
#if defined( GEOS_3 )
! Remove GEOS-3 GWET and XTRA files
IF ( LDUST ) CALL UNZIP_GWET_FIELDS( ZTYPE )
IF ( LXTRA ) CALL UNZIP_XTRA_FIELDS( ZTYPE )
#endif
#if defined( GCAP )
! Unzip GCAP PHIS field (if necessary)
CALL UNZIP_GCAP_FIELDS( ZTYPE )
#endif
!---------------------
! Unzip in foreground
!---------------------
! Type of unzip operation
ZTYPE = 'unzip foreground'
! Unzip A-3, A-6, I-6 files for START of run
CALL UNZIP_A3_FIELDS( ZTYPE, NYMDb )
CALL UNZIP_A6_FIELDS( ZTYPE, NYMDb )
CALL UNZIP_I6_FIELDS( ZTYPE, NYMDb )
#if defined( GEOS_3 )
! Unzip GEOS-3 GWET and XTRA fields for START of run
IF ( LDUST ) CALL UNZIP_GWET_FIELDS( ZTYPE, NYMDb )
IF ( LXTRA ) CALL UNZIP_XTRA_FIELDS( ZTYPE, NYMDb )
#endif
#if defined( GCAP )
! Unzip GCAP PHIS field (if necessary)
CALL UNZIP_GCAP_FIELDS( ZTYPE )
#endif
!### Debug output
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a UNZIP' )
ENDIF
!=================================================================
! ***** R E A D M E T F I E L D S @ start of run *****
!=================================================================
! Open and read A-3 fields
DATE = GET_FIRST_A3_TIME()
CALL OPEN_A3_FIELDS( DATE(1), DATE(2) )
CALL GET_A3_FIELDS( DATE(1), DATE(2) )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a 1st A3 TIME' )
! For MEGAN biogenics, update hourly temps w/in 15-day window
IF ( LMEGAN ) THEN
CALL UPDATE_T_DAY
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: UPDATE T_DAY' )
ENDIF
! Open & read A-6 fields
DATE = GET_FIRST_A6_TIME()
CALL OPEN_A6_FIELDS( DATE(1), DATE(2) )
CALL GET_A6_FIELDS( DATE(1), DATE(2) )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a 1st A6 TIME' )
! Open & read I-6 fields
DATE = (/ NYMD, NHMS /)
CALL OPEN_I6_FIELDS( DATE(1), DATE(2) )
CALL GET_I6_FIELDS_1( DATE(1), DATE(2) )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a 1st I6 TIME' )
#if defined( GEOS_3 )
! Open & read GEOS-3 GWET fields
IF ( LDUST ) THEN
DATE = GET_FIRST_A3_TIME()
CALL OPEN_GWET_FIELDS( DATE(1), DATE(2) )
CALL GET_GWET_FIELDS( DATE(1), DATE(2) )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a 1st GWET TIME' )
ENDIF
! Open & read GEOS-3 XTRA fields
IF ( LXTRA ) THEN
DATE = GET_FIRST_A3_TIME()
CALL OPEN_XTRA_FIELDS( DATE(1), DATE(2) )
CALL GET_XTRA_FIELDS( DATE(1), DATE(2) )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a 1st XTRA TIME' )
ENDIF
#endif
#if defined( GCAP )
! Read GCAP PHIS and LWI fields (if necessary)
CALL OPEN_GCAP_FIELDS
CALL GET_GCAP_FIELDS
! Remove temporary file (if necessary)
IF ( LUNZIP ) THEN
CALL UNZIP_GCAP_FIELDS( 'remove date' )
ENDIF
#endif
!!! add geos_fp (lzh, 04/09/2014)
#endif
! Compute avg surface pressure near polar caps
CALL AVGPOLE( PS1 )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a AVGPOLE' )
! Call AIRQNT to compute air mass quantities from PS1
CALL SET_FLOATING_PRESSURE( PS1 )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a SET_FLT_PRS' )
CALL AIRQNT
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a AIRQNT' )
! adj_group
IF ( LPRINTFD ) THEN
CALL DISPLAY_MET(155,0)
ENDIF
! Compute lightning NOx emissions [molec/box/6h]
IF ( LLIGHTNOX ) THEN
CALL LIGHTNING
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a LIGHTNING' )
ENDIF
! Read land types and fractions from "vegtype.global"
CALL RDLAND
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a RDLAND' )
! Initialize PBL quantities but do not do mixing
CALL DO_PBL_MIX( .FALSE. )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a TURBDAY:1' )
!=================================================================
! ***** I N I T I A L C O N D I T I O N S *****
!=================================================================
IF ( LADJ ) THEN ! adj_group
! Allocate and initialize the CHK arrays
CALL INIT_CHECKPT
! Read from restart F4
CALL READ_RESTART_FILE( NYMDb, NHMSb )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a READ_RESTART_FILE' )
! Apply scaling factors to the initial tracer concentrations
CALL APPLY_IC_SCALING
ELSE
! Read initial tracer conditions
CALL READ_RESTART_FILE( NYMDb, NHMSb )
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a READ_RESTART_FILE' )
! Read ocean Hg initial conditions (if necessary)
IF ( ITS_A_MERCURY_SIM() .and. LDYNOCEAN ) THEN
CALL READ_OCEAN_Hg_RESTART( NYMDb, NHMSb )
IF ( LPRT ) CALL DEBUG_MSG('### MAIN: a READ_OCEAN_RESTART')
ENDIF
ENDIF
! Save initial tracer masses to disk for benchmark runs
IF ( LSTDRUN ) CALL STDRUN( LBEGIN=.TRUE. )
!=================================================================
! ***** 6 - H O U R T I M E S T E P L O O P *****
!=================================================================
! Echo message before first timestep
WRITE( 6, '(a)' )
WRITE( 6, '(a)' ) REPEAT( '*', 44 )
WRITE( 6, '(a)' ) '* B e g i n T i m e S t e p p i n g !! *'
WRITE( 6, '(a)' ) REPEAT( '*', 44 )
WRITE( 6, '(a)' )
! NSTEP is the number of dynamic timesteps w/in a 6-h interval
!! N_DYN_STEPS = 360 / GET_TS_DYN()
!! add geos_fp, 3-hour loop (lzh, 04/09/2014)
#if defined( GEOS_FP )
N_DYN_STEPS = 180 / GET_TS_DYN() ! GEOS-5.7.x has a 3-hr interval
#else
N_DYN_STEPS = 360 / GET_TS_DYN() ! All other met has a 6hr interval
#endif
! Start a new 6-h loop
DO
! Compute time parameters at start of 6-h loop
CALL SET_CURRENT_TIME
! NSECb is # of seconds at the start of 6-h loop
NSECb = GET_ELAPSED_SEC()
! Get dynamic timestep in seconds
N_DYN = 60d0 * GET_TS_DYN()
!=================================================================
! ***** D Y N A M I C T I M E S T E P L O O P *****
!=================================================================
DO N_STEP = 1, N_DYN_STEPS
! Compute & print time quantities at start of dyn step
CALL SET_CURRENT_TIME
CALL PRINT_CURRENT_TIME
! Set time variables for dynamic loop
DAY_OF_YEAR = GET_DAY_OF_YEAR()
ELAPSED_SEC = GET_ELAPSED_SEC()
MONTH = GET_MONTH()
NHMS = GET_NHMS()
NYMD = GET_NYMD()
TAU = GET_TAU()
YEAR = GET_YEAR()
SEASON = GET_SEASON()
! mkeller: weak constraint stuff
IF ( DO_WEAK_CONSTRAINT ) THEN
CALL SET_CT_U ( INCREASE = .TRUE. )
print *, ' WEAK_CONSTRAINT: Date at beginning of loop'
print *, ' WEAK_CONSTRAINT: ', GET_NYMD(), GET_NHMS()
print *, ' WEAK_CONSTRAINT: ', ct_sub_u
IF ( FIRST_FORCE_U ) THEN
CALL GET_FORCE_U_FROM_X_U ! Values in X_U are in v/v
CALL MAKE_FORCE_U_FILE( GET_NYMD(), GET_NHMS() )
CALL CONVERT_UNITS_FORCING( 2, N_TRACERS, N_TRACER_U,
& TCVV, AD, FORCE_U_FULLGRID )
FIRST_FORCE_U = .FALSE.
ENDIF
IF ( ITS_TIME_FOR_U() ) THEN
!mkeller: write forcing values to disk
CALL SET_CT_MAIN_U ( INCREASE = .TRUE. )
CALL SET_CT_U ( RESET = .TRUE. )
CALL GET_FORCE_U_FROM_X_U !mkeller: X_U values are in v/v
CALL MAKE_FORCE_U_FILE( GET_NYMD(), GET_NHMS() )
CALL CONVERT_UNITS_FORCING( 2, N_TRACERS, N_TRACER_U,
& TCVV, AD, FORCE_U_FULLGRID )
ENDIF
ENDIF ! DO_WEAK_CONSTRAINT
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a SET_CURRENT_TIME' )
!==============================================================
! ***** W R I T E D I A G N O S T I C F I L E S *****
!==============================================================
IF ( ITS_TIME_FOR_BPCH() ) THEN
! Set time at end of diagnostic timestep
CALL SET_DIAGe( TAU )
! Write bpch file
CALL DIAG3
! Flush file units
CALL CTM_FLUSH
!===========================================================
! ***** W R I T E R E S T A R T F I L E S *****
!===========================================================
IF ( LSVGLB ) THEN
! Make atmospheric restart file
CALL MAKE_RESTART_FILE( NYMD, NHMS, TAU )
IF (.NOT. LADJ) THEN
! Make ocean mercury restart file
IF ( ITS_A_MERCURY_SIM() .and. LDYNOCEAN ) THEN
CALL MAKE_OCEAN_Hg_RESTART( NYMD, NHMS, TAU )
ENDIF
ENDIF
! Save SOA quantities GPROD & APROD
IF ( LSOA .and. LCHEM ) THEN
CALL WRITE_GPROD_APROD( NYMD, NHMS, TAU )
ENDIF
! Save species concentrations (CSPEC_FULL). (dkh, 02/12/09)
IF ( LCHEM .and. LSVCSPEC ) THEN
CALL MAKE_CSPEC_FILE( NYMD, NHMS )
ENDIF
!### Debug
IF ( LPRT ) THEN
CALL DEBUG_MSG( '### MAIN: a MAKE_RESTART_FILE' )
ENDIF
ENDIF
! Set time at beginning of next diagnostic timestep
CALL SET_DIAGb( TAU )
!===========================================================
! ***** Z E R O D I A G N O S T I C S *****
!===========================================================
CALL INITIALIZE( 2 ) ! Zero arrays
CALL INITIALIZE( 3 ) ! Zero counters
ENDIF
!==============================================================
! ***** T E S T F O R E N D O F R U N *****
!==============================================================
IF ( ITS_TIME_FOR_EXIT() ) GOTO 9999
!!! (lzh, 04/09/2014)
#if defined( GEOS_FP )
!==============================================================
! ****** R E A D G E O S -- 5 . 7 . x F I E L D S *****
!==============================================================
!---------------------------------
! A-1 fields (1hr time averaged)
!---------------------------------
IF ( ITS_TIME_FOR_A1() ) THEN
DATE = GET_A1_TIME()
CALL GEOSFP_READ_A1( DATE(1), DATE(2) )
! Update daily mean temperature archive for MEGAN biogenics
! (tmf, 1/4/2012) This should be turned on!
IF ( LMEGAN ) CALL UPDATE_T_DAY
ENDIF
!----------------------------------
! A-3 fields (3-hr time averaged)
!----------------------------------
IF ( ITS_TIME_FOR_A3() ) THEN
DATE = GET_A3_TIME()
CALL GEOSFP_READ_A3( DATE(1), DATE(2) )
! Since CLDTOPS is an A-3 field, update the
! lightning NOx emissions [molec/box/6h]
IF ( LLIGHTNOX ) CALL LIGHTNING
ENDIF
!----------------------------------
! I-3 fields (3-hr instantaneous
!----------------------------------
IF ( ITS_TIME_ FOR_I3() ) THEN
DATE = GET_I3_TIME()
CALL GEOSFP_READ_I3_2( DATE(1), DATE(2) )
! Compute avg pressure at polar caps
CALL AVGPOLE( PS2 )
ENDIF
#else
!===============================================================
! ***** U N Z I P M E T F I E L D S *****
!===============================================================
IF ( LUNZIP .and. ITS_TIME_FOR_UNZIP() ) THEN
! Get the date & time for 12h (720 mins) from now
DATE = GET_TIME_AHEAD( 720 )
! If LWAIT=T then wait for the met fields to be
! fully unzipped before proceeding w/ the run.
! Otherwise, unzip fields in the background
IF ( LWAIT ) THEN
ZTYPE = 'unzip foreground'
ELSE
ZTYPE = 'unzip background'
ENDIF
! Unzip A3, A6, I6 fields
CALL UNZIP_A3_FIELDS( ZTYPE, DATE(1) )
CALL UNZIP_A6_FIELDS( ZTYPE, DATE(1) )
CALL UNZIP_I6_FIELDS( ZTYPE, DATE(1) )
#if defined( GEOS_3 )
! Unzip GEOS-3 GWET & XTRA fields
IF ( LDUST ) CALL UNZIP_GWET_FIELDS( ZTYPE, DATE(1) )
IF ( LXTRA ) CALL UNZIP_XTRA_FIELDS( ZTYPE, DATE(1) )
#endif
ENDIF
!===============================================================
! ***** R E M O V E M E T F I E L D S *****
!===============================================================
! BUG FIX: don't delete for adjoint (zj, dkh, 07/30/10)
!IF ( LUNZIP .and. ITS_TIME_FOR_DEL() ) THEN
IF ( LUNZIP .and. ITS_TIME_FOR_DEL() .and. (.not. LADJ) ) THEN
! Type of operation
ZTYPE = 'remove date'
! Remove A-3, A-6, and I-6 files only for the current date
CALL UNZIP_A3_FIELDS( ZTYPE, NYMD )
CALL UNZIP_A6_FIELDS( ZTYPE, NYMD )
CALL UNZIP_I6_FIELDS( ZTYPE, NYMD )
#if defined( GEOS_3 )
! Remove GEOS-3 GWET & XTRA fields only for the current date
IF ( LDUST ) CALL UNZIP_GWET_FIELDS( ZTYPE, NYMD )
IF ( LXTRA ) CALL UNZIP_XTRA_FIELDS( ZTYPE, NYMD )
#endif
ENDIF
!==============================================================
! ***** R E A D A - 3 F I E L D S *****
!==============================================================
IF ( ITS_TIME_FOR_A3() ) THEN
! Get the date/time for the next A-3 data block
DATE = GET_A3_TIME()
! Open & read A-3 fields
CALL OPEN_A3_FIELDS( DATE(1), DATE(2) )
CALL GET_A3_FIELDS( DATE(1), DATE(2) )
! Update daily mean temperature archive for MEGAN biogenics
IF ( LMEGAN ) CALL UPDATE_T_DAY
#if defined( GEOS_3 )
! Read GEOS-3 GWET fields
IF ( LDUST ) THEN
CALL OPEN_GWET_FIELDS( DATE(1), DATE(2) )
CALL GET_GWET_FIELDS( DATE(1), DATE(2) )
ENDIF
! Read GEOS-3 PARDF, PARDR, SNOW fields
IF ( LXTRA ) THEN
CALL OPEN_XTRA_FIELDS( DATE(1), DATE(2) )
CALL GET_XTRA_FIELDS( DATE(1), DATE(2) )
ENDIF
#endif
ENDIF
!==============================================================
! ***** R E A D A - 6 F I E L D S *****
!==============================================================
IF ( ITS_TIME_FOR_A6() ) THEN
! Get the date/time for the next A-6 data block
DATE = GET_A6_TIME()
! Open and read A-6 fields
CALL OPEN_A6_FIELDS( DATE(1), DATE(2) )
CALL GET_A6_FIELDS( DATE(1), DATE(2) )
! Since CLDTOPS is an A-6 field, update the
! lightning NOx emissions [molec/box/6h]
IF ( LLIGHTNOX ) CALL LIGHTNING
ENDIF
!==============================================================
! ***** R E A D I - 6 F I E L D S *****
!==============================================================
IF ( ITS_TIME_FOR_I6() ) THEN
! Get the date/time for the next I-6 data block
DATE = GET_I6_TIME()
! Open and read files
CALL OPEN_I6_FIELDS( DATE(1), DATE(2) )
CALL GET_I6_FIELDS_2( DATE(1), DATE(2) )
! Compute avg pressure at polar caps
CALL AVGPOLE( PS2 )
ENDIF
!!! (lzh, 04/09/2014)
#endif
!==============================================================
! ***** M O N T H L Y O R S E A S O N A L D A T A *****
!==============================================================
! UV albedoes
IF ( LCHEM .and. ITS_A_NEW_MONTH() ) THEN
CALL READ_UVALBEDO( MONTH )
ENDIF
! Fossil fuel emissions (SMVGEAR)
IF ( ITS_A_FULLCHEM_SIM() .or. ITS_A_TAGCO_SIM() ) THEN
IF ( LEMIS .and. ITS_A_NEW_SEASON() ) THEN
CALL ANTHROEMS( SEASON )
ENDIF
ENDIF
!==============================================================
! ***** D A I L Y D A T A *****
!==============================================================
IF ( ITS_A_NEW_DAY() ) THEN
! Read leaf-area index (needed for drydep)
CALL RDLAI( DAY_OF_YEAR, MONTH )
! For MEGAN biogenics ...
IF ( LMEGAN ) THEN
! Read AVHRR daily leaf-area-index
CALL RDISOLAI( DAY_OF_YEAR, MONTH )
! Compute 15-day average temperature for MEGAN
CALL UPDATE_T_15_AVG
ENDIF
! Also read soil-type info for fullchem simulation
IF ( ITS_A_FULLCHEM_SIM() .or. ITS_A_H2HD_SIM() ) THEN
CALL RDSOIL
ENDIF
!### Debug
IF ( LPRT ) CALL DEBUG_MSG ( '### MAIN: a DAILY DATA' )
ENDIF
!==============================================================
! ***** I N T E R P O L A T E Q U A N T I T I E S *****
!==============================================================
! Interpolate I-6 fields to current dynamic timestep,
! based on their values at NSEC and NSEC+N_DYN
CALL INTERP( NSECb, ELAPSED_SEC, N_DYN )
! Case of variable tropopause:
! Check LLTROP and set LMIN, LMAX, and LPAUSE
! since this is not done with READ_TROPOPAUSE anymore.
! (Need to double-check that LMIN, Lmax are not used before-phs)
IF ( LVARTROP ) CALL CHECK_VAR_TROP
! If we are not doing transport, then make sure that
! the floating pressure is set to PSC2 (bdf, bmy, 8/22/02)
IF ( .not. LTRAN ) CALL SET_FLOATING_PRESSURE( PSC2 )
! Compute airmass quantities at each grid box
CALL AIRQNT
! Compute the cosine of the solar zenith angle array SUNCOS
! NOTE: SUNCOSB is not really used in PHYSPROC (bmy, 2/13/07)
CALL COSSZA( DAY_OF_YEAR, SUNCOS )
CALL COSSZA( DAY_OF_YEAR, SUNCOS_5hr, FIVE_HR=.TRUE. )
! Compute tropopause height for ND55 diagnostic
IF ( ND55 > 0 ) CALL TROPOPAUSE
#if defined( GEOS_3 )
! 1998 GEOS-3 carries the ground temperature and not the air
! temperature -- thus TS will be 2-3 K too high. As a quick fix,
! copy the temperature at the first sigma level into TS.
! (mje, bnd, bmy, 7/3/01)
IF ( YEAR == 1998 ) TS(:,:) = T(:,:,1)
#endif
! Update dynamic timestep
CALL SET_CT_DYN( INCREMENT=.TRUE. )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a INTERP, etc' )
! Get averaging intervals for local-time diagnostics
! (NOTE: maybe improve this later on)
! Placed after interpolation to get correct value of TROPP.
! (ccc, 12/9/08)
CALL DIAG_2PM
!==============================================================
! ***** U N I T C O N V E R S I O N ( kg -> v/v ) *****
!==============================================================
IF ( ITS_TIME_FOR_UNIT() ) THEN
CALL CONVERT_UNITS( 1, N_TRACERS, TCVV, AD, STT )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a CONVERT_UNITS:1' )
ENDIF
! adj_group
IF ( LPRINTFD ) THEN
WRITE(6,*) ' TCVV(FD) = ', TCVV(NFD)
WRITE(6,*) ' STT(FD) = ', STT(IFD,JFD,LFD,NFD),
& ' [ v/v ] '
WRITE(6,*) ' AD(FD) = ', AD(IFD,JFD,LFD)
ENDIF
!==============================================================
! ***** S T R A T O S P H E R I C F L U X E S *****
!==============================================================
! Now use new strat scheme (hml, adj32_025)
!IF ( LUPBD ) CALL DO_UPBDFLX
!==============================================================
! ***** T R A N S P O R T *****
!==============================================================
IF ( ITS_TIME_FOR_DYN() ) THEN
! adj_group
IF ( LPRINTFD ) THEN
CALL DISPLAY_MET( 155, 1 )
ENDIF
! adj_group
! Checkpoint the surface pressure before transport
IF ( LADJ ) CHK_PSC(:,:,1) = PSC2(:,:)
! adj_group debug
IF ( LPRINTFD ) THEN
print*, 'STT before tran = ', STT(IFD,JFD,LFD,NFD)
print*, 'PSC before tran = ', PSC2(IFD,JFD)
ENDIF
! Call the appropritate version of TPCORE
IF ( LTRAN ) CALL DO_TRANSPORT
! adj_group debug
IF ( LPRINTFD ) THEN
print*, 'STT after tran = ', STT(IFD,JFD,LFD,NFD)
ENDIF
! adj_group
! Checkpoint the surface pressure after transport
IF ( LADJ ) THEN
CHK_PSC(:,:,2) = GET_PFLT()
ENDIF
! Reset air mass quantities
CALL AIRQNT
! adj_group
IF ( LPRINTFD ) THEN
CALL DISPLAY_MET( 155 , 2 )
ENDIF
! Now use strat_chem_mod (hml, adj32_025)
!! Repartition [NOy] species after transport
!IF ( LUPBD .and. ITS_A_FULLCHEM_SIM() ) THEN
! CALL UPBDFLX_NOY( 2 )
!ENDIF
#if !defined( GEOS_5 ) && !defined( GEOS_FP )
! Get relative humidity (after recomputing pressures)
! NOTE: for GEOS-5 we'll read this from disk instead
CALL MAKE_RH
#endif
! Initialize wet scavenging and wetdep fields after
! the airmass quantities are reset after transport
IF ( LCONV .or. LWETD .or. LSULF) THEN
CALL INIT_WETSCAV
ENDIF
ENDIF
!-------------------------------
! Test for convection timestep
!-------------------------------
IF ( ITS_TIME_FOR_CONV() ) THEN
! Increment the convection timestep
CALL SET_CT_CONV( INCREMENT=.TRUE. )
!===========================================================
! ***** M I X E D L A Y E R M I X I N G *****
!===========================================================
! adj_group
!IF ( LPRINTFD ) THEN
! CALL DISPLAY_MET(155,3)
! CALL DISPLAY_MET(155,5)
!ENDIF
CALL DO_PBL_MIX( LTURB )
! adj_group
!CALL DISPLAY_MET(155,4)
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a TURBDAY:2' )
!===========================================================
! ***** C L O U D C O N V E C T I O N *****
!===========================================================
! adj_group
IF ( LPRINTFD ) THEN
write(6,*) ' Before CONVECTION : = ',
& STT(IFD,JFD,LFD,NFD)
ENDIF
! adj_group
#if defined( GEOS_4 )
DATE(1) = GET_NYMD()
DATE(2) = GET_NHMS()
! Make sure that we actually want to write a checkpt file
IF ( DO_CHK_FILE()) THEN
! save STT array with tracer values (in appropriate units)
!CALL GET_TRACER_VALUES( CHK_STT_CON(:,:,:,1:N_TRACERS) )
CHK_STT_CON(:,:,:,:) = REAL(STT(:,:,:,:),4)
CALL MAKE_CHK_CON_FILE ( DATE(1), DATE(2) )
ENDIF
#endif
IF ( LCONV ) THEN
CALL DO_CONVECTION
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a CONVECTION' )
ENDIF
! adj_group
IF ( LPRINTFD ) THEN
write(6,*) ' After CONVECTION : = ',
& STT(IFD,JFD,LFD,NFD)
ENDIF
ENDIF
!==============================================================
! ***** U N I T C O N V E R S I O N ( v/v -> kg ) *****
!==============================================================
IF ( ITS_TIME_FOR_UNIT() ) THEN
CALL CONVERT_UNITS( 2, N_TRACERS, TCVV, AD, STT )
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a CONVERT_UNITS:2' )
ENDIF
! adj_group debug
IF ( LPRINTFD ) THEN
print*, ' STT after UNITS:2 ', STT(IFD,JFD,LFD,NFD)
ENDIF
!-------------------------------
! Test for emission timestep
!-------------------------------
IF ( ITS_TIME_FOR_EMIS() ) THEN
! Save tracer values prior to chemistry for checkpointing
! (dkh, 08/08/05, adj_group, 6/09/09)
IF ( ITS_A_FULLCHEM_SIM() .AND. LADJ ) THEN
CHK_STT_BEFCHEM(:,:,:,:) = STT(:,:,:,:)
ENDIF
! Increment emission counter
CALL SET_CT_EMIS( INCREMENT=.TRUE. )
!========================================================
! ***** D R Y D E P O S I T I O N *****
!========================================================
IF ( LDRYD .and. ( .not. ITS_A_H2HD_SIM() ) ) CALL DO_DRYDEP
!========================================================
! ***** E M I S S I O N S *****
!========================================================
IF ( LEMIS ) CALL DO_EMISSIONS
ENDIF
!===========================================================
! ***** C H E M I S T R Y *****
!===========================================================
! adj_group: add support for CH4 (adj32_023)
! Also need to compute avg P, T for CH4 chemistry (bmy, 1/16/01)
IF ( ITS_A_CH4_SIM() ) CALL CH4_AVGTP
! Every chemistry timestep...
IF ( ITS_TIME_FOR_CHEM() ) THEN
! Increment chemistry timestep counter
CALL SET_CT_CHEM( INCREMENT=.TRUE. )
! adj_group
IF ( LPRINTFD ) THEN
write(6,*) ' Before CHEMISTRY : = ',
& STT(IFD,JFD,LFD,:)
ENDIF
! Call the appropriate chemistry routine
CALL DO_CHEMISTRY
! adj_group
IF ( LPRINTFD ) THEN
write(6,*) ' After CHEMISTRY : = ',
& STT(IFD,JFD,LFD,:)
ENDIF
ENDIF
! (lzh, 11/15/2014)
#if defined( GEOS_FP) && defined( GRID025x03125)
CALL CHECK_STT_025x03125( 'after chemistry' )
#endif
!==============================================================
! ***** W E T D E P O S I T I O N (rainout + washout) *****
!==============================================================
IF ( LWETD .and. ITS_TIME_FOR_DYN() ) CALL DO_WETDEP
! mkeller: weak constraint stuff
IF ( DO_WEAK_CONSTRAINT ) THEN
IF(PERTURB_STT_U) THEN
STT(10:16,20:25,18:22,N_TRACER_U) =
& STT(10:16,20:25,18:22,N_TRACER_U) +
& STT(10:16,20:25,18:22,N_TRACER_U)*0.01
ELSE
print *, ' WEAK_CONSTRAINT: Date at forcing time'
print *, ' WEAK_CONSTRAINT: ', GET_NYMD(), GET_NHMS()
print *, ' WEAK_CONSTRAINT: ', ct_sub_u
! add forcing terms (in units of kg/box)
! PRINT *, "MIN/MAX STT BEFORE: ", MINVAL(STT(:,:,30,2)),
! & MAXVAL(STT(:,:,30,2))
STT(:,:,:,N_TRACER_U) = STT(:,:,:,N_TRACER_U)
& + FORCE_U_FULLGRID(:,:,:)
! print *,' MIN/MAX FORCE:',MINVAL(FORCE_U_FULLGRID(:,:,30)),
! & MAXVAL(FORCE_U_FULLGRID(:,:,30))
! PRINT *, "MIN/MAX STT AFTER: ", MINVAL(STT(:,:,30,2)),
! & MAXVAL(STT(:,:,30,2))
ENDIF
ENDIF
!==============================================================
! ***** W R I T E O U T P U T ******
!
! Write tracer values to either an observation
! file or a checkpoint file, depending upon the type of
! forward run currently being done.
! (dkh, 08/10/05, adj_group, 6/09/09)
!==============================================================
IF ( LADJ ) CALL DO_OUTPUT
!==============================================================
! ***** A R C H I V E D I A G N O S T I C S *****
!==============================================================
IF ( ITS_TIME_FOR_DYN() ) THEN
! Accumulate several diagnostic quantities
CALL DIAG1
! ND41: save PBL height in 1200-1600 LT (amf)
! (for comparison w/ Holzworth, 1967)
IF ( ND41 > 0 ) CALL DIAG41
! ND42: SOA concentrations [ug/m3]
IF ( ND42 > 0 ) CALL DIAG42
! ND59: NH3 concentrations [ug/m3] (diag59 added, lz,10/11/10)
IF ( ND59 > 0 ) CALL DIAG59
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a DIAGNOSTICS' )
ENDIF
! Print atmospheric CH4 burden (for adjoint FD tests)
! (kjw, dkh, 02/12/12, adj32_023)
IF ( LADJ .and. ITS_TIME_FOR_CHEM( )
& .and. ITS_A_CH4_SIM() ) THEN
print*,'Total CH4 burden [kg] = ',SUM( STT(:,:,:,:) )
ENDIF
!==============================================================
! ***** T I M E S E R I E S D I A G N O S T I C S *****
!
! NOTE: Since we are saving soluble tracers, we must move
! the ND40, ND49, and ND52 timeseries diagnostics
! to after the call to DO_WETDEP (bmy, 4/22/04)
!==============================================================
! Plane following diagnostic
IF ( ND40 > 0 ) THEN
! Call SETUP_PLANEFLIGHT routine if necessary
IF ( ITS_A_NEW_DAY() ) THEN
! If it's a full-chemistry simulation but LCHEM=F,
! or if it's an offline simulation, call setup routine
IF ( ITS_A_FULLCHEM_SIM() ) THEN
IF ( .not. LCHEM ) CALL SETUP_PLANEFLIGHT
ELSE
CALL SETUP_PLANEFLIGHT
ENDIF
ENDIF
! Archive data along the flight track
CALL PLANEFLIGHT
ENDIF
! Station timeseries
IF ( ITS_TIME_FOR_DIAG48() ) CALL DIAG48
! 3-D timeseries
IF ( ITS_TIME_FOR_DIAG49() ) CALL DIAG49
! 24-hr timeseries
IF ( DO_SAVE_DIAG50 ) CALL DIAG50
! Morning or afternoon timeseries
IF ( DO_SAVE_DIAG51 ) CALL DIAG51
IF ( DO_SAVE_DIAG51b ) CALL DIAG51b
IF ( DO_SAVE_DIAG51c ) CALL DIAG51c
IF ( DO_SAVE_DIAG51d ) CALL DIAG51d
! Comment out for now
!! Column timeseries
!IF ( ND52 > 0 .and. ITS_TIME_FOR_ND52() ) THEN
! CALL DIAG52
! IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a ND52' )
!ENDIF
CALL COMPARE_HIPPO_DATA
!### After diagnostics
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: after TIMESERIES' )
!==============================================================
! ***** E N D O F D Y N A M I C T I M E S T E P *****
!==============================================================
! Check for NaN, Negatives, Infinities in STT once per hour
IF ( ITS_TIME_FOR_DIAG() ) THEN
! Sometimes STT in the stratosphere can be negative at
! the nested-grid domain edges. Force them to be zero before
! CHECK_STT (yxw)
#if defined( GEOS_5 ) && defined( GRID05x0666 )
CALL CHECK_STT_05x0666( 'End of Dynamic Loop' )
#endif
! (lzh,11/15/2014)
#if defined( GEOS_FP) && defined( GRID025x03125)
CALL CHECK_STT_025x03125( 'after dynamics step' )
#endif
CALL CHECK_STT( 'End of Dynamic Loop' )
ENDIF
! Increment elapsed time
CALL SET_ELAPSED_MIN
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: after SET_ELAPSED_MIN' )
ENDDO
!=================================================================
! ***** C O P Y I - 6 F I E L D S *****
!
! The I-6 fields at the end of this timestep become
! the fields at the beginning of the next timestep
!=================================================================
CALL COPY_I6_FIELDS
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: after COPY_I6_FIELDS' )
ENDDO
!=================================================================
! ***** C L E A N U P A N D Q U I T *****
!=================================================================
9999 CONTINUE
NYMD = GET_NYMD()
NHMS = GET_NHMS()
TAU = GET_TAU()
! Remove all files from temporary directory
!IF ( LUNZIP ) THEN
! adj_group: don't remove yet as they will be reused (dkh, 06/11/09)
IF ( LUNZIP .and. ( .not. LADJ ) ) THEN
! Type of operation
ZTYPE = 'remove all'
! Remove A3, A6, I6 fields
CALL UNZIP_A3_FIELDS( ZTYPE )
CALL UNZIP_A6_FIELDS( ZTYPE )
CALL UNZIP_I6_FIELDS( ZTYPE )
#if defined( GEOS_3 )
! Remove GEOS-3 GWET & XTRA fields
IF ( LDUST ) CALL UNZIP_GWET_FIELDS( ZTYPE )
IF ( LXTRA ) CALL UNZIP_XTRA_FIELDS( ZTYPE )
#endif
#if defined( GCAP )
! Remove GCAP PHIS field (if necessary)
CALL UNZIP_GCAP_FIELDS( ZTYPE )
#endif
ENDIF
CALL WRITE_HIPPO_DATA
CALL CLEANUP_HIPPO
! Print the mass-weighted mean OH concentration (if applicable)
CALL PRINT_DIAG_OH
! For model benchmarking, save final masses of
! Rn,Pb,Be or Ox to a binary punch file
IF ( LSTDRUN ) CALL STDRUN( LBEGIN=.FALSE. )
! Close all files
CALL CLOSE_FILES
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a CLOSE_FILES' )
! Deallocate dynamic module arrays
! adj_group: cleanup called from inverse_driver (dkh, 06/11/09)
IF ( .not. LADJ ) THEN
CALL CLEANUP
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a CLEANUP' )
ENDIF
! Print ending time of simulation
CALL DISPLAY_END_TIME
END SUBROUTINE DO_GEOS_CHEM
!-----------------------------------------------------------------------------------------
! Need this anymore?
!
! SUBROUTINE STORE_STT
!
!!
!!******************************************************************************
!! Subroutine STORE_STT saves a copy of the tracer arrat prior to chemistry.
!! These values are needed for ADJ_PARTITION.
!! (dkh, 08/08/05)
!!
!! Input passed through CMN
!! ============================================================================
!! (1 ) STT : Tracer concentrations [Kg]
!! (2 ) NTRACE : Numer of tracers
!!
!! Output passed through USE CHECKPT_MOD
!! ============================================================================
!! (1 ) CHK_STT_BEFCHEM : Tracer concentratons [Kg]
!!
!!******************************************************************************
!!
! ! Reference to f90 modules
! USE CHECKPT_MOD, ONLY : CHK_STT_BEFCHEM !, CHK_CSPEC
! USE TRACER_MOD, ONLY : N_TRACERS, STT
!
!# include "CMN_SIZE" ! Size params
!
! ! Local variables
! INTEGER I, J, L, N
!
! !=========================================================
! ! STORE_STT begins here!
! !=========================================================
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT ( SHARED )
!!$OMP+PRIVATE ( I, J, L, N )
! DO N = 1, N_TRACERS
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! CHK_STT_BEFCHEM(I,J,L,N) = STT(I,J,L,N)
!
! ENDDO
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ! Return to calling program
! END SUBROUTINE STORE_STT
!
!!------------------------------------------------------------------------------
SUBROUTINE DO_OUTPUT
!
!******************************************************************************
! Subroutine DO_OUTPUT writes values to either an observation file or a
! checkpt file, depending upon the type forward run currently being done.
! (dkh, 08/10/05)
!
! NOTES:
! (1 ) Added support for full chemistry. Moved all relevant code to this
! routine and added rotation of CSPEC arrays. (dkh, 08/10/05)
! (2 ) Now output concentrations in kg/box rather than ug/m3
! (3 ) Add N_CALC as argument. Now call MAKE_SAVE_FILE (dkh, 07/19/06)
! (4 ) Add support for MAKE_SAVE_FILE_2. Comment calls to MAKE_SAVE_FILE
! unless want to calculate global process specific finite difference
! sensitivities. (dkh, 01/23/07)
! (5 ) Add support for CASTNET_OBS (dkh, 04/24/07)
! (6 ) updated to v8, changed flags etc. (mk, dkh, ks, cs, 6/09/09)
! (7 ) BUG FIX: LVARTROP treated correctly (dkh, 01/26/11)
! (8 ) Add support for CH4 (kjw, dkh, 02/12/12, adj32_023)
!******************************************************************************
!
! Reference to f90 modules
USE COMODE_MOD, ONLY : CSPEC_FOR_KPP, CSPEC_PRIOR, JLOP
! LVARTROP support for adj (dkh, 01/26/11)
USE COMODE_MOD, ONLY : CSPEC_FULL_PRIOR
USE COMODE_MOD, ONLY : IXSAVE, IYSAVE, IZSAVE
USE COMODE_MOD, ONLY : ISAVE_PRIOR
USE COMODE_MOD, ONLY : NTLOOP_PRIOR
USE LOGICAL_MOD, ONLY : LVARTROP
#if defined ( IMPROVE_SO4_NIT_OBS )
USE IMPROVE_MOD, ONLY : ITS_TIME_FOR_IMPRV_OBS
USE IMPROVE_MOD, ONLY : ITS_TIME_FOR_IMPRV_OBS_START
USE IMPROVE_MOD, ONLY : ITS_TIME_FOR_IMPRV_OBS_STOP
USE IMPROVE_MOD, ONLY : UPDATE_AEROAVE, RESET_AEROAVE
USE IMPROVE_MOD, ONLY : MAKE_AEROAVE_FILE
#endif
! (yhmao, dkh, 01/13/12, adj32_013)
#if defined ( IMPROVE_BC_OC_OBS )
USE IMPROVE_BC_MOD, ONLY : ITS_TIME_FOR_IMPRV_OBS
USE IMPROVE_BC_MOD, ONLY : ITS_TIME_FOR_IMPRV_OBS_START
USE IMPROVE_BC_MOD, ONLY : ITS_TIME_FOR_IMPRV_OBS_STOP
USE IMPROVE_BC_MOD, ONLY : UPDATE_AEROAVE, RESET_AEROAVE
USE IMPROVE_BC_MOD, ONLY : MAKE_AEROAVE_FILE
USE TRACERID_MOD, ONLY : IDTBCPI, IDTBCPO
!& IDTOCPI, IDTOCPO
#endif
#if defined ( PM_ATTAINMENT )
USE ATTAINMENT_MOD, ONLY : ITS_TIME_FOR_AVE
USE ATTAINMENT_MOD, ONLY : ITS_TIME_FOR_AVE_START
USE ATTAINMENT_MOD, ONLY : ITS_TIME_FOR_AVE_STOP
USE ATTAINMENT_MOD, ONLY : UPDATE_AVE, RESET_AVE
USE ATTAINMENT_MOD, ONLY : MAKE_AVE_FILE
#endif
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS,
! (dkh, 07/19/06)
& GET_TIME_AHEAD, GET_NHMSe, GET_NYMDe,
& GET_TS_CHEM
USE CHECKPT_MOD, ONLY : MAKE_OBS_FILE, MAKE_CHECKPT_FILE,
& PART_CASE, CHK_STT_BEFCHEM,
& CHK_HSAVE,
! (dkh, 07/19/06)
& MAKE_FD_FILE, MAKE_FDGLOB_FILE
USE CHECKPT_MOD, ONLY : MAKE_CHK_DYN_FILE
USE CHECKPT_MOD, ONLY : CHK_STT
USE COMODE_MOD, ONLY : HSAVE
#if defined ( CASTNET_NH4_OBS )
USE CASTNET_MOD, ONLY : ITS_TIME_FOR_CAST_OBS
USE CASTNET_MOD, ONLY : ITS_TIME_FOR_CAST_OBS_START
USE CASTNET_MOD, ONLY : ITS_TIME_FOR_CAST_OBS_STOP
USE CASTNET_MOD, ONLY : UPDATE_CASTCHK, RESET_CASTCHK
USE CASTNET_MOD, ONLY : MAKE_CASTCHK_FILE
#endif
USE ERROR_MOD, ONLY : ERROR_STOP
#if defined ( SOMO35_ATTAINMENT )
USE O3_ATTAIN_MOD, ONLY : CALC_O3_PEAK
#endif
USE ADJ_ARRAYS_MOD, ONLY : N_CALC, IFD, JFD, LFD, NFD, OBS_STT
USE ADJ_ARRAYS_MOD, ONLY : ITS_TIME_FOR_OBS
USE LOGICAL_MOD, ONLY : LCHEM
USE LOGICAL_ADJ_MOD,ONLY : LPRINTFD
USE LOGICAL_ADJ_MOD,ONLY : LFDTEST
USE LOGICAL_ADJ_MOD,ONLY : LFD_GLOB
USE LOGICAL_ADJ_MOD,ONLY : LADJ_WDEP_LS
USE LOGICAL_ADJ_MOD,ONLY : LADJ_WDEP_CV
USE LOGICAL_ADJ_MOD,ONLY : LADJ_FDEP
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM, N_TRACERS,
& STT
USE TRACER_MOD, ONLY : ITS_A_CH4_SIM
USE ADJ_ARRAYS_MOD, ONLY : OBS_FREQ,DO_CHK_FILE
USE ADJ_ARRAYS_MOD, ONLY : INIT_CF_REGION
USE ADJ_ARRAYS_MOD, ONLY : INIT_UNITS_DEP
USE TIME_MOD, ONLY : GET_ELAPSED_MIN
# include "CMN_SIZE" ! Size params
# include "comode.h" ! NTLOOP, IGAS
! Local variables
INTEGER :: JLOOP, N
INTEGER :: DATE(2), DATE_AHEAD(2)
LOGICAL, SAVE :: FIRST = .TRUE.
! LVARTROP support for adj (dkh, 01/26/11)
INTEGER :: IX, IY, IZ
!=================================================================
! DO_OUTPUT begins here!
!=================================================================
! initialize some arrays we may want to use for calculating obs or forcing terms
IF ( FIRST ) THEN
CALL INIT_CF_REGION
IF ( LADJ_FDEP ) THEN
CALL INIT_UNITS_DEP
ENDIF
FIRST = .FALSE.
ENDIF
! Get current time
DATE(1) = GET_NYMD()
DATE(2) = GET_NHMS()
IF ( N_CALC == 0 ) THEN
IF ( ITS_A_CH4_SIM() ) THEN
print*,'Date(1), Date(2) ',DATE(1), DATE(2)
print*,'ITS_TIME_FOR_OBS ( ) = ',ITS_TIME_FOR_OBS ( )
ENDIF
IF ( ITS_TIME_FOR_OBS ( ) ) THEN
! Load the OBS_STT array with tracer values
!CALL GET_TRACER_VALUES( OBS_STT(:,:,:,1:N_TRACERS) )
OBS_STT(:,:,:,:) = STT(:,:,:,:)
! Write values for OBS_STT to *.obs.* file
CALL MAKE_OBS_FILE ( DATE(1), DATE(2) )
! Echo the observed quantity to the screen
IF ( LPRINTFD ) THEN
WRITE(6,*) ' OBS_STT(FD) = ', OBS_STT(IFD,JFD,LFD,NFD)
ENDIF
ENDIF
ELSE
! Only need to checkpoint data on chemistry timesteps
IF ( ITS_TIME_FOR_CHEM ( ) ) THEN
#if defined ( SOMO35_ATTAINMENT )
! Add for o3_attainment
CALL CALC_O3_PEAK
#endif
#if defined ( PM_ATTAINMENT )
IF ( ITS_TIME_FOR_AVE_START( 1 ) )THEN
! Write daily averages
CALL MAKE_AVE_FILE( DATE(1) - 1 )
! Reset running daily averages to zero
CALL RESET_AVE
ENDIF
IF ( ITS_TIME_FOR_AVE() ) THEN
CALL UPDATE_AVE( STT(:,:,1,IDTNIT),
& STT(:,:,1,IDTSO4),
& STT(:,:,1,IDTNH4),
& STT(:,:,1,IDTBCPI)
& +STT(:,:,1,IDTBCPO)
& +STT(:,:,1,IDTOCPI)
& +STT(:,:,1,IDTBCPO)
& )
ENDIF
#endif
#if defined ( IMPROVE_SO4_NIT_OBS )
IF ( ITS_TIME_FOR_IMPRV_OBS_START( 1 ) )THEN
! Reset running daily averages to zero
CALL RESET_AEROAVE
ENDIF
IF ( ITS_TIME_FOR_IMPRV_OBS() ) THEN
CALL UPDATE_AEROAVE( STT(:,:,1,IDTNIT),
& STT(:,:,1,IDTSO4),
& STT(:,:,1,IDTNH4) )
ENDIF
IF ( ITS_TIME_FOR_IMPRV_OBS_STOP( 1 ) ) THEN
! Write daily averages
CALL MAKE_AEROAVE_FILE( DATE(1) - 1 )
! Reset running daily averages (just to be safe)
CALL RESET_AEROAVE
ENDIF
#endif
! (yhmao, dkh, 01/13/12, adj32_013)
#if defined ( IMPROVE_BC_OC_OBS )
IF ( ITS_TIME_FOR_IMPRV_OBS_START( 1 ) )THEN
! Reset running daily averages to zero
CALL RESET_AEROAVE
ENDIF
IF ( ITS_TIME_FOR_IMPRV_OBS() ) THEN
!CALL IMPROVE_DATAPROC(DATE(1))
print*, 'IMPROVE',DATE(1)
!CALL READ_IMPRV_BPCH( DATE(1) )
CALL UPDATE_AEROAVE( STT(:,:,1,IDTBCPI),
& STT(:,:,1,IDTBCPO))
!& STT(:,:,1,IDTOCPI),
!& STT(:,:,1,IDTOCPO) )
ENDIF
IF ( ITS_TIME_FOR_IMPRV_OBS_STOP( 1 ) ) THEN
! Write daily averages
CALL MAKE_AEROAVE_FILE( DATE(1) - 1 )
print*,'write',DATE(1)-1
! Reset running daily averages (just to be safe)
CALL RESET_AEROAVE
ENDIF
#endif
#if defined ( CASTNET_NH4_OBS )
IF ( ITS_TIME_FOR_CAST_OBS() ) THEN
CALL UPDATE_CASTCHK( STT(:,:,1,IDTNH4) )
ENDIF
IF ( ITS_TIME_FOR_CAST_OBS_STOP( 1 ) ) THEN
! Write daily averages
CALL MAKE_CASTCHK_FILE( DATE(1) - 7 )
! Reset running daily averages (just to be safe)
CALL RESET_CASTCHK
ENDIF
IF ( ITS_TIME_FOR_CAST_OBS_START( 1 ) )THEN
! Reset running daily averages to zero
CALL RESET_CASTCHK
ENDIF
#endif
! Load the CHK_STT array with tracer values
!CALL GET_TRACER_VALUES( CHK_STT(:,:,:,1:N_TRACERS) )
CHK_STT(:,:,:,:) = STT(:,:,:,:)
! dkh debug
IF ( LPRINTFD .and. LCHEM .and.
& ITS_A_FULLCHEM_SIM() ) THEN
IF ( JLOP(IFD,JFD,LFD) > 0 ) THEN
print*, ' CSPEC write = ',
& CSPEC_PRIOR(JLOP(IFD,JFD,LFD),:)
print*, ' JLOP write = ', JLOP(IFD,JFD,LFD)
ENDIF
ENDIF
! Make sure that we actually want to write
! a checkpt file
IF ( DO_CHK_FILE() )
& CALL MAKE_CHECKPT_FILE ( DATE(1), DATE(2) )
ENDIF
IF ( ITS_TIME_FOR_CHEM() .or. ITS_TIME_FOR_CONV() ) THEN
! Accumulate deposition values for depostion-based cost function
IF ( LADJ_FDEP ) THEN
CALL UPDATE_FDEP_ARRAYS
ENDIF
ENDIF
! Save final out put as a *save* file for checking full
! chemistry (and chemistry only) adjoints.
! Now only do this for FD_GLOB, not FD_SPOT (dkh, 02/21/11)
!IF ( LFDTEST ) THEN
! Now break this section up a bit to distinguish between cases
! that need to make FD files on the CHEM vs DYN time steps.
! (dkh, 03/10/13)
IF ( LFD_GLOB ) THEN
DATE_AHEAD = -9999
! Wet dep forcing gets writtin on the DYN time step
IF ( LADJ_WDEP_LS .or. LADJ_WDEP_CV ) THEN
DATE_AHEAD = GET_TIME_AHEAD ( GET_TS_DYN() )
! All others on the chemistry time step
ELSEIF ( ITS_TIME_FOR_CHEM() ) THEN
DATE_AHEAD = GET_TIME_AHEAD ( GET_TS_CHEM() )
ENDIF
! For some reason GET_TIME_AHEAD returns 2400000 instead
! of 000000, so patch it here to be zero and advance
! the day by 1.
IF ( DATE_AHEAD(2) == 240000 ) THEN
DATE_AHEAD(1) = DATE_AHEAD(1) + 1
DATE_AHEAD(2) = 0
ENDIF
IF ( DATE_AHEAD(1) == GET_NYMDe() .AND.
& DATE_AHEAD(2) == GET_NHMSe() ) THEN
CALL MAKE_FD_FILE( DATE(1), DATE(2))
!! For 2nd order adjoints
IF ( N_CALC == 3 ) THEN
CALL MAKE_FDGLOB_FILE( DATE(1), DATE(2) )
!CALL ERROR_STOP('force quit', 'on purpose')
ENDIF
ENDIF
ENDIF
IF ( ITS_TIME_FOR_CHEM ( ) ) THEN
! Echo the observed quantity to the screen
IF ( LPRINTFD ) THEN
WRITE(6,*) ' CHK_STT(FD) = ', CHK_STT(IFD,JFD,LFD,NFD)
ENDIF
! Rotate arrays for fullchem simulation
IF ( ITS_A_FULLCHEM_SIM() .AND. LCHEM ) THEN
! LVARTROP support for adj (dkh, 01/26/11)
IF ( LVARTROP ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( JLOOP, N, IX, IY, IZ)
DO N = 1, IGAS
DO JLOOP = 1, NTLOOP
! 3-D array indices
IX = IXSAVE(JLOOP)
IY = IYSAVE(JLOOP)
IZ = IZSAVE(JLOOP)
CSPEC_FULL_PRIOR(IX,IY,IZ,N)
& = CSPEC_FOR_KPP(JLOOP,N)
ISAVE_PRIOR(JLOOP,1) = IX
ISAVE_PRIOR(JLOOP,2) = IY
ISAVE_PRIOR(JLOOP,3) = IZ
ENDDO
ENDDO
!$OMP END PARALLEL DO
NTLOOP_PRIOR = NTLOOP
ELSE
! Save the value of CSPEC after chemistry to CSPEC_PRIOR, which
! will be saved to chk file next time step.
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( JLOOP, N )
DO N = 1, IGAS
DO JLOOP = 1, NTLOOP
CSPEC_PRIOR(JLOOP,N) = CSPEC_FOR_KPP(JLOOP,N)
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
! Save the value of HSAVE to CHK_HSAVE, which will be written
! to chk file next time step. (dkh, 09/06/05)
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO I = 1, IIPAR
DO J = 1, JJPAR
DO L = 1, LLTROP
CHK_HSAVE(I,J,L) = HSAVE(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF ! fullchem
! Echo the observed quantity to the screen
!IF ( LPRINTFD .AND. ITS_A_FULLCHEM_SIM() ) THEN
IF ( LPRINTFD .and. LCHEM .and. ITS_A_FULLCHEM_SIM() ) THEN
IF( JLOP(IFD,JFD,LFD) > 0 ) THEN
WRITE(6,*) 'CHK_STT(FD) = ',CHK_STT(IFD,JFD,LFD,NFD)
WRITE(6,*) 'STT_BEFCHEM(FD) =',
& CHK_STT_BEFCHEM(IFD,JFD,LFD,NFD)
WRITE(6,*) 'PART_CASE(FD) = ',
& PART_CASE(JLOP(IFD,JFD,LFD))
ENDIF
ENDIF
ENDIF ! ITS_TIME_FOR_CHEM
! Now write out checkpoint at the dynamic time step as well. (dkh, 02/02/09)
IF ( DO_CHK_FILE() )
& CALL MAKE_CHK_DYN_FILE( DATE(1), DATE(2) )
ENDIF !N_CALC
! Return to calling program
END SUBROUTINE DO_OUTPUT
!------------------------------------------------------------------------------!
SUBROUTINE UPDATE_FDEP_ARRAYS( )
!
!******************************************************************************
! Subroutine UPDATE_FDEP_ARRAYS updates arrays that we use for tracking the
! value of the deposition-based cost function. (dkh, 04/25/13)
!
!
! NOTES:
!
!******************************************************************************
!
! Reference to f90 modules
USE ADJ_ARRAYS_MOD, ONLY : NSPAN
USE ADJ_ARRAYS_MOD, ONLY : DDEP_TRACER
USE ADJ_ARRAYS_MOD, ONLY : DDEP_CSPEC
USE ADJ_ARRAYS_MOD, ONLY : WDEP_CV
USE ADJ_ARRAYS_MOD, ONLY : WDEP_LS
USE ADJ_ARRAYS_MOD, ONLY : AD44_OLD
USE ADJ_ARRAYS_MOD, ONLY : AD44_CSPEC_OLD
USE ADJ_ARRAYS_MOD, ONLY : AD38_OLD
USE ADJ_ARRAYS_MOD, ONLY : AD39_OLD
USE ADJ_ARRAYS_MOD, ONLY : NOBS2NDEP
USE ADJ_ARRAYS_MOD, ONLY : NOBSCSPEC2NDEP
USE ADJ_ARRAYS_MOD, ONLY : NOBS2NWDEP
USE ADJ_ARRAYS_MOD, ONLY : TRACER_IND
USE ADJ_ARRAYS_MOD, ONLY : GET_CF_REGION
USE ADJ_ARRAYS_MOD, ONLY : TR_DDEP_CONV
USE ADJ_ARRAYS_MOD, ONLY : CS_DDEP_CONV
USE ADJ_ARRAYS_MOD, ONLY : TR_WDEP_CONV
USE ADJ_ARRAYS_MOD, ONLY : NOBS
USE ADJ_ARRAYS_MOD, ONLY : NOBS_CSPEC
USE ADJ_ARRAYS_MOD, ONLY : OBS_FREQ
USE DIAG_MOD, ONLY : AD38
USE DIAG_MOD, ONLY : AD39
USE DIAG_MOD, ONLY : AD44
USE LOGICAL_ADJ_MOD, ONLY : LADJ_DDEP_TRACER
USE LOGICAL_ADJ_MOD, ONLY : LADJ_DDEP_CSPEC
USE LOGICAL_ADJ_MOD, ONLY : LADJ_WDEP_CV
USE LOGICAL_ADJ_MOD, ONLY : LADJ_WDEP_LS
USE LOGICAL_ADJ_MOD, ONLY : LMAX_OBS
USE TIME_MOD, ONLY : GET_TS_CHEM
USE TIME_MOD, ONLY : GET_TS_CONV
USE TIME_MOD, ONLY : GET_TIME_AHEAD
USE TIME_MOD, ONLY : GET_NYMDe
USE TIME_MOD, ONLY : GET_NHMSe
USE TRACERID_MOD, ONLY : IDTSO4
USE TRACERID_MOD, ONLY : IDTNIT
USE TRACERID_MOD, ONLY : IDTNH3
USE TRACERID_MOD, ONLY : IDTNH4
! Local variables
LOGICAL, SAVE :: FIRST = .TRUE.
LOGICAL, SAVE :: FORCE = .FALSE.
INTEGER :: I
INTEGER :: J
INTEGER :: N
INTEGER :: N_TRACER
INTEGER :: N_DEP
INTEGER :: N_WDEP
INTEGER :: DATE(2)
REAL*8 :: UPDATE
REAL*8 :: NTSCHEM
REAL*8 :: NTSCONV
!=================================================================
! UPDATE_FDEP_ARRAYS begins here!
!=================================================================
! implement a cap on total number of observations (dkh, 02/11/11)
IF ( LMAX_OBS ) THEN
DATE = GET_TIME_AHEAD( NSPAN * OBS_FREQ )
IF ( DATE(1) == GET_NYMDe() .and.
& DATE(2) == GET_NHMSe() ) THEN
FORCE = .TRUE.
ENDIF
ELSE
FORCE = .TRUE.
ENDIF
NTSCHEM = REAL(NSPAN,8)
& / ( REAL(GET_TS_CHEM(),8) / REAL(OBS_FREQ,8) )
NTSCONV = REAL(NSPAN,8)
& / ( REAL(GET_TS_CONV(),8) / REAL(OBS_FREQ,8) )
IF ( LADJ_DDEP_TRACER .and. ITS_TIME_FOR_CHEM() .and. LCHEM ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, N, N_TRACER, N_DEP, UPDATE )
DO N = 1, NOBS
N_DEP = NOBS2NDEP(N)
N_TRACER = TRACER_IND(N)
! Only include species whose deposition is handled outside of chemistry / drydep
! i.e., the aerosol species handled by sulfate_mod
IF ( N_TRACER .ne. IDTSO4 .and.
& N_TRACER .ne. IDTNIT .and.
& N_TRACER .ne. IDTNH3 .and.
& N_TRACER .ne. IDTNH4 ) CYCLE
DO J = 1, JJPAR
DO I = 1, IIPAR
UPDATE = AD44(I,J,N_DEP,1) - AD44_OLD(I,J,N)
IF ( FORCE ) THEN
! check to see if reset
IF ( UPDATE < 0
& .and. ABS(UPDATE) > 0.01d0 ) THEN
DDEP_TRACER(I,J,N) = DDEP_TRACER(I,J,N)
& + AD44(I,J,N_DEP,1)
& / NTSCHEM
& * GET_CF_REGION(I,J,1)
& * TR_DDEP_CONV(J,N_TRACER)
! Otherwise increment
ELSE
DDEP_TRACER(I,J,N) = DDEP_TRACER(I,J,N)
& + UPDATE
& / NTSCHEM
& * GET_CF_REGION(I,J,1)
& * TR_DDEP_CONV(J,N_TRACER)
ENDIF
ENDIF
AD44_OLD(I,J,N) = AD44(I,J,N_DEP,1)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
! dkh debug
print*, ' DDEP_TRACER SUM = ', SUM(DDEP_TRACER(:,:,:))
ENDIF
IF ( LADJ_DDEP_CSPEC .and. ITS_TIME_FOR_CHEM() .and. LCHEM ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, N, N_DEP, UPDATE )
DO N = 1, NOBS_CSPEC
N_DEP = NOBSCSPEC2NDEP(N)
DO J = 1, JJPAR
DO I = 1, IIPAR
UPDATE = AD44(I,J,N_DEP,1) - AD44_CSPEC_OLD(I,J,N)
IF ( FORCE ) THEN
! check to see if reset
IF ( UPDATE < 0
& .and. ABS(UPDATE) > 0.01d0 ) THEN
DDEP_CSPEC(I,J,N) = DDEP_CSPEC(I,J,N)
& + AD44(I,J,N_DEP,1)
& / NTSCHEM
& * GET_CF_REGION(I,J,1)
& * CS_DDEP_CONV(J,N)
! Otherwise increment
ELSE
DDEP_CSPEC(I,J,N) = DDEP_CSPEC(I,J,N)
& + UPDATE
& / NTSCHEM
& * GET_CF_REGION(I,J,1)
& * CS_DDEP_CONV(J,N)
ENDIF
ENDIF
AD44_CSPEC_OLD(I,J,N) = AD44(I,J,N_DEP,1)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
! dkh debug
print*, ' DDEP_CSPEC SUM = ', SUM(DDEP_CSPEC(:,:,:))
ENDIF
IF ( LADJ_WDEP_CV .and. ITS_TIME_FOR_CONV() .and. LCHEM ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, N, N_TRACER, N_WDEP, UPDATE )
DO N = 1, NOBS
N_TRACER = TRACER_IND(N)
N_WDEP = NOBS2NWDEP(N)
DO J = 1, JJPAR
DO I = 1, IIPAR
UPDATE = SUM(AD38(I,J,:,N_WDEP)) - AD38_OLD(I,J,N)
IF ( FORCE ) THEN
! check to see if reset
IF ( UPDATE < 0
& .and. ABS(UPDATE) > 0.01d0 ) THEN
WDEP_CV(I,J,N) = WDEP_CV(I,J,N)
& + SUM(AD38(I,J,:,N_WDEP))
& / NTSCONV
& * GET_CF_REGION(I,J,1)
& * TR_WDEP_CONV(J,N_TRACER)
! Otherwise increment
ELSE
WDEP_CV(I,J,N) = WDEP_CV(I,J,N)
& + UPDATE
& / NTSCONV
& * GET_CF_REGION(I,J,1)
& * TR_WDEP_CONV(J,N_TRACER)
ENDIF
ENDIF
AD38_OLD(I,J,N) = SUM(AD38(I,J,:,N_WDEP))
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
! dkh debug
print*, ' WDEP_CV SUM = ', SUM(WDEP_CV(:,:,:))
ENDIF
IF ( LADJ_WDEP_LS .and. ITS_TIME_FOR_CONV() .and. LCHEM ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, N, N_TRACER, N_WDEP, UPDATE )
DO N = 1, NOBS
N_TRACER = TRACER_IND(N)
N_WDEP = NOBS2NWDEP(N)
DO J = 1, JJPAR
DO I = 1, IIPAR
UPDATE = SUM(AD39(I,J,:,N_WDEP)) - AD39_OLD(I,J,N)
IF ( FORCE ) THEN
! check to see if reset
IF ( UPDATE < 0
& .and. ABS(UPDATE) > 0.01d0 ) THEN
WDEP_LS(I,J,N) = WDEP_LS(I,J,N)
& + SUM(AD39(I,J,:,N_WDEP))
& / NTSCONV
& * GET_CF_REGION(I,J,1)
& * TR_WDEP_CONV(J,N_TRACER)
! Otherwise increment
ELSE
WDEP_LS(I,J,N) = WDEP_LS(I,J,N)
& + UPDATE
& / NTSCONV
& * GET_CF_REGION(I,J,1)
& * TR_WDEP_CONV(J,N_TRACER)
ENDIF
ENDIF
AD39_OLD(I,J,N) = SUM(AD39(I,J,:,N_WDEP))
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
! dkh debug
!print*, ' WDEP_LS SUM = ', SUM(WDEP_LS(:,:,:))
!print*, ' WDEP_LS FD = ', WDEP_LS(IFD,JFD,1)
!print*, ' WDEP_LS FD = ', WDEP_LS(IFD,JFD,2)
!print*, ' WDEP_LS FD = ', WDEP_LS(IFD,JFD,3)
!print*, ' AD39 SUM = ', SUM(AD39(IFD,JFD,:,NOBS2NWDEP(1)))
!print*, ' AD39 SUM = ', SUM(AD39(IFD,JFD,:,NOBS2NWDEP(2)))
!print*, ' AD39 SUM = ', SUM(AD39(IFD,JFD,:,NOBS2NWDEP(3)))
!print*, ' NTSCONV = ', NTSCONV
!print*, ' TR_WDEP_CONV = ', TR_WDEP_CONV(JFD,TRACER_IND(1))
ENDIF
! Return to calling program
END SUBROUTINE UPDATE_FDEP_ARRAYS
!------------------------------------------------------------------------------
! Don't need anymore
!
! SUBROUTINE GET_TRACER_VALUES( TCKG )
!!
!!******************************************************************************
!! Subroutine GET_TRACER_VALUES puts the tracers from the forward calculation
!! into an array suitable for writing to checkpoint/observatioin files.
!! This array is indexed accourding to IDADJxxx and values of all tracers are
!! in kg. (dkh, 03/03/05)
!!
!! Arguments as Input/Output:
!! ============================================================================
!! (1 ) TCKG : Tracer concentrations [Kg]
!!
!! Input passed through CMN
!! ============================================================================
!! (1 ) STT : Tracer concentrations [Kg]
!!
!! NOTES:
!! (1 ) The species that aren't tracers have already been loading into OBS_STT
!! and CHK_STT in rpmares_foradj_mod.f. The species that are tracers are
!! the first NADJ species of the OBS and CHK arrays, so only pass columns
!! 1:NADJ.
!! (2 ) Added support for full chemistry. Now only call GET_HNO3 if NSRCX = 10.
!! (dkh, 07/15/05)
!! (3 ) Changed the units of the tracers from ug/m3 to kg/box. Changed name
!! of argument to TCKG. (dkh, 11/02/05)
!! (4 ) updated for v8, not clear if this is needed anymore as STT is in TRACER_MOD now
!! and can be accessed directly. (mk, dkh, ks, cs, 6/09/09)
!!
!!******************************************************************************
!!
! ! References to F90 modules
! USE DAO_MOD, ONLY : AIRVOL
! !USE RPMARES_FORADJ_MOD, ONLY : GET_HNO3
! USE TRACER_MOD, ONLY : N_TRACERS, STT
! USE LOGICAL_ADJ_MOD, ONLY : LPRINTFD
!
!# include "CMN_SIZE" ! IIPAR etc
!
! ! Arguments
! REAL*4 :: TCKG(IIPAR,JJPAR,LLPAR,N_TRACERS)
!
! ! Local variables
! INTEGER :: I, J, L, N
!
! !=================================================================
! ! GET_TRACER_VALUES begins here!
! !=================================================================
!
! ! dkh debug
! IF ( LPRINTFD ) THEN
! print*, ' STT at GET_TRACER_VAL ', STT(IFD,JFD,LFD,NFD)
! print*, ' ARIVOL at GET_TRACER_VAL ', AIRVOL(IFD,JFD,LFD)
! ENDIF
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, L, N )
! DO N = 1, N_TRACERS
! DO L = 1, LLPAR
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! TCKG(I,J,L,N) = STT(I,J,L,N)
!
! ENDDO
! ENDDO
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ! Return to calling program
! END SUBROUTINE GET_TRACER_VALUES
!
!!-----------------------------------------------------------------------------
SUBROUTINE DISPLAY_MET( FID, LOCATION )
!
!******************************************************************************
! Subroutine DISPLAY_MET writes out met field and computed data to the
! screen, used for checking that the fwd and backwd runs are in sync.
! (dkh, 03/13/05)
!
! NOTES:
! (1 ) Use FID = 155 for fwd run and FID = 165 for backwd run
!
!******************************************************************************
!
! References to F90 modules
USE DAO_MOD
USE TIME_MOD, ONLY : GET_YEAR, GET_MONTH, GET_DAY,
& GET_HOUR, GET_MINUTE
USE ERROR_MOD, ONLY : ERROR_STOP
USE FILE_MOD, ONLY : IOERROR
USE TRACERID_MOD
USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD, LFD, NFD
USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ
USE LOGICAL_ADJ_MOD,ONLY : LADJ
USE PBL_MIX_MOD, ONLY : GET_FPBL
USE PRESSURE_MOD, ONLY : GET_PEDGE
# include "CMN_SIZE" ! Size params
! Arguments
INTEGER :: FID
INTEGER :: LOCATION
! Local variables
INTEGER :: IOS
CHARACTER(LEN=40) :: FILENAME
!=================================================================
! DISPLAY_MET begins here!
!=================================================================
!#if defined ( GEOS_5 )
! PRINT*, 'met field diagnostic for GEOS5 yet'
! RETURN
!#endif
IF ( FID == 155 ) THEN
FILENAME = 'FWD_met'
ELSEIF( FID == 165 ) THEN
FILENAME = 'BACKWD_met'
ELSE
CALL ERROR_STOP( ' Undefined FID ',
& ' DISPLAY_MET (geos_chem_mod.f)')
ENDIF
IF ( LOCATION == 0 ) THEN
! Open files for output
OPEN( FID, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
! Error check
IF ( IOS /= 0 ) CALL IOERROR( IOS, FID,'display_met:0')
WRITE(FID,*) 'IFD, JFD, LFD, NFD are:', IFD, JFD, LFD, NFD
#if defined( GEOS_4 )
WRITE(FID,*) 'GEOS4 run'
#elif defined ( GEOS_3 )
WRITE(FID,*) 'GEOS3 run'
#elif defined ( GEOS_5 )
WRITE(FID,*) 'GEOS5 run'
#elif defined ( GEOS_FP )
WRITE(FID,*) 'GEOSFP run'
#endif
ELSEIF ( LOCATION == 1 ) THEN
! Hours since start of run
! Write quantities
WRITE( FID, 100 ) GET_YEAR(), GET_MONTH(), GET_DAY(),
& GET_HOUR(), GET_MINUTE()
! Format string
100 FORMAT( '---> DATE: ', i4.4, '/', i2.2, '/', i2.2,
& ' GMT: ', i2.2, ':', i2.2, ' X-HRS: ', f11.3 )
WRITE(FID,*) ' I6 vars ',
& ' LWI(FD) = ', LWI(IFD,JFD),
& ' PHIS(FD) = ', PHIS(IFD,JFD),
& ' SLP(FD) = ', SLP(IFD,JFD),
& 'TROPP(FD)= ', TROPP(IFD,JFD),
! & ' RH = ', RH(IFD,JFD,LFD),
& ' ALBD(FD) = ', ALBD(IFD,JFD),
& ' PSC2(FD) = ', PSC2(IFD,JFD),
& ' SPHU = ', SPHU(IFD,JFD,LFD),
& ' T = ', T(IFD,JFD,LFD),
& ' UWND = ', UWND(IFD,JFD,LFD),
& ' VWND = ', VWND(IFD,JFD,LFD)
#if defined ( GEOS_4 ) || defined ( GEOS_5 ) || defined( GEOS_FP )
WRITE(FID,*) ' A6 vars TMPU, UWND and VWND read interpolated'
WRITE(FID,*) ' I6 vars '
WRITE(FID,*)
& ' PS1(FD) = ', PS1(IFD,JFD)
#else
WRITE(FID,*) ' I6 vars ',
& ' ALBD1(FD) = ', ALBD1(IFD,JFD),
& ' PS1(FD) = ', PS1(IFD,JFD),
& ' SPHU1 = ', SPHU1(IFD,JFD,LFD),
& ' TMPU1 = ', TMPU1(IFD,JFD,LFD),
& ' UWND1 = ', UWND1(IFD,JFD,LFD),
& ' VWND1 = ', VWND1(IFD,JFD,LFD)
#endif
#if defined ( GEOS_4 ) || defined ( GEOS_5 ) || defined( GEOS_FP )
WRITE(FID,*) ' A6 vars TMPU, UWND and VWND read interpolated'
WRITE(FID,*) ' I6 vars '
WRITE(FID,*)
& ' PS2(FD) = ', PS2(IFD,JFD)
#else
WRITE(FID,*) ' I6 vars ',
& ' ALBD2(FD) = ', ALBD1(IFD,JFD),
& ' PS2(FD) = ', PS2(IFD,JFD),
& ' SPHU2 = ', SPHU2(IFD,JFD,LFD),
& ' TMPU2 = ', TMPU2(IFD,JFD,LFD),
& ' UWND2 = ', UWND2(IFD,JFD,LFD),
& ' VWND2 = ', VWND2(IFD,JFD,LFD)
#endif
WRITE(FID,*) ' Computed met. quantities before trans',
& ' AD(FD) = ', AD(IFD,JFD,LFD),
& ' AIRVOL(FD) =', AIRVOL(IFD,JFD,LFD),
& ' AIRDEN(FD) =', AIRDEN(LFD,IFD,JFD),
! & ' AVGW(FD) =', AVGW(IFD,JFD,LFD)!, ! gives error on first time through
& ' BXHEIGHT = ', BXHEIGHT(IFD,JFD,LFD),
& ' DELP = ', DELP(LFD,IFD,JFD),
& ' FPBL = ', GET_FPBL(IFD,JFD),
& ' PBL = ', PBL(IFD,JFD),
& ' PEDGE = ', GET_PEDGE(IFD,JFD,LFD)
ELSEIF ( LOCATION == 2) THEN
WRITE(FID,*) ' Computed met. quantities after trans',
& ' AD(FD) = ', AD(IFD,JFD,LFD),
& ' AIRVOL(FD) =', AIRVOL(IFD,JFD,LFD),
& ' AIRDEN(FD) =', AIRDEN(LFD,IFD,JFD),
! & ' AVGW(FD) =', AVGW(IFD,JFD,LFD)!, ! gives error on first time through
& ' BXHEIGHT = ', BXHEIGHT(IFD,JFD,LFD),
& ' DELP = ', DELP(LFD,IFD,JFD),
& ' FPBL = ', GET_FPBL(IFD,JFD),
& ' PBL = ', PBL(IFD,JFD),
& ' PEDGE = ', GET_PEDGE(IFD,JFD,LFD)
ELSEIF ( LOCATION == 3 .AND. FID == 155 .AND. LADJ ) THEN
WRITE(FID,*) ' Before turbulent mixing ',
& ' STT = ', STT(IFD,JFD,:,NFD)
ELSEIF ( LOCATION == 4 .AND. FID == 155 .AND. LADJ ) THEN
WRITE(FID,*) ' After turbulent mixing ',
& ' STT = ', STT(IFD,JFD,:,NFD)
ELSEIF ( LOCATION == 3 .AND. FID == 165 ) THEN
WRITE(FID,*) ' Before turbulent mixing ',
& ' STT_ADJ = ', STT_ADJ(IFD,JFD,:,NFD)
ELSEIF ( LOCATION == 4 .AND. FID == 165 ) THEN
WRITE(FID,*) ' After turbulent mixing ',
& ' STT_ADJ = ', STT_ADJ(IFD,JFD,:,NFD)
ELSEIF ( LOCATION == 5 ) THEN
WRITE(FID,*) ' Met data for turbulent mixing: ',
& ' AD(1:2) = ', AD(IFD,JFD,1:2)
ENDIF
! Return to calling program
END SUBROUTINE DISPLAY_MET
!------------------------------------------------------------------------------
SUBROUTINE APPLY_IC_SCALING( )
!
!******************************************************************************
! Subroutine APPLY_IP_SCALING multiplies the initial concentrations by the scaling
! factors which are being optimized. It also saves the pure initial concentrations
! (as read from the restart file ) in mass units to ORIG_STT.
! (dkh, 06/20/06, mk, dkh, ks, cs, 6/09/09)
!
! Input passed through CMN
! ============================================================================
! (1 ) STT : Tracer concentrations [Kg]
! (2 ) ICS_SF : Tracer scaling factors [none]
!
! Used from tracer_mod.f and checkpt_mod.f
! ============================================================================
! (1 ) STT : Tracer concentrations [Kg]
! (2 ) ORIG_STT : Tracer concentrations [Kg]
!
! NOTES:
! (1 ) All this use to just be in geos_chem_mod. It started to look bulky so
! I put it here for now. The only difference is that now we use ORIG_STT
! to store initial concentrations and use the clause IF (ADJ2STT(N) > ) to
! ensure that we're only scaling species that are defined for the adjoint
! calculation, leaving others (DMS, etc) untouched.
! (2 ) Don't convert units of ORIG_STT anymore. (dkh, 11/02/05)
! (3 ) update to v8 (adj_group, 6/09/09)
!******************************************************************************
! Reference to f90 modules
USE TRACERID_MOD, ONLY : IDTH2O2 ! dkh debug
!USE CHECKPT_MOD, ONLY : ORIG_STT
USE DAO_MOD, ONLY : AIRVOL
USE LOGICAL_ADJ_MOD, ONLY : LPRINTFD, LICS, LADJ_EMS
USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD, LFD, NFD, ICS_SF
USE ADJ_ARRAYS_MOD, ONLY : STT_ORIG
USE ADJ_ARRAYS_MOD, ONLY : ICS_SF0
USE ADJ_ARRAYS_MOD, ONLY : EMS_SF
USE ADJ_ARRAYS_MOD, ONLY : EMS_SF0
USE TRACER_MOD, ONLY : N_TRACERS
# include "CMN_SIZE" ! IIPAR etc
! Now include this at the top of the module (dkh, 10/15/09)
!# include "../adjoint/define_adj.h" ! LOG_OPT
!===========================================================
! APPLY_IC_SCALING begins here!
!===========================================================
IF ( LPRINTFD ) THEN
WRITE(6,*) 'STT = ', STT(IFD,JFD,LFD,NFD)
WRITE(6,*) 'AIRVOL = ', AIRVOL(IFD,JFD,LFD)
WRITE(6,*) 'RESTART(FD) = ', STT(IFD,JFD,LFD,NFD)
ENDIF
!===========================================================
! INITIALIZE ACTIVE VARIABLES (for initial conditions)
!===========================================================
#if defined ( LOG_OPT )
! dkh log, adj_group
IF ( LICS ) ICS_SF(:,:,:,:) = EXP(ICS_SF(:,:,:,:))
IF ( LICS ) ICS_SF0(:,:,:,:) = EXP(ICS_SF0(:,:,:,:))
#endif
! dkh debug
print*, ' MIN / MAX ICS_SF = ', MINVAL(ICS_SF), MAXVAL(ICS_SF)
print*, ' MIN / MAX ICS_SF0 = ', MINVAL(ICS_SF0), MAXVAL(ICS_SF0)
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L, N )
DO N = 1, N_TRACERS
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
! Skip species which have no corresponding index
! in adjoint arrays as they are not active variables.
IF ( N > 0 ) THEN
! Save the initial concentration so that we can rescale
! the adjoints at the end of the adjoint calculation
STT_ORIG(I,J,L,N) = STT(I,J,L,N)
! Scale initial concentrations by scaling factors
STT(I,J,L,N) = STT(I,J,L,N)
& * ICS_SF(I,J,L,N)
ENDIF
ENDDO
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
#if defined ( LOG_OPT )
! dkh log, adj_group
IF ( LADJ_EMS ) EMS_SF(:,:,:,:) = EXP(EMS_SF(:,:,:,:))
IF ( LADJ_EMS ) EMS_SF0(:,:,:,:) = EXP(EMS_SF0(:,:,:,:))
#endif
IF ( LPRINTFD ) THEN
WRITE(6,*) 'STT = ', STT(IFD,JFD,LFD,NFD)
WRITE(6,*) 'RESTART(FD) = ', STT(IFD,JFD,LFD,NFD)
ENDIF
! Return to calling program
END SUBROUTINE APPLY_IC_SCALING
!------------------------------------------------------------------------------
!******************************************************************************
! Internal procedures -- Use the F90 CONTAINS command to inline
! subroutines that only can be called from this main program.
!
! All variables referenced in the main program (local variables, F90
! module variables, or common block variables) also have scope within
! internal subroutines.
!
! List of Internal Procedures:
! ============================================================================
! (1 ) DISPLAY_GRID_AND_MODEL : Displays resolution, data set, & start time
! (2 ) GET_NYMD_PHIS : Gets YYYYMMDD for the PHIS data field
! (3 ) DISPLAY_SIGMA_LAT_LON : Displays sigma, lat, and lon information
! (4 ) GET_WIND10M : Wrapper for MAKE_WIND10M (from "dao_mod.f")
! (5 ) CTM_FLUSH : Flushes diagnostic files to disk
! (6 ) DISPLAY_END_TIME : Displays ending time of simulation
! (7 ) MET_FIELD_DEBUG : Prints min and max of met fields for debug
!******************************************************************************
!
!-----------------------------------------------------------------------------
SUBROUTINE DISPLAY_GRID_AND_MODEL
!=================================================================
! Internal Subroutine DISPLAY_GRID_AND_MODEL displays the
! appropriate messages for the given model grid and machine type.
! It also prints the starting time and date (local time) of the
! GEOS-CHEM simulation. (bmy, 12/2/03, 10/18/05)
!=================================================================
! For system time stamp
CHARACTER(LEN=16) :: STAMP
!-----------------------
! Print resolution info
!-----------------------
#if defined( GRID4x5 )
WRITE( 6, '(a)' )
& REPEAT( '*', 13 ) //
& ' S T A R T I N G 4 x 5 G E O S--C H E M ' //
& REPEAT( '*', 13 )
#elif defined( GRID2x25 )
WRITE( 6, '(a)' )
& REPEAT( '*', 13 ) //
& ' S T A R T I N G 2 x 2.5 G E O S--C H E M ' //
& REPEAT( '*', 13 )
#elif defined( GRID1x125 )
WRITE( 6, '(a)' )
& REPEAT( '*', 13 ) //
& ' S T A R T I N G 1 x 1.25 G E O S--C H E M ' //
& REPEAT( '*', 13 )
#elif defined( GRID1x1 )
WRITE( 6, '(a)' )
& REPEAT( '*', 13 ) //
& ' S T A R T I N G 1 x 1 G E O S -- C H E M ' //
& REPEAT( '*', 13 )
#endif
!-----------------------
! Print machine info
!-----------------------
! Get the proper FORMAT statement for the model being used
#if defined( COMPAQ )
WRITE( 6, '(a)' ) 'Created w/ HP/COMPAQ Alpha compiler'
#elif defined( IBM_AIX )
WRITE( 6, '(a)' ) 'Created w/ IBM-AIX compiler'
#elif defined( LINUX_PGI )
WRITE( 6, '(a)' ) 'Created w/ LINUX/PGI compiler'
#elif defined( LINUX_IFORT )
WRITE( 6, '(a)' ) 'Created w/ LINUX/IFORT (64-bit) compiler'
#elif defined( SGI_MIPS )
WRITE( 6, '(a)' ) 'Created w/ SGI MIPSpro compiler'
#elif defined( SPARC )
WRITE( 6, '(a)' ) 'Created w/ Sun/SPARC compiler'
#endif
!-----------------------
! Print met field info
!-----------------------
#if defined( GEOS_3 )
WRITE( 6, '(a)' ) 'Using GEOS-3 met fields'
#elif defined( GEOS_4 )
WRITE( 6, '(a)' ) 'Using GEOS-4/fvDAS met fields'
#elif defined( GEOS_5 )
WRITE( 6, '(a)' ) 'Using GEOS-5/fvDAS met fields'
#elif defined( GEOS_FP )
WRITE( 6, '(a)' ) 'Using GEOS-FP/fvDAS met fields'
#elif defined( GCAP )
WRITE( 6, '(a)' ) 'Using GCAP/GISS met fields'
#endif
!-----------------------
! System time stamp
!-----------------------
STAMP = SYSTEM_TIMESTAMP()
WRITE( 6, 100 ) STAMP
100 FORMAT( /, '===> SIMULATION START TIME: ', a, ' <===', / )
! Return to MAIN program
END SUBROUTINE DISPLAY_GRID_AND_MODEL
!-----------------------------------------------------------------------------
SUBROUTINE CTM_FLUSH
!================================================================
! Internal subroutine CTM_FLUSH flushes certain diagnostic
! file buffers to disk. (bmy, 8/31/00, 7/1/02)
!
! CTM_FLUSH should normally be called after each diagnostic
! output, so that in case the run dies, the output files from
! the last diagnostic timestep will not be lost.
!
! FLUSH is an intrinsic FORTRAN subroutine and takes as input
! the unit number of the file to be flushed to disk.
!================================================================
CALL FLUSH( IU_ND48 )
CALL FLUSH( IU_BPCH )
CALL FLUSH( IU_SMV2LOG )
CALL FLUSH( IU_DEBUG )
! Return to MAIN program
END SUBROUTINE CTM_FLUSH
!------------------------------------------------------------------------------
SUBROUTINE DISPLAY_END_TIME
!=================================================================
! Internal subroutine DISPLAY_END_TIME prints the ending time of
! the GEOS-CHEM simulation (bmy, 5/3/05)
!=================================================================
! Local variables
CHARACTER(LEN=16) :: STAMP
! Print system time stamp
STAMP = SYSTEM_TIMESTAMP()
WRITE( 6, 100 ) STAMP
100 FORMAT( /, '===> SIMULATION END TIME: ', a, ' <===', / )
! Echo info
WRITE ( 6, 3000 )
3000 FORMAT
& ( /, '************** E N D O F G E O S -- C H E M ',
& '**************' )
! Return to MAIN program
END SUBROUTINE DISPLAY_END_TIME
!------------------------------------------------------------------------------
SUBROUTINE MET_FIELD_DEBUG
!=================================================================
! Internal subroutine MET_FIELD_DEBUG prints out the maximum
! and minimum, and sum of DAO met fields for debugging
!=================================================================
! References to F90 modules
USE DAO_MOD, ONLY : AD, AIRDEN, AIRVOL, ALBD1, ALBD2
USE DAO_MOD, ONLY : ALBD, AVGW, BXHEIGHT, CLDFRC, CLDF
USE DAO_MOD, ONLY : CLDMAS, CLDTOPS, DELP
USE DAO_MOD, ONLY : DTRAIN, GWETTOP, HFLUX, HKBETA, HKETA
USE DAO_MOD, ONLY : LWI, MOISTQ, OPTD, OPTDEP, PBL
USE DAO_MOD, ONLY : PREACC, PRECON, PS1, PS2, PSC2
USE DAO_MOD, ONLY : RADLWG, RADSWG, RH, SLP, SNOW
USE DAO_MOD, ONLY : SPHU1, SPHU2, SPHU, SUNCOS, SUNCOSB
USE DAO_MOD, ONLY : SUNCOS_5hr
USE DAO_MOD, ONLY : TMPU1, TMPU2, T, TROPP, TS
USE DAO_MOD, ONLY : TSKIN, U10M, USTAR, UWND1, UWND2
USE DAO_MOD, ONLY : UWND, V10M, VWND1, VWND2, VWND
USE DAO_MOD, ONLY : Z0, ZMEU, ZMMD, ZMMU
! Local variables
INTEGER :: I, J, L, IJ
!=================================================================
! MET_FIELD_DEBUG begins here!
!=================================================================
! Define box to print out
I = 23
J = 34
L = 1
IJ = ( ( J-1 ) * IIPAR ) + I
!=================================================================
! Print out met fields at (I,J,L)
!=================================================================
IF ( ALLOCATED( AD ) ) PRINT*, 'AD : ', AD(I,J,L)
IF ( ALLOCATED( AIRDEN ) ) PRINT*, 'AIRDEN : ', AIRDEN(L,I,J)
IF ( ALLOCATED( AIRVOL ) ) PRINT*, 'AIRVOL : ', AIRVOL(I,J,L)
IF ( ALLOCATED( ALBD1 ) ) PRINT*, 'ALBD1 : ', ALBD1(I,J)
IF ( ALLOCATED( ALBD2 ) ) PRINT*, 'ALBD2 : ', ALBD2(I,J)
IF ( ALLOCATED( ALBD ) ) PRINT*, 'ALBD : ', ALBD(I,J)
IF ( ALLOCATED( AVGW ) ) PRINT*, 'AVGW : ', AVGW(I,J,L)
IF ( ALLOCATED( BXHEIGHT ) ) PRINT*, 'BXHEIGHT: ', BXHEIGHT(I,J,L)
IF ( ALLOCATED( CLDFRC ) ) PRINT*, 'CLDFRC : ', CLDFRC(I,J)
IF ( ALLOCATED( CLDF ) ) PRINT*, 'CLDF : ', CLDF(L,I,J)
IF ( ALLOCATED( CLDMAS ) ) PRINT*, 'CLDMAS : ', CLDMAS(I,J,L)
IF ( ALLOCATED( CLDTOPS ) ) PRINT*, 'CLDTOPS : ', CLDTOPS(I,J)
IF ( ALLOCATED( DELP ) ) PRINT*, 'DELP : ', DELP(L,I,J)
IF ( ALLOCATED( DTRAIN ) ) PRINT*, 'DTRAIN : ', DTRAIN(I,J,L)
IF ( ALLOCATED( GWETTOP ) ) PRINT*, 'GWETTOP : ', GWETTOP(I,J)
IF ( ALLOCATED( HFLUX ) ) PRINT*, 'HFLUX : ', HFLUX(I,J)
IF ( ALLOCATED( HKBETA ) ) PRINT*, 'HKBETA : ', HKBETA(I,J,L)
IF ( ALLOCATED( HKETA ) ) PRINT*, 'HKETA : ', HKETA(I,J,L)
IF ( ALLOCATED( LWI ) ) PRINT*, 'LWI : ', LWI(I,J)
IF ( ALLOCATED( MOISTQ ) ) PRINT*, 'MOISTQ : ', MOISTQ(L,I,J)
IF ( ALLOCATED( OPTD ) ) PRINT*, 'OPTD : ', OPTD(L,I,J)
IF ( ALLOCATED( OPTDEP ) ) PRINT*, 'OPTDEP : ', OPTDEP(L,I,J)
IF ( ALLOCATED( PBL ) ) PRINT*, 'PBL : ', PBL(I,J)
IF ( ALLOCATED( PREACC ) ) PRINT*, 'PREACC : ', PREACC(I,J)
IF ( ALLOCATED( PRECON ) ) PRINT*, 'PRECON : ', PRECON(I,J)
IF ( ALLOCATED( PS1 ) ) PRINT*, 'PS1 : ', PS1(I,J)
IF ( ALLOCATED( PS2 ) ) PRINT*, 'PS2 : ', PS2(I,J)
IF ( ALLOCATED( PSC2 ) ) PRINT*, 'PSC2 : ', PSC2(I,J)
IF ( ALLOCATED( RADLWG ) ) PRINT*, 'RADLWG : ', RADLWG(I,J)
IF ( ALLOCATED( RADSWG ) ) PRINT*, 'RADSWG : ', RADSWG(I,J)
IF ( ALLOCATED( RH ) ) PRINT*, 'RH : ', RH(I,J,L)
IF ( ALLOCATED( SLP ) ) PRINT*, 'SLP : ', SLP(I,J)
IF ( ALLOCATED( SNOW ) ) PRINT*, 'SNOW : ', SNOW(I,J)
IF ( ALLOCATED( SPHU1 ) ) PRINT*, 'SPHU1 : ', SPHU1(I,J,L)
IF ( ALLOCATED( SPHU2 ) ) PRINT*, 'SPHU2 : ', SPHU2(I,J,L)
IF ( ALLOCATED( SPHU ) ) PRINT*, 'SPHU : ', SPHU(I,J,L)
IF ( ALLOCATED( SUNCOS ) ) PRINT*, 'SUNCOS : ', SUNCOS(IJ)
IF ( ALLOCATED( SUNCOS_5hr)) PRINT*, 'SUNCOS_5hr: ',SUNCOS_5hr(IJ)
IF ( ALLOCATED( SUNCOSB ) ) PRINT*, 'SUNCOSB : ', SUNCOSB(IJ)
IF ( ALLOCATED( TMPU1 ) ) PRINT*, 'TMPU1 : ', TMPU1(I,J,L)
IF ( ALLOCATED( TMPU2 ) ) PRINT*, 'TMPU2 : ', TMPU2(I,J,L)
IF ( ALLOCATED( T ) ) PRINT*, 'TMPU : ', T(I,J,L)
IF ( ALLOCATED( TROPP ) ) PRINT*, 'TROPP : ', TROPP(I,J)
IF ( ALLOCATED( TS ) ) PRINT*, 'TS : ', TS(I,J)
IF ( ALLOCATED( TSKIN ) ) PRINT*, 'TSKIN : ', TSKIN(I,J)
IF ( ALLOCATED( U10M ) ) PRINT*, 'U10M : ', U10M(I,J)
IF ( ALLOCATED( USTAR ) ) PRINT*, 'USTAR : ', USTAR(I,J)
IF ( ALLOCATED( UWND1 ) ) PRINT*, 'UWND1 : ', UWND1(I,J,L)
IF ( ALLOCATED( UWND2 ) ) PRINT*, 'UWND2 : ', UWND2(I,J,L)
IF ( ALLOCATED( UWND ) ) PRINT*, 'UWND : ', UWND(I,J,L)
IF ( ALLOCATED( V10M ) ) PRINT*, 'V10M : ', V10M(I,J)
IF ( ALLOCATED( VWND1 ) ) PRINT*, 'VWND1 : ', VWND1(I,J,L)
IF ( ALLOCATED( VWND2 ) ) PRINT*, 'VWND2 : ', VWND2(I,J,L)
IF ( ALLOCATED( VWND ) ) PRINT*, 'VWND : ', VWND(I,J,L)
IF ( ALLOCATED( Z0 ) ) PRINT*, 'Z0 : ', Z0(I,J)
IF ( ALLOCATED( ZMEU ) ) PRINT*, 'ZMEU : ', ZMEU(I,J,L)
IF ( ALLOCATED( ZMMD ) ) PRINT*, 'ZMMD : ', ZMMD(I,J,L)
IF ( ALLOCATED( ZMMU ) ) PRINT*, 'ZMMU : ', ZMMU(I,J,L)
! Flush the output buffer
CALL FLUSH( 6 )
! Return to MAIN program
END SUBROUTINE MET_FIELD_DEBUG
!-----------------------------------------------------------------------------
! End of Module
END MODULE GEOS_CHEM_MOD
Reference in New Issue View Git Blame Copy Permalink