From 1719fe825da39e8abc0f4ee576a35e73c1735fb7 Mon Sep 17 00:00:00 2001 From: "Bin.Liu" Date: Mon, 8 Feb 2021 11:43:59 -0600 Subject: [PATCH 1/3] Modifications from Xu Lu and Xuguang Wang (OU) to enable running dual resolution ensembles in HAFS ENSDA system. POC: xuguang.wang@ou.edu. --- src/gsi/cplr_get_fv3_regional_ensperts.f90 | 80 +++-- src/gsi/general_commvars_mod.f90 | 6 + src/gsi/gridmod.F90 | 12 +- src/gsi/gsi_rfv3io_mod.f90 | 383 ++++++++++++++++----- src/gsi/hybrid_ensemble_isotropic.F90 | 9 + src/gsi/mod_fv3_lolgrid.f90 | 5 +- 6 files changed, 378 insertions(+), 117 deletions(-) diff --git a/src/gsi/cplr_get_fv3_regional_ensperts.f90 b/src/gsi/cplr_get_fv3_regional_ensperts.f90 index bbf3a661ad..c68b908c0a 100644 --- a/src/gsi/cplr_get_fv3_regional_ensperts.f90 +++ b/src/gsi/cplr_get_fv3_regional_ensperts.f90 @@ -20,6 +20,7 @@ subroutine get_fv3_regional_ensperts_run(this,en_perts,nelen,ps_bar) ! ! program history log: ! 2011-08-31 todling - revisit en_perts (single-prec) in light of extended bundle + ! 2021-02-01 Lu & Wang - modify functions for hafs dual ens. POC: xuguang.wang@ou.edu ! ! input argument list: ! @@ -330,9 +331,9 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g use gridmod, only: eta1_ll,eta2_ll use constants, only: zero,one,fv,zero_single,one_tenth,h300 use hybrid_ensemble_parameters, only: grd_ens,q_hyb_ens - use hybrid_ensemble_parameters, only: fv3sar_ensemble_opt + use hybrid_ensemble_parameters, only: fv3sar_ensemble_opt,dual_res - use mpimod, only: mpi_comm_world,mpi_rtype + use mpimod, only: mpi_comm_world,mpi_rtype,mype use netcdf_mod, only: nc_check use gsi_rfv3io_mod,only: type_fv3regfilenameg use gsi_rfv3io_mod,only:n2d @@ -361,7 +362,7 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g ! ! Declare local variables - integer(i_kind):: i,j,k,kp + integer(i_kind):: i,j,k,kp,lon2ens,lat2ens integer(i_kind) iderivative @@ -391,42 +392,71 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g !cltthinktobe should be contained in variable like grd_ens - - - if(fv3sar_ensemble_opt == 0 ) then - call gsi_fv3ncdf_readuv(dynvars,g_u,g_v) - else - call gsi_fv3ncdf_readuv_v1(dynvars,g_u,g_v) - endif - if(fv3sar_ensemble_opt == 0) then - call gsi_fv3ncdf_read(dynvars,'T','t',g_tsen,mype_t) + lon2ens=grd_ens%lon2 + lat2ens=grd_ens%lat2 + if (dual_res) then + if(fv3sar_ensemble_opt == 0 ) then + call gsi_fv3ncdf_readuv(dynvars,g_u,g_v,lat2ens,lon2ens,.true.) + else + call gsi_fv3ncdf_readuv_v1(dynvars,g_u,g_v,lat2ens,lon2ens,.true.) + endif + if(fv3sar_ensemble_opt == 0) then + call gsi_fv3ncdf_read(dynvars,'T','t',g_tsen,mype_t,lat2ens,lon2ens,.true.) + else + call gsi_fv3ncdf_read_v1(dynvars,'t','T',g_tsen,mype_t,lat2ens,lon2ens,.true.) + endif else - call gsi_fv3ncdf_read_v1(dynvars,'t','T',g_tsen,mype_t) - endif + if(fv3sar_ensemble_opt == 0 ) then + call gsi_fv3ncdf_readuv(dynvars,g_u,g_v,lat2ens,lon2ens,.false.) + else + call gsi_fv3ncdf_readuv_v1(dynvars,g_u,g_v,lat2ens,lon2ens,.false.) + endif + if(fv3sar_ensemble_opt == 0) then + call gsi_fv3ncdf_read(dynvars,'T','t',g_tsen,mype_t,lat2ens,lon2ens,.false.) + else + call gsi_fv3ncdf_read_v1(dynvars,'t','T',g_tsen,mype_t,lat2ens,lon2ens,.false.) + endif + end if if (fv3sar_ensemble_opt == 0) then - call gsi_fv3ncdf_read(dynvars,'DELP','delp',g_prsi,mype_p) + if (dual_res) then + call gsi_fv3ncdf_read(dynvars,'DELP','delp',g_prsi,mype_p,lat2ens,lon2ens,.true.) + else + call gsi_fv3ncdf_read(dynvars,'DELP','delp',g_prsi,mype_p,lat2ens,lon2ens,.false.) + end if g_prsi(:,:,grd_ens%nsig+1)=eta1_ll(grd_ens%nsig+1) !thinkto be done , should use eta1_ll from ensemble grid do i=grd_ens%nsig,1,-1 g_prsi(:,:,i)=g_prsi(:,:,i)*0.001_r_kind+g_prsi(:,:,i+1) enddo g_ps(:,:)=g_prsi(:,:,1) else ! for the ensemble processed frm CHGRES - call gsi_fv3ncdf2d_read_v1(dynvars,'ps','PS',g_ps,mype_p) + if (dual_res) then + call gsi_fv3ncdf2d_read_v1(dynvars,'ps','PS',g_ps,mype_p,lat2ens,lon2ens,.true.) + else + call gsi_fv3ncdf2d_read_v1(dynvars,'ps','PS',g_ps,mype_p,lat2ens,lon2ens,.false.) + end if g_ps=g_ps*0.001_r_kind do k=1,grd_ens%nsig+1 g_prsi(:,:,k)=eta1_ll(k)+eta2_ll(k)*g_ps enddo - - endif - if(fv3sar_ensemble_opt == 0) then - call gsi_fv3ncdf_read(tracers,'SPHUM','sphum',g_q,mype_q) - call gsi_fv3ncdf_read(tracers,'O3MR','o3mr',g_oz,mype_oz) + if (dual_res) then + if(fv3sar_ensemble_opt == 0) then + call gsi_fv3ncdf_read(tracers,'SPHUM','sphum',g_q,mype_q,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf_read(tracers,'O3MR','o3mr',g_oz,mype_oz,lat2ens,lon2ens,.true.) + else + call gsi_fv3ncdf_read_v1(tracers,'sphum','SPHUM',g_q,mype_q,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf_read_v1(tracers,'o3mr','O3MR',g_oz,mype_oz,lat2ens,lon2ens,.true.) + endif else - call gsi_fv3ncdf_read_v1(tracers,'sphum','SPHUM',g_q,mype_q) - call gsi_fv3ncdf_read_v1(tracers,'o3mr','O3MR',g_oz,mype_oz) - endif + if(fv3sar_ensemble_opt == 0) then + call gsi_fv3ncdf_read(tracers,'SPHUM','sphum',g_q,mype_q,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf_read(tracers,'O3MR','o3mr',g_oz,mype_oz,lat2ens,lon2ens,.false.) + else + call gsi_fv3ncdf_read_v1(tracers,'sphum','SPHUM',g_q,mype_q,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf_read_v1(tracers,'o3mr','O3MR',g_oz,mype_oz,lat2ens,lon2ens,.false.) + endif + end if !! tsen2tv !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do k=1,grd_ens%nsig @@ -447,7 +477,7 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g end do end do end do - call genqsat(g_rh,g_tsen(1,1,1),g_prsl(1,1,1),grd_ens%lat2,grd_ens%lon2,grd_ens%nsig,ice,iderivative) + call genqsat(g_rh,g_tsen(1,1,1),g_prsl(1,1,1),lat2ens,lon2ens,grd_ens%nsig,ice,iderivative) do k=1,grd_ens%nsig do j=1,grd_ens%lon2 do i=1,grd_ens%lat2 diff --git a/src/gsi/general_commvars_mod.f90 b/src/gsi/general_commvars_mod.f90 index daf182fbdd..e15bf03d7a 100644 --- a/src/gsi/general_commvars_mod.f90 +++ b/src/gsi/general_commvars_mod.f90 @@ -10,6 +10,7 @@ module general_commvars_mod ! program history log: ! 2012-06-25 parrish ! 2013-10-24 todling - move vars ltosj/i to from gridmod here; same for load and fill routines +! 2021-02-01 Lu & Wang - add vars for hafs dual ens. POC: xuguang.wang@ou.edu ! ! Subroutines Included: ! sub init_general_commvars - initialize type(sub2grid_info) structure variables @@ -62,11 +63,13 @@ module general_commvars_mod public :: filluv2_ns public :: load_grid public :: ltosj_s,ltosi_s,ltosj,ltosi + public :: ltosj_sens,ltosi_sens integer(i_kind),allocatable,dimension(:):: ltosi ! lats in iglobal array excluding buffer integer(i_kind),allocatable,dimension(:):: ltosj ! lons in iglobal array excluding buffer integer(i_kind),allocatable,dimension(:):: ltosi_s ! lats in itotsub array including buffer integer(i_kind),allocatable,dimension(:):: ltosj_s ! lons in itotsub array including buffer + integer(i_kind),allocatable,dimension(:):: ltosj_sens,ltosi_sens ! lats/lons for ens ! Declare types @@ -196,6 +199,7 @@ subroutine init_general_commvars displs_s=s2g_raf%displs_s itotsub=s2g_raf%itotsub allocate(ltosi_s(itotsub),ltosj_s(itotsub)) + allocate(ltosi_sens(itotsub),ltosj_sens(itotsub)) ltosi_s=s2g_raf%ltosi_s ltosj_s=s2g_raf%ltosj_s @@ -352,6 +356,8 @@ subroutine destroy_general_commvars implicit none deallocate(ltosi,ltosj,ltosi_s,ltosj_s) + if (allocated(ltosj_sens)) deallocate(ltosj_sens) + if (allocated(ltosi_sens)) deallocate(ltosi_sens) deallocate(levs_id,nvar_id,nvar_pe) call general_sub2grid_destroy_info(s2g_cv,s_ref=s2g_raf) call general_sub2grid_destroy_info(s2g2,s_ref=s2g_raf) diff --git a/src/gsi/gridmod.F90 b/src/gsi/gridmod.F90 index 2bd3c3381f..c375a560f7 100644 --- a/src/gsi/gridmod.F90 +++ b/src/gsi/gridmod.F90 @@ -91,6 +91,7 @@ module gridmod ! 2019-04-19 martin - add use_fv3_aero option to distingiush between NGAC and FV3-Chem ! 2019-09-04 martin - add write_fv3_incr to write netCDF increment rather than analysis in NEMSIO format ! 2019-09-23 martin - add use_gfs_ncio to read global first guess from netCDF file +! 2021-02-01 Lu & Wang - add vars for hafs dual ens. POC: xuguang.wang@ou.edu ! ! ! @@ -132,6 +133,7 @@ module gridmod ! set passed variables to public public :: nnnn1o,iglobal,itotsub,ijn,ijn_s,lat2,lon2,lat1,lon1,nsig,nsig_soil public :: ncloud,nlat,nlon,ntracer,displs_s,displs_g + public :: ijn_sens,ijnens,displs_sens public :: bk5,regional,latlon11,latlon1n,twodvar_regional public :: netcdf,nems_nmmb_regional,wrf_mass_regional,wrf_nmm_regional,cmaq_regional public :: aeta2_ll,pdtop_ll,pt_ll,eta1_ll,eta2_ll,aeta1_ll,idsl5,ck5,ak5 @@ -283,6 +285,9 @@ module gridmod integer(i_kind),allocatable,dimension(:):: isd_g ! displacement for send to global integer(i_kind),allocatable,dimension(:):: displs_s ! displacement for send from subdomain integer(i_kind),allocatable,dimension(:):: displs_g ! displacement for receive on global grid + integer(i_kind),allocatable,dimension(:):: ijn_sens + integer(i_kind),allocatable,dimension(:):: ijnens + integer(i_kind),allocatable,dimension(:):: displs_sens integer(i_kind),dimension(200):: nlayers ! number of RTM layers per model layer ! (k=1 is near surface layer), default is 1 @@ -924,7 +929,8 @@ subroutine create_mapping(npe) allocate(periodic_s(npe),jstart(npe),istart(npe),& ilat1(npe),jlon1(npe),& ijn_s(npe),irc_s(npe),ird_s(npe),displs_s(npe),& - ijn(npe),isc_g(npe),isd_g(npe),displs_g(npe)) + ijn(npe),isc_g(npe),isd_g(npe),displs_g(npe), & + ijn_sens(npe),ijnens(npe),displs_sens(npe)) do i=1,npe periodic_s(i)= .false. @@ -940,6 +946,9 @@ subroutine create_mapping(npe) isc_g(i) = 0 isd_g(i) = 0 displs_g(i) = 0 + ijn_sens(i) = 0 + displs_sens(i)= 0 + ijnens(i) = 0 end do return @@ -980,6 +989,7 @@ subroutine destroy_mapping deallocate(periodic_s,jstart,istart,ilat1,jlon1,& ijn_s,irc_s,ird_s,displs_s,& ijn,isc_g,isd_g,displs_g) + deallocate(ijn_sens,ijnens,displs_sens) return end subroutine destroy_mapping diff --git a/src/gsi/gsi_rfv3io_mod.f90 b/src/gsi/gsi_rfv3io_mod.f90 index 8d834fa6b1..def202ecd5 100644 --- a/src/gsi/gsi_rfv3io_mod.f90 +++ b/src/gsi/gsi_rfv3io_mod.f90 @@ -13,6 +13,8 @@ module gsi_rfv3io_mod ! 2018-02-22 wu - add subroutines for read/write fv3_ncdf ! 2019 ting - modifications for use for ensemble IO and cold start files ! 2020-11-19 Lu & Wang - add time label it for fgat. POC: xuguang.wang@ou.edu +! 2021-02-01 Lu & Wang - modify functions for hafs dual ens. POC: +! xuguang.wang@ou.edu ! subroutines included: ! sub gsi_rfv3io_get_grid_specs ! sub read_fv3_files @@ -58,12 +60,13 @@ module gsi_rfv3io_mod integer(i_kind):: fv3sar_bg_opt=0 type(type_fv3regfilenameg):: bg_fv3regfilenameg - integer(i_kind) nx,ny,nz + integer(i_kind) nx,ny,nz,nxens,nyens real(r_kind),allocatable:: grid_lon(:,:),grid_lont(:,:),grid_lat(:,:),grid_latt(:,:) real(r_kind),allocatable:: ak(:),bk(:) integer(i_kind),allocatable:: ijns2d(:),displss2d(:),ijns(:),displss(:) integer(i_kind),allocatable:: ijnz(:),displsz_g(:) - + integer(i_kind),allocatable:: ijns2dens(:),displss2dens(:),ijnsens(:),displssens(:) + integer(i_kind),allocatable:: ijnzens(:),displsz_gens(:) ! set default to private private ! set subroutines to public @@ -82,6 +85,7 @@ module gsi_rfv3io_mod public :: k_slmsk,k_tsea,k_vfrac,k_vtype,k_stype,k_zorl,k_smc,k_stc public :: k_snwdph,k_f10m,mype_2d,n2d,k_orog,k_psfc public :: ijns,ijns2d,displss,displss2d,ijnz,displsz_g + public :: ijnsens,ijns2dens,displssens,displss2dens,ijnzens,displsz_gens integer(i_kind) mype_u,mype_v,mype_t,mype_q,mype_p,mype_oz,mype_ql integer(i_kind) k_slmsk,k_tsea,k_vfrac,k_vtype,k_stype,k_zorl,k_smc,k_stc @@ -427,17 +431,17 @@ subroutine gsi_rfv3io_get_ens_grid_specs(grid_spec,ierr) gfile_loc=gfile_grid_spec do k=1,ndimensions iret=nf90_inquire_dimension(gfile_loc,k,name,len) - if(trim(name)=='grid_xt') nx=len - if(trim(name)=='grid_yt') ny=len + if(trim(name)=='grid_xt') nxens=len + if(trim(name)=='grid_yt') nyens=len enddo - if(mype==0)write(6,*),'nx,ny=',nx,ny + if(mype==0)write(6,*),'nxens,nyens=',nxens,nyens !!! get nx,ny,grid_lon,grid_lont,grid_lat,grid_latt,nz,ak,bk - allocate(grid_lat(nx+1,ny+1)) - allocate(grid_lon(nx+1,ny+1)) - allocate(grid_latt(nx,ny)) - allocate(grid_lont(nx,ny)) + allocate(grid_lat(nxens+1,nyens+1)) + allocate(grid_lon(nxens+1,nyens+1)) + allocate(grid_latt(nxens,nyens)) + allocate(grid_lont(nxens,nyens)) do k=ndimensions+1,nvariables iret=nf90_inquire_variable(gfile_loc,k,name,len) @@ -462,7 +466,7 @@ subroutine gsi_rfv3io_get_ens_grid_specs(grid_spec,ierr) !!!!!!! setup A grid and interpolation/rotation coeff. - call definecoef_regular_grids(nx,ny,grid_lon,grid_lont,grid_lat,grid_latt,p_fv3sar2ensgrid, & + call definecoef_regular_grids(nxens,nyens,grid_lon,grid_lont,grid_lat,grid_latt,p_fv3sar2ensgrid, & nlat_ens,nlon_ens,region_lat_ens,region_lon_ens) deallocate (grid_lon,grid_lat,grid_lont,grid_latt) @@ -750,6 +754,7 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin,it) use mpimod, only: npe use guess_grids, only: ges_tsen,ges_prsi use gridmod, only: lat2,lon2,nsig,ijn,eta1_ll,eta2_ll,ijn_s + use gridmod, only: ijnens,ijn_sens use constants, only: one,fv use gsi_metguess_mod, only: gsi_metguess_bundle use gsi_bundlemod, only: gsi_bundlegetpointer @@ -800,11 +805,19 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin,it) if (.not.allocated(displss)) allocate(displss(npe)) if (.not.allocated(displss2d)) allocate(displss2d(npe)) if (.not.allocated(displsz_g)) allocate(displsz_g(npe)) - + if (.not.allocated(ijnsens)) allocate(ijnsens(npe)) + if (.not.allocated(ijns2dens)) allocate(ijns2dens(npe)) + if (.not.allocated(ijnzens)) allocate(ijnzens(npe)) + if (.not.allocated(displssens)) allocate(displssens(npe)) + if (.not.allocated(displss2dens)) allocate(displss2dens(npe)) + if (.not.allocated(displsz_gens)) allocate(displsz_gens(npe)) do i=1,npe ijns(i)=ijn_s(i)*nsig ijnz(i)=ijn(i)*nsig ijns2d(i)=ijn_s(i)*n2d + ijnsens(i)=ijn_sens(i)*nsig + ijnzens(i)=ijnens(i)*nsig + ijns2dens(i)=ijn_sens(i)*n2d enddo displss(1)=0 displsz_g(1)=0 @@ -814,7 +827,14 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin,it) displsz_g(i)=displsz_g(i-1)+ ijnz(i-1) displss2d(i)=displss2d(i-1)+ ijns2d(i-1) enddo - + displssens(1)=0 + displsz_gens(1)=0 + displss2dens(1)=0 + do i=2,npe + displssens(i)=displssens(i-1)+ ijnsens(i-1) + displsz_gens(i)=displsz_gens(i-1)+ ijnzens(i-1) + displss2dens(i)=displss2dens(i-1)+ ijns2dens(i-1) + enddo ! do it=1,nfldsig ! it=ntguessig @@ -831,26 +851,26 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin,it) if (ier/=0) call die(trim(myname),'cannot get pointers for fv3 met-fields, ier =',ier) if( fv3sar_bg_opt == 0) then - call gsi_fv3ncdf_readuv(dynvars,ges_u,ges_v) + call gsi_fv3ncdf_readuv(dynvars,ges_u,ges_v,lat2,lon2,.false.) else - call gsi_fv3ncdf_readuv_v1(dynvars,ges_u,ges_v) + call gsi_fv3ncdf_readuv_v1(dynvars,ges_u,ges_v,lat2,lon2,.false.) endif if( fv3sar_bg_opt == 0) then - call gsi_fv3ncdf_read(dynvars,'T','t',ges_tsen(1,1,1,it),mype_t) + call gsi_fv3ncdf_read(dynvars,'T','t',ges_tsen(1,1,1,it),mype_t,lat2,lon2,.false.) else - call gsi_fv3ncdf_read_v1(dynvars,'t','T',ges_tsen(1,1,1,it),mype_t) + call gsi_fv3ncdf_read_v1(dynvars,'t','T',ges_tsen(1,1,1,it),mype_t,lat2,lon2,.false.) endif if( fv3sar_bg_opt == 0) then ! call gsi_fv3ncdf_read(dynvars,'DELP','delp',ges_prsi,mype_p) - call gsi_fv3ncdf_read(dynvars,'DELP','delp',ges_prsi(:,:,:,it),mype_p) + call gsi_fv3ncdf_read(dynvars,'DELP','delp',ges_prsi(:,:,:,it),mype_p,lat2,lon2,.false.) ges_prsi(:,:,nsig+1,it)=eta1_ll(nsig+1) do i=nsig,1,-1 ges_prsi(:,:,i,it)=ges_prsi(:,:,i,it)*0.001_r_kind+ges_prsi(:,:,i+1,it) enddo ges_ps(:,:)=ges_prsi(:,:,1,it) else - call gsi_fv3ncdf2d_read_v1(dynvars,'ps','PS',ges_ps,mype_p) + call gsi_fv3ncdf2d_read_v1(dynvars,'ps','PS',ges_ps,mype_p,lat2,lon2,.false.) ges_ps=ges_ps*0.001_r_kind ges_prsi(:,:,nsig+1,it)=eta1_ll(nsig+1) do k=1,nsig @@ -859,12 +879,12 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin,it) endif if( fv3sar_bg_opt == 0) then - call gsi_fv3ncdf_read(tracers,'SPHUM','sphum',ges_q,mype_q) + call gsi_fv3ncdf_read(tracers,'SPHUM','sphum',ges_q,mype_q,lat2,lon2,.false.) ! call gsi_fv3ncdf_read(tracers,'LIQ_WAT','liq_wat',ges_ql,mype_ql) - call gsi_fv3ncdf_read(tracers,'O3MR','o3mr',ges_oz,mype_oz) + call gsi_fv3ncdf_read(tracers,'O3MR','o3mr',ges_oz,mype_oz,lat2,lon2,.false.) else - call gsi_fv3ncdf_read_v1(tracers,'sphum','SPHUM',ges_q,mype_q) - call gsi_fv3ncdf_read_v1(tracers,'o3mr','O3MR',ges_oz,mype_oz) + call gsi_fv3ncdf_read_v1(tracers,'sphum','SPHUM',ges_q,mype_q,lat2,lon2,.false.) + call gsi_fv3ncdf_read_v1(tracers,'o3mr','O3MR',ges_oz,mype_oz,lat2,lon2,.false.) endif !! tsen2tv !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -878,6 +898,7 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin,it) call gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z) + end subroutine read_fv3_netcdf_guess subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z) @@ -1069,7 +1090,7 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z) deallocate (sfcn2d,a) return end subroutine gsi_fv3ncdf2d_read -subroutine gsi_fv3ncdf2d_read_v1(filenamein,varname,varname2,work_sub,mype_io) +subroutine gsi_fv3ncdf2d_read_v1(filenamein,varname,varname2,work_sub,mype_io,lat2in,lon2in,ensgrid) !$$$ subprogram documentation block ! . . . . ! subprogram: gsi_fv23ncdf2d_readv1 @@ -1105,11 +1126,16 @@ subroutine gsi_fv3ncdf2d_read_v1(filenamein,varname,varname2,work_sub,mype_io) use netcdf, only: nf90_inquire_variable use mod_fv3_lolgrid, only: fv3_h_to_ll_regular_grids use general_commvars_mod, only: ltosi_s,ltosj_s + use gridmod, only: ijn_sens,ijnens,displs_sens + use general_commvars_mod, only: ltosi_sens,ltosj_sens + use hybrid_ensemble_parameters, only: nlon_ens,nlat_ens implicit none character(*) ,intent(in ) :: varname,varname2,filenamein - real(r_kind) ,intent(out ) :: work_sub(lat2,lon2) + integer(i_kind) ,intent(in ) :: lat2in,lon2in + real(r_kind) ,intent(out ) :: work_sub(lat2in,lon2in) integer(i_kind) ,intent(in ) :: mype_io + logical, intent(in ) :: ensgrid real(r_kind),allocatable,dimension(:,:,:):: uu integer(i_kind),allocatable,dimension(:):: dim_id,dim real(r_kind),allocatable,dimension(:):: work @@ -1134,7 +1160,11 @@ subroutine gsi_fv3ncdf2d_read_v1(filenamein,varname,varname2,work_sub,mype_io) iret=nf90_inquire(gfile_loc,ndimensions,nvariables,nattributes,unlimiteddimid) allocate(dim(ndimensions)) - allocate(a(nlat,nlon)) + if (ensgrid) then + allocate(a(nlat_ens,nlon_ens)) + else + allocate(a(nlat,nlon)) + end if iret=nf90_inq_varid(gfile_loc,trim(adjustl(varname)),var_id) if(iret/=nf90_noerr) then @@ -1149,8 +1179,22 @@ subroutine gsi_fv3ncdf2d_read_v1(filenamein,varname,varname2,work_sub,mype_io) allocate(dim_id(ndim)) iret=nf90_inquire_variable(gfile_loc,var_id,dimids=dim_id) if(allocated(uu )) deallocate(uu ) - allocate(uu(nx,ny,1)) - iret=nf90_get_var(gfile_loc,var_id,uu) + if (ensgrid) then + allocate(uu(nxens,nyens,1)) + iret=nf90_get_var(gfile_loc,var_id,uu) + call fv3_h_to_ll_regular_grids(uu(:,:,1),a,nxens,nyens,nlon_ens,nlat_ens,p_fv3sar2ensgrid) + kk=0 + do n=1,npe + do j=1,ijn_sens(n) + kk=kk+1 + ii=ltosi_sens(kk) + jj=ltosj_sens(kk) + work(kk)=a(ii,jj) + end do + end do + else + allocate(uu(nx,ny,1)) + iret=nf90_get_var(gfile_loc,var_id,uu) call fv3_h_to_ll_regular_grids(uu(:,:,1),a,nx,ny,nlon,nlat,p_fv3sar2anlgrid) kk=0 do n=1,npe @@ -1161,20 +1205,25 @@ subroutine gsi_fv3ncdf2d_read_v1(filenamein,varname,varname2,work_sub,mype_io) work(kk)=a(ii,jj) end do end do - + end if iret=nf90_close(gfile_loc) deallocate (uu,a,dim,dim_id) endif !mype - call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& - work_sub,ijn_s(mm1),mpi_rtype,mype_io,mpi_comm_world,ierror) + if (ensgrid) then + call mpi_scatterv(work,ijn_sens,displs_sens,mpi_rtype,& + work_sub,ijn_sens(mm1),mpi_rtype,mype_io,mpi_comm_world,ierror) + else + call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& + work_sub,ijn_s(mm1),mpi_rtype,mype_io,mpi_comm_world,ierror) + end if deallocate (work) return end subroutine gsi_fv3ncdf2d_read_v1 -subroutine gsi_fv3ncdf_read(filenamein,varname,varname2,work_sub,mype_io) +subroutine gsi_fv3ncdf_read(filenamein,varname,varname2,work_sub,mype_io,lat2in,lon2in,ensgrid) !$$$ subprogram documentation block ! . . . . ! subprogram: gsi_fv3ncdf_read @@ -1208,11 +1257,16 @@ subroutine gsi_fv3ncdf_read(filenamein,varname,varname2,work_sub,mype_io) use netcdf, only: nf90_inquire_variable use mod_fv3_lolgrid, only: fv3_h_to_ll_regular_grids use general_commvars_mod, only: ltosi_s,ltosj_s + use gridmod, only: ijn_sens,ijnens + use general_commvars_mod, only: ltosi_sens,ltosj_sens + use hybrid_ensemble_parameters, only: nlon_ens,nlat_ens implicit none character(*) ,intent(in ) :: varname,varname2,filenamein - real(r_kind) ,intent(out ) :: work_sub(lat2,lon2,nsig) + integer(i_kind) ,intent(in ) :: lat2in,lon2in + real(r_kind) ,intent(out ) :: work_sub(lat2in,lon2in,nsig) integer(i_kind) ,intent(in ) :: mype_io + logical, intent(in ) :: ensgrid character(len=128) :: name real(r_kind),allocatable,dimension(:,:,:):: uu integer(i_kind),allocatable,dimension(:):: dim_id,dim @@ -1235,10 +1289,13 @@ subroutine gsi_fv3ncdf_read(filenamein,varname,varname2,work_sub,mype_io) write(6,*)' gsi_fv3ncdf_read:problem opening5 with varnam ',trim(varname) return endif - iret=nf90_inquire(gfile_loc,ndimensions,nvariables,nattributes,unlimiteddimid) allocate(dim(ndimensions)) - allocate(a(nlat,nlon)) + if (ensgrid) then + allocate(a(nlat_ens,nlon_ens)) + else + allocate(a(nlat,nlon)) + end if do k=1,ndimensions iret=nf90_inquire_dimension(gfile_loc,k,name,len) @@ -1264,9 +1321,24 @@ subroutine gsi_fv3ncdf_read(filenamein,varname,varname2,work_sub,mype_io) nzp1=nz+1 do i=1,nz ir=nzp1-i - call fv3_h_to_ll_regular_grids(uu(:,:,i),a,dim(dim_id(1)),dim(dim_id(2)),nlon,nlat,p_fv3sar2anlgrid) - kk=0 - do n=1,npe + if (ensgrid) then + call fv3_h_to_ll_regular_grids(uu(:,:,i),a,dim(dim_id(1)),dim(dim_id(2)),nlon_ens,nlat_ens,p_fv3sar2ensgrid) + kk=0 + do n=1,npe + ns=displssens(n)+(ir-1)*ijn_sens(n) + do j=1,ijn_sens(n) + ns=ns+1 + kk=kk+1 + ii=ltosi_sens(kk) + jj=ltosj_sens(kk) + work(ns)=a(ii,jj) + end do + end do + else + call fv3_h_to_ll_regular_grids(uu(:,:,i),a,dim(dim_id(1)),dim(dim_id(2)),nlon,nlat,p_fv3sar2anlgrid) + + kk=0 + do n=1,npe ns=displss(n)+(ir-1)*ijn_s(n) do j=1,ijn_s(n) ns=ns+1 @@ -1275,22 +1347,27 @@ subroutine gsi_fv3ncdf_read(filenamein,varname,varname2,work_sub,mype_io) jj=ltosj_s(kk) work(ns)=a(ii,jj) end do - end do + end do + end if enddo ! i - iret=nf90_close(gfile_loc) deallocate (uu,a,dim,dim_id) endif !mype - call mpi_scatterv(work,ijns,displss,mpi_rtype,& - work_sub,ijns(mm1),mpi_rtype,mype_io,mpi_comm_world,ierror) + if (ensgrid) then + call mpi_scatterv(work,ijnsens,displssens,mpi_rtype,& + work_sub,ijnsens(mm1),mpi_rtype,mype_io,mpi_comm_world,ierror) + else + call mpi_scatterv(work,ijns,displss,mpi_rtype,& + work_sub,ijns(mm1),mpi_rtype,mype_io,mpi_comm_world,ierror) + end if deallocate (work) return end subroutine gsi_fv3ncdf_read -subroutine gsi_fv3ncdf_read_v1(filenamein,varname,varname2,work_sub,mype_io) +subroutine gsi_fv3ncdf_read_v1(filenamein,varname,varname2,work_sub,mype_io,lat2in,lon2in,ensgrid) !$$$ subprogram documentation block ! . . . . @@ -1327,11 +1404,15 @@ subroutine gsi_fv3ncdf_read_v1(filenamein,varname,varname2,work_sub,mype_io) use netcdf, only: nf90_inq_varid use mod_fv3_lolgrid, only: fv3_h_to_ll_regular_grids use general_commvars_mod, only: ltosi_s,ltosj_s - + use gridmod, only: lat2,lon2,nsig,nlat,nlon,itotsub,ijn_s,ijn_sens + use general_commvars_mod, only: ltosi_sens,ltosj_sens + use hybrid_ensemble_parameters, only: nlon_ens,nlat_ens implicit none character(*) ,intent(in ) :: varname,varname2,filenamein - real(r_kind) ,intent(out ) :: work_sub(lat2,lon2,nsig) + integer(i_kind) ,intent(in ) :: lon2in,lat2in + real(r_kind) ,intent(out ) :: work_sub(lat2in,lon2in,nsig) integer(i_kind) ,intent(in ) :: mype_io + logical, intent(in ) :: ensgrid character(len=128) :: name real(r_kind),allocatable,dimension(:,:,:):: uu real(r_kind),allocatable,dimension(:,:,:):: temp0 @@ -1358,15 +1439,24 @@ subroutine gsi_fv3ncdf_read_v1(filenamein,varname,varname2,work_sub,mype_io) iret=nf90_inquire(gfile_loc,ndimensions,nvariables,nattributes,unlimiteddimid) allocate(dim(ndimensions)) - allocate(a(nlat,nlon)) + if (ensgrid) then + allocate(a(nlat_ens,nlon_ens)) + else + allocate(a(nlat,nlon)) + end if do k=1,ndimensions iret=nf90_inquire_dimension(gfile_loc,k,name,len) dim(k)=len enddo + if (ensgrid) then + allocate(uu(nxens,nyens,nsig)) + allocate(temp0(nxens,nyens,nsig+1)) + else allocate(uu(nx,ny,nsig)) allocate(temp0(nx,ny,nsig+1)) + end if iret=nf90_inq_varid(gfile_loc,trim(adjustl(varname)),var_id) if(iret/=nf90_noerr) then @@ -1383,9 +1473,23 @@ subroutine gsi_fv3ncdf_read_v1(filenamein,varname,varname2,work_sub,mype_io) nzp1=nztmp+1 do i=1,nztmp ir=nzp1-i - call fv3_h_to_ll_regular_grids(uu(:,:,i),a,nx,ny,nlon,nlat,p_fv3sar2anlgrid) - kk=0 - do n=1,npe + if (ensgrid) then + call fv3_h_to_ll_regular_grids(uu(:,:,i),a,nxens,nyens,nlon_ens,nlat_ens,p_fv3sar2ensgrid) + kk=0 + do n=1,npe + ns=displssens(n)+(ir-1)*ijn_sens(n) + do j=1,ijn_sens(n) + ns=ns+1 + kk=kk+1 + ii=ltosi_sens(kk) + jj=ltosj_sens(kk) + work(ns)=a(ii,jj) + end do + end do + else + call fv3_h_to_ll_regular_grids(uu(:,:,i),a,nx,ny,nlon,nlat,p_fv3sar2anlgrid) + kk=0 + do n=1,npe ns=displss(n)+(ir-1)*ijn_s(n) do j=1,ijn_s(n) ns=ns+1 @@ -1394,7 +1498,8 @@ subroutine gsi_fv3ncdf_read_v1(filenamein,varname,varname2,work_sub,mype_io) jj=ltosj_s(kk) work(ns)=a(ii,jj) end do - end do + end do + end if enddo ! i iret=nf90_close(gfile_loc) @@ -1403,14 +1508,18 @@ subroutine gsi_fv3ncdf_read_v1(filenamein,varname,varname2,work_sub,mype_io) endif !mype - call mpi_scatterv(work,ijns,displss,mpi_rtype,& - work_sub,ijns(mm1),mpi_rtype,mype_io,mpi_comm_world,ierror) - + if (ensgrid) then + call mpi_scatterv(work,ijnsens,displssens,mpi_rtype,& + work_sub,ijnsens(mm1),mpi_rtype,mype_io,mpi_comm_world,ierror) + else + call mpi_scatterv(work,ijns,displss,mpi_rtype,& + work_sub,ijns(mm1),mpi_rtype,mype_io,mpi_comm_world,ierror) + end if deallocate (work) return end subroutine gsi_fv3ncdf_read_v1 -subroutine gsi_fv3ncdf_readuv(dynvarsfile,ges_u,ges_v) +subroutine gsi_fv3ncdf_readuv(dynvarsfile,ges_u,ges_v,lat2in,lon2in,ensgrid) !$$$ subprogram documentation block ! . . . . ! subprogram: gsi_fv3ncdf_readuv @@ -1433,18 +1542,23 @@ subroutine gsi_fv3ncdf_readuv(dynvarsfile,ges_u,ges_v) !$$$ end documentation block use kinds, only: r_kind,i_kind use mpimod, only: ierror,mpi_comm_world,npe,mpi_rtype,mype - use gridmod, only: lat2,lon2,nsig,itotsub,ijn_s + use gridmod, only: lat2,lon2,nsig,itotsub,ijn_s,nlat,nlon use netcdf, only: nf90_open,nf90_close,nf90_get_var,nf90_noerr use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension use netcdf, only: nf90_inquire_variable use netcdf, only: nf90_inq_varid use mod_fv3_lolgrid, only: fv3_h_to_ll_regular_grids,nya,nxa,fv3uv2earth_regular_grids use general_commvars_mod, only: ltosi_s,ltosj_s + use gridmod, only: ijn_sens,ijnens + use general_commvars_mod, only: ltosi_sens,ltosj_sens + use hybrid_ensemble_parameters, only: nlon_ens,nlat_ens implicit none character(*) ,intent(in ):: dynvarsfile - real(r_kind) ,intent(out ) :: ges_u(lat2,lon2,nsig) - real(r_kind) ,intent(out ) :: ges_v(lat2,lon2,nsig) + integer(i_kind) ,intent(in ) :: lat2in,lon2in + real(r_kind) ,intent(out ) :: ges_u(lat2in,lon2in,nsig) + real(r_kind) ,intent(out ) :: ges_v(lat2in,lon2in,nsig) + logical, intent(in ) :: ensgrid character(len=128) :: name real(r_kind),allocatable,dimension(:,:,:):: uu,temp1 integer(i_kind),allocatable,dimension(:):: dim_id,dim @@ -1469,7 +1583,11 @@ subroutine gsi_fv3ncdf_readuv(dynvarsfile,ges_u,ges_v) iret=nf90_inquire(gfile_loc,ndimensions,nvariables,nattributes,unlimiteddimid) allocate(dim(ndimensions)) - allocate(a(nya,nxa)) + if (ensgrid) then + allocate(a(nlat_ens,nlon_ens)) + else + allocate(a(nlat,nlon)) + end if do k=1,ndimensions iret=nf90_inquire_dimension(gfile_loc,k,name,len) @@ -1507,14 +1625,33 @@ subroutine gsi_fv3ncdf_readuv(dynvarsfile,ges_u,ges_v) nzp1=nz+1 do i=1,nz ir=nzp1-i - call fv3uv2earth_regular_grids(temp1(:,:,i),uu(:,:,i),nx,ny,u,v,p_fv3sar2anlgrid) - if(mype==mype_u)then - call fv3_h_to_ll_regular_grids(u,a,nx,ny,nxa,nya,p_fv3sar2anlgrid) + if (ensgrid) then + call fv3uv2earth_regular_grids(temp1(:,:,i),uu(:,:,i),nxens,nyens,u,v,p_fv3sar2ensgrid) + if(mype==mype_u)then + call fv3_h_to_ll_regular_grids(u,a,nxens,nyens,nlon_ens,nlat_ens,p_fv3sar2ensgrid) + else + call fv3_h_to_ll_regular_grids(v,a,nxens,nyens,nlon_ens,nlat_ens,p_fv3sar2ensgrid) + endif + kk=0 + do n=1,npe + ns=displssens(n)+(ir-1)*ijn_sens(n) + do j=1,ijn_sens(n) + ns=ns+1 + kk=kk+1 + ii=ltosi_sens(kk) + jj=ltosj_sens(kk) + work(ns)=a(ii,jj) + end do + end do else - call fv3_h_to_ll_regular_grids(v,a,nx,ny,nxa,nya,p_fv3sar2anlgrid) - endif - kk=0 - do n=1,npe + call fv3uv2earth_regular_grids(temp1(:,:,i),uu(:,:,i),nx,ny,u,v,p_fv3sar2anlgrid) + if(mype==mype_u)then + call fv3_h_to_ll_regular_grids(u,a,nx,ny,nlon,nlat,p_fv3sar2anlgrid) + else + call fv3_h_to_ll_regular_grids(v,a,nx,ny,nlon,nlat,p_fv3sar2anlgrid) + endif + kk=0 + do n=1,npe ns=displss(n)+(ir-1)*ijn_s(n) do j=1,ijn_s(n) ns=ns+1 @@ -1523,7 +1660,8 @@ subroutine gsi_fv3ncdf_readuv(dynvarsfile,ges_u,ges_v) jj=ltosj_s(kk) work(ns)=a(ii,jj) end do - end do + end do + end if enddo ! i deallocate(temp1,a) deallocate (dim,dim_id,uu,v,u) @@ -1531,13 +1669,20 @@ subroutine gsi_fv3ncdf_readuv(dynvarsfile,ges_u,ges_v) endif ! mype !! scatter to ges_u,ges_v !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call mpi_scatterv(work,ijns,displss,mpi_rtype,& + if (ensgrid) then + call mpi_scatterv(work,ijnsens,displssens,mpi_rtype,& + ges_u,ijnsens(mm1),mpi_rtype,mype_u,mpi_comm_world,ierror) + call mpi_scatterv(work,ijnsens,displssens,mpi_rtype,& + ges_v,ijnsens(mm1),mpi_rtype,mype_v,mpi_comm_world,ierror) + else + call mpi_scatterv(work,ijns,displss,mpi_rtype,& ges_u,ijns(mm1),mpi_rtype,mype_u,mpi_comm_world,ierror) - call mpi_scatterv(work,ijns,displss,mpi_rtype,& + call mpi_scatterv(work,ijns,displss,mpi_rtype,& ges_v,ijns(mm1),mpi_rtype,mype_v,mpi_comm_world,ierror) + end if deallocate(work) end subroutine gsi_fv3ncdf_readuv -subroutine gsi_fv3ncdf_readuv_v1(dynvarsfile,ges_u,ges_v) +subroutine gsi_fv3ncdf_readuv_v1(dynvarsfile,ges_u,ges_v,lat2in,lon2in,ensgrid) !$$$ subprogram documentation block ! subprogram: gsi_fv3ncdf_readuv_v1 ! prgmmr: wu w org: np22 date: 2017-11-22 @@ -1562,18 +1707,22 @@ subroutine gsi_fv3ncdf_readuv_v1(dynvarsfile,ges_u,ges_v) use constants, only: half use kinds, only: r_kind,i_kind use mpimod, only: ierror,mpi_comm_world,npe,mpi_rtype,mype - use gridmod, only: lat2,lon2,nsig,itotsub,ijn_s + use gridmod, only: lat2,lon2,nsig,itotsub,ijn_s,nlat,nlon use netcdf, only: nf90_open,nf90_close,nf90_get_var,nf90_noerr use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension use netcdf, only: nf90_inquire_variable use netcdf, only: nf90_inq_varid use mod_fv3_lolgrid, only: fv3_h_to_ll_regular_grids,nya,nxa,fv3uv2earth_regular_grids use general_commvars_mod, only: ltosi_s,ltosj_s - + use gridmod, only: ijn_sens,ijnens + use general_commvars_mod, only: ltosi_sens,ltosj_sens + use hybrid_ensemble_parameters, only: nlon_ens,nlat_ens implicit none character(*) ,intent(in ):: dynvarsfile - real(r_kind) ,intent(out ) :: ges_u(lat2,lon2,nsig) - real(r_kind) ,intent(out ) :: ges_v(lat2,lon2,nsig) + integer(i_kind) ,intent(in ) :: lat2in,lon2in + real(r_kind) ,intent(out ) :: ges_u(lat2in,lon2in,nsig) + real(r_kind) ,intent(out ) :: ges_v(lat2in,lon2in,nsig) + logical, intent(in ) :: ensgrid character(len=128) :: name real(r_kind),allocatable,dimension(:,:,:):: uu,temp0 integer(i_kind),allocatable,dimension(:):: dim_id,dim @@ -1598,31 +1747,54 @@ subroutine gsi_fv3ncdf_readuv_v1(dynvarsfile,ges_u,ges_v) iret=nf90_inquire(gfile_loc,ndimensions,nvariables,nattributes,unlimiteddimid) allocate(dim(ndimensions)) - allocate(a(nya,nxa)) + if (ensgrid) then + allocate(a(nlat_ens,nlon_ens)) + else + allocate(a(nlat,nlon)) + end if do k=1,ndimensions iret=nf90_inquire_dimension(gfile_loc,k,name,len) dim(k)=len enddo - allocate(uorv(nx,ny)) - if(mype == mype_u) then - allocate(uu(nx,ny+1,nsig)) - else ! for mype_v - allocate(uu(nx+1,ny,nsig)) - endif + if (ensgrid) then + if(mype == mype_u) then + allocate(uorv(nxens,nyens)) + allocate(uu(nxens,nyens+1,nsig)) + else ! for mype_v + allocate(uorv(nxens,nyens)) + allocate(uu(nxens+1,nyens,nsig)) + endif + else + if(mype == mype_u) then + allocate(uorv(nx,ny)) + allocate(uu(nx,ny+1,nsig)) + else ! for mype_v + allocate(uorv(nx,ny)) + allocate(uu(nx+1,ny,nsig)) + endif + end if ! transfor to earth u/v, interpolate to analysis grid, reverse vertical order if(mype == mype_u) then iret=nf90_inq_varid(gfile_loc,trim(adjustl("u_s")),var_id) iret=nf90_inquire_variable(gfile_loc,var_id,ndims=ndim) - allocate(temp0(nx,ny+1,nsig+1)) + if (ensgrid) then + allocate(temp0(nxens,nyens+1,nsig+1)) + else + allocate(temp0(nx,ny+1,nsig+1)) + end if iret=nf90_get_var(gfile_loc,var_id,temp0) uu(:,:,:)=temp0(:,:,2:nsig+1) deallocate(temp0) endif if(mype == mype_v) then - allocate(temp0(nx+1,ny,nsig+1)) + if (ensgrid) then + allocate(temp0(nxens+1,nyens,nsig+1)) + else + allocate(temp0(nx+1,ny,nsig+1)) + endif iret=nf90_inq_varid(gfile_loc,trim(adjustl("v_w")),var_id) iret=nf90_inquire_variable(gfile_loc,var_id,ndims=ndim) iret=nf90_get_var(gfile_loc,var_id,temp0) @@ -1633,20 +1805,45 @@ subroutine gsi_fv3ncdf_readuv_v1(dynvarsfile,ges_u,ges_v) nzp1=nztmp+1 do i=1,nztmp ir=nzp1-i - if(mype == mype_u)then + if (ensgrid) then + if(mype == mype_u)then + do j=1,nyens + uorv(:,j)=half*(uu(:,j,i)+uu(:,j+1,i)) + enddo + + call fv3_h_to_ll_regular_grids(uorv(:,:),a,nxens,nyens,nlon_ens,nlat_ens,p_fv3sar2ensgrid) + else + do j=1,nxens + uorv(j,:)=half*(uu(j,:,i)+uu(j+1,:,i)) + enddo + call fv3_h_to_ll_regular_grids(uorv(:,:),a,nxens,nyens,nlon_ens,nlat_ens,p_fv3sar2ensgrid) + endif + kk=0 + do n=1,npe + ns=displssens(n)+(ir-1)*ijn_sens(n) + do j=1,ijn_sens(n) + ns=ns+1 + kk=kk+1 + ii=ltosi_sens(kk) + jj=ltosj_sens(kk) + work(ns)=a(ii,jj) + end do + end do + else + if(mype == mype_u)then do j=1,ny uorv(:,j)=half*(uu(:,j,i)+uu(:,j+1,i)) enddo call fv3_h_to_ll_regular_grids(uorv(:,:),a,nx,ny,nxa,nya,p_fv3sar2anlgrid) - else + else do j=1,nx uorv(j,:)=half*(uu(j,:,i)+uu(j+1,:,i)) enddo call fv3_h_to_ll_regular_grids(uorv(:,:),a,nx,ny,nxa,nya,p_fv3sar2anlgrid) - endif - kk=0 - do n=1,npe + endif + kk=0 + do n=1,npe ns=displss(n)+(ir-1)*ijn_s(n) do j=1,ijn_s(n) ns=ns+1 @@ -1655,7 +1852,8 @@ subroutine gsi_fv3ncdf_readuv_v1(dynvarsfile,ges_u,ges_v) jj=ltosj_s(kk) work(ns)=a(ii,jj) end do - end do + end do + end if enddo ! i deallocate(a) deallocate (uu,uorv) @@ -1663,10 +1861,17 @@ subroutine gsi_fv3ncdf_readuv_v1(dynvarsfile,ges_u,ges_v) endif ! mype !! scatter to ges_u,ges_v !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call mpi_scatterv(work,ijns,displss,mpi_rtype,& + if (ensgrid) then + call mpi_scatterv(work,ijnsens,displssens,mpi_rtype,& + ges_u,ijnsens(mm1),mpi_rtype,mype_u,mpi_comm_world,ierror) + call mpi_scatterv(work,ijnsens,displssens,mpi_rtype,& + ges_v,ijnsens(mm1),mpi_rtype,mype_v,mpi_comm_world,ierror) + else + call mpi_scatterv(work,ijns,displss,mpi_rtype,& ges_u,ijns(mm1),mpi_rtype,mype_u,mpi_comm_world,ierror) - call mpi_scatterv(work,ijns,displss,mpi_rtype,& + call mpi_scatterv(work,ijns,displss,mpi_rtype,& ges_v,ijns(mm1),mpi_rtype,mype_v,mpi_comm_world,ierror) + end if deallocate(work) end subroutine gsi_fv3ncdf_readuv_v1 diff --git a/src/gsi/hybrid_ensemble_isotropic.F90 b/src/gsi/hybrid_ensemble_isotropic.F90 index ddd148ad98..5b4c111cc7 100644 --- a/src/gsi/hybrid_ensemble_isotropic.F90 +++ b/src/gsi/hybrid_ensemble_isotropic.F90 @@ -3853,6 +3853,7 @@ subroutine hybens_grid_setup ! 2010-02-20 parrish, adapt for dual resolution ! 2011-01-30 parrish, fix so regional application depends only on parameters regional ! and dual_res. Rename subroutine get_regional_gefs_grid to get_regional_dual_res_grid. +! 2021-02-01 Lu & Wang - add vars for hafs dual ens. POC: xuguang.wang@ou.edu ! ! input argument list: ! @@ -3880,6 +3881,9 @@ subroutine hybens_grid_setup use gridmod, only: region_lat,region_lon,region_dx,region_dy use hybrid_ensemble_parameters, only:regional_ensemble_option use gsi_rfv3io_mod,only:gsi_rfv3io_get_ens_grid_specs + use general_commvars_mod, only: ltosi_sens,ltosj_sens + use gridmod, only: itotsub,ijn_sens,ijnens,displs_sens + use mpimod, only: npe implicit none @@ -3946,6 +3950,11 @@ subroutine hybens_grid_setup allocate(vector(num_fields)) vector=.false. call general_sub2grid_create_info(grd_loc,inner_vars,nlat_ens,nlon_ens,nsig,num_fields,regional,vector) + ltosi_sens=grd_loc%ltosi_s + ltosj_sens=grd_loc%ltosj_s + ijn_sens=grd_loc%ijn_s + ijnens=grd_loc%ijn + displs_sens=grd_loc%displs_s num_fields=max(0,nc3d)*nsig+max(0,nc2d) deallocate(vector) allocate(vector(num_fields)) diff --git a/src/gsi/mod_fv3_lolgrid.f90 b/src/gsi/mod_fv3_lolgrid.f90 index 4fd5218da2..c2cb2cb865 100644 --- a/src/gsi/mod_fv3_lolgrid.f90 +++ b/src/gsi/mod_fv3_lolgrid.f90 @@ -665,6 +665,7 @@ subroutine definecoef_regular_grids(nx,ny,grid_lon,grid_lont,grid_lat,grid_latt, ! 2. compute/setup FV3 to A grid interpolation parameters ! 3. compute/setup A to FV3 grid interpolation parameters ! 4. setup weightings for wind conversion from FV3 to earth +! 2021-02-01 Lu & Wang - modify variable intent for HAFS dual ens. POC: xuguang.wang@ou.edu ! ! input argument list: ! nx, ny - number of cells = nx*ny @@ -686,8 +687,8 @@ subroutine definecoef_regular_grids(nx,ny,grid_lon,grid_lont,grid_lat,grid_latt, use gridmod, only:init_general_transform implicit none type (fv3sar2grid_parm),intent(inout):: p_fv3sar2grid - real(r_kind),allocatable,intent(out):: region_lat_in(:,:),region_lon_in(:,:) - integer(i_kind), intent(out):: nlatin,nlonin + real(r_kind),allocatable,intent(inout):: region_lat_in(:,:),region_lon_in(:,:) + integer(i_kind), intent(inout):: nlatin,nlonin real(r_kind) ,pointer,dimension(:,:):: fv3dx,fv3dx1,fv3dy,fv3dy1 From 636b6224b5363003e829153d73db5951b4e78b05 Mon Sep 17 00:00:00 2001 From: Bin Liu Date: Tue, 16 Feb 2021 12:14:35 -0500 Subject: [PATCH 2/3] Minor modifications for dual resolution regional ensembles (#3) A couple of modifications for fv3-lam dual resolution from @TingLei-NOAA --- src/gsi/gsi_rfv3io_mod.f90 | 6 +++--- src/gsi/mod_fv3_lolgrid.f90 | 13 ++++++++----- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/src/gsi/gsi_rfv3io_mod.f90 b/src/gsi/gsi_rfv3io_mod.f90 index def202ecd5..1744602bda 100644 --- a/src/gsi/gsi_rfv3io_mod.f90 +++ b/src/gsi/gsi_rfv3io_mod.f90 @@ -393,7 +393,7 @@ subroutine gsi_rfv3io_get_ens_grid_specs(grid_spec,ierr) use hybrid_ensemble_parameters, only: region_lat_ens,region_lon_ens use mpimod, only: mype !cltorg use mod_fv3_lola, only: generate_anl_grid - use mod_fv3_lolgrid, only: definecoef_regular_grids + use mod_fv3_lolgrid, only: definecoef_regular_grids,nxa_ens,nya_ens use gridmod, only:region_lat,region_lon,nlat,nlon use gridmod, only: region_dy,region_dx,region_dyi,region_dxi,coeffy,coeffx use kinds, only: i_kind,r_kind @@ -466,7 +466,7 @@ subroutine gsi_rfv3io_get_ens_grid_specs(grid_spec,ierr) !!!!!!! setup A grid and interpolation/rotation coeff. - call definecoef_regular_grids(nxens,nyens,grid_lon,grid_lont,grid_lat,grid_latt,p_fv3sar2ensgrid, & + call definecoef_regular_grids(nxens,nyens,nxa_ens,nya_ens,grid_lon,grid_lont,grid_lat,grid_latt,p_fv3sar2ensgrid, & nlat_ens,nlon_ens,region_lat_ens,region_lon_ens) deallocate (grid_lon,grid_lat,grid_lont,grid_latt) @@ -930,7 +930,7 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z) use netcdf, only: nf90_open,nf90_close,nf90_get_var,nf90_noerr use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension use netcdf, only: nf90_inquire_variable - use mod_fv3_lolgrid, only: fv3_h_to_ll_regular_grids,nxa,nya + use mod_fv3_lolgrid, only: fv3_h_to_ll_regular_grids,nxa,nya,nxa_ens,nya_ens use constants, only: grav implicit none diff --git a/src/gsi/mod_fv3_lolgrid.f90 b/src/gsi/mod_fv3_lolgrid.f90 index c2cb2cb865..4ccb6cc4b4 100644 --- a/src/gsi/mod_fv3_lolgrid.f90 +++ b/src/gsi/mod_fv3_lolgrid.f90 @@ -71,6 +71,7 @@ module mod_fv3_lolgrid public :: p_fv3sar2anlgrid public :: p_fv3sar2ensgrid public :: nxa,nya + public :: nxa_ens,nya_ens type fv3sar2grid_parm logical bilinear integer(i_kind) nxout,nyout,nx,ny @@ -82,6 +83,7 @@ module mod_fv3_lolgrid end type type (fv3sar2grid_parm)::p_fv3sar2anlgrid,p_fv3sar2ensgrid integer(i_kind) nxa,nya + integer(i_kind) nxa_ens,nya_ens contains @@ -648,7 +650,7 @@ subroutine generate_regular_grids(nx,ny,grid_lon,grid_lont,grid_lat,grid_latt,p_ deallocate( xc,yc,zc,gclat,gclon,gcrlat,gcrlon) deallocate(rlat_in,rlon_in) end subroutine generate_regular_grids -subroutine definecoef_regular_grids(nx,ny,grid_lon,grid_lont,grid_lat,grid_latt,p_fv3sar2grid,& +subroutine definecoef_regular_grids(nx,ny,nxa_inout,nya_inout,grid_lon,grid_lont,grid_lat,grid_latt,p_fv3sar2grid,& nlatin,nlonin,region_lat_in,region_lon_in) !$$$ subprogram documentation block ! . . . . @@ -705,6 +707,7 @@ subroutine definecoef_regular_grids(nx,ny,grid_lon,grid_lont,grid_lat,grid_latt, integer(i_kind), intent(in ) :: nx,ny ! fv3 tile x- and y-dimensions + integer(i_kind), intent(inout ) :: nxa_inout,nya_inout real(r_kind) , intent(inout) :: grid_lon(nx+1,ny+1) ! fv3 cell corner longitudes real(r_kind) , intent(inout) :: grid_lont(nx,ny) ! fv3 cell center longitudes real(r_kind) , intent(inout) :: grid_lat(nx+1,ny+1) ! fv3 cell corner latitudes @@ -781,8 +784,8 @@ subroutine definecoef_regular_grids(nx,ny,grid_lon,grid_lont,grid_lat,grid_latt, p_fv3sar2grid%nxout=nxout nyout=nlatin p_fv3sar2grid%nyout=nyout - nxa=nxout - nya=nyout ! for compatiability + nxa_inout=nxout + nya_inout=nyout ! for compatiability if(mype==0) print *,'nlatin,nlonin = ',nlatin,nlonin !--------------------------obtain analysis grid spacing @@ -854,10 +857,10 @@ subroutine definecoef_regular_grids(nx,ny,grid_lon,grid_lont,grid_lat,grid_latt, index0=1 !cltthinkdeb should region_lon_in be in degree or not? - do j=1,nxa + do j=1,nxa_inout xa_a(j)= (rlon_in(index0,j)-clon)/dlon end do - do i=1,nya + do i=1,nya_inout ya_a(i)= (rlat_in(i,index0)-clat)/dlon end do From 8b0c604e8c473ab4e6f862d80b014e9f4c746796 Mon Sep 17 00:00:00 2001 From: "Bin.Liu" Date: Tue, 16 Feb 2021 15:02:43 -0600 Subject: [PATCH 3/3] Changes from Xu Lu (OU): No need to introduce extra variables when the lon/lat2ens=grd_ens%lon/lat2 in cplr_get_fv3_regional_ensperts.f90. --- src/gsi/cplr_get_fv3_regional_ensperts.f90 | 46 +++++++++++----------- 1 file changed, 22 insertions(+), 24 deletions(-) diff --git a/src/gsi/cplr_get_fv3_regional_ensperts.f90 b/src/gsi/cplr_get_fv3_regional_ensperts.f90 index c68b908c0a..fe943985d2 100644 --- a/src/gsi/cplr_get_fv3_regional_ensperts.f90 +++ b/src/gsi/cplr_get_fv3_regional_ensperts.f90 @@ -362,7 +362,7 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g ! ! Declare local variables - integer(i_kind):: i,j,k,kp,lon2ens,lat2ens + integer(i_kind):: i,j,k,kp integer(i_kind) iderivative @@ -392,36 +392,34 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g !cltthinktobe should be contained in variable like grd_ens - lon2ens=grd_ens%lon2 - lat2ens=grd_ens%lat2 if (dual_res) then if(fv3sar_ensemble_opt == 0 ) then - call gsi_fv3ncdf_readuv(dynvars,g_u,g_v,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf_readuv(dynvars,g_u,g_v,grd_ens%lat2,grd_ens%lon2,.true.) else - call gsi_fv3ncdf_readuv_v1(dynvars,g_u,g_v,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf_readuv_v1(dynvars,g_u,g_v,grd_ens%lat2,grd_ens%lon2,.true.) endif if(fv3sar_ensemble_opt == 0) then - call gsi_fv3ncdf_read(dynvars,'T','t',g_tsen,mype_t,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf_read(dynvars,'T','t',g_tsen,mype_t,grd_ens%lat2,grd_ens%lon2,.true.) else - call gsi_fv3ncdf_read_v1(dynvars,'t','T',g_tsen,mype_t,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf_read_v1(dynvars,'t','T',g_tsen,mype_t,grd_ens%lat2,grd_ens%lon2,.true.) endif else if(fv3sar_ensemble_opt == 0 ) then - call gsi_fv3ncdf_readuv(dynvars,g_u,g_v,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf_readuv(dynvars,g_u,g_v,grd_ens%lat2,grd_ens%lon2,.false.) else - call gsi_fv3ncdf_readuv_v1(dynvars,g_u,g_v,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf_readuv_v1(dynvars,g_u,g_v,grd_ens%lat2,grd_ens%lon2,.false.) endif if(fv3sar_ensemble_opt == 0) then - call gsi_fv3ncdf_read(dynvars,'T','t',g_tsen,mype_t,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf_read(dynvars,'T','t',g_tsen,mype_t,grd_ens%lat2,grd_ens%lon2,.false.) else - call gsi_fv3ncdf_read_v1(dynvars,'t','T',g_tsen,mype_t,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf_read_v1(dynvars,'t','T',g_tsen,mype_t,grd_ens%lat2,grd_ens%lon2,.false.) endif end if if (fv3sar_ensemble_opt == 0) then if (dual_res) then - call gsi_fv3ncdf_read(dynvars,'DELP','delp',g_prsi,mype_p,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf_read(dynvars,'DELP','delp',g_prsi,mype_p,grd_ens%lat2,grd_ens%lon2,.true.) else - call gsi_fv3ncdf_read(dynvars,'DELP','delp',g_prsi,mype_p,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf_read(dynvars,'DELP','delp',g_prsi,mype_p,grd_ens%lat2,grd_ens%lon2,.false.) end if g_prsi(:,:,grd_ens%nsig+1)=eta1_ll(grd_ens%nsig+1) !thinkto be done , should use eta1_ll from ensemble grid do i=grd_ens%nsig,1,-1 @@ -430,9 +428,9 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g g_ps(:,:)=g_prsi(:,:,1) else ! for the ensemble processed frm CHGRES if (dual_res) then - call gsi_fv3ncdf2d_read_v1(dynvars,'ps','PS',g_ps,mype_p,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf2d_read_v1(dynvars,'ps','PS',g_ps,mype_p,grd_ens%lat2,grd_ens%lon2,.true.) else - call gsi_fv3ncdf2d_read_v1(dynvars,'ps','PS',g_ps,mype_p,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf2d_read_v1(dynvars,'ps','PS',g_ps,mype_p,grd_ens%lat2,grd_ens%lon2,.false.) end if g_ps=g_ps*0.001_r_kind do k=1,grd_ens%nsig+1 @@ -442,19 +440,19 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g if (dual_res) then if(fv3sar_ensemble_opt == 0) then - call gsi_fv3ncdf_read(tracers,'SPHUM','sphum',g_q,mype_q,lat2ens,lon2ens,.true.) - call gsi_fv3ncdf_read(tracers,'O3MR','o3mr',g_oz,mype_oz,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf_read(tracers,'SPHUM','sphum',g_q,mype_q,grd_ens%lat2,grd_ens%lon2,.true.) + call gsi_fv3ncdf_read(tracers,'O3MR','o3mr',g_oz,mype_oz,grd_ens%lat2,grd_ens%lon2,.true.) else - call gsi_fv3ncdf_read_v1(tracers,'sphum','SPHUM',g_q,mype_q,lat2ens,lon2ens,.true.) - call gsi_fv3ncdf_read_v1(tracers,'o3mr','O3MR',g_oz,mype_oz,lat2ens,lon2ens,.true.) + call gsi_fv3ncdf_read_v1(tracers,'sphum','SPHUM',g_q,mype_q,grd_ens%lat2,grd_ens%lon2,.true.) + call gsi_fv3ncdf_read_v1(tracers,'o3mr','O3MR',g_oz,mype_oz,grd_ens%lat2,grd_ens%lon2,.true.) endif else if(fv3sar_ensemble_opt == 0) then - call gsi_fv3ncdf_read(tracers,'SPHUM','sphum',g_q,mype_q,lat2ens,lon2ens,.false.) - call gsi_fv3ncdf_read(tracers,'O3MR','o3mr',g_oz,mype_oz,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf_read(tracers,'SPHUM','sphum',g_q,mype_q,grd_ens%lat2,grd_ens%lon2,.false.) + call gsi_fv3ncdf_read(tracers,'O3MR','o3mr',g_oz,mype_oz,grd_ens%lat2,grd_ens%lon2,.false.) else - call gsi_fv3ncdf_read_v1(tracers,'sphum','SPHUM',g_q,mype_q,lat2ens,lon2ens,.false.) - call gsi_fv3ncdf_read_v1(tracers,'o3mr','O3MR',g_oz,mype_oz,lat2ens,lon2ens,.false.) + call gsi_fv3ncdf_read_v1(tracers,'sphum','SPHUM',g_q,mype_q,grd_ens%lat2,grd_ens%lon2,.false.) + call gsi_fv3ncdf_read_v1(tracers,'o3mr','O3MR',g_oz,mype_oz,grd_ens%lat2,grd_ens%lon2,.false.) endif end if @@ -477,7 +475,7 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g end do end do end do - call genqsat(g_rh,g_tsen(1,1,1),g_prsl(1,1,1),lat2ens,lon2ens,grd_ens%nsig,ice,iderivative) + call genqsat(g_rh,g_tsen(1,1,1),g_prsl(1,1,1),grd_ens%lat2,grd_ens%lon2,grd_ens%nsig,ice,iderivative) do k=1,grd_ens%nsig do j=1,grd_ens%lon2 do i=1,grd_ens%lat2