Skip to content

Commit

Permalink
replaced .gt. with > etc.
Browse files Browse the repository at this point in the history
  • Loading branch information
@mvertens
mvertens committed Aug 27, 2024
1 parent 62a4573 commit ad84220
Show file tree
Hide file tree
Showing 5 changed files with 52 additions and 66 deletions.
2 changes: 1 addition & 1 deletion src/aero_model.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -539,7 +539,7 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_

! This should not happen since there are only production terms for these gases! !
do cond_vap_idx=1,N_COND_VAP
where(mmr_cond_vap_gasprod(:ncol,:,cond_vap_idx).lt. 0.0_r8)
where(mmr_cond_vap_gasprod(:ncol,:,cond_vap_idx) < 0.0_r8)
mmr_cond_vap_gasprod(:ncol,:,cond_vap_idx) = 0.0_r8
end where
end do
Expand Down
100 changes: 43 additions & 57 deletions src/oslo_aero_ndrop.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,11 +50,9 @@ module oslo_aero_ndrop
real(r8) :: third, twothird, sixth, zero
real(r8) :: sq2, sqpi

integer, parameter :: psat=7 ! number of supersaturations to calc ccn concentration

! supersaturation (%) to determine ccn concentration
integer, parameter :: psat=7 ! number of supersaturations to calc ccn concentration
real(r8), parameter :: supersat(psat)= (/ 0.02_r8, 0.05_r8, 0.1_r8, 0.15_r8, 0.2_r8, 0.5_r8, 1.0_r8 /)

character(len=8) :: ccn_name(psat)= (/'CCN1','CCN2','CCN3','CCN4','CCN5','CCN6','CCN7'/)

! indices in state and pbuf structures
Expand All @@ -78,9 +76,6 @@ module oslo_aero_ndrop
integer, allocatable :: mam_idx(:,:) ! table for local indexing of modal aero number and mmr
integer :: ncnst_tot ! total number of mode number conc + mode species

! Indices for MAM species in the ptend%q array. Needed for prognostic aerosol case.
integer, allocatable :: mam_cnst_idx(:,:)

integer :: tracer_index(0:nmodes,max_tracers_per_mode) ! tracer index
real(r8) :: sumFraction2(pcnst,pver)

Expand Down Expand Up @@ -168,7 +163,7 @@ subroutine ndrop_init_oslo()
end do
end do

! Init the table for local indexing of mam number conc and mmr.
! Init the table for local indexing of mam number conc
! This table uses species index 0 for the number conc.

! Find max number of species in all the modes, and the total
Expand All @@ -181,7 +176,6 @@ subroutine ndrop_init_oslo()
end do

allocate(mam_idx(ntot_amode,0:nspec_max))
allocate(mam_cnst_idx(ntot_amode,0:nspec_max))
allocate(fieldname(ncnst_tot))
allocate(fieldname_cw(ncnst_tot))

