Skip to content

Commit

Permalink
FV3: this commit #refs 61047 Merge FV3 chemistry development branch i…
Browse files Browse the repository at this point in the history 
…nto master branch.

Change-Id: I8014391ea97416ec8d757aa32ed38561b03aa679
  • Loading branch information
@rmontuoro @junwang-noaa
rmontuoro authored and junwang-noaa committed Apr 1, 2019
1 parent 72bbca2 commit ad160f1
Show file tree
Hide file tree
Showing 12 changed files with 1,061 additions and 153 deletions.
224 changes: 201 additions & 23 deletions atmos_model.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ module atmos_model_mod
operator(+), operator(-),real_to_time_type
use field_manager_mod, only: MODEL_ATMOS
use tracer_manager_mod, only: get_number_tracers, get_tracer_names, &
get_tracer_index
get_tracer_index, NO_TRACER
use xgrid_mod, only: grid_box_type
use atmosphere_mod, only: atmosphere_init
use atmosphere_mod, only: atmosphere_restart
Expand Down Expand Up @@ -792,20 +792,71 @@ end subroutine atmos_model_restart
! Retrieve ungridded dimensions of atmospheric model arrays
! </DESCRIPTION>

subroutine get_atmos_model_ungridded_dim(nlev, ntracers, nsoillev)
subroutine get_atmos_model_ungridded_dim(nlev, nsoillev, ntracers, &
num_diag_sfc_emis_flux, num_diag_down_flux, num_diag_type_down_flux, &
num_diag_burn_emis_flux, num_diag_cmass)

integer, optional, intent(out) :: nlev, ntracers, nsoillev
integer, optional, intent(out) :: nlev, nsoillev, ntracers, &
num_diag_sfc_emis_flux, num_diag_down_flux, num_diag_type_down_flux, &
num_diag_burn_emis_flux, num_diag_cmass

if (present(nlev)) nlev = Atm_block%npz
if (present(ntracers)) call get_number_tracers(MODEL_ATMOS, num_tracers=ntracers)
!--- number of atmospheric vertical levels
if (present(nlev)) nlev = Atm_block%npz

!--- number of soil levels
if (present(nsoillev)) then
nsoillev = 0
if (allocated(IPD_Data)) then
if (associated(IPD_Data(1)%Sfcprop%slc)) &
nsoillev = size(IPD_Data(1)%Sfcprop%slc, 2)
nsoillev = size(IPD_Data(1)%Sfcprop%slc, dim=2)
end if
end if

!--- total number of atmospheric tracers
if (present(ntracers)) call get_number_tracers(MODEL_ATMOS, num_tracers=ntracers)

!--- number of tracers used in chemistry diagnostic output
if (present(num_diag_down_flux)) then
num_diag_down_flux = 0
if (associated(IPD_Data(1)%IntDiag%sedim)) &
num_diag_down_flux = size(IPD_Data(1)%IntDiag%sedim, dim=2)
if (present(num_diag_type_down_flux)) then
num_diag_type_down_flux = 0
if (associated(IPD_Data(1)%IntDiag%sedim)) &
num_diag_type_down_flux = num_diag_type_down_flux + 1
if (associated(IPD_Data(1)%IntDiag%drydep)) &
num_diag_type_down_flux = num_diag_type_down_flux + 1
if (associated(IPD_Data(1)%IntDiag%wetdpl)) &
num_diag_type_down_flux = num_diag_type_down_flux + 1
if (associated(IPD_Data(1)%IntDiag%wetdpc)) &
num_diag_type_down_flux = num_diag_type_down_flux + 1
end if
end if

!--- number of bins for chemistry diagnostic output
if (present(num_diag_sfc_emis_flux)) then
num_diag_sfc_emis_flux = 0
if (associated(IPD_Data(1)%IntDiag%duem)) &
num_diag_sfc_emis_flux = size(IPD_Data(1)%IntDiag%duem, dim=2)
if (associated(IPD_Data(1)%IntDiag%ssem)) &
num_diag_sfc_emis_flux = &
num_diag_sfc_emis_flux + size(IPD_Data(1)%IntDiag%ssem, dim=2)
end if

!--- number of tracers used in emission diagnostic output
if (present(num_diag_burn_emis_flux)) then
num_diag_burn_emis_flux = 0
if (associated(IPD_Data(1)%IntDiag%abem)) &
num_diag_burn_emis_flux = size(IPD_Data(1)%IntDiag%abem, dim=2)
end if

!--- number of tracers used in column mass density diagnostics
if (present(num_diag_cmass)) then
num_diag_cmass = 0
if (associated(IPD_Data(1)%IntDiag%aecm)) &
num_diag_cmass = size(IPD_Data(1)%IntDiag%aecm, dim=2)
end if

end subroutine get_atmos_model_ungridded_dim
! </SUBROUTINE>

Expand Down Expand Up @@ -836,28 +887,31 @@ subroutine update_atmos_chemistry(state, rc)

