Skip to content

General updates #15

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 6 commits into
base: main
Choose a base branch
from
Open

General updates #15

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
047b953
updates to newstate by zywshoon
May 1, 2025
4b55d07
changes described in https://github.com/NCAR/CARMA_dev/issues/53
May 1, 2025
d1771b1
Simone changes described in https://github.com/NCAR/CARMA_dev/issues/55
fvitt May 1, 2025
7998861
Merge remote-tracking branch 'ESCOMP/carma4_05_updates' into gen_updates
fvitt May 1, 2025
fdaed26
rhogroup changes described in https://github.com/NCAR/CARMA_dev/issue…
fvitt May 7, 2025
cf46721
merge ESCOMP/carma4_05_updates -- rhogroup changes described in https…
fvitt May 7, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions carma_globaer.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -113,6 +113,7 @@
#define dpc_threshold(igroup) carma%f_group(igroup)%f_dpc_threshold
#define rmon(igroup) carma%f_group(igroup)%f_rmon
#define df(ibin,igroup) carma%f_group(igroup)%f_df(ibin)
#define rhogroup(ibin,igroup) carma%f_group(igroup)%f_rho(ibin)
#define nmon(ibin,igroup) carma%f_group(igroup)%f_nmon(ibin)
#define falpha(igroup) carma%f_group(igroup)%f_falpha
#define neutral_volfrc(igroup) carma%f_group(igroup)%f_neutral_volfrc
Expand Down
2 changes: 2 additions & 0 deletions carma_types_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -147,6 +147,7 @@ module carma_types_mod
! rmrat Ratio of masses of particles in consecutive bins
! eshape Ratio of particle length / diameter
! r Radius bins [cm]
! rho Mass density of particle group [g/cm^3]
! rmass Mass bins [g]
! rrat Ratio of maximum diameter to diameter of equivalent sphere
! rprat Ratio of mobility diameter of a porous particle to diameter of equivlent sphere
Expand Down Expand Up @@ -201,6 +202,7 @@ module carma_types_mod
real(kind=f) :: f_eshape
real(kind=f), allocatable, dimension(:) :: f_r ! (NBIN)
real(kind=f), allocatable, dimension(:) :: f_rmass ! (NBIN)
real(kind=f), allocatable, dimension(:) :: f_rho ! (NBIN)
real(kind=f), allocatable, dimension(:) :: f_vol ! (NBIN)
real(kind=f), allocatable, dimension(:) :: f_dr ! (NBIN)
real(kind=f), allocatable, dimension(:) :: f_dm ! (NBIN)
Expand Down
13 changes: 10 additions & 3 deletions carmagroup_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ module carmagroup_mod
subroutine CARMAGROUP_Create(carma, igroup, name, rmin, rmrat, ishape, eshape, is_ice, rc, is_fractal, &
irhswell, irhswcomp, do_mie, do_wetdep, do_drydep, do_vtran, solfac, scavcoef, shortname, &
cnsttype, maxbin, ifallrtn, is_cloud, rmassmin, imiertn, iopticstype, is_sulfate, dpc_threshold, &
rmon, df, falpha, neutral_volfrc)
rmon, df, falpha, neutral_volfrc, rho)
type(carma_type), intent(inout) :: carma !! the carma object
integer, intent(in) :: igroup !! the group index
character(*), intent(in) :: name !! the group name, maximum of 255 characters
Expand Down Expand Up @@ -82,6 +82,7 @@ subroutine CARMAGROUP_Create(carma, igroup, name, rmin, rmrat, ishape, eshape, i
real(kind=f), optional, intent(in) :: df(carma%f_NBIN) !! fractal dimension
real(kind=f), optional, intent(in) :: falpha !! fractal packing coefficient
real(kind=f), optional, intent(in) :: neutral_volfrc !! volume fraction of core mass for neutralization
real(kind=f), optional, intent(in) :: rho(carma%f_NBIN) !! mass desity [g/cm3]

! Local variables
integer :: ier
Expand Down Expand Up @@ -112,6 +113,7 @@ subroutine CARMAGROUP_Create(carma, igroup, name, rmin, rmrat, ishape, eshape, i
carma%f_group(igroup)%f_rprat(carma%f_NBIN), &
carma%f_group(igroup)%f_df(carma%f_NBIN), &
carma%f_group(igroup)%f_nmon(carma%f_NBIN), &
carma%f_group(igroup)%f_rho(carma%f_NBIN), &
stat=ier)
if(ier /= 0) then
if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Add: ERROR allocating, status=", ier
Expand Down Expand Up @@ -141,6 +143,7 @@ subroutine CARMAGROUP_Create(carma, igroup, name, rmin, rmrat, ishape, eshape, i
carma%f_group(igroup)%f_nmon(:) = 1.0_f
carma%f_group(igroup)%f_falpha = 1.0_f
carma%f_group(igroup)%f_neutral_volfrc = 0.0_f
carma%f_group(igroup)%f_rho(:) = 0._f

! Any optical properties?
if (carma%f_NWAVE > 0) then
Expand Down Expand Up @@ -206,6 +209,7 @@ subroutine CARMAGROUP_Create(carma, igroup, name, rmin, rmrat, ishape, eshape, i
if (present(dpc_threshold)) carma%f_group(igroup)%f_dpc_threshold = dpc_threshold
if (present(rmon)) carma%f_group(igroup)%f_rmon = rmon
if (present(df)) carma%f_group(igroup)%f_df(:) = df(:)
if (present(rho)) carma%f_group(igroup)%f_rho(:) = rho(:)
if (present(falpha)) carma%f_group(igroup)%f_falpha = falpha
if (present(neutral_volfrc)) carma%f_group(igroup)%f_neutral_volfrc = neutral_volfrc

Expand Down Expand Up @@ -318,7 +322,7 @@ subroutine CARMAGROUP_Destroy(carma, igroup, rc)
endif
endif

! Allocate dynamic data.
! De-allocate dynamic data.
if (allocated(carma%f_group(igroup)%f_r)) then
deallocate( &
carma%f_group(igroup)%f_r, &
Expand All @@ -335,6 +339,7 @@ subroutine CARMAGROUP_Destroy(carma, igroup, rc)
carma%f_group(igroup)%f_rprat, &
carma%f_group(igroup)%f_df, &
carma%f_group(igroup)%f_nmon, &
carma%f_group(igroup)%f_rho, &
stat=ier)
if(ier /= 0) then
if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Destroy: ERROR deallocating, status=", ier
Expand Down Expand Up @@ -363,7 +368,7 @@ subroutine CARMAGROUP_Get(carma, igroup, rc, name, shortname, rmin, rmrat, ishap
irhswell, irhswcomp, cnsttype, r, rlow, rup, dr, rmass, dm, vol, qext, ssa, asym, do_mie, &
do_wetdep, do_drydep, do_vtran, solfac, scavcoef, ienconc, ncore, icorelem, maxbin, &
ifallrtn, is_cloud, rmassmin, arat, rrat, rprat, imiertn, iopticstype, is_sulfate, dpc_threshold, rmon, df, &
nmon, falpha, neutral_volfrc)
nmon, falpha, neutral_volfrc, rho)

type(carma_type), intent(in) :: carma !! the carma object
integer, intent(in) :: igroup !! the group index
Expand Down Expand Up @@ -427,6 +432,7 @@ subroutine CARMAGROUP_Get(carma, igroup, rc, name, shortname, rmin, rmrat, ishap
real(kind=f), optional, intent(out) :: nmon(carma%f_NBIN) !! number of monomers per
real(kind=f), optional, intent(out) :: falpha !! fractal packing coefficient
real(kind=f), optional, intent(out) :: neutral_volfrc !! volume fraction of core mass for neutralization
real(kind=f), optional, intent(out) :: rho(carma%f_NBIN) !! mass density

! Assume success.
rc = RC_OK
Expand Down Expand Up @@ -483,6 +489,7 @@ subroutine CARMAGROUP_Get(carma, igroup, rc, name, shortname, rmin, rmrat, ishap
if (present(nmon)) nmon(:) = carma%f_group(igroup)%f_nmon(:)
if (present(falpha)) falpha = carma%f_group(igroup)%f_falpha
if (present(neutral_volfrc)) neutral_volfrc = carma%f_group(igroup)%f_neutral_volfrc
if (present(rho)) rho(:) = carma%f_group(igroup)%f_rho(:)

if (carma%f_NWAVE == 0) then
if (present(qext) .or. present(ssa) .or. present(asym)) then
Expand Down
30 changes: 19 additions & 11 deletions newstate.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ subroutine newstate(carma, cstate, rc)
integer, intent(inout) :: rc !! return code, negative indicates failure

real(kind=f) :: pc_orig(NZ,NBIN,NELEM)
real(kind=f) :: pcl_orig(NZ,NBIN,NELEM)
real(kind=f) :: gc_orig(NZ,NGAS)
real(kind=f) :: t_orig(NZ)
real(kind=f) :: cldfrc_orig(NZ)
Expand Down Expand Up @@ -54,7 +55,8 @@ subroutine newstate(carma, cstate, rc)
if (rc < RC_OK) return
endif

call fixcorecol(carma, cstate, rc)
! pc was changed by vertical, therefore we want to change pcl to pc before it is used by coagulation
pcl(:,:,:) = pc(:,:,:)

! There can be two phases to the microphysics: in-cloud and clear sky. Particles
! that are tagged as "In-cloud" will only be processed in the in-cloud loop, and their
Expand All @@ -79,6 +81,7 @@ subroutine newstate(carma, cstate, rc)
! particle is in the incloud portion of the grid box. Particle that are not "cloud
! particles" have their mass spread throughout the grid box.
pc_orig(:,:,:) = pc(:,:,:)
pcl_orig(:,:,:) = pcl(:,:,:)
gc_orig(:,:) = gc(:,:)
t_orig(:) = t(:)

Expand All @@ -94,6 +97,7 @@ subroutine newstate(carma, cstate, rc)
if (is_grp_cloud(igroup)) then
do ibin = 1, NBIN
pc(:, ibin, ielem) = pc(:, ibin, ielem) / scale_cldfrc(:)
pcl(:, ibin, ielem) = pcl(:, ibin, ielem) / scale_cldfrc(:)
pcd(:, ibin, ielem) = pcd(:, ibin, ielem) / scale_cldfrc(:)
end do
end if
Expand All @@ -102,21 +106,24 @@ subroutine newstate(carma, cstate, rc)
call newstate_calc(carma, cstate, scale_cldfrc(:), rc)
if (rc < RC_OK) return

call fixcorecol(carma, cstate, rc)

! Save the new in-cloud values for the gas, particle and temperature fields.
pc_cloudy(:,:,:) = pc(:,:,:)
gc_cloudy(:,:) = gc(:,:)
t_cloudy(:) = t(:)
rlheat_cloudy(:) = rlheat(:)
partheat_cloudy(:) = partheat(:)

if (do_grow) then
rlheat_cloudy(:) = rlheat(:)
partheat_cloudy(:) = partheat(:)
endif


if (do_substep) zsubsteps_cloudy(:) = zsubsteps(:)

! Now do the clear sky portion, using the original gridbox average concentrations.
! This is optional. If clear sky is not selected then all of the microphysics is
! done in-cloud.
pc(:,:,:) = pc_orig(:,:,:)
pcl(:,:,:) = pcl_orig(:,:,:)
gc(:,:) = gc_orig(:,:)
t(:) = t_orig(:)

Expand All @@ -132,6 +139,7 @@ subroutine newstate(carma, cstate, rc)

if (is_grp_cloud(igroup)) then
pc(:, :, ielem) = 0._f
pcl(:, :, ielem) = 0._f
pcd(:, :, ielem) = 0._f
end if
end do
Expand All @@ -153,17 +161,19 @@ subroutine newstate(carma, cstate, rc)
call newstate_calc(carma, cstate, (1._f - scale_cldfrc(:)), rc)
if (rc < RC_OK) return

call fixcorecol(carma, cstate, rc)

! Restore the cloud fraction
cldfrc(:) = cldfrc_orig(:)

! Save the new clear sky values for the gas, particle and temperature fields.
pc_clear(:,:,:) = pc(:,:,:)
gc_clear(:,:) = gc(:,:)
t_clear(:) = t(:)
rlheat_clear(:) = rlheat(:)
partheat_clear(:) = partheat(:)

if (do_grow) then
rlheat_clear(:) = rlheat(:)
partheat_clear(:) = partheat(:)
endif


if (do_substep) zsubsteps_clear(:) = zsubsteps(:)

Expand Down Expand Up @@ -240,8 +250,6 @@ subroutine newstate(carma, cstate, rc)
scale_threshold(:) = 1._f
call newstate_calc(carma, cstate, scale_threshold, rc)
if (rc < RC_OK) return

call fixcorecol(carma, cstate, rc)
end if

! Return to caller with new state computed
Expand Down
18 changes: 9 additions & 9 deletions rhopart.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -133,55 +133,55 @@ subroutine rhopart(carma, cstate, rc)
if (irhswell(igroup) == I_WTPCT_H2SO4) then

! rlow
call getwetr(carma, igroup, relhum(iz), rlow(ibin,igroup), rlow_wet(iz,ibin,igroup), &
call getwetr(carma, igroup, ibin, relhum(iz), rlow(ibin,igroup), rlow_wet(iz,ibin,igroup), &
rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc, h2o_mass=h2o_mass, &
h2o_vp=pvapl(iz, igash2o), temp=t(iz))
if (rc < 0) return

! rup
call getwetr(carma, igroup, relhum(iz), rup(ibin,igroup), rup_wet(iz,ibin,igroup), &
call getwetr(carma, igroup, ibin, relhum(iz), rup(ibin,igroup), rup_wet(iz,ibin,igroup), &
rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc, h2o_mass=h2o_mass, &
h2o_vp=pvapl(iz, igash2o), temp=t(iz))
if (rc < 0) return

! r
call getwetr(carma, igroup, relhum(iz), r(ibin,igroup), r_wet(iz,ibin,igroup), &
call getwetr(carma, igroup, ibin, relhum(iz), r(ibin,igroup), r_wet(iz,ibin,igroup), &
rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc, h2o_mass=h2o_mass, &
h2o_vp=pvapl(iz, igash2o), temp=t(iz))
if (rc < 0) return

else if (irhswell(igroup) == I_PETTERS) then

call getwetr(carma, igroup, relhum(iz), rlow(ibin,igroup), rlow_wet(iz,ibin,igroup), &
call getwetr(carma, igroup, ibin, relhum(iz), rlow(ibin,igroup), rlow_wet(iz,ibin,igroup), &
rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc,h2o_mass=h2o_mass, &
h2o_vp=pvapl(iz, igash2o), temp=t(iz), kappa=kappahygro(iz,ibin,igroup))
if (rc < 0) return

! rup
call getwetr(carma, igroup, relhum(iz), rup(ibin,igroup), rup_wet(iz,ibin,igroup), &
call getwetr(carma, igroup, ibin, relhum(iz), rup(ibin,igroup), rup_wet(iz,ibin,igroup), &
rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc, h2o_mass=h2o_mass, &
h2o_vp=pvapl(iz, igash2o),temp=t(iz), kappa=kappahygro(iz,ibin,igroup))
if (rc < 0) return

! r
call getwetr(carma, igroup, relhum(iz), r(ibin,igroup), r_wet(iz,ibin,igroup), &
call getwetr(carma, igroup, ibin, relhum(iz), r(ibin,igroup), r_wet(iz,ibin,igroup), &
rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc, h2o_mass=h2o_mass, &
h2o_vp=pvapl(iz, igash2o),temp=t(iz), kappa=kappahygro(iz,ibin,igroup))
if (rc < 0) return

else ! I_GERBER and I_FITZGERALD

call getwetr(carma, igroup, relhum(iz), rlow(ibin,igroup), rlow_wet(iz,ibin,igroup), &
call getwetr(carma, igroup, ibin, relhum(iz), rlow(ibin,igroup), rlow_wet(iz,ibin,igroup), &
rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc)
if (rc < 0) return

! rup
call getwetr(carma, igroup, relhum(iz), rup(ibin,igroup), rup_wet(iz,ibin,igroup), &
call getwetr(carma, igroup, ibin, relhum(iz), rup(ibin,igroup), rup_wet(iz,ibin,igroup), &
rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc)
if (rc < 0) return

! r
call getwetr(carma, igroup, relhum(iz), r(ibin,igroup), r_wet(iz,ibin,igroup), &
call getwetr(carma, igroup, ibin, relhum(iz), r(ibin,igroup), r_wet(iz,ibin,igroup), &
rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc)
if (rc < 0) return

Expand Down
Loading