diff --git a/GeosCore/aerosol_mod.F90 b/GeosCore/aerosol_mod.F90 index 9ec5776cf..5a5fc6b8f 100644 --- a/GeosCore/aerosol_mod.F90 +++ b/GeosCore/aerosol_mod.F90 @@ -251,7 +251,7 @@ SUBROUTINE AEROSOL_CONC( Input_Opt, State_Chm, State_Diag, & REAL(fp), POINTER :: KG_STRAT_AER(:,:,:,:) ! Other variables - INTEGER :: OrigUnit + INTEGER :: previous_units ! For spatially and seasonally varying OM/OC @@ -305,13 +305,14 @@ SUBROUTINE AEROSOL_CONC( Input_Opt, State_Chm, State_Diag, & ! Convert species to [kg] for this routine CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + new_units = KG_SPECIES, & + mapping = State_Chm%Map_Advect, & + previous_units = previous_units & + RC = RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN @@ -1023,7 +1024,8 @@ SUBROUTINE AEROSOL_CONC( Input_Opt, State_Chm, State_Diag, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN diff --git a/GeosCore/airs_ch4_mod.F90 b/GeosCore/airs_ch4_mod.F90 index 28b841c56..f0ee8c9d0 100644 --- a/GeosCore/airs_ch4_mod.F90 +++ b/GeosCore/airs_ch4_mod.F90 @@ -429,7 +429,7 @@ SUBROUTINE CALC_AIRS_CH4_FORCE( Input_Opt, State_Chm, State_Grid, & INTEGER :: IOS INTEGER, SAVE :: TotalObs = 0 CHARACTER(LEN=255) :: FILENAME - INTEGER :: origUnit + INTEGER :: previous_units CHARACTER(LEN=255) :: ThisLoc CHARACTER(LEN=512) :: ErrMsg INTEGER :: RC @@ -518,13 +518,14 @@ SUBROUTINE CALC_AIRS_CH4_FORCE( Input_Opt, State_Chm, State_Grid, & ! Convert species units to [v/v] (mps, 6/12/2020) CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Unit conversion error (kg/kg dry -> v/v dry)' @@ -699,7 +700,8 @@ SUBROUTINE CALC_AIRS_CH4_FORCE( Input_Opt, State_Chm, State_Grid, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) ! Trap errors diff --git a/GeosCore/carbon_mod.F90 b/GeosCore/carbon_mod.F90 index 385e95fdb..ae373261d 100644 --- a/GeosCore/carbon_mod.F90 +++ b/GeosCore/carbon_mod.F90 @@ -4968,7 +4968,7 @@ SUBROUTINE EMISSCARBONTOMAS( Input_Opt, State_Chm, State_Grid, State_Met, RC ) LOGICAL :: SGCOAG = .True. INTEGER :: L, K, EMTYPE INTEGER :: ii=53, jj=29 - INTEGER :: origUnit + INTEGER :: previous_units LOGICAL, SAVE :: FIRST = .TRUE. !(ramnarine 12/27/2018) LOGICAL, SAVE :: USE_FIRE_NUM = .FALSE. LOGICAL :: FND !(ramnarine 1/2/2019) @@ -5029,14 +5029,15 @@ SUBROUTINE EMISSCARBONTOMAS( Input_Opt, State_Chm, State_Grid, State_Met, RC ) ! Convert concentration units to [kg] for TOMAS. This will be ! removed once TOMAS uses mixing ratio instead of mass ! as species units (ewl, 9/11/15) - CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES, & - origUnit = origUnit, & - RC = RC ) + CALL Convert_Spc_Units( & + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = KG_SPECIES, & + previous_units = previous_units, & + RC = RC ) ! Trap errors IF ( RC /= GC_SUCCESS ) THEN @@ -5266,7 +5267,8 @@ SUBROUTINE EMISSCARBONTOMAS( Input_Opt, State_Chm, State_Grid, State_Met, RC ) State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) ! Trap errors diff --git a/GeosCore/chemistry_mod.F90 b/GeosCore/chemistry_mod.F90 index 0c3871959..ea4fece10 100644 --- a/GeosCore/chemistry_mod.F90 +++ b/GeosCore/chemistry_mod.F90 @@ -140,7 +140,7 @@ SUBROUTINE Do_Chemistry( Input_Opt, State_Chm, State_Diag, & LOGICAL, SAVE :: FIRST = .TRUE. ! Strings - INTEGER :: OrigUnit + INTEGER :: previous_units CHARACTER(LEN=255) :: ErrMsg, ThisLoc !======================================================================= @@ -205,13 +205,14 @@ SUBROUTINE Do_Chemistry( Input_Opt, State_Chm, State_Diag, & ! Convert units from mol/mol dry to kg CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_All, & + new_units = KG_SPECIES, & + previous_units = previous_units, & + RC = RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN @@ -455,17 +456,10 @@ SUBROUTINE Do_Chemistry( Input_Opt, State_Chm, State_Diag, & errCode = RC ) ! Check units (ewl, 10/5/15) - IF ( State_Chm%Spc_Units /= KG_SPECIES ) THEN - ErrMsg = 'Incorrect species units after DO_LINEARCHEM!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - ENDIF - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in ""!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF + !IF ( State_Chm%Spc_Units /= KG_SPECIES ) THEN + ! ErrMsg = 'Incorrect species units after DO_LINEARCHEM!' + ! CALL GC_Error( ErrMsg, RC, ThisLoc ) + !ENDIF IF ( Input_Opt%useTimers ) THEN CALL Timer_End( "=> Linearized chem", RC ) @@ -548,11 +542,11 @@ SUBROUTINE Do_Chemistry( Input_Opt, State_Chm, State_Diag, & FullRun = .TRUE., & RC = RC ) - ! Check units (ewl, 10/5/15) - IF ( State_Chm%Spc_Units /= KG_SPECIES ) THEN - ErrMsg = 'Incorrect species units after CHEMSULFATE!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - ENDIF + !! Check units (ewl, 10/5/15) + !IF ( State_Chm%Spc_Units /= KG_SPECIES ) THEN + ! ErrMsg = 'Incorrect species units after CHEMSULFATE!' + ! CALL GC_Error( ErrMsg, RC, ThisLoc ) + !ENDIF ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN @@ -1081,7 +1075,8 @@ SUBROUTINE Do_Chemistry( Input_Opt, State_Chm, State_Diag, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_All, & + new_units = previous_units, & RC = RC ) ! Trap potential errors diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index 20f6852f7..365fe5ce5 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -357,13 +357,14 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! Convert species to [molec/cm3] (ewl, 8/16/16) !======================================================================== CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLECULES_SPECIES_PER_CM3, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_All, & + new_units = MOLECULES_SPECIES_PER_CM3, & + previous_units = previous_units, & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Unit conversion error!' @@ -1731,7 +1732,8 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_All, & + new_units = previous_units, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN diff --git a/GeosCore/gosat_ch4_mod.F90 b/GeosCore/gosat_ch4_mod.F90 index d3e777d64..f8846450a 100644 --- a/GeosCore/gosat_ch4_mod.F90 +++ b/GeosCore/gosat_ch4_mod.F90 @@ -399,7 +399,7 @@ SUBROUTINE CALC_GOSAT_CH4_FORCE( Input_Opt, State_Chm, State_Grid, & INTEGER :: IIJJ(2), I, J, N INTEGER :: L, LL, LGOS INTEGER :: JLOOP, NOBS, IND - INTEGER :: origUnit + INTEGER :: previous_units INTEGER :: INDS(MAXGOS) REAL(fp) :: REF_DATE, TIME REAL(fp) :: GC_PRES(State_Grid%NZ) @@ -584,13 +584,14 @@ SUBROUTINE CALC_GOSAT_CH4_FORCE( Input_Opt, State_Chm, State_Grid, & ! Convert species units to [v/v dry] aka [mol/mol dry] CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Unit conversion error (kg/kg dry -> v/v dry)' @@ -945,7 +946,8 @@ SUBROUTINE CALC_GOSAT_CH4_FORCE( Input_Opt, State_Chm, State_Grid, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN diff --git a/GeosCore/hco_interface_gc_mod.F90 b/GeosCore/hco_interface_gc_mod.F90 index ef6a63feb..3554f9f78 100644 --- a/GeosCore/hco_interface_gc_mod.F90 +++ b/GeosCore/hco_interface_gc_mod.F90 @@ -4605,7 +4605,7 @@ SUBROUTINE Compute_Sflx_for_Vdiff( Input_Opt, State_Chm, State_Diag, & INTEGER :: L, NA INTEGER :: ND, N INTEGER :: Hg_Cat, topMix - INTEGER :: S, origUnit + INTEGER :: S, previous_units REAL(fp) :: dep, emis REAL(fp) :: MW_kg, fracNoHg0Dep REAL(fp) :: tmpFlx @@ -4660,14 +4660,15 @@ SUBROUTINE Compute_Sflx_for_Vdiff( Input_Opt, State_Chm, State_Diag, & !======================================================================= ! Convert units to [v/v dry] aka [mol/mol dry] !======================================================================= - CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + CALL Convert_Spc_Units( + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) ! Trap potential error IF ( RC /= GC_SUCCESS ) THEN @@ -5124,7 +5125,8 @@ SUBROUTINE Compute_Sflx_for_Vdiff( Input_Opt, State_Chm, State_Diag, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) ! Trap potential errors diff --git a/GeosCore/linear_chem_mod.F90 b/GeosCore/linear_chem_mod.F90 index a8e1eeddb..c4fb36afe 100644 --- a/GeosCore/linear_chem_mod.F90 +++ b/GeosCore/linear_chem_mod.F90 @@ -202,8 +202,8 @@ SUBROUTINE DO_LINEAR_CHEM( Input_Opt, State_Chm, State_Grid, & LOGICAL :: IT_IS_A_TAGO3_SIM ! Scalars - INTEGER :: I, J, L, N - INTEGER :: NN, origUnit + INTEGER :: previous_units + INTEGER :: I, J, L, N, NN REAL(fp) :: dt, P, k, M0, RC REAL(fp) :: TK, RDLOSS, T1L, mOH, BryTmp REAL(fp) :: BOXVL, Num, Den, M @@ -602,13 +602,14 @@ SUBROUTINE DO_LINEAR_CHEM( Input_Opt, State_Chm, State_Grid, & ! Convert units to [v/v dry air] aka [mol/mol dry] ! for Linoz and Synoz (ewl, 10/05/15) CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = errCode ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = errCode ) ! Trap potential errors IF ( errCode /= GC_SUCCESS ) THEN @@ -632,7 +633,8 @@ SUBROUTINE DO_LINEAR_CHEM( Input_Opt, State_Chm, State_Grid, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = errCode ) ! Trap potential errors diff --git a/GeosCore/mercury_mod.F90 b/GeosCore/mercury_mod.F90 index 7f13e0dc8..05222aeac 100644 --- a/GeosCore/mercury_mod.F90 +++ b/GeosCore/mercury_mod.F90 @@ -259,7 +259,7 @@ SUBROUTINE EmissMercury( Input_Opt, State_Chm, State_Diag, & ! !LOCAL VARIABLES: ! LOGICAL, SAVE :: FIRST = .TRUE. - INTEGER :: THISMONTH, I, J, origUnit + INTEGER :: THISMONTH, I, J, previous_units ! Pointers REAL(f4), POINTER :: Ptr2D(:,:) @@ -279,13 +279,14 @@ SUBROUTINE EmissMercury( Input_Opt, State_Chm, State_Diag, & ! Convert species units to [kg] for EMISSMERCURY (ewl, 8/12/15) CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = KG_SPECIES, & + previous_units = previous_units, & + RC = RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN @@ -373,7 +374,8 @@ SUBROUTINE EmissMercury( Input_Opt, State_Chm, State_Diag, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN @@ -682,16 +684,16 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & LOGICAL, SAVE :: FIRST = .TRUE. ! Scalars - LOGICAL :: doSuppress - INTEGER :: I, J, L, K - INTEGER :: N, NN, CN, Hg_Cat - INTEGER :: NA, F, SpcID, KppID - INTEGER :: P, MONTH, YEAR, IRH - INTEGER :: TotSteps, TotFuncs, TotJacob, TotAccep - INTEGER :: TotRejec, TotNumLU, HCRC, IERR - INTEGER :: Day, S, errorCount, origUnit - REAL(fp) :: REL_HUM, rtim, itim, TOUT - REAL(fp) :: T, TIN + LOGICAL :: doSuppress, previous_units + INTEGER :: I, J, L, K + INTEGER :: N, NN, CN, Hg_Cat + INTEGER :: NA, F, SpcID, KppID + INTEGER :: P, MONTH, YEAR, IRH + INTEGER :: TotSteps, TotFuncs, TotJacob, TotAccep + INTEGER :: TotRejec, TotNumLU, HCRC, IERR + INTEGER :: Day, S, errorCount + REAL(fp) :: REL_HUM, rtim, itim, TOUT + REAL(fp) :: T, TIN ! Strings CHARACTER(LEN=16) :: thisName @@ -867,13 +869,14 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & ! Convert species to [molec/cm3] (ewl, 8/16/16) !====================================================================== CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLECULES_SPECIES_PER_CM3, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_All, & + new_units = MOLECULES_SPECIES_PER_CM3, & + previous_units = previous_units, & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN errMsg = 'Unit conversion error!' @@ -1388,7 +1391,8 @@ SUBROUTINE ChemMercury( Input_Opt, State_Chm, State_Diag, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_All, & + new_units = previous_units, & RC = RC ) ! Trap potential errors diff --git a/GeosCore/mixing_mod.F90 b/GeosCore/mixing_mod.F90 index 8ab02f98e..f72e30746 100644 --- a/GeosCore/mixing_mod.F90 +++ b/GeosCore/mixing_mod.F90 @@ -249,7 +249,7 @@ SUBROUTINE DO_TEND( Input_Opt, State_Chm, State_Diag, State_Grid, & ! ! Scalars INTEGER :: I, J, L, L1, L2, N, D, NN, NA, nAdvect, S - INTEGER :: DRYDEPID, origUnit + INTEGER :: DRYDEPID, previous_units INTEGER :: PBL_TOP, DRYD_TOP, EMIS_TOP REAL(fp) :: TS, TMP, FRQ, RKT, FRAC, FLUX, AREA_M2 REAL(fp) :: MWkg, DENOM @@ -362,13 +362,14 @@ SUBROUTINE DO_TEND( Input_Opt, State_Chm, State_Diag, State_Grid, & ! Now use units kg/m2 as State_Chm%SPECIES units in DO_TEND to ! remove area-dependency (ewl, 9/30/15) CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES_PER_M2, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = KG_SPECIES_PER_M2, & + previous_units = previous_units, & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Unit conversion error!' @@ -952,7 +953,8 @@ SUBROUTINE DO_TEND( Input_Opt, State_Chm, State_Diag, State_Grid, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN diff --git a/GeosCore/pbl_mix_mod.F90 b/GeosCore/pbl_mix_mod.F90 index 021006bd1..1549cf929 100644 --- a/GeosCore/pbl_mix_mod.F90 +++ b/GeosCore/pbl_mix_mod.F90 @@ -94,7 +94,7 @@ SUBROUTINE Do_Full_Pbl_Mixing( Input_Opt, State_Chm, State_Diag, & INTEGER :: N INTEGER :: NA INTEGER :: TS_Dyn - INTEGER :: origUnit + INTEGER :: previous_units REAL(f8) :: DT_Dyn ! Strings @@ -152,13 +152,14 @@ SUBROUTINE Do_Full_Pbl_Mixing( Input_Opt, State_Chm, State_Diag, & ! Convert species to [v/v dry] aka [mol/mol dry] CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN @@ -192,7 +193,8 @@ SUBROUTINE Do_Full_Pbl_Mixing( Input_Opt, State_Chm, State_Diag, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) ! Trap potential errors diff --git a/GeosCore/rrtmg_rad_transfer_mod.F90 b/GeosCore/rrtmg_rad_transfer_mod.F90 index 55159421c..d8abba1c2 100644 --- a/GeosCore/rrtmg_rad_transfer_mod.F90 +++ b/GeosCore/rrtmg_rad_transfer_mod.F90 @@ -204,7 +204,7 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & LOGICAL :: LOUTPUTAERO ! OUTPUT AEROSOL DIAGNOSTICS? INTEGER :: ITIMEVALS(8) INTEGER :: IDIAGOUT ! INDEX OF SPC OPTICS FOR OUTPUT - INTEGER :: origUnit + INTEGER :: previous_units REAL*8 :: OLDSECS, NEWSECS ! SAVEd scalars @@ -513,13 +513,14 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & ! Convert species units to [kg/kg dry] for RRTMG CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES_PER_KG_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = KG_SPECIES_PER_KG_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN @@ -1709,7 +1710,8 @@ SUBROUTINE DO_RRTMG_RAD_TRANSFER( ThisDay, ThisMonth, iCld, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN diff --git a/GeosCore/set_global_ch4_mod.F90 b/GeosCore/set_global_ch4_mod.F90 index baf2779ec..1e7c7eb72 100644 --- a/GeosCore/set_global_ch4_mod.F90 +++ b/GeosCore/set_global_ch4_mod.F90 @@ -98,7 +98,8 @@ SUBROUTINE Set_CH4( Input_Opt, State_Chm, State_Diag, State_Grid, & ! ! Scalars INTEGER :: I, J, L, PBL_TOP, id_CH4, DT - INTEGER :: OrigUnit + INTEGER :: previous_units + INTEGER :: mapping(1) REAL(fp) :: CH4, dCH4 LOGICAL :: FOUND @@ -128,7 +129,8 @@ SUBROUTINE Set_CH4( Input_Opt, State_Chm, State_Diag, State_Grid, & ENDIF ! Get species ID - id_CH4 = Ind_( 'CH4' ) + id_CH4 = Ind_( 'CH4' ) + mapping(1) = id_CH4 ! Get dynamic timestep DT = GET_TS_DYN() @@ -178,13 +180,14 @@ SUBROUTINE Set_CH4( Input_Opt, State_Chm, State_Diag, State_Grid, & ! Convert species to [v/v dry] aka [mol/mol dry] for this routine CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = mapping, & + new_units = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) ! Add info to logfile IF ( FOUND .AND. Input_Opt%amIRoot .AND. FIRST ) THEN @@ -251,7 +254,8 @@ SUBROUTINE Set_CH4( Input_Opt, State_Chm, State_Diag, State_Grid, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = mapping, & + new_units = previous_units, & RC = RC ) ! Trap potential errors diff --git a/GeosCore/sulfate_mod.F90 b/GeosCore/sulfate_mod.F90 index d4c877324..5b202eddb 100644 --- a/GeosCore/sulfate_mod.F90 +++ b/GeosCore/sulfate_mod.F90 @@ -273,7 +273,7 @@ SUBROUTINE CHEMSULFATE( Input_Opt, State_Chm, State_Diag, State_Grid, & LOGICAL :: LDSTUP INTEGER :: I, J, L, N, MONTH REAL(fp) :: DTCHEM - INTEGER :: origUnit + INTEGER :: previous_units ! Strings CHARACTER(LEN=255) :: ErrMsg, ThisLoc @@ -536,13 +536,14 @@ SUBROUTINE CHEMSULFATE( Input_Opt, State_Chm, State_Diag, State_Grid, & ! Convert species to [v/v dry] aka [mol/mol dry] CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN CALL GC_Error('Unit conversion error', RC, & @@ -677,6 +678,7 @@ SUBROUTINE CHEMSULFATE( Input_Opt, State_Chm, State_Diag, State_Grid, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & origUnit = origUnit, & RC = RC ) @@ -790,7 +792,7 @@ SUBROUTINE EMISSSULFATETOMAS( Input_Opt, State_Chm, State_Grid, & INTEGER :: TID, I, J, L, M INTEGER :: ii=53, jj=29, ll=1 REAL(fp) :: NH4_CONC - INTEGER :: origUnit + INTEGER :: previous_units ! Pointers TYPE(SpcConc), POINTER :: Spc(:) @@ -806,13 +808,14 @@ SUBROUTINE EMISSSULFATETOMAS( Input_Opt, State_Chm, State_Grid, & ! Convert species to [kg] for TOMAS. This will be removed once ! TOMAS uses mixing ratio instead of mass as tracer units (ewl, 9/11/15) CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = KG_SPECIES, & + previous_units = previous_units, & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN CALL GC_Error('Unit conversion error', RC, & @@ -883,7 +886,8 @@ SUBROUTINE EMISSSULFATETOMAS( Input_Opt, State_Chm, State_Grid, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN @@ -7862,7 +7866,7 @@ SUBROUTINE CHEM_SO4_AQ( Input_Opt, State_Chm, State_Grid, State_Met, RC ) ! INTEGER :: I, J, L INTEGER :: k, binact1, binact2 - INTEGER :: KMIN, origUnit + INTEGER :: KMIN, previous_units REAL(fp) :: SO4OXID !================================================================= @@ -7874,13 +7878,14 @@ SUBROUTINE CHEM_SO4_AQ( Input_Opt, State_Chm, State_Grid, State_Met, RC ) ! Convert species from to [kg] CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_unit = KG_SPECIES, & + previous_units = previous_units, & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN CALL GC_Error('Unit conversion error', RC, & @@ -7944,7 +7949,8 @@ SUBROUTINE CHEM_SO4_AQ( Input_Opt, State_Chm, State_Grid, State_Met, RC ) State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN diff --git a/GeosCore/tomas_mod.F90 b/GeosCore/tomas_mod.F90 index a148cd1b1..4e432f3f3 100644 --- a/GeosCore/tomas_mod.F90 +++ b/GeosCore/tomas_mod.F90 @@ -343,12 +343,12 @@ SUBROUTINE DO_TOMAS( Input_Opt, State_Chm, State_Diag, State_Grid, & ! Assume success RC = GC_SUCCESS - ! Check that species units are in [kg] (ewl, 8/13/15) - IF ( State_Chm%Spc_Units /= KG_SPECIES ) THEN - MSG = 'Incorrect species units: ' // TRIM(UNIT_STR(State_Chm%Spc_Units)) - LOC = 'Routine DO_TOMAS in tomas_mod.F90' - CALL GC_Error( MSG, RC, LOC ) - ENDIF + !! Check that species units are in [kg] (ewl, 8/13/15) + !IF ( State_Chm%Spc_Units /= KG_SPECIES ) THEN + ! MSG = 'Incorrect species units: ' // TRIM(UNIT_STR(State_Chm%Spc_Units)) + ! LOC = 'Routine DO_TOMAS in tomas_mod.F90' + ! CALL GC_Error( MSG, RC, LOC ) + !ENDIF ! Do TOMAS aerosol microphysics CALL AEROPHYS( Input_Opt, State_Chm, State_Grid, State_Met, RC ) @@ -517,11 +517,11 @@ SUBROUTINE AEROPHYS( Input_Opt, State_Chm, State_Grid, State_Met, RC ) ! are now generally [kg/kg] in GEOS-Chem, they are converted to ! kg for TOMAS elsewhere in tomas_mod prior to calling this subroutine ! (ewl, 8/13/15) - IF ( State_Chm%Spc_Units /= KG_SPECIES ) THEN - MSG = 'Incorrect species units: ' // TRIM(UNIT_STR(State_Chm%Spc_Units)) - LOC = 'Routine AEROPHYS in tomas_mod.F90' - CALL GC_Error( MSG, RC, LOC ) - ENDIF + !IF ( State_Chm%Spc_Units /= KG_SPECIES ) THEN + ! MSG = 'Incorrect species units: ' // TRIM(UNIT_STR(State_Chm%Spc_Units)) + ! LOC = 'Routine AEROPHYS in tomas_mod.F90' + ! CALL GC_Error( MSG, RC, LOC ) + !ENDIF ! Point to chemical species array [kg] Spc => State_Chm%Species @@ -3643,6 +3643,7 @@ SUBROUTINE AQOXID( MOXID, KMIN, I, J, L, Input_Opt, & ! Assume success RC = GC_SUCCESS + ! TODO: Update since Spc_Units are no longer included ! Check that species units are in [kg] (ewl, 8/13/15) ! Convert species concentration units to [kg] if not necessary. ! Units are [kg/m2] if AQOXID is called from wet deposition diff --git a/GeosCore/tracer_mod.F90 b/GeosCore/tracer_mod.F90 index 2a4006731..8b0e24735 100644 --- a/GeosCore/tracer_mod.F90 +++ b/GeosCore/tracer_mod.F90 @@ -100,7 +100,7 @@ SUBROUTINE Tracer_Source_Phase( Input_Opt, State_Chm, State_Grid, & ! ! Scalars INTEGER :: I, J, L, N, DT - INTEGER :: origUnit + INTEGER :: previous_units REAL(fp) :: Local_Tally REAL(fp) :: Total_Area REAL(fp) :: Total_Spc @@ -147,13 +147,15 @@ SUBROUTINE Tracer_Source_Phase( Input_Opt, State_Chm, State_Grid, & ! Convert species units to v/v dry !======================================================================= CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) + IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Unit conversion error (kg -> v/v dry)' CALL GC_Error( ErrMsg, RC, ThisLoc ) @@ -422,7 +424,8 @@ SUBROUTINE Tracer_Source_Phase( Input_Opt, State_Chm, State_Grid, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN diff --git a/GeosCore/vdiff_mod.F90 b/GeosCore/vdiff_mod.F90 index d201dcef2..939c4fd59 100644 --- a/GeosCore/vdiff_mod.F90 +++ b/GeosCore/vdiff_mod.F90 @@ -2240,7 +2240,7 @@ SUBROUTINE Do_Vdiff( Input_Opt, State_Chm, State_Diag, & ! ! Scalars INTEGER :: TS_Dyn - INTEGER :: origUnit + INTEGER :: previous_units REAL(fp) :: DT_Dyn ! Strings @@ -2302,13 +2302,14 @@ SUBROUTINE Do_Vdiff( Input_Opt, State_Chm, State_Diag, & ! Convert species concentration to [v/v dry] aka [mol/mol dry] CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_Advect, & + new_units = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN diff --git a/GeosCore/wetscav_mod.F90 b/GeosCore/wetscav_mod.F90 index f4ce55658..22c22b808 100644 --- a/GeosCore/wetscav_mod.F90 +++ b/GeosCore/wetscav_mod.F90 @@ -1697,6 +1697,7 @@ SUBROUTINE WASHOUT( I, J, L, & UNITCHANGE_KGKG = .FALSE. UNITCHANGE_KGM2 = .FALSE. + ! TODO: Fix this since Spc_Units are no longer supported IF ( State_Chm%Spc_Units == KG_SPECIES_PER_KG_DRY_AIR ) THEN UNITCHANGE_KGKG = .TRUE. CALL ConvertBox_KgKgDry_to_Kg( I, J, L, & @@ -3185,7 +3186,7 @@ SUBROUTINE WETDEP( Input_Opt, State_Chm, State_Diag, State_Grid, & LOGICAL :: IS_RAINOUT, IS_WASHOUT, IS_BOTH INTEGER :: I, IDX, J, L INTEGER :: N, NW, Hg_Cat, EC - INTEGER :: origUnit + INTEGER :: previous_units REAL(fp) :: Q, QDOWN, DT, DT_OVER_TAU REAL(fp) :: K, K_MIN, K_RAIN, RAINFRAC REAL(fp) :: F, FTOP, F_PRIME, WASHFRAC @@ -3227,13 +3228,14 @@ SUBROUTINE WETDEP( Input_Opt, State_Chm, State_Diag, State_Grid, & ! Convert species concentration to mass per unit area (kg/m2) for ! wet deposition since computation is done per column (ewl, 9/8/15) CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES_PER_M2, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_WetDep, & + new_units = KG_SPECIES_PER_M2, & + previous_units = previous_units, & + RC = RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN @@ -3815,7 +3817,8 @@ SUBROUTINE WETDEP( Input_Opt, State_Chm, State_Diag, State_Grid, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_WetDep, & + new_units = previous_units, & RC = RC ) ! Trap potential errors diff --git a/Interfaces/GCHP/gchp_chunk_mod.F90 b/Interfaces/GCHP/gchp_chunk_mod.F90 index ef6b5f890..0952027de 100644 --- a/Interfaces/GCHP/gchp_chunk_mod.F90 +++ b/Interfaces/GCHP/gchp_chunk_mod.F90 @@ -711,7 +711,8 @@ SUBROUTINE GCHP_Chunk_Run( GC, & TYPE(ESMF_Field) :: IntField REAL*8 :: DT CHARACTER(LEN=ESMF_MAXSTR) :: Iam - INTEGER :: STATUS, HCO_PHASE, RST, origUnit + INTEGER :: STATUS, HCO_PHASE, RST + INTEGER :: previous_units #if defined( MODEL_GEOS ) INTEGER :: I, J, L #endif @@ -969,13 +970,14 @@ SUBROUTINE GCHP_Chunk_Run( GC, & ! Convert to dry mixing ratio CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES_PER_KG_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_All, & + new_units = KG_SPECIES_PER_KG_DRY_AIR, & + previous_units = origUnit, & + RC = RC ) _ASSERT(RC==GC_SUCCESS, 'Error calling CONVERT_SPC_UNITS') ! SDE 05/28/13: Set H2O to STT if relevant @@ -1568,7 +1570,8 @@ SUBROUTINE GCHP_Chunk_Run( GC, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_All, & + new_units = previous_units, & RC = RC ) _ASSERT(RC==GC_SUCCESS, 'Error calling CONVERT_SPC_UNITS') diff --git a/Interfaces/GEOS/geos_CarbonInterface.F90 b/Interfaces/GEOS/geos_CarbonInterface.F90 index 4fda7a268..47e6d7f96 100644 --- a/Interfaces/GEOS/geos_CarbonInterface.F90 +++ b/Interfaces/GEOS/geos_CarbonInterface.F90 @@ -503,7 +503,7 @@ SUBROUTINE GEOS_CarbonSetConc( Import, Input_Opt, State_Chm, & ! CHARACTER(LEN=*), PARAMETER :: myname = 'GEOS_CarbonSetConc' CHARACTER(LEN=*), PARAMETER :: Iam = myname - CHARACTER(LEN=63) :: OrigUnit + CHARACTER(LEN=63) :: previous_units INTEGER :: I, LM, indCO2, indCO, STATUS REAL, POINTER :: CO2(:,:,:) => null() REAL, POINTER :: COmeso(:,:) => null() @@ -519,13 +519,14 @@ SUBROUTINE GEOS_CarbonSetConc( Import, Input_Opt, State_Chm, & ! Make sure concentrations are in kg/kg total ! (this should already be the case) CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = KG_SPECIES_PER_KG_TOTAL_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_All, & + new_units = KG_SPECIES_PER_KG_TOTAL_AIR, & + previous_units = previous_units, & + RC = RC ) ASSERT_(RC==GC_SUCCESS) ! Get index @@ -570,7 +571,7 @@ SUBROUTINE GEOS_CarbonSetConc( Import, Input_Opt, State_Chm, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + new_units = previous_units, & RC = RC ) ASSERT_( RC == GC_SUCCESS ) diff --git a/Interfaces/GEOS/geos_interface.F90 b/Interfaces/GEOS/geos_interface.F90 index b197863fa..b445cc888 100644 --- a/Interfaces/GEOS/geos_interface.F90 +++ b/Interfaces/GEOS/geos_interface.F90 @@ -1135,7 +1135,7 @@ SUBROUTINE GEOS_Diagnostics( GC, IMPORT, EXPORT, Clock, Phase, & REAL, POINTER :: LFR(:,:) => NULL() REAL, POINTER :: CNV_FRC(:,:) => NULL() - CHARACTER(LEN=ESMF_MAXSTR) :: OrigUnit + INTEGER :: previous_units __Iam__('GEOS_Diagnostics') @@ -1170,14 +1170,27 @@ SUBROUTINE GEOS_Diagnostics( GC, IMPORT, EXPORT, Clock, Phase, & ! Move 'regular' GEOS-Chem diagnostics from gchp_chunk_mod.F90 to here to ! make sure that these diagnostics see any post-run updates. ! Diagnostics routine expects units of kg/kg dry. - CALL Convert_Spc_Units ( Input_Opt, State_Chm, State_Grid, State_Met, & - 'kg/kg dry', RC, OrigUnit=OrigUnit ) + CALL Convert_Spc_Units( & + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_All, & + new_units = KG_SPECIES_PER_KG_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) _ASSERT(RC==GC_SUCCESS, 'Error calling CONVERT_SPC_UNITS') CALL Set_Diagnostics_EndofTimestep( Input_Opt, State_Chm, State_Diag, & State_Grid, State_Met, RC ) _ASSERT(RC==GC_SUCCESS, 'Error calling Set_Diagnostics_EndofTimestep') - CALL Convert_Spc_Units ( Input_Opt, State_Chm, State_Grid, State_Met, & - OrigUnit, RC ) + CALL Convert_Spc_Units( & + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chm%Map_All, & + new_units = previous_units, & + RC = RC ) _ASSERT(RC==GC_SUCCESS, 'Error calling CONVERT_SPC_UNITS') !======================================================================= diff --git a/ObsPack/obspack_mod.F90 b/ObsPack/obspack_mod.F90 index 4c8f6014c..f89f0a7f0 100644 --- a/ObsPack/obspack_mod.F90 +++ b/ObsPack/obspack_mod.F90 @@ -1319,7 +1319,7 @@ SUBROUTINE ObsPack_Sample( yyyymmdd, hhmmss, Input_Opt, State_Chm, & LOGICAL :: prtLog, doSample INTEGER :: I, J, L, N, R, S INTEGER :: Yr, Mo, Da, Hr, Mn, Sc - INTEGER :: origUnit + INTEGER :: previous_units REAL(f8) :: TsStart, TsEnd ! Strings @@ -1345,13 +1345,14 @@ SUBROUTINE ObsPack_Sample( yyyymmdd, hhmmss, Input_Opt, State_Chm, & ! call this again requesting that the species are converted back to the ! InUnit values. CALL Convert_Spc_Units( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - State_Met = State_Met, & - outUnit = MOLES_SPECIES_PER_MOLES_DRY_AIR, & - origUnit = origUnit, & - RC = RC ) + Input_Opt = Input_Opt, & + State_Chm = State_Chm, & + State_Grid = State_Grid, & + State_Met = State_Met, & + mapping = State_Chem%Map_Advect, & + new_units = MOLES_SPECIES_PER_MOLES_DRY_AIR, & + previous_units = previous_units, & + RC = RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN @@ -1492,7 +1493,8 @@ SUBROUTINE ObsPack_Sample( yyyymmdd, hhmmss, Input_Opt, State_Chm, & State_Chm = State_Chm, & State_Grid = State_Grid, & State_Met = State_Met, & - outUnit = origUnit, & + mapping = State_Chm%Map_Advect, & + new_units = previous_units, & RC = RC ) ! Trap potential errors