diff --git a/CMakeLists.txt b/CMakeLists.txt
index 2cecbf2d0..155d6469f 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -122,6 +122,7 @@ add_library(fv3atm
module_fv3_config.F90
module_fcst_grid_comp.F90
stochastic_physics/stochastic_physics_wrapper.F90
+ cpl/module_block_data.F90
cpl/module_cplfields.F90
cpl/module_cap_cpl.F90
io/ffsync.F90
diff --git a/atmos_model.F90 b/atmos_model.F90
index cf0cf955e..6fe9ede35 100644
--- a/atmos_model.F90
+++ b/atmos_model.F90
@@ -100,6 +100,7 @@ module atmos_model_mod
use fv_iau_mod, only: iau_external_data_type,getiauforcing,iau_initialize
use module_fv3_config, only: output_1st_tstep_rst, first_kdt, nsout, &
restart_endfcst
+use module_block_data
!-----------------------------------------------------------------------
@@ -395,6 +396,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
integer :: bdat(8), cdat(8)
integer :: ntracers, maxhf, maxh
character(len=32), allocatable, target :: tracer_names(:)
+ integer, allocatable, target :: tracer_types(:)
integer :: nthrds, nb
!-----------------------------------------------------------------------
@@ -491,10 +493,11 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
call get_date (Time, cdat(1), cdat(2), cdat(3), &
cdat(5), cdat(6), cdat(7))
call get_number_tracers(MODEL_ATMOS, num_tracers=ntracers)
- allocate (tracer_names(ntracers))
+ allocate (tracer_names(ntracers), tracer_types(ntracers))
do i = 1, ntracers
call get_tracer_names(MODEL_ATMOS, i, tracer_names(i))
enddo
+ call get_atmos_tracer_types(tracer_types)
!--- setup Init_parm
Init_parm%me = mpp_pe()
Init_parm%master = mpp_root_pe()
@@ -523,6 +526,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
Init_parm%area => Atmos%area
Init_parm%nwat = Atm(mygrid)%flagstruct%nwat
Init_parm%tracer_names => tracer_names
+ Init_parm%tracer_types => tracer_types
Init_parm%restart = Atm(mygrid)%flagstruct%warm_start
Init_parm%hydrostatic = Atm(mygrid)%flagstruct%hydrostatic
@@ -563,6 +567,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
Init_parm%area => null()
Init_parm%tracer_names => null()
deallocate (tracer_names)
+ deallocate (tracer_types)
!--- update tracers in FV3 with any initialized during the physics/radiation init phase
!rab call atmosphere_tracer_postinit (GFS_data, Atm_block)
@@ -764,14 +769,18 @@ end subroutine atmos_model_exchange_phase_2
!
-subroutine update_atmos_model_state (Atmos)
+subroutine update_atmos_model_state (Atmos, rc)
! to update the model state after all concurrency is completed
+ use ESMF
type (atmos_data_type), intent(inout) :: Atmos
+ integer, optional, intent(out) :: rc
!--- local variables
+ integer :: localrc
integer :: isec, seconds, isec_fhzero
- integer :: rc
real(kind=GFS_kind_phys) :: time_int, time_intfull
!
+ if (present(rc)) rc = ESMF_SUCCESS
+
call set_atmosphere_pelist()
call mpp_clock_begin(fv3Clock)
call mpp_clock_begin(updClock)
@@ -828,10 +837,10 @@ subroutine update_atmos_model_state (Atmos)
!--- get bottom layer data from dynamical core for coupling
call atmosphere_get_bottom_layer (Atm_block, DYCORE_Data)
- !if in coupled mode, set up coupled fields
- if (.not. GFS_control%cplchm) then
- call setup_exportdata()
- endif
+ !--- if in coupled mode, set up coupled fields
+ call setup_exportdata(rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, file=__FILE__, rcToReturn=rc)) return
end subroutine update_atmos_model_state
!
@@ -916,13 +925,9 @@ end subroutine atmos_model_restart
! Retrieve ungridded dimensions of atmospheric model arrays
!
-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)
+subroutine get_atmos_model_ungridded_dim(nlev, nsoillev, ntracers)
- 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
+ integer, optional, intent(out) :: nlev, nsoillev, ntracers
!--- number of atmospheric vertical levels
if (present(nlev)) nlev = Atm_block%npz
@@ -939,49 +944,113 @@ subroutine get_atmos_model_ungridded_dim(nlev, nsoillev, ntracers, &
!--- 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(GFS_data(1)%IntDiag%sedim)) &
- num_diag_down_flux = size(GFS_data(1)%IntDiag%sedim, dim=2)
- if (present(num_diag_type_down_flux)) then
- num_diag_type_down_flux = 0
- if (associated(GFS_data(1)%IntDiag%sedim)) &
- num_diag_type_down_flux = num_diag_type_down_flux + 1
- if (associated(GFS_data(1)%IntDiag%drydep)) &
- num_diag_type_down_flux = num_diag_type_down_flux + 1
- if (associated(GFS_data(1)%IntDiag%wetdpl)) &
- num_diag_type_down_flux = num_diag_type_down_flux + 1
- if (associated(GFS_data(1)%IntDiag%wetdpc)) &
- num_diag_type_down_flux = num_diag_type_down_flux + 1
+end subroutine get_atmos_model_ungridded_dim
+!
+
+!#######################################################################
+!
+!
+! Identify and return usage and type id of atmospheric tracers.
+! Ids are defined as:
+! 0 = generic tracer
+! 1 = chemistry - prognostic
+! 2 = chemistry - diagnostic
+!
+! Tracers are identified via the additional 'tracer_usage' keyword and
+! their optional 'type' qualifier. A tracer is assumed prognostic if
+! 'type' is not provided. See examples from the field_table file below:
+!
+! Prognostic tracer:
+! ------------------
+! "TRACER", "atmos_mod", "so2"
+! "longname", "so2 mixing ratio"
+! "units", "ppm"
+! "tracer_usage", "chemistry"
+! "profile_type", "fixed", "surface_value=5.e-6" /
+!
+! Diagnostic tracer:
+! ------------------
+! "TRACER", "atmos_mod", "pm25"
+! "longname", "PM2.5"
+! "units", "ug/m3"
+! "tracer_usage", "chemistry", "type=diagnostic"
+! "profile_type", "fixed", "surface_value=5.e-6" /
+!
+! For atmospheric chemistry, the order of both prognostic and diagnostic
+! tracers is validated against the model's internal assumptions.
+!
+!
+subroutine get_atmos_tracer_types(tracer_types)
+
+ use field_manager_mod, only: parse
+ use tracer_manager_mod, only: query_method
+
+ integer, intent(out) :: tracer_types(:)
+
+ !--- local variables
+ logical :: found
+ integer :: n, num_tracers, num_types
+ integer :: id_max, id_min, id_num, ip_max, ip_min, ip_num
+ character(len=32) :: tracer_usage
+ character(len=128) :: control, tracer_type
+
+ !--- begin
+
+ !--- validate array size
+ call get_number_tracers(MODEL_ATMOS, num_tracers=num_tracers)
+
+ if (size(tracer_types) < num_tracers) &
+ call mpp_error(FATAL, 'insufficient size of tracer type array')
+
+ !--- initialize tracer indices
+ id_min = num_tracers + 1
+ id_max = -id_min
+ ip_min = id_min
+ ip_max = id_max
+ id_num = 0
+ ip_num = 0
+
+ do n = 1, num_tracers
+ tracer_types(n) = 0
+ found = query_method('tracer_usage',MODEL_ATMOS,n,tracer_usage,control)
+ if (found) then
+ if (trim(tracer_usage) == 'chemistry') then
+ !--- set default to prognostic
+ tracer_type = 'prognostic'
+ num_types = parse(control, 'type', tracer_type)
+ select case (trim(tracer_type))
+ case ('diagnostic')
+ tracer_types(n) = 2
+ id_num = id_num + 1
+ id_max = n
+ if (id_num == 1) id_min = n
+ case ('prognostic')
+ tracer_types(n) = 1
+ ip_num = ip_num + 1
+ ip_max = n
+ if (ip_num == 1) ip_min = n
+ end select
+ end if
end if
- end if
+ end do
- !--- number of bins for chemistry diagnostic output
- if (present(num_diag_sfc_emis_flux)) then
- num_diag_sfc_emis_flux = 0
- if (associated(GFS_data(1)%IntDiag%duem)) &
- num_diag_sfc_emis_flux = size(GFS_data(1)%IntDiag%duem, dim=2)
- if (associated(GFS_data(1)%IntDiag%ssem)) &
- num_diag_sfc_emis_flux = &
- num_diag_sfc_emis_flux + size(GFS_data(1)%IntDiag%ssem, dim=2)
+ if (ip_num > 0) then
+ !--- check if prognostic tracers are contiguous
+ if (ip_num > ip_max - ip_min + 1) &
+ call mpp_error(FATAL, 'prognostic chemistry tracers must be contiguous')
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(GFS_data(1)%IntDiag%abem)) &
- num_diag_burn_emis_flux = size(GFS_data(1)%IntDiag%abem, dim=2)
+ if (id_num > 0) then
+ !--- check if diagnostic tracers are contiguous
+ if (id_num > id_max - id_min + 1) &
+ call mpp_error(FATAL, 'diagnostic chemistry tracers must be contiguous')
end if
- !--- number of tracers used in column mass density diagnostics
- if (present(num_diag_cmass)) then
- num_diag_cmass = 0
- if (associated(GFS_data(1)%IntDiag%aecm)) &
- num_diag_cmass = size(GFS_data(1)%IntDiag%aecm, dim=2)
- end if
+ !--- prognostic tracers must precede diagnostic ones
+ if (ip_max > id_min) &
+ call mpp_error(FATAL, 'diagnostic chemistry tracers must follow prognostic ones')
-end subroutine get_atmos_model_ungridded_dim
+end subroutine get_atmos_tracer_types
!
!#######################################################################
@@ -1012,19 +1081,19 @@ subroutine update_atmos_chemistry(state, rc)
!--- local variables
integer :: localrc
integer :: ni, nj, nk, nt, ntb, nte
- integer :: nb, ix, i, j, k, it
+ integer :: nb, ix, i, j, k, k1, it
integer :: ib, jb
- real(ESMF_KIND_R8), dimension(:,:,:), pointer :: prsl, phil, &
- prsi, phii, &
- temp, dqdt, &
- ua, va, vvl, &
- dkt, slc, &
- qb, qm, qu
- real(ESMF_KIND_R8), dimension(:,:,:,:), pointer :: qd, q
+ real(ESMF_KIND_R8), dimension(:,:,:), pointer :: prsl, phil, &
+ prsi, phii, &
+ temp, cldfra, &
+ pflls, pfils, &
+ ua, va, slc
+ real(ESMF_KIND_R8), dimension(:,:,:,:), pointer :: q
- real(ESMF_KIND_R8), dimension(:,:), pointer :: hpbl, area, stype, rainc, &
- uustar, rain, sfcdsw, slmsk, tsfc, shfsfc, snowd, vtype, vfrac, zorl
+ real(ESMF_KIND_R8), dimension(:,:), pointer :: hpbl, area, rainc, &
+ uustar, rain, slmsk, tsfc, shfsfc, zorl, focn, flake, fice, &
+ fsnow, u10m, v10m, swet
! logical, parameter :: diag = .true.
@@ -1044,22 +1113,6 @@ subroutine update_atmos_chemistry(state, rc)
call cplFieldGet(state,'inst_tracer_mass_frac', 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
!--- do not import tracer concentrations by default
ntb = nt + 1
@@ -1067,13 +1120,11 @@ subroutine update_atmos_chemistry(state, rc)
!--- if chemical tracers are present, set bounds appropriately
if (GFS_control%ntchm > 0) then
- if (GFS_control%ntchs /= NO_TRACER) then
- ntb = GFS_control%ntchs
- nte = GFS_control%ntchm + ntb - 1
- end if
+ ntb = GFS_control%ntchs
+ nte = GFS_control%ntche
end if
- !--- tracer concentrations
+ !--- prognostic tracer concentrations
do it = ntb, nte
!$OMP parallel do default (none) &
!$OMP shared (it, nk, nj, ni, Atm_block, GFS_data, q) &
@@ -1091,105 +1142,37 @@ subroutine update_atmos_chemistry(state, rc)
enddo
enddo
- !--- 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, GFS_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)
- GFS_data(nb)%IntDiag%aecm(ix,it) = qm(i,j,it)
- enddo
- enddo
- enddo
-
- !--- (b) dust and sea salt emissions
- ntb = size(GFS_data(1)%IntDiag%duem, dim=2)
- nte = size(qu, dim=3)
- do it = 1, min(ntb, nte)
-!$OMP parallel do default (none) &
-!$OMP shared (it, nj, ni, Atm_block, GFS_data, qu) &
-!$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)
- GFS_data(nb)%IntDiag%duem(ix,it) = qu(i,j,it)
- enddo
- enddo
- enddo
-
- nte = nte - ntb
- if (nte > 0) then
- do it = 1, min(size(GFS_data(1)%IntDiag%ssem, dim=2), nte)
+ !--- diagnostic tracers
+ !--- set tracer concentrations in the atmospheric state directly
+ !--- since the atmosphere's driver cannot perform this step while
+ !--- updating the state
+ if (GFS_control%ndchm > 0) then
+ ntb = GFS_control%ndchs
+ nte = GFS_control%ndche
!$OMP parallel do default (none) &
-!$OMP shared (it, nj, ni, ntb, Atm_block, GFS_data, qu) &
-!$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)
- GFS_data(nb)%IntDiag%ssem(ix,it) = qu(i,j,it+ntb)
+!$OMP shared (mygrid, nk, ntb, nte, Atm, Atm_block, q) &
+!$OMP private (i, ib, ix, j, jb, k, k1, nb)
+ do nb = 1, Atm_block%nblks
+ do k = 1, nk
+ if(flip_vc) then
+ k1 = nk+1-k !reverse the k direction
+ else
+ k1 = k
+ endif
+ do ix = 1, Atm_block%blksz(nb)
+ ib = Atm_block%index(nb)%ii(ix)
+ jb = Atm_block%index(nb)%jj(ix)
+ i = ib - Atm_block%isc + 1
+ j = jb - Atm_block%jsc + 1
+ Atm(mygrid)%q(ib,jb,k1,ntb:nte) = q(i,j,k,ntb:nte)
enddo
- enddo
- enddo
- endif
-
- !--- (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, GFS_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)
- GFS_data(nb)%IntDiag%sedim (ix,it) = qd(i,j,it,1)
- GFS_data(nb)%IntDiag%drydep(ix,it) = qd(i,j,it,2)
- GFS_data(nb)%IntDiag%wetdpl(ix,it) = qd(i,j,it,3)
- GFS_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, GFS_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)
- GFS_data(nb)%IntDiag%abem(ix,it) = qb(i,j,it)
- enddo
- enddo
- enddo
+ end do
+ end do
+ end if
if (GFS_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')
@@ -1222,89 +1205,98 @@ 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_omega_levels', farrayPtr3d=vvl, rc=localrc)
+ call cplFieldGet(state,'inst_tracer_mass_frac', farrayPtr4d=q, rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+
+ call cplFieldGet(state,'inst_pbl_height', farrayPtr2d=hpbl, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_spec_humid_conv_tendency_levels', &
- farrayPtr3d=dqdt, rc=localrc)
+ call cplFieldGet(state,'surface_cell_area', farrayPtr2d=area, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_tracer_mass_frac', farrayPtr4d=q, rc=localrc)
+ call cplFieldGet(state,'inst_convective_rainfall_amount', &
+ farrayPtr2d=rainc, rc=localrc)
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=localrc)
+ call cplFieldGet(state,'inst_friction_velocity', farrayPtr2d=uustar, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'soil_type', farrayPtr2d=stype, rc=localrc)
+ call cplFieldGet(state,'inst_rainfall_amount', farrayPtr2d=rain, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_pbl_height', farrayPtr2d=hpbl, rc=localrc)
+ call cplFieldGet(state,'inst_land_sea_mask', farrayPtr2d=slmsk, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'surface_cell_area', farrayPtr2d=area, rc=localrc)
+ call cplFieldGet(state,'inst_temp_height_surface', farrayPtr2d=tsfc, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_convective_rainfall_amount', &
- farrayPtr2d=rainc, rc=localrc)
+ call cplFieldGet(state,'inst_up_sensi_heat_flx', farrayPtr2d=shfsfc, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_exchange_coefficient_heat_levels', &
- farrayPtr3d=dkt, rc=localrc)
+ call cplFieldGet(state,'inst_surface_roughness', farrayPtr2d=zorl, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_friction_velocity', farrayPtr2d=uustar, rc=localrc)
+ 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
- call cplFieldGet(state,'inst_rainfall_amount', farrayPtr2d=rain, rc=localrc)
+ call cplFieldGet(state,'inst_liq_nonconv_tendency_levels', &
+ farrayPtr3d=pflls, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_down_sw_flx', farrayPtr2d=sfcdsw, rc=localrc)
+ call cplFieldGet(state,'inst_ice_nonconv_tendency_levels', &
+ farrayPtr3d=pfils, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_land_sea_mask', farrayPtr2d=slmsk, rc=localrc)
+ call cplFieldGet(state,'inst_cloud_frac_levels', farrayPtr3d=cldfra, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_temp_height_surface', farrayPtr2d=tsfc, rc=localrc)
+ call cplFieldGet(state,'inst_zonal_wind_height10m', farrayPtr2d=u10m, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_up_sensi_heat_flx', farrayPtr2d=shfsfc, rc=localrc)
+ call cplFieldGet(state,'inst_merid_wind_height10m', farrayPtr2d=v10m, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_lwe_snow_thickness', farrayPtr2d=snowd, rc=localrc)
+ call cplFieldGet(state,'inst_surface_soil_wetness', farrayPtr2d=swet, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'vegetation_type', farrayPtr2d=vtype, rc=localrc)
+ call cplFieldGet(state,'ice_fraction_in_atm', farrayPtr2d=fice, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_vegetation_area_frac', farrayPtr2d=vfrac, rc=localrc)
+ call cplFieldGet(state,'lake_fraction', farrayPtr2d=flake, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- call cplFieldGet(state,'inst_surface_roughness', farrayPtr2d=zorl, rc=localrc)
+ call cplFieldGet(state,'ocean_fraction', farrayPtr2d=focn, rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
+ line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+
+ call cplFieldGet(state,'surface_snow_area_fraction', farrayPtr2d=fsnow, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__, rcToReturn=rc)) return
!--- handle all three-dimensional variables
!$OMP parallel do default (none) &
-!$OMP shared (nk, nj, ni, Atm_block, GFS_data, prsi, phii, prsl, phil, temp, ua, va, vvl, dkt, dqdt) &
+!$OMP shared (nk, nj, ni, Atm_block, GFS_Data, GFS_Control, &
+!$OMP cldfra, pfils, pflls, prsi, phii, prsl, phil, &
+!$OMP temp, ua, va) &
!$OMP private (k, j, jb, i, ib, nb, ix)
do k = 1, nk
do j = 1, nj
@@ -1317,14 +1309,14 @@ subroutine update_atmos_chemistry(state, rc)
prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k)
phii(i,j,k) = GFS_data(nb)%Statein%phii(ix,k)
!--- layer values
- prsl(i,j,k) = GFS_data(nb)%Statein%prsl(ix,k)
- phil(i,j,k) = GFS_data(nb)%Statein%phil(ix,k)
- temp(i,j,k) = GFS_data(nb)%Stateout%gt0(ix,k)
- ua (i,j,k) = GFS_data(nb)%Stateout%gu0(ix,k)
- va (i,j,k) = GFS_data(nb)%Stateout%gv0(ix,k)
- vvl (i,j,k) = GFS_data(nb)%Statein%vvl (ix,k)
- dkt (i,j,k) = GFS_data(nb)%Coupling%dkt(ix,k)
- dqdt(i,j,k) = GFS_data(nb)%Coupling%dqdti(ix,k)
+ prsl(i,j,k) = GFS_Data(nb)%Statein%prsl(ix,k)
+ phil(i,j,k) = GFS_Data(nb)%Statein%phil(ix,k)
+ temp(i,j,k) = GFS_Data(nb)%Stateout%gt0(ix,k)
+ ua (i,j,k) = GFS_Data(nb)%Stateout%gu0(ix,k)
+ va (i,j,k) = GFS_Data(nb)%Stateout%gv0(ix,k)
+ cldfra(i,j,k) = GFS_Data(nb)%IntDiag%cldfra(ix,k)
+ pfils (i,j,k) = GFS_Data(nb)%Coupling%pfi_lsan(ix,k)
+ pflls (i,j,k) = GFS_Data(nb)%Coupling%pfl_lsan(ix,k)
enddo
enddo
enddo
@@ -1362,9 +1354,10 @@ subroutine update_atmos_chemistry(state, rc)
enddo
!$OMP parallel do default (none) &
-!$OMP shared (nj, ni, Atm_block, GFS_data, &
-!$OMP hpbl, area, stype, rainc, rain, uustar, sfcdsw, &
-!$OMP slmsk, snowd, tsfc, shfsfc, vtype, vfrac, zorl, slc) &
+!$OMP shared (nj, ni, Atm_block, GFS_data, GFS_Control, &
+!$OMP hpbl, area, rainc, rain, uustar, &
+!$OMP fice, flake, focn, fsnow, u10m, v10m, &
+!$OMP slmsk, tsfc, shfsfc, zorl, slc, swet) &
!$OMP private (j, jb, i, ib, nb, ix)
do j = 1, nj
jb = j + Atm_block%jsc - 1
@@ -1372,22 +1365,28 @@ subroutine update_atmos_chemistry(state, rc)
ib = i + Atm_block%isc - 1
nb = Atm_block%blkno(ib,jb)
ix = Atm_block%ixp(ib,jb)
- hpbl(i,j) = GFS_data(nb)%Tbd%hpbl(ix)
- area(i,j) = GFS_data(nb)%Grid%area(ix)
- stype(i,j) = GFS_data(nb)%Sfcprop%stype(ix)
- rainc(i,j) = GFS_data(nb)%Coupling%rainc_cpl(ix)
- rain(i,j) = GFS_data(nb)%Coupling%rain_cpl(ix) &
- + GFS_data(nb)%Coupling%snow_cpl(ix)
- uustar(i,j) = GFS_data(nb)%Sfcprop%uustar(ix)
- sfcdsw(i,j) = GFS_data(nb)%Coupling%sfcdsw(ix)
- slmsk(i,j) = GFS_data(nb)%Sfcprop%slmsk(ix)
- snowd(i,j) = GFS_data(nb)%Sfcprop%snowd(ix)
- tsfc(i,j) = GFS_data(nb)%Sfcprop%tsfc(ix)
- shfsfc(i,j) = GFS_data(nb)%Coupling%ushfsfci(ix)
- vtype(i,j) = GFS_data(nb)%Sfcprop%vtype(ix)
- vfrac(i,j) = GFS_data(nb)%Sfcprop%vfrac(ix)
- zorl(i,j) = GFS_data(nb)%Sfcprop%zorl(ix)
- slc(i,j,:) = GFS_data(nb)%Sfcprop%slc(ix,:)
+ hpbl(i,j) = GFS_Data(nb)%Tbd%hpbl(ix)
+ area(i,j) = GFS_Data(nb)%Grid%area(ix)
+ rainc(i,j) = GFS_Data(nb)%Coupling%rainc_cpl(ix)
+ rain(i,j) = GFS_Data(nb)%Coupling%rain_cpl(ix) &
+ + GFS_Data(nb)%Coupling%snow_cpl(ix)
+ uustar(i,j) = GFS_Data(nb)%Sfcprop%uustar(ix)
+ slmsk(i,j) = GFS_Data(nb)%Sfcprop%slmsk(ix)
+ shfsfc(i,j) = GFS_Data(nb)%Coupling%ushfsfci(ix)
+ tsfc(i,j) = GFS_Data(nb)%Coupling%tsfci_cpl(ix)
+ zorl(i,j) = GFS_Data(nb)%Sfcprop%zorl(ix)
+ slc(i,j,:) = GFS_Data(nb)%Sfcprop%slc(ix,:)
+ u10m(i,j) = GFS_Data(nb)%Coupling%u10mi_cpl(ix)
+ v10m(i,j) = GFS_Data(nb)%Coupling%v10mi_cpl(ix)
+ focn(i,j) = GFS_Data(nb)%Sfcprop%oceanfrac(ix)
+ flake(i,j) = max(zero, GFS_Data(nb)%Sfcprop%lakefrac(ix))
+ fice(i,j) = GFS_Data(nb)%Sfcprop%fice(ix)
+ fsnow(i,j) = GFS_Data(nb)%Sfcprop%sncovr(ix)
+ if (GFS_Control%lsm == GFS_Control%lsm_ruc) then
+ swet(i,j) = GFS_Data(nb)%Sfcprop%wetness(ix)
+ else
+ swet(i,j) = GFS_Data(nb)%IntDiag%wet1(ix)
+ end if
enddo
enddo
@@ -1418,24 +1417,26 @@ subroutine update_atmos_chemistry(state, rc)
write(6,'("update_atmos: tgrs - min/max/avg",3g16.6)') minval(temp), maxval(temp), sum(temp)/size(temp)
write(6,'("update_atmos: ugrs - min/max/avg",3g16.6)') minval(ua), maxval(ua), sum(ua)/size(ua)
write(6,'("update_atmos: vgrs - min/max/avg",3g16.6)') minval(va), maxval(va), sum(va)/size(va)
- write(6,'("update_atmos: vvl - min/max/avg",3g16.6)') minval(vvl), maxval(vvl), sum(vvl)/size(vvl)
- write(6,'("update_atmos: dqdt - min/max/avg",3g16.6)') minval(dqdt), maxval(dqdt), sum(dqdt)/size(dqdt)
write(6,'("update_atmos: qgrs - min/max/avg",3g16.6)') minval(q), maxval(q), sum(q)/size(q)
write(6,'("update_atmos: hpbl - min/max/avg",3g16.6)') minval(hpbl), maxval(hpbl), sum(hpbl)/size(hpbl)
write(6,'("update_atmos: rainc - min/max/avg",3g16.6)') minval(rainc), maxval(rainc), sum(rainc)/size(rainc)
write(6,'("update_atmos: rain - min/max/avg",3g16.6)') minval(rain), maxval(rain), sum(rain)/size(rain)
write(6,'("update_atmos: shfsfc - min/max/avg",3g16.6)') minval(shfsfc), maxval(shfsfc), sum(shfsfc)/size(shfsfc)
- write(6,'("update_atmos: sfcdsw - min/max/avg",3g16.6)') minval(sfcdsw), maxval(sfcdsw), sum(sfcdsw)/size(sfcdsw)
write(6,'("update_atmos: slmsk - min/max/avg",3g16.6)') minval(slmsk), maxval(slmsk), sum(slmsk)/size(slmsk)
- write(6,'("update_atmos: snowd - min/max/avg",3g16.6)') minval(snowd), maxval(snowd), sum(snowd)/size(snowd)
write(6,'("update_atmos: tsfc - min/max/avg",3g16.6)') minval(tsfc), maxval(tsfc), sum(tsfc)/size(tsfc)
- write(6,'("update_atmos: vtype - min/max/avg",3g16.6)') minval(vtype), maxval(vtype), sum(vtype)/size(vtype)
- write(6,'("update_atmos: vfrac - min/max/avg",3g16.6)') minval(vfrac), maxval(vfrac), sum(vfrac)/size(vfrac)
write(6,'("update_atmos: area - min/max/avg",3g16.6)') minval(area), maxval(area), sum(area)/size(area)
- write(6,'("update_atmos: stype - min/max/avg",3g16.6)') minval(stype), maxval(stype), sum(stype)/size(stype)
write(6,'("update_atmos: zorl - min/max/avg",3g16.6)') minval(zorl), maxval(zorl), sum(zorl)/size(zorl)
write(6,'("update_atmos: slc - min/max/avg",3g16.6)') minval(slc), maxval(slc), sum(slc)/size(slc)
+ write(6,'("update_atmos: cldfra - min/max/avg",3g16.6)') minval(cldfra), maxval(cldfra), sum(cldfra)/size(cldfra)
+ write(6,'("update_atmos: fice - min/max/avg",3g16.6)') minval(fice), maxval(fice), sum(fice)/size(fice)
+ write(6,'("update_atmos: flake - min/max/avg",3g16.6)') minval(flake), maxval(flake), sum(flake)/size(flake)
+ write(6,'("update_atmos: focn - min/max/avg",3g16.6)') minval(focn), maxval(focn), sum(focn)/size(focn)
+ write(6,'("update_atmos: pfils - min/max/avg",3g16.6)') minval(pfils), maxval(pfils), sum(pfils)/size(pfils)
+ write(6,'("update_atmos: pflls - min/max/avg",3g16.6)') minval(pflls), maxval(pflls), sum(pflls)/size(pflls)
+ write(6,'("update_atmos: swet - min/max/avg",3g16.6)') minval(swet), maxval(swet), sum(swet)/size(swet)
+ write(6,'("update_atmos: u10m - min/max/avg",3g16.6)') minval(u10m), maxval(u10m), sum(u10m)/size(u10m)
+ write(6,'("update_atmos: v10m - min/max/avg",3g16.6)') minval(v10m), maxval(v10m), sum(v10m)/size(v10m)
end if
case default
@@ -2396,31 +2397,46 @@ subroutine assign_importdata(rc)
end subroutine assign_importdata
!
- subroutine setup_exportdata()
+ subroutine setup_exportdata(rc)
use ESMF
use module_cplfields, only: exportFields
+ !--- arguments
+ integer, optional, intent(out) :: rc
+
!--- local variables
- integer :: j, i, k, ix, nb, nk, isc, iec, jsc, jec, idx
+ integer :: i, j, k, idx, ix
+ integer :: isc, iec, jsc, jec
+ integer :: ib, jb, nb, nsb, nk
integer :: sphum, liq_wat, ice_wat, o3mr
real(GFS_kind_phys) :: rtime, rtimek
- integer :: localrc, rc
- integer :: n,dimCount
- logical :: isCreated
+ integer :: localrc
+ integer :: n,rank
+ logical :: isFound
type(ESMF_TypeKind_Flag) :: datatype
character(len=ESMF_MAXSTR) :: fieldName
real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d
real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d
real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer :: datar83d
+ !--- local parameters
+ real(kind=ESMF_KIND_R8), parameter :: zeror8 = 0._ESMF_KIND_R8
+
+ !--- begin
+ if (present(rc)) rc = ESMF_SUCCESS
+
+ !--- disable if coupling with chemistry
+ if (GFS_control%cplchm) return
+
isc = Atm_block%isc
iec = Atm_block%iec
jsc = Atm_block%jsc
jec = Atm_block%jec
nk = Atm_block%npz
+ nsb = Atm_block%blkno(isc,jsc)
rtime = one / GFS_control%dtp
rtimek = GFS_control%rho_h2o * rtime
@@ -2431,932 +2447,254 @@ subroutine setup_exportdata()
datar82d => null()
datar83d => null()
- isCreated = ESMF_FieldIsCreated(exportFields(n), rc=localrc)
+ isFound = ESMF_FieldIsCreated(exportFields(n), rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- if (.not. isCreated) cycle
-
- call ESMF_FieldGet(exportFields(n), name=fieldname, dimCount=dimCount, typekind=datatype, rc=localrc)
- if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- if (datatype == ESMF_TYPEKIND_R8) then
- if (dimCount == 2) then
- call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=localrc)
- if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- else if (dimCount == 3) then
- call ESMF_FieldGet(exportFields(n),farrayPtr=datar83d,localDE=0, rc=localrc)
- if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- else
- write(0,*)'not implemented dimCount ',dimCount, trim(fieldname)
- call ESMF_Finalize(endflag=ESMF_END_ABORT)
- endif
- else if (datatype == ESMF_TYPEKIND_R4) then
- if (dimCount == 2) then
- call ESMF_FieldGet(exportFields(n),farrayPtr=datar42d,localDE=0, rc=localrc)
- if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
- else
- write(0,*)'not implemented dimCount ',dimCount, trim(fieldname)
- call ESMF_Finalize(endflag=ESMF_END_ABORT)
- endif
- else
- write(0,*) 'not implemented datatype ',datatype, trim(fieldname)
- call ESMF_Finalize(endflag=ESMF_END_ABORT)
- endif
-
-
-
- ! Instantaneous u wind (m/s) 10 m above ground
- if (trim(fieldname) == 'inst_zonal_wind_height10m') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%u10mi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instantaneous v wind (m/s) 10 m above ground
- if (trim(fieldname) == 'inst_merid_wind_height10m') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%v10mi_cpl(ix)
- enddo
- enddo
- endif
-
- ! MEAN Zonal compt of momentum flux (N/m**2)
- if (trim(fieldname) == 'mean_zonal_moment_flx_atm') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dusfc_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN Merid compt of momentum flux (N/m**2)
- if (trim(fieldname) == 'mean_merid_moment_flx_atm') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvsfc_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN Sensible heat flux (W/m**2)
- if (trim(fieldname) == 'mean_sensi_heat_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dtsfc_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN Latent heat flux (W/m**2)
- if (trim(fieldname) == 'mean_laten_heat_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dqsfc_cpl(ix) * rtime
- enddo
- enddo
- endif
- ! MEAN Downward LW heat flux (W/m**2)
- if (trim(fieldname) == 'mean_down_lw_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dlwsfc_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN Downward SW heat flux (W/m**2)
- if (trim(fieldname) == 'mean_down_sw_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dswsfc_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN precipitation rate (kg/m2/s)
- if (trim(fieldname) == 'mean_prec_rate') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%rain_cpl(ix) * rtimek
- enddo
- enddo
- endif
-
- ! Instataneous Zonal compt of momentum flux (N/m**2)
- if (trim(fieldname) == 'inst_zonal_moment_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dusfci_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Merid compt of momentum flux (N/m**2)
- if (trim(fieldname) == 'inst_merid_moment_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvsfci_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Sensible heat flux (W/m**2)
- if (trim(fieldname) == 'inst_sensi_heat_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dtsfci_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Latent heat flux (W/m**2)
- if (trim(fieldname) == 'inst_laten_heat_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dqsfci_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Downward long wave radiation flux (W/m**2)
- if (trim(fieldname) == 'inst_down_lw_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dlwsfci_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Downward solar radiation flux (W/m**2)
- if (trim(fieldname) == 'inst_down_sw_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dswsfci_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Temperature (K) 2 m above ground
- if (trim(fieldname) == 'inst_temp_height2m') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%t2mi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Specific humidity (kg/kg) 2 m above ground
- if (trim(fieldname) == 'inst_spec_humid_height2m') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%q2mi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Temperature (K) at surface
- if (trim(fieldname) == 'inst_temp_height_surface') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%tsfci_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Pressure (Pa) land and sea surface
- if (trim(fieldname) == 'inst_pres_height_surface') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%psurfi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous Surface height (m)
- if (trim(fieldname) == 'inst_surface_height') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%oro_cpl(ix)
- enddo
- enddo
- endif
-
- ! MEAN NET long wave radiation flux (W/m**2)
- if (trim(fieldname) == 'mean_net_lw_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nlwsfc_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN NET solar radiation flux over the ocean (W/m**2)
- if (trim(fieldname) == 'mean_net_sw_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nswsfc_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! Instataneous NET long wave radiation flux (W/m**2)
- if (trim(fieldname) == 'inst_net_lw_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nlwsfci_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous NET solar radiation flux over the ocean (W/m**2)
- if (trim(fieldname) == 'inst_net_sw_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nswsfci_cpl(ix)
- enddo
- enddo
- endif
-
- ! MEAN sfc downward nir direct flux (W/m**2)
- if (trim(fieldname) == 'mean_down_sw_ir_dir_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirbm_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN sfc downward nir diffused flux (W/m**2)
- if (trim(fieldname) == 'mean_down_sw_ir_dif_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirdf_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN sfc downward uv+vis direct flux (W/m**2)
- if (trim(fieldname) == 'mean_down_sw_vis_dir_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisbm_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN sfc downward uv+vis diffused flux (W/m**2)
- if (trim(fieldname) == 'mean_down_sw_vis_dif_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisdf_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! Instataneous sfc downward nir direct flux (W/m**2)
- if (trim(fieldname) == 'inst_down_sw_ir_dir_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirbmi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous sfc downward nir diffused flux (W/m**2)
- if (trim(fieldname) == 'inst_down_sw_ir_dif_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirdfi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous sfc downward uv+vis direct flux (W/m**2)
- if (trim(fieldname) == 'inst_down_sw_vis_dir_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisbmi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous sfc downward uv+vis diffused flux (W/m**2)
- if (trim(fieldname) == 'inst_down_sw_vis_dif_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisdfi_cpl(ix)
- enddo
- enddo
- endif
-
- ! MEAN NET sfc nir direct flux (W/m**2)
- if (trim(fieldname) == 'mean_net_sw_ir_dir_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirbm_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN NET sfc nir diffused flux (W/m**2)
- if (trim(fieldname) == 'mean_net_sw_ir_dif_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirdf_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN NET sfc uv+vis direct flux (W/m**2)
- if (trim(fieldname) == 'mean_net_sw_vis_dir_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisbm_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! MEAN NET sfc uv+vis diffused flux (W/m**2)
- if (trim(fieldname) == 'mean_net_sw_vis_dif_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisdf_cpl(ix) * rtime
- enddo
- enddo
- endif
-
- ! Instataneous net sfc nir direct flux (W/m**2)
- if (trim(fieldname) == 'inst_net_sw_ir_dir_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirbmi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous net sfc nir diffused flux (W/m**2)
- if (trim(fieldname) == 'inst_net_sw_ir_dif_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirdfi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous net sfc uv+vis direct flux (W/m**2)
- if (trim(fieldname) == 'inst_net_sw_vis_dir_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisbmi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Instataneous net sfc uv+vis diffused flux (W/m**2)
- if (trim(fieldname) == 'inst_net_sw_vis_dif_flx') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisdfi_cpl(ix)
- enddo
- enddo
- endif
-
- ! Land/Sea mask (sea:0,land:1)
- if (trim(fieldname) == 'inst_land_sea_mask') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%slmsk_cpl(ix)
- enddo
- enddo
- endif
-
-! Data from DYCORE:
-
- ! bottom layer temperature (t)
- if (trim(fieldname) == 'inst_temp_height_lowest') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- if (associated(DYCORE_Data(nb)%coupling%t_bot)) then
- datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%t_bot(ix)
- else
- datar82d(i-isc+1,j-jsc+1) = zero
- endif
- enddo
- enddo
- endif
-
- ! bottom layer specific humidity (q)
- !!! CHECK if tracer 1 is for specific humidity !!!
- if (trim(fieldname) == 'inst_spec_humid_height_lowest') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- if (associated(DYCORE_Data(nb)%coupling%tr_bot)) then
- datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%tr_bot(ix,1)
- else
- datar82d(i-isc+1,j-jsc+1) = zero
- endif
- enddo
- enddo
- endif
-
- ! bottom layer zonal wind (u)
- if (trim(fieldname) == 'inst_zonal_wind_height_lowest') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- if (associated(DYCORE_Data(nb)%coupling%u_bot)) then
- datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%u_bot(ix)
- else
- datar82d(i-isc+1,j-jsc+1) = zero
- endif
- enddo
- enddo
- endif
-
- ! bottom layer meridionalw wind (v)
- if (trim(fieldname) == 'inst_merid_wind_height_lowest') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- if (associated(DYCORE_Data(nb)%coupling%v_bot)) then
- datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%v_bot(ix)
- else
- datar82d(i-isc+1,j-jsc+1) = zero
- endif
- enddo
- enddo
- endif
-
- ! bottom layer pressure (p)
- if (trim(fieldname) == 'inst_pres_height_lowest') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- if (associated(DYCORE_Data(nb)%coupling%p_bot)) then
- datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%p_bot(ix)
- else
- datar82d(i-isc+1,j-jsc+1) = zero
- endif
- enddo
- enddo
- endif
-
- ! bottom layer height (z)
- if (trim(fieldname) == 'inst_height_lowest') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- if (associated(DYCORE_Data(nb)%coupling%z_bot)) then
- datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%z_bot(ix)
- else
- datar82d(i-isc+1,j-jsc+1) = zero
- endif
- enddo
- enddo
- endif
-
-! END Data from DYCORE.
-
- ! MEAN snow precipitation rate (kg/m2/s)
- if (trim(fieldname) == 'mean_fprec_rate') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%snow_cpl(ix) * rtimek
- enddo
- enddo
- endif
-
- ! oceanfrac used by atm to calculate fluxes
- if (trim(fieldname) == 'openwater_frac_in_atm') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = (one - GFS_Data(nb)%Sfcprop%fice(ix))*GFS_Data(nb)%Sfcprop%oceanfrac(ix)
- enddo
- enddo
- endif
-
- ! For JEDI
-
- sphum = get_tracer_index(MODEL_ATMOS, 'sphum')
- liq_wat = get_tracer_index(MODEL_ATMOS, 'liq_wat')
- ice_wat = get_tracer_index(MODEL_ATMOS, 'ice_wat')
- o3mr = get_tracer_index(MODEL_ATMOS, 'o3mr')
-
- if (trim(fieldname) == 'u') then
-!$omp parallel do default(shared) private(i,j,k)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%u(i,j,k)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'v') then
-!$omp parallel do default(shared) private(i,j,k)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%v(i,j,k)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'ua') then
-!$omp parallel do default(shared) private(i,j,k,nb,ix)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%ua(i,j,k)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'va') then
-!$omp parallel do default(shared) private(i,j,k)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%va(i,j,k)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 't') then
-!$omp parallel do default(shared) private(i,j,k)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%pt(i,j,k)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'delp') then
-!$omp parallel do default(shared) private(i,j,k)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%delp(i,j,k)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'sphum' .and. sphum > 0) then
-!$omp parallel do default(shared) private(i,j,k)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,sphum)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'ice_wat' .and. ice_wat > 0) then
-!$omp parallel do default(shared) private(i,j,k)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,ice_wat)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'liq_wat' .and. liq_wat > 0) then
-!$omp parallel do default(shared) private(i,j,k)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,liq_wat)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'o3mr' .and. o3mr > 0) then
-!$omp parallel do default(shared) private(i,j,k)
- do k = 1, nk
- do j=jsc,jec
- do i=isc,iec
- datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,o3mr)
- enddo
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'phis') then
-!$omp parallel do default(shared) private(i,j)
- do j=jsc,jec
- do i=isc,iec
- datar82d(i-isc+1,j-jsc+1) = Atm(mygrid)%phis(i,j)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'u_srf') then
-!$omp parallel do default(shared) private(i,j)
- do j=jsc,jec
- do i=isc,iec
- datar82d(i-isc+1,j-jsc+1) = Atm(mygrid)%u_srf(i,j)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'v_srf') then
-!$omp parallel do default(shared) private(i,j)
- do j=jsc,jec
- do i=isc,iec
- datar82d(i-isc+1,j-jsc+1) = Atm(mygrid)%v_srf(i,j)
- enddo
- enddo
- endif
-
- ! physics
- if (trim(fieldname) == 'slmsk') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%slmsk(ix)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'weasd') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%weasd(ix)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'tsea') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%tsfco(ix)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'vtype') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%vtype(ix)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'stype') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%stype(ix)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'vfrac') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%vfrac(ix)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'stc') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar83d(i-isc+1,j-jsc+1,:) = GFS_data(nb)%Sfcprop%stc(ix,:)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'smc') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar83d(i-isc+1,j-jsc+1,:) = GFS_data(nb)%Sfcprop%smc(ix,:)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'snwdph') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%snowd(ix)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'f10m') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%f10m(ix)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 'zorl') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%zorl(ix)
- enddo
- enddo
- endif
-
- if (trim(fieldname) == 't2m') then
-!$omp parallel do default(shared) private(i,j,nb,ix)
- do j=jsc,jec
- do i=isc,iec
- nb = Atm_block%blkno(i,j)
- ix = Atm_block%ixp(i,j)
- datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%t2m(ix)
- enddo
- enddo
- endif
+ if (isFound) then
+ call ESMF_FieldGet(exportFields(n), name=fieldname, rank=rank, typekind=datatype, rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+ if (datatype == ESMF_TYPEKIND_R8) then
+ select case (rank)
+ case (2)
+ call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+ case (3)
+ call ESMF_FieldGet(exportFields(n),farrayPtr=datar83d,localDE=0, rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+ case default
+ !--- skip field
+ isFound = .false.
+ end select
+ else if (datatype == ESMF_TYPEKIND_R4) then
+ select case (rank)
+ case (2)
+ call ESMF_FieldGet(exportFields(n),farrayPtr=datar42d,localDE=0, rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+ case default
+ !--- skip field
+ isFound = .false.
+ end select
+ else
+ !--- skip field
+ isFound = .false.
+ end if
+ end if
+ if (isFound) then
+!$omp parallel do default(shared) private(nb) reduction(max:localrc)
+ do nb = 1, Atm_block%nblks
+ select case (trim(fieldname))
+ !--- Instantaneous quantities
+ ! Instantaneous u wind (m/s) 10 m above ground
+ case ('inst_zonal_wind_height10m')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%u10mi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous v wind (m/s) 10 m above ground
+ case ('inst_merid_wind_height10m')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%v10mi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Zonal compt of momentum flux (N/m**2)
+ case ('inst_zonal_moment_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfci_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Merid compt of momentum flux (N/m**2)
+ case ('inst_merid_moment_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfci_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Sensible heat flux (W/m**2)
+ case ('inst_sensi_heat_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfci_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Latent heat flux (W/m**2)
+ case ('inst_laten_heat_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Downward long wave radiation flux (W/m**2)
+ case ('inst_down_lw_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfci_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Downward solar radiation flux (W/m**2)
+ case ('inst_down_sw_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dswsfci_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Temperature (K) 2 m above ground
+ case ('inst_temp_height2m')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%t2mi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Specific humidity (kg/kg) 2 m above ground
+ case ('inst_spec_humid_height2m')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%q2mi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Temperature (K) at surface
+ case ('inst_temp_height_surface')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%tsfci_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Pressure (Pa) land and sea surface
+ case ('inst_pres_height_surface')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%psurfi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous Surface height (m)
+ case ('inst_surface_height')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%oro_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous NET long wave radiation flux (W/m**2)
+ case ('inst_net_lw_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nlwsfci_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous NET solar radiation flux over the ocean (W/m**2)
+ case ('inst_net_sw_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nswsfci_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous sfc downward nir direct flux (W/m**2)
+ case ('inst_down_sw_ir_dir_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirbmi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous sfc downward nir diffused flux (W/m**2)
+ case ('inst_down_sw_ir_dif_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirdfi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous sfc downward uv+vis direct flux (W/m**2)
+ case ('inst_down_sw_vis_dir_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisbmi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous sfc downward uv+vis diffused flux (W/m**2)
+ case ('inst_down_sw_vis_dif_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisdfi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous net sfc nir direct flux (W/m**2)
+ case ('inst_net_sw_ir_dir_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirbmi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous net sfc nir diffused flux (W/m**2)
+ case ('inst_net_sw_ir_dif_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirdfi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous net sfc uv+vis direct flux (W/m**2)
+ case ('inst_net_sw_vis_dir_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisbmi_cpl, Atm_block, nb, rc=localrc)
+ ! Instantaneous net sfc uv+vis diffused flux (W/m**2)
+ case ('inst_net_sw_vis_dif_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdfi_cpl, Atm_block, nb, rc=localrc)
+ ! Land/Sea mask (sea:0,land:1)
+ case ('inst_land_sea_mask', 'slmsk')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%slmsk, Atm_block, nb, rc=localrc)
+ !--- Mean quantities
+ ! MEAN Zonal compt of momentum flux (N/m**2)
+ case ('mean_zonal_moment_flx_atm')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN Merid compt of momentum flux (N/m**2)
+ case ('mean_merid_moment_flx_atm')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN Sensible heat flux (W/m**2)
+ case ('mean_sensi_heat_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN Latent heat flux (W/m**2)
+ case ('mean_laten_heat_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN Downward LW heat flux (W/m**2)
+ case ('mean_down_lw_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN Downward SW heat flux (W/m**2)
+ case ('mean_down_sw_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dswsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN NET long wave radiation flux (W/m**2)
+ case ('mean_net_lw_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nlwsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN NET solar radiation flux over the ocean (W/m**2)
+ case ('mean_net_sw_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nswsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN sfc downward nir direct flux (W/m**2)
+ case ('mean_down_sw_ir_dir_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN sfc downward nir diffused flux (W/m**2)
+ case ('mean_down_sw_ir_dif_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN sfc downward uv+vis direct flux (W/m**2)
+ case ('mean_down_sw_vis_dir_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN sfc downward uv+vis diffused flux (W/m**2)
+ case ('mean_down_sw_vis_dif_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN NET sfc nir direct flux (W/m**2)
+ case ('mean_net_sw_ir_dir_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN NET sfc nir diffused flux (W/m**2)
+ case ('mean_net_sw_ir_dif_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN NET sfc uv+vis direct flux (W/m**2)
+ case ('mean_net_sw_vis_dir_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN NET sfc uv+vis diffused flux (W/m**2)
+ case ('mean_net_sw_vis_dif_flx')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
+ ! MEAN precipitation rate (kg/m2/s)
+ case ('mean_prec_rate')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc)
+ ! MEAN snow precipitation rate (kg/m2/s)
+ case ('mean_fprec_rate')
+ call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc)
+ ! oceanfrac used by atm to calculate fluxes
+ case ('openwater_frac_in_atm')
+ call block_data_combine_fractions(datar82d, GFS_data(nb)%sfcprop%oceanfrac, GFS_Data(nb)%sfcprop%fice, Atm_block, nb, rc=localrc)
+ !--- Dycore quantities
+ ! bottom layer temperature (t)
+ case('inst_temp_height_lowest')
+ call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%t_bot, zeror8, Atm_block, nb, rc=localrc)
+ ! bottom layer specific humidity (q)
+ ! ! ! CHECK if tracer 1 is for specific humidity ! ! !
+ case('inst_spec_humid_height_lowest')
+ call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%tr_bot, 1, zeror8, Atm_block, nb, rc=localrc)
+ ! bottom layer zonal wind (u)
+ case('inst_zonal_wind_height_lowest')
+ call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%u_bot, zeror8, Atm_block, nb, rc=localrc)
+ ! bottom layer meridionalw wind (v)
+ case('inst_merid_wind_height_lowest')
+ call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%v_bot, zeror8, Atm_block, nb, rc=localrc)
+ ! bottom layer pressure (p)
+ case('inst_pres_height_lowest')
+ call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%p_bot, zeror8, Atm_block, nb, rc=localrc)
+ ! bottom layer height (z)
+ case('inst_height_lowest')
+ call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%z_bot, zeror8, Atm_block, nb, rc=localrc)
+ !--- JEDI fields
+ case ('u')
+ call block_atmos_copy(datar83d, Atm(mygrid)%u, Atm_block, nb, rc=localrc)
+ case ('v')
+ call block_atmos_copy(datar83d, Atm(mygrid)%v, Atm_block, nb, rc=localrc)
+ case ('ua')
+ call block_atmos_copy(datar83d, Atm(mygrid)%ua, Atm_block, nb, rc=localrc)
+ case ('va')
+ call block_atmos_copy(datar83d, Atm(mygrid)%va, Atm_block, nb, rc=localrc)
+ case ('t')
+ call block_atmos_copy(datar83d, Atm(mygrid)%pt, Atm_block, nb, rc=localrc)
+ case ('delp')
+ call block_atmos_copy(datar83d, Atm(mygrid)%delp, Atm_block, nb, rc=localrc)
+ case ('sphum')
+ sphum = get_tracer_index(MODEL_ATMOS, 'sphum')
+ call block_atmos_copy(datar83d, Atm(mygrid)%q, sphum, Atm_block, nb, rc=localrc)
+ case ('ice_wat')
+ ice_wat = get_tracer_index(MODEL_ATMOS, 'ice_wat')
+ call block_atmos_copy(datar83d, Atm(mygrid)%q, ice_wat, Atm_block, nb, rc=localrc)
+ case ('liq_wat')
+ liq_wat = get_tracer_index(MODEL_ATMOS, 'liq_wat')
+ call block_atmos_copy(datar83d, Atm(mygrid)%q, liq_wat, Atm_block, nb, rc=localrc)
+ case ('o3mr')
+ o3mr = get_tracer_index(MODEL_ATMOS, 'o3mr')
+ call block_atmos_copy(datar83d, Atm(mygrid)%q, o3mr, Atm_block, nb, rc=localrc)
+ case ('phis')
+ call block_atmos_copy(datar82d, Atm(mygrid)%phis, Atm_block, nb, rc=localrc)
+ case ('u_srf')
+ call block_atmos_copy(datar82d, Atm(mygrid)%u_srf, Atm_block, nb, rc=localrc)
+ case ('v_srf')
+ call block_atmos_copy(datar82d, Atm(mygrid)%v_srf, Atm_block, nb, rc=localrc)
+ case ('weasd')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%weasd, Atm_block, nb, rc=localrc)
+ case ('tsea')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%tsfco, Atm_block, nb, rc=localrc)
+ case ('vtype')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%vtype, Atm_block, nb, rc=localrc)
+ case ('stype')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%stype, Atm_block, nb, rc=localrc)
+ case ('vfrac')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%vfrac, Atm_block, nb, rc=localrc)
+ case ('stc')
+ call block_data_copy(datar83d, GFS_data(nb)%sfcprop%stc, Atm_block, nb, rc=localrc)
+ case ('smc')
+ call block_data_copy(datar83d, GFS_data(nb)%sfcprop%smc, Atm_block, nb, rc=localrc)
+ case ('snwdph')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%snowd, Atm_block, nb, rc=localrc)
+ case ('f10m')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%f10m, Atm_block, nb, rc=localrc)
+ case ('zorl')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%zorl, Atm_block, nb, rc=localrc)
+ case ('t2m')
+ call block_data_copy(datar82d, GFS_data(nb)%sfcprop%t2m, Atm_block, nb, rc=localrc)
+ case default
+ localrc = ESMF_RC_NOT_FOUND
+ end select
+ enddo
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg="Failure to populate exported field: "//trim(fieldname), &
+ line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+ endif
enddo ! exportFields
!---
diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90
index 1e4f4c082..0262f5a98 100644
--- a/ccpp/data/GFS_typedefs.F90
+++ b/ccpp/data/GFS_typedefs.F90
@@ -144,7 +144,7 @@ module GFS_typedefs
integer :: nwat !< number of hydrometeors in dcyore (including water vapor)
character(len=32), pointer :: tracer_names(:) !< tracers names to dereference tracer id
- !< based on name location in array
+ integer, pointer :: tracer_types(:) !< tracers types: 0=generic, 1=chem,prog, 2=chem,diag
character(len=64) :: fn_nml !< namelist filename
character(len=256), pointer :: input_nml_file(:) !< character string containing full namelist
!< for use with internal file reads
@@ -532,11 +532,11 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: nwfa2d (:) => null() !< instantaneous water-friendly sfc aerosol source
real (kind=kind_phys), pointer :: nifa2d (:) => null() !< instantaneous ice-friendly sfc aerosol source
- !--- instantaneous quantities for GSDCHEM coupling
- real (kind=kind_phys), pointer :: dqdti (:,:) => null() !< instantaneous total moisture tendency (kg/kg/s)
+ !--- instantaneous quantities for chemistry coupling
real (kind=kind_phys), pointer :: ushfsfci(:) => null() !< instantaneous upward sensible heat flux (w/m**2)
- real (kind=kind_phys), pointer :: dkt (:,:) => null() !< instantaneous dkt diffusion coefficient for temperature (m**2/s)
real (kind=kind_phys), pointer :: qci_conv(:,:) => null() !< convective cloud condesate after rainout
+ real (kind=kind_phys), pointer :: pfi_lsan(:,:) => null() !< instantaneous 3D flux of ice nonconvective precipitation (kg m-2 s-1)
+ real (kind=kind_phys), pointer :: pfl_lsan(:,:) => null() !< instantaneous 3D flux of liquid nonconvective precipitation (kg m-2 s-1)
contains
@@ -1136,8 +1136,12 @@ module GFS_typedefs
integer :: nto2 !< tracer index for oxygen
integer :: ntwa !< tracer index for water friendly aerosol
integer :: ntia !< tracer index for ice friendly aerosol
- integer :: ntchm !< number of chemical tracers
- integer :: ntchs !< tracer index for first chemical tracer
+ integer :: ntchm !< number of prognostic chemical tracers (advected)
+ integer :: ntchs !< tracer index for first prognostic chemical tracer
+ integer :: ntche !< tracer index for last prognostic chemical tracer
+ integer :: ndchm !< number of diagnostic chemical tracers (not advected)
+ integer :: ndchs !< tracer index for first diagnostic chemical tracer
+ integer :: ndche !< tracer index for last diagnostic chemical tracer
logical, pointer :: ntdiag(:) => null() !< array to control diagnostics for chemical tracers
real(kind=kind_phys), pointer :: fscav(:) => null() !< array of aerosol scavenging coefficients
@@ -1217,8 +1221,10 @@ module GFS_typedefs
real(kind=kind_phys) :: rhcmax ! maximum critical relative humidity, replaces rhc_max in physcons.F90
contains
- procedure :: init => control_initialize
- procedure :: print => control_print
+ procedure :: init => control_initialize
+ procedure :: init_chemistry => control_chemistry_initialize
+ procedure :: init_scavenging => control_scavenging_initialize
+ procedure :: print => control_print
end type GFS_control_type
@@ -1692,21 +1698,6 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: tau_tofd(:) => null() !
!---vay-2018 UGWP-diagnostics
- !--- Output diagnostics for coupled chemistry
- integer :: ndust !< number of dust bins for diagnostics
- integer :: nseasalt !< number of seasalt bins for diagnostics
- integer :: ntchmdiag !< number of chemical tracers for diagnostics
- real (kind=kind_phys), pointer :: duem (:,:) => null() !< instantaneous dust emission flux ( kg/m**2/s )
- real (kind=kind_phys), pointer :: ssem (:,:) => null() !< instantaneous sea salt emission flux ( kg/m**2/s )
- real (kind=kind_phys), pointer :: sedim (:,:) => null() !< instantaneous sedimentation ( kg/m**2/s )
- real (kind=kind_phys), pointer :: drydep(:,:) => null() !< instantaneous dry deposition ( kg/m**2/s )
- real (kind=kind_phys), pointer :: wetdpl(:,:) => null() !< instantaneous large-scale wet deposition ( kg/m**2/s )
- real (kind=kind_phys), pointer :: wetdpc(:,:) => null() !< instantaneous convective-scale wet deposition ( kg/m**2/s )
- real (kind=kind_phys), pointer :: abem (:,:) => null() !< instantaneous anthopogenic and biomass burning emissions
- !< for black carbon, organic carbon, and sulfur dioxide ( ug/m**2/s )
- real (kind=kind_phys), pointer :: aecm (:,:) => null() !< instantaneous aerosol column mass densities for
- !< pm2.5, black carbon, organic carbon, sulfate, dust, sea salt ( g/m**2 )
-
! Auxiliary output arrays for debugging
real (kind=kind_phys), pointer :: aux2d(:,:) => null() !< auxiliary 2d arrays in output (for debugging)
real (kind=kind_phys), pointer :: aux3d(:,:,:)=> null() !< auxiliary 2d arrays in output (for debugging)
@@ -1715,7 +1706,6 @@ module GFS_typedefs
procedure :: create => diag_create
procedure :: rad_zero => diag_rad_zero
procedure :: phys_zero => diag_phys_zero
- procedure :: chem_init => diag_chem_init
end type GFS_diag_type
!---------------------------------------------------------------------
@@ -2732,7 +2722,7 @@ subroutine coupling_create (Coupling, IM, Model)
Coupling%snow_cpl = clear_val
endif
- if (Model%cplflx .or. Model%cplwav) then
+ if (Model%cplflx .or. Model%cplchm .or. Model%cplwav) then
!--- instantaneous quantities
allocate (Coupling%u10mi_cpl (IM))
allocate (Coupling%v10mi_cpl (IM))
@@ -2741,6 +2731,12 @@ subroutine coupling_create (Coupling, IM, Model)
Coupling%v10mi_cpl = clear_val
endif
+ if (Model%cplflx .or. Model%cplchm) then
+ !--- instantaneous quantities
+ allocate (Coupling%tsfci_cpl (IM))
+ Coupling%tsfci_cpl = clear_val
+ endif
+
! if (Model%cplwav2atm) then
!--- incoming quantities
! allocate (Coupling%zorlwav_cpl (IM))
@@ -2836,7 +2832,6 @@ subroutine coupling_create (Coupling, IM, Model)
allocate (Coupling%nvisdfi_cpl (IM))
allocate (Coupling%t2mi_cpl (IM))
allocate (Coupling%q2mi_cpl (IM))
- allocate (Coupling%tsfci_cpl (IM))
allocate (Coupling%psurfi_cpl (IM))
allocate (Coupling%oro_cpl (IM))
allocate (Coupling%slmsk_cpl (IM))
@@ -2859,7 +2854,6 @@ subroutine coupling_create (Coupling, IM, Model)
Coupling%nvisdfi_cpl = clear_val
Coupling%t2mi_cpl = clear_val
Coupling%q2mi_cpl = clear_val
- Coupling%tsfci_cpl = clear_val
Coupling%psurfi_cpl = clear_val
Coupling%oro_cpl = clear_val !< pointer to sfcprop%oro
Coupling%slmsk_cpl = clear_val !< pointer to sfcprop%slmsk
@@ -2889,19 +2883,19 @@ subroutine coupling_create (Coupling, IM, Model)
Coupling%condition = clear_val
endif
- ! -- GSDCHEM coupling options
+ ! -- Aerosols coupling options
if (Model%cplchm) then
!--- outgoing instantaneous quantities
allocate (Coupling%ushfsfci (IM))
- allocate (Coupling%dkt (IM,Model%levs))
- allocate (Coupling%dqdti (IM,Model%levs))
!--- accumulated convective rainfall
allocate (Coupling%rainc_cpl (IM))
-
+ ! -- instantaneous 3d fluxes of nonconvective ice and liquid precipitations
+ allocate (Coupling%pfi_lsan (IM,Model%levs))
+ allocate (Coupling%pfl_lsan (IM,Model%levs))
Coupling%rainc_cpl = clear_val
Coupling%ushfsfci = clear_val
- Coupling%dkt = clear_val
- Coupling%dqdti = clear_val
+ Coupling%pfi_lsan = clear_val
+ Coupling%pfl_lsan = clear_val
endif
!--- stochastic physics option
@@ -2954,7 +2948,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
logunit, isc, jsc, nx, ny, levs, &
cnx, cny, gnx, gny, dt_dycore, &
dt_phys, iau_offset, idat, jdat, &
- nwat, tracer_names, &
+ nwat, tracer_names, tracer_types, &
input_nml_file, tile_num, blksz, &
ak, bk, restart, hydrostatic, &
communicator, ntasks, nthreads)
@@ -2990,6 +2984,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
integer, intent(in) :: jdat(8)
integer, intent(in) :: nwat
character(len=32), intent(in) :: tracer_names(:)
+ integer, intent(in) :: tracer_types(:)
character(len=256), intent(in), pointer :: input_nml_file(:)
integer, intent(in) :: blksz(:)
real(kind=kind_phys), dimension(:), intent(in) :: ak
@@ -3469,7 +3464,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
logical :: lndp_each_step = .false.
!--- aerosol scavenging factors
- character(len=20) :: fscav_aero(20) = 'default'
+ integer, parameter :: max_scav_factors = 25
+ character(len=40) :: fscav_aero(max_scav_factors)
!--- END NAMELIST VARIABLES
@@ -4337,59 +4333,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
Model%nqrimef = get_tracer_index(Model%tracer_names, 'q_rimef', Model%me, Model%master, Model%debug)
Model%ntwa = get_tracer_index(Model%tracer_names, 'liq_aero', Model%me, Model%master, Model%debug)
Model%ntia = get_tracer_index(Model%tracer_names, 'ice_aero', Model%me, Model%master, Model%debug)
- Model%ntchm = 0
- Model%ntchs = get_tracer_index(Model%tracer_names, 'so2', Model%me, Model%master, Model%debug)
- if (Model%ntchs > 0) then
- Model%ntchm = get_tracer_index(Model%tracer_names, 'pp10', Model%me, Model%master, Model%debug)
- if (Model%ntchm > 0) then
- Model%ntchm = Model%ntchm - Model%ntchs + 1
- allocate(Model%ntdiag(Model%ntchm))
- ! -- turn on all tracer diagnostics to .true. by default, except for so2
- Model%ntdiag(1) = .false.
- Model%ntdiag(2:) = .true.
- ! -- turn off diagnostics for DMS
- n = get_tracer_index(Model%tracer_names, 'DMS', Model%me, Model%master, Model%debug) - Model%ntchs + 1
- if (n > 0) Model%ntdiag(n) = .false.
- ! -- turn off diagnostics for msa
- n = get_tracer_index(Model%tracer_names, 'msa', Model%me, Model%master, Model%debug) - Model%ntchs + 1
- if (n > 0) Model%ntdiag(n) = .false.
- endif
- endif
- ! -- setup aerosol scavenging factors
- n = max(Model%ntrac, Model%ntchm)
- allocate(Model%fscav(n))
- Model%fscav = -9999.0
- if (Model%ntchm > 0) then
- ! -- initialize to default
- Model%fscav = 0.6_kind_phys
- n = get_tracer_index(Model%tracer_names, 'seas1', Model%me, Model%master, Model%debug) - Model%ntchs + 1
- if (n > 0) Model%fscav(n) = 1.0_kind_phys
- n = get_tracer_index(Model%tracer_names, 'seas2', Model%me, Model%master, Model%debug) - Model%ntchs + 1
- if (n > 0) Model%fscav(n) = 1.0_kind_phys
- n = get_tracer_index(Model%tracer_names, 'seas3', Model%me, Model%master, Model%debug) - Model%ntchs + 1
- if (n > 0) Model%fscav(n) = 1.0_kind_phys
- n = get_tracer_index(Model%tracer_names, 'seas4', Model%me, Model%master, Model%debug) - Model%ntchs + 1
- if (n > 0) Model%fscav(n) = 1.0_kind_phys
- n = get_tracer_index(Model%tracer_names, 'seas5', Model%me, Model%master, Model%debug) - Model%ntchs + 1
- if (n > 0) Model%fscav(n) = 1.0_kind_phys
- ! -- read factors from namelist
- do i = 1, size(fscav_aero)
- j = index(fscav_aero(i),":")
- if (j > 1) then
- read(fscav_aero(i)(j+1:), *, iostat=ios) tem
- if (ios /= 0) cycle
- if (adjustl(fscav_aero(i)(:j-1)) == "*") then
- Model%fscav = tem
- exit
- else
- n = get_tracer_index(Model%tracer_names, adjustl(fscav_aero(i)(:j-1)), Model%me, Model%master, Model%debug) &
- - Model%ntchs + 1
- if (n > 0) Model%fscav(n) = tem
- endif
- endif
- enddo
- endif
+!--- initialize parameters for atmospheric chemistry tracers
+ call Model%init_chemistry(tracer_types)
+
+!--- setup aerosol scavenging factors
+ call Model%init_scavenging(fscav_aero)
! To ensure that these values match what's in the physics,
! array sizes are compared during model init in GFS_phys_time_vary_init()
@@ -4964,6 +4913,103 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
end subroutine control_initialize
+!---------------------------
+! GFS_control%init_chemistry
+!---------------------------
+ subroutine control_chemistry_initialize(Model, tracer_types)
+
+ !--- Identify number and starting/ending indices of both
+ !--- prognostic and diagnostic chemistry tracers.
+ !--- Each tracer set is assumed to be contiguous.
+
+ use parse_tracers, only: NO_TRACER
+
+ !--- interface variables
+ class(GFS_control_type) :: Model
+ integer, intent(in) :: tracer_types(:)
+
+ !--- local variables
+ integer :: n
+
+ !--- begin
+ Model%ntchm = 0
+ Model%ntchs = NO_TRACER
+ Model%ntche = NO_TRACER
+ Model%ndchm = 0
+ Model%ndchs = NO_TRACER
+ Model%ndche = NO_TRACER
+
+ do n = 1, size(tracer_types)
+ select case (tracer_types(n))
+ case (1)
+ ! -- prognostic chemistry tracers
+ Model%ntchm = Model%ntchm + 1
+ if (Model%ntchm == 1) Model%ntchs = n
+ case (2)
+ ! -- diagnostic chemistry tracers
+ Model%ndchm = Model%ndchm + 1
+ if (Model%ndchm == 1) Model%ndchs = n
+ case default
+ ! -- generic tracers
+ end select
+ end do
+
+ if (Model%ntchm > 0) Model%ntche = Model%ntchs + Model%ntchm - 1
+ if (Model%ndchm > 0) Model%ndche = Model%ndchs + Model%ndchm - 1
+
+ end subroutine control_chemistry_initialize
+
+
+!----------------------------
+! GFS_control%init_scavenging
+!----------------------------
+ subroutine control_scavenging_initialize(Model, fscav)
+
+ use parse_tracers, only: get_tracer_index
+
+ !--- interface variables
+ class(GFS_control_type) :: Model
+ character(len=*), intent(in) :: fscav(:)
+
+ !--- local variables
+ integer :: i, ios, j, n
+ real(kind=kind_phys) :: tem
+
+ !--- begin
+ allocate(Model%fscav(Model%ntchm))
+
+ if (Model%ntchm > 0) then
+ !--- set default as no scavenging
+ Model%fscav = zero
+ ! -- read factors from namelist
+ ! -- set default first, if available
+ do i = 1, size(fscav)
+ j = index(fscav(i),":")
+ if (j > 1) then
+ read(fscav(i)(j+1:), *, iostat=ios) tem
+ if (ios /= 0) cycle
+ if (adjustl(fscav(i)(:j-1)) == "*") then
+ Model%fscav = tem
+ exit
+ endif
+ endif
+ enddo
+ ! -- then read factors for each tracer
+ do i = 1, size(fscav)
+ j = index(fscav(i),":")
+ if (j > 1) then
+ read(fscav(i)(j+1:), *, iostat=ios) tem
+ if (ios /= 0) cycle
+ n = get_tracer_index(Model%tracer_names, adjustl(fscav(i)(:j-1)), Model%me, Model%master, Model%debug) &
+ - Model%ntchs + 1
+ if (n > 0) Model%fscav(n) = tem
+ endif
+ enddo
+ endif
+
+ end subroutine control_scavenging_initialize
+
+
!------------------
! GFS_control%print
!------------------
@@ -5361,6 +5407,10 @@ subroutine control_print(Model)
print *, ' ntia : ', Model%ntia
print *, ' ntchm : ', Model%ntchm
print *, ' ntchs : ', Model%ntchs
+ print *, ' ntche : ', Model%ntche
+ print *, ' ndchm : ', Model%ndchm
+ print *, ' ndchs : ', Model%ndchs
+ print *, ' ndche : ', Model%ndche
print *, ' fscav : ', Model%fscav
print *, ' '
print *, 'derived totals for phy_f*d'
@@ -5988,9 +6038,6 @@ subroutine diag_create (Diag, IM, Model)
Diag%aux3d = clear_val
endif
- !--- diagnostics for coupled chemistry
- if (Model%cplchm) call Diag%chem_init(IM,Model)
-
call Diag%rad_zero (Model)
! if(Model%me==0) print *,'in diag_create, call rad_zero'
linit = .true.
@@ -6254,103 +6301,6 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center)
end subroutine diag_phys_zero
-!-----------------------
-! GFS_diag%chem_init
-!-----------------------
- subroutine diag_chem_init(Diag, IM, Model)
-
- use parse_tracers, only: get_tracer_index, NO_TRACER
-
- class(GFS_diag_type) :: Diag
- integer, intent(in) :: IM
- type(GFS_control_type), intent(in) :: Model
-
- ! -- local variables
- integer :: n
-
- ! -- initialize diagnostic variables depending on
- ! -- specific chemical tracers
- if (Model%ntchm > 0) then
- ! -- retrieve number of dust bins
- n = get_number_bins('dust')
- Diag%ndust = n
- if (n > 0) then
- allocate (Diag%duem(IM,n))
- Diag%duem = zero
- end if
-
- ! -- retrieve number of sea salt bins
- n = get_number_bins('seas')
- Diag%nseasalt = n
- if (n > 0) then
- allocate (Diag%ssem(IM,n))
- Diag%ssem = zero
- end if
- end if
-
- ! -- sedimentation and dry/wet deposition diagnostics
- if (associated(Model%ntdiag)) then
- ! -- get number of tracers with enabled diagnostics
- n = count(Model%ntdiag)
- Diag%ntchmdiag = n
-
- ! -- initialize sedimentation
- allocate (Diag%sedim(IM,n))
- Diag%sedim = zero
-
- ! -- initialize dry deposition
- allocate (Diag%drydep(IM,n))
- Diag%drydep = zero
-
- ! -- initialize large-scale wet deposition
- allocate (Diag%wetdpl(IM,n))
- Diag%wetdpl = zero
-
- ! -- initialize convective-scale wet deposition
- allocate (Diag%wetdpc(IM,n))
- Diag%wetdpc = zero
- end if
-
- ! -- initialize anthropogenic and biomass
- ! -- burning emission diagnostics for
- ! -- (in order): black carbon,
- ! -- organic carbon, and sulfur dioxide
- allocate (Diag%abem(IM,6))
- Diag%abem = zero
-
- ! -- initialize column burden diagnostics
- ! -- for aerosol species (in order): pm2.5
- ! -- black carbon, organic carbon, sulfate,
- ! -- dust, sea salt
- allocate (Diag%aecm(IM,6))
- Diag%aecm = zero
-
- contains
-
- integer function get_number_bins(tracer_type)
- character(len=*), intent(in) :: tracer_type
-
- logical :: next
- integer :: n
- character(len=5) :: name
-
- get_number_bins = 0
-
- n = 0
- next = .true.
- do while (next)
- n = n + 1
- write(name,'(a,i1)') tracer_type, n + 1
- next = get_tracer_index(Model%tracer_names, name, &
- Model%me, Model%master, Model%debug) /= NO_TRACER
- end do
-
- get_number_bins = n
-
- end function get_number_bins
-
- end subroutine diag_chem_init
-
!-------------------------
! GFS_interstitial_type%create
!-------------------------
diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta
index 5e73ea1ec..753e9eb41 100644
--- a/ccpp/data/GFS_typedefs.meta
+++ b/ccpp/data/GFS_typedefs.meta
@@ -2277,14 +2277,6 @@
type = real
kind = kind_phys
active = (index_for_stochastic_land_surface_perturbation_type .ne. 0)
-[dqdti]
- standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection
- long_name = instantaneous moisture tendency due to convection
- units = kg kg-1 s-1
- dimensions = (horizontal_loop_extent,vertical_dimension)
- type = real
- kind = kind_phys
- active = (flag_for_chemistry_coupling)
[nwfa2d]
standard_name = tendency_of_water_friendly_aerosols_at_surface
long_name = instantaneous water-friendly sfc aerosol source
@@ -2309,14 +2301,6 @@
type = real
kind = kind_phys
active = (flag_for_chemistry_coupling)
-[dkt]
- standard_name = instantaneous_atmosphere_heat_diffusivity
- long_name = instantaneous atmospheric heat diffusivity
- units = m2 s-1
- dimensions = (horizontal_loop_extent,vertical_dimension)
- type = real
- kind = kind_phys
- active = (flag_for_chemistry_coupling)
[qci_conv]
standard_name = convective_cloud_condesate_after_rainout
long_name = convective cloud condesate after rainout
@@ -2325,6 +2309,22 @@
type = real
kind = kind_phys
active = (flag_for_mass_flux_deep_convection_scheme == flag_for_gf_deep_convection_scheme)
+[pfi_lsan]
+ standard_name = ice_flux_due_to_large_scale_precipitation
+ long_name = instantaneous 3D flux of ice from nonconvective precipitation
+ units = kg m-2 s-1
+ dimensions = (horizontal_loop_extent,vertical_dimension)
+ type = real
+ kind = kind_phys
+ active = (flag_for_chemistry_coupling)
+[pfl_lsan]
+ standard_name = liquid_flux_due_to_large_scale_precipitation
+ long_name = instantaneous 3D flux of liquid water from nonconvective precipitation
+ units = kg m-2 s-1
+ dimensions = (horizontal_loop_extent,vertical_dimension)
+ type = real
+ kind = kind_phys
+ active = (flag_for_chemistry_coupling)
########################################################################
[ccpp-table-properties]
name = GFS_control_type
@@ -4560,6 +4560,30 @@
units = index
dimensions = ()
type = integer
+[ntche]
+ standard_name = index_for_last_chemical_tracer
+ long_name = tracer index for last chemical tracer
+ units = index
+ dimensions = ()
+ type = integer
+[ndchm]
+ standard_name = number_of_diagnostic_chemical_tracers
+ long_name = number of diagnostic chemical tracers
+ units = count
+ dimensions = ()
+ type = integer
+[ndchs]
+ standard_name = index_for_first_diagnostic_chemical_tracer
+ long_name = tracer index for first diagnostic chemical tracer
+ units = index
+ dimensions = ()
+ type = integer
+[ndche]
+ standard_name = index_for_last_diagnostic_chemical_tracer
+ long_name = tracer index for last diagnostic chemical tracer
+ units = index
+ dimensions = ()
+ type = integer
[ntdiag]
standard_name = diagnostics_control_for_chemical_tracers
long_name = array to control diagnostics for chemical tracers
@@ -7058,86 +7082,6 @@
dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation)
type = real
kind = kind_phys
-[ndust]
- standard_name = number_of_dust_bins_for_diagnostics
- long_name = number of dust bins for diagnostics
- units = count
- dimensions = ()
- type = integer
-[nseasalt]
- standard_name = number_of_seasalt_bins_for_diagnostics
- long_name = number of seasalt bins for diagnostics
- units = count
- dimensions = ()
- type = integer
-[ntchmdiag]
- standard_name = number_of_chemical_tracers_for_diagnostics
- long_name = number of chemical tracers for diagnostic output
- units = count
- dimensions = ()
- type = integer
-[duem]
- standard_name = instantaneous_dust_emission_flux
- long_name = instantaneous dust emission flux
- units = kg m-2 s-1
- dimensions = (horizonal_dimension,number_of_dust_bins_for_diagnostics)
- type = real
- kind = kind_phys
- active = (number_of_dust_bins_for_diagnostics > 0)
-[ssem]
- standard_name = instantaneous_seasalt_emission_flux
- long_name = instantaneous sea salt emission flux
- units = kg m-2 s-1
- dimensions = (horizonal_dimension,number_of_seasalt_bins_for_diagnostics)
- type = real
- kind = kind_phys
- active = (number_of_seasalt_bins_for_diagnostics > 0)
-[sedim]
- standard_name = instantaneous_sedimentation
- long_name = instantaneous sedimentation
- units = kg m-2 s-1
- dimensions = (horizonal_dimension,number_of_chemical_tracers_for_diagnostics)
- type = real
- kind = kind_phys
- active = (number_of_chemical_tracers_for_diagnostics > 0)
-[drydep]
- standard_name = instantaneous_dry_deposition
- long_name = instantaneous dry deposition
- units = kg m-2 s-1
- dimensions = (horizonal_dimension,number_of_chemical_tracers_for_diagnostics)
- type = real
- kind = kind_phys
- active = (number_of_chemical_tracers_for_diagnostics > 0)
-[wetdpl]
- standard_name = instantaneous_large_scale_wet_deposition
- long_name = instantaneous large-scale wet deposition
- units = kg m-2 s-1
- dimensions = (horizonal_dimension,number_of_chemical_tracers_for_diagnostics)
- type = real
- kind = kind_phys
- active = (number_of_chemical_tracers_for_diagnostics > 0)
-[wetdpc]
- standard_name = instantaneous_convective_scale_wet_deposition
- long_name = instantaneous convective-scale wet deposition
- units = kg m-2 s-1
- dimensions = (horizonal_dimension,number_of_chemical_tracers_for_diagnostics)
- type = real
- kind = kind_phys
- active = (number_of_chemical_tracers_for_diagnostics > 0)
-[abem]
- standard_name = instantaneous_anthopogenic_and_biomass_burning_emissions
- long_name = instantaneous anthopogenic and biomass burning emissions for black carbon, organic carbon, and sulfur dioxide
- units = ug m-2 s-1
- dimensions = (horizontal_loop_extent,6)
- type = real
- kind = kind_phys
-[aecm]
- standard_name = instantaneous_aerosol_column_mass_densities
- long_name = instantaneous aerosol column mass densities for pm2.5, black carbon, organic carbon, sulfate, dust, sea salt
- units = g m-2
- dimensions = (horizontal_loop_extent,6)
- type = real
- kind = kind_phys
[edmf_a]
standard_name = emdf_updraft_area
long_name = updraft area from mass flux scheme
diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90
index 7790e61e8..619191c10 100644
--- a/ccpp/driver/GFS_diagnostics.F90
+++ b/ccpp/driver/GFS_diagnostics.F90
@@ -3944,161 +3944,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
! print *,'in gfdl_diag_register,af all extdiag, idx=',idx
-! -- chemistry diagnostic variables
- if (Model%cplchm) then
-
- if (Model%ntchm > 0) then
-
- if (associated(IntDiag(1)%duem)) then
- do num = 1, size(IntDiag(1)%duem, dim=2)
- idx = idx + 1
- ExtDiag(idx)%axes = 2
- write(ExtDiag(idx)%name,'("duem",i3.3)') num
- write(ExtDiag(idx)%desc,'("Dust Emission Bin ",i0)') num
- ExtDiag(idx)%unit = 'kg/m2/s'
- ExtDiag(idx)%mod_name = 'gfs_phys'
- allocate (ExtDiag(idx)%data(nblks))
- do nb = 1,nblks
- ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%duem(:,num)
- enddo
- enddo
- endif
-
- if (associated(IntDiag(1)%ssem)) then
- do num = 1, size(IntDiag(1)%ssem, dim=2)
- idx = idx + 1
- ExtDiag(idx)%axes = 2
- write(ExtDiag(idx)%name,'("ssem",i3.3)') num
- write(ExtDiag(idx)%desc,'("Seasalt Emission Bin ",i0)') num
- ExtDiag(idx)%unit = 'kg/m2/s'
- ExtDiag(idx)%mod_name = 'gfs_phys'
- allocate (ExtDiag(idx)%data(nblks))
- do nb = 1,nblks
- ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ssem(:,num)
- enddo
- enddo
- endif
-
- if (associated(Model%ntdiag)) then
- idt = 0
- do num = Model%ntchs, Model%ntchm + Model%ntchs - 1
- if (Model%ntdiag(num-Model%ntchs+1)) then
- idt = idt + 1
- idx = idx + 1
- ExtDiag(idx)%axes = 2
- ExtDiag(idx)%name = trim(Model%tracer_names(num)) // 'sd'
- ExtDiag(idx)%desc = trim(Model%tracer_names(num)) // ' Sedimentation'
- ExtDiag(idx)%unit = 'kg/m2/s'
- ExtDiag(idx)%mod_name = 'gfs_phys'
- allocate (ExtDiag(idx)%data(nblks))
- do nb = 1,nblks
- ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%sedim(:,idt)
- enddo
-
- idx = idx + 1
- ExtDiag(idx)%axes = 2
- ExtDiag(idx)%name = trim(Model%tracer_names(num)) // 'dp'
- ExtDiag(idx)%desc = trim(Model%tracer_names(num)) // ' Dry Deposition'
- ExtDiag(idx)%unit = 'kg/m2/s'
- ExtDiag(idx)%mod_name = 'gfs_phys'
- allocate (ExtDiag(idx)%data(nblks))
- do nb = 1,nblks
- ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%drydep(:,idt)
- enddo
-
- idx = idx + 1
- ExtDiag(idx)%axes = 2
- ExtDiag(idx)%name = trim(Model%tracer_names(num)) // 'wtl'
- ExtDiag(idx)%desc = trim(Model%tracer_names(num)) // ' Large-Scale Wet Deposition'
- ExtDiag(idx)%unit = 'kg/m2/s'
- ExtDiag(idx)%mod_name = 'gfs_phys'
- allocate (ExtDiag(idx)%data(nblks))
- do nb = 1,nblks
- ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%wetdpl(:,idt)
- enddo
-
- idx = idx + 1
- ExtDiag(idx)%axes = 2
- ExtDiag(idx)%name = trim(Model%tracer_names(num)) // 'wtc'
- ExtDiag(idx)%desc = trim(Model%tracer_names(num)) // ' Convective-Scale Wet Deposition'
- ExtDiag(idx)%unit = 'kg/m2/s'
- ExtDiag(idx)%mod_name = 'gfs_phys'
- allocate (ExtDiag(idx)%data(nblks))
- do nb = 1,nblks
- ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%wetdpc(:,idt)
- enddo
- endif
- enddo
- endif
-
- endif
-
- num = size(IntDiag(1)%abem, dim=2)
- do num = 1, size(IntDiag(1)%abem, dim=2)
- idx = idx + 1
- select case (mod(num,3))
- case (0)
- ExtDiag(idx)%name = 'bcem'
- ExtDiag(idx)%desc = 'Black Carbon'
- case (1)
- ExtDiag(idx)%name = 'ocem'
- ExtDiag(idx)%desc = 'Organic Carbon'
- case (2)
- ExtDiag(idx)%name = 'so2em'
- ExtDiag(idx)%desc = 'SO2'
- end select
-
- if (num > 3) then
- ExtDiag(idx)%name = trim(ExtDiag(idx)%name) // 'bb'
- ExtDiag(idx)%desc = trim(ExtDiag(idx)%desc) // ' Biomass Burning Emissions'
- else
- ExtDiag(idx)%name = trim(ExtDiag(idx)%name) // 'an'
- ExtDiag(idx)%desc = trim(ExtDiag(idx)%desc) // ' Anthropogenic Emissions'
- end if
-
- ExtDiag(idx)%axes = 2
- ExtDiag(idx)%unit = 'ug/m2/s'
- ExtDiag(idx)%mod_name = 'gfs_phys'
- allocate (ExtDiag(idx)%data(nblks))
- do nb = 1,nblks
- ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%abem(:,num)
- enddo
- end do
-
- do num = 1, size(IntDiag(1)%aecm, dim=2)
- idx = idx + 1
- select case (num)
- case(1)
- ExtDiag(idx)%name = 'aecmass'
- ExtDiag(idx)%desc = 'Aerosol Column Mass Density (PM2.5)'
- case(2)
- ExtDiag(idx)%name = 'bccmass'
- ExtDiag(idx)%desc = 'Black Carbon Column Mass Density'
- case(3)
- ExtDiag(idx)%name = 'occmass'
- ExtDiag(idx)%desc = 'Organic Carbon Column Mass Density'
- case(4)
- ExtDiag(idx)%name = 'sucmass'
- ExtDiag(idx)%desc = 'Sulfate Column Mass Density'
- case(5)
- ExtDiag(idx)%name = 'ducmass'
- ExtDiag(idx)%desc = 'Dust Column Mass Density'
- case(6)
- ExtDiag(idx)%name = 'sscmass'
- ExtDiag(idx)%desc = 'Seasalt Column Mass Density'
- end select
-
- ExtDiag(idx)%axes = 2
- ExtDiag(idx)%unit = 'g/m2'
- ExtDiag(idx)%mod_name = 'gfs_phys'
- allocate (ExtDiag(idx)%data(nblks))
- do nb = 1,nblks
- ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%aecm(:,num)
- enddo
- end do
-
- endif
-
!--- prognostic variable tendencies (t, u, v, sph, clwmr, o3)
!rab idx = idx + 1
!rab ExtDiag(idx)%axes = 3
diff --git a/ccpp/driver/GFS_init.F90 b/ccpp/driver/GFS_init.F90
index 077474fa7..6ea83e6e3 100644
--- a/ccpp/driver/GFS_init.F90
+++ b/ccpp/driver/GFS_init.F90
@@ -77,6 +77,7 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, &
Init_parm%iau_offset, Init_parm%bdat, &
Init_parm%cdat, Init_parm%nwat, &
Init_parm%tracer_names, &
+ Init_parm%tracer_types, &
Init_parm%input_nml_file, Init_parm%tile_num, &
Init_parm%blksz, Init_parm%ak, Init_parm%bk, &
Init_parm%restart, Init_parm%hydrostatic, &
diff --git a/ccpp/physics b/ccpp/physics
index f6b19b587..f8e883632 160000
--- a/ccpp/physics
+++ b/ccpp/physics
@@ -1 +1 @@
-Subproject commit f6b19b587850b7f2f1af93a4819b5342ac09c015
+Subproject commit f8e883632dcdd3c1aaec8b90adb72b3f6aff4b9d
diff --git a/cpl/module_block_data.F90 b/cpl/module_block_data.F90
new file mode 100644
index 000000000..f2f6fd4e8
--- /dev/null
+++ b/cpl/module_block_data.F90
@@ -0,0 +1,568 @@
+module module_block_data
+
+ use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, &
+ ESMF_RC_PTR_NOTALLOC, ESMF_RC_VAL_OUTOFRANGE
+ use GFS_typedefs, only: kind_phys
+ use block_control_mod, only: block_control_type
+
+ implicit none
+
+ interface block_data_copy
+ module procedure block_copy_1d_to_2d_r8
+ module procedure block_copy_2d_to_2d_r8
+ module procedure block_copy_2d_to_3d_r8
+ module procedure block_copy_3d_to_3d_r8
+ module procedure block_copy_1dslice_to_2d_r8
+ module procedure block_copy_3dslice_to_3d_r8
+ end interface block_data_copy
+
+ interface block_data_fill
+ module procedure block_fill_2d_r8
+ module procedure block_fill_3d_r8
+ end interface block_data_fill
+
+ interface block_data_copy_or_fill
+ module procedure block_copy_or_fill_1d_to_2d_r8
+ module procedure block_copy_or_fill_2d_to_3d_r8
+ module procedure block_copy_or_fill_1dslice_to_2d_r8
+ end interface block_data_copy_or_fill
+
+ interface block_data_combine_fractions
+ module procedure block_combine_frac_1d_to_2d_r8
+ end interface block_data_combine_fractions
+
+ interface block_atmos_copy
+ module procedure block_array_copy_2d_to_2d_r8
+ module procedure block_array_copy_3d_to_3d_r8
+ module procedure block_array_copy_3dslice_to_3d_r8
+ end interface block_atmos_copy
+
+ private
+
+ public :: block_atmos_copy
+
+ public :: block_data_copy
+ public :: block_data_fill
+ public :: block_data_copy_or_fill
+ public :: block_data_combine_fractions
+
+contains
+
+ ! -- copy: 1D to 2D
+
+ subroutine block_copy_1d_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:)
+ real(kind_phys), pointer :: source_ptr(:)
+ type(block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ real(kind_phys), optional, intent(in) :: scale_factor
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb
+ real(kind_phys) :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr) .and. associated(source_ptr)) then
+ factor = 1._kind_phys
+ if (present(scale_factor)) factor = scale_factor
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j) = factor * source_ptr(ix)
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_copy_1d_to_2d_r8
+
+ ! -- copy: 1D slice to 2D
+
+ subroutine block_copy_1dslice_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:)
+ real(kind_phys), pointer :: source_ptr(:,:)
+ integer, intent(in) :: slice
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ real(kind_phys), optional, intent(in) :: scale_factor
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb
+ real(kind_phys) :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr) .and. associated(source_ptr)) then
+ localrc = ESMF_RC_VAL_OUTOFRANGE
+ if (slice > 0 .and. slice <= size(source_ptr, dim=2)) then
+ factor = 1._kind_phys
+ if (present(scale_factor)) factor = scale_factor
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j) = factor * source_ptr(ix,slice)
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_copy_1dslice_to_2d_r8
+
+ ! -- copy: 2D to 3D
+
+ subroutine block_copy_2d_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:)
+ real(kind_phys), pointer :: source_ptr(:,:)
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ real(kind_phys), optional, intent(in) :: scale_factor
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb, k
+ real(kind_phys) :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr) .and. associated(source_ptr)) then
+ factor = 1._kind_phys
+ if (present(scale_factor)) factor = scale_factor
+ do k = 1, size(source_ptr, dim=2)
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j,k) = factor * source_ptr(ix,k)
+ enddo
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_copy_2d_to_3d_r8
+
+ ! -- copy: 2D to 2D
+
+ subroutine block_copy_2d_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:)
+ real(kind_phys), pointer :: source_ptr(:,:)
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ real(kind_phys), optional, intent(in) :: scale_factor
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb
+ real(kind_phys) :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr) .and. associated(source_ptr)) then
+ factor = 1._kind_phys
+ if (present(scale_factor)) factor = scale_factor
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j) = factor * source_ptr(ib,jb)
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_copy_2d_to_2d_r8
+
+ subroutine block_array_copy_2d_to_2d_r8(destin_ptr, source_arr, block, block_index, scale_factor, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:)
+ real, intent(in) :: source_arr(:,:)
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ real, optional, intent(in) :: scale_factor
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb
+ real :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr)) then
+ factor = 1._kind_phys
+ if (present(scale_factor)) factor = scale_factor
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j) = factor * source_arr(ib,jb)
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_array_copy_2d_to_2d_r8
+
+ ! -- copy: 3D to 3D
+
+ subroutine block_copy_3d_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:)
+ real(kind_phys), pointer :: source_ptr(:,:,:)
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ real(kind_phys), optional, intent(in) :: scale_factor
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb, k
+ real(kind_phys) :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr) .and. associated(source_ptr)) then
+ factor = 1._kind_phys
+ if (present(scale_factor)) factor = scale_factor
+ do k = 1, size(source_ptr, dim=3)
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j,k) = factor * source_ptr(ib,jb,k)
+ enddo
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_copy_3d_to_3d_r8
+
+ subroutine block_array_copy_3d_to_3d_r8(destin_ptr, source_arr, block, block_index, scale_factor, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:)
+ real, intent(in) :: source_arr(:,:,:)
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ real, optional, intent(in) :: scale_factor
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb, k
+ real :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr)) then
+ factor = 1._kind_phys
+ if (present(scale_factor)) factor = scale_factor
+ do k = 1, size(source_arr, dim=3)
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j,k) = factor * source_arr(ib,jb,k)
+ enddo
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_array_copy_3d_to_3d_r8
+
+ ! -- copy: 3D slice to 3D
+
+ subroutine block_copy_3dslice_to_3d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:)
+ real(kind_phys), pointer :: source_ptr(:,:,:,:)
+ integer, intent(in) :: slice
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ real(kind_phys), optional, intent(in) :: scale_factor
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb, k
+ real(kind_phys) :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr) .and. associated(source_ptr)) then
+ localrc = ESMF_RC_VAL_OUTOFRANGE
+ if (slice > 0 .and. slice <= size(source_ptr, dim=4)) then
+ factor = 1._kind_phys
+ if (present(scale_factor)) factor = scale_factor
+ do k = 1, size(source_ptr, dim=3)
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j,k) = factor * source_ptr(ib,jb,k,slice)
+ enddo
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_copy_3dslice_to_3d_r8
+
+ subroutine block_array_copy_3dslice_to_3d_r8(destin_ptr, source_arr, slice, block, block_index, scale_factor, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:)
+ real, intent(in) :: source_arr(:,:,:,:)
+ integer, intent(in) :: slice
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ real, optional, intent(in) :: scale_factor
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb, k
+ real :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr)) then
+ localrc = ESMF_RC_VAL_OUTOFRANGE
+ if (slice > 0 .and. slice <= size(source_arr, dim=4)) then
+ factor = 1._kind_phys
+ if (present(scale_factor)) factor = scale_factor
+ do k = 1, size(source_arr, dim=3)
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j,k) = factor * source_arr(ib,jb,k,slice)
+ enddo
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_array_copy_3dslice_to_3d_r8
+
+ ! -- fill: 2D
+
+ subroutine block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:)
+ real(ESMF_KIND_R8), intent(in) :: fill_value
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr)) then
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j) = fill_value
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_fill_2d_r8
+
+ ! -- fill: 3D
+
+ subroutine block_fill_3d_r8(destin_ptr, fill_value, block, block_index, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:)
+ real(ESMF_KIND_R8), intent(in) :: fill_value
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb, k
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr)) then
+ do k = 1, size(destin_ptr, dim=3)
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j,k) = fill_value
+ enddo
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_fill_3d_r8
+
+ ! -- copy/fill: 1D to 2D
+
+ subroutine block_copy_or_fill_1d_to_2d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:)
+ real(kind_phys), pointer :: source_ptr(:)
+ real(ESMF_KIND_R8), intent(in) :: fill_value
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ integer, optional, intent(out) :: rc
+
+ ! -- begin
+ if (present(rc)) rc = ESMF_RC_PTR_NOTALLOC
+
+ if (associated(destin_ptr)) then
+ if (associated(source_ptr)) then
+ call block_copy_1d_to_2d_r8(destin_ptr, source_ptr, block, block_index, rc=rc)
+ else
+ call block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc=rc)
+ end if
+ end if
+
+ end subroutine block_copy_or_fill_1d_to_2d_r8
+
+ ! -- copy/fill: 1D slice to 2D
+
+ subroutine block_copy_or_fill_1dslice_to_2d_r8(destin_ptr, source_ptr, slice, fill_value, block, block_index, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:)
+ real(kind_phys), pointer :: source_ptr(:,:)
+ integer, intent(in) :: slice
+ real(ESMF_KIND_R8), intent(in) :: fill_value
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ integer, optional, intent(out) :: rc
+
+ ! -- begin
+ if (present(rc)) rc = ESMF_RC_PTR_NOTALLOC
+
+ if (associated(destin_ptr)) then
+ if (associated(source_ptr)) then
+ call block_copy_1dslice_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, rc=rc)
+ else
+ call block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc=rc)
+ end if
+ end if
+
+ end subroutine block_copy_or_fill_1dslice_to_2d_r8
+
+ ! -- copy/fill: 2D to 3D
+
+ subroutine block_copy_or_fill_2d_to_3d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:)
+ real(kind_phys), pointer :: source_ptr(:,:)
+ real(ESMF_KIND_R8), intent(in) :: fill_value
+ type (block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ integer, optional, intent(out) :: rc
+
+ ! -- begin
+ if (present(rc)) rc = ESMF_RC_PTR_NOTALLOC
+
+ if (associated(destin_ptr)) then
+ if (associated(source_ptr)) then
+ call block_copy_2d_to_3d_r8(destin_ptr, source_ptr, block, block_index, rc=rc)
+ else
+ call block_fill_3d_r8(destin_ptr, fill_value, block, block_index, rc=rc)
+ end if
+ end if
+
+ end subroutine block_copy_or_fill_2d_to_3d_r8
+
+ ! -- combine: 1D to 2D
+
+ subroutine block_combine_frac_1d_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, block, block_index, rc)
+
+ ! -- arguments
+ real(ESMF_KIND_R8), pointer :: destin_ptr(:,:)
+ real(kind_phys), pointer :: fract1_ptr(:)
+ real(kind_phys), pointer :: fract2_ptr(:)
+ type(block_control_type), intent(in) :: block
+ integer, intent(in) :: block_index
+ integer, optional, intent(out) :: rc
+
+ ! -- local variables
+ integer :: localrc
+ integer :: i, ib, ix, j, jb
+ real(kind_phys) :: factor
+
+ ! -- begin
+ localrc = ESMF_RC_PTR_NOTALLOC
+ if (associated(destin_ptr) .and. &
+ associated(fract1_ptr) .and. associated(fract2_ptr)) then
+ do ix = 1, block%blksz(block_index)
+ ib = block%index(block_index)%ii(ix)
+ jb = block%index(block_index)%jj(ix)
+ i = ib - block%isc + 1
+ j = jb - block%jsc + 1
+ destin_ptr(i,j) = fract1_ptr(ix) * (1._kind_phys - fract2_ptr(ix))
+ enddo
+ localrc = ESMF_SUCCESS
+ end if
+
+ if (present(rc)) rc = localrc
+
+ end subroutine block_combine_frac_1d_to_2d_r8
+
+end module module_block_data
diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90
index 3f7026ede..f74ae1a9c 100644
--- a/cpl/module_cap_cpl.F90
+++ b/cpl/module_cap_cpl.F90
@@ -52,6 +52,43 @@ subroutine clock_cplIntval(gcomp, CF)
end subroutine clock_cplIntval
!-----------------------------------------------------------------------------
+
+ subroutine addFieldMetadata(field, key, values, rc)
+
+ ! This subroutine implements a preliminary method to provide metadata to
+ ! a coupled model that is accessing the field via reference sharing
+ ! (NUOPC SharedStatusField=.true.). The method sets a (key, values) pair
+ ! in the field's array ESMF_Info object to retrieve an array of strings
+ ! encoding metadata.
+ !
+ ! Such a capability should be implemented in the standard NUOPC connector
+ ! for more general applications, possibly providing access to the field's
+ ! ESMF_Info object.
+
+ type(ESMF_Field) :: field
+ character(len=*), intent(in) :: key
+ character(len=*), intent(in) :: values(:)
+ integer, optional, intent(out) :: rc
+
+ ! local variable
+ integer :: localrc
+ type(ESMF_Array) :: array
+ type(ESMF_Info) :: info
+
+ ! begin
+ if (present(rc)) rc = ESMF_SUCCESS
+
+ call ESMF_FieldGet(field, array=array, rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+ call ESMF_InfoGetFromHost(array, info, rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+ call ESMF_InfoSet(info, key, values, rc=localrc)
+ if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
+
+ end subroutine addFieldMetadata
+
+ !-----------------------------------------------------------------------------
+
#if 0
subroutine realizeConnectedInternCplField(state, field, standardName, grid, rc)
@@ -100,36 +137,45 @@ end subroutine realizeConnectedInternCplField
#endif
!-----------------------------------------------------------------------------
- subroutine realizeConnectedCplFields(state, grid, &
- numLevels, numSoilLayers, numTracers, &
- num_diag_sfc_emis_flux, num_diag_down_flux, &
- num_diag_type_down_flux, num_diag_burn_emis_flux, &
- num_diag_cmass, fields_info, state_tag, &
- fieldList, rc)
+ subroutine realizeConnectedCplFields(state, grid, &
+ numLevels, numSoilLayers, numTracers, &
+ fields_info, state_tag, fieldList, rc)
+
+ use field_manager_mod, only: MODEL_ATMOS
+ use tracer_manager_mod, only: get_number_tracers, get_tracer_names
type(ESMF_State), intent(inout) :: state
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: numLevels
integer, intent(in) :: numSoilLayers
integer, intent(in) :: numTracers
- integer, intent(in) :: num_diag_sfc_emis_flux
- integer, intent(in) :: num_diag_down_flux
- integer, intent(in) :: num_diag_type_down_flux
- integer, intent(in) :: num_diag_burn_emis_flux
- integer, intent(in) :: num_diag_cmass
type(FieldInfo), dimension(:), intent(in) :: fields_info
character(len=*), intent(in) :: state_tag !< Import or export.
type(ESMF_Field), dimension(:), intent(out) :: fieldList
integer, intent(out) :: rc
! local variables
- integer :: item
+ integer :: item, pos, tracerCount
logical :: isConnected
type(ESMF_Field) :: field
+ type(ESMF_StateIntent_Flag) :: stateintent
+ character(len=32), allocatable, dimension(:) :: tracerNames, tracerUnits
! begin
rc = ESMF_SUCCESS
+ ! attach list of tracer names to exported tracer field as metadata
+ call ESMF_StateGet(state, stateintent=stateintent, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+
+ if (stateintent == ESMF_STATEINTENT_EXPORT) then
+ call get_number_tracers(MODEL_ATMOS, num_tracers=tracerCount)
+ allocate(tracerNames(tracerCount), tracerUnits(tracerCount))
+ do item = 1, tracerCount
+ call get_tracer_names(MODEL_ATMOS, item, tracerNames(item), units=tracerUnits(item))
+ end do
+ end if
+
do item = 1, size(fields_info)
isConnected = NUOPC_IsConnected(state, fieldName=trim(fields_info(item)%name), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
@@ -151,23 +197,14 @@ subroutine realizeConnectedCplFields(state, grid,
call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1, 1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
- case ('u','tracer_up_flux')
- call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, &
- ungriddedLBound=(/1/), ungriddedUBound=(/num_diag_sfc_emis_flux/), rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
- case ('d','tracer_down_flx')
- call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, &
- ungriddedLBound=(/1, 1/), &
- ungriddedUBound=(/num_diag_down_flux, num_diag_type_down_flux/), rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
- case ('b','tracer_anth_biom_emission')
- call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, &
- ungriddedLBound=(/1/), ungriddedUBound=(/num_diag_burn_emis_flux/), rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
- case ('c','tracer_column_mass_density')
- call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, &
- ungriddedLBound=(/1/), ungriddedUBound=(/num_diag_cmass/), rc=rc)
- if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+ if (allocated(tracerNames)) then
+ call addFieldMetadata(field, 'tracerNames', tracerNames, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+ end if
+ if (allocated(tracerUnits)) then
+ call addFieldMetadata(field, 'tracerUnits', tracerUnits, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+ end if
case ('s','surface')
call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
@@ -201,6 +238,9 @@ subroutine realizeConnectedCplFields(state, grid,
end if
end do
+ if (allocated(tracerNames)) deallocate(tracerNames)
+ if (allocated(tracerUnits)) deallocate(tracerUnits)
+
end subroutine realizeConnectedCplFields
!-----------------------------------------------------------------------------
diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90
index c284252d2..4a9abc6c1 100644
--- a/cpl/module_cplfields.F90
+++ b/cpl/module_cplfields.F90
@@ -17,7 +17,15 @@ module module_cplfields
end type
! Export Fields ----------------------------------------
- integer, public, parameter :: NexportFields = 97
+
+ ! Please specify fields as: FieldInfo("standard_name", "type")
+ ! Field types should be provided according to the table below:
+ ! g : soil levels (3D)
+ ! i : interface (3D)
+ ! l : model levels (3D)
+ ! s : surface (2D)
+ ! t : tracers (4D)
+ integer, public, parameter :: NexportFields = 105
type(ESMF_Field), target, public :: exportFields(NexportFields)
type(FieldInfo), dimension(NexportFields), public, parameter :: exportFieldsInfo = [ &
@@ -36,9 +44,13 @@ module module_cplfields
FieldInfo("inst_convective_rainfall_amount ", "s"), &
FieldInfo("inst_exchange_coefficient_heat_levels ", "l"), &
FieldInfo("inst_spec_humid_conv_tendency_levels ", "l"), &
+ FieldInfo("inst_ice_nonconv_tendency_levels ", "l"), &
+ FieldInfo("inst_liq_nonconv_tendency_levels ", "l"), &
+ FieldInfo("inst_cloud_frac_levels ", "l"), &
FieldInfo("inst_friction_velocity ", "s"), &
FieldInfo("inst_rainfall_amount ", "s"), &
FieldInfo("inst_soil_moisture_content ", "g"), &
+ FieldInfo("inst_surface_soil_wetness ", "s"), &
FieldInfo("inst_up_sensi_heat_flx ", "s"), &
FieldInfo("inst_lwe_snow_thickness ", "s"), &
FieldInfo("vegetation_type ", "s"), &
@@ -93,6 +105,11 @@ module module_cplfields
FieldInfo("inst_height_lowest ", "s"), &
FieldInfo("mean_fprec_rate ", "s"), &
FieldInfo("openwater_frac_in_atm ", "s"), &
+ FieldInfo("ice_fraction_in_atm ", "s"), &
+ FieldInfo("lake_fraction ", "s"), &
+ FieldInfo("ocean_fraction ", "s"), &
+ FieldInfo("surface_snow_area_fraction ", "s"), &
+
! For JEDI
! dynamics
@@ -124,7 +141,7 @@ module module_cplfields
FieldInfo("t2m ", "s") ]
! Import Fields ----------------------------------------
- integer, public, parameter :: NimportFields = 46
+ integer, public, parameter :: NimportFields = 42
logical, public :: importFieldsValid(NimportFields)
type(ESMF_Field), target, public :: importFields(NimportFields)
@@ -145,10 +162,6 @@ module module_cplfields
FieldInfo("inst_ice_ir_dir_albedo ", "s"), &
FieldInfo("inst_ice_vis_dif_albedo ", "s"), &
FieldInfo("inst_ice_vis_dir_albedo ", "s"), &
- FieldInfo("inst_tracer_up_surface_flx ", "u"), &
- FieldInfo("inst_tracer_down_surface_flx ", "d"), &
- FieldInfo("inst_tracer_clmn_mass_dens ", "c"), &
- FieldInfo("inst_tracer_anth_biom_flx ", "b"), &
FieldInfo("wave_z0_roughness_length ", "s"), &
! For JEDI
diff --git a/fv3_cap.F90 b/fv3_cap.F90
index 862dd5a27..87ec28749 100644
--- a/fv3_cap.F90
+++ b/fv3_cap.F90
@@ -42,10 +42,7 @@ module fv3gfs_cap_mod
!
use module_fcst_grid_comp, only: fcstSS => SetServices, &
fcstGrid, numLevels, numSoilLayers, &
- numTracers, num_diag_sfc_emis_flux, &
- num_diag_down_flux, &
- num_diag_type_down_flux, &
- num_diag_burn_emis_flux, num_diag_cmass
+ numTracers
use module_wrt_grid_comp, only: wrtSS => SetServices
!
@@ -783,24 +780,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
if (isPetLocal) then
! -- realize connected fields in exportState
- call realizeConnectedCplFields(exportState, fcstGrid, &
- numLevels, numSoilLayers, numTracers, num_diag_sfc_emis_flux, &
- num_diag_down_flux, num_diag_type_down_flux, num_diag_burn_emis_flux, &
- num_diag_cmass, exportFieldsInfo, 'FV3 Export', &
- exportFields, rc)
+ call realizeConnectedCplFields(exportState, fcstGrid, &
+ numLevels, numSoilLayers, numTracers, &
+ exportFieldsInfo, 'FV3 Export', exportFields, rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+ ! -- initialize export fields if applicable
+ call setup_exportdata(rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
! -- realize connected fields in importState
- call realizeConnectedCplFields(importState, fcstGrid, &
- numLevels, numSoilLayers, numTracers, num_diag_sfc_emis_flux, &
- num_diag_down_flux, num_diag_type_down_flux, num_diag_burn_emis_flux, &
- num_diag_cmass, importFieldsInfo, 'FV3 Import', &
- importFields, rc)
+ call realizeConnectedCplFields(importState, fcstGrid, &
+ numLevels, numSoilLayers, numTracers, &
+ importFieldsInfo, 'FV3 Import', importFields, rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
- call setup_exportdata()
-
end if
end subroutine InitializeRealize
@@ -1242,9 +1236,9 @@ subroutine ModelAdvance_phase2(gcomp, rc)
output: IF(lalarm .or. na==first_kdt ) then
- timerhi = MPI_Wtime()
call ESMF_VMEpochEnter(epoch=ESMF_VMEpoch_Buffer, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
+ timerhi = mpi_wtime()
do i=1, FBCount
!
! get fcst fieldbundle
@@ -1255,6 +1249,7 @@ subroutine ModelAdvance_phase2(gcomp, rc)
!
!end FBcount
enddo
+ timerh = mpi_wtime()
call ESMF_VMEpochExit(rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'aft fieldbundleregrid,na=',na, &
diff --git a/io/module_write_netcdf_parallel.F90 b/io/module_write_netcdf_parallel.F90
index 260371ae9..0506d794a 100644
--- a/io/module_write_netcdf_parallel.F90
+++ b/io/module_write_netcdf_parallel.F90
@@ -378,15 +378,20 @@ subroutine write_netcdf_parallel(fieldbundle, wrtfb, filename, mpi_comm, mype, i
! rescaling (plus it allows the ability to adjust the packing
! range)
scale_fact = (dataMax - dataMin) / (2**nbits-1); offset = dataMin
- allocate(arrayr4_3d_save(i1:i2,j1:j2,k1:k2))
- arrayr4_3d_save(i1:i2,j1:j2,k1:k2)=arrayr4_3d(i1:i2,j1:j2,k1:k2)
- arrayr4_3d = scale_fact*(nint((arrayr4_3d_save - offset) / scale_fact)) + offset
- ! compute max abs compression error.
- compress_err(i) = &
- maxval(abs(arrayr4_3d_save(i1:i2,j1:j2,k1:k2)-arrayr4_3d(i1:i2,j1:j2,k1:k2)))
- deallocate(arrayr4_3d_save)
- call mpi_allreduce(mpi_in_place,compress_err(i),1,mpi_real4,mpi_max,mpi_comm,ierr)
- !print *,'field name=',trim(fldName),dataMin,dataMax,compress_err(i)
+ if (scale_fact > 0.) then
+ allocate(arrayr4_3d_save(i1:i2,j1:j2,k1:k2))
+ arrayr4_3d_save(i1:i2,j1:j2,k1:k2)=arrayr4_3d(i1:i2,j1:j2,k1:k2)
+ arrayr4_3d = scale_fact*(nint((arrayr4_3d_save - offset) / scale_fact)) + offset
+ ! compute max abs compression error.
+ compress_err(i) = &
+ maxval(abs(arrayr4_3d_save(i1:i2,j1:j2,k1:k2)-arrayr4_3d(i1:i2,j1:j2,k1:k2)))
+ deallocate(arrayr4_3d_save)
+ call mpi_allreduce(mpi_in_place,compress_err(i),1,mpi_real4,mpi_max,mpi_comm,ierr)
+ !print *,'field name=',trim(fldName),dataMin,dataMax,compress_err(i)
+ else
+ ! field is constant
+ compress_err(i) = 0.
+ endif
endif
ncerr = nf90_put_var(ncid, varids(i), values=arrayr4_3d, start=(/totalLBound3d(1),totalLBound3d(2),totalLBound3d(3),1/)); NC_ERR_STOP(ncerr)
else if (typekind == ESMF_TYPEKIND_R8) then
diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90
index 618e86f94..fc2c5c63d 100644
--- a/module_fcst_grid_comp.F90
+++ b/module_fcst_grid_comp.F90
@@ -111,21 +111,13 @@ module module_fcst_grid_comp
integer :: numLevels = 0
integer :: numSoilLayers = 0
integer :: numTracers = 0
- integer :: num_diag_sfc_emis_flux = 0
- integer :: num_diag_down_flux = 0
- integer :: num_diag_type_down_flux = 0
- integer :: num_diag_burn_emis_flux = 0
- integer :: num_diag_cmass = 0
-
- integer :: frestart(999)
+ integer :: frestart(999)
!
!-----------------------------------------------------------------------
!
public SetServices, fcstGrid
- public numLevels, numSoilLayers, numTracers, &
- num_diag_sfc_emis_flux, num_diag_down_flux, &
- num_diag_type_down_flux, num_diag_burn_emis_flux, num_diag_cmass
+ public numLevels, numSoilLayers, numTracers
!
contains
!
@@ -692,13 +684,9 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc)
!end qulting
endif
- call get_atmos_model_ungridded_dim(nlev=numLevels, nsoillev=numSoilLayers, &
- ntracers=numTracers, &
- num_diag_burn_emis_flux=num_diag_burn_emis_flux, &
- num_diag_sfc_emis_flux=num_diag_sfc_emis_flux, &
- num_diag_down_flux=num_diag_down_flux, &
- num_diag_type_down_flux=num_diag_type_down_flux, &
- num_diag_cmass=num_diag_cmass)
+ call get_atmos_model_ungridded_dim(nlev=numLevels, &
+ nsoillev=numSoilLayers, &
+ ntracers=numTracers)
!
!-----------------------------------------------------------------------
!
@@ -840,7 +828,8 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc)
call atmos_model_exchange_phase_2 (atm_int_state%Atm, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
- call update_atmos_model_state (atm_int_state%Atm)
+ call update_atmos_model_state (atm_int_state%Atm, rc=rc)
+ if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
!--- intermediate restart
if (atm_int_state%intrm_rst>0) then