!--- local variables
integer :: localrc
integer :: ni, nj, nk, nt, ntoz
integer :: ni, nj, nk, nt, ntb, nte
integer :: nb, ix, i, j, k, it
integer :: ib, jb

real(ESMF_KIND_R8), dimension(:,:,:), pointer :: prsl, phil, &
prsi, phii, &
temp, &
real(ESMF_KIND_R8), dimension(:,:,:), pointer :: prsl, phil, &
prsi, phii, &
temp, &
ua, va, vvl, &
dkt, slc
real(ESMF_KIND_R8), dimension(:,:,:,:), pointer :: q
dkt, slc, &
qb, qm, qu
real(ESMF_KIND_R8), dimension(:,:,:,:), pointer :: qd, q

real(ESMF_KIND_R8), dimension(:,:), pointer :: hpbl, area, stype, rainc, &
uustar, rain, sfcdsw, slmsk, tsfc, shfsfc, snowd, vtype, vfrac, zorl

logical, parameter :: diag = .true.
! logical, parameter :: diag = .true.

! -- begin
if (present(rc)) rc = ESMF_SUCCESS

ni = Atm_block%iec - Atm_block%isc + 1
nj = Atm_block%jec - Atm_block%jsc + 1
nk = Atm_block%npz

!--- get total number of tracers
call get_number_tracers(MODEL_ATMOS, num_tracers=nt)

