Skip to content

Commit

Permalink
GC-Classic updates to use 1D species vector containing 3D concentrati…
Browse files Browse the repository at this point in the history 
…on arrays

Species_mod now contains type SpcConc which is a pointer to a 3D REAL(fp)
array. State_chm_mod now contains a 1D vector called SpeciesVec that points to
type SpcConc. The 4D array Species is removed. An example of the usage change
is:

old: State_Chm%Species(I,J,L,N)
new: State_Chm%SpeciesVec(N)%Conc(I,J,L)

Where pointer Spc was used locally to point to State_Chm%Species, it now
points to State_Chm%SpeciesVec. For example:

old: Spc(I,J,L,N)
new: Spc(N)%Conc(I,J,L)

Signed-off-by: Lizzie Lundgren <elundgren@seas.harvard.edu>
  • Loading branch information
@lizziel
lizziel committed Jan 31, 2022
1 parent 2b3b2b3 commit d3a3311
Show file tree
Hide file tree
Showing 59 changed files with 2,360 additions and 2,090 deletions.
37 changes: 19 additions & 18 deletions GeosCore/RnPbBe_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,6 +79,7 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
!
USE ErrCode_Mod
USE Input_Opt_Mod, ONLY : OptInput
USE Species_Mod, ONLY : SpcConc
USE State_Chm_Mod, ONLY : ChmState
USE State_Chm_Mod, ONLY : Ind_
USE State_Diag_Mod, ONLY : DgnState
Expand Down Expand Up @@ -130,7 +131,7 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
REAL(fp) :: Rn_LOST(State_Grid%NX,State_Grid%NY,State_Grid%NZ)

! Pointers
REAL(fp), POINTER :: Spc(:,:,:,:)
TYPE(SpcConc), POINTER :: Spc(:)
!
! !DEFINED PARAMETERS
!
Expand Down Expand Up @@ -159,7 +160,7 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
DTCHEM = GET_TS_CHEM()

! Point to the species array
Spc => State_Chm%Species
Spc => State_Chm%SpeciesVec

!-----------------------------------------------------------------
! Pre-compute exponential terms and do other first-time setup
Expand Down Expand Up @@ -219,7 +220,7 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
DO I = 1, State_Grid%NX

! Rn_LOST = amount of 222Rn lost to decay [kg]
Rn_LOST(I,J,L) = Spc(I,J,L,id_Rn222) * ( 1.0_fp - EXP_Rn )
Rn_LOST(I,J,L) = Spc(id_Rn222)%Conc(I,J,L) * ( 1.0_fp - EXP_Rn )

!-----------------------------------------------------------
! HISTORY (aka netCDF diagnostics)
Expand All @@ -236,7 +237,7 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
ENDIF

! Subtract Rn_LOST from Spc [kg]
Spc(I,J,L,id_Rn222) = Spc(I,J,L,id_Rn222) - Rn_LOST(I,J,L)
Spc(id_Rn222)%Conc(I,J,L) = Spc(id_Rn222)%Conc(I,J,L) - Rn_LOST(I,J,L)
ENDDO
ENDDO
ENDDO
Expand Down Expand Up @@ -271,18 +272,18 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
ENDIF

! Add 210Pb gained by decay from 222Rn into Spc [kg]
Spc(I,J,L,id_Pb210) = Spc(I,J,L,id_Pb210) + ADD_Pb
Spc(id_Pb210)%Conc(I,J,L) = Spc(id_Pb210)%Conc(I,J,L) + ADD_Pb

! Update stratospheric 210Pb [kg]
IF ( State_Met%InStratosphere(I,J,L) .and. id_Pb210Strat > 0 ) THEN
Spc(I,J,L,id_Pb210Strat) = Spc(I,J,L,id_Pb210Strat) + ADD_Pb
Spc(id_Pb210Strat)%Conc(I,J,L) = Spc(id_Pb210Strat)%Conc(I,J,L) + ADD_Pb
ENDIF

! Amount of 210Pb lost to radioactive decay [kg]
! NOTE: we've already added in the 210Pb gained from 222Rn
Pb_LOST = Spc(I,J,L,id_Pb210) * ( 1.0_fp - EXP_Pb )
Pb_LOST = Spc(id_Pb210)%Conc(I,J,L) * ( 1.0_fp - EXP_Pb )
IF ( id_Pb210Strat > 0 ) THEN
PbStrat_LOST = Spc(I,J,L,id_Pb210Strat) * ( 1.0_fp - EXP_Pb)
PbStrat_LOST = Spc(id_Pb210Strat)%Conc(I,J,L) * ( 1.0_fp - EXP_Pb)
ENDIF

!-----------------------------------------------------------
Expand Down Expand Up @@ -310,11 +311,11 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
ENDIF

! Subtract 210Pb lost to decay from Spc [kg]
Spc(I,J,L,id_Pb210) = Spc(I,J,L,id_Pb210) - Pb_LOST
Spc(id_Pb210)%Conc(I,J,L) = Spc(id_Pb210)%Conc(I,J,L) - Pb_LOST

