diff --git a/atmos_model.F90 b/atmos_model.F90 index 5468249f3..1810a38f7 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -205,7 +205,7 @@ module atmos_model_mod ! GFS containers !---------------- type(GFS_externaldiag_type), target :: GFS_Diag(DIAG_SIZE) -type(GFS_restart_type) :: GFS_restart_var +type(GFS_restart_type) , allocatable, target :: GFS_restart_var(:) !-------------- ! IAU container @@ -1023,7 +1023,7 @@ subroutine update_atmos_model_state (Atmos, rc) call atmosphere_nggps_diag(Atmos%Time) call fv3atm_diag_output(Atmos%Time, GFS_Diag, Atm_block, GFS_control%nx, GFS_control%ny, & GFS_control%levs, 1, 1, 1.0_GFS_kind_phys, time_int, time_intfull, & - GFS_control%fhswr, GFS_control%fhlwr) + GFS_control%fhswr, GFS_control%fhlwr, GFS_control) endif !--- find current fhzero @@ -1153,7 +1153,7 @@ subroutine atmos_model_restart(Atmos, timestamp) if (quilting_restart) then call fv_sfc_restart_output(GFS_sfcprop, Atm_block, GFS_control) - call fv_phy_restart_output(GFS_restart_var, Atm_block) + call fv_phy_restart_output(GFS_restart_var, Atm_block, GFS_Control) call fv_dyn_restart_output(Atm(mygrid), timestamp) else call atmosphere_restart(timestamp) diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 5e81cd4ab..9b2757703 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -39,7 +39,7 @@ module GFS_diagnostics character(len=64) :: mask character(len=64) :: intpl_method real(kind=kind_phys) :: cnvfac - type(data_subtype), dimension(:), allocatable :: data + type(data_subtype) :: data end type GFS_externaldiag_type !--- public data type --- @@ -53,17 +53,17 @@ module GFS_diagnostics !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Helper function for GFS_externaldiag_populate to handle the massive dtend(:,:,dtidx(:,:)) array - subroutine add_dtend(Model,ExtDiag,IntDiag,idx,nblks,itrac,iprocess,desc,unit) + subroutine add_dtend(Model,ExtDiag,IntDiag,idx,itrac,iprocess,desc,unit) implicit none type(GFS_control_type), intent(in) :: Model type(GFS_externaldiag_type), intent(inout) :: ExtDiag(:) type(GFS_diag_type), intent(in) :: IntDiag - integer, intent(in) :: nblks, itrac, iprocess + integer, intent(in) :: itrac, iprocess integer, intent(inout) :: idx real(kind=kind_phys), pointer :: dtend(:,:,:) ! Assumption: dtend is null iff all(dtidx <= 1) character(len=*), intent(in), optional :: desc, unit - integer :: idtend, nb + integer :: idtend idtend = Model%dtidx(itrac,iprocess) if(idtend>=1) then @@ -82,10 +82,7 @@ subroutine add_dtend(Model,ExtDiag,IntDiag,idx,nblks,itrac,iprocess,desc,unit) else ExtDiag(idx)%unit = trim(Model%dtend_var_labels(itrac)%unit) endif - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dtend(Model%chunk_begin(nb):Model%chunk_end(nb),:,idtend) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dtend(:,:,idtend) endif end subroutine add_dtend @@ -114,10 +111,10 @@ 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] ! +! ExtDiag%data%int2(:) [integer ] pointer to 2D data [=> null() for a 3D field] ! +! ExtDiag%data%var2(:) [real*8 ] pointer to 2D data [=> null() for a 3D field] ! +! ExtDiag%data%var21(:) [real*8 ] pointer to 2D data for ratios ! +! ExtDiag%data%var3(:,:) [real*8 ] pointer to 3D data [=> null() for a 2D field] ! !---------------------------------------------------------------------------------------------! use parse_tracers, only: get_tracer_index @@ -138,7 +135,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop type(GFS_init_type), intent(in) :: Init_parm !--- local variables - integer :: idt, idx, num, nb, nblks, NFXR, idtend, ichem, itrac, iprocess, i + integer :: idt, idx, num, NFXR, idtend, ichem, itrac, iprocess, i character(len=2) :: xtra real(kind=kind_phys), parameter :: cn_one = 1._kind_phys real(kind=kind_phys), parameter :: cn_100 = 100._kind_phys @@ -147,8 +144,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop character(len=30) :: namestr, descstr NFXR = Model%NFXR - nblks = Model%nchunks - + ExtDiag(:)%id = -99 ExtDiag(:)%axes = -99 ExtDiag(:)%cnvfac = cn_one @@ -167,10 +163,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'frac' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%cldfra2d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%cldfra2d(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -179,10 +172,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'frac' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%total_albedo(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%total_albedo(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -191,10 +181,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%lwp_ex(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%lwp_ex(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -203,10 +190,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%iwp_ex(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%iwp_ex(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -215,10 +199,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%lwp_fc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%lwp_fc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -226,12 +207,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total ice water path from cloud fraction scheme' ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%iwp_fc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%iwp_fc(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'ALBDO_ave' @@ -240,11 +218,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_100 ExtDiag(idx)%mask = 'positive_flux' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),3) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),4) - enddo + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,3) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,4) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -255,23 +230,17 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dlwsfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - + ExtDiag(idx)%data%var2 => IntDiag%dlwsfc(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'DLWRFI' ExtDiag(idx)%desc = 'instantaneous surface downward longwave flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dlwsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%dlwsfci(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'ULWRF' @@ -280,12 +249,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ulwsfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%ulwsfc(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'DSWRFItoa' @@ -293,11 +259,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_one - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),23) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,23) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -307,10 +270,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),2) - enddo + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,2) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -319,11 +279,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_one - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),1) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,1) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -331,11 +288,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous surface upward longwave flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ulwsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%ulwsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -347,10 +301,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),4) - enddo + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,4) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -358,11 +309,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous surface downward shortwave flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dswsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%dswsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -371,10 +319,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'w/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dswsfcci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dswsfcci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -385,11 +330,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),3) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,3) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -397,11 +339,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous surface upward shortwave flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%uswsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%uswsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -411,11 +350,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),21) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,21) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -425,11 +361,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),22) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,22) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -440,10 +373,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),24) - enddo + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,24) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -454,11 +384,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),25) - enddo - + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,25) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'nbdsf_ave' @@ -468,10 +395,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),26) - enddo + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,26) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -481,11 +405,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),27) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,27) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -495,11 +416,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_lw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),28) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,28) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -509,11 +427,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),29) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,29) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -523,11 +438,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_lw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),30) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,30) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -537,11 +449,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),31) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,31) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -551,11 +460,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),32) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,32) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -563,11 +469,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Clear Sky Instantateous Downward Short Wave Flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),32) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,32) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -577,12 +480,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_lw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),33) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,33) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -593,12 +492,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),23) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,23) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -609,11 +504,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_sw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),2) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,2) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -624,11 +516,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_lw' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),1) - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,1) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -638,11 +527,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_100 ExtDiag(idx)%time_avg = .TRUE. - ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),17) - enddo + ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,17) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -652,11 +538,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_100 ExtDiag(idx)%time_avg = .TRUE. - ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),18) - enddo + ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,18) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -664,11 +547,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'convective cloud layer total cloud cover' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%cnvfac = cn_100 - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Cldprop%cv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%cnvfac = cn_100 + ExtDiag(idx)%data%var2 => Cldprop%cv(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -676,12 +556,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'pressure at convective cloud top level' ExtDiag(idx)%unit = 'pa' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%mask = 'cldmask' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Cldprop%cvt(Model%chunk_begin(nb):Model%chunk_end(nb)) - ExtDiag(idx)%data(nb)%var21 => Cldprop%cv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%mask = 'cldmask' + ExtDiag(idx)%data%var2 => Cldprop%cvt(:) + ExtDiag(idx)%data%var21 => Cldprop%cv(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -689,14 +566,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'pressure at convective cloud bottom level' ExtDiag(idx)%unit = 'pa' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%mask = 'cldmask' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Cldprop%cvb(Model%chunk_begin(nb):Model%chunk_end(nb)) - ExtDiag(idx)%data(nb)%var21 => Cldprop%cv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo -! if(mpp_pe()==mpp_root_pe())print *,'in gfdl_diag_register,af PREScnvclb,idx=',idx - + ExtDiag(idx)%mask = 'cldmask' + ExtDiag(idx)%data%var2 => Cldprop%cvb(:) + ExtDiag(idx)%data%var21 => Cldprop%cv(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -706,11 +578,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_100 ExtDiag(idx)%time_avg = .TRUE. - ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),5) - enddo + ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,5) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -721,11 +590,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' ExtDiag(idx)%mask = "cldmask_ratio" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),8) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),5) - enddo + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,8) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,5) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -735,12 +601,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - ExtDiag(idx)%mask = "cldmask_ratio" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),11) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),5) - enddo + ExtDiag(idx)%mask = "cldmask_ratio" + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,11) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,5) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -750,12 +613,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - ExtDiag(idx)%mask = "cldmask_ratio" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),14) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),5) - enddo + ExtDiag(idx)%mask = "cldmask_ratio" + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,14) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,5) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -765,11 +625,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_100 ExtDiag(idx)%time_avg = .TRUE. - ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),6) - enddo + ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,6) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -779,12 +636,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - ExtDiag(idx)%mask = "cldmask_ratio" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),9) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),6) - enddo + ExtDiag(idx)%mask = "cldmask_ratio" + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,9) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,6) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -794,12 +648,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - ExtDiag(idx)%mask = "cldmask_ratio" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),12) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),6) - enddo + ExtDiag(idx)%mask = "cldmask_ratio" + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,12) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,6) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -809,12 +660,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - ExtDiag(idx)%mask = "cldmask_ratio" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),15) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),6) - enddo + ExtDiag(idx)%mask = "cldmask_ratio" + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,15) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,6) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -824,13 +672,10 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_100 ExtDiag(idx)%time_avg = .TRUE. - ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),7) - enddo + ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,7) - idx = idx + 1 + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'PRES_avelct' ExtDiag(idx)%desc = 'pressure low cloud top level' @@ -838,12 +683,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - ExtDiag(idx)%mask = "cldmask_ratio" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),10) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),7) - enddo + ExtDiag(idx)%mask = "cldmask_ratio" + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,10) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,7) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -853,12 +695,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - ExtDiag(idx)%mask = "cldmask_ratio" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),13) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),7) - enddo + ExtDiag(idx)%mask = "cldmask_ratio" + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,13) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,7) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -868,12 +707,10 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'rad_swlw_min' - ExtDiag(idx)%mask = "cldmask_ratio" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),16) - ExtDiag(idx)%data(nb)%var21 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),7) - enddo + ExtDiag(idx)%mask = "cldmask_ratio" + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,16) + ExtDiag(idx)%data%var21 => IntDiag%fluxr(:,7) + !--- aerosol diagnostics --- idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -881,12 +718,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total aerosol optical depth at 550 nm' ExtDiag(idx)%unit = 'numerical' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),34) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,34) !--- aerosol diagnostics --- idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -895,11 +728,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'numerical' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),35) - enddo - + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,35) !--- aerosol diagnostics --- idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -907,12 +736,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'soot aerosol optical depth at 550 nm' ExtDiag(idx)%unit = 'numerical' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),36) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,36) !--- aerosol diagnostics --- idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -920,12 +745,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'waso aerosol optical depth at 550 nm' ExtDiag(idx)%unit = 'numerical' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),37) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,37) !--- aerosol diagnostics --- idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -933,12 +754,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'suso aerosol optical depth at 550 nm' ExtDiag(idx)%unit = 'numerical' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),38) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,38) !--- aerosol diagnostics --- idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -946,12 +763,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'salt aerosol optical depth at 550 nm' ExtDiag(idx)%unit = 'numerical' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),39) - enddo - + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,39) !--- air quality diagnostics --- if (Model%cplaqm) then if (associated(IntDiag%aod)) then @@ -961,10 +774,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total aerosol optical depth at 550 nm' ExtDiag(idx)%unit = 'numerical' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%aod(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%aod(:) endif endif @@ -979,10 +789,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'fluxr diagnostic '//trim(xtra)//' - GFS radiation' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%fluxr(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + ExtDiag(idx)%data%var2 => IntDiag%fluxr(:,num) enddo !--- the next two appear to be appear to be coupling fields in gloopr @@ -994,10 +801,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop !rab ExtDiag(idx)%name = 'dswcmp_'//trim(xtra) !rab ExtDiag(idx)%desc = 'dswcmp dagnostic '//trim(xtra)//' - GFS radiation' !rab ExtDiag(idx)%unit = 'XXX' -!rab ExtDiag(idx)%mod_name = 'gfs_phys' -!rab do nb = 1,nblks -!rab ExtDiag(idx)%data(nb)%var2 => IntDiag%dswcmp(Model%chunk_begin(nb):Model%chunk_end(nb),num) -!rab enddo +!rab ExtDiag(idx)%data%var2 => IntDiag%dswcmp(:,num) !rab enddo !rab !rab do num = 1,4 @@ -1008,13 +812,11 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop !rab ExtDiag(idx)%desc = 'uswcmp dagnostic '//trim(xtra)//' - GFS radiation' !rab ExtDiag(idx)%unit = 'XXX' !rab ExtDiag(idx)%mod_name = 'gfs_phys' -!rab do nb = 1,nblks -!rab ExtDiag(idx)%data(nb)%var2 => IntDiag%uswcmp(Model%chunk_begin(nb):Model%chunk_end(nb),num) -!rab enddo +!rab ExtDiag(idx)%data%var2 => IntDiag%uswcmp(:,num) !rab enddo ! DH gfortran cannot point to members of arrays of derived types such -! as IntDiag(nb)%topfsw(:)%upfxc (the compilation succeeds, but the +! as IntDiag(1)%topfsw(:)%upfxc (the compilation succeeds, but the ! pointers do not reference the correct data and the output either ! contains garbage (Inf, NaN), or the netCDF I/O layer crashes. #ifndef __GFORTRAN__ @@ -1024,11 +826,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total sky upward sw flux at toa - GFS radiation' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%topfsw(Model%chunk_begin(nb):Model%chunk_end(nb))%upfxc - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%topfsw(:)%upfxc idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1036,11 +835,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total sky downward sw flux at toa - GFS radiation' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%topfsw(Model%chunk_begin(nb):Model%chunk_end(nb))%dnfxc - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%topfsw(:)%dnfxc idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1048,11 +844,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'clear sky upward sw flux at toa - GFS radiation' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%topfsw(Model%chunk_begin(nb):Model%chunk_end(nb))%upfx0 - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%topfsw(:)%upfx0 idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1060,11 +853,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total sky upward lw flux at toa - GFS radiation' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%topflw(Model%chunk_begin(nb):Model%chunk_end(nb))%upfxc - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%topflw(:)%upfxc idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1072,11 +862,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'clear sky upward lw flux at toa - GFS radiation' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%topflw(Model%chunk_begin(nb):Model%chunk_end(nb))%upfx0 - enddo + ExtDiag(idx)%intpl_method = 'bilinear' + ExtDiag(idx)%data%var2 => IntDiag%topflw(:)%upfx0 #endif !--- physics accumulated diagnostics --- @@ -1085,11 +872,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%name = 'ssrun_acc' ExtDiag(idx)%desc = 'Accumulated surface storm water runoff' ExtDiag(idx)%unit = 'kg/m**2' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%srunoff(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%mod_name = 'gfs_phys' + ExtDiag(idx)%data%var2 => IntDiag%srunoff(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1097,11 +881,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Direct Evaporation from Bare Soil' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%evbsa(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%time_avg = .TRUE. + ExtDiag(idx)%data%var2 => IntDiag%evbsa(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1109,11 +890,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Canopy water evaporation' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%evcwa(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%time_avg = .TRUE. + ExtDiag(idx)%data%var2 => IntDiag%evcwa(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1121,11 +899,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Snow Phase Change Heat Flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%snohfa(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%time_avg = .TRUE. + ExtDiag(idx)%data%var2 => IntDiag%snohfa(:) if (Model%lsm == Model%lsm_noahmp) then idx = idx + 1 @@ -1134,11 +909,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = ' Total Precipitation Advected Heat' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%paha(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%time_avg = .TRUE. + ExtDiag(idx)%data%var2 => IntDiag%paha(:) endif idx = idx + 1 @@ -1148,22 +920,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%transa(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - + ExtDiag(idx)%data%var2 => IntDiag%transa(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'sbsno_ave' ExtDiag(idx)%desc = 'Sublimation (evaporation from snow)' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%sbsnoa(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%time_avg = .TRUE. + ExtDiag(idx)%data%var2 => IntDiag%sbsnoa(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1173,10 +939,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%cnvfac = cn_100 - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%snowca(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%snowca(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1184,10 +947,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'snow cover ' ExtDiag(idx)%unit = 'fraction' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%sncovr(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%sncovr(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1196,11 +956,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%mask = "land_only" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%soilm(Model%chunk_begin(nb):Model%chunk_end(nb)) - ExtDiag(idx)%data(nb)%var21 => Sfcprop%slmsk(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%soilm(:) + ExtDiag(idx)%data%var21 => Sfcprop%slmsk(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1209,10 +966,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tmpmin(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tmpmin(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1221,10 +975,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tmpmax(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tmpmax(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1235,10 +986,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dusfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dusfc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1249,10 +997,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dvsfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dvsfc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1263,10 +1008,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dtsfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dtsfc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1277,10 +1019,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dqsfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dqsfc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1292,10 +1031,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'full' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%totprcp(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%totprcp(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1306,10 +1042,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_th ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%totprcpb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%totprcpb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1319,12 +1052,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. -! ExtDiag(idx)%mask = "land_ice_only" - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%gflux(Model%chunk_begin(nb):Model%chunk_end(nb)) -! ExtDiag(idx)%data(nb)%var21 => Sfcprop%slmsk(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ! ExtDiag(idx)%mask = "land_ice_only" + ExtDiag(idx)%data%var2 => IntDiag%gflux(:) + !ExtDiag(idx)%data%var21 => Sfcprop%slmsk(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1333,10 +1063,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dlwsfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dlwsfc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1345,10 +1072,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ulwsfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%ulwsfc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1357,10 +1081,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 's' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%suntim(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%suntim(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1368,10 +1089,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total water runoff' ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%runoff(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%runoff(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1379,10 +1097,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total evaporation of intercepted water' ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tecan(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tecan(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1390,10 +1105,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total plant transpiration' ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tetran(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tetran(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1401,10 +1113,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total soil surface evaporation' ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tedir(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tedir(:) if (Model%lsm == Model%lsm_noahmp) then idx = idx + 1 @@ -1413,10 +1122,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total water storage in aquifer' ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%twa(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%twa(:) endif idx = idx + 1 @@ -1426,10 +1132,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'mm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ep(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%ep(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1439,11 +1142,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%cldwrk(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - + ExtDiag(idx)%data%var2 => IntDiag%cldwrk(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1453,10 +1152,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dugwd(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dugwd(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1466,10 +1162,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dvgwd(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dvgwd(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1478,10 +1171,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kPa' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%psmean(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%psmean(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1493,10 +1183,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'full' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%cnvprcp(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%cnvprcp(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1507,10 +1194,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_th ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%cnvprcpb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%cnvprcpb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1518,10 +1202,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface convective precipitation rate' ExtDiag(idx)%unit = 'kg/m**2/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%cnvprcp(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%cnvprcp(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1530,10 +1211,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/kg' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%spfhmin(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%spfhmin(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1542,10 +1220,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/kg' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%spfhmax(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%spfhmax(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1554,10 +1229,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'vector_bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%u10mmax(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%u10mmax(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1566,10 +1238,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'vector_bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%v10mmax(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%v10mmax(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1578,10 +1247,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%wind10mmax(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%wind10mmax(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'u10max' @@ -1589,10 +1256,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'vector_bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%u10max(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%u10max(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1601,10 +1265,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'vector_bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%v10max(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%v10max(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1613,10 +1274,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%spd10max(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%spd10max(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1625,10 +1283,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%t02max(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%t02max(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1637,10 +1292,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%t02min(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%t02min(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'rh02max' @@ -1648,10 +1301,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%rh02max(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%rh02max(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1660,10 +1310,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%rh02min(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%rh02min(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1671,10 +1318,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'max hourly precipitation rate' ExtDiag(idx)%unit = 'mm h-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%pratemax(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%pratemax(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1683,10 +1327,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_th - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%frzr(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%frzr(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1695,10 +1336,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_th - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%frzrb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%frzrb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1707,10 +1345,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_th - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%frozr(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%frozr(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1719,10 +1354,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_th - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%frozrb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%frozrb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1731,10 +1363,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_th - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tsnowp(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tsnowp(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1743,10 +1372,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_th - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tsnowpb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tsnowpb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1754,10 +1380,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'precipitation ice density' ExtDiag(idx)%unit = 'kg m^-3' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%rhonewsn1(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%rhonewsn1(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1765,10 +1388,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total rain at this time step' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%rain(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%rain(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1776,10 +1396,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'convective rain at this time step' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%rainc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%rainc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1787,10 +1404,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'ice fall at this time step' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ice(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%ice(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1798,10 +1412,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'snow fall at this time step' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%snow(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%snow(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1809,10 +1420,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'graupel fall at this time step' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%graupel(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%graupel(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1823,10 +1431,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_th ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'full' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%totice(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%totice(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1836,10 +1441,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_th ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%toticeb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%toticeb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1850,10 +1452,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_th ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'full' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%totsnw(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%totsnw(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1863,10 +1462,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_th ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%totsnwb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%totsnwb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1877,10 +1473,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%cnvfac = cn_th ExtDiag(idx)%time_avg = .TRUE. ExtDiag(idx)%time_avg_kind = 'full' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%totgrp(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%totgrp(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1890,50 +1483,36 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%cnvfac = cn_th ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%totgrpb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - -! if(mpp_pe()==mpp_root_pe())print *,'in gfdl_diag_register,af totgrp,idx=',idx + ExtDiag(idx)%data%var2 => IntDiag%totgrpb(:) if(associated(Coupling%sfcdlw)) then - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'sfcdlw' - ExtDiag(idx)%desc = 'sfcdlw' - ExtDiag(idx)%unit = 'W m-2' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%sfcdlw(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'sfcdlw' + ExtDiag(idx)%desc = 'sfcdlw' + ExtDiag(idx)%unit = 'W m-2' + ExtDiag(idx)%mod_name = 'gfs_phys' + ExtDiag(idx)%data%var2 => Coupling%sfcdlw(:) endif if(associated(Coupling%htrlw)) then - idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'htrlw' - ExtDiag(idx)%desc = 'htrlw' - ExtDiag(idx)%unit = 'W m-2' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%htrlw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'htrlw' + ExtDiag(idx)%desc = 'htrlw' + ExtDiag(idx)%unit = 'W m-2' + ExtDiag(idx)%mod_name = 'gfs_phys' + ExtDiag(idx)%data%var3 => Coupling%htrlw(:,:) endif if(associated(Radtend%lwhc)) then - idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'lwhc' - ExtDiag(idx)%desc = 'lwhc' - ExtDiag(idx)%unit = 'K s-1' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Radtend%lwhc(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'lwhc' + ExtDiag(idx)%desc = 'lwhc' + ExtDiag(idx)%unit = 'K s-1' + ExtDiag(idx)%mod_name = 'gfs_phys' + ExtDiag(idx)%data%var3 => Radtend%lwhc(:,:) endif !--- physics instantaneous diagnostics --- @@ -1944,10 +1523,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'vector_bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%u10m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%u10m(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1956,10 +1532,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'vector_bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%v10m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%v10m(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1968,10 +1541,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dpt2m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dpt2m(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1979,10 +1549,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'layer 1 height' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%zlvl(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%zlvl(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -1992,10 +1559,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mask = 'pseudo_ps' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%psurf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%psurf(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2004,10 +1568,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Tbd%hpbl(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Tbd%hpbl(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2016,10 +1577,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%pwat(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%pwat(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2028,10 +1586,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%t1(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%t1(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2040,10 +1595,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/kg' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%q1(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%q1(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2052,10 +1604,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'vector_bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%u1(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%u1(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2064,10 +1613,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'vector_bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%v1(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%v1(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2076,10 +1622,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/m2/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%chh(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%chh(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2088,10 +1631,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%cmm(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%cmm(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2100,10 +1640,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dlwsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dlwsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2112,10 +1649,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ulwsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%ulwsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2124,10 +1658,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dswsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dswsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2136,10 +1667,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%uswsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%uswsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2147,10 +1675,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous u component of surface stress' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dusfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dusfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2158,10 +1683,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous v component of surface stress' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dvsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dvsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2170,10 +1692,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dtsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dtsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2182,10 +1701,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dqsfci(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dqsfci(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2193,10 +1709,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous surface ground heat flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%gfluxi(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%gfluxi(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2204,10 +1717,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'wiltimg point (volumetric)' ExtDiag(idx)%unit = 'Proportion' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%smcwlt2(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%smcwlt2(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2215,10 +1725,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Field Capacity (volumetric)' ExtDiag(idx)%unit = 'fraction' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%smcref2(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%smcref2(:) if (Model%lsm == Model%lsm_noahmp) then idx = idx + 1 @@ -2227,10 +1734,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous precipitation advected heat flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%pahi(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%pahi(:) endif idx = idx + 1 @@ -2239,10 +1743,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous surface potential evaporation' ExtDiag(idx)%unit = 'mm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%epi(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%epi(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2250,15 +1751,10 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'normalized soil wetness' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) if (Model%lsm==Model%lsm_ruc) then - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%wetness(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%wetness(:) else - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%wet1(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%wet1(:) endif idx = idx + 1 @@ -2268,10 +1764,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'fraction' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%sr(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%sr(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2282,10 +1775,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'bilinear' ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tdomr(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tdomr(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2296,10 +1786,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'bilinear' ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tdoms(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tdoms(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2310,10 +1797,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'bilinear' ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tdomzr(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tdomzr(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2324,10 +1808,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'bilinear' ExtDiag(idx)%cnvfac = cn_one ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tdomip(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tdomip(:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2335,10 +1816,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Radar reflectivity' ExtDiag(idx)%unit = 'dBz' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%refl_10cm(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%refl_10cm(:,:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2346,10 +1824,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Maximum hail diameter at lowest model level' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%max_hail_diam_sfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%max_hail_diam_sfc(:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2357,10 +1832,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Atmospheric heat diffusivity' ExtDiag(idx)%unit = 'm2s-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dkt(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dkt(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2368,10 +1840,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Atmospheric momentum diffusivity' ExtDiag(idx)%unit = 'm2s-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dku(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dku(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2379,10 +1848,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Instantaneous 3D Cloud Fraction' ExtDiag(idx)%unit = 'frac' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%cldfra(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%cldfra(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2390,11 +1856,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'subgrid scale convective cloud water' ExtDiag(idx)%unit = 'kg/kg' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - if( Model%ncnvw > 0 ) then - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Tbd%phy_f3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%ncnvw) - enddo + if( Model%ncnvw > 0 ) then + ExtDiag(idx)%data%var3 => Tbd%phy_f3d(:,:,Model%ncnvw) endif if (Model%do_skeb) then @@ -2404,10 +1867,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'perturbation velocity' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%skebu_wts(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 =>Coupling%skebu_wts(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2415,10 +1875,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'perturbation velocity' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%skebv_wts(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%skebv_wts(:,:) endif idx = idx + 1 @@ -2427,10 +1884,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'level of dividing streamline' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%zmtnblck(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%zmtnblck(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2438,20 +1892,15 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'max hourly 1-km agl reflectivity' ExtDiag(idx)%unit = 'dBZ' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%refdmax(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%refdmax(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'refdmax263k' ExtDiag(idx)%desc = 'max hourly -10C reflectivity' ExtDiag(idx)%unit = 'dBZ' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%refdmax263k(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%refdmax263k(:) if (Model%do_sppt .or. Model%ca_global) then idx = idx + 1 @@ -2460,10 +1909,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'perturbation velocity' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%sppt_wts(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%sppt_wts(:,:) endif if (Model%do_shum) then @@ -2473,10 +1919,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'perturbation velocity' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%shum_wts(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%shum_wts(:,:) endif if (Model%do_spp) then @@ -2486,10 +1929,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'spp pbl perturbation wts' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%spp_wts_pbl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%spp_wts_pbl(:,:) endif if (Model%do_spp) then @@ -2499,10 +1939,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'spp sfc perturbation wts' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%spp_wts_sfc(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%spp_wts_sfc(:,:) endif if (Model%do_spp) then @@ -2512,10 +1949,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'spp mp perturbation wts' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%spp_wts_mp(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%spp_wts_mp(:,:) endif if (Model%do_spp) then @@ -2525,10 +1959,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'spp gwd perturbation wts' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%spp_wts_gwd(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%spp_wts_gwd(:,:) endif if (Model%do_spp) then @@ -2538,10 +1969,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'spp rad perturbation wts' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%spp_wts_rad(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%spp_wts_rad(:,:) endif if (Model%do_spp) then @@ -2551,10 +1979,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'spp cu deep perturbation wts' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%spp_wts_cu_deep(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%spp_wts_cu_deep(:,:) endif if (Model%lndp_type /= 0) then @@ -2564,11 +1989,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'perturbation amplitude' ExtDiag(idx)%unit = 'none' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling%sfc_wts(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - + ExtDiag(idx)%data%var3 => Coupling%sfc_wts(:,:) endif if (Model%do_ca) then @@ -2578,10 +1999,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Cellular Automata' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%ca1(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%ca1(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2589,10 +2007,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'CA deep conv' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%ca_deep(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%ca_deep(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2600,10 +2015,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'CA turbulence' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%ca_turb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%ca_turb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2611,10 +2023,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'CA shallow conv' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%ca_shal(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%ca_shal(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2622,21 +2031,15 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'CA radiation' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%ca_rad(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%ca_rad(:) idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'ca_micro' ExtDiag(idx)%desc = 'CA microphys' ExtDiag(idx)%unit = '%' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%ca_micro(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%mod_name = 'gfs_phys' + ExtDiag(idx)%data%var2 => Coupling%ca_micro(:) endif if (Model%lkm/=0) then @@ -2648,10 +2051,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'fraction' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lakefrac(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lakefrac(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2660,10 +2060,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lakedepth(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lakedepth(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2672,10 +2069,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%T_snow(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%T_snow(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2684,10 +2078,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%T_ice(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%T_ice(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2696,15 +2087,12 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'flag' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%int2 => Sfcprop%use_lake_model(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%int2 => Sfcprop%use_lake_model(:) if(Model%iopt_lake==Model%iopt_lake_clm) then ! Populate the 3D arrays separately since the code is complicated: - call clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one, nblks) + call clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2712,10 +2100,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'lake point is considered salty by clm lake model' ExtDiag(idx)%unit = '1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%int2 => Sfcprop%lake_is_salty(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%int2 => Sfcprop%lake_is_salty(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2723,10 +2108,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'clm lake model considers the point to be so salty it cannot freeze' ExtDiag(idx)%unit = '1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%int2 => Sfcprop%lake_cannot_freeze(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%int2 => Sfcprop%lake_cannot_freeze(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2735,10 +2117,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%intpl_method = 'nearest_stod' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lake_t2m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lake_t2m(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2747,10 +2126,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/kg' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lake_q2m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lake_q2m(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2759,10 +2135,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'fraction' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lake_albedo(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lake_albedo(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2771,10 +2144,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'mm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lake_h2osno2d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lake_h2osno2d(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2783,10 +2153,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lake_sndpth2d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lake_sndpth2d(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2795,10 +2162,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'count' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lake_snl2d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lake_snl2d(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2807,10 +2171,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lake_tsfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lake_tsfc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2819,10 +2180,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg m-3' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lake_savedtke12d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lake_savedtke12d(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2831,13 +2189,9 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'unitless' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lake_ht(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - - endif - + ExtDiag(idx)%data%var2 => Sfcprop%lake_ht(:) + endif + ! endif if (Model%ldiag_ugwp) THEN @@ -2848,10 +2202,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'height of dividing streamline' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%zmtb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%zmtb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2859,10 +2210,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'height of OGW-launch' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%zogw(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%zogw(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2870,10 +2218,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'height of LWB-level' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%zlwb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%zlwb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2881,10 +2226,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = ' OGW vertical MF at launch level' ExtDiag(idx)%unit = 'N/m2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tau_ogw(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tau_ogw(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2892,10 +2234,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = ' ORO-MTB integrated flux from surface' ExtDiag(idx)%unit = 'N/m2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tau_mtb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tau_mtb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2903,10 +2242,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = ' ORO-TOFD integrated flux from surface' ExtDiag(idx)%unit = 'N/m2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tau_tofd(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tau_tofd(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2914,10 +2250,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = ' NGW momentum flux at launch level ' ExtDiag(idx)%unit = 'N/m2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%tau_ngw(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%tau_ngw(:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2925,10 +2258,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'axz_oro averaged E-W OROGW-tendency' ExtDiag(idx)%unit = 'm/s/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%du3dt_ogw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%du3dt_ogw(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2936,22 +2266,15 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'axz_oro averaged E-W GWALL-tendency' ExtDiag(idx)%unit = 'm/s/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%du3dt_ngw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo -! -! + ExtDiag(idx)%data%var3 => IntDiag%du3dt_ngw(:,:) + idx = idx + 1 ExtDiag(idx)%axes = 3 ExtDiag(idx)%name = 'du3dt_mtb' ExtDiag(idx)%desc = 'axz_oro averaged E-W MTB-tendency' ExtDiag(idx)%unit = 'm/s/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%du3dt_mtb(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%du3dt_mtb(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2959,10 +2282,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'axz_oro averaged E-W TMS-tendency' ExtDiag(idx)%unit = 'm/s/s' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%du3dt_tms(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%du3dt_tms(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2970,10 +2290,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'x wind tendency from mesoscale OGWD' ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dudt_ogw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dudt_ogw(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2981,10 +2298,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'y wind tendency from mesoscale OGWD' ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dvdt_ogw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dvdt_ogw(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2992,10 +2306,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'x wind tendency from blocking drag' ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dudt_obl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dudt_obl(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3003,10 +2314,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'y wind tendency from blocking drag' ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dvdt_obl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dvdt_obl(:,:) ! 2D variables @@ -3016,10 +2324,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'integrated x momentum flux from meso scale ogw' ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%du_ogwcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%du_ogwcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3027,10 +2332,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'integrated y momentum flux from meso scale ogw' ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dv_ogwcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dv_ogwcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3038,10 +2340,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'integrated x momentum flux from blocking drag' ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%du_oblcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%du_oblcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3049,10 +2348,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'integrated y momentum flux from blocking drag' ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dv_oblcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dv_oblcol(:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3061,10 +2357,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dws3dt_ogw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dws3dt_ogw(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3073,10 +2366,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dws3dt_obl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dws3dt_obl(:,:) ! Variables for GSL drag suite @@ -3086,10 +2376,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'x wind tendency from small scale GWD' ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dudt_oss(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dudt_oss(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3097,10 +2384,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'y wind tendency from small scale GWD' ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dvdt_oss(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dvdt_oss(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3108,10 +2392,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'x wind tendency from form drag' ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dudt_ofd(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dudt_ofd(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3119,10 +2400,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'y wind tendency from form drag' ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dvdt_ofd(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dvdt_ofd(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3131,10 +2409,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dws3dt_oss(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dws3dt_oss(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3143,10 +2418,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dws3dt_ofd(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dws3dt_ofd(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3155,10 +2427,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%ldu3dt_ogw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%ldu3dt_ogw(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3167,10 +2436,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%ldu3dt_obl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%ldu3dt_obl(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3179,10 +2445,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%ldu3dt_ofd(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%ldu3dt_ofd(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3191,10 +2454,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%ldu3dt_oss(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%ldu3dt_oss(:,:) ! 2D variables @@ -3204,10 +2464,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'integrated x momentum flux from small scale gwd' ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%du_osscol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%du_osscol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3215,10 +2472,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'integrated y momentum flux from small scale gwd' ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dv_osscol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dv_osscol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3226,10 +2480,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'integrated x momentum flux from form drag' ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%du_ofdcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%du_ofdcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3237,10 +2488,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'integrated y momentum flux from form drag' ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dv_ofdcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dv_ofdcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3249,10 +2497,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%du3_ogwcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%du3_ogwcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3261,10 +2506,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dv3_ogwcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dv3_ogwcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3273,10 +2515,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%du3_oblcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%du3_oblcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3285,10 +2524,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dv3_oblcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dv3_oblcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3297,10 +2533,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%du3_osscol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%du3_osscol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3309,10 +2542,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dv3_osscol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dv3_osscol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3321,10 +2551,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%du3_ofdcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%du3_ofdcol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3333,10 +2560,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'Pa' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%dv3_ofdcol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%dv3_ofdcol(:) ! UGWP non-stationary GWD outputs @@ -3347,10 +2571,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%ldu3dt_ngw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%ldu3dt_ngw(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3359,10 +2580,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm s-2' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%ldv3dt_ngw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%ldv3dt_ngw(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3371,10 +2589,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K s-1' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%ldt3dt_ngw(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%ldt3dt_ngw(:,:) ENDIF ! if (Model%ldiag_ugwp) @@ -3387,7 +2602,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop do iprocess=1,Model%nprocess do itrac=1,Model%ntracp100 if(Model%dtidx(itrac,iprocess)>=1) then - call add_dtend(Model,ExtDiag,IntDiag,idx,nblks,itrac,iprocess) + call add_dtend(Model,ExtDiag,IntDiag,idx,itrac,iprocess) endif enddo enddo @@ -3401,10 +2616,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg m-1 s-3' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%upd_mf(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%upd_mf(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3413,10 +2625,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg m-1 s-3' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%dwn_mf(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%dwn_mf(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3425,10 +2634,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg m-1 s-3' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .TRUE. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%det_mf(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%det_mf(:,:) end if if_qdiag3d @@ -3460,10 +2666,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'mean nir albedo with strong cosz dependency' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%alnsf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%alnsf(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3471,10 +2674,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'mean nir albedo with weak cosz dependency' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%alnwf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%alnwf(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3482,10 +2682,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'mean vis albedo with strong cosz dependency' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%alvsf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%alvsf(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3493,10 +2690,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'mean vis albedo with weak cosz dependency' ExtDiag(idx)%unit = '%' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%alvwf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%alvwf(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3504,10 +2698,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'canopy water (cnwat in gfs data)' ExtDiag(idx)%unit = 'mm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%canopy(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%canopy(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3515,10 +2706,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = '10-meter wind speed divided by lowest model wind speed' ExtDiag(idx)%unit = 'N/A' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%f10m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%f10m(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3526,10 +2714,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'fractional coverage with strong cosz dependency' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%facsf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%facsf(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3537,10 +2722,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'fractional coverage with weak cosz dependency' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%facwf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 =>Sfcprop%facwf(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3548,10 +2730,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'fh parameter from PBL scheme' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%ffhh(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%ffhh(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3559,10 +2738,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'fm parameter from PBL scheme' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%ffmm(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%ffmm(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3570,10 +2746,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'uustar surface frictional wind' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%uustar(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%uustar(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3581,10 +2754,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface slope type' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%int2 => Sfcprop%slope(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%int2 => Sfcprop%slope(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3592,10 +2762,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface ice concentration (ice=1; no ice=0)' ExtDiag(idx)%unit = 'fraction' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%fice(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%fice(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3603,10 +2770,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'sea ice thickness (icetk in gfs_data)' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%hice(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%hice(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3614,10 +2778,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'maximum snow albedo in fraction' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%snoalb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%snoalb(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3625,10 +2786,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'maximum fractional coverage of green vegetation' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%shdmax(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%shdmax(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3636,10 +2794,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'minimum fractional coverage of green vegetation' ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%shdmin(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%shdmin(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3648,10 +2803,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%cnvfac = cn_one/cn_th - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%snowd(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%snowd(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3659,10 +2811,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous sublimation (evaporation from snow)' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%sbsno(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%sbsno(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3670,10 +2819,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous direct evaporation over land' ExtDiag(idx)%unit = 'W m-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%evbs(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%evbs(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3681,10 +2827,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous canopy evaporation' ExtDiag(idx)%unit = 'W m-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%evcw(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%evcw(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3692,10 +2835,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'instantaneous transpiration' ExtDiag(idx)%unit = 'W m-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%trans(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%trans(:) if (Model%lsm == Model%lsm_ruc) then @@ -3705,10 +2845,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface albedo over land' ExtDiag(idx)%unit = 'fraction' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%sfalb_lnd(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%sfalb_lnd(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3716,10 +2853,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'density of frozen precipitation' ExtDiag(idx)%unit = 'kg m-3' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%rhofr(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%rhofr(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3727,10 +2861,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total accumulated frozen precipitation over land' ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%snowfallac_land(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%snowfallac_land(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3738,10 +2869,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total accumulated SWE of frozen precipitation over land' ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%acsnow_land(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%acsnow_land(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3749,10 +2877,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'accumulated snow melt over land' ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%snowmt_land(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%snowmt_land(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3760,10 +2885,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total accumulated frozen precipitation over ice' ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%snowfallac_ice(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%snowfallac_ice(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3771,10 +2893,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total accumulated SWE of frozen precipitation over ice' ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%acsnow_ice(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%acsnow_ice(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3782,10 +2901,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'accumulated snow melt over ice' ExtDiag(idx)%unit = 'kg m-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%snowmt_ice(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%snowmt_ice(:) endif ! RUC lsm idx = idx + 1 @@ -3795,10 +2911,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'number' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%cnvfac = cn_one - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%srflag(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%srflag(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3806,10 +2919,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'soil type in integer 1-9' ExtDiag(idx)%unit = 'number' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%int2 => Sfcprop%stype(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%int2 => Sfcprop%stype(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3817,11 +2927,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'soil color in integer 1-20' ExtDiag(idx)%unit = 'number' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%int2 => Sfcprop%scolor(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - + ExtDiag(idx)%data%int2 => Sfcprop%scolor(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3829,10 +2935,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'land fraction' ExtDiag(idx)%unit = 'fraction [0:1]' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%landfrac(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%landfrac(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3841,10 +2944,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'kg/kg' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%q2m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%q2m(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3853,10 +2953,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'bilinear' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%t2m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%t2m(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3864,10 +2961,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface temperature' ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%tsfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%tsfc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3875,10 +2969,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface zonal current' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%usfco(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%usfco(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3886,10 +2977,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface meridional current' ExtDiag(idx)%unit = 'm/s' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%vsfco(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%vsfco(:) if (Model%frac_grid) then do num = 1,Model%kice @@ -3900,10 +2988,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'internal ice temperature layer ' // trim(xtra) ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%tiice(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%tiice(:,num) enddo end if @@ -3913,10 +2998,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'deep soil temperature' ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%tg3(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%tg3(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3924,10 +3006,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface temperature over ice fraction' ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%tisfc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%tisfc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3935,10 +3014,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'total time-step precipitation' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%tprcp(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%tprcp(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3946,10 +3022,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'vegetation type in integer' ExtDiag(idx)%unit = 'number' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%int2 => sfcprop%vtype(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%int2 => sfcprop%vtype(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3957,10 +3030,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface snow water equivalent' ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%weasd(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%weasd(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3968,10 +3038,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface snow water equivalent over ice' ExtDiag(idx)%unit = 'kg/m**2' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%weasdi(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%weasdi(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3979,10 +3046,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'snow depth over ice' ExtDiag(idx)%unit = 'mm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%snodi(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%snodi(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3991,10 +3055,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'gpm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%cnvfac = cn_one - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%oro(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%oro(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4002,10 +3063,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'sea-land-ice mask (0-sea, 1-land, 2-ice)' ExtDiag(idx)%unit = 'numerical' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%slmsk(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%slmsk(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4014,10 +3072,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%cnvfac = cn_one/cn_100 - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%zorl(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%zorl(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4026,10 +3081,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'fraction' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%cnvfac = cn_100 - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%vfrac(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%vfrac(:) if (Model%lsm==Model%lsm_ruc) then idx = idx + 1 @@ -4039,10 +3091,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'fraction' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%cnvfac = cn_100 - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%wetness(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%wetness(:) end if idx = idx + 1 @@ -4051,10 +3100,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'sfc nir beam sw downward flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%nirbmdi(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%nirbmdi(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4062,10 +3108,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'sfc nir diff sw downward flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%nirdfdi(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%nirdfdi(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4073,10 +3116,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'sfc uv+vis beam sw downward flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%visbmdi(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%visbmdi(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4084,10 +3124,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = ' sfc uv+vis diff sw downward flux' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%visdfdi(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%visdfdi(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4095,10 +3132,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'leaf area index' ExtDiag(idx)%unit = 'number' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%xlaixy(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%xlaixy(:) do num = 1,Model%nvegcat write (xtra,'(i2)') num @@ -4108,10 +3142,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'fraction of vegetation category'//trim(xtra) ExtDiag(idx)%unit = 'frac' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%vegtype_frac(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + ExtDiag(idx)%data%var2 => sfcprop%vegtype_frac(:,num) enddo do num = 1,Model%nsoilcat @@ -4122,10 +3153,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'fraction of soil category'//trim(xtra) ExtDiag(idx)%unit = 'frac' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%soiltype_frac(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + ExtDiag(idx)%data%var2 => sfcprop%soiltype_frac(:,num) enddo if (Model%lsm == Model%lsm_ruc) then @@ -4137,10 +3165,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'liquid soil moisture ' // trim(soil_layer_depth(Model%lsm, Model%lsm_ruc, Model%lsm_noah, num)) ExtDiag(idx)%unit = 'm**3/m**3' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%sh2o(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + ExtDiag(idx)%data%var2 => sfcprop%sh2o(:,num) enddo idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -4148,10 +3173,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'liquid soil moisture' ExtDiag(idx)%unit = 'm**3/m**3' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => sfcprop%sh2o(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => sfcprop%sh2o(:,:) else do num = 1,Model%lsoil_lsm write (xtra,'(i1)') num @@ -4169,10 +3191,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop #endif ! *DH ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%slc(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + ExtDiag(idx)%data%var2 => sfcprop%slc(:,num) enddo idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -4180,64 +3199,49 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'liquid soil moisture' ExtDiag(idx)%unit = 'm**3/m**3' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => sfcprop%slc(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => sfcprop%slc(:,:) endif if (Model%lsm == Model%lsm_ruc) then - do num = 1,Model%lsoil_lsm - write (xtra,'(i1)') num - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilw'//trim(xtra) - ExtDiag(idx)%desc = 'volumetric soil moisture ' // trim(soil_layer_depth(Model%lsm, Model%lsm_ruc, Model%lsm_noah, num)) - ExtDiag(idx)%unit = 'fraction' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%smois(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo - enddo - idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'soilw' - ExtDiag(idx)%desc = 'volumetric soil moisture' - ExtDiag(idx)%unit = 'fraction' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => sfcprop%smois(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + do num = 1,Model%lsoil_lsm + write (xtra,'(i1)') num + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'soilw'//trim(xtra) + ExtDiag(idx)%desc = 'volumetric soil moisture ' // trim(soil_layer_depth(Model%lsm, Model%lsm_ruc, Model%lsm_noah, num)) + ExtDiag(idx)%unit = 'fraction' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%data%var2 => sfcprop%smois(:,num) + enddo + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'soilw' + ExtDiag(idx)%desc = 'volumetric soil moisture' + ExtDiag(idx)%unit = 'fraction' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%data%var3 => sfcprop%smois(:,:) else - do num = 1,Model%lsoil_lsm - write (xtra,'(i1)') num - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilw'//trim(xtra) - ExtDiag(idx)%desc = 'volumetric soil moisture ' // trim(soil_layer_depth(Model%lsm, Model%lsm_ruc, Model%lsm_noah, num)) - ExtDiag(idx)%unit = 'fraction' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%smc(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo - enddo - idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'soilw' - ExtDiag(idx)%desc = 'volumetric soil moisture' - ExtDiag(idx)%unit = 'fraction' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => sfcprop%smc(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + do num = 1,Model%lsoil_lsm + write (xtra,'(i1)') num + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'soilw'//trim(xtra) + ExtDiag(idx)%desc = 'volumetric soil moisture ' // trim(soil_layer_depth(Model%lsm, Model%lsm_ruc, Model%lsm_noah, num)) + ExtDiag(idx)%unit = 'fraction' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%data%var2 => sfcprop%smc(:,num) + enddo + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'soilw' + ExtDiag(idx)%desc = 'volumetric soil moisture' + ExtDiag(idx)%unit = 'fraction' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%data%var3 => sfcprop%smc(:,:) endif - if (Model%lsm == Model%lsm_ruc) then - do num = 1,Model%lsoil_lsm + if (Model%lsm == Model%lsm_ruc) then + do num = 1,Model%lsoil_lsm write (xtra,'(i1)') num idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4245,10 +3249,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'soil temperature ' // trim(soil_layer_depth(Model%lsm, Model%lsm_ruc, Model%lsm_noah, num)) ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%tslb(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + ExtDiag(idx)%data%var2 => sfcprop%tslb(:,num) enddo idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -4256,23 +3257,17 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'soil temperature' ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => sfcprop%tslb(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - else + ExtDiag(idx)%data%var3 => sfcprop%tslb(:,:) + else do num = 1,Model%lsoil_lsm - write (xtra,'(i1)') num - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilt'//trim(xtra) - ExtDiag(idx)%desc = 'soil temperature ' // trim(soil_layer_depth(Model%lsm, Model%lsm_ruc, Model%lsm_noah, num)) - ExtDiag(idx)%unit = 'K' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%stc(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + write (xtra,'(i1)') num + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'soilt'//trim(xtra) + ExtDiag(idx)%desc = 'soil temperature ' // trim(soil_layer_depth(Model%lsm, Model%lsm_ruc, Model%lsm_noah, num)) + ExtDiag(idx)%unit = 'K' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%data%var2 => sfcprop%stc(:,num) enddo idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -4280,11 +3275,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'soil temperature' ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => sfcprop%stc(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - endif + ExtDiag(idx)%data%var3 => sfcprop%stc(:,:) + endif !--------------------------nsst variables if (model%nstf_name(1) > 0) then @@ -4296,10 +3288,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst reference or foundation temperature' ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%tref(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%tref(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4307,10 +3296,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst sub-layer cooling thickness' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%z_c(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%z_c(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4318,10 +3304,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst coefficient1 to calculate d(tz)/d(ts)' ExtDiag(idx)%unit = 'numerical' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%c_0(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%c_0(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4329,10 +3312,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst coefficient2 to calculate d(tz)/d(ts)' ExtDiag(idx)%unit = 'n/a' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%c_d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%c_d(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4340,10 +3320,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst coefficient3 to calculate d(tz)/d(ts)' ExtDiag(idx)%unit = 'n/a' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%w_0(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%w_0(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4351,10 +3328,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst coefficient4 to calculate d(tz)/d(ts)' ExtDiag(idx)%unit = 'n/a' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%w_d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%w_d(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4362,10 +3336,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst heat content in diurnal thermocline layer' ExtDiag(idx)%unit = 'k*m' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%xt(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%xt(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4373,10 +3344,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst salinity content in diurnal thermocline layer' ExtDiag(idx)%unit = 'n/a' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%xs(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%xs(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4384,10 +3352,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst u-current content in diurnal thermocline layer' ExtDiag(idx)%unit = 'm2/s' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%xu(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%xu(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4395,10 +3360,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst v-current content in diurnal thermocline layer' ExtDiag(idx)%unit = 'm2/s' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%xv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%xv(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4406,10 +3368,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst diurnal thermocline layer thickness' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%xz(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%xz(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4417,10 +3376,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst mixed layer thickness' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%zm(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%zm(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4428,21 +3384,15 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst d(xt)/d(ts)' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%xtts(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - + ExtDiag(idx)%data%var2 => sfcprop%xtts(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'xzts' ExtDiag(idx)%desc = 'nsst d(xt)/d(ts)' ExtDiag(idx)%unit = 'm/k' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%xzts(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%xzts(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4450,10 +3400,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst thickness of free convection layer' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%d_conv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%d_conv(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4461,10 +3408,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst index to start dtlm run or not' ExtDiag(idx)%unit = 'n/a' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%ifd(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%ifd(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4472,10 +3416,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst sub-layer cooling amount' ExtDiag(idx)%unit = 'k' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%dt_cool(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%dt_cool(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4483,10 +3424,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'nsst sensible heat flux due to rainfall' ExtDiag(idx)%unit = 'W/m**2' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop%qrain(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => sfcprop%qrain(:) !--------------------------nsst variables endif @@ -4499,10 +3437,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'number concentration of water-friendly aerosols' ExtDiag(idx)%unit = 'kg-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Statein%qgrs(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%ntwa) - enddo + ExtDiag(idx)%data%var3 => Statein%qgrs(:,:,Model%ntwa) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4510,10 +3445,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'water-friendly surface aerosol source' ExtDiag(idx)%unit = 'kg-1 s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%nwfa2d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%nwfa2d(:) elseif (Model%mraerosol) then idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -4521,10 +3453,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'number concentration of water-friendly aerosols' ExtDiag(idx)%unit = 'kg-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Stateout%gq0(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%ntwa) - enddo + ExtDiag(idx)%data%var3 => Stateout%gq0(:,:,Model%ntwa) endif endif @@ -4536,10 +3465,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'number concentration of ice-friendly aerosols' ExtDiag(idx)%unit = 'kg-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Statein%qgrs(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%ntia) - enddo + ExtDiag(idx)%data%var3 => Statein%qgrs(:,:,Model%ntia) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4547,10 +3473,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'ice-friendly surface aerosol source' ExtDiag(idx)%unit = 'kg-1 s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%nifa2d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%nifa2d(:) else if (Model%mraerosol) then idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -4558,10 +3481,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'number concentration of ice-friendly aerosols' ExtDiag(idx)%unit = 'kg-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Stateout%gq0(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%ntia) - enddo + ExtDiag(idx)%data%var3 =>Stateout%gq0(:,:,Model%ntia) end if endif @@ -4584,10 +3504,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' ExtDiag(idx)%time_avg = .false. - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%thompson_ext_diag3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,num) - enddo + ExtDiag(idx)%data%var3 =>IntDiag%thompson_ext_diag3d(:,:,num) enddo end if thompson_extended_diagnostics @@ -4598,10 +3515,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'smoke concentration' ExtDiag(idx)%unit = 'kg kg-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Statein%qgrs(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%ntfsmoke) - enddo + ExtDiag(idx)%data%var3 => Statein%qgrs(:,:,Model%ntfsmoke) endif if (Model%rrfs_sd .and. Model%ntsmoke>0) then @@ -4612,10 +3526,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface fire heat flux' ExtDiag(idx)%unit = 'W m-2' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%fire_heat_flux(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%fire_heat_flux(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4623,10 +3534,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'ration of the burnt area to the grid cell area' ExtDiag(idx)%unit = 'frac' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%frac_grid_burned(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%frac_grid_burned(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4634,10 +3542,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'emission of fine dust for smoke' ExtDiag(idx)%unit = 'ug m-2 s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%emdust(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%emdust(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4645,10 +3550,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'emission of seas for smoke' ExtDiag(idx)%unit = 'ug m-2 s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%emseas(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%emseas(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4656,10 +3558,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'emission of anoc for thompson mp' ExtDiag(idx)%unit = 'ug m-2 s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%emanoc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%emanoc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4667,10 +3566,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'coeff bb for smoke' ExtDiag(idx)%unit = '' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%coef_bb_dc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%coef_bb_dc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4678,10 +3574,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'minimum smoke plume height' ExtDiag(idx)%unit = '' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%min_fplume(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%min_fplume(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4689,10 +3582,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'maximum smoke plume height' ExtDiag(idx)%unit = '' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%max_fplume(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%max_fplume(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4700,20 +3590,15 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'hourly fire weather potential' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%rrfs_hwp(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%rrfs_hwp(:) + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'HWP_ave' ExtDiag(idx)%desc = 'averaged fire weather potential' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%rrfs_hwp_ave(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%rrfs_hwp_ave(:) extended_smoke_dust_diagnostics: if ( Model%extended_sd_diags ) then @@ -4723,10 +3608,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'BL average wind speed' ExtDiag(idx)%unit = '' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%uspdavg(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%uspdavg(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4734,10 +3616,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'BL depth modified parcel method' ExtDiag(idx)%unit = '' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%hpbl_thetav(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Coupling%hpbl_thetav(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4745,10 +3624,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'dry deposition smoke' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%drydep_flux(Model%chunk_begin(nb):Model%chunk_end(nb),1) - enddo + ExtDiag(idx)%data%var2 => Coupling%drydep_flux(:,1) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4756,10 +3632,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'dry deposition dust' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%drydep_flux(Model%chunk_begin(nb):Model%chunk_end(nb),2) - enddo + ExtDiag(idx)%data%var2 => Coupling%drydep_flux(:,2) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4767,10 +3640,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'dry deposition coarsepm' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%drydep_flux(Model%chunk_begin(nb):Model%chunk_end(nb),3) - enddo + ExtDiag(idx)%data%var2 => Coupling%drydep_flux(:,3) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4778,10 +3648,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'resolved wet deposition smoke' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%wetdpr_flux(Model%chunk_begin(nb):Model%chunk_end(nb),1) - enddo + ExtDiag(idx)%data%var2 => Coupling%wetdpr_flux(:,1) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4789,10 +3656,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'resolved wet deposition dust' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%wetdpr_flux(Model%chunk_begin(nb):Model%chunk_end(nb),2) - enddo + ExtDiag(idx)%data%var2 => Coupling%wetdpr_flux(:,2) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4800,10 +3664,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'resolved wet deposition coarsepm' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%wetdpr_flux(Model%chunk_begin(nb):Model%chunk_end(nb),3) - enddo + ExtDiag(idx)%data%var2 => Coupling%wetdpr_flux(:,3) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4811,10 +3672,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'convective wet deposition smoke' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%wetdpc_flux(Model%chunk_begin(nb):Model%chunk_end(nb),1) - enddo + ExtDiag(idx)%data%var2 => Coupling%wetdpc_flux(:,1) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4822,10 +3680,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'convective wet deposition dust' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%wetdpc_flux(Model%chunk_begin(nb):Model%chunk_end(nb),2) - enddo + ExtDiag(idx)%data%var2 => Coupling%wetdpc_flux(:,2) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4833,10 +3688,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'convective wet deposition coarsepm' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling%wetdpc_flux(Model%chunk_begin(nb):Model%chunk_end(nb),3) - enddo + ExtDiag(idx)%data%var2 => Coupling%wetdpc_flux(:,3) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4844,10 +3696,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'hour of peak smoke emissions' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%peak_hr(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%peak_hr(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4855,10 +3704,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'fire type' ExtDiag(idx)%unit = '' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%int2 => Sfcprop%fire_type(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%int2 => Sfcprop%fire_type(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4866,10 +3712,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'lu nofire pixes' ExtDiag(idx)%unit = '' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lu_nofire(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lu_nofire(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4877,10 +3720,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'lu qfire pixes' ExtDiag(idx)%unit = '' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%lu_qfire(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%lu_qfire(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4888,24 +3728,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'coefficient to scale the fire activity depending on the fire duration' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%fhist(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%fhist(:) if (Model%ebb_dcycle == 2 ) then - - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'fire_end_hr' - ExtDiag(idx)%desc = 'Hours since fire was last detected' - ExtDiag(idx)%unit = 'hrs' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%smoke2d_RRFS(Model%chunk_begin(nb):Model%chunk_end(nb),3) - enddo - + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'fire_end_hr' + ExtDiag(idx)%desc = 'Hours since fire was last detected' + ExtDiag(idx)%unit = 'hrs' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%data%var2 => Sfcprop%smoke2d_RRFS(:,3) endif endif extended_smoke_dust_diagnostics @@ -4916,10 +3748,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'smoke emission' 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)%var3 => Coupling%ebu_smoke(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Coupling%ebu_smoke(:,:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4927,11 +3756,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'input smoke emission' ExtDiag(idx)%unit = 'ug m-2 s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%ebb_smoke_in(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - + ExtDiag(idx)%data%var2 => Sfcprop%ebb_smoke_in(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4939,10 +3764,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'output frp' ExtDiag(idx)%unit = 'mw' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%frp_output(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%frp_output(:) smoke_forecast_mode: if (Model%ebb_dcycle == 2 ) then @@ -4952,10 +3774,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Total EBB Emissions' ExtDiag(idx)%unit = 'ug m-2 s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%smoke2d_RRFS(Model%chunk_begin(nb):Model%chunk_end(nb),1) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%smoke2d_RRFS(:,1) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4963,11 +3782,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Daily mean Fire Radiative Power' ExtDiag(idx)%unit = 'mw' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%smoke2d_RRFS(Model%chunk_begin(nb):Model%chunk_end(nb),2) - enddo - + ExtDiag(idx)%data%var2 => Sfcprop%smoke2d_RRFS(:,2) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4975,10 +3790,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Daily mean Hourly Wildfire Potential' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%smoke2d_RRFS(Model%chunk_begin(nb):Model%chunk_end(nb),4) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%smoke2d_RRFS(:,4) endif smoke_forecast_mode @@ -4988,10 +3800,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = '3d total extinction at 550nm' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Radtend%ext550(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Radtend%ext550(:,:) endif do i=1,Model%num_dfi_radar @@ -5006,11 +3815,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'K s-1' ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%time_avg = .FALSE. - - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Tbd%dfi_radar_tten(Model%chunk_begin(nb):Model%chunk_end(nb),:,i) - enddo + ExtDiag(idx)%data%var3 => Tbd%dfi_radar_tten(:,:,i) enddo if(Model%lightning_threat) then @@ -5022,10 +3827,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' ! CCPP physics units are flashes per minute ExtDiag(idx)%cnvfac = 5.0_kind_phys - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ltg1_max(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%ltg1_max(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -5035,10 +3837,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' ! CCPP physics units are flashes per minute ExtDiag(idx)%cnvfac = 5.0_kind_phys - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ltg2_max(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%ltg2_max(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -5048,10 +3847,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' ! CCPP physics units are flashes per minute ExtDiag(idx)%cnvfac = 5.0_kind_phys - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ltg3_max(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%ltg3_max(:) endif ! Cloud effective radii from Microphysics @@ -5063,30 +3859,23 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'effective radius of cloud liquid water particle' ExtDiag(idx)%unit = 'um' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Tbd%phy_f3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%nleffr) - enddo + ExtDiag(idx)%data%var3 => Tbd%phy_f3d(:,:,Model%nleffr) + idx = idx + 1 ExtDiag(idx)%axes = 3 ExtDiag(idx)%name = 'cieffr' ExtDiag(idx)%desc = 'effective radius of stratiform cloud ice particle in um' ExtDiag(idx)%unit = 'um' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Tbd%phy_f3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%nieffr) - enddo + ExtDiag(idx)%data%var3 => Tbd%phy_f3d(:,:,Model%nieffr) + idx = idx + 1 ExtDiag(idx)%axes = 3 ExtDiag(idx)%name = 'cseffr' ExtDiag(idx)%desc = 'effective radius of stratiform cloud snow particle in um' ExtDiag(idx)%unit = 'um' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Tbd%phy_f3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%nseffr) - enddo + ExtDiag(idx)%data%var3 => Tbd%phy_f3d(:,:,Model%nseffr) endif !MYNN @@ -5098,10 +3887,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'height of highest plume' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%ztop_plume(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%ztop_plume(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -5109,10 +3895,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'maximum mass-flux in column' ExtDiag(idx)%unit = 'm s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%maxmf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%maxmf(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -5120,10 +3903,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'maximum width of plumes in grid column' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%maxwidth(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => IntDiag%maxwidth(:) endif if (Model%do_mynnsfclay) then @@ -5133,10 +3913,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'monin obukhov surface stability parameter' ExtDiag(idx)%unit = 'n/a' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%zol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%zol(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -5144,10 +3921,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface exchange coefficient for heat' ExtDiag(idx)%unit = 'W m-2 K-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%flhc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%flhc(:) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -5155,10 +3929,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'surface exchange coefficient for moisture' ExtDiag(idx)%unit = 'kg m-2 s-1' ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop%flqc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + ExtDiag(idx)%data%var2 => Sfcprop%flqc(:) endif if (Model%do_mynnedmf) then @@ -5168,10 +3939,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'subgrid cloud fraction' ExtDiag(idx)%unit = 'frac' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Tbd%CLDFRA_BL(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Tbd%CLDFRA_BL(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5179,10 +3947,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'subgrid cloud mixing ratio' ExtDiag(idx)%unit = 'frac' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Tbd%QC_BL(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Tbd%QC_BL(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5190,10 +3955,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'turbulent mixing length' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Tbd%el_pbl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Tbd%el_pbl(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5201,10 +3963,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = '2 X TKE (from mynn)' ExtDiag(idx)%unit = 'm2 s-2' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Tbd%QKE(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => Tbd%QKE(:,:) if (Model%bl_mynn_output > 0) then @@ -5214,10 +3973,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'updraft area fraction (from mynn)' ExtDiag(idx)%unit = '-' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%edmf_a(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%edmf_a(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5225,10 +3981,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'mean updraft vertical veloctity (mynn)' ExtDiag(idx)%unit = 'm s-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%edmf_w(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%edmf_w(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5236,10 +3989,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'updraft total water (from mynn)' ExtDiag(idx)%unit = 'kg kg-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%edmf_qt(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%edmf_qt(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5247,10 +3997,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'mean liquid potential temperature (mynn)' ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%edmf_thl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%edmf_thl(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5258,10 +4005,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'updraft entrainment rate (from mynn)' ExtDiag(idx)%unit = 'm-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%edmf_ent(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%edmf_ent(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5269,10 +4013,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'mean updraft liquid water (mynn)' ExtDiag(idx)%unit = 'kg kg-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%edmf_qc(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%edmf_qc(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5280,10 +4021,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'subsidence temperature tendency (from mynn)' ExtDiag(idx)%unit = 'K s-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%sub_thl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%sub_thl(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5291,10 +4029,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'subsidence water vapor tendency (mynn)' ExtDiag(idx)%unit = 'kg kg-1 s-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%sub_sqv(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%sub_sqv(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5302,10 +4037,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'detrainment temperature tendency (from mynn)' ExtDiag(idx)%unit = 'K s-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%det_thl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + ExtDiag(idx)%data%var3 => IntDiag%det_thl(:,:) idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -5313,11 +4045,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'detrainment water vapor tendency (mynn)' ExtDiag(idx)%unit = 'kg kg-1 s-1' ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%det_sqv(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - + ExtDiag(idx)%data%var3 => IntDiag%det_sqv(:,:) endif endif @@ -5377,10 +4105,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' ExtDiag(idx)%time_avg = Model%aux2d_time_avg(num) - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag%aux2d(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + ExtDiag(idx)%data%var2 => IntDiag%aux2d(:,num) enddo ! Auxiliary 3d arrays to output (for debugging) @@ -5394,61 +4119,31 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' ExtDiag(idx)%intpl_method = 'bilinear' ExtDiag(idx)%time_avg = Model%aux3d_time_avg(num) - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag%aux3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,num) - enddo + ExtDiag(idx)%data%var3 => IntDiag%aux3d(:,:,num) enddo end subroutine GFS_externaldiag_populate - subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one, nblks) + subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one) implicit none type(GFS_externaldiag_type), intent(inout) :: ExtDiag(:) type(GFS_control_type), intent(in) :: Model type(GFS_sfcprop_type), intent(in) :: Sfcprop integer, intent(inout) :: idx - integer, intent(in) :: nblks real(kind=kind_phys), intent(in) :: cn_one character(:), allocatable :: fullname - integer :: nk, idx0, iblk - - do iblk=1,nblks - call link_all_levels(Sfcprop%lake_snow_z3d(Model%chunk_begin(iblk):Model%chunk_end(iblk),:), 'lake_snow_z3d', 'lake snow level depth', 'm') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop%lake_snow_dz3d(Model%chunk_begin(iblk):Model%chunk_end(iblk),:), 'lake_snow_dz3d', 'lake snow level thickness', 'm') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop%lake_snow_zi3d(Model%chunk_begin(iblk):Model%chunk_end(iblk),:), 'lake_snow_zi3d', 'lake snow interface depth', 'm') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop%lake_h2osoi_vol3d(Model%chunk_begin(iblk):Model%chunk_end(iblk),:), 'lake_h2osoi_vol3d', 'volumetric soil water', 'm3 m-3') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop%lake_h2osoi_liq3d(Model%chunk_begin(iblk):Model%chunk_end(iblk),:), 'lake_h2osoi_liq3d', 'soil liquid water content', 'kg m-2') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop%lake_h2osoi_ice3d(Model%chunk_begin(iblk):Model%chunk_end(iblk),:), 'lake_h2osoi_ice3d', 'soil ice water content', 'kg m-2') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop%lake_t_soisno3d(Model%chunk_begin(iblk):Model%chunk_end(iblk),:), 'lake_t_soisno3d', 'snow or soil level temperature', 'K') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop%lake_t_lake3d(Model%chunk_begin(iblk):Model%chunk_end(iblk),:), 'lake_t_lake3d', 'lake layer temperature', 'K') - enddo + integer :: nk, idx0 - do iblk=1,nblks - call link_all_levels(Sfcprop%lake_icefrac3d(Model%chunk_begin(iblk):Model%chunk_end(iblk),:), 'lake_icefrac3d', 'lake fractional ice cover', 'fraction') - enddo + call link_all_levels(Sfcprop%lake_snow_z3d(:,:), 'lake_snow_z3d', 'lake snow level depth', 'm') + call link_all_levels(Sfcprop%lake_snow_dz3d(:,:), 'lake_snow_dz3d', 'lake snow level thickness', 'm') + call link_all_levels(Sfcprop%lake_snow_zi3d(:,:), 'lake_snow_zi3d', 'lake snow interface depth', 'm') + call link_all_levels(Sfcprop%lake_h2osoi_vol3d(:,:), 'lake_h2osoi_vol3d', 'volumetric soil water', 'm3 m-3') + call link_all_levels(Sfcprop%lake_h2osoi_liq3d(:,:), 'lake_h2osoi_liq3d', 'soil liquid water content', 'kg m-2') + call link_all_levels(Sfcprop%lake_h2osoi_ice3d(:,:), 'lake_h2osoi_ice3d', 'soil ice water content', 'kg m-2') + call link_all_levels(Sfcprop%lake_t_soisno3d(:,:), 'lake_t_soisno3d', 'snow or soil level temperature', 'K') + call link_all_levels(Sfcprop%lake_t_lake3d(:,:), 'lake_t_lake3d', 'lake layer temperature', 'K') + call link_all_levels(Sfcprop%lake_icefrac3d(:,:), 'lake_icefrac3d', 'lake fractional ice cover', 'fraction') contains @@ -5458,36 +4153,24 @@ subroutine link_all_levels(var3d, varname, levelname, unit) character(len=*), intent(in) :: varname, levelname, unit integer k, b, namelen - if(iblk==1) then - namelen = 30+max(len(varname),len(levelname)) - allocate(character(namelen) :: fullname) - idx0 = idx - endif + namelen = 30+max(len(varname),len(levelname)) + allocate(character(namelen) :: fullname) + idx0 = idx var_z_loop: do k=1,size(var3d,2) - idx = idx0 + k - if(iblk==1) then - ExtDiag(idx)%axes = 2 - write(fullname,"(A,'_',I0)") trim(varname),k - ExtDiag(idx)%name = trim(fullname) - write(fullname,"(A,' level ',I0,' of ',I0)") trim(levelname),k,size(var3d,2) - ExtDiag(idx)%desc = trim(fullname) - ExtDiag(idx)%unit = trim(unit) - ExtDiag(idx)%mod_name = 'gfs_sfc' - ExtDiag(idx)%intpl_method = 'nearest_stod' - - allocate (ExtDiag(idx)%data(nblks)) - do b=1,nblks - nullify(ExtDiag(idx)%data(b)%var2) - enddo - endif - - ExtDiag(idx)%data(iblk)%var2 => var3d(:,k) + idx = idx0 + k + ExtDiag(idx)%axes = 2 + write(fullname,"(A,'_',I0)") trim(varname),k + ExtDiag(idx)%name = trim(fullname) + write(fullname,"(A,' level ',I0,' of ',I0)") trim(levelname),k,size(var3d,2) + ExtDiag(idx)%desc = trim(fullname) + ExtDiag(idx)%unit = trim(unit) + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + ExtDiag(idx)%data%var2 => var3d(:,k) enddo var_z_loop - if(iblk==nblks) then - deallocate(fullname) - endif + deallocate(fullname) end subroutine link_all_levels end subroutine clm_lake_externaldiag_populate diff --git a/ccpp/driver/GFS_init.F90 b/ccpp/driver/GFS_init.F90 index 694bacdc5..af1b768bc 100644 --- a/ccpp/driver/GFS_init.F90 +++ b/ccpp/driver/GFS_init.F90 @@ -49,7 +49,6 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & type(GFS_init_type), intent(in) :: Init_parm !--- local variables - integer :: nb integer :: nblks integer :: nt integer :: nthrds diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index d82a1b89f..2af537395 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -10,19 +10,16 @@ module GFS_restart use GFS_diagnostics, only: GFS_externaldiag_type type var_subtype - real(kind=kind_phys), pointer :: var2p(:) => null() !< 2D data saved in packed format [dim(ix)] - real(kind=kind_phys), pointer :: var3p(:,:) => null() !< 3D data saved in packed format [dim(ix,levs)] + real(kind=kind_phys), dimension(:), pointer :: var2 => null() + real(kind=kind_phys), dimension(:,:), pointer :: var3 => null() end type var_subtype type GFS_restart_type - integer :: num2d !< current number of registered 2D restart variables - integer :: num3d !< current number of registered 3D restart variables - integer :: fdiag !< index of first diagnostic field in restart file - integer :: ldiag !< index of last diagnostic field in restart file - - character(len=32), allocatable :: name2d(:) !< variable name as it will appear in the restart file - character(len=32), allocatable :: name3d(:) !< variable name as it will appear in the restart file - type(var_subtype), allocatable :: data(:,:) !< holds pointers to data in packed format (allocated to (nblks,max(2d/3dfields)) + integer :: axes !< Rank of data (2D or 3D). + logical :: diag !< True for diagnostic field. + logical :: reset !< If true, zero out diagnostic field. + character(len=32) :: name !< variable name as it will appear in the restart file. + type(var_subtype) :: data !< Holds pointers to contiguous data. end type GFS_restart_type public GFS_restart_type, GFS_restart_populate @@ -33,18 +30,19 @@ module GFS_restart !--------------------- ! GFS_restart_populate !--------------------- - subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & - Coupling, Grid, Tbd, Cldprop, Radtend, IntDiag, Init_parm, ExtDiag) + subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & + Coupling, Grid, Tbd, Cldprop, Radtend, IntDiag, & + Init_parm, ExtDiag) !----------------------------------------------------------------------------------------! -! RESTART_METADATA ! -! Restart%num2d [int*4 ] number of 2D variables to output ! -! Restart%num3d [int*4 ] number of 3D variables to output ! -! Restart%name2d [char=32] variable name in restart file ! -! Restart%name3d [char=32] variable name in restart file ! -! Restart%fld2d(:,:,:) [real*8 ] pointer to 2D data (im,nblks,MAX_RSTRT) ! -! Restart%fld3d(:,:,:,:) [real*8 ] pointer to 3D data (im,levs,nblks,MAX_RSTRT) ! +! RESTART_METADATA ! +! Restart%axes [int*4 ] Number of axes (rank) of variable ! +! Restart%diag [logical] Flag to indicate diagnostic variable ! +! Restart%reset [logical] Flag to indicate diagnostics need to be reset ! +! Restart%name [char=32] Variable name in restart file ! +! Restart%data%var2(:) [real*8 ] pointer to 2D data (im) ! +! Restart%data%var3(:,:) [real*8 ] pointer to 3D data (im,levs) ! !----------------------------------------------------------------------------------------! - type(GFS_restart_type), intent(inout) :: Restart + type(GFS_restart_type), intent(inout), allocatable :: Restart(:) type(GFS_control_type), intent(in) :: Model type(GFS_statein_type), intent(in) :: Statein type(GFS_stateout_type), intent(in) :: Stateout @@ -61,15 +59,13 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & !--- local variables integer :: idx, ndiag_rst integer :: ndiag_idx(20), itime - integer :: nblks, num, nb, max_rstrt, offset + integer :: num, offset character(len=2) :: c2 = '' logical :: surface_layer_saves_rainprev - - nblks = size(Init_parm%blksz) - max_rstrt = size(Restart%name2d) + integer :: num2d, num3d !--- check if continuous accumulated total precip and total cnvc precip are - !requested in output + ! requested in output. If so, store location into Diagnsotic type. ndiag_rst = 0 ndiag_idx(1:20) = 0 do idx=1, size(ExtDiag) @@ -101,11 +97,9 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & endif endif enddo - - ! Store first and last index of diagnostic fields: - Restart%fdiag = 3 + Model%ntot2d + Model%nctp + 1 - Restart%ldiag = 3 + Model%ntot2d + Model%nctp + ndiag_rst - Restart%num2d = 3 + Model%ntot2d + Model%nctp + ndiag_rst + + ! Number of required 2D restart variables. + num2d = 3 + Model%ntot2d + Model%nctp + ndiag_rst ! The CLM Lake Model needs raincprev and rainncprv, which some ! surface layer schemes save, and some don't. If the surface layer @@ -113,587 +107,518 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & ! separately for clm_lake. surface_layer_saves_rainprev = .false. + ! Do we have any 2D restart varaibles dependent on physics scheme? ! GF if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then - Restart%num2d = Restart%num2d + 3 + num2d = num2d + 3 endif ! Unified convection if (Model%imfdeepcnv == Model%imfdeepcnv_c3) then - Restart%num2d = Restart%num2d + 3 + num2d = num2d + 3 endif ! CA if (Model%imfdeepcnv == 2 .and. Model%do_ca) then - Restart%num2d = Restart%num2d + 1 + num2d = num2d + 1 endif ! NoahMP if (Model%lsm == Model%lsm_noahmp) then - Restart%num2d = Restart%num2d + 10 - surface_layer_saves_rainprev = .true. + num2d = num2d + 10 + surface_layer_saves_rainprev = .true. endif ! RUC if (Model%lsm == Model%lsm_ruc) then - Restart%num2d = Restart%num2d + 5 - surface_layer_saves_rainprev = .true. + num2d = num2d + 5 + surface_layer_saves_rainprev = .true. endif ! MYNN SFC if (Model%do_mynnsfclay) then - Restart%num2d = Restart%num2d + 13 + num2d = num2d + 13 endif ! Save rain prev for lake if surface layer doesn't. if (Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm .and. & .not.surface_layer_saves_rainprev) then - Restart%num2d = Restart%num2d + 2 + num2d = num2d + 2 endif ! Thompson aerosol-aware if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then - Restart%num2d = Restart%num2d + 2 + num2d = num2d + 2 endif if (Model%do_cap_suppress .and. Model%num_dfi_radar>0) then - Restart%num2d = Restart%num2d + Model%num_dfi_radar + num2d = num2d + Model%num_dfi_radar endif if (Model%rrfs_sd) then - Restart%num2d = Restart%num2d + 6 + num2d = num2d + 6 endif - Restart%num3d = Model%ntot3d + ! Number of required 3D restart variables. + num3d = Model%ntot3d + + ! Do we have any 3D restart varaibles dependent on physics scheme? if (Model%num_dfi_radar>0) then - Restart%num3d = Restart%num3d + Model%num_dfi_radar + num3d = num3d + Model%num_dfi_radar endif if(Model%lrefres) then - Restart%num3d = Model%ntot3d+1 + num3d = Model%ntot3d+1 endif ! General Convection if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then - Restart%num3d = Restart%num3d + 1 + num3d = num3d + 1 endif ! GF if (Model%imfdeepcnv == 3) then - Restart%num3d = Restart%num3d + 3 + num3d = num3d + 3 endif ! Unified convection if (Model%imfdeepcnv == 5) then - Restart%num3d = Restart%num3d + 4 + num3d = num3d + 4 endif ! MYNN PBL if (Model%do_mynnedmf) then - Restart%num3d = Restart%num3d + 9 + num3d = num3d + 9 endif if (Model%rrfs_sd) then - Restart%num3d = Restart%num3d + 4 + num3d = num3d + 4 endif !Prognostic area fraction if (Model%progsigma) then - Restart%num3d = Restart%num3d + 2 + num3d = num3d + 2 endif if (Model%num_dfi_radar > 0) then do itime=1,Model%dfi_radar_max_intervals if(Model%ix_dfi_radar(itime)>0) then - Restart%num3d = Restart%num3d + 1 + num3d = num3d + 1 endif enddo endif - allocate (Restart%name2d(Restart%num2d)) - allocate (Restart%name3d(Restart%num3d)) - allocate (Restart%data(nblks,max(Restart%num2d,Restart%num3d))) - - Restart%name2d(:) = ' ' - Restart%name3d(:) = ' ' + !--- Allocate Restart data type. + allocate (Restart(num2d+num3d)) + Restart(:)%diag = .false. + Restart(:)%reset = .false. + idx = 0 !--- Cldprop variables - Restart%name2d(1) = 'cv' - Restart%name2d(2) = 'cvt' - Restart%name2d(3) = 'cvb' - do nb = 1,nblks - Restart%data(nb,1)%var2p => Cldprop%cv(Model%chunk_begin(nb):Model%chunk_end(nb)) - Restart%data(nb,2)%var2p => Cldprop%cvt(Model%chunk_begin(nb):Model%chunk_end(nb)) - Restart%data(nb,3)%var2p => Cldprop%cvb(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'cv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Cldprop%cv(:) + + idx = idx + 1 + Restart(idx)%name = 'cvt' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Cldprop%cvt(:) + + idx = idx + 1 + Restart(idx)%name = 'cvb' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Cldprop%cvb(:) !--- phy_f2d variables - offset = 3 do num = 1,Model%ntot2d + idx = idx + 1 !--- set the variable name write(c2,'(i2.2)') num - Restart%name2d(num+offset) = 'phy_f2d_'//c2 - do nb = 1,nblks - Restart%data(nb,num+offset)%var2p => Tbd%phy_f2d(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + Restart(idx)%name = 'phy_f2d_'//c2 + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Tbd%phy_f2d(:,num) enddo - offset = offset + Model%ntot2d !--- phy_fctd variables if (Model%nctp > 0) then do num = 1, Model%nctp - !--- set the variable name + idx = idx + 1 + !--- set the variable name write(c2,'(i2.2)') num - Restart%name2d(num+offset) = 'phy_fctd_'//c2 - do nb = 1,nblks - Restart%data(nb,num+offset)%var2p => Tbd%phy_fctd(Model%chunk_begin(nb):Model%chunk_end(nb),num) - enddo + Restart(idx)%name = 'phy_fctd_'//c2 + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Tbd%phy_fctd(:,num) enddo - offset = offset + Model%nctp endif !--- Diagnostic variables - do idx = 1,ndiag_rst - if( ndiag_idx(idx) > 0 ) then - Restart%name2d(offset+idx) = trim(ExtDiag(ndiag_idx(idx))%name) - do nb = 1,nblks - Restart%data(nb,offset+idx)%var2p => ExtDiag(ndiag_idx(idx))%data(nb)%var2 - enddo + do num = 1,ndiag_rst + if( ndiag_idx(num) > 0 ) then + idx = idx + 1 + Restart(idx)%name = trim(ExtDiag(ndiag_idx(num))%name) + Restart(idx)%axes = 2 + Restart(idx)%diag = .true. + Restart(idx)%reset = .true. + Restart(idx)%data%var2 => ExtDiag(ndiag_idx(num))%data%var2(:) endif -! print *,'in restart 2d field, Restart%name2d(',offset+idx,')=',trim(Restart%name2d(offset+idx)) enddo - num = offset + ndiag_rst !--- Celluluar Automaton, 2D !CA if (Model%imfdeepcnv == 2 .and. Model%do_ca) then - num = num + 1 - Restart%name2d(num) = 'ca_condition' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Coupling%condition(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'ca_condition' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Coupling%condition(:) endif ! Unified convection if (Model%imfdeepcnv == Model%imfdeepcnv_c3) then - num = num + 1 - Restart%name2d(num) = 'gf_2d_conv_act' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%conv_act(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'gf_2d_conv_act_m' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%conv_act_m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'aod_gf' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Tbd%aod_gf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'gf_2d_conv_act' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%conv_act(:) + idx = idx + 1 + Restart(idx)%name = 'gf_2d_conv_act_m' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%conv_act_m(:) + idx = idx + 1 + Restart(idx)%name = 'aod_gf' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Tbd%aod_gf(:) endif !--- RAP/HRRR-specific variables, 2D ! GF if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then - num = num + 1 - Restart%name2d(num) = 'gf_2d_conv_act' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%conv_act(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'gf_2d_conv_act_m' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%conv_act_m(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'aod_gf' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Tbd%aod_gf(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'gf_2d_conv_act' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%conv_act(:) + idx = idx + 1 + Restart(idx)%name = 'gf_2d_conv_act_m' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%conv_act_m(:) + idx = idx + 1 + Restart(idx)%name = 'aod_gf' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Tbd%aod_gf(:) endif ! NoahMP if (Model%lsm == Model%lsm_noahmp) then - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_raincprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%raincprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_rainncprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%rainncprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_iceprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%iceprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_snowprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%snowprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_graupelprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%graupelprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_draincprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%draincprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_drainncprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%drainncprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_diceprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%diceprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_dsnowprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%dsnowprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'noahmp_2d_dgraupelprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%dgraupelprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_raincprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%raincprv(:) + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_rainncprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%rainncprv(:) + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_iceprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%iceprv(:) + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_snowprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%snowprv(:) + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_graupelprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%graupelprv(:) + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_draincprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%draincprv(:) + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_drainncprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%drainncprv(:) + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_diceprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%diceprv(:) + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_dsnowprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%dsnowprv(:) + idx = idx + 1 + Restart(idx)%name = 'noahmp_2d_dgraupelprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%dgraupelprv(:) endif ! RUC if (Model%lsm == Model%lsm_ruc) then - num = num + 1 - Restart%name2d(num) = 'ruc_2d_raincprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%raincprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'ruc_2d_rainncprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%rainncprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'ruc_2d_iceprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%iceprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'ruc_2d_snowprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%snowprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'ruc_2d_graupelprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%graupelprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'ruc_2d_raincprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%raincprv(:) + idx = idx + 1 + Restart(idx)%name = 'ruc_2d_rainncprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%rainncprv(:) + idx = idx + 1 + Restart(idx)%name = 'ruc_2d_iceprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%iceprv(:) + idx = idx + 1 + Restart(idx)%name = 'ruc_2d_snowprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%snowprv(:) + idx = idx + 1 + Restart(idx)%name = 'ruc_2d_graupelprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%graupelprv(:) endif ! MYNN SFC if (Model%do_mynnsfclay) then - num = num + 1 - Restart%name2d(num) = 'mynn_2d_uustar' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%uustar(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_hpbl' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Tbd%hpbl(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_ustm' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%ustm(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_zol' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%zol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_mol' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%mol(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_flhc' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%flhc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_flqc' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%flqc(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_chs2' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%chs2(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_cqs2' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%cqs2(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_lh' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%lh(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_hflx' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%hflx(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_evap' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%evap(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'mynn_2d_qss' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%qss(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_uustar' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%uustar(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_hpbl' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Tbd%hpbl(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_ustm' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%ustm(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_zol' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%zol(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_mol' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%mol(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_flhc' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%flhc(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_flqc' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%flqc(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_chs2' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%chs2(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_cqs2' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%cqs2(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_lh' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%lh(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_hflx' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%hflx(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_evap' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%evap(:) + idx = idx + 1 + Restart(idx)%name = 'mynn_2d_qss' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%qss(:) endif ! Save rain prev for lake if surface layer doesn't. if (Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm .and. & .not.surface_layer_saves_rainprev) then - num = num + 1 - Restart%name2d(num) = 'raincprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%raincprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'rainncprv' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Sfcprop%rainncprv(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'raincprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%raincprv(:) + idx = idx + 1 + Restart(idx)%name = 'rainncprv' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Sfcprop%rainncprv(:) endif ! Thompson aerosol-aware if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then - num = num + 1 - Restart%name2d(num) = 'thompson_2d_nwfa2d' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Coupling%nwfa2d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'thompson_2d_nifa2d' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Coupling%nifa2d(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'thompson_2d_nwfa2d' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Coupling%nwfa2d(:) + idx = idx + 1 + Restart(idx)%name = 'thompson_2d_nifa2d' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Coupling%nifa2d(:) endif ! Convection suppression if (Model%do_cap_suppress .and. Model%num_dfi_radar > 0) then do itime=1,Model%dfi_radar_max_intervals if(Model%ix_dfi_radar(itime)>0) then - num = num + 1 + idx = idx + 1 if(itime==1) then - Restart%name2d(num) = 'cap_suppress' + Restart(idx)%name = 'cap_suppress' else - write(Restart%name2d(num),'("cap_suppress_",I0)') itime + write(Restart(idx)%name,'("cap_suppress_",I0)') itime endif - do nb = 1,nblks - Restart%data(nb,num)%var2p => Tbd%cap_suppress(Model%chunk_begin(nb):Model%chunk_end(nb),Model%ix_dfi_radar(itime)) - enddo + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Tbd%cap_suppress(:,Model%ix_dfi_radar(itime)) endif enddo endif ! RRFS-SD if (Model%rrfs_sd) then - num = num + 1 - Restart%name2d(num) = 'ddvel_1' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Coupling%ddvel(Model%chunk_begin(nb):Model%chunk_end(nb),1) - enddo - num = num + 1 - Restart%name2d(num) = 'ddvel_2' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Coupling%ddvel(Model%chunk_begin(nb):Model%chunk_end(nb),2) - enddo - num = num + 1 - Restart%name2d(num) = 'min_fplume' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Coupling%min_fplume(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'max_fplume' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Coupling%max_fplume(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'rrfs_hwp' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Coupling%rrfs_hwp(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo - num = num + 1 - Restart%name2d(num) = 'rrfs_hwp_ave' - do nb = 1,nblks - Restart%data(nb,num)%var2p => Coupling%rrfs_hwp_ave(Model%chunk_begin(nb):Model%chunk_end(nb)) - enddo + idx = idx + 1 + Restart(idx)%name = 'ddvel_1' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Coupling%ddvel(:,1) + idx = idx + 1 + Restart(idx)%name = 'ddvel_2' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Coupling%ddvel(:,2) + idx = idx + 1 + Restart(idx)%name = 'min_fplume' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Coupling%min_fplume(:) + idx = idx + 1 + Restart(idx)%name = 'max_fplume' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Coupling%max_fplume(:) + idx = idx + 1 + Restart(idx)%name = 'rrfs_hwp' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Coupling%rrfs_hwp(:) + idx = idx + 1 + Restart(idx)%name = 'rrfs_hwp_ave' + Restart(idx)%axes = 2 + Restart(idx)%data%var2 => Coupling%rrfs_hwp_ave(:) endif !--- phy_f3d variables do num = 1,Model%ntot3d - !--- set the variable name + idx = idx + 1 + !--- set the variable name write(c2,'(i2.2)') num - Restart%name3d(num) = 'phy_f3d_'//c2 - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%phy_f3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,num) - enddo - enddo - if (Model%lrefres) then - num = Model%ntot3d+1 - restart%name3d(num) = 'ref_f3d' - do nb = 1,nblks - Restart%data(nb,num)%var3p => IntDiag%refl_10cm(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - endif - if (Model%lrefres) then - num = Model%ntot3d+1 - else - num = Model%ntot3d - endif + Restart(idx)%name = 'phy_f3d_'//c2 + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%phy_f3d(:,:,num) + enddo + + if (Model%lrefres) then + idx = idx + 1 + Restart(idx)%name = 'ref_f3d' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => IntDiag%refl_10cm(:,:) + endif !Prognostic closure if(Model%progsigma)then - num = num + 1 - Restart%name3d(num) = 'sas_3d_qgrs_dsave' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%prevsq(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'sas_3d_dqdt_qmicro' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Coupling%dqdt_qmicro(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + idx = idx + 1 + Restart(idx)%name = 'sas_3d_qgrs_dsave' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%prevsq(:,:) + idx = idx + 1 + Restart(idx)%name = 'sas_3d_dqdt_qmicro' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Coupling%dqdt_qmicro(:,:) endif !--Convection variable used in CB cloud fraction. Presently this !--is only needed in sgscloud_radpre for imfdeepcnv == imfdeepcnv_gf. if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_c3) then - num = num + 1 - Restart%name3d(num) = 'cnv_3d_ud_mf' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%ud_mf(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + idx = idx + 1 + Restart(idx)%name = 'cnv_3d_ud_mf' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%ud_mf(:,:) endif !Unified convection scheme if (Model%imfdeepcnv == Model%imfdeepcnv_c3) then - num = num + 1 - Restart%name3d(num) = 'gf_3d_prevst' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%prevst(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'gf_3d_prevsq' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%prevsq(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'gf_3d_qci_conv' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Coupling%qci_conv(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + idx = idx + 1 + Restart(idx)%name = 'gf_3d_prevst' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%prevst(:,:) + idx = idx + 1 + Restart(idx)%name = 'gf_3d_prevsq' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%prevsq(:,:) + idx = idx + 1 + Restart(idx)%name = 'gf_3d_qci_conv' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Coupling%qci_conv(:,:) endif !--- RAP/HRRR-specific variables, 3D ! GF if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then - num = num + 1 - Restart%name3d(num) = 'gf_3d_prevst' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%prevst(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'gf_3d_prevsq' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%prevsq(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'gf_3d_qci_conv' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Coupling%qci_conv(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + idx = idx + 1 + Restart(idx)%name = 'gf_3d_prevst' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%prevst(:,:) + idx = idx + 1 + Restart(idx)%name = 'gf_3d_prevsq' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%prevsq(:,:) + idx = idx + 1 + Restart(idx)%name = 'gf_3d_qci_conv' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Coupling%qci_conv(:,:) endif ! MYNN PBL if (Model%do_mynnedmf) then - num = num + 1 - Restart%name3d(num) = 'mynn_3d_cldfra_bl' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%cldfra_bl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'mynn_3d_qc_bl' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%qc_bl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'mynn_3d_qi_bl' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%qi_bl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'mynn_3d_el_pbl' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%el_pbl(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'mynn_3d_sh3d' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%sh3d(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'mynn_3d_qke' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%qke(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'mynn_3d_tsq' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%tsq(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'mynn_3d_qsq' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%qsq(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo - num = num + 1 - Restart%name3d(num) = 'mynn_3d_cov' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%cov(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + idx = idx + 1 + Restart(idx)%name = 'mynn_3d_cldfra_bl' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%cldfra_bl(:,:) + idx = idx + 1 + Restart(idx)%name = 'mynn_3d_qc_bl' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%qc_bl(:,:) + idx = idx + 1 + Restart(idx)%name = 'mynn_3d_qi_bl' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%qi_bl(:,:) + idx = idx + 1 + Restart(idx)%name = 'mynn_3d_el_pbl' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%el_pbl(:,:) + idx = idx + 1 + Restart(idx)%name = 'mynn_3d_sh3d' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%sh3d(:,:) + idx = idx + 1 + Restart(idx)%name = 'mynn_3d_qke' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%qke(:,:) + idx = idx + 1 + Restart(idx)%name = 'mynn_3d_tsq' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%tsq(:,:) + idx = idx + 1 + Restart(idx)%name = 'mynn_3d_qsq' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%qsq(:,:) + idx = idx + 1 + Restart(idx)%name = 'mynn_3d_cov' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%cov(:,:) endif ! Radar-derived microphysics temperature tendencies if (Model%num_dfi_radar > 0) then do itime=1,Model%dfi_radar_max_intervals if(Model%ix_dfi_radar(itime)>0) then - num = num + 1 + idx = idx + 1 if(itime==1) then - Restart%name3d(num) = 'radar_tten' + Restart(idx)%name = 'radar_tten' else - write(Restart%name3d(num),'("radar_tten_",I0)') itime + write(Restart(idx)%name,'("radar_tten_",I0)') itime endif - do nb = 1,nblks - Restart%data(nb,num)%var3p => Tbd%dfi_radar_tten( & - Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%ix_dfi_radar(itime)) - enddo + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Tbd%dfi_radar_tten(:,:,Model%ix_dfi_radar(itime)) endif enddo endif if(Model%rrfs_sd) then - num = num + 1 - Restart%name3d(num) = 'chem3d_1' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Coupling%chem3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,1) - enddo - num = num + 1 - Restart%name3d(num) = 'chem3d_2' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Coupling%chem3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,2) - enddo - num = num + 1 - Restart%name3d(num) = 'chem3d_3' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Coupling%chem3d(Model%chunk_begin(nb):Model%chunk_end(nb),:,3) - enddo - num = num + 1 - Restart%name3d(num) = 'ext550' - do nb = 1,nblks - Restart%data(nb,num)%var3p => Radtend%ext550(Model%chunk_begin(nb):Model%chunk_end(nb),:) - enddo + idx = idx + 1 + Restart(idx)%name = 'chem3d_1' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Coupling%chem3d(:,:,1) + idx = idx + 1 + Restart(idx)%name = 'chem3d_2' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Coupling%chem3d(:,:,2) + idx = idx + 1 + Restart(idx)%name = 'chem3d_3' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Coupling%chem3d(:,:,3) + idx = idx + 1 + Restart(idx)%name = 'ext550' + Restart(idx)%axes = 3 + Restart(idx)%data%var3 => Radtend%ext550(:,:) endif end subroutine GFS_restart_populate diff --git a/io/fv3atm_history_io.F90 b/io/fv3atm_history_io.F90 index 9bd102d22..a0f2fac4d 100644 --- a/io/fv3atm_history_io.F90 +++ b/io/fv3atm_history_io.F90 @@ -115,11 +115,12 @@ end subroutine fv3atm_diag_register !! This routine transfers diagnostic data to the FMS diagnostic !! manager for eventual output to the history files. subroutine fv3atm_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & - dt, time_int, time_intfull, time_radsw, time_radlw) + dt, time_int, time_intfull, time_radsw, time_radlw, Model) !--- subroutine interface variable definitions type(time_type), intent(in) :: time type(GFS_externaldiag_type), intent(in) :: diag(:) type (block_control_type), intent(in) :: atm_block + type(GFS_control_type), intent(in) :: Model integer, intent(in) :: nx, ny, levs, ntcw, ntoz real(kind=kind_phys), intent(in) :: dt real(kind=kind_phys), intent(in) :: time_int @@ -128,7 +129,7 @@ subroutine fv3atm_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & real(kind=kind_phys), intent(in) :: time_radlw call shared_history_data%output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & - dt, time_int, time_intfull, time_radsw, time_radlw) + dt, time_int, time_intfull, time_radsw, time_radlw, Model) end subroutine fv3atm_diag_output @@ -243,7 +244,7 @@ subroutine history_type_register(hist, Diag, Time, Atm_block, Model, xlon, xlat, endif endif else if (diag(idx)%axes == 3) then - hist%levo(idx) = size(Diag(idx)%data(1)%var3, dim=2) + hist%levo(idx) = size(Diag(idx)%data%var3, dim=2) if( index(trim(diag(idx)%intpl_method),'bilinear') > 0 ) then hist%nstt(idx) = nrgst_bl + 1 nrgst_bl = nrgst_bl + hist%levo(idx) @@ -281,12 +282,13 @@ end subroutine history_type_register !! implementation of the public fv3atm_diag_output routine. Never !! call this directly. subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & - dt, time_int, time_intfull, time_radsw, time_radlw) + dt, time_int, time_intfull, time_radsw, time_radlw, Model) !--- subroutine interface variable definitions class(history_type) :: hist type(time_type), intent(in) :: time type(GFS_externaldiag_type), intent(in) :: diag(:) type (block_control_type), intent(in) :: atm_block + type(GFS_control_type), intent(in) :: Model integer, intent(in) :: nx, ny, levs, ntcw, ntoz real(kind=kind_phys), intent(in) :: dt real(kind=kind_phys), intent(in) :: time_int @@ -294,7 +296,7 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, real(kind=kind_phys), intent(in) :: time_radsw real(kind=kind_phys), intent(in) :: time_radlw !--- local variables - integer :: i, j, k, idx, nb, ix, ii, jj, levo_3d + integer :: i, j, k, idx, nb, ix, ii, jj, levo_3d, im character(len=2) :: xtra #ifdef CCPP_32BIT real, dimension(nx,ny) :: var2 @@ -334,7 +336,7 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, endif if_2d: if (diag(idx)%axes == 2) then ! Integer data - int_or_real: if (associated(Diag(idx)%data(1)%int2)) then + int_or_real: if (associated(Diag(idx)%data%int2)) then if (trim(Diag(idx)%intpl_method) == 'nearest_stod') then var2(1:nx,1:ny) = 0._kind_phys do j = 1, ny @@ -343,7 +345,8 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%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) + im = Model%chunk_begin(nb)+ix-1 + var2(i,j) = real(Diag(idx)%data%int2(im), kind=kind_phys) enddo enddo call hist%store_data(Diag(idx)%id, var2, Time, idx, Diag(idx)%intpl_method, Diag(idx)%name) @@ -362,8 +365,9 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%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 + im = Model%chunk_begin(nb)+ix-1 + if (Diag(idx)%data%var21(im) > 0._kind_phys) & + var2(i,j) = max(0._kind_phys,min(1._kind_phys,Diag(idx)%data%var2(im)/Diag(idx)%data%var21(im)))*lcnvfac enddo enddo elseif (trim(Diag(idx)%mask) == 'land_ice_only') then @@ -375,7 +379,8 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%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 + im = Model%chunk_begin(nb)+ix-1 + if (Diag(idx)%data%var21(im) /= 0) var2(i,j) = Diag(idx)%data%var2(im)*lcnvfac enddo enddo elseif (trim(Diag(idx)%mask) == 'land_only') then @@ -387,7 +392,8 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%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 + im = Model%chunk_begin(nb)+ix-1 + if (Diag(idx)%data%var21(im) == 1) var2(i,j) = Diag(idx)%data%var2(im)*lcnvfac enddo enddo elseif (trim(Diag(idx)%mask) == 'cldmask') then @@ -399,7 +405,8 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%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 + im = Model%chunk_begin(nb)+ix-1 + if (Diag(idx)%data%var21(im)*100. > 0.5) var2(i,j) = Diag(idx)%data%var2(im)*lcnvfac enddo enddo elseif (trim(Diag(idx)%mask) == 'cldmask_ratio') then @@ -411,8 +418,9 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%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) + im = Model%chunk_begin(nb)+ix-1 + if (Diag(idx)%data%var21(im)*100.*lcnvfac > 0.5) var2(i,j) = Diag(idx)%data%var2(im)/ & + Diag(idx)%data%var21(im) enddo enddo elseif (trim(Diag(idx)%mask) == 'pseudo_ps') then @@ -423,7 +431,8 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%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) + im = Model%chunk_begin(nb)+ix-1 + var2(i,j) = (Diag(idx)%data%var2(im)/stndrd_atmos_ps)**(rdgas/grav*stndrd_atmos_lapse) enddo enddo else @@ -433,7 +442,8 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%isc -1 nb = Atm_block%blkno(ii,jj) ix = Atm_block%ixp(ii,jj) - var2(i,j) = Diag(idx)%data(nb)%var2(ix) + im = Model%chunk_begin(nb)+ix-1 + var2(i,j) = Diag(idx)%data%var2(im) enddo enddo endif @@ -444,10 +454,11 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%isc -1 nb = Atm_block%blkno(ii,jj) ix = Atm_block%ixp(ii,jj) - var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + im = Model%chunk_begin(nb)+ix-1 + var2(i,j) = Diag(idx)%data%var2(im)*lcnvfac enddo enddo - endif if_mask + endif if_mask endif int_or_real call hist%store_data(Diag(idx)%id, var2, Time, idx, Diag(idx)%intpl_method, Diag(idx)%name) @@ -467,11 +478,12 @@ subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ii = i + Atm_block%isc -1 nb = Atm_block%blkno(ii,jj) ix = Atm_block%ixp(ii,jj) + im = Model%chunk_begin(nb)+ix-1 ! flip only 3d variables with vertical dimension == levs (atm model levels) if (levo_3d == levs) then - var3(i,j,k) = Diag(idx)%data(nb)%var3(ix,levo_3d-k+1)*lcnvfac + var3(i,j,k) = Diag(idx)%data%var3(im,levo_3d-k+1)*lcnvfac else - var3(i,j,k) = Diag(idx)%data(nb)%var3(ix, k )*lcnvfac + var3(i,j,k) = Diag(idx)%data%var3(im, k )*lcnvfac endif enddo enddo diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 index 979c2a000..2b010c938 100644 --- a/io/fv3atm_restart_io.F90 +++ b/io/fv3atm_restart_io.F90 @@ -109,7 +109,7 @@ module fv3atm_restart_io_mod subroutine fv3atm_restart_read (GFS_Sfcprop, GFS_Restart, Atm_block, Model, fv_domain, warm_start, ignore_rst_cksum) implicit none type(GFS_sfcprop_type), intent(inout) :: GFS_Sfcprop - type(GFS_restart_type), intent(inout) :: GFS_Restart + type(GFS_restart_type), intent(inout) :: GFS_Restart(:) type(block_control_type), intent(in) :: Atm_block type(GFS_control_type), intent(inout) :: Model type(domain2d), intent(in) :: fv_domain @@ -132,7 +132,7 @@ end subroutine fv3atm_restart_read subroutine fv3atm_restart_write (GFS_Sfcprop, GFS_Restart, Atm_block, Model, fv_domain, timestamp) implicit none type(GFS_sfcprop_type), intent(inout) :: GFS_Sfcprop - type(GFS_restart_type), intent(inout) :: GFS_Restart + type(GFS_restart_type), intent(inout) :: GFS_Restart(:) type(block_control_type), intent(in) :: Atm_block type(GFS_control_type), intent(in) :: Model type(domain2d), intent(in) :: fv_domain @@ -871,13 +871,13 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain, ignore_r use atmosphere_mod, only: Atm,mygrid implicit none !--- interface variable definitions - type(GFS_restart_type), intent(in) :: GFS_Restart + type(GFS_restart_type), intent(inout) :: GFS_Restart(:) type(block_control_type), intent(in) :: Atm_block type(GFS_control_type), intent(in) :: Model type(domain2d), intent(in) :: fv_domain logical, intent(in) :: ignore_rst_cksum !--- local variables - integer :: i, j, k, nb, ix, num + integer :: i, j, k, nb, ix, num2, num3, ivar integer :: isc, iec, jsc, jec, nx, ny character(len=64) :: fname real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() @@ -925,15 +925,21 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain, ignore_r !--- register the restart fields if(was_allocated) then - - do num = 1,phy%nvar2d - var2_p => phy%var2(:,:,num) - call register_restart_field(Phy_restart, trim(GFS_Restart%name2d(num)), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/),& - &is_optional=.true.) - enddo - do num = 1,phy%nvar3d - var3_p => phy%var3(:,:,:,num) - call register_restart_field(Phy_restart, trim(GFS_restart%name3d(num)), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/), is_optional=.true.) + num2 = 0 + num3 = 0 + do ivar = 1,size(GFS_Restart(:)%axes) + num2 = num2 + 1 + if (GFS_Restart(ivar)%axes == 2) then + var2_p => phy%var2(:,:,num2) + call register_restart_field(Phy_restart, trim(GFS_Restart(ivar)%name), var2_p, & + dimensions=(/'xaxis_1','yaxis_1','Time '/), is_optional=.true.) + end if + if (GFS_Restart(ivar)%axes == 3) then + num3 = num3 + 1 + var3_p => phy%var3(:,:,:,num3) + call register_restart_field(Phy_restart, trim(GFS_restart(ivar)%name), var3_p, & + dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/), is_optional=.true.) + end if enddo nullify(var2_p) nullify(var3_p) @@ -944,7 +950,7 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain, ignore_r call read_restart(Phy_restart, ignore_checksum=ignore_rst_cksum) call close_file(Phy_restart) - call phy%transfer_data(.true., GFS_Restart, Atm_block, Model) + call phy%transfer_data(.true., GFS_Restart, Atm_block, Model, .true.) end subroutine phys_restart_read @@ -956,18 +962,18 @@ end subroutine phys_restart_read subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timestamp) implicit none !--- interface variable definitions - type(GFS_restart_type), intent(in) :: GFS_Restart - type(block_control_type), intent(in) :: Atm_block - type(GFS_control_type), intent(in) :: Model - type(domain2d), intent(in) :: fv_domain - character(len=32), optional, intent(in) :: timestamp + type(GFS_restart_type), intent(inout) :: GFS_Restart(:) + type(block_control_type), intent(in ) :: Atm_block + type(GFS_control_type), intent(in ) :: Model + type(domain2d), intent(in ) :: fv_domain + character(len=32), optional, intent(in ) :: timestamp !--- local variables - integer :: i, j, k, nb, ix, num + integer :: i, j, k, nb, ix, num2, num3 integer :: isc, iec, jsc, jec, nx, ny real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() !--- used for axis data for fms2_io - integer :: is, ie + integer :: is, ie, ivar integer, allocatable, dimension(:) :: buffer character(7) :: indir='RESTART' character(72) :: infile @@ -1027,20 +1033,28 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta call mpp_error(FATAL, 'Error opening file '//trim(infile)) end if - do num = 1,phy%nvar2d - var2_p => phy%var2(:,:,num) - call register_restart_field(Phy_restart, trim(GFS_Restart%name2d(num)), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/),& - & chunksizes=(/xaxis_1_chunk,yaxis_1_chunk,1/), is_optional=.true.) - enddo - do num = 1,phy%nvar3d - var3_p => phy%var3(:,:,:,num) - call register_restart_field(Phy_restart, trim(GFS_Restart%name3d(num)), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/),& - & chunksizes=(/xaxis_1_chunk,yaxis_1_chunk,1,1/), is_optional=.true.) + num2 = 0 + num3 = 0 + do ivar = 1,size(GFS_restart(:)%axes) + if (GFS_Restart(ivar)%axes == 2) then + num2 = num2 + 1 + var2_p => phy%var2(:,:,num2) + call register_restart_field(Phy_restart, trim(GFS_Restart(ivar)%name), var2_p, & + dimensions=(/'xaxis_1','yaxis_1','Time '/),& + chunksizes=(/xaxis_1_chunk,yaxis_1_chunk,1/), is_optional=.true.) + endif + if (GFS_Restart(ivar)%axes == 3) then + num3 = num3 + 1 + var3_p => phy%var3(:,:,:,num3) + call register_restart_field(Phy_restart, trim(GFS_Restart(ivar)%name), var3_p,& + dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/),& + chunksizes=(/xaxis_1_chunk,yaxis_1_chunk,1,1/), is_optional=.true.) + endif enddo nullify(var2_p) nullify(var3_p) - call phy%transfer_data(.false., GFS_Restart, Atm_block, Model) + call phy%transfer_data(.false., GFS_Restart, Atm_block, Model, .false.) call write_restart(Phy_restart) call close_file(Phy_restart) @@ -1054,7 +1068,7 @@ subroutine fv3atm_restart_register (Sfcprop, GFS_restart, Atm_block, Model) implicit none type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_restart_type), intent(in) :: GFS_Restart + type(GFS_restart_type), intent(in) :: GFS_Restart(:) type(block_control_type), intent(in) :: Atm_block type(GFS_control_type), intent(in) :: Model @@ -1081,14 +1095,15 @@ subroutine fv3atm_restart_register (Sfcprop, GFS_restart, Atm_block, Model) end subroutine fv3atm_restart_register !>@Copies physics restart fields from write component data structures to the model grid. - subroutine fv_phy_restart_output(GFS_Restart, Atm_block) + subroutine fv_phy_restart_output(GFS_Restart, Atm_block, Model) implicit none - type(GFS_restart_type), intent(in) :: GFS_Restart - type(block_control_type), intent(in) :: Atm_block + type(GFS_restart_type), intent(inout) :: GFS_Restart(:) + type(block_control_type), intent(in ) :: Atm_block + type(GFS_control_type), intent(in ) :: Model - call phy_quilt%transfer_data(.false., GFS_Restart, Atm_block) + call phy_quilt%transfer_data(.false., GFS_Restart, Atm_block, Model, .false.) end subroutine fv_phy_restart_output @@ -1210,32 +1225,44 @@ logical function phy_data_alloc(phy, GFS_Restart, Atm_block) use fv3atm_common_io, only: get_nx_ny_from_atm implicit none class(phy_data_type) :: phy - type(GFS_restart_type), intent(in) :: GFS_Restart + type(GFS_restart_type), intent(in) :: GFS_Restart(:) type(block_control_type), intent(in) :: Atm_block - integer :: nx, ny, num + integer :: nx, ny, ivar, num2, num3 phy_data_alloc = .false. if(associated(phy%var2)) return call get_nx_ny_from_atm(Atm_block, nx, ny) - phy%npz = Atm_block%npz - phy%nvar2d = GFS_Restart%num2d - phy%nvar3d = GFS_Restart%num3d + ! + ! Count the number of 2D and 3D restart fields, allocate space for physics data, + ! and gather metadata (e.g. names) for each field. + ! + phy%nvar2d = 0 + phy%nvar3d = 0 + do ivar = 1,size(GFS_restart(:)%axes) + if (GFS_restart(ivar)%axes == 2) phy%nvar2d = phy%nvar2d + 1 + if (GFS_restart(ivar)%axes == 3) phy%nvar3d = phy%nvar3d + 1 + enddo allocate (phy%var2(nx,ny,phy%nvar2d), phy%var2_names(phy%nvar2d)) allocate (phy%var3(nx,ny,phy%npz,phy%nvar3d), phy%var3_names(phy%nvar3d)) phy%var2 = zero phy%var3 = zero - do num = 1,phy%nvar2d - phy%var2_names(num) = trim(GFS_Restart%name2d(num)) + num2 = 0 + num3 = 0 + do ivar = 1,size(GFS_restart(:)%axes) + if (GFS_restart(ivar)%axes == 2) then + num2 = num2 + 1 + phy%var2_names(num2) = trim(GFS_Restart(ivar)%name) + end if + if (GFS_restart(ivar)%axes == 3) then + num3 = num3 + 1 + phy%var3_names(num3) = trim(GFS_Restart(ivar)%name) + endif enddo - do num = 1,phy%nvar3d - phy%var3_names(num) = trim(GFS_Restart%name3d(num)) - enddo - phy_data_alloc = .true. end function phy_data_alloc @@ -1246,16 +1273,17 @@ end function phy_data_alloc !! direction of the copy. For reading=.true., data is copied from the temporary arrays to the !! model grid (during restart read). For reading=.false., data is copied from the model grid to !! temporary arrays (for writing the restart). - subroutine phy_data_transfer_data(phy, reading, GFS_Restart, Atm_block, Model) + subroutine phy_data_transfer_data(phy, reading, GFS_Restart, Atm_block, Model, reset_diag) use mpp_mod, only: FATAL, mpp_error implicit none class(phy_data_type) :: phy logical, intent(in) :: reading - type(GFS_restart_type) :: GFS_Restart + type(GFS_restart_type), intent(inout) :: GFS_Restart(:) type(block_control_type) :: Atm_block - type(GFS_control_type), optional, intent(in) :: Model + type(GFS_control_type), intent(in) :: Model + logical, intent(in) :: reset_diag - integer :: i, j, k, num, nb, ix + integer :: i, j, k, ivar, nb, ix, im, num2, num3 !--- register the restart fields if (.not. associated(phy%var2)) then @@ -1267,81 +1295,81 @@ subroutine phy_data_transfer_data(phy, reading, GFS_Restart, Atm_block, Model) return ! should never get here endif - ! Copy 2D Vars - - if(reading) then - !--- place the data into the block GFS containers - !--- phy%var* variables - do num = 1,phy%nvar2d - !$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1,Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 - j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 - GFS_Restart%data(nb,num)%var2p(ix) = phy%var2(i,j,num) - enddo - enddo - enddo - else - !--- 2D variables - do num = 1,phy%nvar2d - !$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1,Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 - j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 - phy%var2(i,j,num) = GFS_Restart%data(nb,num)%var2p(ix) - enddo - enddo - enddo - endif - - !-- if restart from init time, reset accumulated diag fields - - if(reading .and. present(Model)) then - if(Model%phour < 1.e-7) then - do num = GFS_Restart%fdiag,GFS_Restart%ldiag - !$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1,Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 - j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 - GFS_Restart%data(nb,num)%var2p(ix) = zero - enddo - enddo - enddo - endif - endif - - ! Copy 3D Vars - + !--- place the data into the contiguous GFS containers. if(reading) then - do num = 1,phy%nvar3d - !$omp parallel do default(shared) private(i, j, k, nb, ix) - do nb = 1,Atm_block%nblks - do k=1,phy%npz - do ix = 1, Atm_block%blksz(nb) - i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 - j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 - GFS_Restart%data(nb,num)%var3p(ix,k) = phy%var3(i,j,k,num) - enddo - enddo - enddo - enddo + ! 2D + num2 = 0 + num3 = 0 + do ivar = 1,size(GFS_restart(:)%axes) + if (GFS_restart(ivar)%axes == 2) then + num2 = num2 + 1 + !$omp parallel do default(shared) private(i, j, nb, ix, im) + do nb = 1,Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + im = Model%chunk_begin(nb)+ix-1 + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + GFS_Restart(ivar)%data%var2(im) = phy%var2(i,j,num2) + !--- if restart from init time, reset accumulated diag fields + if (reset_diag) then + if (GFS_restart(ivar)%reset .and. Model%phour < 1.e-7) then + GFS_Restart(ivar)%data%var2(im) = zero + endif + endif + enddo + enddo + endif + ! 3D + if (GFS_restart(ivar)%axes == 3) then + num3 = num3 + 1 + !$omp parallel do default(shared) private(i, j, k, nb, ix, im) + do nb = 1,Atm_block%nblks + do k=1,phy%npz + do ix = 1, Atm_block%blksz(nb) + im = Model%chunk_begin(nb)+ix-1 + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + GFS_Restart(ivar)%data%var3(im,k) = phy%var3(i,j,k,num3) + enddo + enddo + enddo + endif + enddo + + !--- place the data into the phy%var* variables. else - !--- 3D variables - do num = 1,phy%nvar3d - !$omp parallel do default(shared) private(i, j, k, nb, ix) - do nb = 1,Atm_block%nblks - do k=1,phy%npz - do ix = 1, Atm_block%blksz(nb) - i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 - j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 - phy%var3(i,j,k,num) = GFS_Restart%data(nb,num)%var3p(ix,k) - enddo - enddo - enddo - enddo + num2 = 0 + num3 = 0 + do ivar = 1,size(GFS_restart(:)%axes) + ! 2D + if (GFS_restart(ivar)%axes == 2) then + num2 = num2 + 1 + !$omp parallel do default(shared) private(i, j, nb, ix, im) + do nb = 1,Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + im = Model%chunk_begin(nb)+ix-1 + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + phy%var2(i,j,num2) = GFS_Restart(ivar)%data%var2(im) + enddo + enddo + endif + ! 3D + if (GFS_restart(ivar)%axes == 3) then + num3 = num3 + 1 + !$omp parallel do default(shared) private(i, j, k, nb, ix, im) + do nb = 1,Atm_block%nblks + do k=1,phy%npz + do ix = 1, Atm_block%blksz(nb) + im = Model%chunk_begin(nb)+ix-1 + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + phy%var3(i,j,k,num3) = GFS_Restart(ivar)%data%var3(im,k) + enddo + enddo + enddo + endif + enddo endif end subroutine phy_data_transfer_data