diff --git a/CMakeLists.txt b/CMakeLists.txt index d375d288e..986b5fd2f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -60,9 +60,6 @@ set_target_properties(fv3atm PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT target_include_directories(fv3atm INTERFACE $ $) -# This should not be necessary once framework and physics targets define BUILD_INTERFACE -target_include_directories(fv3atm PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/physics) - target_link_libraries(fv3atm PUBLIC fv3 fv3ccpp stochastic_physics diff --git a/atmos_model.F90 b/atmos_model.F90 index 3cf80e61c..f092da8c5 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -2326,7 +2326,7 @@ subroutine assign_importdata(jdat, rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - GFS_data(nb)%Sfcprop%vtype(ix) = datar82d(i-isc+1,j-jsc+1) + GFS_data(nb)%Sfcprop%vtype(ix) = int(datar82d(i-isc+1,j-jsc+1)) enddo enddo endif @@ -2341,7 +2341,7 @@ subroutine assign_importdata(jdat, rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - GFS_data(nb)%Sfcprop%stype(ix) = datar82d(i-isc+1,j-jsc+1) + GFS_data(nb)%Sfcprop%stype(ix) = int(datar82d(i-isc+1,j-jsc+1)) enddo enddo endif diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 68abe1de8..eb47767f8 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -263,13 +263,16 @@ module GFS_typedefs real (kind=kind_phys), pointer :: facwf (:) => null() !< fractional coverage with weak cosz dependency !--- In (physics only) - real (kind=kind_phys), pointer :: slope (:) => null() !< sfc slope type for lsm + integer, pointer :: slope (:) => null() !< sfc slope type for lsm + integer, pointer :: slope_save (:) => null()!< sfc slope type save real (kind=kind_phys), pointer :: shdmin (:) => null() !< min fractional coverage of green veg real (kind=kind_phys), pointer :: shdmax (:) => null() !< max fractnl cover of green veg (not used) real (kind=kind_phys), pointer :: tg3 (:) => null() !< deep soil temperature real (kind=kind_phys), pointer :: vfrac (:) => null() !< vegetation fraction - real (kind=kind_phys), pointer :: vtype (:) => null() !< vegetation type - real (kind=kind_phys), pointer :: stype (:) => null() !< soil type + integer, pointer :: vtype (:) => null() !< vegetation type + integer, pointer :: stype (:) => null() !< soil type + integer, pointer :: vtype_save (:) => null()!< vegetation type save + integer, pointer :: stype_save (:) => null()!< soil type save real (kind=kind_phys), pointer :: uustar (:) => null() !< boundary layer parameter real (kind=kind_phys), pointer :: oro (:) => null() !< orography real (kind=kind_phys), pointer :: oro_uf (:) => null() !< unfiltered orography @@ -2027,7 +2030,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: sigmatot(:,:) => null() !< logical :: skip_macro !< real (kind=kind_phys), pointer :: slc_save(:,:) => null() !< - integer, pointer :: slopetype(:) => null() !< real (kind=kind_phys), pointer :: smcmax(:) => null() !< real (kind=kind_phys), pointer :: smc_save(:,:) => null() !< real (kind=kind_phys), pointer :: snowc(:) => null() !< @@ -2043,7 +2045,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: snowmp(:) => null() !< real (kind=kind_phys), pointer :: snowmt(:) => null() !< real (kind=kind_phys), pointer :: soilm_in_m(:) => null() !< - integer, pointer :: soiltype(:) => null() !< real (kind=kind_phys), pointer :: stc_save(:,:) => null() !< real (kind=kind_phys), pointer :: stress(:) => null() !< real (kind=kind_phys), pointer :: stress_ice(:) => null() !< @@ -2080,7 +2081,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: vegf1d(:) => null() !< real (kind=kind_phys) :: lndp_vgf !< - integer, pointer :: vegtype(:) => null() !< real (kind=kind_phys), pointer :: w_upi(:,:) => null() !< real (kind=kind_phys), pointer :: wcbmax(:) => null() !< ! real (kind=kind_phys), pointer :: weasd_water(:) => null() !< @@ -2211,7 +2211,6 @@ module GFS_typedefs procedure :: create => interstitial_create !< allocate array data procedure :: rad_reset => interstitial_rad_reset !< reset array data for radiation procedure :: phys_reset => interstitial_phys_reset !< reset array data for physics - procedure :: mprint => interstitial_print !< print array data end type GFS_interstitial_type @@ -2419,35 +2418,41 @@ subroutine sfcprop_create (Sfcprop, IM, Model) !--- physics surface props !--- In - allocate (Sfcprop%slope (IM)) - allocate (Sfcprop%shdmin (IM)) - allocate (Sfcprop%shdmax (IM)) - allocate (Sfcprop%snoalb (IM)) - allocate (Sfcprop%tg3 (IM)) - allocate (Sfcprop%vfrac (IM)) - allocate (Sfcprop%vtype (IM)) - allocate (Sfcprop%stype (IM)) - allocate (Sfcprop%uustar (IM)) - allocate (Sfcprop%oro (IM)) - allocate (Sfcprop%oro_uf (IM)) - allocate (Sfcprop%evap (IM)) - allocate (Sfcprop%hflx (IM)) - allocate (Sfcprop%qss (IM)) - - Sfcprop%slope = clear_val - Sfcprop%shdmin = clear_val - Sfcprop%shdmax = clear_val - Sfcprop%snoalb = clear_val - Sfcprop%tg3 = clear_val - Sfcprop%vfrac = clear_val - Sfcprop%vtype = clear_val - Sfcprop%stype = clear_val - Sfcprop%uustar = clear_val - Sfcprop%oro = clear_val - Sfcprop%oro_uf = clear_val - Sfcprop%evap = clear_val - Sfcprop%hflx = clear_val - Sfcprop%qss = clear_val + allocate (Sfcprop%slope (IM)) + allocate (Sfcprop%slope_save (IM)) + allocate (Sfcprop%shdmin (IM)) + allocate (Sfcprop%shdmax (IM)) + allocate (Sfcprop%snoalb (IM)) + allocate (Sfcprop%tg3 (IM)) + allocate (Sfcprop%vfrac (IM)) + allocate (Sfcprop%vtype (IM)) + allocate (Sfcprop%vtype_save (IM)) + allocate (Sfcprop%stype (IM)) + allocate (Sfcprop%stype_save (IM)) + allocate (Sfcprop%uustar (IM)) + allocate (Sfcprop%oro (IM)) + allocate (Sfcprop%oro_uf (IM)) + allocate (Sfcprop%evap (IM)) + allocate (Sfcprop%hflx (IM)) + allocate (Sfcprop%qss (IM)) + + Sfcprop%slope = zero + Sfcprop%slope_save = zero + Sfcprop%shdmin = clear_val + Sfcprop%shdmax = clear_val + Sfcprop%snoalb = clear_val + Sfcprop%tg3 = clear_val + Sfcprop%vfrac = clear_val + Sfcprop%vtype = zero + Sfcprop%vtype_save = zero + Sfcprop%stype = zero + Sfcprop%stype_save = zero + Sfcprop%uustar = clear_val + Sfcprop%oro = clear_val + Sfcprop%oro_uf = clear_val + Sfcprop%evap = clear_val + Sfcprop%hflx = clear_val + Sfcprop%qss = clear_val !--- In/Out allocate (Sfcprop%hice (IM)) @@ -7093,14 +7098,12 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%sigmaf (IM)) allocate (Interstitial%sigmafrac (IM,Model%levs)) allocate (Interstitial%sigmatot (IM,Model%levs)) - allocate (Interstitial%slopetype (IM)) allocate (Interstitial%snowc (IM)) allocate (Interstitial%snowd_ice (IM)) ! allocate (Interstitial%snowd_land (IM)) ! allocate (Interstitial%snowd_water (IM)) allocate (Interstitial%snohf (IM)) allocate (Interstitial%snowmt (IM)) - allocate (Interstitial%soiltype (IM)) allocate (Interstitial%stress (IM)) allocate (Interstitial%stress_ice (IM)) allocate (Interstitial%stress_land (IM)) @@ -7126,7 +7129,6 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%uustar_water (IM)) allocate (Interstitial%vdftra (IM,Model%levs,Interstitial%nvdiff)) !GJF first dimension was set as 'IX' in GFS_physics_driver allocate (Interstitial%vegf1d (IM)) - allocate (Interstitial%vegtype (IM)) allocate (Interstitial%wcbmax (IM)) allocate (Interstitial%weasd_ice (IM)) ! allocate (Interstitial%weasd_land (IM)) @@ -7829,14 +7831,12 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%sigmaf = clear_val Interstitial%sigmafrac = clear_val Interstitial%sigmatot = clear_val - Interstitial%slopetype = 0 Interstitial%snowc = clear_val Interstitial%snowd_ice = huge ! Interstitial%snowd_land = huge ! Interstitial%snowd_water = huge Interstitial%snohf = clear_val Interstitial%snowmt = clear_val - Interstitial%soiltype = 0 Interstitial%stress = clear_val Interstitial%stress_ice = huge Interstitial%stress_land = huge @@ -7859,7 +7859,6 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%vdftra = clear_val Interstitial%vegf1d = clear_val Interstitial%lndp_vgf = clear_val - Interstitial%vegtype = 0 Interstitial%wcbmax = clear_val Interstitial%weasd_ice = huge ! Interstitial%weasd_land = huge @@ -7992,412 +7991,4 @@ subroutine interstitial_phys_reset (Interstitial, Model) ! end subroutine interstitial_phys_reset - ! DH* 20200901: this routine is no longer used by CCPP's GFS_debug.F90. When new variables are - ! added to the GFS_interstitial_type, it is best to add the variable to both interstitial_print - ! below and to GFS_interstitialtoscreen in ccpp/physics/physics/GFS_debug.F90 - subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) - ! - implicit none - ! - class(GFS_interstitial_type) :: Interstitial - type(GFS_control_type), intent(in) :: Model - integer, intent(in) :: mpirank, omprank, blkno - ! - ! Print static variables - write (0,'(a,3i6)') 'Interstitial_print for mpirank, omprank, blkno: ', mpirank, omprank, blkno - write (0,*) 'Interstitial_print: values that do not change' - write (0,*) 'Interstitial%ipr = ', Interstitial%ipr - write (0,*) 'Interstitial%itc = ', Interstitial%itc - write (0,*) 'Interstitial%latidxprnt = ', Interstitial%latidxprnt - write (0,*) 'Interstitial%levi = ', Interstitial%levi - write (0,*) 'Interstitial%lmk = ', Interstitial%lmk - write (0,*) 'Interstitial%lmp = ', Interstitial%lmp - write (0,*) 'Interstitial%nbdlw = ', Interstitial%nbdlw - write (0,*) 'Interstitial%nbdsw = ', Interstitial%nbdsw - write (0,*) 'Interstitial%nf_aelw = ', Interstitial%nf_aelw - write (0,*) 'Interstitial%nf_aesw = ', Interstitial%nf_aesw - write (0,*) 'Interstitial%nsamftrac = ', Interstitial%nsamftrac - write (0,*) 'Interstitial%nscav = ', Interstitial%nscav - write (0,*) 'Interstitial%nspc1 = ', Interstitial%nspc1 - write (0,*) 'Interstitial%ntcwx = ', Interstitial%ntcwx - write (0,*) 'Interstitial%ntiwx = ', Interstitial%ntiwx - write (0,*) 'Interstitial%nvdiff = ', Interstitial%nvdiff - write (0,*) 'Interstitial%phys_hydrostatic = ', Interstitial%phys_hydrostatic - write (0,*) 'Interstitial%skip_macro = ', Interstitial%skip_macro - write (0,*) 'Interstitial%trans_aero = ', Interstitial%trans_aero - ! Print all other variables - write (0,*) 'Interstitial_print: values that change' - write (0,*) 'sum(Interstitial%adjsfculw_land ) = ', sum(Interstitial%adjsfculw_land ) - write (0,*) 'sum(Interstitial%adjsfculw_ice ) = ', sum(Interstitial%adjsfculw_ice ) - write (0,*) 'sum(Interstitial%adjsfculw_water ) = ', sum(Interstitial%adjsfculw_water ) - write (0,*) 'sum(Interstitial%adjnirbmd ) = ', sum(Interstitial%adjnirbmd ) - write (0,*) 'sum(Interstitial%adjnirbmu ) = ', sum(Interstitial%adjnirbmu ) - write (0,*) 'sum(Interstitial%adjnirdfd ) = ', sum(Interstitial%adjnirdfd ) - write (0,*) 'sum(Interstitial%adjnirdfu ) = ', sum(Interstitial%adjnirdfu ) - write (0,*) 'sum(Interstitial%adjvisbmd ) = ', sum(Interstitial%adjvisbmd ) - write (0,*) 'sum(Interstitial%adjvisbmu ) = ', sum(Interstitial%adjvisbmu ) - write (0,*) 'sum(Interstitial%adjvisdfu ) = ', sum(Interstitial%adjvisdfu ) - write (0,*) 'sum(Interstitial%adjvisdfd ) = ', sum(Interstitial%adjvisdfd ) - write (0,*) 'sum(Interstitial%aerodp ) = ', sum(Interstitial%aerodp ) - write (0,*) 'sum(Interstitial%alb1d ) = ', sum(Interstitial%alb1d ) - if (.not. Model%do_RRTMGP) then - write (0,*) 'sum(Interstitial%alpha ) = ', sum(Interstitial%alpha ) - end if - write (0,*) 'sum(Interstitial%bexp1d ) = ', sum(Interstitial%bexp1d ) - write (0,*) 'sum(Interstitial%cd ) = ', sum(Interstitial%cd ) - write (0,*) 'sum(Interstitial%cd_ice ) = ', sum(Interstitial%cd_ice ) - write (0,*) 'sum(Interstitial%cd_land ) = ', sum(Interstitial%cd_land ) - write (0,*) 'sum(Interstitial%cd_water ) = ', sum(Interstitial%cd_water ) - write (0,*) 'sum(Interstitial%cdq ) = ', sum(Interstitial%cdq ) - write (0,*) 'sum(Interstitial%cdq_ice ) = ', sum(Interstitial%cdq_ice ) - write (0,*) 'sum(Interstitial%cdq_land ) = ', sum(Interstitial%cdq_land ) - write (0,*) 'sum(Interstitial%cdq_water ) = ', sum(Interstitial%cdq_water ) - write (0,*) 'sum(Interstitial%chh_ice ) = ', sum(Interstitial%chh_ice ) - write (0,*) 'sum(Interstitial%chh_land ) = ', sum(Interstitial%chh_land ) - write (0,*) 'sum(Interstitial%chh_water ) = ', sum(Interstitial%chh_water ) - write (0,*) 'sum(Interstitial%cldf ) = ', sum(Interstitial%cldf ) - write (0,*) 'sum(Interstitial%cldsa ) = ', sum(Interstitial%cldsa ) - write (0,*) 'sum(Interstitial%cldtaulw ) = ', sum(Interstitial%cldtaulw ) - write (0,*) 'sum(Interstitial%cldtausw ) = ', sum(Interstitial%cldtausw ) - write (0,*) 'sum(Interstitial%cld1d ) = ', sum(Interstitial%cld1d ) - write (0,*) 'sum(Interstitial%clw ) = ', sum(Interstitial%clw ) - write (0,*) 'sum(Interstitial%clx ) = ', sum(Interstitial%clx ) - write (0,*) 'sum(Interstitial%clouds ) = ', sum(Interstitial%clouds ) - write (0,*) 'sum(Interstitial%cmm_ice ) = ', sum(Interstitial%cmm_ice ) - write (0,*) 'sum(Interstitial%cmm_land ) = ', sum(Interstitial%cmm_land ) - write (0,*) 'sum(Interstitial%cmm_water ) = ', sum(Interstitial%cmm_water ) - write (0,*) 'sum(Interstitial%cnvc ) = ', sum(Interstitial%cnvc ) - write (0,*) 'sum(Interstitial%cnvw ) = ', sum(Interstitial%cnvw ) - write (0,*) 'sum(Interstitial%ctei_r ) = ', sum(Interstitial%ctei_r ) - write (0,*) 'sum(Interstitial%ctei_rml ) = ', sum(Interstitial%ctei_rml ) - write (0,*) 'sum(Interstitial%cumabs ) = ', sum(Interstitial%cumabs ) - write (0,*) 'sum(Interstitial%dd_mf ) = ', sum(Interstitial%dd_mf ) - write (0,*) 'sum(Interstitial%de_lgth ) = ', sum(Interstitial%de_lgth ) - write (0,*) 'sum(Interstitial%del ) = ', sum(Interstitial%del ) - write (0,*) 'sum(Interstitial%del_gz ) = ', sum(Interstitial%del_gz ) - write (0,*) 'sum(Interstitial%delr ) = ', sum(Interstitial%delr ) - write (0,*) 'sum(Interstitial%dlength ) = ', sum(Interstitial%dlength ) - write (0,*) 'sum(Interstitial%dqdt ) = ', sum(Interstitial%dqdt ) - write (0,*) 'sum(Interstitial%dqsfc1 ) = ', sum(Interstitial%dqsfc1 ) - write (0,*) 'sum(Interstitial%drain ) = ', sum(Interstitial%drain ) - write (0,*) 'sum(Interstitial%dtdt ) = ', sum(Interstitial%dtdt ) - write (0,*) 'sum(Interstitial%dtsfc1 ) = ', sum(Interstitial%dtsfc1 ) - write (0,*) 'sum(Interstitial%dtzm ) = ', sum(Interstitial%dtzm ) - write (0,*) 'sum(Interstitial%dt_mf ) = ', sum(Interstitial%dt_mf ) - write (0,*) 'sum(Interstitial%dudt ) = ', sum(Interstitial%dudt ) - write (0,*) 'sum(Interstitial%dusfcg ) = ', sum(Interstitial%dusfcg ) - write (0,*) 'sum(Interstitial%dusfc1 ) = ', sum(Interstitial%dusfc1 ) - write (0,*) 'sum(Interstitial%dvdftra ) = ', sum(Interstitial%dvdftra ) - write (0,*) 'sum(Interstitial%dvdt ) = ', sum(Interstitial%dvdt ) - write (0,*) 'sum(Interstitial%dvsfcg ) = ', sum(Interstitial%dvsfcg ) - write (0,*) 'sum(Interstitial%dvsfc1 ) = ', sum(Interstitial%dvsfc1 ) - write (0,*) 'sum(Interstitial%dzlyr ) = ', sum(Interstitial%dzlyr ) - write (0,*) 'sum(Interstitial%elvmax ) = ', sum(Interstitial%elvmax ) - write (0,*) 'sum(Interstitial%ep1d ) = ', sum(Interstitial%ep1d ) - write (0,*) 'sum(Interstitial%ep1d_ice ) = ', sum(Interstitial%ep1d_ice ) - write (0,*) 'sum(Interstitial%ep1d_land ) = ', sum(Interstitial%ep1d_land ) - write (0,*) 'sum(Interstitial%ep1d_water ) = ', sum(Interstitial%ep1d_water ) - write (0,*) 'sum(Interstitial%evap_ice ) = ', sum(Interstitial%evap_ice ) - write (0,*) 'sum(Interstitial%evap_land ) = ', sum(Interstitial%evap_land ) - write (0,*) 'sum(Interstitial%evap_water ) = ', sum(Interstitial%evap_water ) - write (0,*) 'sum(Interstitial%evbs ) = ', sum(Interstitial%evbs ) - write (0,*) 'sum(Interstitial%evcw ) = ', sum(Interstitial%evcw ) - write (0,*) 'sum(Interstitial%faerlw ) = ', sum(Interstitial%faerlw ) - write (0,*) 'sum(Interstitial%faersw ) = ', sum(Interstitial%faersw ) - write (0,*) 'sum(Interstitial%ffhh_ice ) = ', sum(Interstitial%ffhh_ice ) - write (0,*) 'sum(Interstitial%ffhh_land ) = ', sum(Interstitial%ffhh_land ) - write (0,*) 'sum(Interstitial%ffhh_water ) = ', sum(Interstitial%ffhh_water ) - write (0,*) 'sum(Interstitial%fh2 ) = ', sum(Interstitial%fh2 ) - write (0,*) 'sum(Interstitial%fh2_ice ) = ', sum(Interstitial%fh2_ice ) - write (0,*) 'sum(Interstitial%fh2_land ) = ', sum(Interstitial%fh2_land ) - write (0,*) 'sum(Interstitial%fh2_water ) = ', sum(Interstitial%fh2_water ) - write (0,*) 'Interstitial%flag_cice(1) = ', Interstitial%flag_cice(1) - write (0,*) 'Interstitial%flag_guess(1) = ', Interstitial%flag_guess(1) - write (0,*) 'Interstitial%flag_iter(1) = ', Interstitial%flag_iter(1) - write (0,*) 'sum(Interstitial%ffmm_ice ) = ', sum(Interstitial%ffmm_ice ) - write (0,*) 'sum(Interstitial%ffmm_land ) = ', sum(Interstitial%ffmm_land ) - write (0,*) 'sum(Interstitial%ffmm_water ) = ', sum(Interstitial%ffmm_water ) - write (0,*) 'sum(Interstitial%fm10 ) = ', sum(Interstitial%fm10 ) - write (0,*) 'sum(Interstitial%fm10_ice ) = ', sum(Interstitial%fm10_ice ) - write (0,*) 'sum(Interstitial%fm10_land ) = ', sum(Interstitial%fm10_land ) - write (0,*) 'sum(Interstitial%fm10_water ) = ', sum(Interstitial%fm10_water ) - write (0,*) 'Interstitial%frain = ', Interstitial%frain - write (0,*) 'sum(Interstitial%frland ) = ', sum(Interstitial%frland ) - write (0,*) 'sum(Interstitial%fscav ) = ', sum(Interstitial%fscav ) - write (0,*) 'sum(Interstitial%fswtr ) = ', sum(Interstitial%fswtr ) - write (0,*) 'sum(Interstitial%gabsbdlw ) = ', sum(Interstitial%gabsbdlw ) - write (0,*) 'sum(Interstitial%gabsbdlw_ice ) = ', sum(Interstitial%gabsbdlw_ice ) - write (0,*) 'sum(Interstitial%gabsbdlw_land ) = ', sum(Interstitial%gabsbdlw_land ) - write (0,*) 'sum(Interstitial%gabsbdlw_water ) = ', sum(Interstitial%gabsbdlw_water ) - write (0,*) 'sum(Interstitial%gamma ) = ', sum(Interstitial%gamma ) - write (0,*) 'sum(Interstitial%gamq ) = ', sum(Interstitial%gamq ) - write (0,*) 'sum(Interstitial%gamt ) = ', sum(Interstitial%gamt ) - write (0,*) 'sum(Interstitial%gasvmr ) = ', sum(Interstitial%gasvmr ) - write (0,*) 'sum(Interstitial%gflx ) = ', sum(Interstitial%gflx ) - write (0,*) 'sum(Interstitial%gflx_ice ) = ', sum(Interstitial%gflx_ice ) - write (0,*) 'sum(Interstitial%gflx_land ) = ', sum(Interstitial%gflx_land ) - write (0,*) 'sum(Interstitial%gflx_water ) = ', sum(Interstitial%gflx_water ) - write (0,*) 'sum(Interstitial%gwdcu ) = ', sum(Interstitial%gwdcu ) - write (0,*) 'sum(Interstitial%gwdcv ) = ', sum(Interstitial%gwdcv ) - write (0,*) 'sum(Interstitial%zvfun ) = ', sum(Interstitial%zvfun ) - write (0,*) 'sum(Interstitial%hffac ) = ', sum(Interstitial%hffac ) - write (0,*) 'sum(Interstitial%hflxq ) = ', sum(Interstitial%hflxq ) - write (0,*) 'sum(Interstitial%hflx_ice ) = ', sum(Interstitial%hflx_ice ) - write (0,*) 'sum(Interstitial%hflx_land ) = ', sum(Interstitial%hflx_land ) - write (0,*) 'sum(Interstitial%hflx_water ) = ', sum(Interstitial%hflx_water ) - write (0,*) 'sum(Interstitial%htlwc ) = ', sum(Interstitial%htlwc ) - write (0,*) 'sum(Interstitial%htlw0 ) = ', sum(Interstitial%htlw0 ) - write (0,*) 'sum(Interstitial%htswc ) = ', sum(Interstitial%htswc ) - write (0,*) 'sum(Interstitial%htsw0 ) = ', sum(Interstitial%htsw0 ) - write (0,*) 'Interstitial%dry(:)==.true. = ', count(Interstitial%dry(:) ) - write (0,*) 'sum(Interstitial%idxday ) = ', sum(Interstitial%idxday ) - write (0,*) 'Interstitial%icy(:)==.true. = ', count(Interstitial%icy(:) ) - write (0,*) 'Interstitial%lake(:)==.true. = ', count(Interstitial%lake(:) ) - write (0,*) 'Interstitial%use_flake(:)==.true. = ', count(Interstitial%use_flake(:) ) - write (0,*) 'Interstitial%ocean(:)==.true. = ', count(Interstitial%ocean(:) ) - write (0,*) 'sum(Interstitial%islmsk ) = ', sum(Interstitial%islmsk ) - write (0,*) 'sum(Interstitial%islmsk_cice ) = ', sum(Interstitial%islmsk_cice ) - write (0,*) 'Interstitial%wet(:)==.true. = ', count(Interstitial%wet(:) ) - write (0,*) 'Interstitial%kb = ', Interstitial%kb - write (0,*) 'sum(Interstitial%kbot ) = ', sum(Interstitial%kbot ) - write (0,*) 'sum(Interstitial%kcnv ) = ', sum(Interstitial%kcnv ) - write (0,*) 'Interstitial%kd = ', Interstitial%kd - write (0,*) 'sum(Interstitial%kinver ) = ', sum(Interstitial%kinver ) - write (0,*) 'sum(Interstitial%kpbl ) = ', sum(Interstitial%kpbl ) - write (0,*) 'Interstitial%kt = ', Interstitial%kt - write (0,*) 'sum(Interstitial%ktop ) = ', sum(Interstitial%ktop ) - write (0,*) 'sum(Interstitial%mbota ) = ', sum(Interstitial%mbota ) - write (0,*) 'sum(Interstitial%mtopa ) = ', sum(Interstitial%mtopa ) - write (0,*) 'Interstitial%nday = ', Interstitial%nday - write (0,*) 'sum(Interstitial%oa4 ) = ', sum(Interstitial%oa4 ) - write (0,*) 'sum(Interstitial%oc ) = ', sum(Interstitial%oc ) - write (0,*) 'sum(Interstitial%olyr ) = ', sum(Interstitial%olyr ) - write (0,*) 'sum(Interstitial%plvl ) = ', sum(Interstitial%plvl ) - write (0,*) 'sum(Interstitial%plyr ) = ', sum(Interstitial%plyr ) - write (0,*) 'sum(Interstitial%prcpmp ) = ', sum(Interstitial%prcpmp ) - write (0,*) 'sum(Interstitial%prnum ) = ', sum(Interstitial%prnum ) - write (0,*) 'sum(Interstitial%qlyr ) = ', sum(Interstitial%qlyr ) - write (0,*) 'sum(Interstitial%qss_ice ) = ', sum(Interstitial%qss_ice ) - write (0,*) 'sum(Interstitial%qss_land ) = ', sum(Interstitial%qss_land ) - write (0,*) 'sum(Interstitial%qss_water ) = ', sum(Interstitial%qss_water ) - write (0,*) 'Interstitial%radar_reset = ', Interstitial%radar_reset - write (0,*) 'Interstitial%raddt = ', Interstitial%raddt - write (0,*) 'sum(Interstitial%raincd ) = ', sum(Interstitial%raincd ) - write (0,*) 'sum(Interstitial%raincs ) = ', sum(Interstitial%raincs ) - write (0,*) 'sum(Interstitial%rainmcadj ) = ', sum(Interstitial%rainmcadj ) - write (0,*) 'sum(Interstitial%rainp ) = ', sum(Interstitial%rainp ) - write (0,*) 'sum(Interstitial%rb ) = ', sum(Interstitial%rb ) - write (0,*) 'sum(Interstitial%rb_ice ) = ', sum(Interstitial%rb_ice ) - write (0,*) 'sum(Interstitial%rb_land ) = ', sum(Interstitial%rb_land ) - write (0,*) 'sum(Interstitial%rb_water ) = ', sum(Interstitial%rb_water ) - write (0,*) 'Interstitial%max_hourly_reset = ', Interstitial%max_hourly_reset - write (0,*) 'Interstitial%ext_diag_thompson_reset = ', Interstitial%ext_diag_thompson_reset - write (0,*) 'sum(Interstitial%rhc ) = ', sum(Interstitial%rhc ) - write (0,*) 'sum(Interstitial%runoff ) = ', sum(Interstitial%runoff ) - write (0,*) 'sum(Interstitial%save_q ) = ', sum(Interstitial%save_q ) - write (0,*) 'sum(Interstitial%save_t ) = ', sum(Interstitial%save_t ) - write (0,*) 'sum(Interstitial%save_tcp ) = ', sum(Interstitial%save_tcp ) - write (0,*) 'sum(Interstitial%save_u ) = ', sum(Interstitial%save_u ) - write (0,*) 'sum(Interstitial%save_v ) = ', sum(Interstitial%save_v ) - write (0,*) 'sum(Interstitial%sbsno ) = ', sum(Interstitial%sbsno ) - write (0,*) 'sum(Interstitial%scmpsw%uvbfc ) = ', sum(Interstitial%scmpsw%uvbfc ) - write (0,*) 'sum(Interstitial%scmpsw%uvbf0 ) = ', sum(Interstitial%scmpsw%uvbf0 ) - write (0,*) 'sum(Interstitial%scmpsw%nirbm ) = ', sum(Interstitial%scmpsw%nirbm ) - write (0,*) 'sum(Interstitial%scmpsw%nirdf ) = ', sum(Interstitial%scmpsw%nirdf ) - write (0,*) 'sum(Interstitial%scmpsw%visbm ) = ', sum(Interstitial%scmpsw%visbm ) - write (0,*) 'sum(Interstitial%scmpsw%visdf ) = ', sum(Interstitial%scmpsw%visdf ) - write (0,*) 'sum(Interstitial%semis_ice ) = ', sum(Interstitial%semis_ice ) - write (0,*) 'sum(Interstitial%semis_land ) = ', sum(Interstitial%semis_land ) - write (0,*) 'sum(Interstitial%semis_water ) = ', sum(Interstitial%semis_water ) - write (0,*) 'sum(Interstitial%sfcalb ) = ', sum(Interstitial%sfcalb ) - write (0,*) 'sum(Interstitial%sigma ) = ', sum(Interstitial%sigma ) - write (0,*) 'sum(Interstitial%sigmaf ) = ', sum(Interstitial%sigmaf ) - write (0,*) 'sum(Interstitial%sigmafrac ) = ', sum(Interstitial%sigmafrac ) - write (0,*) 'sum(Interstitial%sigmatot ) = ', sum(Interstitial%sigmatot ) - write (0,*) 'sum(Interstitial%slopetype ) = ', sum(Interstitial%slopetype ) - write (0,*) 'sum(Interstitial%snowc ) = ', sum(Interstitial%snowc ) - write (0,*) 'sum(Interstitial%snowd_ice ) = ', sum(Interstitial%snowd_ice ) -! write (0,*) 'sum(Interstitial%snowd_land ) = ', sum(Interstitial%snowd_land ) -! write (0,*) 'sum(Interstitial%snowd_water ) = ', sum(Interstitial%snowd_water ) - write (0,*) 'sum(Interstitial%snohf ) = ', sum(Interstitial%snohf ) - write (0,*) 'sum(Interstitial%snowmt ) = ', sum(Interstitial%snowmt ) - write (0,*) 'sum(Interstitial%soiltype ) = ', sum(Interstitial%soiltype ) - write (0,*) 'sum(Interstitial%stress ) = ', sum(Interstitial%stress ) - write (0,*) 'sum(Interstitial%stress_ice ) = ', sum(Interstitial%stress_ice ) - write (0,*) 'sum(Interstitial%stress_land ) = ', sum(Interstitial%stress_land ) - write (0,*) 'sum(Interstitial%stress_water ) = ', sum(Interstitial%stress_water ) - write (0,*) 'sum(Interstitial%theta ) = ', sum(Interstitial%theta ) - write (0,*) 'sum(Interstitial%tlvl ) = ', sum(Interstitial%tlvl ) - write (0,*) 'sum(Interstitial%tlyr ) = ', sum(Interstitial%tlyr ) - write (0,*) 'sum(Interstitial%tprcp_ice ) = ', sum(Interstitial%tprcp_ice ) - write (0,*) 'sum(Interstitial%tprcp_land ) = ', sum(Interstitial%tprcp_land ) - write (0,*) 'sum(Interstitial%tprcp_water ) = ', sum(Interstitial%tprcp_water ) - write (0,*) 'sum(Interstitial%trans ) = ', sum(Interstitial%trans ) - write (0,*) 'sum(Interstitial%tseal ) = ', sum(Interstitial%tseal ) - write (0,*) 'sum(Interstitial%tsfa ) = ', sum(Interstitial%tsfa ) - write (0,*) 'sum(Interstitial%tsfc_ice ) = ', sum(Interstitial%tsfc_ice ) - write (0,*) 'sum(Interstitial%tsfc_water ) = ', sum(Interstitial%tsfc_water ) - write (0,*) 'sum(Interstitial%tsfg ) = ', sum(Interstitial%tsfg ) - write (0,*) 'sum(Interstitial%tsurf_ice ) = ', sum(Interstitial%tsurf_ice ) - write (0,*) 'sum(Interstitial%tsurf_land ) = ', sum(Interstitial%tsurf_land ) - write (0,*) 'sum(Interstitial%tsurf_water ) = ', sum(Interstitial%tsurf_water ) - write (0,*) 'sum(Interstitial%ud_mf ) = ', sum(Interstitial%ud_mf ) - write (0,*) 'sum(Interstitial%uustar_ice ) = ', sum(Interstitial%uustar_ice ) - write (0,*) 'sum(Interstitial%uustar_land ) = ', sum(Interstitial%uustar_land ) - write (0,*) 'sum(Interstitial%uustar_water ) = ', sum(Interstitial%uustar_water ) - write (0,*) 'sum(Interstitial%vdftra ) = ', sum(Interstitial%vdftra ) - write (0,*) 'sum(Interstitial%vegf1d ) = ', sum(Interstitial%vegf1d ) - write (0,*) 'sum(Interstitial%vegtype ) = ', sum(Interstitial%vegtype ) - write (0,*) 'sum(Interstitial%wcbmax ) = ', sum(Interstitial%wcbmax ) - write (0,*) 'sum(Interstitial%weasd_ice ) = ', sum(Interstitial%weasd_ice ) -! write (0,*) 'sum(Interstitial%weasd_land ) = ', sum(Interstitial%weasd_land ) -! write (0,*) 'sum(Interstitial%weasd_water ) = ', sum(Interstitial%weasd_water ) - write (0,*) 'sum(Interstitial%wind ) = ', sum(Interstitial%wind ) - write (0,*) 'sum(Interstitial%work1 ) = ', sum(Interstitial%work1 ) - write (0,*) 'sum(Interstitial%work2 ) = ', sum(Interstitial%work2 ) - write (0,*) 'sum(Interstitial%work3 ) = ', sum(Interstitial%work3 ) - write (0,*) 'sum(Interstitial%xcosz ) = ', sum(Interstitial%xcosz ) - write (0,*) 'sum(Interstitial%xlai1d ) = ', sum(Interstitial%xlai1d ) - write (0,*) 'sum(Interstitial%xmu ) = ', sum(Interstitial%xmu ) - write (0,*) 'sum(Interstitial%z01d ) = ', sum(Interstitial%z01d ) - write (0,*) 'sum(Interstitial%zt1d ) = ', sum(Interstitial%zt1d ) - -! UGWP common - write (0,*) 'sum(Interstitial%tau_mtb ) = ', sum(Interstitial%tau_mtb ) - write (0,*) 'sum(Interstitial%tau_ogw ) = ', sum(Interstitial%tau_ogw ) - write (0,*) 'sum(Interstitial%tau_tofd ) = ', sum(Interstitial%tau_tofd ) - write (0,*) 'sum(Interstitial%tau_ngw ) = ', sum(Interstitial%tau_ngw ) - write (0,*) 'sum(Interstitial%tau_oss ) = ', sum(Interstitial%tau_oss ) - write (0,*) 'sum(Interstitial%dudt_mtb ) = ', sum(Interstitial%dudt_mtb ) - write (0,*) 'sum(Interstitial%dudt_tms ) = ', sum(Interstitial%dudt_tms ) - write (0,*) 'sum(Interstitial%zmtb ) = ', sum(Interstitial%zmtb ) - write (0,*) 'sum(Interstitial%zlwb ) = ', sum(Interstitial%zlwb ) - write (0,*) 'sum(Interstitial%zogw ) = ', sum(Interstitial%zogw ) - write (0,*) 'sum(Interstitial%zngw ) = ', sum(Interstitial%zngw ) - -! UGWP v1 - if (Model%do_ugwp_v1) then - write (0,*) 'sum(Interstitial%dudt_ngw ) = ', sum(Interstitial%dudt_ngw ) - write (0,*) 'sum(Interstitial%dvdt_ngw ) = ', sum(Interstitial%dvdt_ngw ) - write (0,*) 'sum(Interstitial%dtdt_ngw ) = ', sum(Interstitial%dtdt_ngw ) - write (0,*) 'sum(Interstitial%kdis_ngw ) = ', sum(Interstitial%kdis_ngw ) - end if -!-- GSL drag suite - if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & - Model%gwd_opt==2 .or. Model%gwd_opt==22) then - write (0,*) 'sum(Interstitial%varss ) = ', sum(Interstitial%varss) - write (0,*) 'sum(Interstitial%ocss ) = ', sum(Interstitial%ocss) - write (0,*) 'sum(Interstitial%oa4ss ) = ', sum(Interstitial%oa4ss) - write (0,*) 'sum(Interstitial%clxss ) = ', sum(Interstitial%clxss) - end if -! - ! Print arrays that are conditional on physics choices - if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then - write (0,*) 'Interstitial_print: values specific to GFDL/Thompson microphysics' - write (0,*) 'sum(Interstitial%graupelmp ) = ', sum(Interstitial%graupelmp ) - write (0,*) 'sum(Interstitial%icemp ) = ', sum(Interstitial%icemp ) - write (0,*) 'sum(Interstitial%rainmp ) = ', sum(Interstitial%rainmp ) - write (0,*) 'sum(Interstitial%snowmp ) = ', sum(Interstitial%snowmp ) - !F-A scheme - else if (Model%imp_physics == Model%imp_physics_fer_hires) then - write (0,*) 'Interstitial_print: values specific to F-A microphysics' - write (0,*) 'sum(Interstitial%f_ice ) = ', sum(Interstitial%f_ice ) - write (0,*) 'sum(Interstitial%f_rain ) = ', sum(Interstitial%f_rain ) - write (0,*) 'sum(Interstitial%f_rimef ) = ', sum(Interstitial%f_rimef ) - write (0,*) 'sum(Interstitial%cwm ) = ', sum(Interstitial%cwm ) - else if (Model%imp_physics == Model%imp_physics_mg) then - write (0,*) 'Interstitial_print: values specific to MG microphysics' - write (0,*) 'sum(Interstitial%ncgl ) = ', sum(Interstitial%ncgl ) - write (0,*) 'sum(Interstitial%ncpr ) = ', sum(Interstitial%ncpr ) - write (0,*) 'sum(Interstitial%ncps ) = ', sum(Interstitial%ncps ) - write (0,*) 'sum(Interstitial%qgl ) = ', sum(Interstitial%qgl ) - write (0,*) 'sum(Interstitial%qrn ) = ', sum(Interstitial%qrn ) - write (0,*) 'sum(Interstitial%qsnw ) = ', sum(Interstitial%qsnw ) - write (0,*) 'sum(Interstitial%qlcn ) = ', sum(Interstitial%qlcn ) - write (0,*) 'sum(Interstitial%qicn ) = ', sum(Interstitial%qicn ) - write (0,*) 'sum(Interstitial%w_upi ) = ', sum(Interstitial%w_upi ) - write (0,*) 'sum(Interstitial%cf_upi ) = ', sum(Interstitial%cf_upi ) - write (0,*) 'sum(Interstitial%cnv_mfd ) = ', sum(Interstitial%cnv_mfd ) - write (0,*) 'sum(Interstitial%cnv_dqldt ) = ', sum(Interstitial%cnv_dqldt ) - write (0,*) 'sum(Interstitial%clcn ) = ', sum(Interstitial%clcn ) - write (0,*) 'sum(Interstitial%cnv_fice ) = ', sum(Interstitial%cnv_fice ) - write (0,*) 'sum(Interstitial%cnv_ndrop ) = ', sum(Interstitial%cnv_ndrop ) - write (0,*) 'sum(Interstitial%cnv_nice ) = ', sum(Interstitial%cnv_nice ) - end if - if (Model%do_shoc) then - write (0,*) 'Interstitial_print: values specific to SHOC' - write (0,*) 'sum(Interstitial%ncgl ) = ', sum(Interstitial%ncgl ) - write (0,*) 'sum(Interstitial%qrn ) = ', sum(Interstitial%qrn ) - write (0,*) 'sum(Interstitial%qsnw ) = ', sum(Interstitial%qsnw ) - write (0,*) 'sum(Interstitial%qgl ) = ', sum(Interstitial%qgl ) - write (0,*) 'sum(Interstitial%ncpi ) = ', sum(Interstitial%ncpi ) - write (0,*) 'sum(Interstitial%ncpl ) = ', sum(Interstitial%ncpl ) - end if - if (Model%lsm == Model%lsm_noahmp) then - write (0,*) 'sum(Interstitial%t2mmp ) = ', sum(Interstitial%t2mmp ) - write (0,*) 'sum(Interstitial%q2mp ) = ', sum(Interstitial%q2mp ) - end if - if (Model%lsm == Model%lsm_noah_wrfv4) then - write (0,*) 'sum(Interstitial%canopy_save ) = ', sum(Interstitial%canopy_save ) - write (0,*) 'sum(Interstitial%chk_land ) = ', sum(Interstitial%chk_land ) - write (0,*) 'sum(Interstitial%cmc ) = ', sum(Interstitial%cmc ) - write (0,*) 'sum(Interstitial%dqsdt2 ) = ', sum(Interstitial%dqsdt2 ) - write (0,*) 'sum(Interstitial%drain_in_m_sm1 ) = ', sum(Interstitial%drain_in_m_sm1 ) - write (0,*) 'Interstitial%flag_lsm(1) = ', Interstitial%flag_lsm(1) - write (0,*) 'Interstitial%flag_lsm_glacier(1) = ', Interstitial%flag_lsm_glacier(1) - write (0,*) 'sum(Interstitial%qs1 ) = ', sum(Interstitial%qs1 ) - write (0,*) 'sum(Interstitial%qv1 ) = ', sum(Interstitial%qv1 ) - write (0,*) 'sum(Interstitial%rho1 ) = ', sum(Interstitial%rho1 ) - write (0,*) 'sum(Interstitial%runoff_in_m_sm1 ) = ', sum(Interstitial%runoff_in_m_sm1 ) - write (0,*) 'sum(Interstitial%smcmax ) = ', sum(Interstitial%smcmax ) - write (0,*) 'sum(Interstitial%snowd_land_save ) = ', sum(Interstitial%snowd_land_save ) - write (0,*) 'sum(Interstitial%snow_depth ) = ', sum(Interstitial%snow_depth ) - write (0,*) 'sum(Interstitial%snohf_snow ) = ', sum(Interstitial%snohf_snow ) - write (0,*) 'sum(Interstitial%snohf_frzgra ) = ', sum(Interstitial%snohf_frzgra ) - write (0,*) 'sum(Interstitial%snohf_snowmelt ) = ', sum(Interstitial%snohf_snowmelt ) - write (0,*) 'sum(Interstitial%soilm_in_m ) = ', sum(Interstitial%soilm_in_m ) - write (0,*) 'sum(Interstitial%th1 ) = ', sum(Interstitial%th1 ) - write (0,*) 'sum(Interstitial%tprcp_rate_land ) = ', sum(Interstitial%tprcp_rate_land ) - write (0,*) 'sum(Interstitial%tsfc_land_save ) = ', sum(Interstitial%tsfc_land_save ) - write (0,*) 'sum(Interstitial%weasd_land_save ) = ', sum(Interstitial%weasd_land_save ) - end if - ! RRTMGP - if (Model%do_RRTMGP) then - write (0,*) 'sum(Interstitial%aerosolslw ) = ', sum(Interstitial%aerosolslw ) - write (0,*) 'sum(Interstitial%aerosolssw ) = ', sum(Interstitial%aerosolssw ) - write (0,*) 'sum(Interstitial%cld_frac ) = ', sum(Interstitial%cld_frac ) - write (0,*) 'sum(Interstitial%cld_lwp ) = ', sum(Interstitial%cld_lwp ) - write (0,*) 'sum(Interstitial%cld_reliq ) = ', sum(Interstitial%cld_reliq ) - write (0,*) 'sum(Interstitial%cld_iwp ) = ', sum(Interstitial%cld_iwp ) - write (0,*) 'sum(Interstitial%cld_reice ) = ', sum(Interstitial%cld_reice ) - write (0,*) 'sum(Interstitial%cld_swp ) = ', sum(Interstitial%cld_swp ) - write (0,*) 'sum(Interstitial%cld_resnow ) = ', sum(Interstitial%cld_resnow ) - write (0,*) 'sum(Interstitial%cld_rwp ) = ', sum(Interstitial%cld_rwp ) - write (0,*) 'sum(Interstitial%cld_rerain ) = ', sum(Interstitial%cld_rerain ) - write (0,*) 'sum(Interstitial%precip_frac ) = ', sum(Interstitial%precip_frac ) - write (0,*) 'sum(Interstitial%icseed_lw ) = ', sum(Interstitial%icseed_lw ) - write (0,*) 'sum(Interstitial%icseed_sw ) = ', sum(Interstitial%icseed_sw ) - write (0,*) 'sum(Interstitial%fluxlwUP_clrsky ) = ', sum(Interstitial%fluxlwUP_clrsky ) - write (0,*) 'sum(Interstitial%fluxlwDOWN_clrsky ) = ', sum(Interstitial%fluxlwDOWN_clrsky) - write (0,*) 'sum(Interstitial%fluxswUP_allsky ) = ', sum(Interstitial%fluxswUP_allsky ) - write (0,*) 'sum(Interstitial%fluxswDOWN_allsky ) = ', sum(Interstitial%fluxswDOWN_allsky) - write (0,*) 'sum(Interstitial%fluxswUP_clrsky ) = ', sum(Interstitial%fluxswUP_clrsky ) - write (0,*) 'sum(Interstitial%fluxswDOWN_clrsky ) = ', sum(Interstitial%fluxswDOWN_clrsky) - write (0,*) 'sum(Interstitial%relhum ) = ', sum(Interstitial%relhum ) - write (0,*) 'sum(Interstitial%q_lay ) = ', sum(Interstitial%q_lay ) - write (0,*) 'sum(Interstitial%qs_lay ) = ', sum(Interstitial%qs_lay ) - write (0,*) 'sum(Interstitial%deltaZ ) = ', sum(Interstitial%deltaZ ) - write (0,*) 'sum(Interstitial%p_lay ) = ', sum(Interstitial%p_lay ) - write (0,*) 'sum(Interstitial%p_lev ) = ', sum(Interstitial%p_lev ) - write (0,*) 'sum(Interstitial%t_lay ) = ', sum(Interstitial%t_lay ) - write (0,*) 'sum(Interstitial%t_lev ) = ', sum(Interstitial%t_lev ) - write (0,*) 'sum(Interstitial%tv_lay ) = ', sum(Interstitial%tv_lay ) - write (0,*) 'sum(Interstitial%cloud_overlap_param ) = ', sum(Interstitial%cloud_overlap_param) - write (0,*) 'sum(Interstitial%precip_overlap_param ) = ', sum(Interstitial%precip_overlap_param) - end if - - write (0,*) 'Interstitial_print: end' - ! - end subroutine interstitial_print - end module GFS_typedefs diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 2e1f76a7c..f623a8027 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -697,12 +697,17 @@ type = real kind = kind_phys [slope] - standard_name = surface_slope_classification_real + standard_name = surface_slope_classification long_name = sfc slope type for lsm units = index dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys + type = integer +[slope_save] + standard_name = surface_slope_classification_save + long_name = sfc slope type for lsm save + units = index + dimensions = (horizontal_loop_extent) + type = integer [shdmin] standard_name = min_vegetation_area_fraction long_name = min fractional coverage of green vegetation @@ -732,19 +737,29 @@ type = real kind = kind_phys [vtype] - standard_name = vegetation_type_classification_real + standard_name = vegetation_type_classification long_name = vegetation type for lsm units = index dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys + type = integer +[vtype_save] + standard_name = vegetation_type_classification_save + long_name = vegetation type for lsm save + units = index + dimensions = (horizontal_loop_extent) + type = integer [stype] - standard_name = soil_type_classification_real + standard_name = soil_type_classification long_name = soil type for lsm units = index dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys + type = integer +[stype_save] + standard_name = soil_type_classification_save + long_name = soil type for lsm save + units = index + dimensions = (horizontal_loop_extent) + type = integer [uustar] standard_name = surface_friction_velocity long_name = boundary layer parameter @@ -9484,12 +9499,6 @@ type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_noah_wrfv4_land_surface_scheme) -[slopetype] - standard_name = surface_slope_classification - long_name = surface slope type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer [smcmax] standard_name = soil_porosity long_name = volumetric soil porosity @@ -9590,12 +9599,6 @@ type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_noah_wrfv4_land_surface_scheme) -[soiltype] - standard_name = soil_type_classification - long_name = soil type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer [stc_save] standard_name = soil_temperature_save long_name = soil temperature before entering a physics scheme @@ -9842,12 +9845,6 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[vegtype] - standard_name = vegetation_type_classification - long_name = vegetation type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 4287b4acb..be79b5963 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -20,6 +20,7 @@ module GFS_diagnostics !--- private data type definition --- type data_subtype + integer, dimension(:), pointer :: int2 => NULL() real(kind=kind_phys), dimension(:), pointer :: var2 => NULL() real(kind=kind_phys), dimension(:), pointer :: var21 => NULL() real(kind=kind_phys), dimension(:,:), pointer :: var3 => NULL() @@ -113,6 +114,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ! ExtDiag%mask [char*64 ] description of mask-type ! ! ExtDiag%intpl_method [char*64 ] method to use for interpolation ! ! ExtDiag%cnvfac [real*8 ] conversion factor to output specified units ! +! ExtDiag%data(nb)%int2(:) [integer ] pointer to 2D data [=> null() for a 3D field] ! ! ExtDiag%data(nb)%var2(:) [real*8 ] pointer to 2D data [=> null() for a 3D field] ! ! ExtDiag%data(nb)%var21(:) [real*8 ] pointer to 2D data for ratios ! ! ExtDiag%data(nb)%var3(:,:) [real*8 ] pointer to 3D data [=> null() for a 2D field] ! @@ -2610,7 +2612,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%slope(:) + ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%slope(:) enddo idx = idx + 1 @@ -2724,7 +2726,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%stype(:) + ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%stype(:) enddo idx = idx + 1 @@ -2819,7 +2821,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%vtype(:) + ExtDiag(idx)%data(nb)%int2 => sfcprop(nb)%vtype(:) enddo idx = idx + 1 diff --git a/ccpp/physics b/ccpp/physics index 3c23577b9..2ececb085 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3c23577b97fa9e9b193543b39963dd538847833d +Subproject commit 2ececb085ba72f5dac6cf296e20771f1ae970a96 diff --git a/cpl/module_block_data.F90 b/cpl/module_block_data.F90 index f2f6fd4e8..02ef0ebc8 100644 --- a/cpl/module_block_data.F90 +++ b/cpl/module_block_data.F90 @@ -8,6 +8,7 @@ module module_block_data implicit none interface block_data_copy + module procedure block_copy_1d_i4_to_2d_r8 module procedure block_copy_1d_to_2d_r8 module procedure block_copy_2d_to_2d_r8 module procedure block_copy_2d_to_3d_r8 @@ -50,6 +51,40 @@ module module_block_data ! -- copy: 1D to 2D + subroutine block_copy_1d_i4_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + integer, 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 * real(source_ptr(ix), kind=kind_phys) + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_1d_i4_to_2d_r8 + subroutine block_copy_1d_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) ! -- arguments diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index ce6420fa4..7d5a84f4e 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -215,13 +215,13 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,14) = GFS_Data(nb)%Sfcprop%alnwf(ix) temp2d(i,j,15) = GFS_Data(nb)%Sfcprop%facsf(ix) temp2d(i,j,16) = GFS_Data(nb)%Sfcprop%facwf(ix) - temp2d(i,j,17) = GFS_Data(nb)%Sfcprop%slope(ix) + temp2d(i,j,17) = real(GFS_Data(nb)%Sfcprop%slope(ix), kind=kind_phys) temp2d(i,j,18) = GFS_Data(nb)%Sfcprop%shdmin(ix) temp2d(i,j,19) = GFS_Data(nb)%Sfcprop%shdmax(ix) temp2d(i,j,20) = GFS_Data(nb)%Sfcprop%tg3(ix) temp2d(i,j,21) = GFS_Data(nb)%Sfcprop%vfrac(ix) - temp2d(i,j,22) = GFS_Data(nb)%Sfcprop%vtype(ix) - temp2d(i,j,23) = GFS_Data(nb)%Sfcprop%stype(ix) + temp2d(i,j,22) = real(GFS_Data(nb)%Sfcprop%vtype(ix), kind=kind_phys) + temp2d(i,j,23) = real(GFS_Data(nb)%Sfcprop%stype(ix), kind=kind_phys) temp2d(i,j,24) = GFS_Data(nb)%Sfcprop%uustar(ix) temp2d(i,j,25) = GFS_Data(nb)%Sfcprop%oro(ix) temp2d(i,j,26) = GFS_Data(nb)%Sfcprop%oro_uf(ix) @@ -1142,8 +1142,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%f10m(ix) = sfc_var2(i,j,14) !--- f10m Sfcprop(nb)%t2m(ix) = sfc_var2(i,j,15) !--- t2m Sfcprop(nb)%q2m(ix) = sfc_var2(i,j,16) !--- q2m - Sfcprop(nb)%vtype(ix) = sfc_var2(i,j,17) !--- vtype - Sfcprop(nb)%stype(ix) = sfc_var2(i,j,18) !--- stype + Sfcprop(nb)%vtype(ix) = int(sfc_var2(i,j,17)) !--- vtype + Sfcprop(nb)%stype(ix) = int(sfc_var2(i,j,18)) !--- stype Sfcprop(nb)%uustar(ix) = sfc_var2(i,j,19) !--- uustar Sfcprop(nb)%ffmm(ix) = sfc_var2(i,j,20) !--- ffmm Sfcprop(nb)%ffhh(ix) = sfc_var2(i,j,21) !--- ffhh @@ -1155,7 +1155,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%snowd(ix) = sfc_var2(i,j,27) !--- snowd (snwdph in the file) Sfcprop(nb)%shdmin(ix) = sfc_var2(i,j,28) !--- shdmin Sfcprop(nb)%shdmax(ix) = sfc_var2(i,j,29) !--- shdmax - Sfcprop(nb)%slope(ix) = sfc_var2(i,j,30) !--- slope + Sfcprop(nb)%slope(ix) = int(sfc_var2(i,j,30)) !--- slope Sfcprop(nb)%snoalb(ix) = sfc_var2(i,j,31) !--- snoalb Sfcprop(nb)%sncovr(ix) = sfc_var2(i,j,32) !--- sncovr Sfcprop(nb)%snodl(ix) = sfc_var2(i,j,33) !--- snodl (snowd on land portion of a cell) @@ -1183,7 +1183,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif - if (nint(Sfcprop(nb)%stype(ix)) == 14 .or. int(Sfcprop(nb)%stype(ix)+0.5) <= 0) then + if (Sfcprop(nb)%stype(ix) == 14 .or. Sfcprop(nb)%stype(ix) <= 0) then Sfcprop(nb)%landfrac(ix) = zero Sfcprop(nb)%stype(ix) = 0 if (Sfcprop(nb)%lakefrac(ix) > zero) then @@ -1194,7 +1194,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Model%frac_grid) then if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) - if (Sfcprop(nb)%slmsk(ix) == 1 .and. nint(Sfcprop(nb)%stype(ix)) == 14) & + if (Sfcprop(nb)%slmsk(ix) == 1 .and. Sfcprop(nb)%stype(ix) == 14) & Sfcprop(nb)%slmsk(ix) = 0 if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell @@ -1245,7 +1245,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 else Sfcprop(nb)%slmsk(ix) = nint(Sfcprop(nb)%landfrac(ix)) - if (Sfcprop(nb)%stype(ix) <= 0 .or. nint(Sfcprop(nb)%stype(ix)) == 14) & + if (Sfcprop(nb)%stype(ix) <= 0 .or. Sfcprop(nb)%stype(ix) == 14) & Sfcprop(nb)%slmsk(ix) = zero if (nint(Sfcprop(nb)%slmsk(ix)) == 0) then Sfcprop(nb)%oceanfrac(ix) = one @@ -1260,7 +1260,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif else if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0 & - .and. nint(Sfcprop(nb)%stype(ix)) /= 14) then + .and. Sfcprop(nb)%stype(ix) /= 14) then Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = zero @@ -2034,8 +2034,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,14) = Sfcprop(nb)%f10m(ix) !--- f10m sfc_var2(i,j,15) = Sfcprop(nb)%t2m(ix) !--- t2m sfc_var2(i,j,16) = Sfcprop(nb)%q2m(ix) !--- q2m - sfc_var2(i,j,17) = Sfcprop(nb)%vtype(ix) !--- vtype - sfc_var2(i,j,18) = Sfcprop(nb)%stype(ix) !--- stype + sfc_var2(i,j,17) = real(Sfcprop(nb)%vtype(ix), kind=kind_phys) !--- vtype + sfc_var2(i,j,18) = real(Sfcprop(nb)%stype(ix), kind=kind_phys) !--- stype sfc_var2(i,j,19) = Sfcprop(nb)%uustar(ix)!--- uustar sfc_var2(i,j,20) = Sfcprop(nb)%ffmm(ix) !--- ffmm sfc_var2(i,j,21) = Sfcprop(nb)%ffhh(ix) !--- ffhh @@ -2047,7 +2047,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,27) = Sfcprop(nb)%snowd(ix) !--- snowd (snwdph in the file) sfc_var2(i,j,28) = Sfcprop(nb)%shdmin(ix)!--- shdmin sfc_var2(i,j,29) = Sfcprop(nb)%shdmax(ix)!--- shdmax - sfc_var2(i,j,30) = Sfcprop(nb)%slope(ix) !--- slope + sfc_var2(i,j,30) = real(Sfcprop(nb)%slope(ix), kind=kind_phys) !--- slope sfc_var2(i,j,31) = Sfcprop(nb)%snoalb(ix)!--- snoalb sfc_var2(i,j,32) = Sfcprop(nb)%sncovr(ix) !--- sncovr sfc_var2(i,j,33) = Sfcprop(nb)%snodl(ix) !--- snodl (snowd on land) @@ -2638,101 +2638,122 @@ subroutine fv3gfs_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & endif endif if (diag(idx)%axes == 2) then - if (trim(diag(idx)%mask) == 'positive_flux') then - !--- albedos are actually a ratio of two radiation surface properties - var2(1:nx,1:ny) = 0._kind_phys - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix) > 0._kind_phys) & - var2(i,j) = max(0._kind_phys,min(1._kind_phys,Diag(idx)%data(nb)%var2(ix)/Diag(idx)%data(nb)%var21(ix)))*lcnvfac + ! Integer data + int_or_real: if (associated(Diag(idx)%data(1)%int2)) then + if (trim(Diag(idx)%intpl_method) == 'nearest_stod') then + var2(1:nx,1:ny) = 0._kind_phys + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + var2(i,j) = real(Diag(idx)%data(nb)%int2(ix), kind=kind_phys) + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'land_ice_only') then - !--- need to "mask" gflux to output valid data over land/ice only - var2(1:nx,1:ny) = missing_value - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix) /= 0) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + call store_data(Diag(idx)%id, var2, Time, idx, Diag(idx)%intpl_method, Diag(idx)%name) + else + call mpp_error(FATAL, 'Interpolation method ' // trim(Diag(idx)%intpl_method) // ' for integer variable ' & + // trim(Diag(idx)%name) // ' not supported.') + endif + ! Real data + else ! int_or_real + if (trim(diag(idx)%mask) == 'positive_flux') then + !--- albedos are actually a ratio of two radiation surface properties + var2(1:nx,1:ny) = 0._kind_phys + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + if (Diag(idx)%data(nb)%var21(ix) > 0._kind_phys) & + var2(i,j) = max(0._kind_phys,min(1._kind_phys,Diag(idx)%data(nb)%var2(ix)/Diag(idx)%data(nb)%var21(ix)))*lcnvfac + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'land_only') then - !--- need to "mask" soilm to have value only over land - var2(1:nx,1:ny) = missing_value - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix) == 1) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + elseif (trim(Diag(idx)%mask) == 'land_ice_only') then + !--- need to "mask" gflux to output valid data over land/ice only + var2(1:nx,1:ny) = missing_value + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + if (Diag(idx)%data(nb)%var21(ix) /= 0) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'cldmask') then - !--- need to "mask" soilm to have value only over land - var2(1:nx,1:ny) = missing_value - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix)*100. > 0.5) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + elseif (trim(Diag(idx)%mask) == 'land_only') then + !--- need to "mask" soilm to have value only over land + var2(1:nx,1:ny) = missing_value + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + if (Diag(idx)%data(nb)%var21(ix) == 1) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'cldmask_ratio') then - !--- need to "mask" soilm to have value only over land - var2(1:nx,1:ny) = missing_value - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix)*100.*lcnvfac > 0.5) var2(i,j) = Diag(idx)%data(nb)%var2(ix)/ & - Diag(idx)%data(nb)%var21(ix) + elseif (trim(Diag(idx)%mask) == 'cldmask') then + !--- need to "mask" soilm to have value only over land + var2(1:nx,1:ny) = missing_value + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + if (Diag(idx)%data(nb)%var21(ix)*100. > 0.5) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'pseudo_ps') then - if ( use_wrtgridcomp_output ) then + elseif (trim(Diag(idx)%mask) == 'cldmask_ratio') then + !--- need to "mask" soilm to have value only over land + var2(1:nx,1:ny) = missing_value do j = 1, ny jj = j + jsc -1 do i = 1, nx ii = i + isc -1 nb = Atm_block%blkno(ii,jj) ix = Atm_block%ixp(ii,jj) - var2(i,j) = (Diag(idx)%data(nb)%var2(ix)/stndrd_atmos_ps)**(rdgas/grav*stndrd_atmos_lapse) + if (Diag(idx)%data(nb)%var21(ix)*100.*lcnvfac > 0.5) var2(i,j) = Diag(idx)%data(nb)%var2(ix)/ & + Diag(idx)%data(nb)%var21(ix) enddo enddo - else + elseif (trim(Diag(idx)%mask) == 'pseudo_ps') then + if ( use_wrtgridcomp_output ) then + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + var2(i,j) = (Diag(idx)%data(nb)%var2(ix)/stndrd_atmos_ps)**(rdgas/grav*stndrd_atmos_lapse) + enddo + enddo + else + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + var2(i,j) = Diag(idx)%data(nb)%var2(ix) + enddo + enddo + endif + elseif (trim(Diag(idx)%mask) == '') then do j = 1, ny jj = j + jsc -1 do i = 1, nx ii = i + isc -1 nb = Atm_block%blkno(ii,jj) ix = Atm_block%ixp(ii,jj) - var2(i,j) = Diag(idx)%data(nb)%var2(ix) + var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac enddo enddo endif - elseif (trim(Diag(idx)%mask) == '') then - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac - enddo - enddo - endif + endif int_or_real ! used=send_data(Diag(idx)%id, var2, Time) ! print *,'in phys, after store_data, idx=',idx,' var=', trim(Diag(idx)%name) call store_data(Diag(idx)%id, var2, Time, idx, Diag(idx)%intpl_method, Diag(idx)%name)