! Update stratospheric 210Pb [kg]
IF ( id_Pb210Strat > 0 ) THEN
Spc(I,J,L,id_Pb210Strat) = Spc(I,J,L,id_Pb210Strat) - PbStrat_LOST
Spc(id_Pb210Strat)%Conc(I,J,L) = Spc(id_Pb210Strat)%Conc(I,J,L) - PbStrat_LOST
ENDIF

ENDDO
Expand All @@ -337,9 +338,9 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
DO I = 1, State_Grid%NX

! Amount of 7Be lost to decay [kg]
Be7_LOST = Spc(I,J,L,id_Be7) * ( 1d0 - EXP_Be7 )
Be7_LOST = Spc(id_Be7)%Conc(I,J,L) * ( 1d0 - EXP_Be7 )
IF ( id_Be7Strat > 0 ) THEN
Be7Strat_LOST = Spc(I,J,L,id_Be7Strat) * ( 1d0 - EXP_Be7 )
Be7Strat_LOST = Spc(id_Be7Strat)%Conc(I,J,L) * ( 1d0 - EXP_Be7 )
ENDIF

!-----------------------------------------------------------
Expand Down Expand Up @@ -367,11 +368,11 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
ENDIF

! Subtract amount of 7Be lost to decay from Spc [kg]
Spc(I,J,L,id_Be7) = Spc(I,J,L,id_Be7) - Be7_LOST
Spc(id_Be7)%Conc(I,J,L) = Spc(id_Be7)%Conc(I,J,L) - Be7_LOST

! Update stratospheric 7Be [kg]
IF ( id_Be7Strat > 0 ) THEN
Spc(I,J,L,id_Be7Strat) = Spc(I,J,L,id_Be7Strat) - Be7Strat_LOST
Spc(id_Be7Strat)%Conc(I,J,L) = Spc(id_Be7Strat)%Conc(I,J,L) - Be7Strat_LOST
ENDIF

ENDDO
Expand All @@ -394,9 +395,9 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
DO I = 1, State_Grid%NX

! Amount of 10Be lost to decay [kg]
Be10_LOST = Spc(I,J,L,id_Be10) * ( 1d0 - EXP_Be10 )
Be10_LOST = Spc(id_Be10)%Conc(I,J,L) * ( 1d0 - EXP_Be10 )
IF ( id_Be10Strat > 0 ) THEN
Be10Strat_LOST = Spc(I,J,L,id_Be10Strat) * ( 1d0 - EXP_Be10 )
Be10Strat_LOST = Spc(id_Be10Strat)%Conc(I,J,L) * ( 1d0 - EXP_Be10 )
ENDIF