Expand Down Expand Up @@ -387,8 +381,8 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
real(r8) :: alogarg
real(r8) :: overlapp(pver), overlapm(pver) ! cloud overlap below, cloud overlap above
real(r8) :: nsource(pcols,pver) ! droplet number source (#/kg/s)
real(r8) :: ndropmix(pcols,pver) ! droplet number mixing (#/kg/s)
real(r8) :: ndropcol(pcols) ! column droplet number (#/m2)
real(r8) :: ndropmix(pcols,pver) ! droplet number mixing (#/kg/s) (diagnostic)
real(r8) :: ndropcol(pcols) ! column droplet number (#/m2) (diagnostic)
real(r8) :: cldo_tmp, cldn_tmp
real(r8) :: tau_cld_regenerate
real(r8) :: tau_cld_regenerate_exp
Expand Down Expand Up @@ -529,7 +523,7 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
do ispec = 1, nspec_amode(imode)
tracerIndex = tracer_index(imode,ispec) !Index in q
cloud_tracer_index = cloudTracerIndex(tracerIndex) !Index in phys-buffer
mm = mam_idx(imode,ispec) !Index in raer/qqcw
mm = mam_idx(imode,ispec) !Index in raer/qqcw
raer(mm)%fld => state%q(:,:,tracerIndex) !NOTE: These are total fields (for example condensate)
call pbuf_get_field(pbuf, cloud_tracer_index, qqcw(mm)%fld) !NOTE: These are total fields (for example condensate)
enddo
Expand All @@ -540,7 +534,8 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
fluxn_tmp(ntot_amode), &
fluxm_tmp(ntot_amode))

wtke = 0._r8
! Initialize turbulent vertical velocity at base of layers (m/s)
wtke(:,:) = 0._r8

! aerosol tendencies
call physics_ptend_init(ptend, state%psetcols, 'ndrop', lq=lq)
Expand Down Expand Up @@ -632,8 +627,8 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
csbot_cscen(ilev) = 1.0_r8
end if

! rce-comment - define wtke at layer centers for new-cloud activation
! and at layer boundaries for old-cloud activation
! define wtke at layer centers for new-cloud activation
! and at layer boundaries for old-cloud activation
wtke_cen(icol,ilev) = wsub(icol,ilev)
wtke(icol,ilev) = wsub(icol,ilev)
wtke_cen(icol,ilev) = max(wtke_cen(icol,ilev), wmixmin)
Expand Down Expand Up @@ -725,7 +720,7 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
end do
call t_stopf('ndrop_getConstituentFraction_check_trackerNormalization1')

call t_startf('ndrop_getConstituentFraction_check_trackerNormalization3')
call t_startf('ndrop_getConstituentFraction_check_trackerNormalization2')
do ilev=top_lev, pver
do itrac=1,pcnst
if (sumFraction(itrac,ilev) > 1.e-2_r8) then
Expand All @@ -742,10 +737,9 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
endif
end do !tracers
end do !levels
call t_stopf('ndrop_getConstituentFraction_check_trackerNormalization3')
call t_stopf('ndrop_getConstituentFraction_check_trackerNormalization2')

call t_stopf('ndrop_getConstituentFraction')
!debug sum fraction for "icol" done

call t_startf('ndrop_getNumberConc')
do imode = 1, nmodes ! Number of modes
Expand All @@ -754,7 +748,7 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
do ilev= top_lev,pver
raercol(ilev,mm,nsav) = numberConcentration(icol,ilev,imode)/cs(icol,ilev) !#/kg air
!In oslo model, number concentrations are diagnostics, so
!Approximate number concentration in each mode by total
!approximate number concentration in each mode by total
!cloud number concentration scaled by how much is available of
!each mode
raercol_cw(ilev,mm,nsav) = ncldwtr(icol,ilev)*numberConcentration(icol,ilev,imode) &
Expand Down Expand Up @@ -835,7 +829,7 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
if (cldn_tmp < cldo_tmp) then
! droplet loss in decaying cloud
nsource(icol,ilev) = nsource(icol,ilev) + qcld(ilev)*(cldn_tmp - cldo_tmp)/cldo_tmp*cldliqf(icol,ilev)*dtinv
qcld(ilev) = qcld(ilev)*(1._r8 + (cldn_tmp - cldo_tmp)/cldo_tmp)
qcld(ilev) = qcld(ilev)*(1._r8 + (cldn_tmp - cldo_tmp)/cldo_tmp)

! convert activated aerosol to interstitial in decaying cloud
dumc = (cldn_tmp - cldo_tmp)/cldo_tmp * cldliqf(icol,ilev)
Expand Down Expand Up @@ -987,18 +981,16 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
if (lcldn(icol,ilev) - lcldn(icol,kp1) > 0.01_r8 .or. ilev == pver) then

! cloud base

! ekd(ilev) = wtke(icol,ilev)*dz(icol,ilev)/sq2pi
! rce-comments
! first, should probably have 1/zs(ilev) here rather than dz(icol,ilev) because
! the turbulent flux is proportional to ekd(ilev)*zs(ilev),
! while the dz(icol,ilev) is used to get flux divergences
! and mixing ratio tendency/change
! second and more importantly, using a single updraft velocity here
! means having monodisperse turbulent updraft and downdrafts.
! The sq2pi factor assumes a normal draft spectrum.
! The fluxn/fluxm from activate must be consistent with the
! fluxes calculated in explmix.
! first, should probably have 1/zs(ilev) here rather than dz(icol,ilev) because
! the turbulent flux is proportional to ekd(ilev)*zs(ilev),
! while the dz(icol,ilev) is used to get flux divergences
! and mixing ratio tendency/change
! second and more importantly, using a single updraft velocity here
! means having monodisperse turbulent updraft and downdrafts.
! The sq2pi factor assumes a normal draft spectrum.
! The fluxn/fluxm from activate must be consistent with the
! fluxes calculated in explmix.
ekd(ilev) = wbar/zs(ilev)

alogarg = max(1.e-20_r8, 1._r8/lcldn(icol,ilev) - 1._r8)
Expand Down Expand Up @@ -1137,21 +1129,19 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,

! no liquid cloud
nsource(icol,ilev) = nsource(icol,ilev) - qcld(ilev)*dtinv
qcld(ilev) = 0.0_r8
qcld(ilev) = 0.0_r8

if (cldn(icol,ilev) < 0.01_r8) then
! no ice cloud either

! convert activated aerosol to interstitial in decaying cloud

do imode = 1, ntot_amode
mm = mam_idx(imode,0)
raercol(ilev,mm,nsav) = raercol(ilev,mm,nsav) + raercol_cw(ilev,mm,nsav) ! cloud-borne aerosol
raercol(ilev,mm,nsav) = raercol(ilev,mm,nsav) + raercol_cw(ilev,mm,nsav) ! cloud-borne aerosol
raercol_cw(ilev,mm,nsav) = 0._r8

do ispec = 1, nspec_amode(imode)
mm = mam_idx(imode,ispec)
raercol(ilev,mm,nsav) = raercol(ilev,mm,nsav) + raercol_cw(ilev,mm,nsav) ! cloud-borne aerosol
raercol(ilev,mm,nsav) = raercol(ilev,mm,nsav) + raercol_cw(ilev,mm,nsav) ! cloud-borne aerosol
raercol_cw(ilev,mm,nsav) = 0._r8
end do
end do
Expand All @@ -1170,33 +1160,30 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,
! load new droplets in layers above, below clouds
dtmin = dtmicro
ekk(top_lev-1) = 0.0_r8
ekk(pver) = 0.0_r8
do ilev = top_lev, pver-1
! rce-comment -- ekd(ilev) is eddy-diffusivity at ilev/ilev+1 interface
! want ekk(ilev) = ekd(ilev) * (density at ilev/ilev+1 interface)
! so use pint(icol,ilev+1) as pint is 1:pverp
! ekk(ilev)=ekd(ilev)*2.*pint(icol,ilev)/(rair*(temp(icol,ilev)+temp(icol,ilev+1)))
! ekk(ilev)=ekd(ilev)*2.*pint(icol,ilev+1)/(rair*(temp(icol,ilev)+temp(icol,ilev+1)))
! ekd(ilev) is eddy-diffusivity at ilev/ilev+1 interface
! want ekk(ilev) = ekd(ilev) * (density at ilev/ilev+1 interface)
ekk(ilev) = ekd(ilev)*csbot(ilev)
end do
ekk(pver) = 0.0_r8

do ilev = top_lev, pver
km1 = max0(ilev-1, top_lev)
km1 = max0(ilev-1, top_lev)
ekkp(ilev) = zn(ilev)*ekk(ilev)*zs(ilev)
ekkm(ilev) = zn(ilev)*ekk(ilev-1)*zs(km1)
tinv = ekkp(ilev) + ekkm(ilev)

! rce-comment -- tinv is the sum of all first-order-loss-rates
! for the layer. for most layers, the activation loss rate
! (for interstitial particles) is accounted for by the loss by
! turb-transfer to the layer above.
! ilev=pver is special, and the loss rate for activation within
! the layer must be added to tinv. if not, the time step
! can be too big, and explmix can produce negative values.
! the negative values are reset to zero, resulting in an
! artificial source.
if (ilev == pver) tinv = tinv + taumix_internal_pver_inv

! tinv is the sum of all first-order-loss-rates
! for the layer. for most layers, the activation loss rate
! (for interstitial particles) is accounted for by the loss by
! turb-transfer to the layer above.
! ilev=pver is special, and the loss rate for activation within
! the layer must be added to tinv. if not, the time step
! can be too big, and explmix can produce negative values.
! the negative values are reset to zero, resulting in an
! artificial source.
if (ilev == pver) then
tinv = tinv + taumix_internal_pver_inv
end if
if (tinv > 1.e-6_r8) then
dtt = 1._r8/tinv
dtmin = min(dtmin, dtt)
Expand Down Expand Up @@ -1395,12 +1382,11 @@ subroutine dropmixnuc_oslo( state, ptend, dtmicro, pbuf, wsub,

do ilev = top_lev, pver
ndropmix(icol,ilev) = (qcld(ilev) - ncldwtr(icol,ilev))*dtinv - nsource(icol,ilev)
tendnd(icol,ilev) = (max(qcld(ilev), 1.e-6_r8) - ncldwtr(icol,ilev))*dtinv
ndropcol(icol) = ndropcol(icol) + ncldwtr(icol,ilev)*pdel(icol,ilev)
tendnd(icol,ilev) = (max(qcld(ilev), 1.e-6_r8) - ncldwtr(icol,ilev))*dtinv
ndropcol(icol) = ndropcol(icol) + ncldwtr(icol,ilev)*pdel(icol,ilev)
end do
ndropcol(icol) = ndropcol(icol)/gravit


raertend = 0._r8
qqcwtend = 0._r8

Expand Down
3 changes: 2 additions & 1 deletion src/oslo_aero_share.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -620,7 +620,8 @@ subroutine registerTracersInMode()
tracer_in_mode(:,:) = -1 !undefined

!externally mixed bc
tracer_in_mode(MODE_IDX_BC_EXT_AC, 1:n_tracers_in_mode(MODE_IDX_BC_EXT_AC)) = (/l_bc_ax/)
tracer_in_mode(MODE_IDX_BC_EXT_AC, 1:n_tracers_in_mode(MODE_IDX_BC_EXT_AC)) = &
(/l_bc_ax/)

!sulphate + soa, sulfate condensate.
tracer_in_mode(MODE_IDX_SO4SOA_AIT, 1:n_tracers_in_mode(MODE_IDX_SO4SOA_AIT) ) = &
Expand Down
3 changes: 1 addition & 2 deletions src_cam/radiation.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1265,7 +1265,6 @@ subroutine radiation_tend( &
volc_ext_sun, volc_omega_sun, volc_g_sun, volc_ext_earth, volc_omega_earth, &
aodvis, absvis)

!TODO (mvertens): should the following be added here?
rd%cld_tau_cloudsim(:ncol,:) = cld_tau(rrtmg_sw_cloudsim_band,:ncol,:)
rd%aer_tau550(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag)
rd%aer_tau400(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag+1)
Expand Down Expand Up @@ -1337,7 +1336,7 @@ subroutine radiation_tend( &
cam_out%solld, fns, fcns, Nday, Nnite, &
IdxDay, IdxNite, su, sd, E_cld_tau=c_cld_tau, &
E_cld_tau_w=c_cld_tau_w, E_cld_tau_w_g=c_cld_tau_w_g, &
E_cld_tau_w_f=c_cld_tau_w_f, old_convert=.false.)
E_cld_tau_w_f=c_cld_tau_w_f, old_convert=.false., idrf=.false.)
! OSLO_AERO end

! Output net fluxes at 200 mb
Expand Down
10 changes: 5 additions & 5 deletions src_cam/radsw.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -202,12 +202,12 @@ subroutine rad_rrtmg_sw(lchnk,ncol ,rrtmg_levs ,r_state , &

real(r8) :: tauc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud optical depth
real(r8) :: ssac_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud single scat. albedo
real(r8) :: asmc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud asymmetry parameter
real(r8) :: asmc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud asymetry parameter
real(r8) :: fsfc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud forward scattering fraction

real(r8) :: tau_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer optical depth
real(r8) :: ssa_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer single scat. albedo
real(r8) :: asm_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer asymmetry parameter
real(r8) :: asm_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer asymetry parameter

real(r8) :: cld_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud fraction
real(r8) :: rei_stosw(pcols, rrtmg_levs-1) ! stochastic ice particle size
Expand All @@ -216,7 +216,7 @@ subroutine rad_rrtmg_sw(lchnk,ncol ,rrtmg_levs ,r_state , &
real(r8) :: cliqwp_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud liquid wter path
real(r8) :: tauc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud optical depth (optional)
real(r8) :: ssac_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud single scat. albedo (optional)
real(r8) :: asmc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud asymmetry parameter (optional)
real(r8) :: asmc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud asymetry parameter (optional)
real(r8) :: fsfc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud forward scattering fraction (optional)

real(r8), parameter :: dps = 1._r8/86400._r8 ! Inverse of seconds per day
Expand Down Expand Up @@ -247,10 +247,10 @@ subroutine rad_rrtmg_sw(lchnk,ncol ,rrtmg_levs ,r_state , &
real(r8) :: tauxcl(pcols,0:pver) ! water cloud extinction optical depth
real(r8) :: tauxci(pcols,0:pver) ! ice cloud extinction optical depth
real(r8) :: wcl(pcols,0:pver) ! liquid cloud single scattering albedo
real(r8) :: gcl(pcols,0:pver) ! liquid cloud asymmetry parameter
real(r8) :: gcl(pcols,0:pver) ! liquid cloud asymetry parameter
real(r8) :: fcl(pcols,0:pver) ! liquid cloud forward scattered fraction
real(r8) :: wci(pcols,0:pver) ! ice cloud single scattering albedo
real(r8) :: gci(pcols,0:pver) ! ice cloud asymmetry parameter
real(r8) :: gci(pcols,0:pver) ! ice cloud asymetry parameter
real(r8) :: fci(pcols,0:pver) ! ice cloud forward scattered fraction

! Aerosol radiative property arrays
Expand Down

0 comments on commit ad84220

Please sign in to comment.