select case (trim(state))
Expand All @@ -867,12 +921,37 @@ subroutine update_atmos_chemistry(state, rc)
farrayPtr4d=q, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
call cplFieldGet(state,'inst_tracer_up_surface_flx', &
farrayPtr3d=qu, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
call cplFieldGet(state,'inst_tracer_down_surface_flx', &
farrayPtr4d=qd, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
call cplFieldGet(state,'inst_tracer_clmn_mass_dens', &
farrayPtr3d=qm, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
call cplFieldGet(state,'inst_tracer_anth_biom_flx', &
farrayPtr3d=qb, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return

!--- tracers quantities
!--- locate the end location of standard atmospheric tracers, marked by ozone
ntoz = get_tracer_index(MODEL_ATMOS, 'o3mr')
!--- do not import tracer concentrations by default
ntb = nt + 1
nte = nt

!--- if chemical tracers are present, set bounds appropriately
if (IPD_Control%ntchm > 0) then
if (IPD_Control%ntchs /= NO_TRACER) then
ntb = IPD_Control%ntchs
nte = IPD_Control%ntchm + ntb - 1
end if
end if

do it = ntoz + 1, nt
!--- tracer concentrations
do it = ntb, nte
!$OMP parallel do default (none) &
!$OMP shared (it, nk, nj, ni, Atm_block, IPD_Data, q) &
!$OMP private (k, j, jb, i, ib, nb, ix)
Expand All @@ -889,9 +968,97 @@ subroutine update_atmos_chemistry(state, rc)
enddo
enddo

if (diag) then
!--- tracer diagnostics
!--- (a) column mass densities
do it = 1, size(qm, dim=3)
!$OMP parallel do default (none) &
!$OMP shared (it, nj, ni, Atm_block, IPD_Data, qm) &
!$OMP private (j, jb, i, ib, nb, ix)
do j = 1, nj
jb = j + Atm_block%jsc - 1
do i = 1, ni
ib = i + Atm_block%isc - 1
nb = Atm_block%blkno(ib,jb)
ix = Atm_block%ixp(ib,jb)
IPD_Data(nb)%IntDiag%aecm(ix,it) = qm(i,j,it)
enddo
enddo
enddo

!--- (b) dust and sea salt emissions
ntb = size(IPD_Data(1)%IntDiag%duem, dim=2)
nte = size(qu, dim=3)
do it = 1, min(ntb, nte)
do j = 1, nj
jb = j + Atm_block%jsc - 1
do i = 1, ni
ib = i + Atm_block%isc - 1
nb = Atm_block%blkno(ib,jb)
ix = Atm_block%ixp(ib,jb)
IPD_Data(nb)%IntDiag%duem(ix,it) = qu(i,j,it)
enddo
enddo
enddo

nte = nte - ntb
do it = 1, min(size(IPD_Data(1)%IntDiag%ssem, dim=2), nte)
do j = 1, nj
jb = j + Atm_block%jsc - 1
do i = 1, ni
ib = i + Atm_block%isc - 1
nb = Atm_block%blkno(ib,jb)
ix = Atm_block%ixp(ib,jb)
IPD_Data(nb)%IntDiag%ssem(ix,it) = qu(i,j,it+ntb)
enddo
enddo
enddo

!--- (c) sedimentation and dry/wet deposition
do it = 1, size(qd, dim=3)
!$OMP parallel do default (none) &
!$OMP shared (it, nj, ni, Atm_block, IPD_Data, qd) &
!$OMP private (j, jb, i, ib, nb, ix)
do j = 1, nj
jb = j + Atm_block%jsc - 1
do i = 1, ni
ib = i + Atm_block%isc - 1
nb = Atm_block%blkno(ib,jb)
ix = Atm_block%ixp(ib,jb)
IPD_Data(nb)%IntDiag%sedim (ix,it) = qd(i,j,it,1)
IPD_Data(nb)%IntDiag%drydep(ix,it) = qd(i,j,it,2)
IPD_Data(nb)%IntDiag%wetdpl(ix,it) = qd(i,j,it,3)
IPD_Data(nb)%IntDiag%wetdpc(ix,it) = qd(i,j,it,4)
enddo
enddo
enddo

!--- (d) anthropogenic and biomass burning emissions
do it = 1, size(qb, dim=3)
!$OMP parallel do default (none) &
!$OMP shared (it, nj, ni, Atm_block, IPD_Data, qb) &
!$OMP private (j, jb, i, ib, nb, ix)
do j = 1, nj
jb = j + Atm_block%jsc - 1
do i = 1, ni
ib = i + Atm_block%isc - 1
nb = Atm_block%blkno(ib,jb)
ix = Atm_block%ixp(ib,jb)
IPD_Data(nb)%IntDiag%abem(ix,it) = qb(i,j,it)
enddo
enddo
enddo

if (IPD_Control%debug) then
write(6,'("update_atmos: ",a,": qgrs - min/max/avg",3g16.6)') &
trim(state), minval(q), maxval(q), sum(q)/size(q)
write(6,'("update_atmos: ",a,": qup - min/max/avg",3g16.6)') &
trim(state), minval(qu), maxval(qu), sum(qu)/size(qu)
write(6,'("update_atmos: ",a,": qdwn - min/max/avg",3g16.6)') &
trim(state), minval(qd), maxval(qd), sum(qd)/size(qd)
write(6,'("update_atmos: ",a,": qcmd - min/max/avg",3g16.6)') &
trim(state), minval(qm), maxval(qm), sum(qm)/size(qm)
write(6,'("update_atmos: ",a,": qabb - min/max/avg",3g16.6)') &
trim(state), minval(qb), maxval(qb), sum(qb)/size(qb)
end if

case ('export')
Expand Down Expand Up @@ -935,7 +1102,8 @@ subroutine update_atmos_chemistry(state, rc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return

call cplFieldGet(state,'inst_soil_moisture_content', farrayPtr3d=slc, rc=rc)
call cplFieldGet(state,'inst_soil_moisture_content', &
farrayPtr3d=slc, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return

Expand Down Expand Up @@ -1078,7 +1246,8 @@ subroutine update_atmos_chemistry(state, rc)
area(i,j) = IPD_Data(nb)%Grid%area(ix)
stype(i,j) = IPD_Data(nb)%Sfcprop%stype(ix)
rainc(i,j) = IPD_Data(nb)%Coupling%rainc_cpl(ix)
rain(i,j) = IPD_Data(nb)%Coupling%rain_cpl(ix)
rain(i,j) = IPD_Data(nb)%Coupling%rain_cpl(ix) &
+ IPD_Data(nb)%Coupling%snow_cpl(ix)
uustar(i,j) = IPD_Data(nb)%Sfcprop%uustar(ix)
sfcdsw(i,j) = IPD_Data(nb)%Coupling%sfcdsw(ix)
slmsk(i,j) = IPD_Data(nb)%Sfcprop%slmsk(ix)
Expand All @@ -1092,7 +1261,7 @@ subroutine update_atmos_chemistry(state, rc)
enddo
enddo

if (diag) then
if (IPD_Control%debug) then
! -- diagnostics
write(6,'("update_atmos: prsi - min/max/avg",3g16.6)') minval(prsi), maxval(prsi), sum(prsi)/size(prsi)
write(6,'("update_atmos: phii - min/max/avg",3g16.6)') minval(phii), maxval(phii), sum(phii)/size(phii)
Expand Down Expand Up @@ -1208,7 +1377,7 @@ subroutine assign_importdata(rc)
real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d
real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d
real(kind=IPD_kind_phys), dimension(:,:), pointer :: datar8
logical found, lcpl_fice
logical found, isFieldCreated, lcpl_fice
!
!------------------------------------------------------------------------------
!
Expand All @@ -1230,16 +1399,25 @@ subroutine assign_importdata(rc)
! Each import field is only available if it was connected in the
! import state.
found = .false.
if (ESMF_FieldIsCreated(importFields(n))) then

isFieldCreated = ESMF_FieldIsCreated(importFields(n), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return ! bail out

if (isFieldCreated) then

! put the data from local cubed sphere grid to column grid for phys
datar8 = -99999.0
call ESMF_FieldGet(importFields(n), dimCount=dimCount ,typekind=datatype, &
name=impfield_name, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return ! bail out

if ( dimCount == 2) then
if ( datatype == ESMF_TYPEKIND_R8) then
call ESMF_FieldGet(importFields(n),farrayPtr=datar82d,localDE=0, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return ! bail out
datar8=datar82d
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplIMP,atmos gets ',trim(impfield_name),' datar8=',maxval(datar8),minval(datar8), &
datar8(isc,jsc)
Expand Down
Loading

0 comments on commit ad160f1

Please sign in to comment.