diff --git a/atmos_model.F90 b/atmos_model.F90 index 132b4f403..e5ebf390c 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1173,16 +1173,20 @@ subroutine update_atmos_chemistry(state, rc) integer :: nb, ix, i, j, k, k1, it integer :: ib, jb - real(ESMF_KIND_R8), dimension(:,:,:), pointer :: prsl, phil, & - prsi, phii, & - temp, cldfra, & - pflls, pfils, & - ua, va, slc + real(ESMF_KIND_R8), dimension(:,:,:), pointer :: cldfra, & + pfils, pflls, & + phii, phil, & + prsi, prsl, & + slc, smc, & + stc, temp, & + ua, va + real(ESMF_KIND_R8), dimension(:,:,:,:), pointer :: q - real(ESMF_KIND_R8), dimension(:,:), pointer :: hpbl, area, rainc, & - uustar, rain, slmsk, tsfc, shfsfc, zorl, focn, flake, fice, & - fsnow, u10m, v10m, swet + real(ESMF_KIND_R8), dimension(:,:), pointer :: aod, area, canopy, cmm, & + dqsfc, dtsfc, fice, flake, focn, fsnow, hpbl, nswsfc, oro, psfc, & + q2m, rain, rainc, rca, shfsfc, slmsk, stype, swet, t2m, tsfc, & + u10m, uustar, v10m, vfrac, xlai, zorl ! logical, parameter :: diag = .true. @@ -1203,6 +1207,12 @@ subroutine update_atmos_chemistry(state, rc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return + if (GFS_control%cplaqm) then + call cplFieldGet(state,'inst_tracer_diag_aod', farrayPtr2d=aod, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + end if + !--- do not import tracer concentrations by default ntb = nt + 1 nte = nt @@ -1259,26 +1269,41 @@ subroutine update_atmos_chemistry(state, rc) end do end if + if (GFS_control%cplaqm) then + !--- other diagnostics +!$OMP parallel do default (none) & +!$OMP shared (nj, ni, Atm_block, GFS_Data, aod) & +!$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%aod(ix) = aod(i,j) + enddo + enddo + 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) + if (GFS_control%cplaqm) & + write(6,'("update_atmos: ",a,": aod - min/max ",3g16.6)') & + trim(state), minval(aod), maxval(aod) end if case ('export') !--- retrieve references to allocated memory for each field - call cplFieldGet(state,'inst_pres_interface', farrayPtr3d=prsi, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_pres_levels', farrayPtr3d=prsl, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_geop_interface', farrayPtr3d=phii, rc=localrc) + call cplFieldGet(state,'inst_geop_levels', farrayPtr3d=phil, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_geop_levels', farrayPtr3d=phil, rc=localrc) + call cplFieldGet(state,'inst_geop_interface', farrayPtr3d=phii, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -1327,28 +1352,10 @@ 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_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_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_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_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_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_cloud_frac_levels', farrayPtr3d=cldfra, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -1361,25 +1368,113 @@ 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_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,'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,'lake_fraction', farrayPtr2d=flake, rc=localrc) + 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 - 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 + if (GFS_Control%cplaqm) then - 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 + call cplFieldGet(state,'canopy_moisture_storage', farrayPtr2d=canopy, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_aerodynamic_conductance', farrayPtr2d=cmm, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_laten_heat_flx', farrayPtr2d=dqsfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_sensi_heat_flx', farrayPtr2d=dtsfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_net_sw_flx', farrayPtr2d=nswsfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'height', farrayPtr2d=oro, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_pres_height_surface', farrayPtr2d=psfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_spec_humid_height2m', farrayPtr2d=q2m, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_canopy_resistance', farrayPtr2d=rca, 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=smc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'temperature_of_soil_layer', farrayPtr3d=stc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_temp_height2m', farrayPtr2d=t2m, 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) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'leaf_area_index', farrayPtr2d=xlai, 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) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + else + + call cplFieldGet(state,'inst_pres_interface', farrayPtr3d=prsi, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + 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_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,'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,'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,'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_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_surface_soil_wetness', farrayPtr2d=swet, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + end if !--- handle all three-dimensional variables !$OMP parallel do default (none) & @@ -1395,7 +1490,6 @@ subroutine update_atmos_chemistry(state, rc) nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) !--- interface values - 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) @@ -1404,8 +1498,13 @@ subroutine update_atmos_chemistry(state, rc) 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) + if (.not.GFS_Control%cplaqm) then + !--- interface values + prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k) + !--- layer values + pfils (i,j,k) = GFS_Data(nb)%Coupling%pfi_lsan(ix,k) + pflls (i,j,k) = GFS_Data(nb)%Coupling%pfl_lsan(ix,k) + end if enddo enddo enddo @@ -1419,8 +1518,9 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k) phii(i,j,k) = GFS_data(nb)%Statein%phii(ix,k) + if (.not.GFS_Control%cplaqm) & + prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k) enddo enddo @@ -1444,9 +1544,11 @@ subroutine update_atmos_chemistry(state, rc) !$OMP parallel do default (none) & !$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 area, canopy, cmm, dqsfc, dtsfc, fice, & +!$OMP flake, focn, fsnow, hpbl, nswsfc, oro, & +!$OMP psfc, q2m, rain, rainc, rca, shfsfc, slc, & +!$OMP slmsk, smc, stc, stype, swet, t2m, tsfc, & +!$OMP u10m, uustar, v10m, vfrac, xlai, zorl) & !$OMP private (j, jb, i, ib, nb, ix) do j = 1, nj jb = j + Atm_block%jsc - 1 @@ -1461,20 +1563,46 @@ subroutine update_atmos_chemistry(state, rc) + 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) + if (GFS_Control%cplaqm) then + canopy(i,j) = GFS_Data(nb)%Sfcprop%canopy(ix) + cmm(i,j) = GFS_Data(nb)%IntDiag%cmm(ix) + dqsfc(i,j) = GFS_Data(nb)%Coupling%dqsfci_cpl(ix) + dtsfc(i,j) = GFS_Data(nb)%Coupling%dtsfci_cpl(ix) + nswsfc(i,j) = GFS_Data(nb)%Coupling%nswsfci_cpl(ix) + oro(i,j) = max(0.d0, GFS_Data(nb)%Sfcprop%oro(ix)) + psfc(i,j) = GFS_Data(nb)%Coupling%psurfi_cpl(ix) + q2m(i,j) = GFS_Data(nb)%Coupling%q2mi_cpl(ix) + rca(i,j) = GFS_Data(nb)%Sfcprop%rca(ix) + smc(i,j,:) = GFS_Data(nb)%Sfcprop%smc(ix,:) + stc(i,j,:) = GFS_Data(nb)%Sfcprop%stc(ix,:) + t2m(i,j) = GFS_Data(nb)%Coupling%t2mi_cpl(ix) + vfrac(i,j) = GFS_Data(nb)%Sfcprop%vfrac(ix) + xlai(i,j) = GFS_Data(nb)%Sfcprop%xlaixy(ix) + if (nint(slmsk(i,j)) == 2) then + if (GFS_Control%isot == 1) then + stype(i,j) = 16._ESMF_KIND_R8 + else + stype(i,j) = 9._ESMF_KIND_R8 + endif + else + stype(i,j) = real(int( GFS_Data(nb)%Sfcprop%stype(ix)+0.5 ), kind=ESMF_KIND_R8) + endif else - swet(i,j) = GFS_Data(nb)%IntDiag%wet1(ix) + flake(i,j) = max(zero, GFS_Data(nb)%Sfcprop%lakefrac(ix)) + focn(i,j) = GFS_Data(nb)%Sfcprop%oceanfrac(ix) + shfsfc(i,j) = GFS_Data(nb)%Coupling%ushfsfci(ix) + slc(i,j,:) = GFS_Data(nb)%Sfcprop%slc(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 end if enddo enddo @@ -1499,7 +1627,6 @@ subroutine update_atmos_chemistry(state, rc) if (GFS_control%debug) then ! -- diagnostics - write(6,'("update_atmos: prsi - min/max/avg",3g16.6)') minval(prsi), maxval(prsi), sum(prsi)/size(prsi) write(6,'("update_atmos: phii - min/max/avg",3g16.6)') minval(phii), maxval(phii), sum(phii)/size(phii) write(6,'("update_atmos: prsl - min/max/avg",3g16.6)') minval(prsl), maxval(prsl), sum(prsl)/size(prsl) write(6,'("update_atmos: phil - min/max/avg",3g16.6)') minval(phil), maxval(phil), sum(phil)/size(phil) @@ -1511,21 +1638,40 @@ subroutine update_atmos_chemistry(state, rc) 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: slmsk - min/max/avg",3g16.6)') minval(slmsk), maxval(slmsk), sum(slmsk)/size(slmsk) write(6,'("update_atmos: tsfc - min/max/avg",3g16.6)') minval(tsfc), maxval(tsfc), sum(tsfc)/size(tsfc) write(6,'("update_atmos: area - min/max/avg",3g16.6)') minval(area), maxval(area), sum(area)/size(area) 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) + if (GFS_Control%cplaqm) then + write(6,'("update_atmos: canopy - min/max/avg",3g16.6)') minval(canopy), maxval(canopy), sum(canopy)/size(canopy) + write(6,'("update_atmos: cmm - min/max/avg",3g16.6)') minval(cmm), maxval(cmm), sum(cmm)/size(cmm) + write(6,'("update_atmos: dqsfc - min/max/avg",3g16.6)') minval(dqsfc), maxval(dqsfc), sum(dqsfc)/size(dqsfc) + write(6,'("update_atmos: dtsfc - min/max/avg",3g16.6)') minval(dtsfc), maxval(dtsfc), sum(dtsfc)/size(dtsfc) + write(6,'("update_atmos: nswsfc - min/max/avg",3g16.6)') minval(nswsfc), maxval(nswsfc), sum(nswsfc)/size(nswsfc) + write(6,'("update_atmos: oro - min/max/avg",3g16.6)') minval(oro), maxval(oro), sum(oro)/size(oro) + write(6,'("update_atmos: psfc - min/max/avg",3g16.6)') minval(psfc), maxval(psfc), sum(psfc)/size(psfc) + write(6,'("update_atmos: q2m - min/max/avg",3g16.6)') minval(q2m), maxval(q2m), sum(q2m)/size(q2m) + write(6,'("update_atmos: rca - min/max/avg",3g16.6)') minval(rca), maxval(rca), sum(rca)/size(rca) + write(6,'("update_atmos: smc - min/max/avg",3g16.6)') minval(smc), maxval(smc), sum(smc)/size(smc) + write(6,'("update_atmos: stc - min/max/avg",3g16.6)') minval(stc), maxval(stc), sum(stc)/size(stc) + write(6,'("update_atmos: t2m - min/max/avg",3g16.6)') minval(t2m), maxval(t2m), sum(t2m)/size(t2m) + write(6,'("update_atmos: vfrac - min/max/avg",3g16.6)') minval(vfrac), maxval(vfrac), sum(vfrac)/size(vfrac) + write(6,'("update_atmos: xlai - min/max/avg",3g16.6)') minval(xlai), maxval(xlai), sum(xlai)/size(xlai) + write(6,'("update_atmos: stype - min/max/avg",3g16.6)') minval(stype), maxval(stype), sum(stype)/size(stype) + else + write(6,'("update_atmos: prsi - min/max/avg",3g16.6)') minval(prsi), maxval(prsi), sum(prsi)/size(prsi) + 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: shfsfc - min/max/avg",3g16.6)') minval(shfsfc), maxval(shfsfc), sum(shfsfc)/size(shfsfc) + write(6,'("update_atmos: slc - min/max/avg",3g16.6)') minval(slc), maxval(slc), sum(slc)/size(slc) + write(6,'("update_atmos: swet - min/max/avg",3g16.6)') minval(swet), maxval(swet), sum(swet)/size(swet) + end if end if case default diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 526f12b3a..ad22a11b9 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -295,6 +295,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: ffmm (:) => null() !< fm parameter from PBL scheme real (kind=kind_phys), pointer :: ffhh (:) => null() !< fh parameter from PBL scheme real (kind=kind_phys), pointer :: f10m (:) => null() !< fm at 10m - Ratio of sigma level 1 wind and 10m wind + real (kind=kind_phys), pointer :: rca (:) => null() !< canopy resistance real (kind=kind_phys), pointer :: tprcp (:) => null() !< sfc_fld%tprcp - total precipitation real (kind=kind_phys), pointer :: srflag (:) => null() !< sfc_fld%srflag - snow/rain flag for precipitation real (kind=kind_phys), pointer :: slc (:,:) => null() !< liquid soil moisture @@ -647,6 +648,7 @@ module GFS_typedefs logical :: cplocn2atm !< default yes ocn->atm coupling logical :: cplwav !< default no cplwav collection logical :: cplwav2atm !< default no wav->atm coupling + logical :: cplaqm !< default no cplaqm collection logical :: cplchm !< default no cplchm collection logical :: use_cice_alb !< default .false. - i.e. don't use albedo imported from the ice model logical :: cpl_imp_mrg !< default no merge import with internal forcings @@ -1841,6 +1843,9 @@ module GFS_typedefs ! Extended output diagnostics for Thompson MP real (kind=kind_phys), pointer :: thompson_ext_diag3d (:,:,:) => null() ! extended diagnostic 3d output arrays from Thompson MP + ! Diagnostics for coupled air quality model + real (kind=kind_phys), pointer :: aod (:) => null() !< instantaneous aerosol optical depth ( n/a ) + ! 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) @@ -2584,6 +2589,12 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%dt_cool = zero Sfcprop%qrain = zero endif + if (Model%lsm == Model%lsm_noah) then + allocate (Sfcprop%xlaixy (IM)) + allocate (Sfcprop%rca (IM)) + Sfcprop%xlaixy = clear_val + Sfcprop%rca = clear_val + end if if (Model%lsm == Model%lsm_ruc .or. Model%lsm == Model%lsm_noahmp) then allocate(Sfcprop%raincprv (IM)) allocate(Sfcprop%rainncprv (IM)) @@ -3003,6 +3014,23 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%pfl_lsan = clear_val endif + ! -- additional coupling options for air quality + if (Model%cplaqm .and. .not.Model%cplflx) then + !--- outgoing instantaneous quantities + allocate (Coupling%dtsfci_cpl (IM)) + allocate (Coupling%dqsfci_cpl (IM)) + allocate (Coupling%nswsfci_cpl (IM)) + allocate (Coupling%t2mi_cpl (IM)) + allocate (Coupling%q2mi_cpl (IM)) + allocate (Coupling%psurfi_cpl (IM)) + Coupling%dtsfci_cpl = clear_val + Coupling%dqsfci_cpl = clear_val + Coupling%nswsfci_cpl = clear_val + Coupling%t2mi_cpl = clear_val + Coupling%q2mi_cpl = clear_val + Coupling%psurfi_cpl = clear_val + endif + !--- stochastic physics option if (Model%do_sppt .or. Model%ca_global) then allocate (Coupling%sppt_wts (IM,Model%levs)) @@ -3146,6 +3174,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: cplocn2atm = .true. !< default yes cplocn2atm coupling (turn on the feedback from ocn to atm) logical :: cplwav = .false. !< default no cplwav collection logical :: cplwav2atm = .false. !< default no cplwav2atm coupling + logical :: cplaqm = .false. !< default no cplaqm collection logical :: cplchm = .false. !< default no cplchm collection logical :: use_cice_alb = .false. !< default no cice albedo logical :: cpl_imp_mrg = .false. !< default no merge import with internal forcings @@ -3622,7 +3651,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: do_spp = .false. !--- aerosol scavenging factors - integer, parameter :: max_scav_factors = 25 + integer, parameter :: max_scav_factors = 183 character(len=40) :: fscav_aero(max_scav_factors) real(kind=kind_phys) :: radar_tten_limits(2) = (/ limit_unspecified, limit_unspecified /) @@ -3636,8 +3665,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & naux3d, aux2d_time_avg, aux3d_time_avg, fhcyc, & thermodyn_id, sfcpress_id, & !--- coupling parameters - cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplchm, & - cpl_imp_mrg, cpl_imp_dbg, & + cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm, & + cplchm, cpl_imp_mrg, cpl_imp_dbg, & use_cice_alb, & #ifdef IDEA_PHYS lsidea, weimer_model, f107_kp_size, f107_kp_interval, & @@ -3950,7 +3979,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%cplocn2atm = cplocn2atm Model%cplwav = cplwav Model%cplwav2atm = cplwav2atm - Model%cplchm = cplchm + Model%cplaqm = cplaqm + Model%cplchm = cplchm .or. cplaqm Model%use_cice_alb = use_cice_alb Model%cpl_imp_mrg = cpl_imp_mrg Model%cpl_imp_dbg = cpl_imp_dbg @@ -5781,6 +5811,7 @@ subroutine control_print(Model) print *, ' cplocn2atm : ', Model%cplocn2atm print *, ' cplwav : ', Model%cplwav print *, ' cplwav2atm : ', Model%cplwav2atm + print *, ' cplaqm : ', Model%cplaqm print *, ' cplchm : ', Model%cplchm print *, ' use_cice_alb : ', Model%use_cice_alb print *, ' cpl_imp_mrg : ', Model%cpl_imp_mrg @@ -7033,6 +7064,13 @@ subroutine diag_create (Diag, IM, Model) Diag%thompson_ext_diag3d = clear_val endif + ! Air quality diagnostics + ! -- initialize diagnostic variables + if (Model%cplaqm) then + allocate (Diag%aod(IM)) + Diag%aod = zero + end if + ! Auxiliary arrays in output for debugging if (Model%naux2d>0) then allocate (Diag%aux2d(IM,Model%naux2d)) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index e6012a92e..4d6815641 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -955,6 +955,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[rca] + standard_name = aerodynamic_resistance_in_canopy + long_name = canopy resistance + units = s m-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [tprcp] standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total precipitation amount in each time step @@ -1378,7 +1385,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .and. flag_for_reading_leaf_area_index_from_input)) + active = (control_for_land_surface_scheme == identifier_for_noah_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .and. flag_for_reading_leaf_area_index_from_input)) [xsaixy] standard_name = stem_area_index long_name = stem area index @@ -2077,7 +2084,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [dqsfci_cpl] standard_name = surface_upward_latent_heat_flux_for_coupling long_name = instantaneous sfc latent heat flux @@ -2085,7 +2092,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [dlwsfci_cpl] standard_name = surface_downwelling_longwave_flux_for_coupling long_name = instantaneous sfc downward lw flux @@ -2149,7 +2156,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [nnirbmi_cpl] standard_name = surface_net_downwelling_direct_nir_shortwave_flux_for_coupling long_name = instantaneous net nir beam sfc downward sw flux @@ -2189,7 +2196,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [q2mi_cpl] standard_name = specific_humidity_at_2m_for_coupling long_name = instantaneous Q2m @@ -2197,7 +2204,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [u10mi_cpl] standard_name = x_wind_at_10m_for_coupling long_name = instantaneous U10m @@ -2229,7 +2236,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [ulwsfcin_cpl] standard_name = surface_upwelling_longwave_flux_from_coupled_process long_name = surface upwelling LW flux for coupling @@ -2747,6 +2754,12 @@ units = flag dimensions = () type = logical +[cplaqm] + standard_name = flag_for_air_quality_coupling + long_name = flag controlling cplaqm collection (default off) + units = flag + dimensions = () + type = logical [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) diff --git a/ccpp/physics b/ccpp/physics index 6d4acb149..b1326baa5 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 6d4acb149ec5a54051359659a2be7dcebbb4976a +Subproject commit b1326baa54effdf81b8ea417fd4cc2f8779069f1 diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 68d6f10d8..06f11ab94 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -26,7 +26,7 @@ module module_cplfields ! l : model levels (3D) ! s : surface (2D) ! t : tracers (4D) - integer, public, parameter :: NexportFields = 105 + integer, public, parameter :: NexportFields = 111 type(ESMF_Field), target, public :: exportFields(NexportFields) type(FieldInfo), dimension(NexportFields), public, parameter :: exportFieldsInfo = [ & @@ -110,6 +110,12 @@ module module_cplfields FieldInfo("lake_fraction ", "s"), & FieldInfo("ocean_fraction ", "s"), & FieldInfo("surface_snow_area_fraction ", "s"), & + FieldInfo("canopy_moisture_storage ", "s"), & + FieldInfo("inst_aerodynamic_conductance ", "s"), & + FieldInfo("inst_canopy_resistance ", "s"), & + FieldInfo("leaf_area_index ", "s"), & + FieldInfo("temperature_of_soil_layer ", "g"), & + FieldInfo("height ", "s"), & ! For JEDI @@ -142,7 +148,7 @@ module module_cplfields FieldInfo("t2m ", "s") ] ! Import Fields ---------------------------------------- - integer, public, parameter :: NimportFields = 42 + integer, public, parameter :: NimportFields = 43 logical, public :: importFieldsValid(NimportFields) type(ESMF_Field), target, public :: importFields(NimportFields) @@ -164,6 +170,7 @@ module module_cplfields FieldInfo("inst_ice_vis_dif_albedo ", "s"), & FieldInfo("inst_ice_vis_dir_albedo ", "s"), & FieldInfo("wave_z0_roughness_length ", "s"), & + FieldInfo("inst_tracer_diag_aod ", "s"), & ! For JEDI ! dynamics @@ -219,7 +226,15 @@ module module_cplfields "ice_fraction_in_atm ", & "lake_fraction ", & "ocean_fraction ", & - "surface_snow_area_fraction " & + "surface_snow_area_fraction ", & + "inst_vegetation_area_frac ", & + "canopy_moisture_storage ", & + "inst_aerodynamic_conductance ", & + "inst_canopy_resistance ", & + "leaf_area_index ", & + "soil_type ", & + "temperature_of_soil_layer ", & + "height " & ] ! Methods