Sola/GEOS-Chem-adjoint-v35-note
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
6c42635544ee620492f64a47d07a254ff7667db1
GEOS-Chem-adjoint-v35-note/code/modified/geos_chem_mod.f
Sola_MBA 2370ddd793 update 20251007
2025-10-08 16:10:00 +08:00

2979 lines
106 KiB
Fortran
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

! $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
USE ATOM_OBS_MOD, ONLY : INIT_ATOM, CLEANUP_ATOM, READ_ATOM_DATA
USE ATOM_OBS_MOD, ONLY : COMPARE_ATOM_DATA, WRITE_ATOM_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 INIT_ATOM
CALL READ_ATOM_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
CALL COMPARE_ATOM_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
CALL WRITE_ATOM_DATA
CALL CLEANUP_ATOM
! 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 155 是正向运行的，165 是逆向运行的，主要是决定了使用的文件名
!
!******************************************************************************
!
! 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