1363 lines
53 KiB
Fortran
1363 lines
53 KiB
Fortran
! $Id: main.f,v 1.1 2009/06/09 21:51:51 daven Exp $
|
|
! $Log: main.f,v $
|
|
! Revision 1.1 2009/06/09 21:51:51 daven
|
|
! Initial revision
|
|
!
|
|
! Revision 1.58 2009/05/06 14:14:45 ccarouge
|
|
! commits for v8-02-01 (ccarouge 5/6/09)
|
|
!
|
|
! Revision 1.57 2009/01/29 15:35:50 bmy
|
|
! Added protex header to emep_mod.f. Also some last-minute changes from
|
|
! Philippe, and a couple of typo fixes. (bmy, 1/29/09)
|
|
!
|
|
! Revision 1.56 2008/12/15 21:21:12 bmy
|
|
! Added various updates of diagnostics. (bmy, 12/15/08)
|
|
!
|
|
! Revision 1.55 2008/12/15 15:55:15 bmy
|
|
! Replaced TPCORE by S-J Lin and Kevin Yeh with the version
|
|
! from GMI (ccarouge, bmy, 12/15/08)
|
|
!
|
|
! Bug fix in ND51
|
|
!
|
|
! Removed obsolete "Prior to" code from various routines
|
|
!
|
|
! (bmy, 12/15/08)
|
|
!
|
|
! Revision 1.54 2008/11/07 19:30:33 bmy
|
|
! Modifications for GEOS-5 0.5 x 0.666 nested grid simulation
|
|
! Also removed obsolete lightning_nox_nl_mod.f
|
|
! (bmy, 11/7/08)
|
|
!
|
|
! Revision 1.53 2008/08/08 17:20:36 bmy
|
|
! Updated before Bob Y. goes on vacation (bmy, 8/8/08)
|
|
!
|
|
! Revision 1.52 2008/04/03 14:19:44 bmy
|
|
! Now use RPMARES for ATE. Only compute ATE w/in tropopause. (bmy, 4/3/08)
|
|
!
|
|
! Revision 1.51 2008/02/14 18:23:49 bmy
|
|
! Added fixes to make sure tagged CO has same emissions
|
|
! as the full-chemistry CO (jaf, mak, bmy, 2/14/08)
|
|
!
|
|
! Revision 1.50 2007/11/16 18:47:43 bmy
|
|
!
|
|
! Bringing in GEOS-5 modifications to the mainline GEOS-Chem std code
|
|
! (bmy, 11/16/07)
|
|
!
|
|
! Revision 1.49 2007/11/05 16:16:22 bmy
|
|
! - Added H2/HD simulation
|
|
! - Added code for cloud overlap in FAST-J (but use same option as before)
|
|
! - Added 200hPa polar fix for variable tropopause
|
|
! - Added updated lightning scheme (non-near-land)
|
|
! - Fixed mass flux diagnostics in GEOS-3 TPCORE
|
|
! - Removed GEMISNOX array in CMN_NOX to prevent common block errors
|
|
!
|
|
! Revision 1.48 2007/02/22 18:26:28 bmy
|
|
! GEOS-Chem v7-04-11, includes the following modifications:
|
|
! - Fixed near-land lightning; now scale 2x25, 4x5 to 6 Tg N/yr (ltm,bmy)
|
|
! - Now allow ND49, ND50, ND51 to save transects of a single lon or lat (bmy)
|
|
! - Add case for T > 293K to routine GET_LWC in "mercury_mod.f" (cdh,bmy)
|
|
! - Bug fix: correct indices for embedded chemistry in "transport_mod.f" (phs)
|
|
! - Bug fix: correct typo in SEASALT_CHEM routine in "sulfate_mod.f" (bmy)
|
|
! - Now prevent seg fault errors when LBIOMASS=F (bmy)
|
|
! - 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
|
|
!
|
|
PROGRAM GEOS_CHEM
|
|
!
|
|
!******************************************************************************
|
|
!
|
|
!
|
|
! 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
|
|
!
|
|
!******************************************************************************
|
|
!
|
|
! 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 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 : MAKE_RH
|
|
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
|
|
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 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 : 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 UPBDFLX_MOD, ONLY : DO_UPBDFLX, UPBDFLX_NOY
|
|
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
|
|
! To save CSPEC_FULL restart (dkh, 02/12/09)
|
|
USE LOGICAL_MOD, ONLY : LSVCSPEC
|
|
USE RESTART_MOD, ONLY : MAKE_CSPEC_FILE
|
|
USE CHECKPOINT_MOD, ONLY : MAKE_CONVECTION_CHKFILE
|
|
USE LOGICAL_ADJ_MOD
|
|
USE INPUT_ADJ_MOD, ONLY : READ_INPUT_ADJ_FILE
|
|
|
|
! 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
|
|
REAL*8 :: TAU, TAUb
|
|
CHARACTER(LEN=255) :: ZTYPE
|
|
|
|
!=================================================================
|
|
! 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 *****
|
|
!=================================================================
|
|
|
|
! Read input file and call init routines from other modules
|
|
CALL READ_INPUT_FILE
|
|
CALL READ_INPUT_ADJ_FILE
|
|
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
|
|
|
|
! 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
|
|
|
|
! 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()
|
|
|
|
!=================================================================
|
|
! ***** 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
|
|
|
|
! 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' )
|
|
|
|
! 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 *****
|
|
!=================================================================
|
|
|
|
! 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
|
|
|
|
! 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()
|
|
|
|
! 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()
|
|
|
|
!### 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 )
|
|
|
|
! Make ocean mercury restart file
|
|
IF ( ITS_A_MERCURY_SIM() .and. LDYNOCEAN ) THEN
|
|
CALL MAKE_OCEAN_Hg_RESTART( NYMD, NHMS, TAU )
|
|
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
|
|
|
|
!===============================================================
|
|
! ***** 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 *****
|
|
!===============================================================
|
|
IF ( LUNZIP .and. ITS_TIME_FOR_DEL() ) 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
|
|
|
|
!==============================================================
|
|
! ***** 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 )
|
|
|
|
! 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
|
|
|
|
!==============================================================
|
|
! ***** S T R A T O S P H E R I C F L U X E S *****
|
|
!==============================================================
|
|
IF ( LUPBD ) CALL DO_UPBDFLX
|
|
|
|
!==============================================================
|
|
! ***** T R A N S P O R T *****
|
|
!==============================================================
|
|
IF ( ITS_TIME_FOR_DYN() ) THEN
|
|
|
|
! Call the appropritate version of TPCORE
|
|
IF ( LTRAN ) CALL DO_TRANSPORT
|
|
|
|
! Reset air mass quantities
|
|
CALL AIRQNT
|
|
|
|
! Repartition [NOy] species after transport
|
|
IF ( LUPBD .and. ITS_A_FULLCHEM_SIM() ) THEN
|
|
CALL UPBDFLX_NOY( 2 )
|
|
ENDIF
|
|
|
|
#if !defined( GEOS_5 )
|
|
! 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 ) CALL INIT_WETSCAV
|
|
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 *****
|
|
!===========================================================
|
|
CALL DO_PBL_MIX( LTURB )
|
|
|
|
!### 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 *****
|
|
!===========================================================
|
|
IF ( LCONV ) THEN
|
|
CALL DO_CONVECTION
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a CONVECTION' )
|
|
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
|
|
|
|
!-------------------------------
|
|
! Test for emission timestep
|
|
!-------------------------------
|
|
IF ( ITS_TIME_FOR_EMIS() ) THEN
|
|
|
|
! 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 *****
|
|
!===========================================================
|
|
|
|
! 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. )
|
|
|
|
! Call the appropriate chemistry routine
|
|
CALL DO_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
|
|
|
|
!==============================================================
|
|
! ***** 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
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a DIAGNOSTICS' )
|
|
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
|
|
|
|
! 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
|
|
|
|
!### 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
|
|
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()
|
|
|
|
CALL MAKE_CONVECTION_CHKFILE(NYMD,NHMS,TAU)
|
|
|
|
! Remove all files from temporary directory
|
|
IF ( LUNZIP ) 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
|
|
|
|
! 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
|
|
CALL CLEANUP
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### MAIN: a CLEANUP' )
|
|
|
|
! Print ending time of simulation
|
|
CALL DISPLAY_END_TIME
|
|
!
|
|
!******************************************************************************
|
|
! 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
|
|
!******************************************************************************
|
|
!
|
|
CONTAINS
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
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( 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 : 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( 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 program
|
|
END PROGRAM GEOS_CHEM
|
|
|