From 4e926878ee920e936452436cc38168e9e227fc44 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 23 Mar 2023 12:55:52 -0400 Subject: [PATCH] Structural updates to fast-jx/cloud-j work so far - Replace Headers/photol_obj_mod.F90 with Headers/phot_container_mod.F90 - Rename State_Chm%Photol to State_Chm%Phot - Rename derived type PhotolState to PhotContainer - Retire CMN_Phot_Mod.F90 - Create photolysis_mod.F90 - Replace Init_Chemistry with Init_Photolysis - Pass State_Chm to RRTMG subroutine Set_SpecMask - Replace local variable DO_PHOTCHEM in mercury_mod with Input_Opt var set from toggle in geoschem_config.yml photolysis menu - Pass State_Chm to Photo_JX - Change order of arguments in Init_Mercury to put all IN-only first - Move duplicate subroutines out of fjx_interface_mod.F90 and cldj_interface_mod.F90 and put in photolysis_mod.F90 - Retire fast-jx subroutine GC_EXITC - Rename subroutine Fast_JX to Run_FastJX - Rename subroutine Init_Fjx to Init_RastJX Signed-off-by: Lizzie Lundgren --- GeosCore/CMakeLists.txt | 1 + GeosCore/aerosol_mod.F90 | 117 ++- GeosCore/chemistry_mod.F90 | 107 -- GeosCore/cldj_interface_mod.F90 | 1499 +-------------------------- GeosCore/cleanup.F90 | 8 - GeosCore/dust_mod.F90 | 71 +- GeosCore/fjx_interface_mod.F90 | 1291 ++--------------------- GeosCore/fjx_mod.F90 | 32 +- GeosCore/fullchem_mod.F90 | 132 ++- GeosCore/gc_environment_mod.F90 | 8 +- GeosCore/mercury_mod.F90 | 94 +- GeosCore/photolysis_mod.F90 | 1440 +++++++++++++++++++++++++ GeosCore/planeflight_mod.F90 | 30 +- GeosCore/rrtmg_rad_transfer_mod.F90 | 81 +- GeosCore/ucx_mod.F90 | 23 +- Headers/CMN_Phot_mod.F90 | 374 ------- Headers/CMakeLists.txt | 3 +- Headers/phot_container_mod.F90 | 784 ++++++++++++++ Headers/photol_obj_mod.F90 | 1170 --------------------- Headers/state_chm_mod.F90 | 27 +- Headers/state_diag_mod.F90 | 2 +- Interfaces/GCClassic/main.F90 | 9 +- Interfaces/GCHP/gchp_chunk_mod.F90 | 12 +- 23 files changed, 2808 insertions(+), 4507 deletions(-) create mode 100644 GeosCore/photolysis_mod.F90 delete mode 100644 Headers/CMN_Phot_mod.F90 create mode 100644 Headers/phot_container_mod.F90 delete mode 100644 Headers/photol_obj_mod.F90 diff --git a/GeosCore/CMakeLists.txt b/GeosCore/CMakeLists.txt index 73e6f42fc..48341c047 100755 --- a/GeosCore/CMakeLists.txt +++ b/GeosCore/CMakeLists.txt @@ -82,6 +82,7 @@ add_library(GeosCore ocean_mercury_mod.F90 olson_landmap_mod.F90 pbl_mix_mod.F90 + photolysis_mod.F90 planeflight_mod.F90 pops_mod.F90 RnPbBe_mod.F90 diff --git a/GeosCore/aerosol_mod.F90 b/GeosCore/aerosol_mod.F90 index 4863a22e9..0dc0490e9 100644 --- a/GeosCore/aerosol_mod.F90 +++ b/GeosCore/aerosol_mod.F90 @@ -173,7 +173,6 @@ SUBROUTINE AEROSOL_CONC( Input_Opt, State_Chm, State_Diag, & ! ! !USES: ! - USE CMN_Phot_MOD, ONLY : REAA USE ErrCode_Mod USE ERROR_MOD #if !defined( MODEL_CESM ) @@ -245,6 +244,7 @@ SUBROUTINE AEROSOL_CONC( Input_Opt, State_Chm, State_Diag, & ! Pointers TYPE(SpcConc), POINTER :: Spc(:) + REAL*8, POINTER :: REAA(:,:) REAL(fp), POINTER :: AIRVOL(:,:,:) REAL(fp), POINTER :: PMID(:,:,:) REAL(fp), POINTER :: T(:,:,:) @@ -299,6 +299,9 @@ SUBROUTINE AEROSOL_CONC( Input_Opt, State_Chm, State_Diag, & Is_SimpleSOA = ( id_SOAS > 0 ) Is_ComplexSOA = Input_Opt%LSOA + ! Set pointers + REAA => State_Chm%Phot%REAA + ! Convert species to [kg] for this routine CALL Convert_Spc_Units( Input_Opt, State_Chm, State_Grid, State_Met, & 'kg', RC, OrigUnit=OrigUnit ) @@ -1017,6 +1020,7 @@ SUBROUTINE AEROSOL_CONC( Input_Opt, State_Chm, State_Diag, & ! Free pointers Spc => NULL() + REAA => NULL() AIRVOL => NULL() PMID => NULL() T => NULL() @@ -1045,14 +1049,7 @@ SUBROUTINE RDAER( Input_Opt, State_Chm, State_Diag, State_Grid, State_Met, & ! ! !USES: ! - USE CMN_SIZE_Mod, ONLY : NRH, NRHAER, NSTRATAER - USE CMN_Phot_MOD, ONLY : IRHARR, ODAER, NWVAA, NWVAA0, NWVREQUIRED - USE CMN_Phot_MOD, ONLY : IWV1000, REAA, QQAA, ALPHAA, SSAA - USE CMN_Phot_MOD, ONLY : ASYMAA, ISOPOD, NDUST, IWVSELECT - USE CMN_Phot_MOD, ONLY : ACOEF_WV, BCOEF_WV, NAER, IWVREQUIRED -#ifdef RRTMG - USE CMN_Phot_MOD, ONLY : RTODAER, RTSSAER, RTASYMAER -#endif + USE CMN_SIZE_Mod, ONLY : NAER, NRH, NDUST, NRHAER, NSTRATAER USE ErrCode_Mod USE ERROR_MOD, ONLY : ERROR_STOP, Safe_Div USE Input_Opt_Mod, ONLY : OptInput @@ -1182,14 +1179,33 @@ SUBROUTINE RDAER( Input_Opt, State_Chm, State_Diag, State_Grid, State_Met, & REAL(fp) :: GF_RH REAL(fp) :: BCAE_1, BCAE_2 - ! Pointers - REAL(fp), POINTER :: BXHEIGHT(:,:,:) - REAL(fp), POINTER :: ERADIUS(:,:,:,:) - REAL(fp), POINTER :: TAREA(:,:,:,:) - REAL(fp), POINTER :: WERADIUS(:,:,:,:) - REAL(fp), POINTER :: WTAREA(:,:,:,:) + ! Pointers to State_Chm%Phot + INTEGER, POINTER :: IWVREQUIRED(:) + INTEGER, POINTER :: IWVSELECT (:,:) + INTEGER, POINTER :: IRHARR (:,:,:) + REAL*8, POINTER :: ACOEF_WV (:) + REAL*8, POINTER :: BCOEF_WV (:) + REAL*8, POINTER :: REAA (:,:) + REAL*8, POINTER :: QQAA (:,:,:) + REAL*8, POINTER :: ALPHAA (:,:,:) + REAL*8, POINTER :: SSAA (:,:,:) + REAL*8, POINTER :: ASYMAA (:,:,:) + REAL*8, POINTER :: ISOPOD (:,:,:,:) + REAL*8, POINTER :: ODAER (:,:,:,:,:) +#ifdef RRTMG + REAL*8, POINTER :: RTODAER (:,:,:,:,:) + REAL*8, POINTER :: RTSSAER (:,:,:,:,:) + REAL*8, POINTER :: RTASYMAER(:,:,:,:,:) +#endif + + ! Other pointers + REAL(fp), POINTER :: BXHEIGHT (:,:,:) + REAL(fp), POINTER :: ERADIUS (:,:,:,:) + REAL(fp), POINTER :: TAREA (:,:,:,:) + REAL(fp), POINTER :: WERADIUS (:,:,:,:) + REAL(fp), POINTER :: WTAREA (:,:,:,:) REAL(fp), POINTER :: ACLRADIUS(:,:,:) - REAL(fp), POINTER :: ACLAREA(:,:,:) + REAL(fp), POINTER :: ACLAREA (:,:,:) ! For diagnostics LOGICAL :: IsWL1 @@ -1228,13 +1244,30 @@ SUBROUTINE RDAER( Input_Opt, State_Chm, State_Diag, State_Grid, State_Met, & IS_POA = ( id_POA1 > 0 .AND. id_POA2 > 0 ) ! Initialize pointers - BXHEIGHT => State_Met%BXHEIGHT ! Grid box height [m] - ERADIUS => State_Chm%AeroRadi ! Aerosol Radius [cm] - TAREA => State_Chm%AeroArea ! Aerosol Area [cm2/cm3] - WERADIUS => State_Chm%WetAeroRadi ! Wet Aerosol Radius [cm] - WTAREA => State_Chm%WetAeroArea ! Wet Aerosol Area [cm2/cm3] - ACLRADIUS => State_Chm%AClRadi ! Fine Cl- Radius [cm] - ACLAREA => State_Chm%AClArea ! Fine Cl- Area [cm2/cm3] + IWVREQUIRED => State_Chm%Phot%IWVREQUIRED ! WL indexes for interpolation + IWVSELECT => State_Chm%Phot%IWVSELECT ! Indexes of requested WLs + IRHARR => State_Chm%Phot%IRHARR ! Relative humidity indexes + ACOEF_WV => State_Chm%Phot%ACOEF_WV ! Coeffs for WL interpolation + BCOEF_WV => State_Chm%Phot%BCOEF_WV ! Coeffs for WL interpolation + REAA => State_Chm%Phot%REAA + QQAA => State_Chm%Phot%QQAA + ALPHAA => State_Chm%Phot%ALPHAA + SSAA => State_Chm%Phot%SSAA + ASYMAA => State_Chm%Phot%ASYMAA + ISOPOD => State_Chm%Phot%ISOPOD ! Isoprene optical depth + ODAER => State_Chm%Phot%ODAER ! Aerosol optical depth +#ifdef RRTMG + RTODAER => State_Chm%Phot%RTODAER ! Optical dust + RTSSAER => State_Chm%Phot%RTSSAER + RTASYMAER => State_Chm%Phot%RTASYMAER +#endif + BXHEIGHT => State_Met%BXHEIGHT ! Grid box height [m] + ERADIUS => State_Chm%AeroRadi ! Aerosol Radius [cm] + TAREA => State_Chm%AeroArea ! Aerosol Area [cm2/cm3] + WERADIUS => State_Chm%WetAeroRadi ! Wet Aerosol Radius [cm] + WTAREA => State_Chm%WetAeroArea ! Wet Aerosol Area [cm2/cm3] + ACLRADIUS => State_Chm%AClRadi ! Fine Cl- Radius [cm] + ACLAREA => State_Chm%AClArea ! Fine Cl- Area [cm2/cm3] ! Initialize the mapping between hygroscopic species in the ! species database and the species order in NRHAER @@ -1466,12 +1499,13 @@ SUBROUTINE RDAER( Input_Opt, State_Chm, State_Diag, State_Grid, State_Met, & IF ( LRAD ) THEN !Loop over all RT wavelengths (30) ! plus any required for calculating the AOD - NWVS = NWVAA-NWVAA0+NWVREQUIRED + NWVS = State_Chm%Phot%NWVAA - State_Chm%Phot%NWVAA0 + & + State_Chm%Phot%NWVREQUIRED ELSE !Loop over wavelengths needed for !interpolation to those requested in geoschem_config.yml !(determined in RD_AOD) - NWVS = NWVREQUIRED + NWVS = State_Chm%Phot%NWVREQUIRED ENDIF ENDIF @@ -1480,16 +1514,16 @@ SUBROUTINE RDAER( Input_Opt, State_Chm, State_Diag, State_Grid, State_Met, & IF (ODSWITCH .EQ. 0) THEN ! only doing for 1000nm (IWV1000 is set in RD_AOD) ! N.B. NWVS is fixed to 1 above - only one wavelength - IWV=IWV1000 + IWV=State_Chm%Phot%IWV1000 ELSE IF ( LRAD ) THEN ! RRTMG wavelengths begin after NWVAA0 standard wavelengths ! but add on any others required IF (IIWV.LE.30) THEN !index of RRTMG wavelengths starts after the standard NWVAA0 - !(currently NWVAA0=11, set in CMN_Phot_mod based on the - ! .dat LUT) - IWV = IIWV+NWVAA0 + !(currently NWVAA0=11, hard-coded in phot_container_mod based + ! on the .dat LUT) + IWV = IIWV + State_Chm%Phot%NWVAA0 ELSE !now we calculate at wvs for the requested AOD IWV = IWVREQUIRED(IIWV-30) @@ -2246,7 +2280,30 @@ SUBROUTINE RDAER( Input_Opt, State_Chm, State_Diag, State_Grid, State_Met, & !TAREA(:,NDUST+NRHAER+2) = 0.d0 !SPA ! Free pointers - NULLIFY( BXHEIGHT, ERADIUS, TAREA, WERADIUS, WTAREA, ACLRADIUS, ACLAREA ) + IWVREQUIRED => NULL() + IWVSELECT => NULL() + IRHARR => NULL() + ACOEF_WV => NULL() + BCOEF_WV => NULL() + REAA => NULL() + QQAA => NULL() + ALPHAA => NULL() + SSAA => NULL() + ASYMAA => NULL() + ISOPOD => NULL() + ODAER => NULL() +#ifdef RRTMG + RTODAER => NULL() + RTSSAER => NULL() + RTASYMAER => NULL() +#endif + BXHEIGHT => NULL() + ERADIUS => NULL() + TAREA => NULL() + WERADIUS => NULL() + WTAREA => NULL() + ACLRADIUS => NULL() + ACLAREA => NULL() ! Reset first-time flag FIRST = .FALSE. diff --git a/GeosCore/chemistry_mod.F90 b/GeosCore/chemistry_mod.F90 index 926052d03..a36e0d1ea 100644 --- a/GeosCore/chemistry_mod.F90 +++ b/GeosCore/chemistry_mod.F90 @@ -23,7 +23,6 @@ MODULE Chemistry_Mod ! ! !PUBLIC MEMBER FUNCTIONS: ! - PUBLIC :: Init_Chemistry PUBLIC :: Do_Chemistry PUBLIC :: Recompute_OD ! @@ -1431,110 +1430,4 @@ SUBROUTINE Chem_Passive_Species( Input_Opt, State_Chm, State_Grid, & END SUBROUTINE Chem_Passive_Species !EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: init_chemistry -! -! !DESCRIPTION: Subroutine INIT\_CHEMISTRY initializes chemistry -! variables. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE Init_Chemistry( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) -! -! !USES: -! - USE ErrCode_Mod -#ifdef CLOUDJ - USE Cldj_Interface_Mod, ONLY : Init_CloudJ -#else - USE FJX_Interface_Mod, ONLY : Init_FJX -#endif - USE FullChem_Mod, ONLY : Init_FullChem - USE Input_Opt_Mod, ONLY : OptInput - USE State_Chm_Mod, ONLY : ChmState - USE State_Chm_Mod, ONLY : Ind_ - USE State_Diag_Mod, ONLY : DgnState - USE State_Grid_Mod, ONLY : GrdState -! -! !INPUT PARAMETERS: -! - TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object -! -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(OptInput), INTENT(INOUT) :: Input_Opt ! Input Options object - TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object - TYPE(DgnState), INTENT(INOUT) :: State_Diag ! Diagnostics State object - INTEGER, INTENT(INOUT) :: RC ! Success or failure? -! -! !REMARKS: -! We initialize relevant fullchem and carbon KPP mechanism variables -! here in order to use values from the Species Database. When the other -! modules are initialized (most of which are done in GC_Init_Extra), at -! that point the Species Database has not been read from the YAML file, -! so we must call Init_FullChem and Init_Carbon_Gases here. -! -! !REVISION HISTORY: -! 19 May 2014 - C. Keller - Initial version -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: - - ! SAVEd scalars - LOGICAL, SAVE :: FIRST = .TRUE. - - ! Strings - CHARACTER(LEN=255) :: ErrMsg, ThisLoc - - !======================================================================= - ! INIT_CHEMISTRY begins here! - !======================================================================= - - ! Initialize - RC = GC_SUCCESS - ErrMsg = '' - ThisLoc = ' -> at Init_Chemistry (in module GeosCore/chemistry_mod.F90)' - - ! Skip if we have already done this - IF ( FIRST ) THEN - - ! Adjust first flag - FIRST = .FALSE. - - !-------------------------------------------------------------------- - ! Initialize photolysis except for carbon - ! - ! NOTE: we need to call this for a dry-run so that we can get - ! a list of all of the lookup tables etc read by Fast-JX/Cloud-J - !-------------------------------------------------------------------- - IF ( .not. Input_Opt%ITS_A_CARBON_SIM ) THEN -#ifdef CLOUDJ - CALL Init_CloudJ( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_CloudJ"!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF -#else - CALL Init_FJX( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_FJX"!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF -#endif - ENDIF - - ENDIF - - END SUBROUTINE Init_Chemistry -!EOC END MODULE Chemistry_Mod diff --git a/GeosCore/cldj_interface_mod.F90 b/GeosCore/cldj_interface_mod.F90 index 654fcf228..61956da3f 100644 --- a/GeosCore/cldj_interface_mod.F90 +++ b/GeosCore/cldj_interface_mod.F90 @@ -31,16 +31,10 @@ MODULE CLDJ_INTERFACE_MOD ! PUBLIC :: INIT_CLOUDJ PUBLIC :: RUN_CLOUDJ - PUBLIC :: PHOTRATE_ADJ ! ! !PRIVATE MEMBER FUNCTIONS: ! - PRIVATE :: GC_EXITC - PRIVATE :: RD_PROF_NC - PRIVATE :: RD_AOD - PRIVATE :: CALC_AOD - PRIVATE :: SET_PROF - PRIVATE :: SET_AER + PRIVATE :: SET_PROF_CLOUDJ PRIVATE :: SOLAR_JX ! Copy of fjx_mod SOLAR_JX pending looking more at cldj ! ! !REVISION HISTORY: @@ -64,25 +58,22 @@ MODULE CLDJ_INTERFACE_MOD !\\ ! !INTERFACE: ! - SUBROUTINE INIT_CLOUDJ( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) + SUBROUTINE INIT_CLOUDJ( Input_Opt, State_Diag, State_Grid, State_Chm, RC ) ! ! !USES: ! + +! ewl: Use, inputs/outputs, and local vars could be slimmed down USE Charpak_Mod, ONLY : CSTRIP + ! ewl: if these are in cloud-j, why do I need to pass them??? USE Cldj_Cmn_Mod, ONLY : JVN_, NJX, NRATJ, W_, WL USE Cldj_Cmn_Mod, ONLY : TITLEJX, JLABEL, JFACTA, RNAMES - - ! ewl debugging - USE Cldj_Cmn_Mod, ONLY : JIND, BRANCH - + USE Cldj_Cmn_Mod, ONLY : JIND, BRANCH ! ewl debugging USE Cldj_Init_Mod, ONLY : Init_CldJ - USE Cmn_Phot_Mod, ONLY : GC_Photo_ID, UVXFACTOR USE ErrCode_Mod USE Input_Opt_Mod, ONLY : OptInput USE inquireMod, ONLY : findFreeLUN - USE PhysConstants, ONLY : UVXPlanck, UVXCConst USE State_Chm_Mod, ONLY : ChmState - USE State_Chm_Mod, ONLY : Ind_ USE State_Diag_Mod, ONLY : DgnState USE State_Grid_Mod, ONLY : GrdState #if defined( MODEL_CESM ) @@ -92,14 +83,18 @@ SUBROUTINE INIT_CLOUDJ( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object - TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object - TYPE(DgnState), INTENT(IN) :: State_Diag ! Diagnostics State object - TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object + TYPE(DgnState), INTENT(IN) :: State_Diag ! Diagnostics State object + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object + ! ! !OUTPUT PARAMETERS: ! - INTEGER, INTENT(OUT) :: RC ! Success or failure? + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 14 Dec 2022 - E. Lundgren - initial version, adapted from fast_jx_mod @@ -146,17 +141,6 @@ SUBROUTINE INIT_CLOUDJ( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) endif ENDIF -#if defined( MODEL_CESM ) - IF ( Input_Opt%amIRoot ) THEN - JXUNIT = findFreeLUN() - ELSE - JXUNIT = 0 - ENDIF -#else - ! Get a free LUN - JXUNIT = findFreeLUN() -#endif - ENDIF ! Define data directory for FAST-JX input @@ -167,384 +151,8 @@ SUBROUTINE INIT_CLOUDJ( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) ! FJX_j2j.dat (RD_JS_JX) CALL Init_CldJ(DATA_DIR,TITLEJXX,JVN_,NJXX) - !===================================================================== - ! Read in AOD data - ! (or just print file name if in dry-run mode) - !===================================================================== - CALL RD_AOD( JXUNIT, Input_Opt, RC ) - - !ewl: I took this out of RD_AOD - ! Only do the following if we are not running in dry-run mode - IF ( .not. Input_Opt%DryRun ) THEN - - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, * ) 'Optics read for all wavelengths successfully' - ENDIF - - ! Now calculate the required wavelengths in the LUT to calculate - ! the requested AOD - CALL CALC_AOD( Input_Opt ) - ENDIF - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in FAST-JX routine "RD_AOD"!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ! Set up MIEDX array to interpret between GC and FJX aerosol indexing - ! NOTE: MIEDX was mostly not used in Fast-JX. It is used for all - ! aerosols in Cloud-J (ewl) - IF ( notDryRun ) THEN - CALL SET_AER( Input_Opt ) - ENDIF - - !===================================================================== - ! Read in T & O3 climatology used to fill e.g. upper layers - ! or if O3 not calc. - !===================================================================== - CALL RD_PROF_NC( Input_Opt, RC ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Rd_Prof_Nc"!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ! Skip if not in dry-run mode - IF ( notDryRun ) THEN - NJXX = NJX - do J = 1,NJX - TITLEJXX(J) = TITLEJX(J) - enddo - ENDIF - -! ewl: do I need to bring this back??? - ! Store # of photolysis reactions in state_chm - State_Chm%Photol%NRatJ = NRatJ - - !======================================================================== - ! Flag special reactions that will be later adjusted by - ! routine PHOTRATE_ADJ (called from FlexChem) - !======================================================================== - - IF ( Input_Opt%ITS_A_FULLCHEM_SIM ) THEN - ! Loop over all photolysis reactions - DO K = 1, NRATJ - - ! Strip all blanks from the reactants and products list - TEXT = JLABEL(K) - CALL CSTRIP( TEXT ) - - !IF ( Input_Opt%amIRoot ) THEN - ! WRITE(*,*) K, TRIM( TEXT ) - !ENDIF - - ! Look for certain reactions - SELECT CASE( TRIM( TEXT ) ) - CASE( 'O2PHOTONOO' ) - State_Chm%Photol%RXN_O2 = K ! O2 + hv -> O + O - CASE( 'O3PHOTONO2O' ) - State_Chm%Photol%RXN_O3_1 = K ! O3 + hv -> O2 + O - CASE( 'O3PHOTONO2O(1D)' ) - State_Chm%Photol%RXN_O3_2 = K ! O3 + hv -> O2 + O(1D) - CASE( 'SO4PHOTONSO2OHOH' ) - State_Chm%Photol%RXN_H2SO4 = K ! SO4 + hv -> SO2 + OH + OH - CASE( 'NO2PHOTONNOO' ) - State_Chm%Photol%RXN_NO2 = K ! NO2 + hv -> NO + O - CASE( 'NOPHOTONNO' ) - State_Chm%Photol%RXN_NO = K ! NO + hv -> N + O - CASE( 'NO3PHOTONNO2O' ) - State_Chm%Photol%RXN_NO3 = K ! NO3 + hv -> NO2 + O - CASE( 'N2OPHOTONN2O' ) - State_Chm%Photol%RXN_N2O = K ! N2O + hv -> N2 + O - CASE( 'NITsPHOTONHNO2' ) - State_Chm%Photol%RXN_JNITSa = K ! NITs + hv -> HNO2 - CASE( 'NITsPHOTONNO2' ) - State_Chm%Photol%RXN_JNITSb = K ! NITs + hv -> NO2 - CASE( 'NITPHOTONHNO2' ) - State_Chm%Photol%RXN_JNITa = K ! NIT + hv -> HNO2 - CASE( 'NITPHOTONNO2' ) - State_Chm%Photol%RXN_JNITb = K ! NIT + hv -> NO2 - CASE( 'HNO3PHOTONNO2OH' ) - State_Chm%Photol%RXN_JHNO3 = K ! HNO3 + hv = OH + NO2 - CASE DEFAULT - ! Nothing - END SELECT - ENDDO - - !--------------------------------------------------------------------- - ! Error check the various rxn flags - !--------------------------------------------------------------------- - IF ( State_Chm%Photol%RXN_O2 < 0 ) THEN - ErrMsg = 'Could not find rxn O2 + hv -> O + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_O3_1 < 0 ) THEN - ErrMsg = 'Could not find rxn O3 + hv -> O2 + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_O3_2 < 0 ) THEN - ErrMsg = 'Could not find rxn O3 + hv -> O2 + O(1D)' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - ENDIF - - IF ( State_Chm%Photol%RXN_NO2 < 0 ) THEN - ErrMsg = 'Could not find rxn NO2 + hv -> NO + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_NO2 < 0 ) THEN - ErrMsg = 'Could not find rxn NO2 + hv -> NO + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_JNITSa < 0 ) THEN - ErrMsg = 'Could not find rxn NITS + hv -> HNO2' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_JNITSb < 0 ) THEN - ErrMsg = 'Could not find rxn NITS + hv -> NO2' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_JNITa < 0 ) THEN - ErrMsg = 'Could not find rxn NIT + hv -> HNO2' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_JNITb < 0 ) THEN - ErrMsg = 'Could not find rxn NIT + hv -> NO2' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_H2SO4 < 0 ) THEN - ErrMsg = 'Could not find rxn SO4 + hv -> SO2 + OH + OH!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_NO3 < 0 ) THEN - ErrMsg = 'Could not find rxn NO3 + hv -> NO2 + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_NO < 0 ) THEN - ErrMsg = 'Could not find rxn NO + hv -> O + N' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_N2O < 0 ) THEN - ErrMsg = 'Could not find rxn N2O + hv -> N2 + O(1D)' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - !--------------------------------------------------------------------- - ! Print out saved rxn flags for fullchem simulations - !--------------------------------------------------------------------- - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 100 ) REPEAT( '=', 79 ) - WRITE( 6, 110 ) - WRITE( 6, 120 ) State_Chm%Photol%RXN_O2 - WRITE( 6, 130 ) State_Chm%Photol%RXN_O3_1 - WRITE( 6, 140 ) State_Chm%Photol%RXN_O3_2 - WRITE( 6, 180 ) State_Chm%Photol%RXN_JNITSa - WRITE( 6, 190 ) State_Chm%Photol%RXN_JNITSb - WRITE( 6, 200 ) State_Chm%Photol%RXN_JNITa - WRITE( 6, 210 ) State_Chm%Photol%RXN_JNITb - WRITE( 6, 160 ) State_Chm%Photol%RXN_H2SO4 - WRITE( 6, 170 ) State_Chm%Photol%RXN_NO2 - WRITE( 6, 100 ) REPEAT( '=', 79 ) - ENDIF - ENDIF - - !======================================================================== - ! Flag reactions for diagnostics (only in Hg chem) - !======================================================================== - IF ( Input_Opt%ITS_A_MERCURY_SIM ) THEN - ! Loop over all photolysis reactions - DO K = 1, NRATJ - - ! Strip all blanks from the reactants and products list - TEXT = JLABEL(K) - CALL CSTRIP( TEXT ) - - ! Look for certain reactions - SELECT CASE( TRIM( TEXT ) ) - CASE( 'O3PHOTONO2O' ) - State_Chm%Photol%RXN_O3_1 = K ! O3 + hv -> O2 + O - CASE( 'O3PHOTONO2O(1D)' ) - State_Chm%Photol%RXN_O3_2 = K ! O3 + hv -> O2 + O(1D) - CASE( 'NO2PHOTONNOO' ) - State_Chm%Photol%RXN_NO2 = K ! NO2 + hv -> NO + O - CASE( 'BrOPHOTONBrO' ) - State_Chm%Photol%RXN_BrO = K ! BrO + hv -> Br + O - CASE( 'ClOPHOTONClO' ) - State_Chm%Photol%RXN_ClO = K ! ClO + hv -> Cl + O - CASE DEFAULT - ! Nothing - END SELECT - ENDDO - - !-------------------------------------------------------------------- - ! Error check the various rxn flags - !-------------------------------------------------------------------- - IF ( State_Chm%Photol%RXN_O3_1 < 0 ) THEN - ErrMsg = 'Could not find rxn O3 + hv -> O2 + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_O3_2 < 0 ) THEN - ErrMsg = 'Could not find rxn O3 + hv -> O2 + O(1D) #1' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_NO2 < 0 ) THEN - ErrMsg = 'Could not find rxn NO2 + hv -> NO + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_BrO < 0 ) THEN - ErrMsg = 'Could not find rxn BrO + hv -> Br + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_ClO < 0 ) THEN - ErrMsg = 'Could not find rxn ClO + hv -> Cl + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - !--------------------------------------------------------------------- - ! Print out saved rxn flags for Hg simulation - !--------------------------------------------------------------------- - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 100 ) REPEAT( '=', 79 ) - WRITE( 6, 110 ) - WRITE( 6, 130 ) State_Chm%Photol%RXN_O3_1 - WRITE( 6, 140 ) State_Chm%Photol%RXN_O3_2 - WRITE( 6, 170 ) State_Chm%Photol%RXN_NO2 - WRITE( 6, 220 ) State_Chm%Photol%RXN_BrO - WRITE( 6, 230 ) State_Chm%Photol%RXN_ClO - WRITE( 6, 100 ) REPEAT( '=', 79 ) - ENDIF - ENDIF - - ! FORMAT statements -100 FORMAT( a ) -110 FORMAT( 'Photo rxn flags saved for use in PHOTRATE_ADJ:', / ) -120 FORMAT( 'RXN_O2 [ O2 + hv -> O + O ] = ', i5 ) -130 FORMAT( 'RXN_O3_1 [ O3 + hv -> O2 + O ] = ', i5 ) -140 FORMAT( 'RXN_O3_2a [ O3 + hv -> O2 + O(1D) #1 ] = ', i5 ) -150 FORMAT( 'RXN_O3_2b [ O3 + hv -> O2 + O(1D) #2 ] = ', i5 ) -160 FORMAT( 'RXN_H2SO4 [ SO4 + hv -> SO2 + OH + OH ] = ', i5 ) -170 FORMAT( 'RXN_NO2 [ NO2 + hv -> NO + O ] = ', i5 ) -180 FORMAT( 'RXN_JNITSa [ NITS + hv -> HNO2 ] = ', i5 ) -190 FORMAT( 'RXN_JNITSb [ NITS + hv -> NO2 ] = ', i5 ) -200 FORMAT( 'RXN_JNITa [ NIT + hv -> HNO2 ] = ', i5 ) -210 FORMAT( 'RXN_JNITb [ NIT + hv -> NO2 ] = ', i5 ) -220 FORMAT( 'RXN_BrO [ BrO + hv -> Br + O ] = ', i5 ) -230 FORMAT( 'RXN_ClO [ ClO + hv -> Cl + O ] = ', i5 ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_CloudJ"!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ! Skip further processing if we are in dry-run mode - IF ( notDryRun ) THEN - - ! Get the GEOS-Chem photolysis index for each of the 1...JVN_ entries - ! in the FJX_j2j.dat file. We'll use this for the diagnostics. - DO J = 1, JVN_ - - IF ( J == State_Chm%Photol%Rxn_O3_2 ) THEN - - !------------------------------------------------------------ - ! O3 + hv = O + O(1D) - ! - ! Save this as JO3_O1D in the nPhotol+1 slot - !------------------------------------------------------------ - GC_Photo_Id(J) = State_Chm%nPhotol + 1 - - ELSE IF ( J == State_Chm%Photol%Rxn_O3_1 ) THEN - - !------------------------------------------------------------ - ! O3 + hv -> O + O - ! - ! Save this as JO3_O3P in the nPhotol+2 slot - !------------------------------------------------------------- - GC_Photo_Id(J) = State_Chm%nPhotol + 2 - - ELSE - - !------------------------------------------------------------ - ! Everything else - ! - ! Find the matching GEOS-Chem photolysis species number - !------------------------------------------------------------ - GC_Photo_Id(J) = Ind_( RNAMES(J), 'P' ) - - ENDIF - - ! Print the mapping - IF ( Input_Opt%amIRoot ) THEN - IF ( GC_Photo_Id(J) > 0 ) THEN - WRITE(6, 240) RNAMES(J), J, GC_Photo_Id(J), JFACTA(J) -240 FORMAT( a10, ':', i7, 2x, i7, 2x, f7.4 ) - ENDIF - ENDIF - ENDDO - -#if defined( MODEL_CESM ) - IF ( Input_Opt%amIRoot ) THEN - CALL freeUnit(JXUnit) - ENDIF -#endif - - ! Compute factors for UV flux diagnostics if turned on - IF ( State_Diag%Archive_UVFluxNet .or. & - State_Diag%Archive_UVFluxDirect .or. & - State_Diag%Archive_UVFluxDiffuse ) THEN - UVXFACTOR = 0e+0_fp - ND64MULT = UVXPLANCK*UVXCCONST*1.0e+13_fp - DO J = 1, W_ - UVXFACTOR(J) = ND64MULT/WL(J) - ENDDO - ENDIF - ENDIF - - ! ewl debugging - print *, " " - print *, "In Init_CloudJ" - print *, "ewl: NRATJ: ", NRATJ - print *, "ewl: JLABEL(1): ", JLABEL(1) - print *, "ewl: RNAMES(1): ", RNAMES(1) - print *, "ewl: JIND(1): ", JIND(1) - print *, "ewl: JFACTA(1): ", JFACTA(1) - print *, "ewl: BRANCH(1): ", BRANCH(1) + ! Store # of photolysis reactions in State_Chm object for easy reference + State_Chm%Phot%nPhotRxns = NRatJ END SUBROUTINE INIT_CLOUDJ !EOC @@ -567,12 +175,11 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & ! ! !USES: ! + ! ewl: if these are in cloud-j, why do we need them here?? USE Cldj_Cmn_Mod, ONLY : A_, L_, L1_, W_, S_ USE Cldj_Cmn_Mod, ONLY : JVN_, JXL_, JXL1_, AN_, NQD_, W_r - USE Cldj_Cmn_Mod, ONLY : NRATJ, JIND, JFACTA, FL + USE Cldj_Cmn_Mod, ONLY : JIND, JFACTA, FL USE Cld_Sub_Mod, ONLY : Cloud_JX - USE CMN_Phot_Mod, ONLY : ZPJ, IRHARR, UVXFACTOR, IWV1000 - USE CMN_Phot_Mod, ONLY : ODAER, ODMDUST, MIEDX USE CMN_SIZE_MOD, ONLY : NDUST, NRH, NAER, NRHAER USE ErrCode_Mod USE ERROR_MOD, ONLY : ERROR_STOP, ALLOC_ERR @@ -589,20 +196,6 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & USE TOMS_MOD, ONLY : GET_OVERHEAD_O3 IMPLICIT NONE - -!============================================================================== -! Uncomment the appropriate #define statement to denote which of the -! available cloud overlap options that you wish to use. - -!! Linear overlap -!#define USE_LINEAR_OVERLAP 1 - -! Approximate random overlap (balance between accuracy & speed) -#define USE_APPROX_RANDOM_OVERLAP 1 - -!! Maximum random cloud overlap (most computationally intensive) -!#define USE_MAXIMUM_RANDOM_OVERLAP 1 -!============================================================================== ! ! !INPUT PARAMETERS: ! @@ -623,12 +216,6 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & ! ! !REMARKS: ! -! Parameter to choose cloud overlap algorithm: -! ============================================================================ -! (1 ) OVERLAP (INTEGER) : 1 - Linear Approximation (used up to v7-04-12) -! 2 - Approximate Random Overlap (default) -! 3 - Maximum Random Overlap (computation intensive) -! ! !REVISION HISTORY: ! 14 Dec 2022 - E. Lundgren - initial version, adapted from fast_jx_mod ! See https://github.com/geoschem/geos-chem for complete history @@ -638,9 +225,10 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & ! ! !LOCAL VARIABLES: ! +!ewl: might be able to clean up use statements, inputs/outpus, and local vars INTEGER, SAVE :: LASTMONTH = -1 INTEGER :: NLON, NLAT, DAY, MONTH, DAY_OF_YR, L, N, J - INTEGER :: IOPT, LCHEM + INTEGER :: IOPT, LCHEM, IWV1000 REAL(fp) :: U0, PRES, YLAT, O3_TOMS, SZA, SOLF REAL(fp) :: O3_CTM(State_Grid%NZ+1) REAL(fp) :: T_CTM(State_Grid%NZ+1), OPTD(State_Grid%NZ) @@ -748,6 +336,9 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & ThisLoc = ' -> at Run_CloudJ (in module GeosCore/cldj_interface_mod.F90)' prtDebug = Input_Opt%Verbose + ! Get wavelength index for 1000 hm + IWV1000 = State_Chm%Phot%IWV1000 + ! Get day of year (0-365 or 0-366) DAY_OF_YR = GET_DAY_OF_YEAR() @@ -778,7 +369,7 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & NDXAER(:,:) = 0.d0 DO N = 1, AN_ DO L = 1, L1_ - NDXAER(L,N) = MIEDX(N) + NDXAER(L,N) = State_Chm%Phot%MIEDX(N) ENDDO ENDDO @@ -837,6 +428,7 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & !$OMP PRIVATE( CLDF, CLDCOR, CLDIW, AERSP, IRAN, SKPERD ) & !$OMP PRIVATE( SWMSQ, OD18, NICA, JCOUNT, LDARK, WTQCA ) & !$OMP PRIVATE( A, MW_kg, BoxHt ) & + !$OMP PRIVATE( FDIRECT, FDIFFUSE, UVX_CONST, K, S ) & !$OMP SCHEDULE( DYNAMIC ) ! Loop over latitudes and longitudes @@ -889,19 +481,19 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & OPTAER = 0.0e+0_fp DO N = 1, NAER DO L = 1, State_Grid%NZ - IOPT = ( (N-1) * NRH ) + IRHARR(NLON,NLAT,L) - OPTAER(L,IOPT) = ODAER(NLON,NLAT,L,IWV1000,N) + IOPT = ( (N-1) * NRH ) + State_Chm%Phot%IRHARR(NLON,NLAT,L) + OPTAER(L,IOPT) = State_Chm%Phot%ODAER(NLON,NLAT,L,IWV1000,N) ENDDO ENDDO DO N = 1, NDUST DO L = 1, State_Grid%NZ - OPTDUST(L,N) = ODMDUST(NLON,NLAT,L,IWV1000,N) + OPTDUST(L,N) = State_Chm%Phot%ODMDUST(NLON,NLAT,L,IWV1000,N) ENDDO ENDDO ! Mineral dust OD profile [unitless] at (NLON,NLAT) ! and at 1000nm, IWV1000 (DAR) - !OPTDUST = ODMDUST(NLON,NLAT,:,IWV1000,:) + !OPTDUST = ODMDUST(NLON,NLAT,:,State_Chm%Phot%IWV1000,:) ! Cloud OD profile [unitless] at (NLON,NLAT) OPTD = State_Met%OPTD(NLON,NLAT,1:State_Grid%NZ) @@ -925,7 +517,8 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & #endif if (State_Grid%NZ+1 .gt. JXL1_) then - call GC_EXITC(' PHOTO_JX: not enough levels in JX') + CALL ERROR_STOP('PHOTO_JX: not enough levels in JX', & + 'cldj_interface_mod.F90' ) endif ! Input conversion (SDE 03/29/13) @@ -992,12 +585,12 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & ! Path density (DDJ) [# molec/cm2] ! New methodology for: ! Ozone density (OOJ) [# O3 molec/cm2] - CALL SET_PROF (YLAT, MONTH, DAY, & + CALL SET_PROF_CLOUDJ (YLAT, MONTH, DAY, & T_CTM, P_CTM, OPTD, & OPTDUST, OPTAER, O3_CTM, & O3_TOMS, AERX_COL, T_CLIM, & O3_CLIM, Z_CLIM, AIR_CLIM, & - Input_Opt, State_Grid ) + Input_Opt, State_Grid, State_Chm ) ! ! Call FAST-JX routines to compute J-values ! CALL PHOTO_JX( Input_Opt%amIRoot, Input_Opt%DryRun, & @@ -1158,11 +751,11 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & ! Fill out common-block array of J-rates using PHOTO_JX output DO L=1,State_Grid%MaxChemLev - DO J=1,NRATJ + DO J=1,State_Chm%Phot%nPhotRxns IF (JIND(J).gt.0) THEN - ZPJ(L,J,NLON,NLAT) = VALJXX(L,JIND(J))*JFACTA(J) + State_Chm%Phot%ZPJ(L,J,NLON,NLAT) = VALJXX(L,JIND(J))*JFACTA(J) ELSE - ZPJ(L,J,NLON,NLAT) = 0.e+0_fp + State_Chm%Phot%ZPJ(L,J,NLON,NLAT) = 0.e+0_fp ENDIF ENDDO ENDDO @@ -1170,8 +763,8 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & ! Set J-rates outside the chemgrid to zero IF (State_Grid%MaxChemLev.lt.L_) THEN DO L=State_Grid%MaxChemLev+1,L_ - DO J=1,NRATJ - ZPJ(L,J,NLON,NLAT) = 0.e+0_fp + DO J=1,State_Chm%Phot%nPhotRxns + State_Chm%Phot%ZPJ(L,J,NLON,NLAT) = 0.e+0_fp ENDDO ENDDO ENDIF @@ -1200,6 +793,8 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & FDIRECT = 0.0_fp FDIFFUSE = 0.0_fp + ! ewl: this is messed up. FSBOT and FJBOT aren't set. + ! Direct & diffuse fluxes at each level FDIRECT(1) = FSBOT(K) ! surface FDIFFUSE(1) = FJBOT(K) ! surface @@ -1209,7 +804,7 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & ENDDO ! Constant to multiply UV fluxes at each wavelength bin - UVX_CONST = SOLF * FL(K) * UVXFACTOR(K) + UVX_CONST = SOLF * FL(K) * State_Chm%Phot%UVXFACTOR(K) ! Archive into diagnostic arrays DO L = 1, State_Grid%NZ @@ -1248,12 +843,6 @@ SUBROUTINE Run_CloudJ( WLAOD, Input_Opt, State_Chm, State_Diag, & ENDDO !$OMP END PARALLEL DO -! ! ewl debug: beware this is called in a loop!! -! L=1 -! DO J=1,JVN_ -! print *, "ewl: J, sum, min, max of ZPJ after run_CloudJ: ", J, SUM(ZPJ(L,J,:,:)), MINVAL(ZPJ(L,J,:,:)), MAXVAL(ZPJ(L,J,:,:)) -! ENDDO - ! Reset first-time flag FIRST=.FALSE. @@ -1264,882 +853,27 @@ END SUBROUTINE Run_CloudJ !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: photrate_adj -! -! !DESCRIPTION: Subroutine PHOTRATE\_ADJ adjusts certain photolysis rates -! for chemistry. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE PHOTRATE_ADJ( Input_Opt, State_Chm, State_Diag, State_Met, & - I, J, L, & - FRAC, RC ) -! -! !USES: -! - USE CMN_Phot_Mod, ONLY : ZPJ - USE ErrCode_Mod - USE Input_Opt_Mod, ONLY : OptInput - USE State_Chm_Mod, ONLY : ChmState - USE State_Diag_Mod, ONLY : DgnState - USE State_Met_Mod, ONLY : MetState -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input_Options object - TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object - TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object - INTEGER, INTENT(IN) :: I, J, L ! Lon, lat, lev indices - REAL(fp), INTENT(IN) :: FRAC ! Result of SO4_PHOTFRAC, - ! called from DO_FLEXCHEM -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(DgnState), INTENT(INOUT) :: State_Diag ! Diagnostics State object -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Success or failure -! -! !REMARKS: -! NOTE: The netCDF diagnostics are attached in DO_FLEXCHEM so that we have -! access to the adjusted rates. Only the bpch diagnostics are updated -! here. -! -- Bob Yantosca, 19 Dec 2017 -! -! %%%% NOTE: WE SHOULD UPDATE THE COMMENTS TO MAKE SURE THAT WE DO %%%% -! %%%% NOT KEEP ANY CONFLICTING OR INCORRECT INFORMATION (bmy, 3/28/16) %%%% -! -! !REVISION HISTORY: -! 14 Dec 2022 - E. Lundgren - initial version -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - INTEGER :: RXN_JNITSa, RXN_JNITSb, RXN_JNITa, RXN_JNITb - INTEGER :: RXN_JHNO3, RXN_H2SO4, RXN_O3_1, RXN_O3_2 - REAL(fp) :: JscaleNITs, JscaleNIT, JNITChanA, JNITChanB - REAL(fp) :: C_O2, C_N2, C_H2, ITEMPK, RO1DplH2O - REAL(fp) :: RO1DplH2, RO1D, NUMDEN, TEMP, C_H2O - - - !================================================================= - ! PHOTRATE_ADJ begins here! - !================================================================= - - ! Initialize - RC = GC_SUCCESS - TEMP = State_Met%T(I,J,L) ! K - NUMDEN = State_Met%AIRNUMDEN(I,J,L) ! molec/cm3 - C_H2O = State_Met%AVGW(I,J,L) * State_Met%AIRNUMDEN(I,J,L) ! molec/cm3 - RXN_JNITSa = State_Chm%Photol%RXN_JNITSa - RXN_JNITSb = State_Chm%Photol%RXN_JNITSb - RXN_JNITa = State_Chm%Photol%RXN_JNITa - RXN_JNITb = State_Chm%Photol%RXN_JNITb - RXN_JHNO3 = State_Chm%Photol%RXN_JHNO3 - RXN_H2SO4 = State_Chm%Photol%RXN_H2SO4 - RXN_O3_1 = State_Chm%Photol%RXN_O3_1 - RXN_O3_2 = State_Chm%Photol%RXN_O3_2 - - ! For all mechanisms. Set the photolysis rate of NITs and NIT to a - ! scaled value of JHNO3. NOTE: this is set in geoschem_config.yml - IF ( Input_Opt%hvAerNIT ) THEN - - ! Get the photolysis scalars read in from geoschem_config.yml - JscaleNITs = Input_Opt%hvAerNIT_JNITs - JscaleNIT = Input_Opt%hvAerNIT_JNIT - ! convert reaction channel % to a fraction - JNITChanA = Input_Opt%JNITChanA - JNITChanB = Input_Opt%JNITChanB - JNITChanA = JNITChanA / 100.0_fp - JNITChanB = JNITChanB / 100.0_fp - ! Set the photolysis rate of NITs - ZPJ(L,RXN_JNITSa,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNITs - ZPJ(L,RXN_JNITSb,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNITs - ! Set the photolysis rate of NIT - ZPJ(L,RXN_JNITa,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNIT - ZPJ(L,RXN_JNITb,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNIT - ! Adjust to scaling for channels set in geoschem_config.yml - ! NOTE: channel scaling is 1 in FJX_j2j.dat, then updated here - ZPJ(L,RXN_JNITSa,I,J) = ZPJ(L,RXN_JNITSa,I,J) * JNITChanA - ZPJ(L,RXN_JNITa,I,J) = ZPJ(L,RXN_JNITa,I,J) * JNITChanA - ZPJ(L,RXN_JNITSb,I,J) = ZPJ(L,RXN_JNITSb,I,J) * JNITChanB - ZPJ(L,RXN_JNITb,I,J) = ZPJ(L,RXN_JNITb,I,J) * JNITChanB - - ! Gotcha to set JNIT and JNITs to zero if hvAerNIT switch is off - ELSE - - ! Set the photolysis rate of NITs to zero - ZPJ(L,RXN_JNITSa,I,J) = 0.0_fp - ZPJ(L,RXN_JNITSb,I,J) = 0.0_fp - ! Set the photolysis rate of NIT to zero - ZPJ(L,RXN_JNITa,I,J) = 0.0_fp - ZPJ(L,RXN_JNITb,I,J) = 0.0_fp - - ENDIF - - !============================================================== - ! SPECIAL TREATMENT FOR H2SO4+hv -> SO2 + 2OH - ! - ! Only allow photolysis of H2SO4 when gaseous (SDE 04/11/13) - !============================================================== - - ! Calculate if H2SO4 expected to be gaseous or aqueous - ! Only allow photolysis above 6 hPa - ! RXN_H2SO4 specifies SO4 + hv -> SO2 + OH + OH - ZPJ(L,RXN_H2SO4,I,J) = ZPJ(L,RXN_H2SO4,I,J) * FRAC - - !============================================================== - ! SPECIAL TREATMENT FOR O3+hv -> O+O2 - ! - ! [O1D]ss=J[O3]/(k[H2O]+k[N2]+k[O2]) - ! SO, THE EFFECTIVE J-VALUE IS J*k[H2O]/(k[H2O]+k[N2]+k[O2]) - ! - ! We don't want to do this if strat-chem is in use, as all - ! the intermediate reactions are included - this would be - ! double-counting (SDE 04/01/13) - !============================================================== - - ! Need to subtract O3->O1D from rate - ! RXN_O3_1 specifies: O3 + hv -> O2 + O - ! RXN_O3_2 specifies: O3 + hv -> O2 + O(1D) - ZPJ(L,RXN_O3_1,I,J) = ZPJ(L,RXN_O3_1,I,J) & - - ZPJ(L,RXN_O3_2,I,J) - - END SUBROUTINE PHOTRATE_ADJ -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: rd_aod -! -! !DESCRIPTION: Subroutine RD\_AOD reads aerosol phase functions that are -! used to scale diagnostic output to an arbitrary wavelengh. This -! facilitates comparing with satellite observations. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE RD_AOD( NJ1, Input_Opt, RC ) -! -! !USES: -! - USE CMN_Phot_Mod, ONLY : RDAA, RWAA, WVAA, NRAA, RHAA, SGAA, QQAA, REAA - USE CMN_Phot_Mod, ONLY : SSAA, ASYMAA, PHAA - USE CMN_Phot_Mod, ONLY : IWV1000, NSPAA, NWVAA, NRLAA, NCMAA, ALPHAA - USE ErrCode_Mod - USE Input_Opt_Mod, ONLY : OptInput -! -! !INPUT PARAMETERS: -! - INTEGER, INTENT(IN) :: NJ1 ! Unit # of file to open - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Success or failure? -! -! !REMARKS: -! The .dat files for each species contain the optical properties -! at multiple wavelengths to be used in the online calculation of the aerosol -! optical depth diagnostics. -! These properties have been calculated using the same size and optical -! properties as the FJX_spec.dat file used for the FAST-J photolysis -! calculations (which is now redundant for aerosols, the values in the .dat -! files here are now used). The file currently contains 11 wavelengths -! for Fast-J and other commonly used wavelengths for satellite and -! AERONET retrievals. 30 wavelengths follow that map onto RRTMG -! wavebands for radiaitive flux calculations (not used if RRTMG is off). -! A complete set of optical properties from 250-2000 nm for aerosols is -! available at: -! ftp://ftp.as.harvard.edu/geos-chem/data/aerosol_optics/hi_spectral_res -! . -! -- Colette L. Heald, 05/10/10) -! -- David A. Ridley, 05/10/13 (update for new optics files) -! -! !REVISION HISTORY: -! 10 May 2010 - C. Heald - Initial version -! 14 Dec 2022 - E. Lundgren - Copied from GEOS-Chem fast_jx_mod -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES -! - ! Scalars - INTEGER :: I, J, K, N - INTEGER :: IOS - LOGICAL :: LBRC, FileExists - - ! Strings - CHARACTER(LEN=78 ) :: TITLE0 - CHARACTER(LEN=255) :: DATA_DIR - CHARACTER(LEN=255) :: THISFILE - CHARACTER(LEN=255) :: FileMsg - CHARACTER(LEN=255) :: ErrMsg - CHARACTER(LEN=255) :: ThisLoc - - ! String arrays - CHARACTER(LEN=30) :: SPECFIL(8) - - !================================================================ - ! RD_AOD begins here! - !================================================================ - - ! Initialize - RC = GC_SUCCESS - ErrMsg = '' - ThisLoc = ' -> at RD_AOD (in module GeosCore/fast_jx_mod.F90)' - LBRC = Input_Opt%LBRC - DATA_DIR = TRIM( Input_Opt%FAST_JX_DIR ) - - ! IMPORTANT: aerosol_mod.F and dust_mod.F expect aerosols in this order - ! - ! Treating strat sulfate with GADS data but modified to match - ! the old Fast-J values size (r=0.09um, sg=0.6) - I think there's - ! evidence that this is too smale and narrow e.g. Deshler et al. 2003 - ! NAT should really be associated with something like cirrus cloud - ! but for now we are just treating the NAT like the sulfate... limited - ! info but ref index is similar e.g. Scarchilli et al. (2005) - !(DAR 05/2015) - DATA SPECFIL /"so4.dat","soot.dat","org.dat", & - "ssa.dat","ssc.dat", & - "h2so4.dat","h2so4.dat", & - "dust.dat"/ - - ! Loop over the array of filenames - DO k = 1, NSPAA - - ! Choose different set of input files for standard (trop+strat chenm) - ! and tropchem (trop-only chem) simulations - THISFILE = TRIM( DATA_DIR ) // TRIM( SPECFIL(k) ) - - !-------------------------------------------------------------- - ! In dry-run mode, print file path to dryrun log and cycle. - ! Otherwise, print file path to stdout and continue. - !-------------------------------------------------------------- - - ! Test if the file exists - INQUIRE( FILE=TRIM( ThisFile ), EXIST=FileExists ) - - ! Test if the file exists and define an output string - IF ( FileExists ) THEN - FileMsg = 'FAST-JX (RD_AOD): Opening' - ELSE - FileMsg = 'FAST-JX (RD_AOD): REQUIRED FILE NOT FOUND' - ENDIF - - ! Write to stdout for both regular and dry-run simulations - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 300 ) TRIM( FileMsg ), TRIM( ThisFile ) -300 FORMAT( a, ' ', a ) - ENDIF - - ! For dry-run simulations, cycle to next file. - ! For regular simulations, throw an error if we can't find the file. - IF ( Input_Opt%DryRun ) THEN - CYCLE - ELSE - IF ( .not. FileExists ) THEN - WRITE( ErrMsg, 300 ) TRIM( FileMsg ), TRIM( ThisFile ) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - ENDIF - - !-------------------------------------------------------------- - ! If not a dry-run, read data from each species file - !-------------------------------------------------------------- - -#if defined( MODEL_CESM ) - ! Only read file on root thread if using CESM - IF ( Input_Opt%amIRoot ) THEN -#endif - - ! Open file - OPEN( NJ1, FILE=TRIM( THISFILE ), STATUS='OLD', IOSTAT=RC ) - - ! Error check - IF ( RC /= 0 ) THEN - ErrMsg = 'Error opening file: ' // TRIM( ThisFile ) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ! Read header lines - READ( NJ1, '(A)' ) TITLE0 - IF ( Input_Opt%amIRoot ) WRITE( 6, '(1X,A)' ) TITLE0 - - ! Second header line added for more info - READ( NJ1, '(A)' ) TITLE0 - IF ( Input_Opt%amIRoot ) WRITE( 6, '(1X,A)' ) TITLE0 - - READ( NJ1, '(A)' ) TITLE0 -110 FORMAT( 3x, a20 ) - - DO i = 1, NRAA - DO j = 1, NWVAA - - READ(NJ1,*) WVAA(j,k),RHAA(i,k),NRLAA(j,i,k),NCMAA(j,i,k), & - RDAA(i,k),RWAA(i,k),SGAA(i,k),QQAA(j,i,k), & - ALPHAA(j,i,k),REAA(i,k),SSAA(j,i,k), & - ASYMAA(j,i,k),(PHAA(j,i,k,n),n=1,8) - - ! make note of where 1000nm is for FAST-J calcs - IF (WVAA(j,k).EQ.1000.0) IWV1000=J - - ENDDO - ENDDO - - ! Close file - CLOSE( NJ1 ) - -#if defined( MODEL_CESM ) - ENDIF -#endif - - ENDDO - -#if defined( MODEL_CESM ) && defined( SPMD ) - CALL MPIBCAST( WVAA, Size(WVAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( RHAA, Size(RHAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( NRLAA, Size(NRLAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( NCMAA, Size(NCMAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( RDAA, Size(RDAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( RWAA, Size(RWAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( SGAA, Size(SGAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( QQAA, Size(QQAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( ALPHAA, Size(ALPHAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( REAA, Size(REAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( SSAA, Size(SSAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( ASYMAA, Size(ASYMAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( PHAA, Size(PHAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( IWV1000, 1, MPIINT, 0, MPICOM ) -#endif - -! ewl: this and subroutine calc_aod moved to fast_jx_interface_mod.F90 -! !================================================================= -! ! Only do the following if we are not running in dry-run mode -! !================================================================= -! IF ( .not. Input_Opt%DryRun ) THEN -! -! IF ( Input_Opt%amIRoot ) THEN -! WRITE( 6, * ) 'Optics read for all wavelengths successfully' -! ENDIF -! -! ! Now calculate the required wavelengths in the LUT to calculate -! ! the requested AOD -! CALL CALC_AOD( Input_Opt ) -! ENDIF - - END SUBROUTINE RD_AOD -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: calc_aod -! -! !DESCRIPTION: Subroutine CALC\_AOD works out the closest tie points -! in the optics LUT wavelengths and the coefficients required to -! calculate the angstrom exponent for interpolating optics to the requested -! wavelength. If the wavelength requested matches a standard wavelength -! in the LUT then we skip the interpolation (DAR 09/2013) -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE CALC_AOD( Input_Opt ) -! -! !USES: -! - USE CMN_Phot_Mod, ONLY : NWVAA, NWVAA0, WVAA - USE CMN_Phot_Mod, ONLY : IWVSELECT - USE CMN_Phot_Mod, ONLY : IRTWVSELECT - USE CMN_Phot_Mod, ONLY : ACOEF_WV, BCOEF_WV, CCOEF_WV - USE CMN_Phot_Mod, ONLY : ACOEF_RTWV, BCOEF_RTWV, CCOEF_RTWV - USE CMN_Phot_Mod, ONLY : NWVREQUIRED, IWVREQUIRED - USE CMN_Phot_Mod, ONLY : NRTWVREQUIRED, IRTWVREQUIRED - USE Input_Opt_Mod, ONLY : OptInput -#ifdef RRTMG - USE PARRRTM, ONLY : NBNDLW -#endif -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt -! -! !REMARKS: -! Now the user is able to select any 3 wavelengths for optics -! output in the geoschem_config.yml file we need to be able to interpolate -! to those wavelengths based on what is available in the optics -! look-up table. -! . -! The standard lookup table currently has values for -! 11 common wavelengths followed by 30 that are required by RRTMG. -! Only those required to interpolate to user requested -! wavelengths are selected from the standard wavelengths. RRTMG -! wavelengths are not used in the interpolation for AOD output -! (DAR 10/2013) -! . -! UPDATE: because the RT optics output doesnt have access to the -! standard wavelengths we now calculate two sets of values: one -! for the ND21 and diag3 outputs that use the standard wavelengths -! and one for RRTMG diagnostics that interpolate the optics from RRTMG -! wavelengths. Perhaps a switch needs adding to switch off the RT -! optics output (and interpolation) if this ends up costing too -! much and is not used, but it is ideal to have an optics output -! that matches exactly what RRTMG uses to calculate the fluxes -! -! !REVISION HISTORY: -! 18 Jun 2013 - D. Ridley - Initial version -! 14 Dec 2022 - E. Lundgren - Copied from GEOS-Chem fast_jx_mod -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC +! !IROUTINE: set_prof_cloudj ! -! !LOCAL VARIABLES -! - INTEGER :: MINWV, MAXWV, N, N0, N1, W, NSTEP - REAL(fp) :: WVDIF - - !================================================================ - ! CALC_AOD begins here! - !================================================================ - - !cycle over standard wavelengths - N0=1 - N1=NWVAA0 - NSTEP=1 - NWVREQUIRED=0 - DO W=1,Input_Opt%NWVSELECT - MINWV = -999 - MAXWV = 999 - DO N=N0,N1,NSTEP - WVDIF = WVAA(N,1)-Input_Opt%WVSELECT(W) - IF ((WVDIF.LE.0).AND.(WVDIF.GT.MINWV)) THEN - MINWV = WVDIF - IWVSELECT(1,W)=N - ENDIF - IF ((WVDIF.GE.0).AND.(WVDIF.LT.MAXWV)) THEN - MAXWV = WVDIF - IWVSELECT(2,W)=N - ENDIF - ENDDO - IF (IWVSELECT(2,W).EQ.IWVSELECT(1,W)) THEN - !we have a match! - MINWV=0 - MAXWV=0 - !add this wavelength to those for output - NWVREQUIRED=NWVREQUIRED+1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) - ELSE - !we are going to have to interpolate to the requested wavelength - NWVREQUIRED=NWVREQUIRED+1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) - NWVREQUIRED=NWVREQUIRED+1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(2,W) - ENDIF - - !Error check - ensure we have a match or requested wavelength - !falls within two LUT tie points - IF (MINWV.EQ.-999) THEN - ! requested wavelength is shorter than min wv in LUT - ! set to min - write(6,*) 'ERROR requested wavelength is too short!!' - write(6,*) 'Defaulting to LUT min: ',WVAA(1,1) - IWVSELECT(1,W)=1 - IWVSELECT(2,W)=1 !300nm - NWVREQUIRED=NWVREQUIRED-1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) - ENDIF - IF (MAXWV.EQ.999) THEN - ! requested wavelength is longer than min wv in LUT - ! set to max - write(6,*) 'ERROR requested wavelength is too long!!' - write(6,*) 'Defaulting to LUT min: ',WVAA(NWVAA0,1) - IWVSELECT(1,W)=NWVAA0 - IWVSELECT(2,W)=NWVAA0 !1020nm - NWVREQUIRED=NWVREQUIRED-1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) - ENDIF - - !now calcualte the angstrom exponent coefs for interpolation - - !this is done here to save time and repetition in aerosol_mod.F - IF (IWVSELECT(1,W).NE.IWVSELECT(2,W)) THEN - ACOEF_WV(W) = WVAA(IWVSELECT(2,W),1)/Input_Opt%WVSELECT(W) - BCOEF_WV(W) =1.0d0/(LOG(WVAA(IWVSELECT(2,W),1)/ & - WVAA(IWVSELECT(1,W),1))) - !relative location of selected wavelength between tie points - !for interpolating SSA and ASYM for output in aerosol_mod.F and - !dust_mod.F - CCOEF_WV(W) =(Input_Opt%WVSELECT(W)-WVAA(IWVSELECT(1,W),1))/ & - (WVAA(IWVSELECT(2,W),1)-WVAA(IWVSELECT(1,W),1)) - ENDIF - IF ( Input_Opt%amIRoot ) THEN - write(6,*) 'N WAVELENGTHS: ',Input_Opt%NWVSELECT - write(6,*) 'WAVELENGTH REQUESTED:',Input_Opt%WVSELECT(W) - write(6,*) 'WAVELENGTH REQUIRED:', NWVREQUIRED - !write(6,*) IWVSELECT(1,W),WVAA(IWVSELECT(1,W),1) - !write(6,*) IWVSELECT(2,W),WVAA(IWVSELECT(2,W),1) - !write(6,*) ACOEF_WV(W),BCOEF_WV(W),CCOEF_WV(W) - write(6,*) '*********************************' - ENDIF - ENDDO !Input_Opt%NWVSELECT -#ifdef RRTMG - !repeat for RRTMG wavelengths to get the closest wavelength - !indices and the interpolation coefficients - !Indices are relative to all wavelengths in the LUT i.e. the RRTMG - !wavelengths start at NWVAA0+1 - N0=NWVAA0+1 - N1=NWVAA - NSTEP=1 - NRTWVREQUIRED=0 - DO W=1,Input_Opt%NWVSELECT - MINWV = -999 - MAXWV = 999 - DO N=N0,N1,NSTEP - WVDIF = WVAA(N,1)-Input_Opt%WVSELECT(W) - IF ((WVDIF.LE.0).AND.(WVDIF.GT.MINWV)) THEN - MINWV = WVDIF - IRTWVSELECT(1,W)=N - ENDIF - IF ((WVDIF.GE.0).AND.(WVDIF.LT.MAXWV)) THEN - MAXWV = WVDIF - IRTWVSELECT(2,W)=N - ENDIF - ENDDO - IF (IRTWVSELECT(2,W).EQ.IRTWVSELECT(1,W)) THEN - !we have a match! - MINWV=0 - MAXWV=0 - !add this wavelength to those for output - NRTWVREQUIRED=NRTWVREQUIRED+1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) - ELSE - !we are going to have to interpolate to the requested - !wavelength - NRTWVREQUIRED=NRTWVREQUIRED+1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) - NRTWVREQUIRED=NRTWVREQUIRED+1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(2,W) - ENDIF - - !Error check - ensure we have a match or requested wavelength - !falls within two LUT tie points - IF (MINWV.EQ.-999) THEN - ! requested wavelength is shorter than min wv in LUT - ! set to min - write(6,*) 'ERROR requested wavelength is too short!!' - write(6,*) 'Defaulting to LUT min: ',WVAA(NWVAA-1,1) - IRTWVSELECT(1,W)=NWVAA-1 - IRTWVSELECT(2,W)=NWVAA-1 - NRTWVREQUIRED=NRTWVREQUIRED-1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) - ENDIF - IF (MAXWV.EQ.999) THEN - ! requested wavelength is longer than min wv in LUT - ! set to max - write(6,*) 'ERROR requested wavelength is too long!!' - write(6,*) 'Defaulting to LUT min: ',WVAA(NWVAA0+1,1) - IRTWVSELECT(1,W)=NWVAA0+1 - IRTWVSELECT(2,W)=NWVAA0+1 - NRTWVREQUIRED=NRTWVREQUIRED-1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) - ENDIF - - !now calcualte the angstrom exponent coefs for interpolation - - !this is done here to save time and repetition in aerosol_mod.F - IF (IRTWVSELECT(1,W).NE.IRTWVSELECT(2,W)) THEN - ACOEF_RTWV(W) = WVAA(IRTWVSELECT(2,W),1)/Input_Opt%WVSELECT(W) - BCOEF_RTWV(W) =1.0d0/(LOG(WVAA(IRTWVSELECT(2,W),1)/ & - WVAA(IRTWVSELECT(1,W),1))) - !relative location of selected wavelength between tie points - !for interpolating SSA and ASYM for output in aerosol_mod.F and - !dust_mod.F - CCOEF_RTWV(W) =(Input_Opt%WVSELECT(W)-WVAA(IRTWVSELECT(1,W),1))/ & - (WVAA(IRTWVSELECT(2,W),1)-WVAA(IRTWVSELECT(1,W),1)) - ENDIF - !convert wavelength index to that required by rrtmg_rad_transfer - !i.e. without the standard and LW wavelengths - IRTWVSELECT(1,W) = IRTWVSELECT(1,W) - NWVAA0 - NBNDLW - IRTWVSELECT(2,W) = IRTWVSELECT(2,W) - NWVAA0 - NBNDLW - IF ( Input_Opt%amIRoot ) THEN - write(6,*) 'N RT WAVELENGTHS: ',Input_Opt%NWVSELECT - write(6,*) 'RT WAVELENGTH REQUESTED:',Input_Opt%WVSELECT(W) - write(6,*) 'RT WAVELENGTH REQUIRED:', NRTWVREQUIRED - write(6,*) IRTWVSELECT(1,W),WVAA(IRTWVSELECT(1,W)+NWVAA0+NBNDLW,1) - write(6,*) IRTWVSELECT(2,W),WVAA(IRTWVSELECT(2,W)+NWVAA0+NBNDLW,1) - write(6,*) ACOEF_WV(W),BCOEF_WV(W),CCOEF_WV(W) - write(6,*) '*********************************' - ENDIF - ENDDO !Input_Opt%NWVSELECT -#endif - END SUBROUTINE CALC_AOD -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: rd_prof_nc -! -! !DESCRIPTION: Subroutine RAD\_PROF\_NC reads in the reference climatology -! from a NetCDF file rather than an ASCII .dat. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE RD_PROF_NC( Input_Opt, RC ) -! -! !USES: -! - USE CMN_Phot_Mod, ONLY : OREF, TREF - USE ErrCode_Mod - USE Input_Opt_Mod, ONLY : OptInput - -#if defined( MODEL_CESM ) - USE CAM_PIO_UTILS, ONLY : CAM_PIO_OPENFILE - USE IOFILEMOD, ONLY : GETFIL - USE PIO, ONLY : PIO_CLOSEFILE - USE PIO, ONLY : PIO_INQ_DIMID - USE PIO, ONLY : PIO_INQ_DIMLEN - USE PIO, ONLY : PIO_INQ_VARID - USE PIO, ONLY : PIO_GET_VAR - USE PIO, ONLY : PIO_NOERR - USE PIO, ONLY : PIO_NOWRITE - USE PIO, ONLY : FILE_DESC_T -#else - USE m_netcdf_io_open - USE m_netcdf_io_read - USE m_netcdf_io_readattr - USE m_netcdf_io_close -#endif -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Success or failure? -! -! !REMARKS: -! This file was automatically generated by the Perl scripts in the -! NcdfUtilities package (which ships w/ GEOS-Chem) and was subsequently -! hand-edited. -! -! !REVISION HISTORY: -! 19 Apr 2012 - R. Yantosca - Initial version -! 14 Dec 2022 - E. Lundgren - Copied from GEOS-Chem fast_jx_mod -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - ! Scalars - LOGICAL :: FileExists ! Does input file exist? - INTEGER :: fId ! netCDF file ID - - ! Strings - CHARACTER(LEN=255) :: nc_dir ! netCDF directory name - CHARACTER(LEN=255) :: nc_file ! netCDF file name - CHARACTER(LEN=255) :: nc_path ! netCDF path name - CHARACTER(LEN=255) :: v_name ! netCDF variable name - CHARACTER(LEN=255) :: a_name ! netCDF attribute name - CHARACTER(LEN=255) :: a_val ! netCDF attribute value - CHARACTER(LEN=255) :: FileMsg - CHARACTER(LEN=255) :: ErrMsg - CHARACTER(LEN=255) :: ThisLoc - - ! Arrays - INTEGER :: st3d(3), ct3d(3) ! For 3D arrays - -#if defined( MODEL_CESM ) - type(FILE_DESC_T) :: ncid - INTEGER :: vId, iret -#endif - - !================================================================= - ! RD_PROF_NC begins here! - !================================================================= - - ! Initialize - ! Assume success - RC = GC_SUCCESS - ErrMsg = '' - ThisLoc = ' -> at RD_PROF_NC (in module GeosCore/cldj_interface_mod.F90)' - - ! Directory and file names - nc_dir = TRIM( Input_Opt%CHEM_INPUTS_DIR ) // 'FastJ_201204/' - nc_file = 'fastj.jv_atms_dat.nc' - nc_path = TRIM( nc_dir ) // TRIM( nc_file ) - - !================================================================= - ! In dry-run mode, print file path to dryrun log and exit. - ! Otherwise, print file path to stdout and continue. - !================================================================= - - ! Test if the file exists - INQUIRE( FILE=TRIM( nc_path ), EXIST=FileExists ) - - ! Test if the file exists and define an output string - IF ( FileExists ) THEN - FileMsg = 'FAST-JX (RD_PROF_NC): Opening' - ELSE - FileMsg = 'FAST-JX (RD_PROF_NC): REQUIRED FILE NOT FOUND' - ENDIF - - ! Write to stdout for both regular and dry-run simulations - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 300 ) TRIM( FileMsg ), TRIM( nc_path ) -300 FORMAT( a, ' ', a ) - ENDIF - - ! For dry-run simulations, return to calling program. - ! For regular simulations, throw an error if we can't find the file. - IF ( Input_Opt%DryRun ) THEN - RETURN - ELSE - IF ( .not. FileExists ) THEN - WRITE( ErrMsg, 300 ) TRIM( FileMsg ), TRIM( nc_path ) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - ENDIF - - !========================================================================= - ! Open and read data from the netCDF file - !========================================================================= - - ! Open netCDF file -#if defined( MODEL_CESM ) - CALL CAM_PIO_OPENFILE( ncid, TRIM(nc_path), PIO_NOWRITE ) -#else - CALL Ncop_Rd( fId, TRIM(nc_path) ) -#endif - - ! Echo info to stdout - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 100 ) REPEAT( '%', 79 ) - WRITE( 6, 110 ) TRIM(nc_file) - WRITE( 6, 120 ) TRIM(nc_dir) - ENDIF - - !---------------------------------------- - ! VARIABLE: T - !---------------------------------------- - - ! Variable name - v_name = "T" - - ! Read T from file - st3d = (/ 1, 1, 1 /) - ct3d = (/ 51, 18, 12 /) -#if defined( MODEL_CESM ) - iret = PIO_INQ_VARID( ncid, trim(v_name), vid ) - iret = PIO_GET_VAR( ncid, vid, TREF ) -#else - CALL NcRd( TREF, fId, TRIM(v_name), st3d, ct3d ) - - ! Read the T:units attribute - a_name = "units" - CALL NcGet_Var_Attributes( fId,TRIM(v_name),TRIM(a_name),a_val ) - - ! Echo info to stdout - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 130 ) TRIM(v_name), TRIM(a_val) - ENDIF -#endif - - !---------------------------------------- - ! VARIABLE: O3 - !---------------------------------------- - - ! Variable name - v_name = "O3" - - ! Read O3 from file - st3d = (/ 1, 1, 1 /) - ct3d = (/ 51, 18, 12 /) -#if defined( MODEL_CESM ) - iret = PIO_INQ_VARID( ncid, trim(v_name), vid ) - iret = PIO_GET_VAR( ncid, vid, OREF ) -#else - CALL NcRd( OREF, fId, TRIM(v_name), st3d, ct3d ) - - ! Read the O3:units attribute - a_name = "units" - CALL NcGet_Var_Attributes( fId,TRIM(v_name),TRIM(a_name),a_val ) - - ! Echo info to stdout - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 130 ) TRIM(v_name), TRIM(a_val) - ENDIF -#endif - - !================================================================= - ! Cleanup and quit - !================================================================= - - ! Close netCDF file -#if defined( MODEL_CESM ) - CALL PIO_CLOSEFILE( ncid ) -#else - CALL NcCl( fId ) -#endif - - ! Echo info to stdout - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 140 ) - WRITE( 6, 100 ) REPEAT( '%', 79 ) - ENDIF - - ! FORMAT statements -100 FORMAT( a ) -110 FORMAT( '%% Opening file : ', a ) -120 FORMAT( '%% in directory : ', a, / , '%%' ) -130 FORMAT( '%% Successfully read ', a, ' [', a, ']' ) -140 FORMAT( '%% Successfully closed file!' ) - - END SUBROUTINE RD_PROF_NC -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: set_prof -! -! !DESCRIPTION: Subroutine SET\_PROF sets vertical profiles for a given +! !DESCRIPTION: Subroutine SET\_PROF\_CLOUDJ sets vertical profiles for a given ! latitude and longitude. !\\ !\\ ! !INTERFACE: ! - SUBROUTINE SET_PROF( YLAT, MONTH, DAY, T_CTM, P_CTM, & + SUBROUTINE SET_PROF_CLOUDJ( YLAT, MONTH, DAY, T_CTM, P_CTM, & CLDOD, DSTOD, AEROD, O3_CTM, O3_TOMS, & AERCOL, T_CLIM, O3_CLIM, Z_CLIM, AIR_CLIM, & - Input_Opt, State_Grid ) + Input_Opt, State_Grid, State_Chm ) ! ! !USES: ! USE Cldj_Cmn_Mod, ONLY : L_, L1_, A_, ZZHT - USE CMN_Phot_Mod, ONLY : OREF, TREF USE CMN_SIZE_Mod, ONLY : NAER, NRH, NDUST USE Input_Opt_Mod, ONLY : OptInput USE PhysConstants, ONLY : AIRMW, AVO, g0, BOLTZ USE State_Grid_Mod, ONLY : GrdState + USE State_Chm_Mod, ONLY : ChmState ! ! !INPUT PARAMETERS: ! @@ -2155,6 +889,7 @@ SUBROUTINE SET_PROF( YLAT, MONTH, DAY, T_CTM, P_CTM, & REAL(fp), INTENT(IN) :: O3_CTM(L1_) ! CTM ozone (molec/cm3) TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object ! ! !OUTPUT VARIABLES: ! @@ -2238,8 +973,8 @@ SUBROUTINE SET_PROF( YLAT, MONTH, DAY, T_CTM, P_CTM, & ! Temporary arrays for climatology data DO I = 1, 51 - OREF2(I) = OREF(I,L,M) - TREF2(I) = TREF(I,L,M) + OREF2(I) = State_Chm%Phot%OREF(I,L,M) + TREF2(I) = State_Chm%Phot%TREF(I,L,M) ENDDO ! Apportion O3 and T on supplied climatology z* levels onto CTM levels @@ -2403,139 +1138,7 @@ SUBROUTINE SET_PROF( YLAT, MONTH, DAY, T_CTM, P_CTM, & ENDDO - END SUBROUTINE SET_PROF -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: set_aer -! -! !DESCRIPTION: Subroutine SET\_AER fills out the array MIEDX. -! Each entry connects a GEOS-Chem aerosol to its Fast-JX counterpart: -! MIEDX(Fast-JX index) = (GC index) -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE SET_AER( Input_Opt ) -! -! !USES: -! - USE Cldj_Cmn_Mod, ONLY : AN_, NAA, TITLAA - USE CMN_Phot_Mod, ONLY : MIEDX - USE CMN_SIZE_Mod, ONLY : NRHAER, NRH - USE Input_Opt_Mod, ONLY : OptInput -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options -! -! !REVISION HISTORY: -! 31 Mar 2013 - S. D. Eastham - Adapted from J. Mao FJX v6.2 implementation -! 14 Dec 2022 - E. Lundgren - Copied from GEOS-Chem fast_jx_mod -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - INTEGER :: I, J, K - INTEGER :: IND(NRHAER) - - !================================================================= - ! SER_AER begins here! - !================================================================= - - ! Taken from aerosol_mod.F - IND = (/22,29,36,43,50/) - - DO I=1,AN_ - MIEDX(I) = 0 - ENDDO - - ! Select Aerosol/Cloud types to be used - define types here - ! Each of these types must be listed in the order used by OPMIE.F - - ! Clouds - MIEDX(1) = 3 ! Black carbon absorber - MIEDX(2) = 10 ! Water Cloud (Deirmenjian 8 micron) - MIEDX(3) = 14 ! Irregular Ice Cloud (Mishchenko) - - ! Dust - MIEDX(4) = 15 ! Mineral Dust .15 micron (rvm, 9/30/00) - MIEDX(5) = 16 ! Mineral Dust .25 micron (rvm, 9/30/00) - MIEDX(6) = 17 ! Mineral Dust .4 micron (rvm, 9/30/00) - MIEDX(7) = 18 ! Mineral Dust .8 micron (rvm, 9/30/00) - MIEDX(8) = 19 ! Mineral Dust 1.5 micron (rvm, 9/30/00) - MIEDX(9) = 20 ! Mineral Dust 2.5 micron (rvm, 9/30/00) - MIEDX(10) = 21 ! Mineral Dust 4.0 micron (rvm, 9/30/00) - - ! Aerosols - DO I=1,NRHAER - DO J=1,NRH - MIEDX(10+((I-1)*NRH)+J)=IND(I)+J-1 - ENDDO - ENDDO - - ! Stratospheric aerosols - SSA/STS and solid PSCs - MIEDX(10+(NRHAER*NRH)+1) = 4 ! SSA/LBS/STS - MIEDX(10+(NRHAER*NRH)+2) = 14 ! NAT/ice PSCs - - ! Ensure all 'AN_' types are valid selections - do i=1,AN_ - IF (Input_Opt%amIRoot) write(6,1000) MIEDX(i),TITLAA(MIEDX(i)) - if (MIEDX(i).gt.NAA.or.MIEDX(i).le.0) then - if (Input_Opt%amIRoot) then - write(6,1200) MIEDX(i),NAA - endif - CALL GC_EXITC('Bad MIEDX value.') - endif - enddo - -1000 format('Using Aerosol type: ',i3,1x,a) -1200 format('Aerosol type ',i3,' unsuitable; supplied values must be ', & - 'between 1 and ',i3) - - END SUBROUTINE SET_AER -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: gc_exitc -! -! !DESCRIPTION: Subroutine GC_EXITC forces an error in GEOS-Chem and quits. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE GC_EXITC (T_EXIT) -! -! !USES: -! - USE ERROR_MOD, ONLY : ERROR_STOP -! -! !INPUT PARAMETERS: -! - CHARACTER(LEN=*), INTENT(IN) :: T_EXIT -! -! !REVISION HISTORY: -! 28 Mar 2013 - S. D. Eastham - Copied from Fast-JX v7.0 -! 14 Dec 2022 - E. Lundgren - Copied from GEOS-Chem fast_jx_mod -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - CALL ERROR_STOP( T_EXIT, 'cldj_interface_mod.F90' ) - - END SUBROUTINE GC_EXITC + END SUBROUTINE SET_PROF_CloudJ !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! diff --git a/GeosCore/cleanup.F90 b/GeosCore/cleanup.F90 index 2c8cee4cc..17e0938da 100644 --- a/GeosCore/cleanup.F90 +++ b/GeosCore/cleanup.F90 @@ -19,7 +19,6 @@ SUBROUTINE CLEANUP( Input_Opt, State_Grid, ERROR, RC ) USE CARBON_MOD, ONLY : CLEANUP_CARBON USE Carbon_Gases_Mod, ONLY : Cleanup_Carbon_Gases USE CO2_MOD, ONLY : CLEANUP_CO2 - USE CMN_Phot_Mod, ONLY : Cleanup_CMN_Phot USE DEPO_MERCURY_MOD, ONLY : CLEANUP_DEPO_MERCURY USE DRYDEP_MOD, ONLY : CLEANUP_DRYDEP USE DUST_MOD, ONLY : CLEANUP_DUST @@ -183,13 +182,6 @@ SUBROUTINE CLEANUP( Input_Opt, State_Grid, ERROR, RC ) RETURN ENDIF - CALL Cleanup_CMN_Phot( RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_CMN_Phot"!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - CALL CLEANUP_MERCURY() CALL CLEANUP_OCEAN_MERCURY() CALL CLEANUP_DEPO_MERCURY() diff --git a/GeosCore/dust_mod.F90 b/GeosCore/dust_mod.F90 index b1a7efd98..a720c88e3 100644 --- a/GeosCore/dust_mod.F90 +++ b/GeosCore/dust_mod.F90 @@ -1193,12 +1193,8 @@ SUBROUTINE RDUST_ONLINE( Input_Opt, State_Chm, State_Diag, State_Grid, & ! ! !USES: ! - USE CMN_Phot_MOD, ONLY : NWVAART, NWVREQUIRED, QQAA, RDAA, SSAA, ASYMAA - USE CMN_Phot_MOD, ONLY : IWV1000, NWVAA0, ODMDUST, IWVSELECT - USE CMN_Phot_MOD, ONLY : ACOEF_WV, BCOEF_WV - USE CMN_Phot_MOD, ONLY : IWVREQUIRED, NDUST + USE CMN_Size_MOD, ONLY : NDUST #ifdef RRTMG - USE CMN_Phot_MOD, ONLY : RTODAER, RTSSAER, RTASYMAER USE CMN_Size_MOD, ONLY : NAER #endif USE ErrCode_Mod @@ -1248,7 +1244,23 @@ SUBROUTINE RDUST_ONLINE( Input_Opt, State_Chm, State_Diag, State_Grid, & REAL(fp) :: tempOD(State_Grid%NX,State_Grid%NY, & State_Grid%NZ,NDUST, 3) - ! Pointers + ! Pointers to State_Chm%Phot + INTEGER, POINTER :: IWVREQUIRED(:) + INTEGER, POINTER :: IWVSELECT (:,:) + REAL*8, POINTER :: ACOEF_WV (:) + REAL*8, POINTER :: BCOEF_WV (:) + REAL*8, POINTER :: RDAA (:,:) + REAL*8, POINTER :: QQAA (:,:,:) + REAL*8, POINTER :: SSAA (:,:,:) + REAL*8, POINTER :: ASYMAA (:,:,:) + REAL(fp), POINTER :: ODMDUST (:,:,:,:,:) +#ifdef RRTMG + REAL*8, POINTER :: RTODAER (:,:,:,:,:) + REAL*8, POINTER :: RTSSAER (:,:,:,:,:) + REAL*8, POINTER :: RTASYMAER(:,:,:,:,:) +#endif + + ! Other pointers REAL(fp), POINTER :: ERADIUS(:,:,:,:) REAL(fp), POINTER :: TAREA(:,:,:,:) REAL(fp), POINTER :: WERADIUS(:,:,:,:) @@ -1263,6 +1275,23 @@ SUBROUTINE RDUST_ONLINE( Input_Opt, State_Chm, State_Diag, State_Grid, & RC = GC_SUCCESS ! Initialize pointers + + IWVREQUIRED => State_Chm%Phot%IWVREQUIRED ! WL indexes for interpolation + IWVSELECT => State_Chm%Phot%IWVSELECT ! Indexes of requested WLs + ACOEF_WV => State_Chm%Phot%ACOEF_WV ! Coeffs for WL interpolation + BCOEF_WV => State_Chm%Phot%BCOEF_WV ! Coeffs for WL interpolation + RDAA => State_Chm%Phot%RDAA + QQAA => State_Chm%Phot%QQAA + SSAA => State_Chm%Phot%SSAA + ASYMAA => State_Chm%Phot%ASYMAA + ODMDUST => State_Chm%Phot%ODMDUST +#ifdef RRTMG + RTODAER => State_Chm%Phot%RTODAER ! Optical dust + RTSSAER => State_Chm%Phot%RTSSAER + RTASYMAER => State_Chm%Phot%RTASYMAER +#endif + + ERADIUS => State_Chm%AeroRadi ! Aerosol Radius [cm] TAREA => State_Chm%AeroArea ! Aerosol Area [cm2/cm3] WERADIUS => State_Chm%WetAeroRadi ! Wet Aerosol Radius [cm] @@ -1313,9 +1342,9 @@ SUBROUTINE RDUST_ONLINE( Input_Opt, State_Chm, State_Diag, State_Grid, & ELSE IF ( Input_Opt%LRAD ) THEN !Loop over all RT wavelengths (30) ! plus any required for calculating the AOD - NWVS = NWVAART+NWVREQUIRED + NWVS = State_Chm%Phot%NWVAART + State_Chm%Phot%NWVREQUIRED ELSE !Loop over wavelengths needed (from RD_AOD) - NWVS = NWVREQUIRED + NWVS = State_Chm%Phot%NWVREQUIRED ENDIF ENDIF @@ -1326,20 +1355,20 @@ SUBROUTINE RDUST_ONLINE( Input_Opt, State_Chm, State_Diag, State_Grid, & IF (ODSWITCH .EQ. 0) THEN ! only doing for 1000nm i.e. IWV=10 in LUT ! N.B. NWVS is fixed to 1 above - only one wavelength - IWV=IWV1000 + IWV=State_Chm%Phot%IWV1000 ELSE IF ( Input_Opt%LRAD ) THEN ! RRTMG wavelengths begin after NWVAA0 standard wavelengths ! but add on any others required - IF (IIWV.LE.NWVAART) THEN + IF (IIWV.LE.State_Chm%Phot%NWVAART) THEN !index of RRTMG wavelengths starts after the standard NWVAA0 - !(currently NWVAA0=11, set in CMN_Phot_mod based on the .dat - !LUT) - IWV = IIWV+NWVAA0 + !(currently NWVAA0=11, hard-coded in phot_container_mod based + !on the .dat LUT) + IWV = IIWV + State_Chm%Phot%NWVAA0 ELSE !now we calculate at wvs for the requested AOD !offset index by NWVAART i.e. start from 1 - IWV = IWVREQUIRED(IIWV-NWVAART) + IWV = IWVREQUIRED(IIWV-State_Chm%Phot%NWVAART) ENDIF ELSE ! IWVREQUIRED lists the index of requires standard wavelengths @@ -1537,6 +1566,20 @@ SUBROUTINE RDUST_ONLINE( Input_Opt, State_Chm, State_Diag, State_Grid, & ENDIF ! Free pointers + IWVREQUIRED => NULL() + IWVSELECT => NULL() + ACOEF_WV => NULL() + BCOEF_WV => NULL() + RDAA => NULL() + QQAA => NULL() + SSAA => NULL() + ASYMAA => NULL() + ODMDUST => NULL() +#ifdef RRTMG + RTODAER => NULL() + RTSSAER => NULL() + RTASYMAER => NULL() +#endif ERADIUS => NULL() TAREA => NULL() WERADIUS => NULL() diff --git a/GeosCore/fjx_interface_mod.F90 b/GeosCore/fjx_interface_mod.F90 index 1b8db7567..a3f61e5e2 100644 --- a/GeosCore/fjx_interface_mod.F90 +++ b/GeosCore/fjx_interface_mod.F90 @@ -30,18 +30,13 @@ MODULE FJX_INTERFACE_MOD ! ! !PUBLIC MEMBER FUNCTIONS: ! - PUBLIC :: INIT_FJX - PUBLIC :: FAST_JX - PUBLIC :: PHOTRATE_ADJ + PUBLIC :: Init_FastJX + PUBLIC :: Run_FASTJX ! ! !PRIVATE MEMBER FUNCTIONS: ! - PRIVATE :: GC_EXITC - PRIVATE :: RD_PROF_NC - PRIVATE :: RD_AOD - PRIVATE :: CALC_AOD - PRIVATE :: SET_PROF - PRIVATE :: SET_AER + PRIVATE :: RD_PROF_NC ! NC-read version of what is in cloud-j + PRIVATE :: SET_PROF_FJX ! could consolidate in photolysis_mod perhaps ! ! !REVISION HISTORY: ! See https://github.com/geoschem/geos-chem for complete history @@ -56,28 +51,24 @@ MODULE FJX_INTERFACE_MOD !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: int_fjx +! !IROUTINE: init_fastjx ! -! !DESCRIPTION: Subroutine INIT\_FJX initializes Fast-JX variables. +! !DESCRIPTION: Subroutine Init\_FastJX initializes Fast-JX variables. !\\ !\\ ! !INTERFACE: ! - SUBROUTINE INIT_FJX( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) + SUBROUTINE Init_FastJX( Input_Opt, State_Diag, State_Grid, State_Chm, RC ) ! ! !USES: ! - USE Charpak_Mod, ONLY : CSTRIP +! USE Charpak_Mod, ONLY : CSTRIP USE CMN_FastJX_Mod, ONLY : JVN_, NJX, NRATJ, W_, WL USE CMN_FastJX_Mod, ONLY : TITLEJX, JLABEL, RNAMES, JFACTA - ! ewl debugging - USE CMN_FastJX_Mod, ONLY : BRANCH, JIND - - USE CMN_Phot_Mod, ONLY : GC_Photo_ID, UVXFACTOR + USE CMN_FastJX_Mod, ONLY : BRANCH, JIND ! ewl debugging USE ErrCode_Mod USE Input_Opt_Mod, ONLY : OptInput USE inquireMod, ONLY : findFreeLUN - USE PhysConstants, ONLY : UVXPlanck, UVXCConst USE State_Chm_Mod, ONLY : ChmState USE State_Chm_Mod, ONLY : Ind_ USE State_Diag_Mod, ONLY : DgnState @@ -89,14 +80,17 @@ SUBROUTINE INIT_FJX( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object - TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object - TYPE(DgnState), INTENT(IN) :: State_Diag ! Diagnostics State object - TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object + TYPE(DgnState), INTENT(IN) :: State_Diag ! Diagnostics State object + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object ! ! !OUTPUT PARAMETERS: ! - INTEGER, INTENT(OUT) :: RC ! Success or failure? + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 28 Mar 2013 - S. D. Eastham - Copied from Fast-JX v7.0 @@ -109,25 +103,23 @@ SUBROUTINE INIT_FJX( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) ! ! Scalars LOGICAL :: notDryRun - INTEGER :: JXUNIT, J, NJXX, PhotoId, K - REAL(fp) :: ND64MULT + INTEGER :: JXUNIT, J, NJXX, K ! Strings CHARACTER(LEN=6) :: TITLEJXX(JVN_) - CHARACTER(LEN=50 ) :: TEXT CHARACTER(LEN=255) :: DATA_DIR CHARACTER(LEN=255) :: FILENAME CHARACTER(LEN=255) :: ErrMsg, ThisLoc !================================================================= - ! INIT_FJX begins here! + ! Init_FastJX begins here! !================================================================= ! Initialize - RC = GC_SUCCESS - notDryRun = ( .not. Input_Opt%DryRun ) - ErrMsg = '' - ThisLoc = ' -> at Init_FJX (in module GeosCore/fjx_interface_mod.F90)' + RC = GC_SUCCESS + notDryRun = ( .not. Input_Opt%DryRun ) + ErrMsg = '' + ThisLoc = ' -> at Init_FastJX (in module GeosCore/fjx_interface_mod.F90)' ! Skip these opterations when running in dry-run mode IF ( notDryRun ) THEN @@ -137,7 +129,7 @@ SUBROUTINE INIT_FJX( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) write(6,*) ' Initializing Fast-JX v7.0 standalone CTM code.' if (W_.ne.8 .and. W_.ne.12 .and. W_.ne.18) then - ErrMsg = ' INIT_FJX: invalid no. wavelengths' + ErrMsg = 'Invalid number of wavelengths (W_)' CALL GC_Error( ErrMsg, RC, ThisLoc ) RETURN endif @@ -175,19 +167,6 @@ SUBROUTINE INIT_FJX( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) RETURN ENDIF - ! Compute factors for UV flux diagnostics - IF ( notDryRun ) THEN - IF ( State_Diag%Archive_UVFluxNet .or. & - State_Diag%Archive_UVFluxDirect .or. & - State_Diag%Archive_UVFluxDiffuse ) THEN - UVXFACTOR = 0e+0_fp - ND64MULT = UVXPLANCK*UVXCCONST*1.0e+13_fp - DO J = 1, W_ - UVXFACTOR(J) = ND64MULT/WL(J) - ENDDO - ENDIF - ENDIF - !===================================================================== ! Read in 5-wavelength scattering data ! (or just print file name if in dry-run mode) @@ -205,43 +184,11 @@ SUBROUTINE INIT_FJX( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) RETURN ENDIF - !===================================================================== - ! Read in AOD data - ! (or just print file name if in dry-run mode) - !===================================================================== - CALL RD_AOD( JXUNIT, Input_Opt, RC ) - -!!ewl: took this out of RD_AOD - ! Only do the following if we are not running in dry-run mode - IF ( .not. Input_Opt%DryRun ) THEN - - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, * ) 'Optics read for all wavelengths successfully' - ENDIF - - ! Now calculate the required wavelengths in the LUT to calculate - ! the requested AOD - CALL CALC_AOD( Input_Opt ) - ENDIF -!!ewl - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in FAST-JX routine "RD_AOD"!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ! Set up MIEDX array to interpret between GC and FJX aerosol indexing - IF ( notDryRun ) THEN - CALL SET_AER( Input_Opt ) - ENDIF - !===================================================================== ! Read in T & O3 climatology used to fill e.g. upper layers ! or if O3 not calc. !===================================================================== - CALL RD_PROF_NC( Input_Opt, RC ) + CALL RD_PROF_NC( Input_Opt, State_Chm, RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN @@ -268,348 +215,49 @@ SUBROUTINE INIT_FJX( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) CALL RD_JS_JX( Input_Opt%amIRoot, Input_Opt%DryRun, JXUNIT, & TRIM( FILENAME ), TITLEJXX, NJXX, RC ) - ! Store # of photolysis reactions in state_chm - State_Chm%Photol%NRatJ = NRatJ - -! ewl: bring out of RD_JS_JX - !======================================================================== - ! Flag special reactions that will be later adjusted by - ! routine PHOTRATE_ADJ (called from FlexChem) - !======================================================================== - - IF ( Input_Opt%ITS_A_FULLCHEM_SIM ) THEN - ! Loop over all photolysis reactions - DO K = 1, NRATJ - - ! Strip all blanks from the reactants and products list - TEXT = JLABEL(K) - CALL CSTRIP( TEXT ) - - !IF ( Input_Opt%amIRoot ) THEN - ! WRITE(*,*) K, TRIM( TEXT ) - !ENDIF - - ! Look for certain reactions - SELECT CASE( TRIM( TEXT ) ) - CASE( 'O2PHOTONOO' ) - State_Chm%Photol%RXN_O2 = K ! O2 + hv -> O + O - CASE( 'O3PHOTONO2O' ) - State_Chm%Photol%RXN_O3_1 = K ! O3 + hv -> O2 + O - CASE( 'O3PHOTONO2O(1D)' ) - State_Chm%Photol%RXN_O3_2 = K ! O3 + hv -> O2 + O(1D) - CASE( 'SO4PHOTONSO2OHOH' ) - State_Chm%Photol%RXN_H2SO4 = K ! SO4 + hv -> SO2 + OH + OH - CASE( 'NO2PHOTONNOO' ) - State_Chm%Photol%RXN_NO2 = K ! NO2 + hv -> NO + O - CASE( 'NOPHOTONNO' ) - State_Chm%Photol%RXN_NO = K ! NO + hv -> N + O - CASE( 'NO3PHOTONNO2O' ) - State_Chm%Photol%RXN_NO3 = K ! NO3 + hv -> NO2 + O - CASE( 'N2OPHOTONN2O' ) - State_Chm%Photol%RXN_N2O = K ! N2O + hv -> N2 + O - CASE( 'NITsPHOTONHNO2' ) - State_Chm%Photol%RXN_JNITSa = K ! NITs + hv -> HNO2 - CASE( 'NITsPHOTONNO2' ) - State_Chm%Photol%RXN_JNITSb = K ! NITs + hv -> NO2 - CASE( 'NITPHOTONHNO2' ) - State_Chm%Photol%RXN_JNITa = K ! NIT + hv -> HNO2 - CASE( 'NITPHOTONNO2' ) - State_Chm%Photol%RXN_JNITb = K ! NIT + hv -> NO2 - CASE( 'HNO3PHOTONNO2OH' ) - State_Chm%Photol%RXN_JHNO3 = K ! HNO3 + hv = OH + NO2 - CASE DEFAULT - ! Nothing - END SELECT - ENDDO - - !--------------------------------------------------------------------- - ! Error check the various rxn flags - !--------------------------------------------------------------------- - IF ( State_Chm%Photol%RXN_O2 < 0 ) THEN - ErrMsg = 'Could not find rxn O2 + hv -> O + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_O3_1 < 0 ) THEN - ErrMsg = 'Could not find rxn O3 + hv -> O2 + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_O3_2 < 0 ) THEN - ErrMsg = 'Could not find rxn O3 + hv -> O2 + O(1D)' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - ENDIF - - IF ( State_Chm%Photol%RXN_NO2 < 0 ) THEN - ErrMsg = 'Could not find rxn NO2 + hv -> NO + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_NO2 < 0 ) THEN - ErrMsg = 'Could not find rxn NO2 + hv -> NO + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_JNITSa < 0 ) THEN - ErrMsg = 'Could not find rxn NITS + hv -> HNO2' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_JNITSb < 0 ) THEN - ErrMsg = 'Could not find rxn NITS + hv -> NO2' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_JNITa < 0 ) THEN - ErrMsg = 'Could not find rxn NIT + hv -> HNO2' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_JNITb < 0 ) THEN - ErrMsg = 'Could not find rxn NIT + hv -> NO2' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_H2SO4 < 0 ) THEN - ErrMsg = 'Could not find rxn SO4 + hv -> SO2 + OH + OH!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_NO3 < 0 ) THEN - ErrMsg = 'Could not find rxn NO3 + hv -> NO2 + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_NO < 0 ) THEN - ErrMsg = 'Could not find rxn NO + hv -> O + N' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_N2O < 0 ) THEN - ErrMsg = 'Could not find rxn N2O + hv -> N2 + O(1D)' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - !--------------------------------------------------------------------- - ! Print out saved rxn flags for fullchem simulations - !--------------------------------------------------------------------- - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 100 ) REPEAT( '=', 79 ) - WRITE( 6, 110 ) - WRITE( 6, 120 ) State_Chm%Photol%RXN_O2 - WRITE( 6, 130 ) State_Chm%Photol%RXN_O3_1 - WRITE( 6, 140 ) State_Chm%Photol%RXN_O3_2 - WRITE( 6, 180 ) State_Chm%Photol%RXN_JNITSa - WRITE( 6, 190 ) State_Chm%Photol%RXN_JNITSb - WRITE( 6, 200 ) State_Chm%Photol%RXN_JNITa - WRITE( 6, 210 ) State_Chm%Photol%RXN_JNITb - WRITE( 6, 160 ) State_Chm%Photol%RXN_H2SO4 - WRITE( 6, 170 ) State_Chm%Photol%RXN_NO2 - WRITE( 6, 100 ) REPEAT( '=', 79 ) - ENDIF - ENDIF - - !======================================================================== - ! Flag reactions for diagnostics (only in Hg chem) - !======================================================================== - IF ( Input_Opt%ITS_A_MERCURY_SIM ) THEN - ! Loop over all photolysis reactions - DO K = 1, NRATJ - - ! Strip all blanks from the reactants and products list - TEXT = JLABEL(K) - CALL CSTRIP( TEXT ) - - ! Look for certain reactions - SELECT CASE( TRIM( TEXT ) ) - CASE( 'O3PHOTONO2O' ) - State_Chm%Photol%RXN_O3_1 = K ! O3 + hv -> O2 + O - CASE( 'O3PHOTONO2O(1D)' ) - State_Chm%Photol%RXN_O3_2 = K ! O3 + hv -> O2 + O(1D) - CASE( 'NO2PHOTONNOO' ) - State_Chm%Photol%RXN_NO2 = K ! NO2 + hv -> NO + O - CASE( 'BrOPHOTONBrO' ) - State_Chm%Photol%RXN_BrO = K ! BrO + hv -> Br + O - CASE( 'ClOPHOTONClO' ) - State_Chm%Photol%RXN_ClO = K ! ClO + hv -> Cl + O - CASE DEFAULT - ! Nothing - END SELECT - ENDDO - - !-------------------------------------------------------------------- - ! Error check the various rxn flags - !-------------------------------------------------------------------- - IF ( State_Chm%Photol%RXN_O3_1 < 0 ) THEN - ErrMsg = 'Could not find rxn O3 + hv -> O2 + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_O3_2 < 0 ) THEN - ErrMsg = 'Could not find rxn O3 + hv -> O2 + O(1D) #1' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_NO2 < 0 ) THEN - ErrMsg = 'Could not find rxn NO2 + hv -> NO + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_BrO < 0 ) THEN - ErrMsg = 'Could not find rxn BrO + hv -> Br + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - IF ( State_Chm%Photol%RXN_ClO < 0 ) THEN - ErrMsg = 'Could not find rxn ClO + hv -> Cl + O' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - !--------------------------------------------------------------------- - ! Print out saved rxn flags for Hg simulation - !--------------------------------------------------------------------- - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 100 ) REPEAT( '=', 79 ) - WRITE( 6, 110 ) - WRITE( 6, 130 ) State_Chm%Photol%RXN_O3_1 - WRITE( 6, 140 ) State_Chm%Photol%RXN_O3_2 - WRITE( 6, 170 ) State_Chm%Photol%RXN_NO2 - WRITE( 6, 220 ) State_Chm%Photol%RXN_BrO - WRITE( 6, 230 ) State_Chm%Photol%RXN_ClO - WRITE( 6, 100 ) REPEAT( '=', 79 ) - ENDIF - ENDIF - - ! FORMAT statements -100 FORMAT( a ) -110 FORMAT( 'Photo rxn flags saved for use in PHOTRATE_ADJ:', / ) -120 FORMAT( 'RXN_O2 [ O2 + hv -> O + O ] = ', i5 ) -130 FORMAT( 'RXN_O3_1 [ O3 + hv -> O2 + O ] = ', i5 ) -140 FORMAT( 'RXN_O3_2a [ O3 + hv -> O2 + O(1D) #1 ] = ', i5 ) -150 FORMAT( 'RXN_O3_2b [ O3 + hv -> O2 + O(1D) #2 ] = ', i5 ) -160 FORMAT( 'RXN_H2SO4 [ SO4 + hv -> SO2 + OH + OH ] = ', i5 ) -170 FORMAT( 'RXN_NO2 [ NO2 + hv -> NO + O ] = ', i5 ) -180 FORMAT( 'RXN_JNITSa [ NITS + hv -> HNO2 ] = ', i5 ) -190 FORMAT( 'RXN_JNITSb [ NITS + hv -> NO2 ] = ', i5 ) -200 FORMAT( 'RXN_JNITa [ NIT + hv -> HNO2 ] = ', i5 ) -210 FORMAT( 'RXN_JNITb [ NIT + hv -> NO2 ] = ', i5 ) -220 FORMAT( 'RXN_BrO [ BrO + hv -> Br + O ] = ', i5 ) -230 FORMAT( 'RXN_ClO [ ClO + hv -> Cl + O ] = ', i5 ) - -!ewl end - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Rd_Js_Jx"!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ! Skip further processing if we are in dry-run mode - IF ( notDryRun ) THEN - - ! Get the GEOS-Chem photolysis index for each of the 1...JVN_ entries - ! in the FJX_j2j.dat file. We'll use this for the diagnostics. - DO J = 1, JVN_ - - IF ( J == State_Chm%Photol%Rxn_O3_2 ) THEN - - !------------------------------------------------------------ - ! O3 + hv = O + O(1D) - ! - ! Save this as JO3_O1D in the nPhotol+1 slot - !------------------------------------------------------------ - GC_Photo_Id(J) = State_Chm%nPhotol + 1 - - ELSE IF ( J == State_Chm%Photol%Rxn_O3_1 ) THEN - - !------------------------------------------------------------ - ! O3 + hv -> O + O - ! - ! Save this as JO3_O3P in the nPhotol+2 slot - !------------------------------------------------------------- - GC_Photo_Id(J) = State_Chm%nPhotol + 2 - - ELSE - - !------------------------------------------------------------ - ! Everything else - ! - ! Find the matching GEOS-Chem photolysis species number - !------------------------------------------------------------ - GC_Photo_Id(J) = Ind_( RNAMES(J), 'P' ) - - ENDIF - - ! Print the mapping - IF ( Input_Opt%amIRoot ) THEN - IF ( GC_Photo_Id(J) > 0 ) THEN - WRITE(6, 240) RNAMES(J), J, GC_Photo_Id(J), JFACTA(J) -240 FORMAT( a10, ':', i7, 2x, i7, 2x, f7.4 ) - ENDIF - ENDIF - ENDDO + ! Store # of photolysis reactions in state_chm for easy reference + State_Chm%Phot%nPhotRxns = NRatJ #if defined( MODEL_CESM ) - IF ( Input_Opt%amIRoot ) THEN - CALL freeUnit(JXUnit) - ENDIF + IF ( notDryRun .AND. Input_Opt%amIRoot ) THEN + CALL freeUnit(JXUnit) + ENDIF #endif - ENDIF +! +! ! ewl debugging +! print *, " " +! print *, "In Init_FastJX" +! print *, "ewl: NRATJ: ", NRATJ +! print *, "ewl: JLABEL(1): ", JLABEL(1) +! print *, "ewl: RNAMES(1): ", RNAMES(1) +! print *, "ewl: JIND(1): ", JIND(1) +! print *, "ewl: JFACTA(1): ", JFACTA(1) +! print *, "ewl: BRANCH(1): ", BRANCH(1) - ! ewl debugging - print *, " " - print *, "In Init_FJX" - print *, "ewl: NRATJ: ", NRATJ - print *, "ewl: JLABEL(1): ", JLABEL(1) - print *, "ewl: RNAMES(1): ", RNAMES(1) - print *, "ewl: JIND(1): ", JIND(1) - print *, "ewl: JFACTA(1): ", JFACTA(1) - print *, "ewl: BRANCH(1): ", BRANCH(1) - - END SUBROUTINE INIT_FJX + END SUBROUTINE Init_FastJX !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! !------------------------------------------------------------------------------ !BOP ! -! !ROUTINE: fast_jx +! !ROUTINE: run_fastjx ! -! !DESCRIPTION: Subroutine FAST\_JX loops over longitude and latitude, and +! !DESCRIPTION: Subroutine RUN|_FASTJX loops over longitude and latitude, and ! calls PHOTO\_JX to compute J-Values for each column at every chemistry ! time-step. !\\ !\\ ! !INTERFACE: ! - SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & - State_Grid, State_Met, RC ) + SUBROUTINE Run_FastJX( WLAOD, Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, RC ) ! ! !USES: ! USE CMN_FastJX_Mod, ONLY : A_, L_, L1_, W_, JVN_, JXL_, JXL1_ USE CMN_FastJX_Mod, ONLY : NRATJ, JIND, JFACTA, FL - USE CMN_Phot_Mod, ONLY : ZPJ, IRHARR, UVXFACTOR, IWV1000 - USE CMN_Phot_Mod, ONLY : ODAER, ODMDUST USE CMN_SIZE_MOD, ONLY : NDUST, NRH, NAER USE ErrCode_Mod USE ERROR_MOD, ONLY : ERROR_STOP, ALLOC_ERR @@ -726,16 +374,30 @@ SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & REAL(fp) :: UVX_CONST INTEGER :: S, K + ! Pointers + INTEGER, POINTER :: IRHARR (:,:,:) + REAL(fp), POINTER :: UVXFACTOR(:) + REAL(fp), POINTER :: ZPJ (:,:,:,:) + REAL(fp), POINTER :: ODAER (:,:,:,:,:) + REAL(fp), POINTER :: ODMDUST (:,:,:,:,:) + !================================================================= - ! FAST_JX begins here! + ! Run_FastJX begins here! !================================================================= ! Initialize RC = GC_SUCCESS ErrMsg = '' - ThisLoc = ' -> at Fast_JX (in module GeosCore/fjx_interface_mod.F90)' + ThisLoc = ' -> at Run_FastJX (in module GeosCore/fjx_interface_mod.F90)' prtDebug = Input_Opt%Verbose + ! Set pointers + ZPJ => State_Chm%Phot%ZPJ + IRHARR => State_Chm%Phot%IRHARR + UVXFACTOR => State_Chm%Phot%UVXFACTOR + ODAER => State_Chm%Phot%ODAER + ODMDUST => State_Chm%Phot%ODMDUST + ! Get day of year (0-365 or 0-366) DAY_OF_YR = GET_DAY_OF_YEAR() @@ -804,6 +466,7 @@ SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & !$OMP PRIVATE( SZA, SOLF, ODCLOUD_COL ) & !$OMP PRIVATE( AERX_COL, T_CLIM, O3_CLIM, Z_CLIM, AIR_CLIM ) & !$OMP PRIVATE( VALJXX, FSBOT, FJBOT, FLXD, FJFLX ) & + !$OMP PRIVATE( FDIRECT, FDIFFUSE, UVX_CONST, K, S ) & !$OMP SCHEDULE( DYNAMIC ) ! Loop over latitudes and longitudes @@ -853,18 +516,18 @@ SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & DO N = 1, NAER DO L = 1, State_Grid%NZ IOPT = ( (N-1) * NRH ) + IRHARR(NLON,NLAT,L) - OPTAER(L,IOPT) = ODAER(NLON,NLAT,L,IWV1000,N) + OPTAER(L,IOPT) = ODAER(NLON,NLAT,L,State_Chm%Phot%IWV1000,N) ENDDO ENDDO DO N = 1, NDUST DO L = 1, State_Grid%NZ - OPTDUST(L,N) = ODMDUST(NLON,NLAT,L,IWV1000,N) + OPTDUST(L,N) = ODMDUST(NLON,NLAT,L,State_Chm%Phot%IWV1000,N) ENDDO ENDDO ! Mineral dust OD profile [unitless] at (NLON,NLAT) ! and at 1000nm, IWV1000 (DAR) - !OPTDUST = ODMDUST(NLON,NLAT,:,IWV1000,:) + !OPTDUST = ODMDUST(NLON,NLAT,:,State_Chm%Phot%IWV1000,:) ! Cloud OD profile [unitless] at (NLON,NLAT) OPTD = State_Met%OPTD(NLON,NLAT,1:State_Grid%NZ) @@ -888,7 +551,8 @@ SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & #endif if (State_Grid%NZ+1 .gt. JXL1_) then - call GC_EXITC(' PHOTO_JX: not enough levels in JX') + ErrMsg = ' PHOTO_JX: not enough levels in JX' + call Error_Stop( ErrMsg, ThisLoc ) endif ! Input conversion (SDE 03/29/13) @@ -899,7 +563,6 @@ SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & ! 99.0 80 km if (SZA .gt. 98.e+0_fp) cycle -! ewl: better to put these options in geoschem_config.yml? #if defined( USE_LINEAR_OVERLAP ) !=========================================================== ! %%%% CLOUD OVERLAP: LINEAR ASSUMPTION %%%% @@ -955,12 +618,12 @@ SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & ! Path density (DDJ) [# molec/cm2] ! New methodology for: ! Ozone density (OOJ) [# O3 molec/cm2] - CALL SET_PROF (YLAT, MONTH, DAY, & - T_CTM, P_CTM, OPTD, & - OPTDUST, OPTAER, O3_CTM, & - O3_TOMS, AERX_COL, T_CLIM, & - O3_CLIM, Z_CLIM, AIR_CLIM, & - Input_Opt, State_Grid ) + CALL SET_PROF_FJX (YLAT, MONTH, DAY, & + T_CTM, P_CTM, OPTD, & + OPTDUST, OPTAER, O3_CTM, & + O3_TOMS, AERX_COL, T_CLIM, & + O3_CLIM, Z_CLIM, AIR_CLIM, & + Input_Opt, State_Grid, State_Chm ) ! Call FAST-JX routines to compute J-values CALL PHOTO_JX( Input_Opt%amIRoot, Input_Opt%DryRun, & @@ -968,8 +631,8 @@ SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & P_CTM, T_CTM, AOD999, NLON, & NLAT, AERX_COL, T_CLIM, O3_CLIM, & Z_CLIM, AIR_CLIM, State_Grid%maxChemLev, & - VALJXX, FSBOT, FJBOT, FLXD, & - FJFLX ) + State_Chm, VALJXX, FSBOT, FJBOT, & + FLXD, FJFLX ) ! Fill out common-block array of J-rates using PHOTO_JX output DO L=1,State_Grid%MaxChemLev @@ -1004,6 +667,9 @@ SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & ! 3 - Diffuse flux ! Convention: negative is downwards !================================================================= + + ! TODO TODO TODO - there seems to be a parallelization error here + IF ( State_Diag%Archive_UVFluxDiffuse .or. & State_Diag%Archive_UVFluxDirect .or. & State_Diag%Archive_UVFluxNet ) THEN @@ -1066,630 +732,14 @@ SUBROUTINE FAST_JX( WLAOD, Input_Opt, State_Chm, State_Diag, & ! Reset first-time flag FIRST=.FALSE. - END SUBROUTINE FAST_JX -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: photrate_adj -! -! !DESCRIPTION: Subroutine PHOTRATE\_ADJ adjusts certain photolysis rates -! for chemistry. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE PHOTRATE_ADJ( Input_Opt, State_Chm, State_Diag, State_Met, & - I, J, L, & - FRAC, RC ) -! -! !USES: -! - USE CMN_Phot_Mod, ONLY : ZPJ - USE ErrCode_Mod - USE Input_Opt_Mod, ONLY : OptInput - USE State_Chm_Mod, ONLY : ChmState - USE State_Diag_Mod, ONLY : DgnState - USE State_Met_Mod, ONLY : MetState -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input_Options object - TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object - TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object - INTEGER, INTENT(IN) :: I, J, L ! Lon, lat, lev indices - REAL(fp), INTENT(IN) :: FRAC ! Result of SO4_PHOTFRAC, - ! called from DO_FLEXCHEM -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(DgnState), INTENT(INOUT) :: State_Diag ! Diagnostics State object -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Success or failure -! -! !REMARKS: -! NOTE: The netCDF diagnostics are attached in DO_FLEXCHEM so that we have -! access to the adjusted rates. Only the bpch diagnostics are updated -! here. -! -- Bob Yantosca, 19 Dec 2017 -! -! %%%% NOTE: WE SHOULD UPDATE THE COMMENTS TO MAKE SURE THAT WE DO %%%% -! %%%% NOT KEEP ANY CONFLICTING OR INCORRECT INFORMATION (bmy, 3/28/16) %%%% -! -! !REVISION HISTORY: -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - INTEGER :: RXN_JNITSa, RXN_JNITSb, RXN_JNITa, RXN_JNITb - INTEGER :: RXN_JHNO3, RXN_H2SO4, RXN_O3_1, RXN_O3_2 - REAL(fp) :: JscaleNITs, JscaleNIT, JNITChanA, JNITChanB - REAL(fp) :: C_O2, C_N2, C_H2, ITEMPK, RO1DplH2O - REAL(fp) :: RO1DplH2, RO1D, NUMDEN, TEMP, C_H2O - - - !================================================================= - ! PHOTRATE_ADJ begins here! - !================================================================= - - ! Initialize - RC = GC_SUCCESS - TEMP = State_Met%T(I,J,L) ! K - NUMDEN = State_Met%AIRNUMDEN(I,J,L) ! molec/cm3 - C_H2O = State_Met%AVGW(I,J,L) * State_Met%AIRNUMDEN(I,J,L) ! molec/cm3 - RXN_JNITSa = State_Chm%Photol%RXN_JNITSa - RXN_JNITSb = State_Chm%Photol%RXN_JNITSb - RXN_JNITa = State_Chm%Photol%RXN_JNITa - RXN_JNITb = State_Chm%Photol%RXN_JNITb - RXN_JHNO3 = State_Chm%Photol%RXN_JHNO3 - RXN_H2SO4 = State_Chm%Photol%RXN_H2SO4 - RXN_O3_1 = State_Chm%Photol%RXN_O3_1 - RXN_O3_2 = State_Chm%Photol%RXN_O3_2 - - ! For all mechanisms. Set the photolysis rate of NITs and NIT to a - ! scaled value of JHNO3. NOTE: this is set in geoschem_config.yml - IF ( Input_Opt%hvAerNIT ) THEN - - ! Get the photolysis scalars read in from geoschem_config.yml - JscaleNITs = Input_Opt%hvAerNIT_JNITs - JscaleNIT = Input_Opt%hvAerNIT_JNIT - ! convert reaction channel % to a fraction - JNITChanA = Input_Opt%JNITChanA - JNITChanB = Input_Opt%JNITChanB - JNITChanA = JNITChanA / 100.0_fp - JNITChanB = JNITChanB / 100.0_fp - ! Set the photolysis rate of NITs - ZPJ(L,RXN_JNITSa,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNITs - ZPJ(L,RXN_JNITSb,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNITs - ! Set the photolysis rate of NIT - ZPJ(L,RXN_JNITa,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNIT - ZPJ(L,RXN_JNITb,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNIT - ! Adjust to scaling for channels set in geoschem_config.yml - ! NOTE: channel scaling is 1 in FJX_j2j.dat, then updated here - ZPJ(L,RXN_JNITSa,I,J) = ZPJ(L,RXN_JNITSa,I,J) * JNITChanA - ZPJ(L,RXN_JNITa,I,J) = ZPJ(L,RXN_JNITa,I,J) * JNITChanA - ZPJ(L,RXN_JNITSb,I,J) = ZPJ(L,RXN_JNITSb,I,J) * JNITChanB - ZPJ(L,RXN_JNITb,I,J) = ZPJ(L,RXN_JNITb,I,J) * JNITChanB - - ! Gotcha to set JNIT and JNITs to zero if hvAerNIT switch is off - ELSE - - ! Set the photolysis rate of NITs to zero - ZPJ(L,RXN_JNITSa,I,J) = 0.0_fp - ZPJ(L,RXN_JNITSb,I,J) = 0.0_fp - ! Set the photolysis rate of NIT to zero - ZPJ(L,RXN_JNITa,I,J) = 0.0_fp - ZPJ(L,RXN_JNITb,I,J) = 0.0_fp - - ENDIF - - !============================================================== - ! SPECIAL TREATMENT FOR H2SO4+hv -> SO2 + 2OH - ! - ! Only allow photolysis of H2SO4 when gaseous (SDE 04/11/13) - !============================================================== - - ! Calculate if H2SO4 expected to be gaseous or aqueous - ! Only allow photolysis above 6 hPa - ! RXN_H2SO4 specifies SO4 + hv -> SO2 + OH + OH - ZPJ(L,RXN_H2SO4,I,J) = ZPJ(L,RXN_H2SO4,I,J) * FRAC + ! Free pointers + ZPJ => NULL() + IRHARR => NULL() + UVXFACTOR => NULL() + ODAER => NULL() + ODMDUST => NULL() - !============================================================== - ! SPECIAL TREATMENT FOR O3+hv -> O+O2 - ! - ! [O1D]ss=J[O3]/(k[H2O]+k[N2]+k[O2]) - ! SO, THE EFFECTIVE J-VALUE IS J*k[H2O]/(k[H2O]+k[N2]+k[O2]) - ! - ! We don't want to do this if strat-chem is in use, as all - ! the intermediate reactions are included - this would be - ! double-counting (SDE 04/01/13) - !============================================================== - - ! Need to subtract O3->O1D from rate - ! RXN_O3_1 specifies: O3 + hv -> O2 + O - ! RXN_O3_2 specifies: O3 + hv -> O2 + O(1D) - ZPJ(L,RXN_O3_1,I,J) = ZPJ(L,RXN_O3_1,I,J) & - - ZPJ(L,RXN_O3_2,I,J) - - END SUBROUTINE PHOTRATE_ADJ -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: rd_aod -! -! !DESCRIPTION: Subroutine RD\_AOD reads aerosol phase functions that are -! used to scale diagnostic output to an arbitrary wavelengh. This -! facilitates comparing with satellite observations. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE RD_AOD( NJ1, Input_Opt, RC ) -! -! !USES: -! - USE CMN_Phot_Mod, ONLY : RDAA, RWAA, WVAA, NRAA, RHAA, SGAA, QQAA, REAA - USE CMN_Phot_Mod, ONLY : SSAA, ASYMAA, PHAA - USE CMN_Phot_Mod, ONLY : IWV1000, NSPAA, NWVAA, NRLAA, NCMAA, ALPHAA - USE ErrCode_Mod - USE Input_Opt_Mod, ONLY : OptInput -! -! !INPUT PARAMETERS: -! - INTEGER, INTENT(IN) :: NJ1 ! Unit # of file to open - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Success or failure? -! -! !REMARKS: -! The .dat files for each species contain the optical properties -! at multiple wavelengths to be used in the online calculation of the aerosol -! optical depth diagnostics. -! These properties have been calculated using the same size and optical -! properties as the FJX_spec.dat file used for the FAST-J photolysis -! calculations (which is now redundant for aerosols, the values in the .dat -! files here are now used). The file currently contains 11 wavelengths -! for Fast-J and other commonly used wavelengths for satellite and -! AERONET retrievals. 30 wavelengths follow that map onto RRTMG -! wavebands for radiaitive flux calculations (not used if RRTMG is off). -! A complete set of optical properties from 250-2000 nm for aerosols is -! available at: -! ftp://ftp.as.harvard.edu/geos-chem/data/aerosol_optics/hi_spectral_res -! . -! -- Colette L. Heald, 05/10/10) -! -- David A. Ridley, 05/10/13 (update for new optics files) -! -! !REVISION HISTORY: -! 10 May 2010 - C. Heald - Initial version -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES -! - ! Scalars - INTEGER :: I, J, K, N - INTEGER :: IOS - LOGICAL :: LBRC, FileExists - - ! Strings - CHARACTER(LEN=78 ) :: TITLE0 - CHARACTER(LEN=255) :: DATA_DIR - CHARACTER(LEN=255) :: THISFILE - CHARACTER(LEN=255) :: FileMsg - CHARACTER(LEN=255) :: ErrMsg - CHARACTER(LEN=255) :: ThisLoc - - ! String arrays - CHARACTER(LEN=30) :: SPECFIL(8) - - !================================================================ - ! RD_AOD begins here! - !================================================================ - - ! Initialize - RC = GC_SUCCESS - ErrMsg = '' - ThisLoc = ' -> at RD_AOD (in module GeosCore/fast_jx_mod.F90)' - LBRC = Input_Opt%LBRC - DATA_DIR = TRIM( Input_Opt%FAST_JX_DIR ) - - ! IMPORTANT: aerosol_mod.F and dust_mod.F expect aerosols in this order - ! - ! Treating strat sulfate with GADS data but modified to match - ! the old Fast-J values size (r=0.09um, sg=0.6) - I think there's - ! evidence that this is too smale and narrow e.g. Deshler et al. 2003 - ! NAT should really be associated with something like cirrus cloud - ! but for now we are just treating the NAT like the sulfate... limited - ! info but ref index is similar e.g. Scarchilli et al. (2005) - !(DAR 05/2015) - DATA SPECFIL /"so4.dat","soot.dat","org.dat", & - "ssa.dat","ssc.dat", & - "h2so4.dat","h2so4.dat", & - "dust.dat"/ - - ! Loop over the array of filenames - DO k = 1, NSPAA - - ! Choose different set of input files for standard (trop+strat chenm) - ! and tropchem (trop-only chem) simulations - THISFILE = TRIM( DATA_DIR ) // TRIM( SPECFIL(k) ) - - !-------------------------------------------------------------- - ! In dry-run mode, print file path to dryrun log and cycle. - ! Otherwise, print file path to stdout and continue. - !-------------------------------------------------------------- - - ! Test if the file exists - INQUIRE( FILE=TRIM( ThisFile ), EXIST=FileExists ) - - ! Test if the file exists and define an output string - IF ( FileExists ) THEN - FileMsg = 'FAST-JX (RD_AOD): Opening' - ELSE - FileMsg = 'FAST-JX (RD_AOD): REQUIRED FILE NOT FOUND' - ENDIF - - ! Write to stdout for both regular and dry-run simulations - IF ( Input_Opt%amIRoot ) THEN - WRITE( 6, 300 ) TRIM( FileMsg ), TRIM( ThisFile ) -300 FORMAT( a, ' ', a ) - ENDIF - - ! For dry-run simulations, cycle to next file. - ! For regular simulations, throw an error if we can't find the file. - IF ( Input_Opt%DryRun ) THEN - CYCLE - ELSE - IF ( .not. FileExists ) THEN - WRITE( ErrMsg, 300 ) TRIM( FileMsg ), TRIM( ThisFile ) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - ENDIF - - !-------------------------------------------------------------- - ! If not a dry-run, read data from each species file - !-------------------------------------------------------------- - -#if defined( MODEL_CESM ) - ! Only read file on root thread if using CESM - IF ( Input_Opt%amIRoot ) THEN -#endif - - ! Open file - OPEN( NJ1, FILE=TRIM( THISFILE ), STATUS='OLD', IOSTAT=RC ) - - ! Error check - IF ( RC /= 0 ) THEN - ErrMsg = 'Error opening file: ' // TRIM( ThisFile ) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ! Read header lines - READ( NJ1, '(A)' ) TITLE0 - IF ( Input_Opt%amIRoot ) WRITE( 6, '(1X,A)' ) TITLE0 - - ! Second header line added for more info - READ( NJ1, '(A)' ) TITLE0 - IF ( Input_Opt%amIRoot ) WRITE( 6, '(1X,A)' ) TITLE0 - - READ( NJ1, '(A)' ) TITLE0 -110 FORMAT( 3x, a20 ) - - DO i = 1, NRAA - DO j = 1, NWVAA - - READ(NJ1,*) WVAA(j,k),RHAA(i,k),NRLAA(j,i,k),NCMAA(j,i,k), & - RDAA(i,k),RWAA(i,k),SGAA(i,k),QQAA(j,i,k), & - ALPHAA(j,i,k),REAA(i,k),SSAA(j,i,k), & - ASYMAA(j,i,k),(PHAA(j,i,k,n),n=1,8) - - ! make note of where 1000nm is for FAST-J calcs - IF (WVAA(j,k).EQ.1000.0) IWV1000=J - - ENDDO - ENDDO - - ! Close file - CLOSE( NJ1 ) - -#if defined( MODEL_CESM ) - ENDIF -#endif - - ENDDO - -#if defined( MODEL_CESM ) && defined( SPMD ) - CALL MPIBCAST( WVAA, Size(WVAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( RHAA, Size(RHAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( NRLAA, Size(NRLAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( NCMAA, Size(NCMAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( RDAA, Size(RDAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( RWAA, Size(RWAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( SGAA, Size(SGAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( QQAA, Size(QQAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( ALPHAA, Size(ALPHAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( REAA, Size(REAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( SSAA, Size(SSAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( ASYMAA, Size(ASYMAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( PHAA, Size(PHAA), MPIR8, 0, MPICOM ) - CALL MPIBCAST( IWV1000, 1, MPIINT, 0, MPICOM ) -#endif - -! ewl: this and subroutine calc_aod moved to fast_jx_interface_mod.F90 -! !================================================================= -! ! Only do the following if we are not running in dry-run mode -! !================================================================= -! IF ( .not. Input_Opt%DryRun ) THEN -! -! IF ( Input_Opt%amIRoot ) THEN -! WRITE( 6, * ) 'Optics read for all wavelengths successfully' -! ENDIF -! -! ! Now calculate the required wavelengths in the LUT to calculate -! ! the requested AOD -! CALL CALC_AOD( Input_Opt ) -! ENDIF - - END SUBROUTINE RD_AOD -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: calc_aod -! -! !DESCRIPTION: Subroutine CALC\_AOD works out the closest tie points -! in the optics LUT wavelengths and the coefficients required to -! calculate the angstrom exponent for interpolating optics to the requested -! wavelength. If the wavelength requested matches a standard wavelength -! in the LUT then we skip the interpolation (DAR 09/2013) -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE CALC_AOD( Input_Opt ) -! -! !USES: -! - USE CMN_Phot_Mod, ONLY : NWVAA, NWVAA0, WVAA - USE CMN_Phot_Mod, ONLY : IWVSELECT - USE CMN_Phot_Mod, ONLY : IRTWVSELECT - USE CMN_Phot_Mod, ONLY : ACOEF_WV, BCOEF_WV, CCOEF_WV - USE CMN_Phot_Mod, ONLY : ACOEF_RTWV, BCOEF_RTWV, CCOEF_RTWV - USE CMN_Phot_Mod, ONLY : NWVREQUIRED, IWVREQUIRED - USE CMN_Phot_Mod, ONLY : NRTWVREQUIRED, IRTWVREQUIRED - USE Input_Opt_Mod, ONLY : OptInput -#ifdef RRTMG - USE PARRRTM, ONLY : NBNDLW -#endif -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt -! -! !REMARKS: -! Now the user is able to select any 3 wavelengths for optics -! output in the geoschem_config.yml file we need to be able to interpolate -! to those wavelengths based on what is available in the optics -! look-up table. -! . -! The standard lookup table currently has values for -! 11 common wavelengths followed by 30 that are required by RRTMG. -! Only those required to interpolate to user requested -! wavelengths are selected from the standard wavelengths. RRTMG -! wavelengths are not used in the interpolation for AOD output -! (DAR 10/2013) -! . -! UPDATE: because the RT optics output doesnt have access to the -! standard wavelengths we now calculate two sets of values: one -! for the ND21 and diag3 outputs that use the standard wavelengths -! and one for RRTMG diagnostics that interpolate the optics from RRTMG -! wavelengths. Perhaps a switch needs adding to switch off the RT -! optics output (and interpolation) if this ends up costing too -! much and is not used, but it is ideal to have an optics output -! that matches exactly what RRTMG uses to calculate the fluxes -! -! !REVISION HISTORY: -! 18 Jun 2013 - D. Ridley - Initial version -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES -! - INTEGER :: MINWV, MAXWV, N, N0, N1, W, NSTEP - REAL(fp) :: WVDIF - - !================================================================ - ! CALC_AOD begins here! - !================================================================ - - !cycle over standard wavelengths - N0=1 - N1=NWVAA0 - NSTEP=1 - NWVREQUIRED=0 - DO W=1,Input_Opt%NWVSELECT - MINWV = -999 - MAXWV = 999 - DO N=N0,N1,NSTEP - WVDIF = WVAA(N,1)-Input_Opt%WVSELECT(W) - IF ((WVDIF.LE.0).AND.(WVDIF.GT.MINWV)) THEN - MINWV = WVDIF - IWVSELECT(1,W)=N - ENDIF - IF ((WVDIF.GE.0).AND.(WVDIF.LT.MAXWV)) THEN - MAXWV = WVDIF - IWVSELECT(2,W)=N - ENDIF - ENDDO - IF (IWVSELECT(2,W).EQ.IWVSELECT(1,W)) THEN - !we have a match! - MINWV=0 - MAXWV=0 - !add this wavelength to those for output - NWVREQUIRED=NWVREQUIRED+1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) - ELSE - !we are going to have to interpolate to the requested wavelength - NWVREQUIRED=NWVREQUIRED+1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) - NWVREQUIRED=NWVREQUIRED+1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(2,W) - ENDIF - - !Error check - ensure we have a match or requested wavelength - !falls within two LUT tie points - IF (MINWV.EQ.-999) THEN - ! requested wavelength is shorter than min wv in LUT - ! set to min - write(6,*) 'ERROR requested wavelength is too short!!' - write(6,*) 'Defaulting to LUT min: ',WVAA(1,1) - IWVSELECT(1,W)=1 - IWVSELECT(2,W)=1 !300nm - NWVREQUIRED=NWVREQUIRED-1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) - ENDIF - IF (MAXWV.EQ.999) THEN - ! requested wavelength is longer than min wv in LUT - ! set to max - write(6,*) 'ERROR requested wavelength is too long!!' - write(6,*) 'Defaulting to LUT min: ',WVAA(NWVAA0,1) - IWVSELECT(1,W)=NWVAA0 - IWVSELECT(2,W)=NWVAA0 !1020nm - NWVREQUIRED=NWVREQUIRED-1 - IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) - ENDIF - - !now calcualte the angstrom exponent coefs for interpolation - - !this is done here to save time and repetition in aerosol_mod.F - IF (IWVSELECT(1,W).NE.IWVSELECT(2,W)) THEN - ACOEF_WV(W) = WVAA(IWVSELECT(2,W),1)/Input_Opt%WVSELECT(W) - BCOEF_WV(W) =1.0d0/(LOG(WVAA(IWVSELECT(2,W),1)/ & - WVAA(IWVSELECT(1,W),1))) - !relative location of selected wavelength between tie points - !for interpolating SSA and ASYM for output in aerosol_mod.F and - !dust_mod.F - CCOEF_WV(W) =(Input_Opt%WVSELECT(W)-WVAA(IWVSELECT(1,W),1))/ & - (WVAA(IWVSELECT(2,W),1)-WVAA(IWVSELECT(1,W),1)) - ENDIF - IF ( Input_Opt%amIRoot ) THEN - write(6,*) 'N WAVELENGTHS: ',Input_Opt%NWVSELECT - write(6,*) 'WAVELENGTH REQUESTED:',Input_Opt%WVSELECT(W) - write(6,*) 'WAVELENGTH REQUIRED:', NWVREQUIRED - !write(6,*) IWVSELECT(1,W),WVAA(IWVSELECT(1,W),1) - !write(6,*) IWVSELECT(2,W),WVAA(IWVSELECT(2,W),1) - !write(6,*) ACOEF_WV(W),BCOEF_WV(W),CCOEF_WV(W) - write(6,*) '*********************************' - ENDIF - ENDDO !Input_Opt%NWVSELECT -#ifdef RRTMG - !repeat for RRTMG wavelengths to get the closest wavelength - !indices and the interpolation coefficients - !Indices are relative to all wavelengths in the LUT i.e. the RRTMG - !wavelengths start at NWVAA0+1 - N0=NWVAA0+1 - N1=NWVAA - NSTEP=1 - NRTWVREQUIRED=0 - DO W=1,Input_Opt%NWVSELECT - MINWV = -999 - MAXWV = 999 - DO N=N0,N1,NSTEP - WVDIF = WVAA(N,1)-Input_Opt%WVSELECT(W) - IF ((WVDIF.LE.0).AND.(WVDIF.GT.MINWV)) THEN - MINWV = WVDIF - IRTWVSELECT(1,W)=N - ENDIF - IF ((WVDIF.GE.0).AND.(WVDIF.LT.MAXWV)) THEN - MAXWV = WVDIF - IRTWVSELECT(2,W)=N - ENDIF - ENDDO - IF (IRTWVSELECT(2,W).EQ.IRTWVSELECT(1,W)) THEN - !we have a match! - MINWV=0 - MAXWV=0 - !add this wavelength to those for output - NRTWVREQUIRED=NRTWVREQUIRED+1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) - ELSE - !we are going to have to interpolate to the requested - !wavelength - NRTWVREQUIRED=NRTWVREQUIRED+1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) - NRTWVREQUIRED=NRTWVREQUIRED+1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(2,W) - ENDIF - - !Error check - ensure we have a match or requested wavelength - !falls within two LUT tie points - IF (MINWV.EQ.-999) THEN - ! requested wavelength is shorter than min wv in LUT - ! set to min - write(6,*) 'ERROR requested wavelength is too short!!' - write(6,*) 'Defaulting to LUT min: ',WVAA(NWVAA-1,1) - IRTWVSELECT(1,W)=NWVAA-1 - IRTWVSELECT(2,W)=NWVAA-1 - NRTWVREQUIRED=NRTWVREQUIRED-1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) - ENDIF - IF (MAXWV.EQ.999) THEN - ! requested wavelength is longer than min wv in LUT - ! set to max - write(6,*) 'ERROR requested wavelength is too long!!' - write(6,*) 'Defaulting to LUT min: ',WVAA(NWVAA0+1,1) - IRTWVSELECT(1,W)=NWVAA0+1 - IRTWVSELECT(2,W)=NWVAA0+1 - NRTWVREQUIRED=NRTWVREQUIRED-1 - IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) - ENDIF - - !now calcualte the angstrom exponent coefs for interpolation - - !this is done here to save time and repetition in aerosol_mod.F - IF (IRTWVSELECT(1,W).NE.IRTWVSELECT(2,W)) THEN - ACOEF_RTWV(W) = WVAA(IRTWVSELECT(2,W),1)/Input_Opt%WVSELECT(W) - BCOEF_RTWV(W) =1.0d0/(LOG(WVAA(IRTWVSELECT(2,W),1)/ & - WVAA(IRTWVSELECT(1,W),1))) - !relative location of selected wavelength between tie points - !for interpolating SSA and ASYM for output in aerosol_mod.F and - !dust_mod.F - CCOEF_RTWV(W) =(Input_Opt%WVSELECT(W)-WVAA(IRTWVSELECT(1,W),1))/ & - (WVAA(IRTWVSELECT(2,W),1)-WVAA(IRTWVSELECT(1,W),1)) - ENDIF - !convert wavelength index to that required by rrtmg_rad_transfer - !i.e. without the standard and LW wavelengths - IRTWVSELECT(1,W) = IRTWVSELECT(1,W) - NWVAA0 - NBNDLW - IRTWVSELECT(2,W) = IRTWVSELECT(2,W) - NWVAA0 - NBNDLW - IF ( Input_Opt%amIRoot ) THEN - write(6,*) 'N RT WAVELENGTHS: ',Input_Opt%NWVSELECT - write(6,*) 'RT WAVELENGTH REQUESTED:',Input_Opt%WVSELECT(W) - write(6,*) 'RT WAVELENGTH REQUIRED:', NRTWVREQUIRED - write(6,*) IRTWVSELECT(1,W),WVAA(IRTWVSELECT(1,W)+NWVAA0+NBNDLW,1) - write(6,*) IRTWVSELECT(2,W),WVAA(IRTWVSELECT(2,W)+NWVAA0+NBNDLW,1) - write(6,*) ACOEF_WV(W),BCOEF_WV(W),CCOEF_WV(W) - write(6,*) '*********************************' - ENDIF - ENDDO !Input_Opt%NWVSELECT -#endif - END SUBROUTINE CALC_AOD + END SUBROUTINE Run_FastJX !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! @@ -1704,13 +754,13 @@ END SUBROUTINE CALC_AOD !\\ ! !INTERFACE: ! - SUBROUTINE RD_PROF_NC( Input_Opt, RC ) + SUBROUTINE RD_PROF_NC( Input_Opt, State_Chm, RC ) ! ! !USES: ! - USE CMN_Phot_Mod, ONLY : OREF, TREF USE ErrCode_Mod USE Input_Opt_Mod, ONLY : OptInput + USE State_Chm_Mod, ONLY : ChmState #if defined( MODEL_CESM ) USE CAM_PIO_UTILS, ONLY : CAM_PIO_OPENFILE @@ -1732,11 +782,15 @@ SUBROUTINE RD_PROF_NC( Input_Opt, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry state object ! ! !OUTPUT PARAMETERS: ! - INTEGER, INTENT(OUT) :: RC ! Success or failure? + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REMARKS: ! This file was automatically generated by the Perl scripts in the @@ -1775,6 +829,10 @@ SUBROUTINE RD_PROF_NC( Input_Opt, RC ) INTEGER :: vId, iret #endif + ! Pointers + REAL(fp), POINTER :: OREF(:,:,:) + REAL(fp), POINTER :: TREF(:,:,:) + !================================================================= ! RD_PROF_NC begins here! !================================================================= @@ -1785,6 +843,10 @@ SUBROUTINE RD_PROF_NC( Input_Opt, RC ) ErrMsg = '' ThisLoc = ' -> at RD_PROF_NC (in module GeosCore/fjx_interface_mod.F90)' + ! Set pointers + OREF => State_Chm%Phot%OREF + TREF => State_Chm%Phot%TREF + ! Directory and file names nc_dir = TRIM( Input_Opt%CHEM_INPUTS_DIR ) // 'FastJ_201204/' nc_file = 'fastj.jv_atms_dat.nc' @@ -1910,6 +972,10 @@ SUBROUTINE RD_PROF_NC( Input_Opt, RC ) WRITE( 6, 100 ) REPEAT( '%', 79 ) ENDIF + ! Free pointers + OREF => NULL() + TREF => NULL() + ! FORMAT statements 100 FORMAT( a ) 110 FORMAT( '%% Opening file : ', a ) @@ -1924,26 +990,26 @@ END SUBROUTINE RD_PROF_NC !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: set_prof +! !IROUTINE: set_prof_fjx ! -! !DESCRIPTION: Subroutine SET\_PROF sets vertical profiles for a given +! !DESCRIPTION: Subroutine SET\_PROF\_FJX sets vertical profiles for a given ! latitude and longitude. !\\ !\\ ! !INTERFACE: ! - SUBROUTINE SET_PROF( YLAT, MONTH, DAY, T_CTM, P_CTM, & + SUBROUTINE SET_PROF_FJX( YLAT, MONTH, DAY, T_CTM, P_CTM, & CLDOD, DSTOD, AEROD, O3_CTM, O3_TOMS, & AERCOL, T_CLIM, O3_CLIM, Z_CLIM, AIR_CLIM, & - Input_Opt, State_Grid ) + Input_Opt, State_Grid, State_Chm ) ! ! !USES: ! USE CMN_FastJX_Mod, ONLY : L_, L1_, A_, ZZHT - USE CMN_Phot_Mod, ONLY : OREF, TREF USE CMN_SIZE_Mod, ONLY : NAER, NRH, NDUST USE Input_Opt_Mod, ONLY : OptInput USE PhysConstants, ONLY : AIRMW, AVO, g0, BOLTZ + USE State_Chm_Mod, ONLY : ChmState USE State_Grid_Mod, ONLY : GrdState ! ! !INPUT PARAMETERS: @@ -1960,6 +1026,7 @@ SUBROUTINE SET_PROF( YLAT, MONTH, DAY, T_CTM, P_CTM, & REAL(fp), INTENT(IN) :: O3_CTM(L1_) ! CTM ozone (molec/cm3) TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object ! ! !OUTPUT VARIABLES: ! @@ -2042,8 +1109,8 @@ SUBROUTINE SET_PROF( YLAT, MONTH, DAY, T_CTM, P_CTM, & ! Temporary arrays for climatology data DO I = 1, 51 - OREF2(I) = OREF(I,L,M) - TREF2(I) = TREF(I,L,M) + OREF2(I) = State_Chm%Phot%OREF(I,L,M) + TREF2(I) = State_Chm%Phot%TREF(I,L,M) ENDDO ! Apportion O3 and T on supplied climatology z* levels onto CTM levels @@ -2207,137 +1274,7 @@ SUBROUTINE SET_PROF( YLAT, MONTH, DAY, T_CTM, P_CTM, & ENDDO - END SUBROUTINE SET_PROF -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: set_aer -! -! !DESCRIPTION: Subroutine SET\_AER fills out the array MIEDX. -! Each entry connects a GEOS-Chem aerosol to its Fast-JX counterpart: -! MIEDX(Fast-JX index) = (GC index) -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE SET_AER( Input_Opt ) -! -! !USES: -! - USE CMN_FastJX_Mod, ONLY : AN_, NAA, TITLAA - USE CMN_Phot_Mod, ONLY : MIEDX - USE CMN_SIZE_Mod, ONLY : NRHAER, NRH - USE Input_Opt_Mod, ONLY : OptInput -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options -! -! !REVISION HISTORY: -! 31 Mar 2013 - S. D. Eastham - Adapted from J. Mao FJX v6.2 implementation -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - INTEGER :: I, J, K - INTEGER :: IND(NRHAER) - - !================================================================= - ! SER_AER begins here! - !================================================================= - - ! Taken from aerosol_mod.F - IND = (/22,29,36,43,50/) - - DO I=1,AN_ - MIEDX(I) = 0 - ENDDO - - ! Select Aerosol/Cloud types to be used - define types here - ! Each of these types must be listed in the order used by OPMIE.F - - ! Clouds - MIEDX(1) = 3 ! Black carbon absorber - MIEDX(2) = 10 ! Water Cloud (Deirmenjian 8 micron) - MIEDX(3) = 14 ! Irregular Ice Cloud (Mishchenko) - - ! Dust - MIEDX(4) = 15 ! Mineral Dust .15 micron (rvm, 9/30/00) - MIEDX(5) = 16 ! Mineral Dust .25 micron (rvm, 9/30/00) - MIEDX(6) = 17 ! Mineral Dust .4 micron (rvm, 9/30/00) - MIEDX(7) = 18 ! Mineral Dust .8 micron (rvm, 9/30/00) - MIEDX(8) = 19 ! Mineral Dust 1.5 micron (rvm, 9/30/00) - MIEDX(9) = 20 ! Mineral Dust 2.5 micron (rvm, 9/30/00) - MIEDX(10) = 21 ! Mineral Dust 4.0 micron (rvm, 9/30/00) - - ! Aerosols - DO I=1,NRHAER - DO J=1,NRH - MIEDX(10+((I-1)*NRH)+J)=IND(I)+J-1 - ENDDO - ENDDO - - ! Stratospheric aerosols - SSA/STS and solid PSCs - MIEDX(10+(NRHAER*NRH)+1) = 4 ! SSA/LBS/STS - MIEDX(10+(NRHAER*NRH)+2) = 14 ! NAT/ice PSCs - - ! Ensure all 'AN_' types are valid selections - do i=1,AN_ - IF (Input_Opt%amIRoot) write(6,1000) MIEDX(i),TITLAA(MIEDX(i)) - if (MIEDX(i).gt.NAA.or.MIEDX(i).le.0) then - if (Input_Opt%amIRoot) then - write(6,1200) MIEDX(i),NAA - endif - CALL GC_EXITC('Bad MIEDX value.') - endif - enddo - -1000 format('Using Aerosol type: ',i3,1x,a) -1200 format('Aerosol type ',i3,' unsuitable; supplied values must be ', & - 'between 1 and ',i3) - - END SUBROUTINE SET_AER -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: gc_exitc -! -! !DESCRIPTION: Subroutine GC_EXITC forces an error in GEOS-Chem and quits. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE GC_EXITC (T_EXIT) -! -! !USES: -! - USE ERROR_MOD, ONLY : ERROR_STOP -! -! !INPUT PARAMETERS: -! - CHARACTER(LEN=*), INTENT(IN) :: T_EXIT -! -! !REVISION HISTORY: -! 28 Mar 2013 - S. D. Eastham - Copied from Fast-JX v7.0 -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - CALL ERROR_STOP( T_EXIT, 'fjx_interface_mod.F90' ) - - END SUBROUTINE GC_EXITC + END SUBROUTINE SET_PROF_FJX !EOC END MODULE FJX_INTERFACE_MOD !#endif ! Always compile for now because of mercury diff --git a/GeosCore/fjx_mod.F90 b/GeosCore/fjx_mod.F90 index a3d4c2854..d6b83a975 100644 --- a/GeosCore/fjx_mod.F90 +++ b/GeosCore/fjx_mod.F90 @@ -78,17 +78,18 @@ SUBROUTINE PHOTO_JX( amIRoot, dryrun, & U0, REFLB, SZA, SOLF, & P_COL, T_COL, AOD999, ILON, & ILAT, AERX_COL, T_CLIM, OOJ, & - ZZJ, DDJ, maxChemLev, VALJXX, & - FSBOT, FJBOT, FLXD, FJFLX ) + ZZJ, DDJ, maxChemLev, State_Chm, & + VALJXX, FSBOT, FJBOT, FLXD, & + FJFLX ) ! ! !USES: ! - USE CMN_FastJX_Mod, ONLY : L_, L1_, A_, N_, W_, X_ + USE CMN_FastJX_Mod, ONLY : L_, L1_, A_, N_, W_, X_, AN_ USE CMN_FastJX_Mod, ONLY : JXL_, JXL1_, JXL2_, JVN_ USE CMN_FastJX_Mod, ONLY : QO2, QO3, NJX, FL, WL, QRAYL - USE CMN_FastJX_Mod, ONLY : LQQ, TQQ, QAA, PAA, SAA - USE CMN_Phot_Mod, ONLY : NSPAA, MIEDX, QQAA, SSAA, PHAA ! aerosols + USE CMN_FastJX_Mod, ONLY : LQQ, TQQ, QAA, PAA, SAA USE CMN_SIZE_Mod, ONLY : NRH, NRHAER + USE State_Chm_Mod, ONLY : ChmState ! For NSPAA, QQAA, SSAA, PHAA IMPLICIT NONE ! @@ -108,6 +109,7 @@ SUBROUTINE PHOTO_JX( amIRoot, dryrun, & REAL(fp), INTENT(IN), DIMENSION(L1_+1 ) :: ZZJ ! Edge alts (cm) REAL(fp), INTENT(IN), DIMENSION(L1_ ) :: DDJ INTEGER, INTENT(IN) :: maxChemLev + TYPE(ChmState), INTENT(IN) :: State_Chm ! ! !INPUT/OUTPUT PARAMETERS: ! @@ -146,6 +148,11 @@ SUBROUTINE PHOTO_JX( amIRoot, dryrun, & real(fp) :: RFLECT real(fp) :: AMF2(2*JXL1_+1,2*JXL1_+1) + ! Pointers + REAL*8, POINTER :: QQAA(:,:,:) + REAL*8, POINTER :: SSAA(:,:,:) + REAL*8, POINTER :: PHAA(:,:,:,:) + ! ---------key SCATTERING arrays for clouds+aerosols------------------ real(fp) :: OD(5,JXL1_),SSA(5,JXL1_),SLEG(8,5,JXL1_) real(fp) :: OD600(JXL1_) @@ -175,9 +182,15 @@ SUBROUTINE PHOTO_JX( amIRoot, dryrun, & ! PHOTO_JX begins here! !================================================================= + ! Initialize L2EDGE = L_ + L_ + 2 FFF(:,:) = 0.e+0_fp + ! Set pointers + QQAA => State_Chm%Phot%QQAA + SSAA => State_Chm%Phot%SSAA + PHAA => State_Chm%Phot%PHAA + ! Fill out PPJ and TTJ with CTM data to replace fixed climatology DO L=1,L1_ PPJ(L) = P_COL(L) @@ -244,7 +257,7 @@ SUBROUTINE PHOTO_JX( amIRoot, dryrun, & ! Clouds and non-species aerosols DO M=1,3 IF (AERX_COL(M,L).gt.0e+0_fp) THEN - IDXAER=MIEDX(M) + IDXAER=State_Chm%Phot%MIEDX(M) ! Cloud (600 nm scaling) QSCALING = QAA(KMIE,IDXAER)/QAA(4,IDXAER) LOCALOD = QSCALING*AERX_COL(M,L) @@ -290,7 +303,7 @@ SUBROUTINE PHOTO_JX( amIRoot, dryrun, & ! Mineral dust (from new optics LUT) DO M=4,10 IF (AERX_COL(M,L).gt.0d0) THEN - IDXAER=NSPAA !dust is last in LUT + IDXAER=State_Chm%Phot%NSPAA !dust is last in LUT IR=M-3 IF (AOD999) THEN QSCALING = QQAA(KMIE2,IR,IDXAER)/ & @@ -421,6 +434,11 @@ SUBROUTINE PHOTO_JX( amIRoot, dryrun, & ! Calculate photolysis rates call JRATET(PPJ,T_INPUT,FFF, VALJXX,L_,maxChemLev,NJX) + ! Free pointers + QQAA => NULL() + SSAA => NULL() + PHAA => NULL() + END SUBROUTINE PHOTO_JX !EOC !------------------------------------------------------------------------------ diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index 264b7d37f..fc51e98b0 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -91,15 +91,14 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! ! !USES: ! - USE CMN_Phot_Mod, ONLY : ZPJ, GC_PHOTO_ID #ifdef CLOUDJ + ! all for debugging USE Cldj_Cmn_Mod, ONLY : JLABEL, JFACTA, NRATJ, RNAMES USE Cldj_Cmn_Mod, ONLY : BRANCH, JIND, JVN_ - USE Cldj_Interface_Mod, ONLY : PHOTRATE_ADJ, Run_CloudJ #else + ! all for debugging USE CMN_FastJX_mod, ONLY : JLABEL, JFACTA, NRATJ, RNAMES USE CMN_FastJX_mod, ONLY : BRANCH, JIND, JVN_ - USE FJX_Interface_Mod, ONLY : PHOTRATE_ADJ, FAST_JX #endif USE ErrCode_Mod USE ERROR_MOD @@ -119,6 +118,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & USE GcKpp_Rates, ONLY : UPDATE_RCONST, RCONST USE GcKpp_Util, ONLY : Get_OHreactivity USE Input_Opt_Mod, ONLY : OptInput + USE Photolysis_Mod, ONLY : Do_Photolysis, PhotRate_Adj USE PhysConstants, ONLY : AVO, AIRMW USE PRESSURE_MOD USE Species_Mod, ONLY : Species @@ -173,7 +173,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & INTEGER :: I, J, L, N INTEGER :: NA, F, SpcID, KppID INTEGER :: P, MONTH, YEAR, Day - INTEGER :: WAVELENGTH, IERR, S, Thread + INTEGER :: IERR, S, Thread REAL(fp) :: SO4_FRAC, T, TIN REAL(fp) :: TOUT, SR, LWC @@ -376,17 +376,10 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! Compute J-values IF ( Input_Opt%Do_Photolysis ) THEN - WAVELENGTH = 0 -#ifdef CLOUDJ - CALL Run_CloudJ( WAVELENGTH, Input_Opt, State_Chm, State_Diag, & - State_Grid, State_Met, RC ) -#else - CALL FAST_JX( WAVELENGTH, Input_Opt, State_Chm, State_Diag, & - State_Grid, State_Met, RC ) -#endif - + CALL Do_Photolysis( Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, RC ) IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Photolysis"!' + ErrMsg = 'Error encountered in "Do_Photolysis"!' CALL GC_Error( ErrMsg, RC, ThisLoc ) RETURN ENDIF @@ -616,10 +609,10 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & I, J, L, SO4_FRAC, IERR ) ! Loop over the FAST-JX photolysis species - DO N = 1, State_Chm%Photol%nJvalMax + DO N = 1, JVN_ ! Copy photolysis rate from FAST_JX into KPP PHOTOL array - PHOTOL(N) = ZPJ(L,N,I,J) + PHOTOL(N) = State_Chm%Phot%ZPJ(L,N,I,J) !============================================================ ! HISTORY (aka netCDF diagnostics) @@ -643,12 +636,12 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! NOTE: For convenience, we have stored the GEOS-Chem ! photolysis species index (range: 1..State_Chm%nPhotol) ! for each of the FAST-JX photolysis species (range; - ! 1..nJvalMax) in the GC_PHOTO_ID array (located in module + ! 1..JVN_) in the GC_PHOTO_ID array (located in module ! CMN_Photol_mod.F90). (ewl: revisit) !============================================================ ! GC photolysis species index - P = GC_Photo_Id(N) + P = State_Chm%Phot%GC_Photo_Id(N) ! If this FAST_JX photolysis species maps to a valid ! GEOS-Chem photolysis species (for this simulation)... @@ -1522,35 +1515,34 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ENDDO !$OMP END PARALLEL DO - ! ewl debugging - do N=1,State_Chm%Photol%nJvalMax - ! GC photolysis species index - P = GC_Photo_Id(N) - print *, " " - print *, "In loop over nJvalMax: ", N, " of ", State_Chm%Photol%nJvalMax - print *, "# photolysis reactions in chemistry = NRATJ: ", NRATJ - print *, "ewl: size(zpj): ", size(zpj) - print *, "ewl: size(state_diag%jval): ", size(state_diag%jval) - print *, "ewl: JVN_: ", JVN_ - print *, "ewl: JLABEL(N): ", trim(JLABEL(N)) - print *, "ewl: RNAMES(N): ", trim(RNAMES(N)) - print *, "ewl: BRANCH(N): ", BRANCH(N) - print *, "ewl: JIND(N): ", JIND(N) - print *, "ewl: JFACTA(N): ", JFACTA(N) - print *, "ewl: P = GC_Photo_Id(N): ", P - print *, "ewl: max(zpj(L=1,N,:,:): ", maxval(zpj(1,N,:,:)) - ! If this FAST_JX photolysis species maps to a valid - ! GEOS-Chem photolysis species (for this simulation)... - IF ( P > 0 .and. P <= State_Chm%nPhotol ) THEN - print *, "ewl: P maps to a valid GEOS-Chem photolysis species" - print *, "ewl: S = State_Diag%Map_Jval%id2slot(P): ", S - S = State_Diag%Map_Jval%id2slot(P) - IF ( S > 0 ) THEN - print *, "ewl: max(jval(:,:,L=1,S): ", maxval(state_diag%jval(:,:,1,S)) - ENDIF - ENDIF - - enddo +! ! ewl debugging +! do N=1,JVN_ +! ! GC photolysis species index +! P = GC_Photo_Id(N) +! print *, " " +! print *, "In loop over JVN_: ", N, " of ", JVN_ +! print *, "# photolysis reactions in chemistry = NRATJ: ", NRATJ +! print *, "ewl: size(zpj): ", size(zpj) +! print *, "ewl: size(state_diag%jval): ", size(state_diag%jval) +! print *, "ewl: JVN_: ", JVN_ +! print *, "ewl: JLABEL(N): ", trim(JLABEL(N)) +! print *, "ewl: RNAMES(N): ", trim(RNAMES(N)) +! print *, "ewl: BRANCH(N): ", BRANCH(N) +! print *, "ewl: JIND(N): ", JIND(N) +! print *, "ewl: JFACTA(N): ", JFACTA(N) +! print *, "ewl: P = GC_Photo_Id(N): ", P +! print *, "ewl: max(zpj(L=1,N,:,:): ", maxval(zpj(1,N,:,:)) +! ! If this FAST_JX photolysis species maps to a valid +! ! GEOS-Chem photolysis species (for this simulation)... +! IF ( P > 0 .and. P <= State_Chm%nPhotol ) THEN +! print *, "ewl: P maps to a valid GEOS-Chem photolysis species" +! print *, "ewl: S = State_Diag%Map_Jval%id2slot(P): ", S +! S = State_Diag%Map_Jval%id2slot(P) +! IF ( S > 0 ) THEN +! print *, "ewl: max(jval(:,:,L=1,S): ", maxval(state_diag%jval(:,:,1,S)) +! ENDIF +! ENDIF +! enddo ! Stop timer IF ( Input_Opt%useTimers ) THEN @@ -1676,11 +1668,11 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! Set State_Chm arrays for surface J-values used in HEMCO and ! saved to restart file - IF ( State_Chm%Photol%RXN_O3_1 >= 0 ) THEN - State_Chm%JOH(:,:) = ZPJ(1,State_Chm%Photol%RXN_O3_1,:,:) + IF ( State_Chm%Phot%RXN_O3_1 >= 0 ) THEN + State_Chm%JOH(:,:) = State_Chm%Phot%ZPJ(1,State_Chm%Phot%RXN_O3_1,:,:) ENDIF - IF ( State_Chm%Photol%RXN_NO2 >= 0 ) THEN - State_Chm%JNO2(:,:) = ZPJ(1,State_Chm%Photol%RXN_NO2,:,:) + IF ( State_Chm%Phot%RXN_NO2 >= 0 ) THEN + State_Chm%JNO2(:,:) = State_Chm%Phot%ZPJ(1,State_Chm%Phot%RXN_NO2,:,:) ENDIF ! Set FIRSTCHEM = .FALSE. -- we have gone thru one chem step @@ -1706,6 +1698,13 @@ SUBROUTINE PrintFirstTimeInfo( Input_Opt, State_Chm, FirstChem ) ! USE Input_Opt_Mod, ONLY : OptInput USE State_Chm_Mod, ONLY : ChmState +#ifdef CLOUDJ + ! all for debugging + USE Cldj_Cmn_Mod +#else + ! all for debugging + USE CMN_FastJX_Mod +#endif ! ! !INPUT PARAMETERS: ! @@ -1754,6 +1753,36 @@ SUBROUTINE PrintFirstTimeInfo( Input_Opt, State_Chm, FirstChem ) #else 150 FORMAT( '* Photolysis is activated -- rates computed by FAST-JX' ) #endif + ! ewl debugging + print *, " Parameters used in photolysis:" + print *, " W_ : ", W_ + print *, " JVN_ : ", JVN_ + print *, " L_ : ", L_ + print *, " L1_ : ", L1_ + print *, " L2_ : ", L2_ + print *, " JVL_ : ", JVL_ + print *, " JXL1_ : ", JXL1_ + print *, " JXL2_ : ", JXL2_ + print *, " AN_ : ", AN_ + print *, " WX_ : ", WX_ + print *, " NAA : ", NAA + print *, " X_ : ", X_ + print *, " A_ : ", A_ + print *, " N_ : ", N_ + print *, " EMU : ", EMU + print *, " WT : ", WT + print *, " ZZHT : ", ZZHT + print *, " RAD : ", RAD + print *, " NRATJ : ", NRATJ + print *, " ATAU : ", ATAU + print *, " ATAU0 : ", ATAU0 + print *, " NW1 : ", NW1 + print *, " NW2 : ", NW2 + print *, " NJX : ", NJX +#ifdef CLOUDJ + print *, " RAA(29) : ", RAA(29) +#else + print *, " RAA(IND999,29) : ", RAA(State_Chm%Phot%IND999,29) #endif ELSE WRITE( 6, 160 ) @@ -1762,6 +1791,7 @@ SUBROUTINE PrintFirstTimeInfo( Input_Opt, State_Chm, FirstChem ) ! Write footer WRITE( 6, '(a)' ) REPEAT( '=', 79 ) + ENDIF END SUBROUTINE PrintFirstTimeInfo diff --git a/GeosCore/gc_environment_mod.F90 b/GeosCore/gc_environment_mod.F90 index 9d4c81217..36513f2c8 100644 --- a/GeosCore/gc_environment_mod.F90 +++ b/GeosCore/gc_environment_mod.F90 @@ -79,8 +79,7 @@ SUBROUTINE GC_Allocate_All( Input_Opt, & ! ! !USES: ! - USE CMN_FastJX_Mod, ONLY : Init_CMN_FastJX ! ewl: temporary - USE CMN_Phot_Mod, ONLY : Init_CMN_Phot ! ewl: temporary + USE CMN_FastJX_Mod, ONLY : Init_CMN_FastJX USE ErrCode_Mod USE Input_Opt_Mod USE State_Grid_Mod, ONLY : GrdState @@ -147,9 +146,6 @@ SUBROUTINE GC_Allocate_All( Input_Opt, & ! Initialize CMN_FastJX_mod.F90 CALL Init_CMN_FastJX( Input_Opt,State_Grid, RC ) - ! Initialize CMN_Phot_mod.F90 - CALL Init_CMN_Phot( Input_Opt, State_Grid, RC ) - ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered within call to "Init_CMN_FJX"!' @@ -683,7 +679,7 @@ SUBROUTINE GC_Init_Extra( Diag_List, Input_Opt, State_Chm, & IF ( Input_Opt%ITS_A_MERCURY_SIM ) THEN ! Main mercury module - CALL Init_Mercury( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) + CALL Init_Mercury( Input_Opt, State_Grid, State_Chm, State_Diag, RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "Init_Mercury"!' CALL GC_Error( ErrMsg, RC, ThisLoc ) diff --git a/GeosCore/mercury_mod.F90 b/GeosCore/mercury_mod.F90 index 26f748898..1a4989e44 100644 --- a/GeosCore/mercury_mod.F90 +++ b/GeosCore/mercury_mod.F90 @@ -616,8 +616,6 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & ! USE Depo_Mercury_Mod, ONLY : ADD_Hg2_DD USE Depo_Mercury_Mod, ONLY : ADD_HgP_DD - USE FJX_Interface_Mod, ONLY : FAST_JX - USE CMN_Phot_Mod, ONLY : ODMDUST, IRHARR, ODAER, GC_Photo_Id, ZPJ USE GcKpp_Monitor, ONLY : SPC_NAMES, FAM_NAMES USE GcKpp_Parameters USE GcKpp_Integrator, ONLY : Integrate @@ -626,6 +624,7 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & USE Gckpp_Global USE GcKpp_Rates, ONLY : UPDATE_RCONST, RCONST USE Timers_Mod + USE Photolysis_Mod, ONLY : Do_Photolysis USE PhysConstants, ONLY : AVO USE State_Chm_Mod, ONLY : Ind_ USE PRESSURE_MOD @@ -700,17 +699,17 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & #endif ! Pointers - TYPE(SpcConc), POINTER :: Spc(:) - REAL(fp), POINTER :: TK(:,:,: ) - - ! Objects TYPE(Species), POINTER :: SpcInfo + TYPE(SpcConc), POINTER :: Spc (:) + INTEGER, POINTER :: IRHARR (:,:,:) + REAL(fp), POINTER :: TK (:,:,:) + REAL(fp), POINTER :: ODAER (:,:,:,:,:) + REAL(fp), POINTER :: ODMDUST(:,:,:,:,:) ! ! !DEFINED PARAMETERS: ! ! Toggle hetchem or photolysis on/off for testing (default=on) LOGICAL, PARAMETER :: DO_HETCHEM = .TRUE. - LOGICAL, PARAMETER :: DO_PHOTCHEM = .TRUE. ! Relative Humidities (to be passed to FAST_JX) REAL(fp), PARAMETER :: RH(5) = (/0.0_fp, 0.5_fp, 0.7_fp, 0.8_fp, 0.9_fp/) @@ -734,11 +733,16 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & Day = Get_Day() ! Current day Month = Get_Month() ! Current month Year = Get_Year() ! Current year - Spc => State_Chm%Species ! Chemical species array [kg] - TK => State_Met%T ! Temperature [K] - SpcInfo => NULL() ! Pointer to GEOS-Chem species database Failed2x = .FALSE. ! Flag for graceful exit of simulation + ! Initialize pointers + SpcInfo => NULL() ! Pointer to GEOS-Chem species database + Spc => State_Chm%Species ! Chemical species array [kg] + TK => State_Met%T ! Temperature [K] + IRHARR => State_Chm%Phot%IRHARR ! Relative humidity indexes + ODAER => State_Chm%Phot%ODAER ! Aerosol optical depth + ODMDUST => State_Chm%Phot%ODMDUST ! Dust optical depth + !======================================================================== ! Set chemistry options and pointers to chemical inputs from HEMCO !======================================================================== @@ -749,7 +753,7 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & ' is turned off for testing purposes.' WRITE( 6, '(a)' ) REPEAT( '#', 32 ) ENDIF - IF ( .not. DO_PHOTCHEM ) THEN + IF ( .not. Input_Opt%Do_Photolysis ) THEN WRITE( 6, '(a)' ) REPEAT( '#', 32 ) WRITE( 6, '(a)' ) ' # Do_FlexChem: Photolysis chemistry' // & ' is turned off for testing purposes.' @@ -858,15 +862,13 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & !======================================================================== ! Call photolysis routine to compute J-Values !======================================================================== - IF ( DO_PHOTCHEM ) THEN + IF ( Input_Opt%Do_Photolysis ) THEN !Compute J values - CALL Fast_JX( 0, Input_Opt, State_Chm, & - State_Diag, State_Grid, State_Met, RC ) - - ! Trap potential errors + CALL Do_Photolysis( Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, RC ) IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error encountered in "FAST_JX"!' + errMsg = 'Error encountered in "Do_Photolysis"!' CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF @@ -1010,11 +1012,11 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & IF ( State_Met%SUNCOSmid(I,J) > -0.1391731e+0_fp ) THEN ! Loop over the FAST-JX photolysis species - DO N = 1, State_Chm%Photol%nRatJ + DO N = 1, State_Chm%Phot%nPhotRxns ! Copy photolysis rate from FAST_JX into KPP PHOTOL array - IF ( DO_PHOTCHEM ) THEN - PHOTOL(N) = ZPJ(L,N,I,J) + IF ( Input_Opt%Do_Photolysis ) THEN + PHOTOL(N) = State_Chm%Phot%ZPJ(L,N,I,J) ENDIF !--------------------------------------------------------------- @@ -1026,7 +1028,7 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & IF ( State_Diag%Archive_JVal ) THEN ! GC photolysis species index - P = GC_Photo_Id(N) + P = State_Chm%Phot%GC_Photo_Id(N) ! Archive the instantaneous photolysis rate ! (summing over all reaction branches) @@ -1038,7 +1040,7 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & IF ( State_Diag%Archive_SatDiagnJVal ) THEN ! GC photolysis species index - P = GC_Photo_Id(N) + P = State_Chm%Phot%GC_Photo_Id(N) ! Archive the instantaneous photolysis rate ! (summing over all reaction branches) @@ -1370,9 +1372,13 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & ! WRITE(*,*) 'Total Hg2 mass [Mg]: ', Hg2Sum !ENDIF - ! Free pointer memory - TK => NULL() + ! Free pointers SpcInfo => NULL() + Spc => NULL() + IRHARR => NULL() + TK => NULL() + ODAER => NULL() + ODMDUST => NULL() END SUBROUTINE ChemMercury !EOC @@ -1795,7 +1801,6 @@ SUBROUTINE PolarBrOx( State_Chm, State_Grid, State_Met ) USE State_Met_Mod, ONLY : MetState USE State_Chm_Mod, ONLY : ChmState USE Time_Mod, ONLY : Get_Month - USE Cmn_Phot_Mod, ONLY : ZPJ ! ! !INPUT PARAMETERS: ! @@ -1914,7 +1919,7 @@ SUBROUTINE PolarBrOx( State_Chm, State_Grid, State_Met ) Br_CONC = State_Chm%Species(id_Br )%Conc(I,J,L) ! Get JBrO - JBrO = ZPJ(L,id_phot_BrO,I,J) + JBrO = State_Chm%Phot%ZPJ(L,id_phot_BrO,I,J) ! [BrO] is a linear function of temperature derived based on ! results from Pohler et al. (2010), Prados-Roman et al. (2011) @@ -1987,7 +1992,6 @@ SUBROUTINE PartXOx( State_Chm, State_Grid, State_Met ) USE State_Grid_Mod, ONLY : GrdState USE State_Met_Mod, ONLY : MetState USE State_Chm_Mod, ONLY : ChmState - USE Cmn_Phot_Mod, ONLY : ZPJ ! ! !INPUT PARAMETERS: ! @@ -2099,8 +2103,8 @@ SUBROUTINE PartXOx( State_Chm, State_Grid, State_Met ) k_Cl_O3 = A_Cl_O3 * EXP( -EdivR_Cl_O3 / State_Met%T(I,J,L) ) ! Instantaneous J-values [1/s] - J_BrO = ZPJ(L,id_phot_BrO,I,J) - J_ClO = ZPJ(L,id_phot_ClO,I,J) + J_BrO = State_Chm%Phot%ZPJ(L,id_phot_BrO,I,J) + J_ClO = State_Chm%Phot%ZPJ(L,id_phot_ClO,I,J) ! Fraction of [X]/[XO] F_Br_BrO = Safe_Div( J_BrO+(k_BrO_NO*C_NO), k_Br_O3*C_O3, 0.0_fp ) @@ -2151,7 +2155,6 @@ SUBROUTINE PartNOx( State_Chm, State_Grid, State_Met ) USE State_Grid_Mod, ONLY : GrdState USE State_Met_Mod, ONLY : MetState USE State_Chm_Mod, ONLY : ChmState - USE Cmn_Phot_Mod, ONLY : ZPJ ! ! !INPUT PARAMETERS: ! @@ -2231,7 +2234,7 @@ SUBROUTINE PartNOx( State_Chm, State_Grid, State_Met ) k3 = A * EXP( -EdivR / State_Met%T(I,J,L) ) ! Instantaneous JNO2 - J_NO2 = ZPJ(L,id_phot_NO2,I,J) + J_NO2 = State_Chm%Phot%ZPJ(L,id_phot_NO2,I,J) ! Fraction of NO2/NOx F_NO2 = SAFE_DIV( k3*C_O3, J_NO2+k3*C_O3, 0.0_fp ) @@ -3461,17 +3464,16 @@ END SUBROUTINE OfflineOcean_ReadMo !\\ ! !INTERFACE: ! - SUBROUTINE Init_Mercury( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) + SUBROUTINE Init_Mercury( Input_Opt, State_Grid, State_Chm, State_Diag, RC ) ! ! !USES: ! - USE CMN_Phot_Mod, ONLY : GC_Photo_Id USE Cmn_Size_Mod, ONLY : nAer, nDust USE ErrCode_Mod - USE FJX_Interface_Mod, ONLY : Init_FJX USE GcKpp_Monitor, ONLY : Eqn_Names, Fam_Names USE GcKpp_Parameters, ONLY : nFam, nReact USE Input_Opt_Mod, ONLY : OptInput + USE Photolysis_Mod, ONLY : Init_Photolysis USE Species_Mod, ONLY : Species USE State_Chm_Mod, ONLY : Ind_ USE State_Chm_Mod, ONLY : ChmState @@ -3481,11 +3483,11 @@ SUBROUTINE Init_Mercury( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) ! !INPUT PARAMETERS: ! TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object - TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object ! ! !INPUT/OUTPUT PARAMETERS: ! + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object TYPE(DgnState), INTENT(INOUT) :: State_Diag ! Diagnostic State object ! ! !OUTPUT PARAMETERS: @@ -3507,6 +3509,7 @@ SUBROUTINE Init_Mercury( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) ! Scalars INTEGER :: I, KppId, N, P INTEGER :: p_BrO, p_ClO, p_Hg2ORGP, p_NO2 + INTEGER :: nPhotRxns ! Strings CHARACTER(LEN=255) :: thisLoc @@ -3848,13 +3851,11 @@ SUBROUTINE Init_Mercury( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) LnoUSAemis = .FALSE. !======================================================================== - ! Initialize FAST-JX photolysis + ! Initialize photolysis !======================================================================== - CALL Init_FJX( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) - - ! Trap potential errors + CALL Init_Photolysis( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error encountered in "Init_FJX"!' + errMsg = 'Error encountered in "Init_Photolysis"!' CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF @@ -3870,16 +3871,17 @@ SUBROUTINE Init_Mercury( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) p_NO2 = Ind_( 'NO2', 'P' ) ! Initialize variables for # reactions and slots of ZPJ + nPhotRxns = State_Chm%Phot%nPhotRxns id_phot_BrO = 0 id_phot_ClO = 0 id_phot_Hg2Org = 0 id_phot_NO2 = 0 ! Loop over all photolysis reactions - DO N = 1, State_Chm%Photol%nRatJ + DO N = 1, nPhotRxns ! GC photolysis species index (skip if not present) - P = GC_Photo_Id(N) + P = State_Chm%Phot%GC_Photo_Id(N) IF ( P <= 0 ) CYCLE ! Define the slots in the ZPJ array for several species. @@ -3891,22 +3893,22 @@ SUBROUTINE Init_Mercury( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) ENDDO ! Error checks - IF ( id_phot_BrO <= 0 .or. id_phot_BrO > State_Chm%Photol%nRatJ ) THEN + IF ( id_phot_BrO <= 0 .or. id_phot_BrO > nPhotRxns ) THEN errMsg = 'Invalid photolysis index for BrO!' CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF - IF ( id_phot_ClO <= 0 .or. id_phot_ClO > State_Chm%Photol%nRatJ ) THEN + IF ( id_phot_ClO <= 0 .or. id_phot_ClO > nPhotRxns ) THEN errMsg = 'Invalid photolysis index for ClO!' CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF - IF ( id_phot_Hg2Org <= 0 .or. id_phot_Hg2Org > State_Chm%Photol%nRatJ ) THEN + IF ( id_phot_Hg2Org <= 0 .or. id_phot_Hg2Org > nPhotRxns ) THEN errMsg = 'Invalid photolysis index for HG2ORGP!' CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF - IF ( id_phot_NO2 <= 0 .or. id_phot_NO2 > State_Chm%Photol%nRatJ ) THEN + IF ( id_phot_NO2 <= 0 .or. id_phot_NO2 > nPhotRxns ) THEN errMsg = 'Invalid photolysis index for NO2!' CALL GC_Error( errMsg, RC, thisLoc ) RETURN diff --git a/GeosCore/photolysis_mod.F90 b/GeosCore/photolysis_mod.F90 new file mode 100644 index 000000000..63d7bf94d --- /dev/null +++ b/GeosCore/photolysis_mod.F90 @@ -0,0 +1,1440 @@ +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: photolysis_mod.F90 +! +! !DESCRIPTION: Module PHOTOLYSIS\_MOD contains routines and variables +! for GEOS-Chem photolysis. +!\\ +!\\ +! !INTERFACE: +! +MODULE PHOTOLYSIS_MOD +! +! !USES: +! + USE PRECISION_MOD + + IMPLICIT NONE + + PRIVATE +! +! !PUBLIC MEMBER FUNCTIONS: +! + PUBLIC :: Init_Photolysis + PUBLIC :: Do_Photolysis + PUBLIC :: PHOTRATE_ADJ +! +! !PRIVATE MEMBER FUNCTIONS: +! + PRIVATE :: RD_AOD + PRIVATE :: CALC_AOD + PRIVATE :: SET_AER +! +! !REVISION HISTORY: +! 20 Mar 2023 - E. Lundgren - initial version, adapted from fast_jx_mod.F90 +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC + +CONTAINS +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_photolysis +! +! !DESCRIPTION: Subroutine INIT\_PHOTOLYSIS initializes GEOS-Chem photolysis. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE INIT_PHOTOLYSIS( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) +! +! !USES: +! + USE Charpak_Mod, ONLY : CSTRIP +#ifdef CLOUDJ + USE Cldj_Cmn_Mod +#else + USE CMN_FastJX_Mod +#endif + USE ErrCode_Mod + USE Input_Opt_Mod, ONLY : OptInput + USE PhysConstants, ONLY : UVXPlanck, UVXCConst + USE State_Chm_Mod, ONLY : ChmState, Ind_ + USE State_Diag_Mod, ONLY : DgnState + USE State_Grid_Mod, ONLY : GrdState +#ifdef CLOUDJ + USE Cldj_Interface_Mod, ONLY : Init_CloudJ +#else + USE Fjx_Interface_Mod, ONLY : Init_FastJX +#endif +! +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object + TYPE(DgnState), INTENT(IN) :: State_Diag ! Diagnostics State object + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? +! +! !REVISION HISTORY: +! 20 Mar 2023 - E. Lundgren - initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + ! Strings + CHARACTER(LEN=50 ) :: TEXT + CHARACTER(LEN=255) :: ErrMsg, ThisLoc + + ! Scalars + LOGICAL :: notDryRun + INTEGER :: J, K + REAL(fp) :: ND64MULT + + ! Pointers + INTEGER, POINTER :: GC_Photo_ID(:) + + !======================================================================= + ! INIT_PHOTOLYSIS begins here! + !======================================================================= + + ! Initialize + RC = GC_SUCCESS + notDryRun = ( .not. Input_Opt%DryRun ) + ErrMsg = '' + ThisLoc = ' -> at Init_Photolysis (in module GeosCore/photolysis_mod.F90)' + + ! Set pointers + GC_Photo_ID => State_Chm%Phot%GC_Photo_ID + + !-------------------------------------------------------------------- + ! Initialize photolysis except for carbon + ! + ! NOTE: we need to call this for a dry-run so that we can get + ! a list of all of the lookup tables etc read by Fast-JX/Cloud-J + !-------------------------------------------------------------------- + ! ewl: need to revisit qualification to run, since done in main.F90 too + IF ( .not. Input_Opt%ITS_A_CARBON_SIM ) THEN +#ifdef CLOUDJ + CALL Init_CloudJ( Input_Opt, State_Diag, State_Grid, State_Chm, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_CloudJ"!' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF +#else + CALL Init_FastJX( Input_Opt, State_Diag, State_Grid, State_Chm, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_FastJX"!' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF +#endif + ENDIF + + !======================================================================== + ! Flag special reactions that will be later adjusted by + ! routine PHOTRATE_ADJ (called from FlexChem) + !======================================================================== + IF ( Input_Opt%ITS_A_FULLCHEM_SIM ) THEN + + ! Loop over all photolysis reactions + DO K = 1, State_Chm%Phot%nPhotRxns + + ! Strip all blanks from the reactants and products list + TEXT = JLABEL(K) + CALL CSTRIP( TEXT ) + + !IF ( Input_Opt%amIRoot ) THEN + ! WRITE(*,*) K, TRIM( TEXT ) + !ENDIF + + ! Look for certain reactions + SELECT CASE( TRIM( TEXT ) ) + CASE( 'O2PHOTONOO' ) + State_Chm%Phot%RXN_O2 = K ! O2 + hv -> O + O + CASE( 'O3PHOTONO2O' ) + State_Chm%Phot%RXN_O3_1 = K ! O3 + hv -> O2 + O + CASE( 'O3PHOTONO2O(1D)' ) + State_Chm%Phot%RXN_O3_2 = K ! O3 + hv -> O2 + O(1D) + CASE( 'SO4PHOTONSO2OHOH' ) + State_Chm%Phot%RXN_H2SO4 = K ! SO4 + hv -> SO2 + OH + OH + CASE( 'NO2PHOTONNOO' ) + State_Chm%Phot%RXN_NO2 = K ! NO2 + hv -> NO + O + CASE( 'NOPHOTONNO' ) + State_Chm%Phot%RXN_NO = K ! NO + hv -> N + O + CASE( 'NO3PHOTONNO2O' ) + State_Chm%Phot%RXN_NO3 = K ! NO3 + hv -> NO2 + O + CASE( 'N2OPHOTONN2O' ) + State_Chm%Phot%RXN_N2O = K ! N2O + hv -> N2 + O + CASE( 'NITsPHOTONHNO2' ) + State_Chm%Phot%RXN_JNITSa = K ! NITs + hv -> HNO2 + CASE( 'NITsPHOTONNO2' ) + State_Chm%Phot%RXN_JNITSb = K ! NITs + hv -> NO2 + CASE( 'NITPHOTONHNO2' ) + State_Chm%Phot%RXN_JNITa = K ! NIT + hv -> HNO2 + CASE( 'NITPHOTONNO2' ) + State_Chm%Phot%RXN_JNITb = K ! NIT + hv -> NO2 + CASE( 'HNO3PHOTONNO2OH' ) + State_Chm%Phot%RXN_JHNO3 = K ! HNO3 + hv = OH + NO2 + CASE DEFAULT + ! Nothing + END SELECT + ENDDO + + !--------------------------------------------------------------------- + ! Error check the various rxn flags + !--------------------------------------------------------------------- + IF ( State_Chm%Phot%RXN_O2 < 0 ) THEN + ErrMsg = 'Could not find rxn O2 + hv -> O + O' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_O3_1 < 0 ) THEN + ErrMsg = 'Could not find rxn O3 + hv -> O2 + O' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_O3_2 < 0 ) THEN + ErrMsg = 'Could not find rxn O3 + hv -> O2 + O(1D)' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + ENDIF + + IF ( State_Chm%Phot%RXN_NO2 < 0 ) THEN + ErrMsg = 'Could not find rxn NO2 + hv -> NO + O' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_NO2 < 0 ) THEN + ErrMsg = 'Could not find rxn NO2 + hv -> NO + O' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_JNITSa < 0 ) THEN + ErrMsg = 'Could not find rxn NITS + hv -> HNO2' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_JNITSb < 0 ) THEN + ErrMsg = 'Could not find rxn NITS + hv -> NO2' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_JNITa < 0 ) THEN + ErrMsg = 'Could not find rxn NIT + hv -> HNO2' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_JNITb < 0 ) THEN + ErrMsg = 'Could not find rxn NIT + hv -> NO2' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_H2SO4 < 0 ) THEN + ErrMsg = 'Could not find rxn SO4 + hv -> SO2 + OH + OH!' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_NO3 < 0 ) THEN + ErrMsg = 'Could not find rxn NO3 + hv -> NO2 + O' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_NO < 0 ) THEN + ErrMsg = 'Could not find rxn NO + hv -> O + N' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_N2O < 0 ) THEN + ErrMsg = 'Could not find rxn N2O + hv -> N2 + O(1D)' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + !--------------------------------------------------------------------- + ! Print out saved rxn flags for fullchem simulations + !--------------------------------------------------------------------- + IF ( Input_Opt%amIRoot ) THEN + WRITE( 6, 100 ) REPEAT( '=', 79 ) + WRITE( 6, 110 ) + WRITE( 6, 120 ) State_Chm%Phot%RXN_O2 + WRITE( 6, 130 ) State_Chm%Phot%RXN_O3_1 + WRITE( 6, 140 ) State_Chm%Phot%RXN_O3_2 + WRITE( 6, 180 ) State_Chm%Phot%RXN_JNITSa + WRITE( 6, 190 ) State_Chm%Phot%RXN_JNITSb + WRITE( 6, 200 ) State_Chm%Phot%RXN_JNITa + WRITE( 6, 210 ) State_Chm%Phot%RXN_JNITb + WRITE( 6, 160 ) State_Chm%Phot%RXN_H2SO4 + WRITE( 6, 170 ) State_Chm%Phot%RXN_NO2 + WRITE( 6, 100 ) REPEAT( '=', 79 ) + ENDIF + ENDIF + + !======================================================================== + ! Flag reactions for diagnostics (only in Hg chem) + !======================================================================== + IF ( Input_Opt%ITS_A_MERCURY_SIM ) THEN + ! Loop over all photolysis reactions + DO K = 1, State_Chm%Phot%nPhotRxns + + ! Strip all blanks from the reactants and products list + TEXT = JLABEL(K) + CALL CSTRIP( TEXT ) + + ! Look for certain reactions + SELECT CASE( TRIM( TEXT ) ) + CASE( 'O3PHOTONO2O' ) + State_Chm%Phot%RXN_O3_1 = K ! O3 + hv -> O2 + O + CASE( 'O3PHOTONO2O(1D)' ) + State_Chm%Phot%RXN_O3_2 = K ! O3 + hv -> O2 + O(1D) + CASE( 'NO2PHOTONNOO' ) + State_Chm%Phot%RXN_NO2 = K ! NO2 + hv -> NO + O + CASE( 'BrOPHOTONBrO' ) + State_Chm%Phot%RXN_BrO = K ! BrO + hv -> Br + O + CASE( 'ClOPHOTONClO' ) + State_Chm%Phot%RXN_ClO = K ! ClO + hv -> Cl + O + CASE DEFAULT + ! Nothing + END SELECT + ENDDO + + !-------------------------------------------------------------------- + ! Error check the various rxn flags + !-------------------------------------------------------------------- + IF ( State_Chm%Phot%RXN_O3_1 < 0 ) THEN + ErrMsg = 'Could not find rxn O3 + hv -> O2 + O' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_O3_2 < 0 ) THEN + ErrMsg = 'Could not find rxn O3 + hv -> O2 + O(1D) #1' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_NO2 < 0 ) THEN + ErrMsg = 'Could not find rxn NO2 + hv -> NO + O' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_BrO < 0 ) THEN + ErrMsg = 'Could not find rxn BrO + hv -> Br + O' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( State_Chm%Phot%RXN_ClO < 0 ) THEN + ErrMsg = 'Could not find rxn ClO + hv -> Cl + O' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + !--------------------------------------------------------------------- + ! Print out saved rxn flags for Hg simulation + !--------------------------------------------------------------------- + IF ( Input_Opt%amIRoot ) THEN + WRITE( 6, 100 ) REPEAT( '=', 79 ) + WRITE( 6, 110 ) + WRITE( 6, 130 ) State_Chm%Phot%RXN_O3_1 + WRITE( 6, 140 ) State_Chm%Phot%RXN_O3_2 + WRITE( 6, 170 ) State_Chm%Phot%RXN_NO2 + WRITE( 6, 220 ) State_Chm%Phot%RXN_BrO + WRITE( 6, 230 ) State_Chm%Phot%RXN_ClO + WRITE( 6, 100 ) REPEAT( '=', 79 ) + ENDIF + ENDIF + + ! Skip further processing if we are in dry-run mode + IF ( notDryRun ) THEN + + ! Get the GEOS-Chem photolysis index for each of the 1...JVN_ entries + ! in the FJX_j2j.dat file. We'll use this for the diagnostics. + DO J = 1, JVN_ + + IF ( J == State_Chm%Phot%Rxn_O3_2 ) THEN + + !------------------------------------------------------------ + ! O3 + hv = O + O(1D) + ! + ! Save this as JO3_O1D in the nPhotol+1 slot + !------------------------------------------------------------ + GC_Photo_Id(J) = State_Chm%nPhotol + 1 + + ELSE IF ( J == State_Chm%Phot%Rxn_O3_1 ) THEN + + !------------------------------------------------------------ + ! O3 + hv -> O + O + ! + ! Save this as JO3_O3P in the nPhotol+2 slot + !------------------------------------------------------------- + GC_Photo_Id(J) = State_Chm%nPhotol + 2 + + ELSE + + !------------------------------------------------------------ + ! Everything else + ! + ! Find the matching GEOS-Chem photolysis species number + !------------------------------------------------------------ + GC_Photo_Id(J) = Ind_( RNAMES(J), 'P' ) + + ENDIF + + ! Print the mapping + IF ( Input_Opt%amIRoot ) THEN + IF ( GC_Photo_Id(J) > 0 ) THEN + WRITE(6, 240) RNAMES(J), J, GC_Photo_Id(J), JFACTA(J) +240 FORMAT( a10, ':', i7, 2x, i7, 2x, f7.4 ) + ENDIF + ENDIF + ENDDO + + !===================================================================== + ! Compute factors for UV flux diagnostics if turned on + !===================================================================== + IF ( State_Diag%Archive_UVFluxNet .or. & + State_Diag%Archive_UVFluxDirect .or. & + State_Diag%Archive_UVFluxDiffuse ) THEN + ND64MULT = UVXPLANCK*UVXCCONST*1.0e+13_fp + State_Chm%Phot%UVXFACTOR = 0e+0_fp + DO J = 1, W_ + State_Chm%Phot%UVXFACTOR(J) = ND64MULT/WL(J) + ENDDO + ENDIF + ENDIF + + !===================================================================== + ! Read in AOD data + ! (or just print file name if in dry-run mode) + !===================================================================== + + CALL RD_AOD( Input_Opt, State_Chm, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in FAST-JX routine "RD_AOD"!' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + ! Only do the following if we are not running in dry-run mode + IF ( .not. Input_Opt%DryRun ) THEN + + IF ( Input_Opt%amIRoot ) THEN + WRITE( 6, * ) 'Optics read for all wavelengths successfully' + ENDIF + + ! Now calculate the required wavelengths in the LUT to calculate + ! the requested AOD + CALL CALC_AOD( Input_Opt, State_Chm, RC ) + + ! Set up MIEDX array to interpret between GC and FJX aerosol indexing + ! NOTE: MIEDX was mostly not used in Fast-JX. It is used for all + ! aerosols in Cloud-J (ewl) + CALL SET_AER( Input_Opt, State_Chm, RC ) + + ENDIF + + ! Free pointers + GC_Photo_ID => NULL() + + ! FORMAT statements +100 FORMAT( a ) +110 FORMAT( 'Photo rxn flags saved for use in PHOTRATE_ADJ:', / ) +120 FORMAT( 'RXN_O2 [ O2 + hv -> O + O ] = ', i5 ) +130 FORMAT( 'RXN_O3_1 [ O3 + hv -> O2 + O ] = ', i5 ) +140 FORMAT( 'RXN_O3_2a [ O3 + hv -> O2 + O(1D) #1 ] = ', i5 ) +150 FORMAT( 'RXN_O3_2b [ O3 + hv -> O2 + O(1D) #2 ] = ', i5 ) +160 FORMAT( 'RXN_H2SO4 [ SO4 + hv -> SO2 + OH + OH ] = ', i5 ) +170 FORMAT( 'RXN_NO2 [ NO2 + hv -> NO + O ] = ', i5 ) +180 FORMAT( 'RXN_JNITSa [ NITS + hv -> HNO2 ] = ', i5 ) +190 FORMAT( 'RXN_JNITSb [ NITS + hv -> NO2 ] = ', i5 ) +200 FORMAT( 'RXN_JNITa [ NIT + hv -> HNO2 ] = ', i5 ) +210 FORMAT( 'RXN_JNITb [ NIT + hv -> NO2 ] = ', i5 ) +220 FORMAT( 'RXN_BrO [ BrO + hv -> Br + O ] = ', i5 ) +230 FORMAT( 'RXN_ClO [ ClO + hv -> Cl + O ] = ', i5 ) + + END SUBROUTINE Init_Photolysis +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !ROUTINE: do_photolysis +! +! !DESCRIPTION: Subroutine DO\_PHOTOLYSIS loops over longitude and latitude, +! and computes J-Values for each column at every chemistry time-step. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Do_Photolysis( Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, RC ) +! +! !USES: +! + USE ErrCode_Mod + USE Input_Opt_Mod, ONLY : OptInput + USE State_Chm_Mod, ONLY : ChmState + USE State_Diag_Mod, ONLY : DgnState + USE State_Grid_Mod, ONLY : GrdState + USE State_Met_Mod, ONLY : MetState +#ifdef CLOUDJ + USE Cldj_Interface_Mod, ONLY : Run_CloudJ +#else + USE Fjx_Interface_Mod, ONLY : Run_FastJX +#endif + + IMPLICIT NONE +! +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(DgnState), INTENT(INOUT) :: State_Diag ! Diagnostics State object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? +! +! !REMARKS: +! +! +! !REVISION HISTORY: +! 20 Mar 2023 - E. Lundgren - initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: Wavelength + CHARACTER(LEN=255) :: ErrMsg, ThisLoc + + !================================================================= + ! DO_PHOTOLYSIS begins here! + !================================================================= + + ! Initialize + RC = GC_SUCCESS + ErrMsg = '' + ThisLoc = ' -> at DO_PHOTOLYSIS (in module GeosCore/photolysis_mod.F90)' + WAVELENGTH = 0 + +#ifdef CLOUDJ + CALL Run_CloudJ( Wavelength, Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, RC ) +#else + CALL Run_FastJX( Wavelength, Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, RC ) +#endif + + IF ( RC /= GC_SUCCESS ) THEN +#ifdef CloudJ + ErrMsg = 'Error encountered in subroutine Run_CloudJ!' +#else + ErrMsg = 'Error encountered in subroutine RunFastJX!' +#endif + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + +! ewl: consider changing name to something like compute_jvalues + END SUBROUTINE Do_Photolysis +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: photrate_adj +! +! !DESCRIPTION: Subroutine PHOTRATE\_ADJ adjusts certain photolysis rates +! for chemistry. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE PHOTRATE_ADJ( Input_Opt, State_Chm, State_Diag, State_Met, & + I, J, L, FRAC, RC ) +! +! !USES: +! + USE ErrCode_Mod + USE Input_Opt_Mod, ONLY : OptInput + USE State_Chm_Mod, ONLY : ChmState + USE State_Diag_Mod, ONLY : DgnState + USE State_Met_Mod, ONLY : MetState +! +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input_Options object + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object + TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object + INTEGER, INTENT(IN) :: I, J, L ! Lon, lat, lev indices + REAL(fp), INTENT(IN) :: FRAC ! Result of SO4_PHOTFRAC, + ! called from DO_FLEXCHEM +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(DgnState), INTENT(INOUT) :: State_Diag ! Diagnostics State object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure +! +! !REMARKS: +! NOTE: The netCDF diagnostics are attached in DO_FLEXCHEM so that we have +! access to the adjusted rates. Only the bpch diagnostics are updated +! here. +! -- Bob Yantosca, 19 Dec 2017 +! +! %%%% NOTE: WE SHOULD UPDATE THE COMMENTS TO MAKE SURE THAT WE DO %%%% +! %%%% NOT KEEP ANY CONFLICTING OR INCORRECT INFORMATION (bmy, 3/28/16) %%%% +! +! !REVISION HISTORY: +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: RXN_JNITSa, RXN_JNITSb, RXN_JNITa, RXN_JNITb + INTEGER :: RXN_JHNO3, RXN_H2SO4, RXN_O3_1, RXN_O3_2 + REAL(fp) :: JscaleNITs, JscaleNIT, JNITChanA, JNITChanB + REAL(fp) :: C_O2, C_N2, C_H2, ITEMPK, RO1DplH2O + REAL(fp) :: RO1DplH2, RO1D, NUMDEN, TEMP, C_H2O + + ! Pointers + REAL*8, POINTER :: ZPJ(:,:,:,:) + + !================================================================= + ! PHOTRATE_ADJ begins here! + !================================================================= + + ! Initialize + RC = GC_SUCCESS + TEMP = State_Met%T(I,J,L) ! K + NUMDEN = State_Met%AIRNUMDEN(I,J,L) ! molec/cm3 + C_H2O = State_Met%AVGW(I,J,L) * State_Met%AIRNUMDEN(I,J,L) ! molec/cm3 + + ! Reaction flags + RXN_JNITSa = State_Chm%Phot%RXN_JNITSa + RXN_JNITSb = State_Chm%Phot%RXN_JNITSb + RXN_JNITa = State_Chm%Phot%RXN_JNITa + RXN_JNITb = State_Chm%Phot%RXN_JNITb + RXN_JHNO3 = State_Chm%Phot%RXN_JHNO3 + RXN_H2SO4 = State_Chm%Phot%RXN_H2SO4 + RXN_O3_1 = State_Chm%Phot%RXN_O3_1 + RXN_O3_2 = State_Chm%Phot%RXN_O3_2 + + ! Pointers + ZPJ => State_Chm%Phot%ZPJ + + ! For all mechanisms. Set the photolysis rate of NITs and NIT to a + ! scaled value of JHNO3. NOTE: this is set in geoschem_config.yml + IF ( Input_Opt%hvAerNIT ) THEN + + ! Get the photolysis scalars read in from geoschem_config.yml + JscaleNITs = Input_Opt%hvAerNIT_JNITs + JscaleNIT = Input_Opt%hvAerNIT_JNIT + ! convert reaction channel % to a fraction + JNITChanA = Input_Opt%JNITChanA + JNITChanB = Input_Opt%JNITChanB + JNITChanA = JNITChanA / 100.0_fp + JNITChanB = JNITChanB / 100.0_fp + ! Set the photolysis rate of NITs + ZPJ(L,RXN_JNITSa,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNITs + ZPJ(L,RXN_JNITSb,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNITs + ! Set the photolysis rate of NIT + ZPJ(L,RXN_JNITa,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNIT + ZPJ(L,RXN_JNITb,I,J) = ZPJ(L,RXN_JHNO3,I,J) * JscaleNIT + ! Adjust to scaling for channels set in geoschem_config.yml + ! NOTE: channel scaling is 1 in FJX_j2j.dat, then updated here + ZPJ(L,RXN_JNITSa,I,J) = ZPJ(L,RXN_JNITSa,I,J) * JNITChanA + ZPJ(L,RXN_JNITa,I,J) = ZPJ(L,RXN_JNITa,I,J) * JNITChanA + ZPJ(L,RXN_JNITSb,I,J) = ZPJ(L,RXN_JNITSb,I,J) * JNITChanB + ZPJ(L,RXN_JNITb,I,J) = ZPJ(L,RXN_JNITb,I,J) * JNITChanB + + ! Gotcha to set JNIT and JNITs to zero if hvAerNIT switch is off + ELSE + + ! Set the photolysis rate of NITs to zero + ZPJ(L,RXN_JNITSa,I,J) = 0.0_fp + ZPJ(L,RXN_JNITSb,I,J) = 0.0_fp + ! Set the photolysis rate of NIT to zero + ZPJ(L,RXN_JNITa,I,J) = 0.0_fp + ZPJ(L,RXN_JNITb,I,J) = 0.0_fp + + ENDIF + + !============================================================== + ! SPECIAL TREATMENT FOR H2SO4+hv -> SO2 + 2OH + ! + ! Only allow photolysis of H2SO4 when gaseous (SDE 04/11/13) + !============================================================== + + ! Calculate if H2SO4 expected to be gaseous or aqueous + ! Only allow photolysis above 6 hPa + ! RXN_H2SO4 specifies SO4 + hv -> SO2 + OH + OH + ZPJ(L,RXN_H2SO4,I,J) = ZPJ(L,RXN_H2SO4,I,J) * FRAC + + !============================================================== + ! SPECIAL TREATMENT FOR O3+hv -> O+O2 + ! + ! [O1D]ss=J[O3]/(k[H2O]+k[N2]+k[O2]) + ! SO, THE EFFECTIVE J-VALUE IS J*k[H2O]/(k[H2O]+k[N2]+k[O2]) + ! + ! We don't want to do this if strat-chem is in use, as all + ! the intermediate reactions are included - this would be + ! double-counting (SDE 04/01/13) + !============================================================== + + ! Need to subtract O3->O1D from rate + ! RXN_O3_1 specifies: O3 + hv -> O2 + O + ! RXN_O3_2 specifies: O3 + hv -> O2 + O(1D) + ZPJ(L,RXN_O3_1,I,J) = ZPJ(L,RXN_O3_1,I,J) & + - ZPJ(L,RXN_O3_2,I,J) + + ! Free pointers + ZPJ => NULL() + + END SUBROUTINE PHOTRATE_ADJ +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: rd_aod +! +! !DESCRIPTION: Subroutine RD\_AOD reads aerosol phase functions that are +! used to scale diagnostic output to an arbitrary wavelengh. This +! facilitates comparing with satellite observations. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE RD_AOD( Input_Opt, State_Chm, RC ) +! +! !USES: +! + USE ErrCode_Mod + USE Input_Opt_Mod, ONLY : OptInput + USE InquireMod, ONLY : FindFreeLUN + USE State_Chm_Mod, ONLY : ChmState +#if defined( MODEL_CESM ) + USE UNITS, ONLY : freeUnit +#endif +! +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? +! +! !REMARKS: +! The .dat files for each species contain the optical properties +! at multiple wavelengths to be used in the online calculation of the aerosol +! optical depth diagnostics. +! These properties have been calculated using the same size and optical +! properties as the FJX_spec.dat file used for the FAST-J photolysis +! calculations (which is now redundant for aerosols, the values in the .dat +! files here are now used). The file currently contains 11 wavelengths +! for Fast-J and other commonly used wavelengths for satellite and +! AERONET retrievals. 30 wavelengths follow that map onto RRTMG +! wavebands for radiaitive flux calculations (not used if RRTMG is off). +! A complete set of optical properties from 250-2000 nm for aerosols is +! available at: +! ftp://ftp.as.harvard.edu/geos-chem/data/aerosol_optics/hi_spectral_res +! . +! -- Colette L. Heald, 05/10/10) +! -- David A. Ridley, 05/10/13 (update for new optics files) +! +! !REVISION HISTORY: +! 10 May 2010 - C. Heald - Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES +! + ! Scalars + INTEGER :: I, J, K, N + INTEGER :: IOS, NJ1 + LOGICAL :: LBRC, FileExists + + ! Strings + CHARACTER(LEN=78 ) :: TITLE0 + CHARACTER(LEN=255) :: DATA_DIR + CHARACTER(LEN=255) :: THISFILE + CHARACTER(LEN=255) :: FileMsg + CHARACTER(LEN=255) :: ErrMsg + CHARACTER(LEN=255) :: ThisLoc + + ! String arrays + CHARACTER(LEN=30) :: SPECFIL(8) + + ! Pointers + REAL*8, POINTER :: WVAA (:,:) + REAL*8, POINTER :: RHAA (:,:) + REAL*8, POINTER :: RDAA (:,:) + REAL*8, POINTER :: RWAA (:,:) + REAL*8, POINTER :: SGAA (:,:) + REAL*8, POINTER :: REAA (:,:) + REAL*8, POINTER :: NCMAA (:,:,:) + REAL*8, POINTER :: NRLAA (:,:,:) + REAL*8, POINTER :: QQAA (:,:,:) + REAL*8, POINTER :: ALPHAA(:,:,:) + REAL*8, POINTER :: SSAA (:,:,:) + REAL*8, POINTER :: ASYMAA(:,:,:) + REAL*8, POINTER :: PHAA (:,:,:,:) + + !================================================================ + ! RD_AOD begins here! + !================================================================ + + ! Initialize + RC = GC_SUCCESS + ErrMsg = '' + ThisLoc = ' -> at RD_AOD (in module GeosCore/fast_jx_mod.F90)' + LBRC = Input_Opt%LBRC + DATA_DIR = TRIM( Input_Opt%FAST_JX_DIR ) + + ! Set Pointers + WVAA => State_Chm%Phot%WVAA + RHAA => State_Chm%Phot%RHAA + RDAA => State_Chm%Phot%RDAA + RWAA => State_Chm%Phot%RWAA + SGAA => State_Chm%Phot%SGAA + REAA => State_Chm%Phot%REAA + NRLAA => State_Chm%Phot%NRLAA + NCMAA => State_Chm%Phot%NCMAA + QQAA => State_Chm%Phot%QQAA + ALPHAA => State_Chm%Phot%ALPHAA + SSAA => State_Chm%Phot%SSAA + ASYMAA => State_Chm%Phot%ASYMAA + PHAA => State_Chm%Phot%PHAA + +#if defined( MODEL_CESM ) + IF ( Input_Opt%amIRoot ) THEN + NJ1 = findFreeLUN() + ELSE + NJ1 = 0 + ENDIF +#else + ! Get a free LUN + NJ1 = findFreeLUN() +#endif + + ! IMPORTANT: aerosol_mod.F and dust_mod.F expect aerosols in this order + ! + ! Treating strat sulfate with GADS data but modified to match + ! the old Fast-J values size (r=0.09um, sg=0.6) - I think there's + ! evidence that this is too smale and narrow e.g. Deshler et al. 2003 + ! NAT should really be associated with something like cirrus cloud + ! but for now we are just treating the NAT like the sulfate... limited + ! info but ref index is similar e.g. Scarchilli et al. (2005) + !(DAR 05/2015) + DATA SPECFIL /"so4.dat","soot.dat","org.dat", & + "ssa.dat","ssc.dat", & + "h2so4.dat","h2so4.dat", & + "dust.dat"/ + + ! Loop over the array of filenames + DO k = 1, State_Chm%Phot%NSPAA + + ! Choose different set of input files for standard (trop+strat chenm) + ! and tropchem (trop-only chem) simulations + THISFILE = TRIM( DATA_DIR ) // TRIM( SPECFIL(k) ) + + !-------------------------------------------------------------- + ! In dry-run mode, print file path to dryrun log and cycle. + ! Otherwise, print file path to stdout and continue. + !-------------------------------------------------------------- + + ! Test if the file exists + INQUIRE( FILE=TRIM( ThisFile ), EXIST=FileExists ) + + ! Test if the file exists and define an output string + IF ( FileExists ) THEN + FileMsg = 'FAST-JX (RD_AOD): Opening' + ELSE + FileMsg = 'FAST-JX (RD_AOD): REQUIRED FILE NOT FOUND' + ENDIF + + ! Write to stdout for both regular and dry-run simulations + IF ( Input_Opt%amIRoot ) THEN + WRITE( 6, 300 ) TRIM( FileMsg ), TRIM( ThisFile ) +300 FORMAT( a, ' ', a ) + ENDIF + + ! For dry-run simulations, cycle to next file. + ! For regular simulations, throw an error if we can't find the file. + IF ( Input_Opt%DryRun ) THEN + CYCLE + ELSE + IF ( .not. FileExists ) THEN + WRITE( ErrMsg, 300 ) TRIM( FileMsg ), TRIM( ThisFile ) + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + ENDIF + + !-------------------------------------------------------------- + ! If not a dry-run, read data from each species file + !-------------------------------------------------------------- + +#if defined( MODEL_CESM ) + ! Only read file on root thread if using CESM + IF ( Input_Opt%amIRoot ) THEN +#endif + + ! Open file + OPEN( NJ1, FILE=TRIM( THISFILE ), STATUS='OLD', IOSTAT=RC ) + + ! Error check + IF ( RC /= 0 ) THEN + ErrMsg = 'Error opening file: ' // TRIM( ThisFile ) + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + ! Read header lines + READ( NJ1, '(A)' ) TITLE0 + IF ( Input_Opt%amIRoot ) WRITE( 6, '(1X,A)' ) TITLE0 + + ! Second header line added for more info + READ( NJ1, '(A)' ) TITLE0 + IF ( Input_Opt%amIRoot ) WRITE( 6, '(1X,A)' ) TITLE0 + + READ( NJ1, '(A)' ) TITLE0 +110 FORMAT( 3x, a20 ) + + DO i = 1, State_Chm%Phot%NRAA + DO j = 1, State_Chm%Phot%NWVAA + + READ(NJ1,*) WVAA(j,k),RHAA(i,k),NRLAA(j,i,k),NCMAA(j,i,k), & + RDAA(i,k),RWAA(i,k),SGAA(i,k),QQAA(j,i,k), & + ALPHAA(j,i,k),REAA(i,k),SSAA(j,i,k), & + ASYMAA(j,i,k),(PHAA(j,i,k,n),n=1,8) + + ! make note of where 1000nm is for FAST-J calcs + IF (WVAA(j,k).EQ.1000.0) State_Chm%Phot%IWV1000=J + + ENDDO + ENDDO + + ! Close file + CLOSE( NJ1 ) + +#if defined( MODEL_CESM ) + ENDIF +#endif + + ENDDO + +! ! ewl debugging +! print *, "ewl: State_Chm%Phot%IWV1000: ", State_Chm%Phot%IWV1000 +! print *, "ewl:WVAA sum: ", SUM(State_Chm%Phot%WVAA (:,:) ) +! print *, "ewl:RHAA sum: ", SUM(State_Chm%Phot%RHAA (:,:) ) +! print *, "ewl:RDAA sum: ", SUM(State_Chm%Phot%RDAA (:,:) ) +! print *, "ewl:RWAA sum: ", SUM(State_Chm%Phot%RWAA (:,:) ) +! print *, "ewl:SGAA sum: ", SUM(State_Chm%Phot%SGAA (:,:) ) +! print *, "ewl:REAA sum: ", SUM(State_Chm%Phot%REAA (:,:) ) +! print *, "ewl:NRLAA sum: ", SUM(State_Chm%Phot%NRLAA (:,:,:) ) +! print *, "ewl:NCMAA sum: ", SUM(State_Chm%Phot%NCMAA (:,:,:) ) +! print *, "ewl:QQAA sum: ", SUM(State_Chm%Phot%QQAA (:,:,:) ) +! print *, "ewl:ALPHAA sum: ", SUM(State_Chm%Phot%ALPHAA(:,:,:) ) +! print *, "ewl:SSAA sum: ", SUM(State_Chm%Phot%SSAA (:,:,:) ) +! print *, "ewl:ASYMAA sum: ", SUM(State_Chm%Phot%ASYMAA(:,:,:) ) +! print *, "ewl:PHAA sum: ", SUM(State_Chm%Phot%PHAA (:,:,:,:)) + +#if defined( MODEL_CESM ) + IF ( Input_Opt%amIRoot ) CALL freeUnit(NJ1) +#endif + + ! Free pointers + WVAA => NULL() + RHAA => NULL() + RDAA => NULL() + RWAA => NULL() + SGAA => NULL() + REAA => NULL() + NCMAA => NULL() + NRLAA => NULL() + QQAA => NULL() + ALPHAA => NULL() + SSAA => NULL() + ASYMAA => NULL() + PHAA => NULL() + + END SUBROUTINE RD_AOD +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: calc_aod +! +! !DESCRIPTION: Subroutine CALC\_AOD works out the closest tie points +! in the optics LUT wavelengths and the coefficients required to +! calculate the angstrom exponent for interpolating optics to the requested +! wavelength. If the wavelength requested matches a standard wavelength +! in the LUT then we skip the interpolation (DAR 09/2013) +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CALC_AOD( Input_Opt, State_Chm, RC ) +! +! !USES: +! + USE Input_Opt_Mod, ONLY : OptInput +#ifdef RRTMG + USE PARRRTM, ONLY : NBNDLW +#endif + USE State_Chm_Mod, ONLY : ChmState +! +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(ChmState), INTENT(IN) :: State_Chm +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: RC +! +! !REMARKS: +! Now the user is able to select any 3 wavelengths for optics +! output in the geoschem_config.yml file we need to be able to interpolate +! to those wavelengths based on what is available in the optics +! look-up table. +! . +! The standard lookup table currently has values for +! 11 common wavelengths followed by 30 that are required by RRTMG. +! Only those required to interpolate to user requested +! wavelengths are selected from the standard wavelengths. RRTMG +! wavelengths are not used in the interpolation for AOD output +! (DAR 10/2013) +! . +! UPDATE: because the RT optics output doesnt have access to the +! standard wavelengths we now calculate two sets of values: one +! for the ND21 and diag3 outputs that use the standard wavelengths +! and one for RRTMG diagnostics that interpolate the optics from RRTMG +! wavelengths. Perhaps a switch needs adding to switch off the RT +! optics output (and interpolation) if this ends up costing too +! much and is not used, but it is ideal to have an optics output +! that matches exactly what RRTMG uses to calculate the fluxes +! +! !REVISION HISTORY: +! 18 Jun 2013 - D. Ridley - Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES +! + INTEGER :: MINWV, MAXWV, N, N0, N1, W, NSTEP + INTEGER :: NWVAA, NWVAA0, NWVREQUIRED, NRTWVREQUIRED + REAL(fp) :: WVDIF + + ! Pointers + INTEGER, POINTER :: IWVREQUIRED (:) + INTEGER, POINTER :: IRTWVREQUIRED(:) + INTEGER, POINTER :: IWVSELECT (:,:) + INTEGER, POINTER :: IRTWVSELECT (:,:) + REAL*8, POINTER :: ACOEF_WV (:) + REAL*8, POINTER :: BCOEF_WV (:) + REAL*8, POINTER :: CCOEF_WV (:) + REAL*8, POINTER :: ACOEF_RTWV (:) + REAL*8, POINTER :: BCOEF_RTWV (:) + REAL*8, POINTER :: CCOEF_RTWV (:) + REAL*8, POINTER :: WVAA (:,:) + + !================================================================ + ! CALC_AOD begins here! + !================================================================ + + ! Constants State_Chm%Phot + NWVAA = State_Chm%Phot%NWVAA + NWVAA0 = State_Chm%Phot%NWVAA0 + + ! Scalars in State_Chm%Phot that will be set in this subroutine + NWVREQUIRED = State_Chm%Phot%NWVREQUIRED + NRTWVREQUIRED = State_Chm%Phot%NRTWVREQUIRED + + ! Set pointers + IWVREQUIRED => State_Chm%Phot%IWVREQUIRED + IRTWVREQUIRED => State_Chm%Phot%IRTWVREQUIRED + IWVSELECT => State_Chm%Phot%IWVSELECT + IRTWVSELECT => State_Chm%Phot%IRTWVSELECT + ACOEF_WV => State_Chm%Phot%ACOEF_WV + BCOEF_WV => State_Chm%Phot%BCOEF_WV + CCOEF_WV => State_Chm%Phot%CCOEF_WV + ACOEF_RTWV => State_Chm%Phot%ACOEF_RTWV + BCOEF_RTWV => State_Chm%Phot%BCOEF_RTWV + CCOEF_RTWV => State_Chm%Phot%CCOEF_RTWV + WVAA => State_Chm%Phot%WVAA + + !cycle over standard wavelengths + N0=1 + N1=NWVAA0 + NSTEP=1 + NWVREQUIRED=0 + DO W=1,Input_Opt%NWVSELECT + MINWV = -999 + MAXWV = 999 + DO N=N0,N1,NSTEP ! 1 to 11 + WVDIF = WVAA(N,1)-Input_Opt%WVSELECT(W) + IF ((WVDIF.LE.0).AND.(WVDIF.GT.MINWV)) THEN + MINWV = WVDIF + IWVSELECT(1,W)=N + ENDIF + IF ((WVDIF.GE.0).AND.(WVDIF.LT.MAXWV)) THEN + MAXWV = WVDIF + IWVSELECT(2,W)=N + ENDIF + ENDDO + IF (IWVSELECT(2,W).EQ.IWVSELECT(1,W)) THEN + !we have a match! + MINWV=0 + MAXWV=0 + !add this wavelength to those for output + NWVREQUIRED=NWVREQUIRED+1 + IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) + ELSE + !we are going to have to interpolate to the requested wavelength + NWVREQUIRED=NWVREQUIRED+1 + IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) + NWVREQUIRED=NWVREQUIRED+1 + IWVREQUIRED(NWVREQUIRED)=IWVSELECT(2,W) + ENDIF + + !Error check - ensure we have a match or requested wavelength + !falls within two LUT tie points + IF (MINWV.EQ.-999) THEN + ! requested wavelength is shorter than min wv in LUT + ! set to min + write(6,*) 'ERROR requested wavelength is too short!!' + write(6,*) 'Defaulting to LUT min: ',WVAA(1,1) + IWVSELECT(1,W)=1 + IWVSELECT(2,W)=1 !300nm + NWVREQUIRED=NWVREQUIRED-1 + IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) + ENDIF + IF (MAXWV.EQ.999) THEN + ! requested wavelength is longer than min wv in LUT + ! set to max + write(6,*) 'ERROR requested wavelength is too long!!' + write(6,*) 'Defaulting to LUT min: ',WVAA(NWVAA0,1) + IWVSELECT(1,W)=NWVAA0 + IWVSELECT(2,W)=NWVAA0 !1020nm + NWVREQUIRED=NWVREQUIRED-1 + IWVREQUIRED(NWVREQUIRED)=IWVSELECT(1,W) + ENDIF + + !now calcualte the angstrom exponent coefs for interpolation - + !this is done here to save time and repetition in aerosol_mod.F + IF (IWVSELECT(1,W).NE.IWVSELECT(2,W)) THEN + ACOEF_WV(W) = WVAA(IWVSELECT(2,W),1)/Input_Opt%WVSELECT(W) + BCOEF_WV(W) =1.0d0/(LOG(WVAA(IWVSELECT(2,W),1)/ & + WVAA(IWVSELECT(1,W),1))) + !relative location of selected wavelength between tie points + !for interpolating SSA and ASYM for output in aerosol_mod.F and + !dust_mod.F + CCOEF_WV(W) =(Input_Opt%WVSELECT(W)-WVAA(IWVSELECT(1,W),1))/ & + (WVAA(IWVSELECT(2,W),1)-WVAA(IWVSELECT(1,W),1)) + ENDIF + IF ( Input_Opt%amIRoot ) THEN + write(6,*) 'N WAVELENGTHS: ',Input_Opt%NWVSELECT + write(6,*) 'WAVELENGTH REQUESTED:',Input_Opt%WVSELECT(W) + write(6,*) 'WAVELENGTH REQUIRED:', NWVREQUIRED + !write(6,*) IWVSELECT(1,W),WVAA(IWVSELECT(1,W),1) + !write(6,*) IWVSELECT(2,W),WVAA(IWVSELECT(2,W),1) + !write(6,*) ACOEF_WV(W),BCOEF_WV(W),CCOEF_WV(W) + write(6,*) '*********************************' + ENDIF + ENDDO !Input_Opt%NWVSELECT +#ifdef RRTMG + !repeat for RRTMG wavelengths to get the closest wavelength + !indices and the interpolation coefficients + !Indices are relative to all wavelengths in the LUT i.e. the RRTMG + !wavelengths start at NWVAA0+1 + N0=NWVAA0+1 + N1=NWVAA + NSTEP=1 + NRTWVREQUIRED=0 + DO W=1,Input_Opt%NWVSELECT + MINWV = -999 + MAXWV = 999 + DO N=N0,N1,NSTEP + WVDIF = WVAA(N,1)-Input_Opt%WVSELECT(W) + IF ((WVDIF.LE.0).AND.(WVDIF.GT.MINWV)) THEN + MINWV = WVDIF + IRTWVSELECT(1,W)=N + ENDIF + IF ((WVDIF.GE.0).AND.(WVDIF.LT.MAXWV)) THEN + MAXWV = WVDIF + IRTWVSELECT(2,W)=N + ENDIF + ENDDO + IF (IRTWVSELECT(2,W).EQ.IRTWVSELECT(1,W)) THEN + !we have a match! + MINWV=0 + MAXWV=0 + !add this wavelength to those for output + NRTWVREQUIRED=NRTWVREQUIRED+1 + IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) + ELSE + !we are going to have to interpolate to the requested + !wavelength + NRTWVREQUIRED=NRTWVREQUIRED+1 + IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) + NRTWVREQUIRED=NRTWVREQUIRED+1 + IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(2,W) + ENDIF + + !Error check - ensure we have a match or requested wavelength + !falls within two LUT tie points + IF (MINWV.EQ.-999) THEN + ! requested wavelength is shorter than min wv in LUT + ! set to min + write(6,*) 'ERROR requested wavelength is too short!!' + write(6,*) 'Defaulting to LUT min: ',WVAA(NWVAA-1,1) + IRTWVSELECT(1,W)=NWVAA-1 + IRTWVSELECT(2,W)=NWVAA-1 + NRTWVREQUIRED=NRTWVREQUIRED-1 + IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) + ENDIF + IF (MAXWV.EQ.999) THEN + ! requested wavelength is longer than min wv in LUT + ! set to max + write(6,*) 'ERROR requested wavelength is too long!!' + write(6,*) 'Defaulting to LUT min: ',WVAA(NWVAA0+1,1) + IRTWVSELECT(1,W)=NWVAA0+1 + IRTWVSELECT(2,W)=NWVAA0+1 + NRTWVREQUIRED=NRTWVREQUIRED-1 + IRTWVREQUIRED(NRTWVREQUIRED)=IRTWVSELECT(1,W) + ENDIF + + !now calcualte the angstrom exponent coefs for interpolation - + !this is done here to save time and repetition in aerosol_mod.F + IF (IRTWVSELECT(1,W).NE.IRTWVSELECT(2,W)) THEN + ACOEF_RTWV(W) = WVAA(IRTWVSELECT(2,W),1)/Input_Opt%WVSELECT(W) + BCOEF_RTWV(W) =1.0d0/(LOG(WVAA(IRTWVSELECT(2,W),1)/ & + WVAA(IRTWVSELECT(1,W),1))) + !relative location of selected wavelength between tie points + !for interpolating SSA and ASYM for output in aerosol_mod.F and + !dust_mod.F + CCOEF_RTWV(W) =(Input_Opt%WVSELECT(W)-WVAA(IRTWVSELECT(1,W),1))/ & + (WVAA(IRTWVSELECT(2,W),1)-WVAA(IRTWVSELECT(1,W),1)) + ENDIF + !convert wavelength index to that required by rrtmg_rad_transfer + !i.e. without the standard and LW wavelengths + IRTWVSELECT(1,W) = IRTWVSELECT(1,W) - NWVAA0 - NBNDLW + IRTWVSELECT(2,W) = IRTWVSELECT(2,W) - NWVAA0 - NBNDLW + IF ( Input_Opt%amIRoot ) THEN + write(6,*) 'N RT WAVELENGTHS: ',Input_Opt%NWVSELECT + write(6,*) 'RT WAVELENGTH REQUESTED:',Input_Opt%WVSELECT(W) + write(6,*) 'RT WAVELENGTH REQUIRED:', NRTWVREQUIRED + write(6,*) IRTWVSELECT(1,W),WVAA(IRTWVSELECT(1,W)+NWVAA0+NBNDLW,1) + write(6,*) IRTWVSELECT(2,W),WVAA(IRTWVSELECT(2,W)+NWVAA0+NBNDLW,1) + write(6,*) ACOEF_WV(W),BCOEF_WV(W),CCOEF_WV(W) + write(6,*) '*********************************' + ENDIF + ENDDO !Input_Opt%NWVSELECT +#endif + + ! Copy values back into State_Chm + State_Chm%Phot%NWVREQUIRED = NWVREQUIRED + State_Chm%Phot%NRTWVREQUIRED = NRTWVREQUIRED + + ! Free pointers + IWVREQUIRED => NULL() + IRTWVREQUIRED => NULL() + IWVSELECT => NULL() + IRTWVSELECT => NULL() + ACOEF_WV => NULL() + BCOEF_WV => NULL() + CCOEF_WV => NULL() + ACOEF_RTWV => NULL() + BCOEF_RTWV => NULL() + CCOEF_RTWV => NULL() + WVAA => NULL() + + END SUBROUTINE CALC_AOD +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: set_aer +! +! !DESCRIPTION: Subroutine SET\_AER fills out the array MIEDX. +! Each entry connects a GEOS-Chem aerosol to its Fast-JX counterpart: +! MIEDX(Fast-JX index) = (GC index) +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE SET_AER( Input_Opt, State_Chm, RC ) +! +! !USES: +! +#ifdef CLOUDJ + USE Cldj_Cmn_Mod, ONLY : AN_, NAA, TITLAA +#else + USE CMN_FastJX_Mod, ONLY : AN_, NAA, TITLAA +#endif + USE CMN_SIZE_Mod, ONLY : NRHAER, NRH + USE ErrCode_Mod + USE Input_Opt_Mod, ONLY : OptInput + USE State_Chm_Mod, ONLY : ChmState +! +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options +! +! !INPUT/OUT PARAMETERS: +! + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? +! +! !REVISION HISTORY: +! 31 Mar 2013 - S. D. Eastham - Adapted from J. Mao FJX v6.2 implementation +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=255) :: ErrMsg, ThisLoc + INTEGER :: I, J, K + INTEGER :: IND(NRHAER) + INTEGER, POINTER :: MIEDX(:) + + !================================================================= + ! SER_AER begins here! + !================================================================= + + ! Initialize + RC = GC_SUCCESS + ErrMsg = '' + ThisLoc = ' -> at Set_Aer (in module GeosCore/photolysis_mod.F90)' + + + ! Set pointer + MIEDX => State_Chm%Phot%MIEDX + + ! Taken from aerosol_mod.F + IND = (/22,29,36,43,50/) + + DO I=1,AN_ + MIEDX(I) = 0 + ENDDO + + ! Select Aerosol/Cloud types to be used - define types here + ! Each of these types must be listed in the order used by OPMIE.F + + ! Clouds + MIEDX(1) = 3 ! Black carbon absorber + MIEDX(2) = 10 ! Water Cloud (Deirmenjian 8 micron) + MIEDX(3) = 14 ! Irregular Ice Cloud (Mishchenko) + + ! Dust + MIEDX(4) = 15 ! Mineral Dust .15 micron (rvm, 9/30/00) + MIEDX(5) = 16 ! Mineral Dust .25 micron (rvm, 9/30/00) + MIEDX(6) = 17 ! Mineral Dust .4 micron (rvm, 9/30/00) + MIEDX(7) = 18 ! Mineral Dust .8 micron (rvm, 9/30/00) + MIEDX(8) = 19 ! Mineral Dust 1.5 micron (rvm, 9/30/00) + MIEDX(9) = 20 ! Mineral Dust 2.5 micron (rvm, 9/30/00) + MIEDX(10) = 21 ! Mineral Dust 4.0 micron (rvm, 9/30/00) + + ! Aerosols + DO I=1,NRHAER + DO J=1,NRH + MIEDX(10+((I-1)*NRH)+J)=IND(I)+J-1 + ENDDO + ENDDO + + ! Stratospheric aerosols - SSA/STS and solid PSCs + MIEDX(10+(NRHAER*NRH)+1) = 4 ! SSA/LBS/STS + MIEDX(10+(NRHAER*NRH)+2) = 14 ! NAT/ice PSCs + + ! Ensure all 'AN_' types are valid selections + do i=1,AN_ + IF (Input_Opt%amIRoot) write(6,1000) MIEDX(i),TITLAA(MIEDX(i)) + if (MIEDX(i).gt.NAA.or.MIEDX(i).le.0) then + if (Input_Opt%amIRoot) then + write(6,1200) MIEDX(i),NAA + endif + ErrMsg = 'Bad MIEDX value in "Set_AER"!' + call GC_Error( ErrMsg, RC, ThisLoc ) + return + endif + enddo + + ! Free pointer + MIEDX => NULL() + +1000 format('Using Aerosol type: ',i3,1x,a) +1200 format('Aerosol type ',i3,' unsuitable; supplied values must be ', & + 'between 1 and ',i3) + + END SUBROUTINE SET_AER +!EOC + +END MODULE PHOTOLYSIS_MOD diff --git a/GeosCore/planeflight_mod.F90 b/GeosCore/planeflight_mod.F90 index b7d0c4ff3..5b9ea7a51 100644 --- a/GeosCore/planeflight_mod.F90 +++ b/GeosCore/planeflight_mod.F90 @@ -370,7 +370,6 @@ SUBROUTINE READ_VARIABLES( Input_Opt, State_Chm, IU_FILE, RC ) USE ErrCode_Mod USE ERROR_MOD, ONLY : GEOS_CHEM_STOP USE FILE_MOD, ONLY : IOERROR - USE CMN_Phot_Mod, ONLY : GC_Photo_Id USE Input_Opt_Mod, ONLY : OptInput USE Species_Mod, ONLY : Species USE State_Chm_Mod, ONLY : ChmState @@ -784,10 +783,10 @@ SUBROUTINE READ_VARIABLES( Input_Opt, State_Chm, IU_FILE, RC ) P = -999 ! GEOS-Chem photolyis species ID ! Loop the reaciton branches and find the correct "P" index - DO IK = 1, State_Chm%Photol%nJvalMax + DO IK = 1, State_Chm%Phot%nMaxPhotRxns ! GC photolysis species index - P = GC_Photo_Id(NUM) + P = State_Chm%Phot%GC_Photo_Id(NUM) ! If this FAST_JX photolysis species maps to a valid ! GEOS-Chem photolysis species (for this simulation)... @@ -1503,9 +1502,6 @@ SUBROUTINE PLANEFLIGHT( Input_Opt, State_Chm, State_Diag, & ! ! !USES: ! - USE CMN_Phot_Mod, ONLY : ODAER, QAA_AOD, ODMDUST - USE CMN_Phot_Mod, ONLY : IWVSELECT, ACOEF_WV, BCOEF_WV - USE CMN_FastJX_Mod, ONLY : QAA USE CMN_SIZE_MOD, ONLY : NDUST, NAER USE ErrCode_Mod USE ERROR_MOD, ONLY : GEOS_CHEM_STOP @@ -1583,7 +1579,13 @@ SUBROUTINE PLANEFLIGHT( Input_Opt, State_Chm, State_Diag, & INTEGER :: YEAR, MONTH, DAY, HOUR, MINUTE ! Pointers - TYPE(SpcConc), POINTER :: Spc(:) + TYPE(SpcConc), POINTER :: Spc (:) + INTEGER, POINTER :: IWVSELECT(:,:) + REAL*8, POINTER :: ACOEF_WV (:) + REAL*8, POINTER :: BCOEF_WV (:) + REAL(fp), POINTER :: ODAER (:,:,:,:,:) + REAL(fp), POINTER :: ODMDUST (:,:,:,:,:) + ! ! !DEFINED PARAMETERS: ! @@ -1608,6 +1610,13 @@ SUBROUTINE PLANEFLIGHT( Input_Opt, State_Chm, State_Diag, & ! Return if there is no flighttrack data for today IF ( .not. DO_PF ) RETURN + ! Initialize pointers + IWVSELECT => State_Chm%Phot%IWVSELECT ! Indexes of requested WLs + ACOEF_WV => State_Chm%Phot%ACOEF_WV ! Coeffs for WL interpolation + BCOEF_WV => State_Chm%Phot%BCOEF_WV ! Coeffs for WL interpolation + ODAER => State_Chm%Phot%ODAER ! Aerosol optical depth + ODMDUST => State_Chm%Phot%ODMDUST ! Dust optical depth + ! Update from kyu (03/2015): CHEMSTEP = ( MOD(GET_ELAPSED_SEC(), GET_TS_DIAG() ) == ( GET_TS_DIAG() / 2)) @@ -2325,6 +2334,13 @@ SUBROUTINE PLANEFLIGHT( Input_Opt, State_Chm, State_Diag, & ENDIF ENDDO + ! Free pointers + IWVSELECT => NULL() + ACOEF_WV => NULL() + BCOEF_WV => NULL() + ODAER => NULL() + ODMDUST => NULL() + END SUBROUTINE PLANEFLIGHT !EOC !------------------------------------------------------------------------------ diff --git a/GeosCore/rrtmg_rad_transfer_mod.F90 b/GeosCore/rrtmg_rad_transfer_mod.F90 index d060a1efa..2bf3d9cd3 100644 --- a/GeosCore/rrtmg_rad_transfer_mod.F90 +++ b/GeosCore/rrtmg_rad_transfer_mod.F90 @@ -144,12 +144,6 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & !----------------------------------------------------------------- ! GEOS-Chem modules !----------------------------------------------------------------- - USE CMN_Phot_Mod, ONLY : NSPECRAD ! NUMBER OF SPECIES FOR RT - USE CMN_Phot_Mod, ONLY : NASPECRAD ! NUMBER OF AEROSOL SPECIES - USE CMN_Phot_Mod, ONLY : SPECMASK, IRTWVSELECT - USE CMN_Phot_Mod, ONLY : ACOEF_RTWV, BCOEF_RTWV, CCOEF_RTWV - USE CMN_Phot_Mod, ONLY : WVAA, NWVAA, NWVAA0 - USE CMN_Phot_Mod, ONLY : RTODAER, RTSSAER, RTASYMAER USE ErrCode_Mod USE ERROR_MOD USE Input_Opt_Mod, ONLY : OptInput @@ -231,7 +225,7 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & INTEGER :: OUTIDX,IOUTWV INTEGER :: IB,IBX,IB_SW,IS,NBNDS,NSPEC INTEGER :: IS_ON,NASPECRAD_ON - INTEGER :: IASPECRAD_ON(NASPECRAD) + INTEGER :: IASPECRAD_ON(State_Chm%Phot%NASPECRAD) INTEGER :: BaseIndex REAL*8 :: RHOICE=0.9167, RHOLIQ=1. ! G/CM3 @@ -485,7 +479,16 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & CHARACTER(LEN=255) :: ErrMsg, ThisLoc ! Pointers - TYPE(SpcConc), POINTER :: Spc(:) + TYPE(SpcConc), POINTER :: Spc (:) + INTEGER, POINTER :: SPECMASK (:) + INTEGER, POINTER :: IRTWVSELECT(:,:) + REAL*8, POINTER :: ACOEF_RTWV (:) + REAL*8, POINTER :: BCOEF_RTWV (:) + REAL*8, POINTER :: CCOEF_RTWV (:) + REAL*8, POINTER :: WVAA (:,:) + REAL*8, POINTER :: RTODAER (:,:,:,:,:) + REAL*8, POINTER :: RTSSAER (:,:,:,:,:) + REAL*8, POINTER :: RTASYMAER (:,:,:,:,:) !================================================================= ! DO_RRTMG_RAD_TRANSFER begins here! @@ -496,6 +499,18 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & ErrMsg = '' ThisLoc = ' -> at DO_RRTMG_RAD_TRANSFER (in rrtmg_rad_transfer_mod.F90)' + ! Set pointers + Spc => State_Chm%Species + SPECMASK => State_Chm%Phot%SPECMASK + IRTWVSELECT => State_Chm%Phot%IRTWVSELECT + ACOEF_RTWV => State_Chm%Phot%ACOEF_RTWV + BCOEF_RTWV => State_Chm%Phot%BCOEF_RTWV + CCOEF_RTWV => State_Chm%Phot%CCOEF_RTWV + WVAA => State_Chm%Phot%WVAA + RTODAER => State_Chm%Phot%RTODAER + RTSSAER => State_Chm%Phot%RTSSAER + RTASYMAER => State_Chm%Phot%RTASYMAER + ! Convert species units to kg/kg dry for RRTMG CALL Convert_Spc_Units( Input_Opt, State_Chm, State_Grid, State_Met, & 'kg/kg dry', RC, OrigUnit=OrigUnit ) @@ -538,7 +553,7 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & NASPECRAD_ON = 0 IASPECRAD_ON(:) = 0 - DO N=1,NASPECRAD + DO N=1,State_Chm%Phot%NASPECRAD IF (SPECMASK(N).GT.0) THEN DOAERAD = .TRUE. NASPECRAD_ON = NASPECRAD_ON +1 @@ -611,9 +626,6 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & ENDIF - ! Set pointer to species vector containing concentrations - Spc => State_Chm%Species - !$OMP PARALLEL DO & !$OMP DEFAULT( SHARED ) & !$OMP PRIVATE( I, J, IB ) & @@ -765,13 +777,13 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & !I.E. WE WANT TO RUN WITHOUT THE GAS IF IT HAS BEEN !REQUESTED SO THAT WE CAN DIFFERENCE WITH THE BASELINE RUN - IF (SPECMASK(NASPECRAD+1).EQ.1) THEN + IF (SPECMASK(State_Chm%Phot%NASPECRAD+1).EQ.1) THEN O3VMR(I,J,L) = Spc(id_O3)%Conc(I,J,L) * AIRMW / & State_Chm%SpcData(id_O3)%Info%MW_g ENDIF - IF (SPECMASK(NASPECRAD+2).EQ.1) THEN + IF (SPECMASK(State_Chm%Phot%NASPECRAD+2).EQ.1) THEN CH4VMR(I,J,L) = Spc(id_CH4)%Conc(I,J,L) * AIRMW /& State_Chm%SpcData(id_CH4)%Info%MW_g @@ -828,9 +840,9 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & DO IB = 1,NBNDS !RRTMG WAVEBANDS START AFTER WVAA0 STANDARD WAVELNGTHS IN GC ARRAYS !BASED ON LUT ORDER. JUST APPLY OFFSET - IBX=IB+NWVAA0 + IBX=IB+State_Chm%Phot%NWVAA0 IB_SW = IB-NBNDLW - DO IS = 1,NASPECRAD + DO IS = 1,State_Chm%Phot%NASPECRAD !THE AEROSOL SPECIES WE ARE CURRENTLY CALCULATING FOR WILL BE !SET TO THE LSPECRADMENU VALUE FOR THAT SPECIES. !THIS MEANS THAT RRTMG REQUIRES *ALL OTHER* SPECIES SO THAT THE @@ -1694,7 +1706,17 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & ENDIF ! Nullify pointers - Spc => NULL() + Spc => NULL() + SPECMASK => NULL() + IRTWVSELECT => NULL() + ACOEF_RTWV => NULL() + BCOEF_RTWV => NULL() + CCOEF_RTWV => NULL() + WVAA => NULL() + RTODAER => NULL() + RTSSAER => NULL() + RTASYMAER => NULL() + END SUBROUTINE DO_RRTMG_RAD_TRANSFER !EOC @@ -1717,15 +1739,19 @@ END SUBROUTINE DO_RRTMG_RAD_TRANSFER !\\ ! !INTERFACE: ! - SUBROUTINE Set_SpecMask( iSpecRadMenu ) + SUBROUTINE Set_SpecMask( iSpecRadMenu, State_Chm ) ! ! !USES: ! - USE CMN_Phot_Mod, ONLY : SPECMASK, NSPECRAD, NASPECRAD + USE State_Chm_Mod, ONLY : ChmState ! ! !INPUT PARAMETERS: ! - INTEGER, INTENT(IN) :: iSpecRadMenu ! Index of RRTMG flux output + INTEGER, INTENT(IN) :: iSpecRadMenu ! Index of RRTMG flux output +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry state object ! ! !REVISION HISTORY: ! 18 Jun 2013 - D.A. Ridley - Initial version @@ -1738,6 +1764,9 @@ SUBROUTINE Set_SpecMask( iSpecRadMenu ) ! INTEGER :: N0,N,I,II,NXTRA + ! Pointers + INTEGER, POINTER :: SPECMASK(:) + !================================================================= ! SET_SPECMASK begins here! !================================================================= @@ -1753,7 +1782,10 @@ SUBROUTINE Set_SpecMask( iSpecRadMenu ) !WHERE NXTRA=NUMBER OF NEW SPECIES ADDED ABOVE THE STANDARD CODE !E.G. FOR UCX NSPECRAD=18 AND STS AND NAT ARE INCLUDED !IN RTODAER INDEX 8 AND 9, BEFORE DUST - NXTRA=NSPECRAD-16 + NXTRA = State_Chm%Phot%NSPECRAD - 16 + + ! Set pointer + SPECMASK => State_Chm%Phot%SpecMask !CONVERT THE CURRENT SPECIES SELECTION FROM THE INPUT MENU INTO !THE REQUIRED SPECIES TO BE INCLUDED IN THE RRTMG CALCULATION @@ -1810,7 +1842,7 @@ SUBROUTINE Set_SpecMask( iSpecRadMenu ) ! PM = All particulate matter ! add all aerosols but not gases here CASE( 10 ) - DO II = 1, NASPECRAD + DO II = 1, State_Chm%Phot%NASPECRAD SPECMASK(II)=10 ENDDO @@ -1826,6 +1858,9 @@ SUBROUTINE Set_SpecMask( iSpecRadMenu ) END SELECT ENDIF + ! Nullify pointer + SPECMASK => NULL() + END SUBROUTINE Set_SpecMask !EOC !------------------------------------------------------------------------------ @@ -1966,7 +2001,6 @@ SUBROUTINE Init_Surface_Rad( State_Grid ) ! ! !USES: ! - USE CMN_Phot_Mod USE ERROR_MOD, ONLY : ALLOC_ERR USE State_Grid_Mod, ONLY : GrdState ! @@ -2383,7 +2417,6 @@ SUBROUTINE INIT_MCICA_CLOUDS( State_Grid ) ! ! !USES: ! - USE CMN_Phot_Mod USE ERROR_MOD, ONLY : ALLOC_ERR USE PARRRTM, ONLY : NGPTLW USE PARRRSW, ONLY : NGPTSW diff --git a/GeosCore/ucx_mod.F90 b/GeosCore/ucx_mod.F90 index 99efdb29c..67ab1f4b5 100644 --- a/GeosCore/ucx_mod.F90 +++ b/GeosCore/ucx_mod.F90 @@ -223,7 +223,6 @@ SUBROUTINE UCX_NOX( Input_Opt, State_Chm, State_Grid, State_Met ) ! ! !USES: ! - USE CMN_Phot_Mod, ONLY : ZPJ USE ERROR_MOD, ONLY : ERROR_STOP USE ERROR_MOD, ONLY : DEBUG_MSG USE ERROR_MOD, ONLY : SAFE_DIV @@ -315,6 +314,7 @@ SUBROUTINE UCX_NOX( Input_Opt, State_Chm, State_Grid, State_Met ) ! Pointers TYPE(SpcConc), POINTER :: Spc(:) + REAL(fp), POINTER :: ZPJ(:,:,:,:) ! Required for updated chemistry Integer :: LMinPhot @@ -323,8 +323,9 @@ SUBROUTINE UCX_NOX( Input_Opt, State_Chm, State_Grid, State_Met ) ! UCX_NOX begins here! !================================================================= - ! Point to GEOS-Chem species array + ! Point to GEOS-Chem species array and J-values Spc => State_Chm%Species + ZPJ => State_Chm%Phot%ZPJ ! Retrieve monthly mean data if necessary IF (LASTMONTH.ne.GET_MONTH()) THEN @@ -471,13 +472,13 @@ SUBROUTINE UCX_NOX( Input_Opt, State_Chm, State_Grid, State_Met ) RRATE(1) = 5.1e-12_fp*exp(210.e+0_fp*TINV) ! 4: NO2 + hv -> NO + O1D !RRATE(k_JNO2) = NOX_J(I,J,L,JNO2IDX)*DAYFRAC - RRATE(k_JNO2) = ZPJ(LMINPHOT,State_Chm%Photol%RXN_NO2,I,J) + RRATE(k_JNO2) = ZPJ(LMINPHOT,State_Chm%Phot%RXN_NO2,I,J) ! 5: NO3 + hv -> NO2 + O !RRATE(k_JNO3) = NOX_J(I,J,L,JNO3IDX)*DAYFRAC - RRATE(k_JNO3) = ZPJ(LMINPHOT,State_Chm%Photol%RXN_NO3,I,J) + RRATE(k_JNO3) = ZPJ(LMINPHOT,State_Chm%Phot%RXN_NO3,I,J) ! 6: NO + hv -> N + O !RRATE(k_JNO ) = NOX_J(I,J,L,JNOIDX)*DAYFRAC - RRATE(k_JNO) = ZPJ(LMINPHOT,State_Chm%Photol%RXN_NO,I,J) + RRATE(k_JNO) = ZPJ(LMINPHOT,State_Chm%Phot%RXN_NO,I,J) ! 7: N + NO2 -> N2O + O RRATE(7) = 5.8e-12_fp*exp(220.e+0_fp*TINV) ! 8: N + NO -> N2 + O @@ -490,7 +491,7 @@ SUBROUTINE UCX_NOX( Input_Opt, State_Chm, State_Grid, State_Met ) RRATE(11) = 7.25e-11_fp*exp(20.e+0_fp*TINV) ! 12: N2O + hv -> N2 + O1D !RRATE(k_JN2O) = NOX_J(I,J,L,JN2OIDX)*DAYFRAC - RRATE(k_JN2O) = ZPJ(LMINPHOT,State_Chm%Photol%RXN_N2O,I,J) + RRATE(k_JN2O) = ZPJ(LMINPHOT,State_Chm%Phot%RXN_N2O,I,J) ! Sanity check Where(RRate.lt.0.0e+0_fp) RRate = 0.0e+0_fp @@ -600,8 +601,9 @@ SUBROUTINE UCX_NOX( Input_Opt, State_Chm, State_Grid, State_Met ) CALL DEBUG_MSG(TRIM(DBGMSG)) ENDIF - ! Free pointer + ! Free pointers NULLIFY( Spc ) + NULLIFY( ZPJ ) END SUBROUTINE UCX_NOX !EOC @@ -781,7 +783,6 @@ SUBROUTINE SETTLE_STRAT_AER( Input_Opt, State_Chm, State_Grid, State_Met, RC ) #else USE CMN_FastJX_Mod, ONLY : RAA #endif - USE CMN_Phot_Mod, ONLY : IND999 USE ErrCode_Mod USE ERROR_MOD, ONLY : IT_IS_NAN,ERROR_STOP USE Input_Opt_Mod, ONLY : OptInput @@ -952,7 +953,7 @@ SUBROUTINE SETTLE_STRAT_AER( Input_Opt, State_Chm, State_Grid, State_Met, RC ) ! ewl: need to check if this is correct equivalent to fast-jx RWET(IBC) = RAA(29) * 1.0e-6_fp #else - RWET(IBC) = RAA(IND999,29) * 1.0e-6_fp + RWET(IBC) = RAA(State_Chm%Phot%IND999,29) * 1.0e-6_fp #endif ENDIF @@ -3867,7 +3868,6 @@ SUBROUTINE UCX_H2SO4PHOT( Input_Opt, State_Chm, State_Grid, State_Met ) ! ! !USES: ! - USE CMN_Phot_Mod, ONLY : ZPJ USE Input_Opt_Mod, ONLY : OptInput USE Species_Mod, ONLY : SpcConc USE State_Chm_Mod, ONLY : ChmState @@ -3935,7 +3935,8 @@ SUBROUTINE UCX_H2SO4PHOT( Input_Opt, State_Chm, State_Grid, State_Met ) LMINPHOT = State_Met%ChemGridLev(I,J) ! Retrieve photolysis rate as a fraction of gaseous SO4 - PHOTDELTA = ZPJ(LMINPHOT,State_Chm%Photol%RXN_H2SO4,I,J) * DTCHEM + PHOTDELTA = State_Chm%Phot%ZPJ(LMINPHOT,State_Chm%Phot%RXN_H2SO4,I,J)& + * DTCHEM PHOTDELTA = MIN(1.e+0_fp,PHOTDELTA) DO L=LMINPHOT+1,State_Grid%NZ diff --git a/Headers/CMN_Phot_mod.F90 b/Headers/CMN_Phot_mod.F90 deleted file mode 100644 index 579a4eab7..000000000 --- a/Headers/CMN_Phot_mod.F90 +++ /dev/null @@ -1,374 +0,0 @@ -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !MODULE: CMN_Phot_mod.F90 -! -! !DESCRIPTION: Module CMN\_Phot\_Mod contains parameters and global variables -! related to photolysis and radiative transfer. It is not used to interface -! between Harvard chemistry and UC-Irvine photolysis programs (Fast-J/Fast-JX -! or Cloud-J) but it used to facilitate application of the output of those -! programs within GEOS-Chem. Content in this file previously was in file -! CMN_FJX_MOD.F90 but was moved to this file for development of Cloud-J. -!\\ -!\\ -! !INTERFACE: -! -MODULE CMN_Phot_Mod -! -! !USES: -! -#ifdef CLOUDJ - USE Cldj_Cmn_Mod, ONLY: A_, AN_, JVN_, WX_ -#else - USE CMN_FastJX_Mod, ONLY: A_, AN_, JVN_, WX_ -#endif - USE CMN_SIZE_MOD, ONLY : NDUST, NAER - USE PRECISION_MOD - - IMPLICIT NONE - PUBLIC -! -! !DEFINED PARAMETERS: -! - ! Index in RAA & QAA of 999 nm wavelength - INTEGER, PARAMETER :: IND999 = 5 - - ! Mapping array from Harvard species names to UCI species names - INTEGER :: RINDEX(JVN_) - - ! GEOS-Chem "ModelId" corresponding to each photolysis species - INTEGER :: GC_Photo_Id(JVN_) - - ! Output J values - REAL(fp), ALLOCATABLE :: ZPJ(:,:,:,:) - - !----------------------------------------------------------------------- - ! variables used to map fast-JX J's onto CTM J's - !----------------------------------------------------------------------- - - ! Conversion factors from photons/cm2s to W/m2 - REAL(fp), DIMENSION(WX_) :: UVXFACTOR - - !----------------------------------------------------------------------- - ! Variables in file 'jv_spec_aod.dat' (RD_AOD) - !----------------------------------------------------------------------- - - ! QAA_AOD: Aerosol scattering phase functions - REAL(fp) :: QAA_AOD(A_) - - ! WAA: 5 Wavelengths for the supplied phase functions - REAL(fp) :: WAA_AOD(A_) - - ! PAA: Phase function: first 8 terms of expansion - REAL(fp) :: PAA_AOD(8,A_) - - ! RAA: Effective radius associated with aerosol type - REAL(fp) :: RAA_AOD(A_) - - ! SAA: Single scattering albedo - REAL(fp) :: SAA_AOD(A_) - - !----------------------------------------------------------------------- - ! Variables in file 'atmos_std.dat' (RD_PROF) - !----------------------------------------------------------------------- - - ! T and O3 reference profiles - REAL(fp), DIMENSION(51,18,12) :: TREF, OREF - - ! Interfacing indices for GC and FJX aerosols - INTEGER, ALLOCATABLE :: MIEDX(:) - - ! Dust and aerosol optical depths - REAL(fp), ALLOCATABLE :: ODMDUST(:,:,:,:,:) - REAL(fp), ALLOCATABLE :: ODAER(:,:,:,:,:) - REAL(fp), ALLOCATABLE :: ISOPOD(:,:,:,:) ! eam, 2014 - - !----------------------------------------------------------------------- - ! Variables added for RRTMG (dar, mps, 12/5/14) - !----------------------------------------------------------------------- - - INTEGER, PARAMETER :: NWVAA = 41 !number of wavelengths in LUT - INTEGER, PARAMETER :: NWVAA0 = 11 !number of non-RRTMG wavelengths - INTEGER, PARAMETER :: NWVAART = NWVAA-NWVAA0 !number of RRTMG wvs - INTEGER, PARAMETER :: NRAA = 7 !number of aer sizes in LUT - INTEGER, PARAMETER :: NALBD = 2 - INTEGER, PARAMETER :: NEMISS = 16 - - ! Now set the following in Init_CMN_Phot below (mps, 1/3/18) - INTEGER :: NSPAA !number of species in LUT - INTEGER :: NASPECRAD !aerosol species in RT - INTEGER :: NSPECRAD !aerosol+gas species in RT - - ! Optical arrays read within RD_AOD - REAL*8, ALLOCATABLE :: WVAA(:,:) - REAL*8, ALLOCATABLE :: RHAA(:,:) - REAL*8, ALLOCATABLE :: NRLAA(:,:,:) - REAL*8, ALLOCATABLE :: NCMAA(:,:,:) - REAL*8, ALLOCATABLE :: RDAA(:,:) - REAL*8, ALLOCATABLE :: RWAA(:,:) - REAL*8, ALLOCATABLE :: SGAA(:,:) - REAL*8, ALLOCATABLE :: QQAA(:,:,:) - REAL*8, ALLOCATABLE :: ALPHAA(:,:,:) - REAL*8, ALLOCATABLE :: REAA(:,:) - REAL*8, ALLOCATABLE :: SSAA(:,:,:) - REAL*8, ALLOCATABLE :: ASYMAA(:,:,:) - REAL*8, ALLOCATABLE :: PHAA(:,:,:,:) - - INTEGER :: IWVSELECT(2,3) !index of requested wavelengths - INTEGER :: IRTWVSELECT(2,3) !index of requested RT wavelengths - - ! max of 3 but need 2 per wavelength if interpolating - INTEGER :: NWVREQUIRED !number of wvs required for interpolation - INTEGER :: IWVREQUIRED(6) !index of wavelengths for interpo. - INTEGER :: NRTWVREQUIRED !number of wvs required for RT interpolation - INTEGER :: IRTWVREQUIRED(6) !index of wavelengths for RT interpo. - ! list of required wavelengths, up to max of 3 x 2 - - INTEGER :: IWV1000 !Store the wavelength index for 1000nm for Fast-J - - !coefficients for interpolation of wavelength (and for RT too) - REAL*8 :: ACOEF_WV(3),BCOEF_WV(3),CCOEF_WV(3) - REAL*8 :: ACOEF_RTWV(3),BCOEF_RTWV(3),CCOEF_RTWV(3) - INTEGER, ALLOCATABLE :: SPECMASK(:) !list of binary switches for different - !species flux output - - ! RH indices - INTEGER, ALLOCATABLE :: IRHARR(:,:,:) - -#ifdef RRTMG - !to pass to RT code - !one for each hydrophilic/hydrophobic aerosol and optical dust bin - !and also sulfate, nitrate and ammonia are separate too - REAL*8, ALLOCATABLE :: RTODAER(:,:,:,:,:) - REAL*8, ALLOCATABLE :: RTSSAER(:,:,:,:,:) - REAL*8, ALLOCATABLE :: RTASYMAER(:,:,:,:,:) -#endif - -CONTAINS -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: Init_Cmn_Phot -! -! !DESCRIPTION: Routine INIT\_CMN\_Phot initializes quantities based on -! the grid-independent size parameters. -!\\ -!\\ -! !INTERFACE: - - SUBROUTINE Init_CMN_Phot( Input_Opt, State_Grid, RC ) -! -! !USES: -! - USE ErrCode_Mod - USE Input_Opt_Mod, ONLY : OptInput - USE State_Grid_Mod, ONLY : GrdState -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object - TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Success or failure? -! -! !REVISION HISTORY: -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - - !================================================================= - ! INIT_CMN_Phot begins here! - !================================================================= - - ! For RRTMG: - NSPAA = 8 ! number of species in LUT - NASPECRAD = 16 ! aerosol species in RT - NSPECRAD = 18 ! aerosol+gas species in RT - - IF ( .not. Input_Opt%DryRun ) THEN - !----------------------------------------------------------------------- - ! Allocate arrays - !----------------------------------------------------------------------- - - ALLOCATE( ZPJ( State_Grid%NZ, JVN_, State_Grid%NX, State_Grid%NY), & - STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - ZPJ = 0e+0_fp - - ALLOCATE( ODMDUST( State_Grid%NX, State_Grid%NY, State_Grid%NZ, & - NWVAA, NDUST), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - ODMDUST = 0e+0_fp - - ALLOCATE( ODAER( State_Grid%NX, State_Grid%NY, State_Grid%NZ, NWVAA, NAER),& - STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - ODAER = 0e+0_fp - - ALLOCATE( MIEDX(AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - MIEDX = 0 - - ! Allocate array for isoprene SOA AOD (eam, 2014): - ALLOCATE( ISOPOD( State_Grid%NX, State_Grid%NY, State_Grid%NZ, NWVAA), & - STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - ISOPOD = 0e+0_fp - - !----------------------------------------------------------------------- - ! Variables added for RRTMG (dar, mps, 12/5/14) - !----------------------------------------------------------------------- - - ALLOCATE( IRHARR( State_Grid%NX, State_Grid%NY, State_Grid%NZ ), & - STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - IRHARR = 0d0 - - ALLOCATE( WVAA(NWVAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - WVAA = 0d0 - - ALLOCATE( RHAA(NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - RHAA = 0d0 - - ALLOCATE( NRLAA(NWVAA,NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - NRLAA = 0d0 - - ALLOCATE( NCMAA(NWVAA,NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - NCMAA = 0d0 - - ALLOCATE( RDAA(NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - RDAA = 0d0 - - ALLOCATE( RWAA(NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - RWAA = 0d0 - - ALLOCATE( SGAA(NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - SGAA = 0d0 - - ALLOCATE( QQAA(NWVAA,NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - QQAA = 0d0 - - ALLOCATE( ALPHAA(NWVAA,NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - ALPHAA = 0d0 - - ALLOCATE( REAA(NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - REAA = 0d0 - - ALLOCATE( SSAA(NWVAA,NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - SSAA = 0d0 - - ALLOCATE( ASYMAA(NWVAA,NRAA,NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - ASYMAA = 0d0 - - ALLOCATE( PHAA(NWVAA,NRAA,NSPAA,8), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - PHAA = 0d0 - - ALLOCATE( SPECMASK(NSPECRAD), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - SPECMASK = 0 - -#ifdef RRTMG - ! +2 to split SNA into SU, NI and AM - ALLOCATE( RTODAER( State_Grid%NX, State_Grid%NY, State_Grid%NZ, & - NWVAA,NAER+2+NDUST), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - RTODAER = 0d0 - - ALLOCATE( RTSSAER( State_Grid%NX, State_Grid%NY, State_Grid%NZ, & - NWVAA, NAER+2+NDUST ), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - RTSSAER = 0d0 - - ALLOCATE( RTASYMAER( State_Grid%NX, State_Grid%NY, State_Grid%NZ, & - NWVAA, NAER+2+NDUST ), STAT=RC ) - IF ( RC /= GC_SUCCESS ) RETURN - RTASYMAER = 0d0 -#endif - ENDIF - - ! Return w/ success - RC = GC_SUCCESS - - END SUBROUTINE Init_CMN_Phot -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: Cleanup_Cmn_Phot -! -! !DESCRIPTION: Subroutine CLEANUP\_CMN\_Phot deallocates all module arrays. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE Cleanup_CMN_Phot( RC ) -! -! !USES: -! - USE ErrCode_Mod -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Success or failure? -! -! !REVISION HISTORY: -! 21 Feb 2014 - M. Sulprizio- Initial version -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - IF ( ALLOCATED( ZPJ ) ) DEALLOCATE( ZPJ ) - IF ( ALLOCATED( ODMDUST ) ) DEALLOCATE( ODMDUST ) - IF ( ALLOCATED( ODAER ) ) DEALLOCATE( ODAER ) - IF ( ALLOCATED( MIEDX ) ) DEALLOCATE( MIEDX ) - IF ( ALLOCATED( ISOPOD ) ) DEALLOCATE( ISOPOD ) - IF ( ALLOCATED( IRHARR ) ) DEALLOCATE( IRHARR ) - IF ( ALLOCATED( WVAA ) ) DEALLOCATE( WVAA ) - IF ( ALLOCATED( RHAA ) ) DEALLOCATE( RHAA ) - IF ( ALLOCATED( NRLAA ) ) DEALLOCATE( NRLAA ) - IF ( ALLOCATED( NCMAA ) ) DEALLOCATE( NCMAA ) - IF ( ALLOCATED( RDAA ) ) DEALLOCATE( RDAA ) - IF ( ALLOCATED( RWAA ) ) DEALLOCATE( RWAA ) - IF ( ALLOCATED( SGAA ) ) DEALLOCATE( SGAA ) - IF ( ALLOCATED( QQAA ) ) DEALLOCATE( QQAA ) - IF ( ALLOCATED( ALPHAA ) ) DEALLOCATE( ALPHAA ) - IF ( ALLOCATED( REAA ) ) DEALLOCATE( REAA ) - IF ( ALLOCATED( SSAA ) ) DEALLOCATE( SSAA ) - IF ( ALLOCATED( ASYMAA ) ) DEALLOCATE( ASYMAA ) - IF ( ALLOCATED( PHAA ) ) DEALLOCATE( PHAA ) - IF ( ALLOCATED( SPECMASK ) ) DEALLOCATE( SPECMASK ) -#ifdef RRTMG - IF ( ALLOCATED( RTODAER ) ) DEALLOCATE( RTODAER ) - IF ( ALLOCATED( RTSSAER ) ) DEALLOCATE( RTSSAER ) - IF ( ALLOCATED( RTASYMAER ) ) DEALLOCATE( RTASYMAER ) -#endif - - ! Return successfully - RC = GC_SUCCESS - - END SUBROUTINE Cleanup_CMN_Phot -!EOC -END MODULE CMN_Phot_Mod diff --git a/Headers/CMakeLists.txt b/Headers/CMakeLists.txt index 3f846e702..9cc18494e 100755 --- a/Headers/CMakeLists.txt +++ b/Headers/CMakeLists.txt @@ -8,7 +8,6 @@ add_library(Headers charpak_mod.F90 CMN_DIAG_mod.F90 CMN_FastJX_mod.F90 - CMN_Phot_mod.F90 CMN_O3_mod.F90 CMN_SIZE_mod.F90 diaglist_mod.F90 @@ -17,7 +16,7 @@ add_library(Headers errcode_mod.F90 input_opt_mod.F90 inquireMod.F90 - photol_obj_mod.F90 + phot_container_mod.F90 physconstants.F90 precision_mod.F90 qfyaml_mod.F90 diff --git a/Headers/phot_container_mod.F90 b/Headers/phot_container_mod.F90 new file mode 100644 index 000000000..05fc9df3c --- /dev/null +++ b/Headers/phot_container_mod.F90 @@ -0,0 +1,784 @@ +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: phot_container_mod.F90 +! +! !DESCRIPTION: Module PHOT\_CONTAINER\_MOD contains the derived type used +! to store photolysis and optics data in GEOS-Chem. +!\\ +!\\ +! !INTERFACE: +! +MODULE Phot_Container_Mod +! +! USES: +! + USE ErrCode_Mod + USE Precision_Mod + + IMPLICIT NONE + PRIVATE +! +! !PUBLIC MEMBER FUNCTIONS: +! + PUBLIC :: Init_Phot_Container + PUBLIC :: Cleanup_Phot_Container +! +! !PUBLIC DATA MEMBERS: +! + ! Parameters used for allocation + + !========================================================================= + ! Derived type for photolysis and optics data container + !========================================================================= + TYPE, PUBLIC :: PhotContainer + + ! Scalars set during object initialization + INTEGER :: IND999 ! Index in RAA & QAA of 999 nm + INTEGER :: NWVAA ! # LUT wavelengths (RRTMG) + INTEGER :: NSPAA ! # LUT species (RRTMG) + INTEGER :: NRAA ! # LUT aerosol sizes (RRTMG) + INTEGER :: NWVAA0 ! # non-RRTMG wavelengths + INTEGER :: NALBD ! ?? + INTEGER :: NEMISS ! ?? + INTEGER :: NASPECRAD ! # RRTMG aerosol species + INTEGER :: NSPECRAD ! # RRTMG aerosol+gas species + + ! Scalars + INTEGER :: JTAUMX ! max # divisions + + ! For RRTMG? + INTEGER :: NWVAART ! # RRTMG wavelengths + INTEGER :: NWVREQUIRED ! # WLs needed for interpolation + INTEGER :: NRTWVREQUIRED! # WLs needed for RT interpolation + INTEGER :: IWV1000 ! WL index for 1000 nm + + ! Renamed from Fast-JX/Cloud-J module variables for clarity + INTEGER :: nWLbins ! # WL bins (W_) + INTEGER :: nPhotRxns ! # photolysis reactions in CTM chemistry (NRATJ) + INTEGER :: nMaxPhotRxns ! Maximum # of photolysis reactions (JVN_?) + + ! Photo-reaction flags for reactions adjusted in PhotRate_Adj + INTEGER :: RXN_O2 ! O2 + jv --> O + O + INTEGER :: RXN_O3_1 ! O3 + hv --> O2 + O + INTEGER :: RXN_O3_2 ! O3 + hv --> O2 + O(1D) + INTEGER :: RXN_H2SO4 ! SO4 + hv --> SO2 + 2OH + INTEGER :: RXN_NO2 ! NO2 + hv --> NO + O + INTEGER :: RXN_JHNO3 ! HNO3 + hv --> OH + NO2 + INTEGER :: RXN_JNITSa ! NITs + hv --> HNO2 + INTEGER :: RXN_JNITSb ! NITs + hv --> NO2 + INTEGER :: RXN_JNITa ! NIT + hv --> HNO2 + INTEGER :: RXN_JNITb ! NIT + hv --> NO2 + INTEGER :: RXN_NO ! For ucx_mod + INTEGER :: RXN_NO3 ! For ucx_mod + INTEGER :: RXN_N2O ! For ucx_mod + INTEGER :: RXN_BrO ! For Hg chem + INTEGER :: RXN_ClO ! For Hg chem + + ! Arrays + INTEGER, ALLOCATABLE :: RINDEX (:) ! GC to UCI spc name index mapping + INTEGER, ALLOCATABLE :: GC_Photo_Id(:) ! GC id per photolysis species + INTEGER, ALLOCATABLE :: MIEDX (:) ! Interface indices for GC/FJX spc + + REAL(fp), ALLOCATABLE :: UVXFACTOR(:) ! Photons/cm2s -> W/m2 conv factors + REAL(fp), ALLOCATABLE :: QAA_AOD (:) ! Single scattering albedo + REAL(fp), ALLOCATABLE :: WAA_AOD (:) ! Aerosol scattering phase fnctns + REAL(fp), ALLOCATABLE :: PAA_AOD (:) ! WLs for supplied phase functions + REAL(fp), ALLOCATABLE :: RAA_AOD (:) ! Phase fnctn (first 8 terms) + REAL(fp), ALLOCATABLE :: SAA_AOD (:) ! Aerosol type effective radius + + REAL(fp), ALLOCATABLE :: TREF (:,:,:) ! Temp reference profile + REAL(fp), ALLOCATABLE :: OREF (:,:,:) ! Ozone reference profile + REAL(fp), ALLOCATABLE :: ZPJ (:,:,:,:) ! J-values + + ! RRTMG allocatable arrays + INTEGER, ALLOCATABLE :: SPECMASK (:) ! binary switches for spc flux + INTEGER, ALLOCATABLE :: IWVREQUIRED (:) ! WL indexes for interpolation + INTEGER, ALLOCATABLE :: IRTWVREQUIRED(:) ! WL indexes for RT interp + INTEGER, ALLOCATABLE :: IWVSELECT (:,:) ! Indexes of requested WLs + INTEGER, ALLOCATABLE :: IRTWVSELECT (:,:) ! Indexes of requested RT WLs + INTEGER, ALLOCATABLE :: IRHARR (:,:,:) ! Relative humidity indices + + REAL*8, ALLOCATABLE :: ACOEF_WV (:) ! Coeffs for WL interpolation + REAL*8, ALLOCATABLE :: BCOEF_WV (:) ! Coeffs for WL interpolation + REAL*8, ALLOCATABLE :: CCOEF_WV (:) ! Coeffs for WL interpolation + REAL*8, ALLOCATABLE :: ACOEF_RTWV(:) ! Coeffs for RT WL interpolation + REAL*8, ALLOCATABLE :: BCOEF_RTWV(:) ! Coeffs for RT WL interpolation + REAL*8, ALLOCATABLE :: CCOEF_RTWV(:) ! Coeffs for RT WL interpolation + REAL*8, ALLOCATABLE :: WVAA (:,:) ! ?? + REAL*8, ALLOCATABLE :: RHAA (:,:) ! ?? + REAL*8, ALLOCATABLE :: RDAA (:,:) ! ?? + REAL*8, ALLOCATABLE :: RWAA (:,:) ! ?? + REAL*8, ALLOCATABLE :: SGAA (:,:) ! ?? + REAL*8, ALLOCATABLE :: REAA (:,:) ! ?? + REAL*8, ALLOCATABLE :: NRLAA (:,:,:) ! ?? + REAL*8, ALLOCATABLE :: NCMAA (:,:,:) ! ?? + REAL*8, ALLOCATABLE :: QQAA (:,:,:) ! ?? + REAL*8, ALLOCATABLE :: ALPHAA (:,:,:) ! ?? + REAL*8, ALLOCATABLE :: SSAA (:,:,:) ! ?? + REAL*8, ALLOCATABLE :: ASYMAA (:,:,:) ! ?? + REAL*8, ALLOCATABLE :: PHAA (:,:,:,:) ! ?? + + ! For optical depth diagnostics + REAL(fp), ALLOCATABLE :: ISOPOD (:,:,:,:) ! Isoprene optical depth + REAL(fp), ALLOCATABLE :: ODMDUST (:,:,:,:,:) ! Dust optical depth + REAL(fp), ALLOCATABLE :: ODAER (:,:,:,:,:) ! Aerosol optical depth + +#ifdef RRTMG + REAL*8, ALLOCATABLE :: RTODAER (:,:,:,:,:) ! Optical dust + REAL*8, ALLOCATABLE :: RTSSAER (:,:,:,:,:) ! ?? + REAL*8, ALLOCATABLE :: RTASYMAER (:,:,:,:,:) ! ?? +#endif + + END TYPE PhotContainer +! +! !REMARKS: +! Acronyms used in this file (may appear as upper or lower-case): +! CLDJ : Cloud-J +! CONV : conversion +! EFF : effective +! FJX : Fast-JX +! FLX : flux +! FNCTN : function +! GC : GEOS-Chem +! LUT : look-up table +! RT : radiative transfer +! RXN : reaction +! SPC : species +! TEMP : temperature +! TOA : top-of-atmosphere +! UCI : University of California, Irvine +! WL : wavelegnth +! Xs : cross-section +! X-section : cross-section +! +! !REVISION HISTORY: +! 28 Nov 2022 - E. Lundgren- Initial version, based on state_grid_mod.F90 +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +CONTAINS +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Init_Phot_Container +! +! !DESCRIPTION: Subroutine INIT\_PHOT\_Container allocates and initializes +! the Phot container object. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Init_Phot_Container( Input_Opt, State_Grid, Phot, RC ) +! +! !USES: +! +#ifdef CLOUDJ + USE Cldj_Cmn_Mod, ONLY : A_, AN_, W_, WX_, JVN_, N_, JXL_ +#else + USE CMN_FastJX_Mod, ONLY : A_, AN_, W_, WX_, JVN_, N_, JXL_ +#endif + USE CMN_Size_Mod, ONLY : NDUST, NAER + USE ErrCode_Mod + USE Input_Opt_Mod, ONLY : OptInput + USE State_Grid_Mod, ONLY : GrdState +! +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid object +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(PhotContainer), POINTER :: Phot ! Phot data container +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? +! +! !REVISION HISTORY: +! 28 Nov 2022 - E. Lundgren- Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=255) :: errMsg, thisLoc + + !====================================================================== + ! Allocate and initialize module variables + !====================================================================== + + ! Assume success + RC = GC_SUCCESS + thisLoc = ' -> at Init_Phot_Container (in module Headers/phot_container_mod.F90)' + + ! Constants + Phot%IND999 = 5 ! Index in RAA & QAA of 999 nm + Phot%NWVAA = 41 ! # LUT wavelengths (RRTMG) + Phot%NSPAA = 8 ! # LUT species (RRTMG) + Phot%NRAA = 7 ! # LUT aerosol sizes (RRTMG) + Phot%NWVAA0 = 11 ! # non-RRTMG wavelengths + Phot%NALBD = 2 ! ?? + Phot%NEMISS = 16 ! ?? + Phot%NASPECRAD = 16 ! # RRTMG aerosol species + Phot%NSPECRAD = 18 ! # RRTMG aerosol+gas species + + ! Store certain values from Fast-JX/Cloud-J with more intuitive name + Phot%nWLbins = W_ + Phot%nPhotRxns = 0 ! Is set in ___ (ewl) + + ! Integer scalars + Phot%JTAUMX = (N_-4*JXL_)/2 + + Phot%RXN_O2 = -1 + Phot%RXN_O3_1 = -1 + Phot%RXN_O3_2 = -1 + Phot%RXN_H2SO4 = -1 + Phot%RXN_NO2 = -1 + Phot%RXN_JHNO3 = -1 + Phot%RXN_JNITSa = -1 + Phot%RXN_JNITSb = -1 + Phot%RXN_JNITa = -1 + Phot%RXN_JNITb = -1 + Phot%RXN_NO = -1 + Phot%RXN_NO3 = -1 + Phot%RXN_N2O = -1 + Phot%RXN_BrO = -1 + Phot%RXN_ClO = -1 + + ! Allocate arrays + IF ( .not. Input_Opt%DryRun ) THEN + + ! Integer arrays + + ! Phot%RINDEX (:) + ALLOCATE( Phot%RINDEX(JVN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array RINDEX!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%RINDEX = 0 + + ! Phot%GC_Photo_Id (:) + ALLOCATE( Phot%GC_Photo_Id(JVN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array GC_Photo_Id!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%GC_Photo_Id = 0 + + ! Phot%MIEDX (:) + ALLOCATE( Phot%MIEDX(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array MIEDX!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%MIEDX = 0 + + ! Real(fp) arrays + + ! Phot%UVXFACTOR(:) + ALLOCATE( Phot%UVXFACTOR(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array UVXFACTOR!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%UVXFACTOR = 0e+0_fp + + ! Phot%QAA_AOD (:) + ALLOCATE( Phot%QAA_AOD(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array QAA_AOD!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%QAA_AOD = 0e+0_fp + + ! Phot%WAA_AOD (:) + ALLOCATE( Phot%WAA_AOD(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array WAA_AOD!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%WAA_AOD = 0e+0_fp + + ! Phot%PAA_AOD (:) + ALLOCATE( Phot%PAA_AOD(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array PAA_AOD!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%PAA_AOD = 0e+0_fp + + ! Phot%RAA_AOD (:) + ALLOCATE( Phot%RAA_AOD(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array RAA_AOD!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%RAA_AOD = 0e+0_fp + + ! Phot%SAA_AOD (:) + ALLOCATE( Phot%SAA_AOD(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array SAA_AOD!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%SAA_AOD = 0e+0_fp + + ! Phot%TREF (:,:,:) + ALLOCATE( Phot%TREF(51,18,12), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array TREF!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%TREF = 0e+0_fp + + ! Phot%OREF (:,:,:) + ALLOCATE( Phot%OREF(51,18,12), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array OREF!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%OREF = 0e+0_fp + + ! Phot%ZPJ (:,:,:,:) + ALLOCATE( Phot%ZPJ( State_Grid%NZ, JVN_, State_Grid%NX, & + State_Grid%NY), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array ZPJ!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%ZPJ = 0e+0_fp + + ENDIF + + !-------------------------------------------------- + ! Fields for RRTMG and optical depth diagnostics + !-------------------------------------------------- + + ! Other scalars + Phot%NWVAART = Phot%NWVAA-Phot%NWVAA0 ! # RRTMG wavelengths + + ! Scalars set in subroutine CALC_AOD + Phot%NWVREQUIRED = 0 + Phot%NRTWVREQUIRED = 0 + + ! Scalars set in subroutine RD_AOD + Phot%IWV1000 = 0 + + ! Allocate arrays + IF ( .not. Input_Opt%DryRun ) THEN + + ! RRTMG integer arrays + + ! Phot%SPECMASK (:) + ALLOCATE( Phot%SPECMASK(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array SPECMASK!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%SPECMASK = 0 + + ! Phot%IWVREQUIRED (:) + ALLOCATE( Phot%IWVREQUIRED(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array IWVREQUIRED!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%IWVREQUIRED = 0 + + ! Phot%IRTWVREQUIRED(:) + ALLOCATE( Phot%IRTWVREQUIRED(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array IRTWVREQUIRED!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%IRTWVREQUIRED = 0 + + ! Phot%IWVSELECT (:,:) + ALLOCATE( Phot%IWVSELECT(2,3), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array IWVSELECT!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%IWVSELECT = 0 + + ! Phot%IRTWVSELECT (:,:) + ALLOCATE( Phot%IRTWVSELECT(2,3), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array IRTWVSELECT!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%IRTWVSELECT = 0 + + ! Phot%IRHARR (:,:,:) + ALLOCATE( Phot%IRHARR( State_Grid%NX, State_Grid%NY, & + State_Grid%NZ ), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array IRHARR!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%IRHARR = 0d0 + + ! RRTMG real*8 arrays + + ! Phot%ACOEF_WV (:) + ALLOCATE( Phot%ACOEF_WV(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array ACOEF_WV!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%ACOEF_WV = 0d0 + + ! Phot%BCOEF_WV (:) + ALLOCATE( Phot%BCOEF_WV(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array BCOEF_WV!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%BCOEF_WV = 0d0 + + ! Phot%CCOEF_WV (:) + ALLOCATE( Phot%CCOEF_WV(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array CCOEF_WV!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%CCOEF_WV = 0d0 + + ! Phot%ACOEF_RTWV(:) + ALLOCATE( Phot%ACOEF_RTWV(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array ACOEF_RTWV!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%ACOEF_RTWV = 0d0 + + ! Phot%BCOEF_RTWV(:) + ALLOCATE( Phot%BCOEF_RTWV(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array BCOEF_RTWV!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%BCOEF_RTWV = 0d0 + + ! Phot%CCOEF_RTWV(:) + ALLOCATE( Phot%CCOEF_RTWV(AN_), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array CCOEF_RTWV!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%CCOEF_RTWV = 0d0 + + ! Phot%WVAA (:,:) + ALLOCATE( Phot%WVAA(Phot%NWVAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array WVAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%WVAA = 0d0 + + ! Phot%RHAA (:,:) + ALLOCATE( Phot%RHAA(Phot%NRAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array RHAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%RHAA = 0d0 + + ! Phot%RDAA (:,:)! + ALLOCATE( Phot%RDAA(Phot%NRAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array RDAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%RDAA = 0d0 + + ! Phot%RWAA (:,:) + ALLOCATE( Phot%RWAA(Phot%NRAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array RWAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%RWAA = 0d0 + + ! Phot%SGAA (:,:) + ALLOCATE( Phot%SGAA(Phot%NRAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array SGAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%SGAA = 0d0 + + ! Phot%REAA (:,:) + ALLOCATE( Phot%REAA(Phot%NRAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array REAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%REAA = 0d0 + + ! Phot%NRLAA (:,:,:) + ALLOCATE( Phot%NRLAA(Phot%NWVAA,Phot%NRAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array NRLAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%NRLAA = 0d0 + + ! Phot%NCMAA (:,:,:) + ALLOCATE( Phot%NCMAA(Phot%NWVAA,Phot%NRAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array NCMAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%NCMAA = 0d0 + + ! Phot%QQAA (:,:,:) + ALLOCATE( Phot%QQAA(Phot%NWVAA,Phot%NRAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array QQAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%QQAA = 0d0 + + ! Phot%ALPHAA (:,:,:) + ALLOCATE( Phot%ALPHAA(Phot%NWVAA,Phot%NRAA,Phot%NSPAA), & + STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array ALPHAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%ALPHAA = 0d0 + + ! Phot%SSAA (:,:,:) + ALLOCATE( Phot%SSAA(Phot%NWVAA,Phot%NRAA,Phot%NSPAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array SSAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%SSAA = 0d0 + + ! Phot%ASYMAA (:,:,:) + ALLOCATE( Phot%ASYMAA(Phot%NWVAA,Phot%NRAA,Phot%NSPAA), & + STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array ASYMAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%ASYMAA = 0d0 + + ! Phot%PHAA (:,:,:,:) + ALLOCATE( Phot%PHAA(Phot%NWVAA,Phot%NRAA,Phot%NSPAA,8), & + STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array PHAA!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%PHAA = 0d0 + + ! Phot%ISOPOD (:,:,:,:) + ALLOCATE( Phot%ISOPOD( State_Grid%NX, State_Grid%NY, & + State_Grid%NZ, Phot%NWVAA), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array ISOPOD!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%ISOPOD = 0e+0_fp + + ! Phot%ODMDUST (:,:,:,:,:) + ALLOCATE( Phot%ODMDUST( State_Grid%NX, State_Grid%NY, & + State_Grid%NZ, Phot%NWVAA, NDUST), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array ODMDUST!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%ODMDUST = 0e+0_fp + + ! Phot%ODAER (:,:,:,:,:) + ALLOCATE( Phot%ODAER( State_Grid%NX, State_Grid%NY, & + State_Grid%NZ, Phot%NWVAA, NAER), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array ODAER!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%ODAER = 0e+0_fp + +#ifdef RRTMG + ! Phot%RTODAER (:,:,:,:,:) + ! +2 to split SNA into SU, NI and AM + ALLOCATE( Phot%RTODAER( State_Grid%NX, State_Grid%NY, & + State_Grid%NZ, Phot%NWVAA,NAER+2+NDUST), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array RTODAER!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%RTODAER = 0d0 + + ! Phot%RTSSAER (:,:,:,:,:) + ALLOCATE( Phot%RTSSAER( State_Grid%NX, State_Grid%NY, & + State_Grid%NZ, Phot%NWVAA, NAER+2+NDUST ), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array RTSSAER!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%RTSSAER = 0d0 + + ! Phot%RTASYMAER (:,:,:,:,:) + ALLOCATE( Phot%RTASYMAER( State_Grid%NX, State_Grid%NY, & + State_Grid%NZ, Phot%NWVAA, NAER+2+NDUST ), STAT=RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error allocating array RTASYMAER!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Phot%RTASYMAER = 0d0 +#endif + + ENDIF + + END SUBROUTINE Init_Phot_Container +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Cleanup_Phot_Container +! +! !DESCRIPTION: Subroutine CLEANUP\_PHOT\_CONTAINER deallocates all fields +! of the phot container object. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Cleanup_Phot_Container( Phot, RC ) +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(PhotContainer), POINTER :: Phot ! Phot data container +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Return code +! +! !REVISION HISTORY: +! 28 Nov 2022 - E. Lundgren- Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC + + ! Assume success + RC = GC_SUCCESS + + !======================================================================= + ! Deallocate arrays + !======================================================================= + ! Will need to change this to just do arrays etc + IF ( ASSOCIATED( Phot ) ) THEN + IF (ALLOCATED(Phot%RINDEX )) DEALLOCATE(Phot%RINDEX ) + IF (ALLOCATED(Phot%GC_Photo_Id )) DEALLOCATE(Phot%GC_Photo_Id ) + IF (ALLOCATED(Phot%MIEDX )) DEALLOCATE(Phot%MIEDX ) + IF (ALLOCATED(Phot%UVXFACTOR )) DEALLOCATE(Phot%UVXFACTOR ) + IF (ALLOCATED(Phot%QAA_AOD )) DEALLOCATE(Phot%QAA_AOD ) + IF (ALLOCATED(Phot%WAA_AOD )) DEALLOCATE(Phot%WAA_AOD ) + IF (ALLOCATED(Phot%PAA_AOD )) DEALLOCATE(Phot%PAA_AOD ) + IF (ALLOCATED(Phot%RAA_AOD )) DEALLOCATE(Phot%RAA_AOD ) + IF (ALLOCATED(Phot%SAA_AOD )) DEALLOCATE(Phot%SAA_AOD ) + IF (ALLOCATED(Phot%TREF )) DEALLOCATE(Phot%TREF ) + IF (ALLOCATED(Phot%OREF )) DEALLOCATE(Phot%OREF ) + IF (ALLOCATED(Phot%ISOPOD )) DEALLOCATE(Phot%ISOPOD ) + IF (ALLOCATED(Phot%ZPJ )) DEALLOCATE(Phot%ZPJ ) + IF (ALLOCATED(Phot%ODMDUST )) DEALLOCATE(Phot%ODMDUST ) + IF (ALLOCATED(Phot%ODAER )) DEALLOCATE(Phot%ODAER ) + IF (ALLOCATED(Phot%SPECMASK )) DEALLOCATE(Phot%SPECMASK ) + IF (ALLOCATED(Phot%IWVREQUIRED )) DEALLOCATE(Phot%IWVREQUIRED ) + IF (ALLOCATED(Phot%IRTWVREQUIRED )) DEALLOCATE(Phot%IRTWVREQUIRED ) + IF (ALLOCATED(Phot%IWVSELECT )) DEALLOCATE(Phot%IWVSELECT ) + IF (ALLOCATED(Phot%IRTWVSELECT )) DEALLOCATE(Phot%IRTWVSELECT ) + IF (ALLOCATED(Phot%IRHARR )) DEALLOCATE(Phot%IRHARR ) + IF (ALLOCATED(Phot%ACOEF_WV )) DEALLOCATE(Phot%ACOEF_WV ) + IF (ALLOCATED(Phot%BCOEF_WV )) DEALLOCATE(Phot%BCOEF_WV ) + IF (ALLOCATED(Phot%CCOEF_WV )) DEALLOCATE(Phot%CCOEF_WV ) + IF (ALLOCATED(Phot%ACOEF_RTWV )) DEALLOCATE(Phot%ACOEF_RTWV ) + IF (ALLOCATED(Phot%BCOEF_RTWV )) DEALLOCATE(Phot%BCOEF_RTWV ) + IF (ALLOCATED(Phot%CCOEF_RTWV )) DEALLOCATE(Phot%CCOEF_RTWV ) + IF (ALLOCATED(Phot%WVAA )) DEALLOCATE(Phot%WVAA ) + IF (ALLOCATED(Phot%RHAA )) DEALLOCATE(Phot%RHAA ) + IF (ALLOCATED(Phot%RDAA )) DEALLOCATE(Phot%RDAA ) + IF (ALLOCATED(Phot%RWAA )) DEALLOCATE(Phot%RWAA ) + IF (ALLOCATED(Phot%SGAA )) DEALLOCATE(Phot%SGAA ) + IF (ALLOCATED(Phot%REAA )) DEALLOCATE(Phot%REAA ) + IF (ALLOCATED(Phot%NRLAA )) DEALLOCATE(Phot%NRLAA ) + IF (ALLOCATED(Phot%NCMAA )) DEALLOCATE(Phot%NCMAA ) + IF (ALLOCATED(Phot%QQAA )) DEALLOCATE(Phot%QQAA ) + IF (ALLOCATED(Phot%ALPHAA )) DEALLOCATE(Phot%ALPHAA ) + IF (ALLOCATED(Phot%SSAA )) DEALLOCATE(Phot%SSAA ) + IF (ALLOCATED(Phot%ASYMAA )) DEALLOCATE(Phot%ASYMAA ) + IF (ALLOCATED(Phot%PHAA )) DEALLOCATE(Phot%PHAA ) +#ifdef RRTMG + IF (ALLOCATED(Phot%RTODAER )) DEALLOCATE(Phot%RTODAER ) + IF (ALLOCATED(Phot%RTSSAER )) DEALLOCATE(Phot%RTSSAER ) + IF (ALLOCATED(Phot%RTASYMAER )) DEALLOCATE(Phot%RTASYMAER ) +#endif + + Phot => NULL() + ENDIF + + END SUBROUTINE Cleanup_Phot_Container +!EOC + +END MODULE Phot_Container_Mod diff --git a/Headers/photol_obj_mod.F90 b/Headers/photol_obj_mod.F90 deleted file mode 100644 index 6e0a1cd92..000000000 --- a/Headers/photol_obj_mod.F90 +++ /dev/null @@ -1,1170 +0,0 @@ -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !MODULE: photol_obj_mod.F90 -! -! !DESCRIPTION: Module PHOTOL\_OBJ\_MOD contains the derived type used to -! define the Photolysis object for GEOS-Chem that is included as a member -! of the State_Chm object -!\\ -!\\ -! !INTERFACE: -! -MODULE Photol_Obj_Mod -! -! USES: -! - USE ErrCode_Mod - USE Precision_Mod - - IMPLICIT NONE - PRIVATE -! -! !PUBLIC MEMBER FUNCTIONS: -! - PUBLIC :: Init_Photol_Obj - PUBLIC :: Cleanup_Photol_Obj -! -! !PUBLIC DATA MEMBERS: -! - ! Parameters used for allocation - - !========================================================================= - ! Derived type for Grid State - !========================================================================= - TYPE, PUBLIC :: PhotolState - - ! NOTE: we might want to make some of the parameters input - ! values rather than hard-code them during initialization. - ! Several of the them are physical constants that could be - ! moved to physconstants. And some of these might be able to - ! be removed if only used in Cloud-J routines and they are defined - ! in cloud-j. - - !--------------------------------------------------- - ! Fields that are also defined in Fast-JX or Cloud-J - !--------------------------------------------------- - - ! Renamed for clarity - INTEGER :: nJvalMax ! Max # J-values (JVN_ in Fast-JX/Cloud-J) - INTEGER :: nWLbins ! # WL bins (W_ in Fast-JX/Cloud-J) - - ! Other scalars used to allocate array sizes - INTEGER :: AN_ ! Number of separate aerosols per layer - INTEGER :: WX_ ! # WLs in input file - INTEGER :: M_ ! # Gaussian points used (must be 4 in Fast-JX) - INTEGER :: A_ ! # input aerosol/cloud Mie data sets - - ! Other scalars - INTEGER :: L_ ! Number of CTM layers - INTEGER :: L1_ ! Number of CTM layer edges - INTEGER :: L2_ ! Number of levels with both edges and mid-pt - INTEGER :: JVL_ ! Vertical J-value levels - INTEGER :: JXL_ ! # levels in J-values array - INTEGER :: JXL1_ ! ?? - INTEGER :: JXL2_ ! Max # levels in basic Fast-JX/Cloud-J grid - INTEGER :: X_ ! Max # input X-section data sets - INTEGER :: N_ ! # levels in Mie scattering arrays - INTEGER :: M2_ ! ?? - INTEGER :: NJX ! ?? - INTEGER :: NW1 ! ?? - INTEGER :: NW2 ! ?? - INTEGER :: NAA ! # categories for scattering phase functions - - ! Physical constants - ! (Candidates for physconst or use from Cloud-J) - REAL(fp) :: ZZHT ! Scale height [cm] - REAL(fp) :: RAD ! Radius of Earth [cm] - REAL(fp) :: ATAU ! Heating rate (factor increase between levels) - REAL(fp) :: ATAU0 ! Minimum heating rate - - ! Scalar set outside of this module - INTEGER :: NRATJ ! # photolysis rxns in chemistry (.LE. JVN_) - - ! Arrays - CHARACTER(LEN=6), ALLOCATABLE :: TITLEJX(:) ! Input cross sections title - CHARACTER(LEN=1), ALLOCATABLE :: SQQ (:) ! Input cross sections flag - CHARACTER(LEN=10), ALLOCATABLE :: RNAMES(:) ! Photolysis spc names - CHARACTER(LEN=80), ALLOCATABLE :: TITLAA(:) ! Scattering data title - INTEGER, ALLOCATABLE :: BRANCH (:) ! Photolysis spc branches - INTEGER, ALLOCATABLE :: JIND (:) ! Index mapping J-values onto rates - REAL(fp), ALLOCATABLE :: LQQ (:) ! Categorical interpolation options - REAL(fp), ALLOCATABLE :: WBIN (:) ! Boundaries of WL bins - REAL(fp), ALLOCATABLE :: WL (:) ! Centers of WL bins (eff WL) - REAL(fp), ALLOCATABLE :: FL (:) ! Solar flx incident on TOA [cm-2s-1] - REAL(fp), ALLOCATABLE :: QRAYL (:) ! Rayleigh params (eff Xs) [cm2] - REAL(fp), ALLOCATABLE :: EMU (:) ! 4 Gauss pts ?? - REAL(fp), ALLOCATABLE :: WT (:) ! 4 Gauss pts ?? - REAL(fp), ALLOCATABLE :: JFACTA (:) ! Multiplication factor for J-values - REAL(fp), ALLOCATABLE :: JLABEL (:) ! J-value label in main chem model - REAL(fp), ALLOCATABLE :: SAA (:,:) ! Single scattering albedo - REAL(fp), ALLOCATABLE :: QAA (:,:) ! Aerosol scatting phase fnctns - REAL(fp), ALLOCATABLE :: WAA (:,:) ! WLa for supplied phase functions - REAL(fp), ALLOCATABLE :: RAA (:,:) ! Aerosol type effective radius - REAL(fp), ALLOCATABLE :: QO2 (:,:) ! O2 X-sections - REAL(fp), ALLOCATABLE :: QO3 (:,:) ! O3 X-sections - REAL(fp), ALLOCATABLE :: Q1D (:,:) ! O3 => O(1D) quantum yield - REAL(fp), ALLOCATABLE :: TQQ (:,:) ! Temp for X-sections - REAL(fp), ALLOCATABLE :: QQQ (:,:,:) ! Xs in each WL bin [cm2] - REAL(fp), ALLOCATABLE :: PAA (:,:,:) ! Phase fnctn (first 8 terms) - - !-------------------------------------------------- - ! Fields that are not in Cloud-J - !-------------------------------------------------- - - ! Scalars - INTEGER :: IND999 ! Index in RAA & QAA of 999 nm - INTEGER :: JTAUMX ! max # divisions - - ! Photo-reaction flags for reactions adjusted in PhotRate_Adj - INTEGER :: RXN_O2 ! O2 + jv --> O + O - INTEGER :: RXN_O3_1 ! O3 + hv --> O2 + O - INTEGER :: RXN_O3_2 ! O3 + hv --> O2 + O(1D) - INTEGER :: RXN_H2SO4 ! SO4 + hv --> SO2 + 2OH - INTEGER :: RXN_NO2 ! NO2 + hv --> NO + O - INTEGER :: RXN_JHNO3 ! HNO3 + hv --> OH + NO2 - INTEGER :: RXN_JNITSa ! NITs + hv --> HNO2 - INTEGER :: RXN_JNITSb ! NITs + hv --> NO2 - INTEGER :: RXN_JNITa ! NIT + hv --> HNO2 - INTEGER :: RXN_JNITb ! NIT + hv --> NO2 - INTEGER :: RXN_NO ! For ucx_mod - INTEGER :: RXN_NO3 ! For ucx_mod - INTEGER :: RXN_N2O ! For ucx_mod - INTEGER :: RXN_BrO ! For Hg chem - INTEGER :: RXN_ClO ! For Hg chem - - ! Arrays - INTEGER, ALLOCATABLE :: RINDEX (:) ! GC to UCI spc name index mapping - INTEGER, ALLOCATABLE :: GC_Photo_Id(:) ! GC id per photolysis species - INTEGER, ALLOCATABLE :: MIEDX (:) ! Interface indices for GC/FJX spc - - REAL(fp), ALLOCATABLE :: UVXFACTOR(:) ! Photons/cm2s -> W/m2 conv factors - REAL(fp), ALLOCATABLE :: QAA_AOD (:) ! Single scattering albedo - REAL(fp), ALLOCATABLE :: WAA_AOD (:) ! Aerosol scattering phase fnctns - REAL(fp), ALLOCATABLE :: PAA_AOD (:) ! WLs for supplied phase functions - REAL(fp), ALLOCATABLE :: RAA_AOD (:) ! Phase fnctn (first 8 terms) - REAL(fp), ALLOCATABLE :: SAA_AOD (:) ! Aerosol type effective radius - - REAL(fp), ALLOCATABLE :: TREF (:,:,:) ! Temp reference profile - REAL(fp), ALLOCATABLE :: OREF (:,:,:) ! Ozone reference profile - REAL(fp), ALLOCATABLE :: ZPJ (:,:,:,:) ! J-values - - !-------------------------------------------------- - ! Fields for RRTMG and optical depth diagnostics - !-------------------------------------------------- - - ! RRTMG scalars - - ! Scalars used for allocating arrays - INTEGER :: NWVAA ! # LUT wavelengths - INTEGER :: NSPAA ! # LUT species - INTEGER :: NRAA ! # LUT aerosol sizes - - ! Other scalars - INTEGER :: NWVAA0 ! # non-RRTMG wavelengths - INTEGER :: NWVAART ! # RRTMG wavelengths - INTEGER :: NALBD ! ?? - INTEGER :: NEMISS ! ?? - INTEGER :: NASPECRAD ! # RRTMG aerosol species - INTEGER :: NSPECRAD ! # RRTMG aerosol+gas species - INTEGER :: NWVREQUIRED ! # WLs needed for interpolation - INTEGER :: NRTWVREQUIRED! # WLs needed for RT interpolation - INTEGER :: IWV1000 ! WL index for 1000 nm - - ! RRTMG allocatable arrays - INTEGER, ALLOCATABLE :: SPECMASK (:) ! binary switches for spc flux - INTEGER, ALLOCATABLE :: IWVREQUIRED (:) ! WL indexes for interpolation - INTEGER, ALLOCATABLE :: IRTWVREQUIRED(:) ! WL indexes for RT interp - INTEGER, ALLOCATABLE :: IWVSELECT (:,:) ! Indexes of requested WLs - INTEGER, ALLOCATABLE :: IRTWVSELECT (:,:) ! Indexes of requested RT WLs - INTEGER, ALLOCATABLE :: IRHARR (:,:,:) ! Relative humidity indices - - REAL*8, ALLOCATABLE :: ACOEF_WV (:) ! Coeffs for WL interpolation - REAL*8, ALLOCATABLE :: BCOEF_WV (:) ! Coeffs for WL interpolation - REAL*8, ALLOCATABLE :: CCOEF_WV (:) ! Coeffs for WL interpolation - REAL*8, ALLOCATABLE :: ACOEF_RTWV(:) ! Coeffs for RT WL interpolation - REAL*8, ALLOCATABLE :: BCOEF_RTWV(:) ! Coeffs for RT WL interpolation - REAL*8, ALLOCATABLE :: CCOEF_RTWV(:) ! Coeffs for RT WL interpolation - REAL*8, ALLOCATABLE :: WVAA (:,:) ! ?? - REAL*8, ALLOCATABLE :: RHAA (:,:) ! ?? - REAL*8, ALLOCATABLE :: RDAA (:,:) ! ?? - REAL*8, ALLOCATABLE :: RWAA (:,:) ! ?? - REAL*8, ALLOCATABLE :: SGAA (:,:) ! ?? - REAL*8, ALLOCATABLE :: REAA (:,:) ! ?? - REAL*8, ALLOCATABLE :: NRLAA (:,:,:) ! ?? - REAL*8, ALLOCATABLE :: NCMAA (:,:,:) ! ?? - REAL*8, ALLOCATABLE :: QQAA (:,:,:) ! ?? - REAL*8, ALLOCATABLE :: ALPHAA (:,:,:) ! ?? - REAL*8, ALLOCATABLE :: SSAA (:,:,:) ! ?? - REAL*8, ALLOCATABLE :: ASYMAA (:,:,:) ! ?? - REAL*8, ALLOCATABLE :: PHAA (:,:,:,:) ! ?? - - ! For optical depth diagnostics - REAL(fp), ALLOCATABLE :: ISOPOD (:,:,:,:) ! Isoprene optical depth - REAL(fp), ALLOCATABLE :: ODMDUST (:,:,:,:,:) ! Dust optical depth - REAL(fp), ALLOCATABLE :: ODAER (:,:,:,:,:) ! Aerosol optical depth - -#ifdef RRTMG - REAL*8, ALLOCATABLE :: RTODAER (:,:,:,:,:) ! Optical dust - REAL*8, ALLOCATABLE :: RTSSAER (:,:,:,:,:) ! ?? - REAL*8, ALLOCATABLE :: RTASYMAER (:,:,:,:,:) ! ?? -#endif - - END TYPE PhotolState -! -! !REMARKS: -! Acronyms used in this file (may appear as upper or lower-case): -! CLDJ : Cloud-J -! CONV : conversion -! EFF : effective -! FJX : Fast-JX -! FLX : flux -! FNCTN : function -! GC : GEOS-Chem -! LUT : look-up table -! RT : radiative transfer -! RXN : reaction -! SPC : species -! TEMP : temperature -! TOA : top-of-atmosphere -! UCI : University of California, Irvine -! WL : wavelegnth -! Xs : cross-section -! X-section : cross-section -! -! !REVISION HISTORY: -! 28 Nov 2022 - E. Lundgren- Initial version, based on state_grid_mod.F90 -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -CONTAINS -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: Init_Photol_Obj -! -! !DESCRIPTION: Subroutine INIT\_PHOTOL\_OBJ allocates and initializes -! the Photol object -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE Init_Photol_Obj( Input_Opt, State_Grid, Photol, RC ) -! -! !USES: -! -#ifdef CLOUDJ - USE Cldj_Cmn_Mod, ONLY : W_, JVN_ -#else - USE CMN_FastJX_Mod, ONLY : W_, JVN_ -#endif - USE CMN_Size_Mod, ONLY : NDUST, NAER - USE ErrCode_Mod - USE Input_Opt_Mod, ONLY : OptInput - USE State_Grid_Mod, ONLY : GrdState -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object - TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid object -! -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(PhotolState), POINTER :: Photol ! Photolysis state object -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Success or failure? -! -! !REVISION HISTORY: -! 28 Nov 2022 - E. Lundgren- Initial version -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - CHARACTER(LEN=255) :: errMsg, thisLoc - - !====================================================================== - ! Allocate and initialize module variables - !====================================================================== - - ! Assume success - RC = GC_SUCCESS - thisLoc = ' -> at Init_Photol_Obj (in module Headers/photol_obj_mod.F90)' - - !--------------------------------------------------- - ! Photolysis fields that are also in Cloud-J - !--------------------------------------------------- - - ! Values from Fast-JX/Cloud-J (ewl: not sure yet where to define) - Photol%nJvalMax = JVN_ ! Max # J-values - Photol%nWLbins = W_ ! # WL bins - - ! Integer scalars - - ! Used in array dimensions - Photol%AN_ = 37 ! Number of separate aerosols per layer - Photol%WX_ = 18 ! # WLs in input file - Photol%M_ = 4 ! # Gaussian points used (must be 4 in Fast-JX) - Photol%A_ = 56 ! # input aerosol/cloud Mie data sets - - ! Other scalars - Photol%L_ = State_Grid%NZ - Photol%L1_ = State_Grid%NZ + 1 - Photol%L2_ = 2 * ( State_Grid%NZ + 1 ) - Photol%JVL_ = State_Grid%NZ - Photol%JXL_ = State_Grid%NZ - Photol%JXL1_= State_Grid%NZ + 1 - Photol%JXL2_= 2 * ( State_Grid%NZ + 1 ) ! ewl: check this - - Photol%X_ = 123 -!ewl: consider making this a config input?? - Photol%N_ = 601 - Photol%M2_ = 2*Photol%M_ - - ! These are set somewhere else? (ewl) - Photol%NJX = 0 - Photol%NW1 = 0 - Photol%NW2 = 0 - Photol%NAA = 0 - - ! Real(fp) scalars - -!ewl: consider putting these in physconst if not already there - Photol%ZZHT = 5.e+5_fp ! Scale height [cm] - Photol%RAD = 6375.e+5_fp ! Radius of Earth [cm] - Photol%ATAU = 1.120e+0_fp ! Heating rate (factor increase between layers) - Photol%ATAU0 = 0.010e+0_fp ! Minimum heating rate - - ! Allocate arrays - IF ( .not. Input_Opt%DryRun ) THEN - - ! Character arrays - - ! Photol%TITLEJX (:) - ALLOCATE( Photol%TITLEJX(Photol%X_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array TITLEJX!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%TITLEJX = '' - - ! Photol%SQQ (:) - ALLOCATE( Photol%SQQ(Photol%X_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array SQQ!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%SQQ = '' - - ! Character arrays - - ! Photol%RNAMES (:) - ALLOCATE( Photol%RNAMES(Photol%nJvalMax), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RNAMES!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RNAMES = '' - - ! Photol%TITLAA (:) - ALLOCATE( Photol%TITLAA(Photol%A_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array TITLEAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%TITLAA = '' - - ! Integer arrays - - ! Photol%BRANCH (:) - ALLOCATE( Photol%BRANCH(Photol%nJvalMax), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array BRANCH!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%BRANCH = 0 - - ! Photol%JIND(:) - ALLOCATE( Photol%JIND(Photol%nJvalMax), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array JIND!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%JIND = 0 - - ! Real(fp) arrays - - ! Photol%LQQ (:) - ALLOCATE( Photol%LQQ(Photol%X_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array LQQ!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%LQQ = 0e+0_fp - - ! Photol%WBIN (:) - ALLOCATE( Photol%WBIN(Photol%WX_+1), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array WBIN!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%WBIN = 0e+0_fp - - ! Photol%WL (:) - ALLOCATE( Photol%WL(Photol%WX_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array WL!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%WL = 0e+0_fp - - ! Photol%FL (:) - ALLOCATE( Photol%FL(Photol%WX_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array FL!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%FL = 0e+0_fp - - ! Photol%QRAYL (:) - ALLOCATE( Photol%QRAYL(Photol%WX_+1), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array QRAYL!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%QRAYL = 0e+0_fp - - ! Photol%EMU (:) - ALLOCATE( Photol%EMU(Photol%M_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array EMU!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%EMU = 0e+0_fp - - ! Photol%WT (:) - ALLOCATE( Photol%WT(Photol%M_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array WT!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%WT = 0e+0_fp - - ! Photol%JFACTA (:) - ALLOCATE( Photol%JFACTA(Photol%nJvalMax), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array JFACTA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%JFACTA = 0e+0_fp - - ! Photol%JLABEL (:) - ALLOCATE( Photol%JLABEL(Photol%nJvalMax), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array JLABEL!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%JLABEL = 0e+0_fp - - ! Photol%SAA (:,:) - ALLOCATE( Photol%SAA(5,Photol%A_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array SAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%SAA = 0e+0_fp - - ! Photol%QAA (:,:) - ALLOCATE( Photol%QAA(5,Photol%A_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array QAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%QAA = 0e+0_fp - - ! Photol%WAA (:,:) - ALLOCATE( Photol%WAA(5,Photol%A_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array WAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%WAA = 0e+0_fp - - ! Photol%RAA (:,:) - ALLOCATE( Photol%RAA(5,Photol%A_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RAA = 0e+0_fp - - ! Photol%QO2 (:,:) - ALLOCATE( Photol%QO2(Photol%WX_,3), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array QO2!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%QO2 = 0e+0_fp - - ! Photol%QO3 (:,:) - ALLOCATE( Photol%QO3(Photol%WX_,3), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array QO3!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%QO3 = 0e+0_fp - - ! Photol%Q1D (:,:) - ALLOCATE( Photol%Q1D(Photol%WX_,3), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array Q1D!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%Q1D = 0e+0_fp - - ! Photol%TQQ (:,:) - ALLOCATE( Photol%TQQ(3,Photol%X_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array TQQ!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%TQQ = 0e+0_fp - - ! Photol%QQQ (:,:,:) - ALLOCATE( Photol%QQQ(Photol%WX_,3,Photol%X_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array QQQ!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%QQQ = 0e+0_fp - - ! Photol%PAA (:,:,:) - ALLOCATE( Photol%PAA(8,5,Photol%A_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array PAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%PAA = 0e+0_fp - - ENDIF - - !-------------------------------------------------- - ! General photolysis fields that are not in Cloud-J - !-------------------------------------------------- - - ! Integer scalars - - Photol%IND999 = 5 - Photol%JTAUMX = (Photol%N_ - 4*Photol%JXL_) / 2 - - Photol%RXN_O2 = -1 - Photol%RXN_O3_1 = -1 - Photol%RXN_O3_2 = -1 - Photol%RXN_H2SO4 = -1 - Photol%RXN_NO2 = -1 - Photol%RXN_JHNO3 = -1 - Photol%RXN_JNITSa = -1 - Photol%RXN_JNITSb = -1 - Photol%RXN_JNITa = -1 - Photol%RXN_JNITb = -1 - Photol%RXN_NO = -1 - Photol%RXN_NO3 = -1 - Photol%RXN_N2O = -1 - Photol%RXN_BrO = -1 - Photol%RXN_ClO = -1 - - ! Allocate arrays - IF ( .not. Input_Opt%DryRun ) THEN - - ! Integer arrays - - ! Photol%RINDEX (:) - ALLOCATE( Photol%RINDEX(Photol%nJvalMax), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RINDEX!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RINDEX = 0 - - ! Photol%GC_Photo_Id (:) - ALLOCATE( Photol%GC_Photo_Id(Photol%nJvalMax), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array GC_Photo_Id!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%GC_Photo_Id = 0 - - ! Photol%MIEDX (:) - ALLOCATE( Photol%MIEDX(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array MIEDX!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%MIEDX = 0 - - ! Real(fp) arrays - - ! Photol%UVXFACTOR(:) - ALLOCATE( Photol%UVXFACTOR(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array UVXFACTOR!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%UVXFACTOR = 0e+0_fp - - ! Photol%QAA_AOD (:) - ALLOCATE( Photol%QAA_AOD(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array QAA_AOD!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%QAA_AOD = 0e+0_fp - - ! Photol%WAA_AOD (:) - ALLOCATE( Photol%WAA_AOD(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array WAA_AOD!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%WAA_AOD = 0e+0_fp - - ! Photol%PAA_AOD (:) - ALLOCATE( Photol%PAA_AOD(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array PAA_AOD!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%PAA_AOD = 0e+0_fp - - ! Photol%RAA_AOD (:) - ALLOCATE( Photol%RAA_AOD(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RAA_AOD!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RAA_AOD = 0e+0_fp - - ! Photol%SAA_AOD (:) - ALLOCATE( Photol%SAA_AOD(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array SAA_AOD!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%SAA_AOD = 0e+0_fp - - ! Photol%TREF (:,:,:) - ALLOCATE( Photol%TREF(51,18,12), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array TREF!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%TREF = 0e+0_fp - - ! Photol%OREF (:,:,:) - ALLOCATE( Photol%OREF(51,18,12), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array OREF!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%OREF = 0e+0_fp - - ! Photol%ZPJ (:,:,:,:) - ALLOCATE( Photol%ZPJ( State_Grid%NZ, Photol%nJvalMax, State_Grid%NX, & - State_Grid%NY), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array ZPJ!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%ZPJ = 0e+0_fp - - ENDIF - - !-------------------------------------------------- - ! Fields for RRTMG and optical depth diags (none in Cloud-J) - !-------------------------------------------------- - - ! RRTMG integer scalars - - ! Scalars used for allocating arrays - Photol%NWVAA = 41 ! # LUT wavelengths - Photol%NSPAA = 8 ! # LUT species - Photol%NRAA = 7 ! # LUT aerosol sizes - - ! Other scalars - Photol%NWVAA0 = 11 ! # non-RRTMG wavelengths - Photol%NWVAART = Photol%NWVAA-Photol%NWVAA0 ! # RRTMG wavelengths - Photol%NALBD = 2 ! ?? - Photol%NEMISS = 16 ! ?? - Photol%NASPECRAD = 16 ! # RT aerosol species - Photol%NSPECRAD = 18 ! # RT aerosol+gas species - - ! These are set elsewhere? (ewl) - Photol%NWVREQUIRED = 0 - Photol%NRTWVREQUIRED = 0 - Photol%IWV1000 = 0 - - ! Allocate arrays - IF ( .not. Input_Opt%DryRun ) THEN - - ! RRTMG integer arrays - - ! Photol%SPECMASK (:) - ALLOCATE( Photol%SPECMASK(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array SPECMASK!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%SPECMASK = 0 - - ! Photol%IWVREQUIRED (:) - ALLOCATE( Photol%IWVREQUIRED(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array IWVREQUIRED!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%IWVREQUIRED = 0 - - ! Photol%IRTWVREQUIRED(:) - ALLOCATE( Photol%IRTWVREQUIRED(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array IRTWVREQUIRED!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%IRTWVREQUIRED = 0 - - ! Photol%IWVSELECT (:,:) - ALLOCATE( Photol%IWVSELECT(2,3), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array IWVSELECT!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%IWVSELECT = 0 - - ! Photol%IRTWVSELECT (:,:) - ALLOCATE( Photol%IRTWVSELECT(2,3), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array IRTWVSELECT!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%IRTWVSELECT = 0 - - ! Photol%IRHARR (:,:,:) - ALLOCATE( Photol%IRHARR( State_Grid%NX, State_Grid%NY, & - State_Grid%NZ ), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array IRHARR!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%IRHARR = 0d0 - - ! RRTMG real*8 arrays - - ! Photol%ACOEF_WV (:) - ALLOCATE( Photol%ACOEF_WV(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array ACOEF_WV!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%ACOEF_WV = 0d0 - - ! Photol%BCOEF_WV (:) - ALLOCATE( Photol%BCOEF_WV(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array BCOEF_WV!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%BCOEF_WV = 0d0 - - ! Photol%CCOEF_WV (:) - ALLOCATE( Photol%CCOEF_WV(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array CCOEF_WV!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%CCOEF_WV = 0d0 - - ! Photol%ACOEF_RTWV(:) - ALLOCATE( Photol%ACOEF_RTWV(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array ACOEF_RTWV!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%ACOEF_RTWV = 0d0 - - ! Photol%BCOEF_RTWV(:) - ALLOCATE( Photol%BCOEF_RTWV(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array BCOEF_RTWV!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%BCOEF_RTWV = 0d0 - - ! Photol%CCOEF_RTWV(:) - ALLOCATE( Photol%CCOEF_RTWV(Photol%AN_), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array CCOEF_RTWV!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%CCOEF_RTWV = 0d0 - - ! Photol%WVAA (:,:) - ALLOCATE( Photol%WVAA(Photol%NWVAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array WVAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%WVAA = 0d0 - - ! Photol%RHAA (:,:) - ALLOCATE( Photol%RHAA(Photol%NRAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RHAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RHAA = 0d0 - - ! Photol%RDAA (:,:)! - ALLOCATE( Photol%RDAA(Photol%NRAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RDAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RDAA = 0d0 - - ! Photol%RWAA (:,:) - ALLOCATE( Photol%RWAA(Photol%NRAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RWAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RWAA = 0d0 - - ! Photol%SGAA (:,:) - ALLOCATE( Photol%SGAA(Photol%NRAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array SGAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%SGAA = 0d0 - - ! Photol%REAA (:,:) - ALLOCATE( Photol%REAA(Photol%NRAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array REAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%REAA = 0d0 - - ! Photol%NRLAA (:,:,:) - ALLOCATE( Photol%NRLAA(Photol%NWVAA,Photol%NRAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array NRLAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%NRLAA = 0d0 - - ! Photol%NCMAA (:,:,:) - ALLOCATE( Photol%NCMAA(Photol%NWVAA,Photol%NRAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array NCMAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%NCMAA = 0d0 - - ! Photol%QQAA (:,:,:) - ALLOCATE( Photol%QQAA(Photol%NWVAA,Photol%NRAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array QQAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%QQAA = 0d0 - - ! Photol%ALPHAA (:,:,:) - ALLOCATE( Photol%ALPHAA(Photol%NWVAA,Photol%NRAA,Photol%NSPAA), & - STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array ALPHAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%ALPHAA = 0d0 - - ! Photol%SSAA (:,:,:) - ALLOCATE( Photol%SSAA(Photol%NWVAA,Photol%NRAA,Photol%NSPAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array SSAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%SSAA = 0d0 - - ! Photol%ASYMAA (:,:,:) - ALLOCATE( Photol%ASYMAA(Photol%NWVAA,Photol%NRAA,Photol%NSPAA), & - STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array ASYMAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%ASYMAA = 0d0 - - ! Photol%PHAA (:,:,:,:) - ALLOCATE( Photol%PHAA(Photol%NWVAA,Photol%NRAA,Photol%NSPAA,8), & - STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array PHAA!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%PHAA = 0d0 - - ! Photol%ISOPOD (:,:,:,:) - ALLOCATE( Photol%ISOPOD( State_Grid%NX, State_Grid%NY, & - State_Grid%NZ, Photol%NWVAA), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array ISOPOD!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%ISOPOD = 0e+0_fp - - ! Photol%ODMDUST (:,:,:,:,:) - ALLOCATE( Photol%ODMDUST( State_Grid%NX, State_Grid%NY, & - State_Grid%NZ, Photol%NWVAA, NDUST), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array ODMDUST!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%ODMDUST = 0e+0_fp - - ! Photol%ODAER (:,:,:,:,:) - ALLOCATE( Photol%ODAER( State_Grid%NX, State_Grid%NY, & - State_Grid%NZ, Photol%NWVAA, NAER), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array ODAER!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%ODAER = 0e+0_fp - -#ifdef RRTMG - ! Photol%RTODAER (:,:,:,:,:) - ! +2 to split SNA into SU, NI and AM - ALLOCATE( Photol%RTODAER( State_Grid%NX, State_Grid%NY, & - State_Grid%NZ, Photol%NWVAA,NAER+2+NDUST), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RTODAER!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RTODAER = 0d0 - - ! Photol%RTSSAER (:,:,:,:,:) - ALLOCATE( Photol%RTSSAER( State_Grid%NX, State_Grid%NY, & - State_Grid%NZ, Photol%NWVAA, NAER+2+NDUST ), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RTSSAER!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RTSSAER = 0d0 - - ! Photol%RTASYMAER (:,:,:,:,:) - ALLOCATE( Photol%RTASYMAER( State_Grid%NX, State_Grid%NY, & - State_Grid%NZ, Photol%NWVAA, NAER+2+NDUST ), STAT=RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error allocating array RTASYMAER!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Photol%RTASYMAER = 0d0 -#endif - - ENDIF - - END SUBROUTINE Init_Photol_Obj -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: Cleanup_Photol_Obj -! -! !DESCRIPTION: Subroutine CLEANUP\_STATE\_PHOTOL deallocates all fields -! of the photolysis state object. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE Cleanup_Photol_Obj( Photol, RC ) -! -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(PhotolState), POINTER :: Photol ! Obj for photolysis state -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Return code -! -! !REVISION HISTORY: -! 28 Nov 2022 - E. Lundgren- Initial version -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - - ! Assume success - RC = GC_SUCCESS - - !======================================================================= - ! Deallocate arrays - !======================================================================= - ! Will need to change this to just do arrays etc - IF ( ASSOCIATED( Photol ) ) THEN - IF (ALLOCATED(Photol%JIND )) DEALLOCATE(Photol%JIND ) - IF (ALLOCATED(Photol%LQQ )) DEALLOCATE(Photol%LQQ ) - IF (ALLOCATED(Photol%TITLEJX )) DEALLOCATE(Photol%TITLEJX ) - IF (ALLOCATED(Photol%SQQ )) DEALLOCATE(Photol%SQQ ) - IF (ALLOCATED(Photol%WBIN )) DEALLOCATE(Photol%WBIN ) - IF (ALLOCATED(Photol%WL )) DEALLOCATE(Photol%WL ) - IF (ALLOCATED(Photol%FL )) DEALLOCATE(Photol%FL ) - IF (ALLOCATED(Photol%EMU )) DEALLOCATE(Photol%EMU ) - IF (ALLOCATED(Photol%WT )) DEALLOCATE(Photol%WT ) - IF (ALLOCATED(Photol%JFACTA )) DEALLOCATE(Photol%JFACTA ) - IF (ALLOCATED(Photol%SAA )) DEALLOCATE(Photol%SAA ) - IF (ALLOCATED(Photol%QAA )) DEALLOCATE(Photol%QAA ) - IF (ALLOCATED(Photol%WAA )) DEALLOCATE(Photol%WAA ) - IF (ALLOCATED(Photol%RAA )) DEALLOCATE(Photol%RAA ) - IF (ALLOCATED(Photol%QO2 )) DEALLOCATE(Photol%QO2 ) - IF (ALLOCATED(Photol%QO3 )) DEALLOCATE(Photol%QO3 ) - IF (ALLOCATED(Photol%Q1D )) DEALLOCATE(Photol%Q1D ) - IF (ALLOCATED(Photol%TQQ )) DEALLOCATE(Photol%TQQ ) - IF (ALLOCATED(Photol%QQQ )) DEALLOCATE(Photol%QQQ ) - IF (ALLOCATED(Photol%PAA )) DEALLOCATE(Photol%PAA ) - IF (ALLOCATED(Photol%QRAYL )) DEALLOCATE(Photol%QRAYL ) - IF (ALLOCATED(Photol%RNAMES )) DEALLOCATE(Photol%RNAMES ) - IF (ALLOCATED(Photol%TITLAA )) DEALLOCATE(Photol%TITLAA ) - IF (ALLOCATED(Photol%BRANCH )) DEALLOCATE(Photol%BRANCH ) - IF (ALLOCATED(Photol%RINDEX )) DEALLOCATE(Photol%RINDEX ) - IF (ALLOCATED(Photol%GC_Photo_Id )) DEALLOCATE(Photol%GC_Photo_Id ) - IF (ALLOCATED(Photol%MIEDX )) DEALLOCATE(Photol%MIEDX ) - IF (ALLOCATED(Photol%UVXFACTOR )) DEALLOCATE(Photol%UVXFACTOR ) - IF (ALLOCATED(Photol%QAA_AOD )) DEALLOCATE(Photol%QAA_AOD ) - IF (ALLOCATED(Photol%WAA_AOD )) DEALLOCATE(Photol%WAA_AOD ) - IF (ALLOCATED(Photol%PAA_AOD )) DEALLOCATE(Photol%PAA_AOD ) - IF (ALLOCATED(Photol%RAA_AOD )) DEALLOCATE(Photol%RAA_AOD ) - IF (ALLOCATED(Photol%SAA_AOD )) DEALLOCATE(Photol%SAA_AOD ) - IF (ALLOCATED(Photol%TREF )) DEALLOCATE(Photol%TREF ) - IF (ALLOCATED(Photol%OREF )) DEALLOCATE(Photol%OREF ) - IF (ALLOCATED(Photol%ISOPOD )) DEALLOCATE(Photol%ISOPOD ) - IF (ALLOCATED(Photol%ZPJ )) DEALLOCATE(Photol%ZPJ ) - IF (ALLOCATED(Photol%ODMDUST )) DEALLOCATE(Photol%ODMDUST ) - IF (ALLOCATED(Photol%ODAER )) DEALLOCATE(Photol%ODAER ) - IF (ALLOCATED(Photol%SPECMASK )) DEALLOCATE(Photol%SPECMASK ) - IF (ALLOCATED(Photol%IWVREQUIRED )) DEALLOCATE(Photol%IWVREQUIRED ) - IF (ALLOCATED(Photol%IRTWVREQUIRED )) DEALLOCATE(Photol%IRTWVREQUIRED ) - IF (ALLOCATED(Photol%IWVSELECT )) DEALLOCATE(Photol%IWVSELECT ) - IF (ALLOCATED(Photol%IRTWVSELECT )) DEALLOCATE(Photol%IRTWVSELECT ) - IF (ALLOCATED(Photol%IRHARR )) DEALLOCATE(Photol%IRHARR ) - IF (ALLOCATED(Photol%ACOEF_WV )) DEALLOCATE(Photol%ACOEF_WV ) - IF (ALLOCATED(Photol%BCOEF_WV )) DEALLOCATE(Photol%BCOEF_WV ) - IF (ALLOCATED(Photol%CCOEF_WV )) DEALLOCATE(Photol%CCOEF_WV ) - IF (ALLOCATED(Photol%ACOEF_RTWV )) DEALLOCATE(Photol%ACOEF_RTWV ) - IF (ALLOCATED(Photol%BCOEF_RTWV )) DEALLOCATE(Photol%BCOEF_RTWV ) - IF (ALLOCATED(Photol%CCOEF_RTWV )) DEALLOCATE(Photol%CCOEF_RTWV ) - IF (ALLOCATED(Photol%WVAA )) DEALLOCATE(Photol%WVAA ) - IF (ALLOCATED(Photol%RHAA )) DEALLOCATE(Photol%RHAA ) - IF (ALLOCATED(Photol%RDAA )) DEALLOCATE(Photol%RDAA ) - IF (ALLOCATED(Photol%RWAA )) DEALLOCATE(Photol%RWAA ) - IF (ALLOCATED(Photol%SGAA )) DEALLOCATE(Photol%SGAA ) - IF (ALLOCATED(Photol%REAA )) DEALLOCATE(Photol%REAA ) - IF (ALLOCATED(Photol%NRLAA )) DEALLOCATE(Photol%NRLAA ) - IF (ALLOCATED(Photol%NCMAA )) DEALLOCATE(Photol%NCMAA ) - IF (ALLOCATED(Photol%QQAA )) DEALLOCATE(Photol%QQAA ) - IF (ALLOCATED(Photol%ALPHAA )) DEALLOCATE(Photol%ALPHAA ) - IF (ALLOCATED(Photol%SSAA )) DEALLOCATE(Photol%SSAA ) - IF (ALLOCATED(Photol%ASYMAA )) DEALLOCATE(Photol%ASYMAA ) - IF (ALLOCATED(Photol%PHAA )) DEALLOCATE(Photol%PHAA ) -#ifdef RRTMG - IF (ALLOCATED(Photol%RTODAER )) DEALLOCATE(Photol%RTODAER ) - IF (ALLOCATED(Photol%RTSSAER )) DEALLOCATE(Photol%RTSSAER ) - IF (ALLOCATED(Photol%RTASYMAER )) DEALLOCATE(Photol%RTASYMAER ) -#endif - - Photol => NULL() - ENDIF - - END SUBROUTINE Cleanup_Photol_Obj -!EOC -END MODULE Photol_Obj_Mod diff --git a/Headers/state_chm_mod.F90 b/Headers/state_chm_mod.F90 index 51d2003e6..6fd8745e6 100644 --- a/Headers/state_chm_mod.F90 +++ b/Headers/state_chm_mod.F90 @@ -23,7 +23,7 @@ MODULE State_Chm_Mod ! USE Dictionary_M, ONLY : dictionary_t ! Fortran hash table type USE ErrCode_Mod ! Error handling - USE Photol_Obj_Mod ! For photolysis state object + USE Phot_Container_Mod ! For photolysis state object USE PhysConstants ! Physical constants USE Precision_Mod ! GEOS-Chem precision types USE Registry_Mod ! Registry module @@ -224,7 +224,7 @@ MODULE State_Chm_Mod !----------------------------------------------------------------------- ! Fields for photolysis !----------------------------------------------------------------------- - TYPE(PhotolState), POINTER :: photol ! Photolysis state obj + TYPE(PhotContainer), POINTER :: phot ! Photolysis/optics container !----------------------------------------------------------------------- ! Fields for dry deposition @@ -417,7 +417,7 @@ SUBROUTINE Zero_State_Chm( State_Chm, RC ) #endif ! Photolysis state - State_Chm%Photol => NULL() + State_Chm%Phot => NULL() ! RRTMG state State_Chm%RRTMG_iSeed = 0 @@ -668,10 +668,10 @@ SUBROUTINE Init_State_Chm( Input_Opt, State_Chm, State_Grid, RC ) !======================================================================== ! Allocate and initialize the photolysis object !======================================================================== - ALLOCATE( State_Chm%Photol, STAT=RC ) - CALL Init_Photol_Obj( Input_Opt, State_Grid, State_Chm%Photol, RC ) + ALLOCATE( State_Chm%Phot, STAT=RC ) + CALL Init_Phot_Container( Input_Opt, State_Grid, State_Chm%Phot, RC ) IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error encountered in "Init_Photol_State" routine!' + errMsg = 'Error encountered in "Init_Phot_Container" routine!' CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF @@ -2374,8 +2374,8 @@ SUBROUTINE Init_Mapping_Vectors( Input_Opt, State_Chm, RC ) State_Chm%Map_WetDep = 0 ENDIF - IF ( State_Chm%Photol%nWLbins > 0 ) THEN - ALLOCATE( State_Chm%Map_WL( State_Chm%Photol%nWLbins ), STAT=RC ) + IF ( State_Chm%Phot%nWLbins > 0 ) THEN + ALLOCATE( State_Chm%Map_WL( State_Chm%Phot%nWLbins ), STAT=RC ) CALL GC_CheckVar( 'State_Chm%Map_WL', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN State_Chm%Map_WL = 0 @@ -2528,10 +2528,10 @@ SUBROUTINE Init_Mapping_Vectors( Input_Opt, State_Chm, RC ) ! Set up the mapping for UVFlux Diagnostics ! placeholder for now since couldn't figure out how to read in WL from file !------------------------------------------------------------------------ - IF ( State_Chm%Photol%nWLbins > 0 ) THEN + IF ( State_Chm%Phot%nWLbins > 0 ) THEN ! Define identifying string - DO N = 1, State_Chm%Photol%nWLbins + DO N = 1, State_Chm%Phot%nWLbins State_Chm%Map_WL(N) = 0 ENDDO ENDIF @@ -3427,10 +3427,9 @@ SUBROUTINE Cleanup_State_Chm( State_Chm, RC ) State_Chm%TOMS2 => NULL() ENDIF - ! ewl: need to work on this - IF ( ASSOCIATED ( State_Chm%Photol ) ) THEN - CALL Cleanup_Photol_Obj(State_Chm%Photol, RC ) - State_Chm%Photol => NULL() + IF ( ASSOCIATED ( State_Chm%Phot ) ) THEN + CALL Cleanup_Phot_Container(State_Chm%Phot, RC ) + State_Chm%Phot => NULL() ENDIF !----------------------------------------------------------------------- diff --git a/Headers/state_diag_mod.F90 b/Headers/state_diag_mod.F90 index 421441f99..b6fbd178a 100644 --- a/Headers/state_diag_mod.F90 +++ b/Headers/state_diag_mod.F90 @@ -14054,7 +14054,7 @@ SUBROUTINE Get_NumTags( tagId, State_Chm, numTags, RC ) CASE( 'PHO', 'P' ) numTags = State_Chm%nPhotol CASE( 'UVFLX', 'U' ) - numTags = State_Chm%Photol%nWLbins + numTags = State_Chm%Phot%nWLbins CASE( 'PRD', 'Y' ) numTags = State_Chm%nProd CASE( 'RRTMG', 'Z' ) diff --git a/Interfaces/GCClassic/main.F90 b/Interfaces/GCClassic/main.F90 index c968b64d3..585b316b6 100644 --- a/Interfaces/GCClassic/main.F90 +++ b/Interfaces/GCClassic/main.F90 @@ -67,6 +67,7 @@ PROGRAM GEOS_Chem USE LINEAR_CHEM_MOD ! For linearized chemistry above chem grid USE MERCURY_MOD ! For offline Hg simulation (driver) USE OCEAN_MERCURY_MOD ! For offline Hg simulation (ocean model) + USE PHOTOLYSIS_MOD ! For photolysis (ewl: revisit FJX things in this list) USE TOMS_MOD ! For overhead O3 columns (for FAST-J) USE UCX_MOD ! For unified trop-strat chemistry USE UVALBEDO_MOD ! For reading UV albedoes (for FAST-J) @@ -753,11 +754,11 @@ PROGRAM GEOS_Chem Input_Opt%ITS_AN_AEROSOL_SIM .or. & Input_Opt%ITS_A_MERCURY_SIM .or. & Input_Opt%ITS_A_CARBON_SIM ) THEN - CALL Init_Chemistry( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) + CALL Init_Photolysis( Input_Opt, State_Chm, State_Diag, State_Grid, RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Chemistry"!' + ErrMsg = 'Error encountered in "Init_Photolysis"!' CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF ENDIF @@ -1711,7 +1712,7 @@ PROGRAM GEOS_Chem WRITE( 6, 520 ) State_Diag%RadOutName(N), State_Diag%RadOutInd(N) ! Generate mask for species in RT - CALL Set_SpecMask( State_Diag%RadOutInd(N) ) + CALL Set_SpecMask( State_Diag%RadOutInd(N), State_Chm ) ! Compute radiative transfer for the given output CALL Do_RRTMG_Rad_Transfer( ThisDay = Day, & @@ -1738,7 +1739,7 @@ PROGRAM GEOS_Chem ! Calculate for rest of outputs, if any DO N = 2, State_Diag%nRadOut WRITE( 6, 520 ) State_Diag%RadOutName(N), State_Diag%RadOutInd(N) - CALL Set_SpecMask( State_Diag%RadOutInd(N) ) + CALL Set_SpecMask( State_Diag%RadOutInd(N), State_Chm ) CALL Do_RRTMG_Rad_Transfer( ThisDay = Day, & ThisMonth = Month, & iCld = State_Chm%RRTMG_iCld, & diff --git a/Interfaces/GCHP/gchp_chunk_mod.F90 b/Interfaces/GCHP/gchp_chunk_mod.F90 index a6c680e9a..75d4a8727 100644 --- a/Interfaces/GCHP/gchp_chunk_mod.F90 +++ b/Interfaces/GCHP/gchp_chunk_mod.F90 @@ -68,7 +68,7 @@ SUBROUTINE GCHP_Chunk_Init( nymdB, nhmsB, nymdE, & ! ! !USES: ! - USE Chemistry_Mod, ONLY : Init_Chemistry + USE Photolysis_Mod, ONLY : Init_Photolysis USE Emissions_Mod, ONLY : Emissions_Init USE GC_Environment_Mod USE GC_Grid_Mod, ONLY : SetGridFromCtr @@ -517,9 +517,9 @@ SUBROUTINE GCHP_Chunk_Init( nymdB, nhmsB, nymdE, & Input_Opt%ITS_AN_AEROSOL_SIM .or. & Input_Opt%ITS_A_MERCURY_SIM .or. & Input_Opt%ITS_A_CARBON_SIM ) THEN - CALL INIT_CHEMISTRY ( Input_Opt, State_Chm, State_Diag, & - State_Grid, RC ) - _ASSERT(RC==GC_SUCCESS, 'Error calling INIT_CHEMISTRY') + CALL INIT_PHOTOLYSIS ( Input_Opt, State_Chm, State_Diag, & + State_Grid, RC ) + _ASSERT(RC==GC_SUCCESS, 'Error calling INIT_PHOTOLYSIS') ENDIF #if defined( RRTMG ) @@ -1441,7 +1441,7 @@ SUBROUTINE GCHP_Chunk_Run( GC, & ENDIF ! Generate mask for species in RT - CALL Set_SpecMask( State_Diag%RadOutInd(N) ) + CALL Set_SpecMask( State_Diag%RadOutInd(N), State_Chm ) ! Compute radiative fluxes for the given output CALL Do_RRTMG_Rad_Transfer( ThisDay = Day, & @@ -1465,7 +1465,7 @@ SUBROUTINE GCHP_Chunk_Run( GC, & IF ( Input_Opt%amIRoot .AND. FIRST_RT ) THEN WRITE( 6, 520 ) State_Diag%RadOutName(N), State_Diag%RadOutInd(N) ENDIF - CALL Set_SpecMask( State_Diag%RadOutInd(N) ) + CALL Set_SpecMask( State_Diag%RadOutInd(N), State_Chm ) CALL Do_RRTMG_Rad_Transfer( ThisDay = Day, & ThisMonth = Month, & iCld = State_Chm%RRTMG_iCld, &