!-----------------------------------------------------------
Expand Down Expand Up @@ -424,11 +425,11 @@ SUBROUTINE CHEMRnPbBe( Input_Opt, State_Chm, State_Diag, &
ENDIF

! Subtract amount of 10Be lost to decay from Spc [kg]
Spc(I,J,L,id_Be10) = Spc(I,J,L,id_Be10) - Be10_LOST
Spc(id_Be10)%Conc(I,J,L) = Spc(id_Be10)%Conc(I,J,L) - Be10_LOST

! Update stratospheric 10Be [kg]
IF ( id_Be10Strat > 0 ) THEN
Spc(I,J,L,id_Be10Strat) = Spc(I,J,L,id_Be10Strat) - Be10Strat_LOST
Spc(id_Be10Strat)%Conc(I,J,L) = Spc(id_Be10Strat)%Conc(I,J,L) - Be10Strat_LOST
ENDIF

ENDDO
Expand Down
34 changes: 18 additions & 16 deletions GeosCore/aero_drydep.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,8 @@ SUBROUTINE AERO_DRYDEP( Input_Opt, State_Chm, State_Diag, &
USE PhysConstants, ONLY : g0
USE PhysConstants, ONLY : AVO
USE PRECISION_MOD
!ewlspc
USE Species_Mod, ONLY : SpcConc
USE State_Chm_Mod, ONLY : ChmState
USE State_Chm_Mod, ONLY : Ind_
USE State_Diag_Mod, ONLY : DgnState
Expand Down Expand Up @@ -96,10 +98,10 @@ SUBROUTINE AERO_DRYDEP( Input_Opt, State_Chm, State_Diag, &
REAL(fp) :: X0(IBINS,ICOMP-IDIAG+1 )

! Pointers
REAL(fp), POINTER :: Spc (:,:,:,:)
REAL(fp), POINTER :: BXHEIGHT(:,:,: )
REAL(fp), POINTER :: T (:,:,: )
REAL(fp), POINTER :: DepFreq (:,:,: ) ! IM, JM, nDryDep
TYPE(SpcConc), POINTER :: Spc (: )
REAL(fp), POINTER :: BXHEIGHT(:,:,: )
REAL(fp), POINTER :: T (:,:,: )
REAL(fp), POINTER :: DepFreq (:,:,: ) ! IM, JM, nDryDep

! SAVEd arrays
INTEGER, SAVE :: DRYD(IBINS)
Expand Down Expand Up @@ -132,7 +134,7 @@ SUBROUTINE AERO_DRYDEP( Input_Opt, State_Chm, State_Diag, &
prtDebug = ( Input_Opt%LPRT .and. Input_Opt%amIRoot )

! Initialize pointers
Spc => State_Chm%Species
Spc => State_Chm%SpeciesVec
BXHEIGHT => State_Met%BXHEIGHT
T => State_Met%T
DepFreq => State_Chm%DryDepFreq
Expand Down Expand Up @@ -298,7 +300,7 @@ SUBROUTINE AERO_DRYDEP( Input_Opt, State_Chm, State_Diag, &
! Method is to solve bidiagonal matrix
! which is implicit and first order accurate in Z
DO L = 1, State_Grid%NZ
TC0(L) = Spc(I,J,L,ID)
TC0(L) = Spc(ID)%Conc(I,J,L)
TC(L) = TC0(L)
ENDDO

Expand All @@ -316,7 +318,7 @@ SUBROUTINE AERO_DRYDEP( Input_Opt, State_Chm, State_Diag, &
ENDDO

DO L = 1, State_Grid%NZ
Spc(I,J,L,ID) = TC(L)
Spc(ID)%Conc(I,J,L) = TC(L)

! Debug
!IF (i==ix .and. j==jx .and. l==ll ) &
Expand Down Expand Up @@ -411,15 +413,15 @@ SUBROUTINE AERO_DRYDEP( Input_Opt, State_Chm, State_Diag, &
DO JC = 1, ICOMP-IDIAG+1
DO BIN = 1, IBINS
ID = id_NK1 - 1 + BIN + ( IBINS * (JC-1) )
X0(BIN,JC) = Spc(I,J,L,ID)
X0(BIN,JC) = Spc(ID)%Conc(I,J,L)
ENDDO
ENDDO
! Debug
!IF (i==ii .and. j==jj .and. L==1) &
! print *,'L Spc(',I,J,'L',bb,') DIF ', &
! print *,'L Spc(',bb,')%Conc(',I,J,'L) DIF ', &
! 'FLUX AD44'
!IF (i==ix .and. j==jx .and. L==1) &
! print *,'L Spc(',I,J,'L',bb,') DIF ', &
! print *,'L Spc(',bb,')%Conc(',I,J,'L) DIF ', &
! 'FLUX AD44'
!ENDIF
! Dry deposit 1 aerosol component at a time, start looping from
Expand Down Expand Up @@ -471,18 +473,18 @@ SUBROUTINE AERO_DRYDEP( Input_Opt, State_Chm, State_Diag, &
ENDIF
! Debug
!if(i==ii .and. j==jj .and. bin==bb .and. JC==1) &
! print *,'>',L, Spc(I,J,L,ID), X0(BIN,JC) - X, FLUX, &
! print *,'>',L, Spc(ID)%Conc(I,J,L), X0(BIN,JC) - X, FLUX, &
! AD44(I,J,DRYD(BIN),1)
!if(i==ii .and. j==jj .and. bin==bb .and. JC==2) &
! print *,'>',L, Spc(I,J,L,ID), X0(BIN,JC) - X, FLUX, &
! print *,'>',L, Spc(ID)%Conc(I,J,L), X0(BIN,JC) - X, FLUX, &
! AD44(I,J,nDryDep+BIN+(JC-2)*IBINS,1)
!if(i==ix .and. j==jx .and. bin==bb .and. JC==ICOMP) &
! print *, L, Spc(I,J,L,ID), X0(BIN,JC) - X, FLUX,
! print *, L, Spc(ID)%Conc(I,J,L), X0(BIN,JC) - X, FLUX,
! AD44(I,J,nDryDep+BIN+(JC-2)*IBINS,1)
#endif

! Swap X back into Spc array
Spc(I,J,L,ID) = X
Spc(ID)%Conc(I,J,L) = X

ENDDO
ENDDO
Expand All @@ -492,7 +494,7 @@ SUBROUTINE AERO_DRYDEP( Input_Opt, State_Chm, State_Diag, &
! mixing_mod.F90 (ckeller, 3/5/15)
! ***********************************************************************
! Dry deposit H2SO4 gas (win, 5/24/06)
Y0 = Spc(I,J,L,id_H2SO4)
Y0 = Spc(id_H2SO4)%Conc(I,J,L,)
RKT = DepFreq(I,J,H2SO4ID) * State_Met%F_UNDER_PBLTOP(I,J,L)
Y = Y0 * EXP(-RKT)

Expand All @@ -517,7 +519,7 @@ SUBROUTINE AERO_DRYDEP( Input_Opt, State_Chm, State_Diag, &
#endif

!Swap final H2SO4 back into Spc array
Spc(I,J,L,id_H2SO4) = Y
Spc(id_H2SO4)%Conc(I,J,L,) = Y

ENDDO
ENDDO
Expand Down

0 comments on commit d3a3311

Please sign in to comment.