diff --git a/parm/regrid_sfc/regrid.nml_tmpl b/parm/regrid_sfc/regrid.nml_tmpl index 1d23deca7..915ec8bf9 100644 --- a/parm/regrid_sfc/regrid.nml_tmpl +++ b/parm/regrid_sfc/regrid.nml_tmpl @@ -4,25 +4,26 @@ missing_value=0., time_list=@[time_list], add_time_dim=@[add_time_dim], + nmem_ens=@[NMEM_REGRID], / &input gridtype="gau_inc", ires=@[ires], jres=@[jres], fname=@[in_fname], - dir="./", + dir=@[in_dir], fname_coord="gaussian_scrip.nc", dir_coord="./", fname_mask=@[fname_mask_in], - dir_mask=@[dir_mask_in] + dir_mask=@[dir_mask_in], / &output gridtype="fv3_rst", ires=@[ireso], jres=@[jreso], fname=@[out_fname], - dir="./", - fname_mask="vegetation_type" - dir_mask="./" - dir_coord="./" + dir=@[out_dir], + fname_mask="vegetation_type", + dir_mask="./", + dir_coord="./", / diff --git a/reg_tests/regrid_sfc/gauss2fv3incr.sh b/reg_tests/regrid_sfc/gauss2fv3incr.sh index 3e9d68675..9aec4cb2f 100755 --- a/reg_tests/regrid_sfc/gauss2fv3incr.sh +++ b/reg_tests/regrid_sfc/gauss2fv3incr.sh @@ -59,6 +59,7 @@ cat << EOF > regrid.nml time_list=6, add_time_dim=.true., extrap_levs=2, + nmem_ens=1, / &input gridtype="gau_inc", diff --git a/sorc/regrid_sfc.fd/grids_IO.F90 b/sorc/regrid_sfc.fd/grids_IO.F90 index 1e2854f1d..f55b9bbf0 100644 --- a/sorc/regrid_sfc.fd/grids_IO.F90 +++ b/sorc/regrid_sfc.fd/grids_IO.F90 @@ -43,17 +43,18 @@ module grids_IO !> Create ESMF grid objects, with mask if requested !! @param[in] localpet local pet !! @param[in] npets total number of pets +!! @param[in] imem_ens ensemble member index !! @param[in] grid_setup data structure with grid details !! @param[out] mod_grid output esmf_grid structure !! @param[in] timestamp timestep of input file - subroutine setup_grid(localpet, npets, grid_setup, mod_grid, timestamp ) + subroutine setup_grid(localpet, npets, imem_ens, grid_setup, mod_grid, timestamp ) implicit none ! INTENT IN type(grid_setup_type), intent(in) :: grid_setup - integer, intent(in) :: localpet, npets + integer, intent(in) :: localpet, npets, imem_ens integer, intent(in), optional :: timestamp ! INTENT OUT @@ -74,9 +75,9 @@ subroutine setup_grid(localpet, npets, grid_setup, mod_grid, timestamp ) select case (grid_setup%descriptor) case ('fv3_rst') - call create_grid_fv3(grid_setup%ires, trim(grid_setup%dir_coord), npets, localpet ,mod_grid) + call create_grid_fv3(grid_setup%ires, trim(grid_setup%dir_coord), npets, localpet, imem_ens, mod_grid) case ('gau_inc') - call create_grid_gauss(grid_setup, npets, localpet, mod_grid) + call create_grid_gauss(grid_setup, npets, localpet, imem_ens, mod_grid) case default call error_handler("unknown grid_setup%descriptor in setup_grid", 1) end select @@ -251,6 +252,7 @@ end subroutine read_into_fields !> write variables from ESMF Fields into netcdf restart-like file !! @param[in] localpet local pet +!! @param[in] imem_ens ensemble member index !! @param[in] i_dim longitudinal dimension !! @param[in] j_dim latitudinal dimension !! @param[in] fname_out file name to write to @@ -261,13 +263,13 @@ end subroutine read_into_fields !! @param[in] fields fields to read variables into !! @param[in] add_time_dim specify whether output file has time dimension - subroutine write_from_fields(localpet, i_dim, j_dim , fname_out, dir_out, & + subroutine write_from_fields(localpet, imem_ens, i_dim, j_dim , fname_out, dir_out, & n_vars, n_tims, variable_list, fields, add_time_dim) implicit none ! INTENT IN - integer, intent(in) :: localpet, i_dim, j_dim, n_vars, n_tims + integer, intent(in) :: localpet, imem_ens, i_dim, j_dim, n_vars, n_tims character(*), intent(in) :: fname_out character(*), intent(in) :: dir_out character(15), dimension(n_vars), intent(in) :: variable_list @@ -278,21 +280,18 @@ subroutine write_from_fields(localpet, i_dim, j_dim , fname_out, dir_out, & integer :: tt, id_var, ncid, ierr, & id_x, id_y, id_t, v, t character(len=1) :: tchar + character(len=3) :: memchar character(len=500) :: fname real(esmf_kind_r8), allocatable :: array2D(:,:) real(esmf_kind_r8), allocatable :: array_out(:,:,:,:) do v = 1, n_vars - if (localpet == 0) print *, 'Writing ', trim(variable_list(v)), ' into field' + if (localpet == 0) print *, 'Writing ', trim(variable_list(v)), ' into field for ensemble member', imem_ens enddo - if (localpet==0) then - allocate(array_out(n_vars, i_dim, j_dim, n_tims)) - allocate(array2D(i_dim, j_dim)) - else - allocate(array_out(0,0,0,0)) - allocate(array2D(0,0)) - end if + ! All processes need properly sized arrays for FieldGather to work + allocate(array_out(n_vars, i_dim, j_dim, n_tims)) + allocate(array2D(i_dim, j_dim)) do tt = 1, n_tiles @@ -311,7 +310,8 @@ subroutine write_from_fields(localpet, i_dim, j_dim , fname_out, dir_out, & ! open file, set dimensions write(tchar,'(i1)') tt - fname = dir_out//"/"//fname_out//".tile"//tchar//".nc" + write(memchar,'(I3)') imem_ens + fname = dir_out//"/"//fname_out//".mem"//trim(adjustl(memchar))//".tile"//tchar//".nc" ierr = nf90_create(trim(fname), NF90_NETCDF4, ncid) call netcdf_err(ierr, 'creating file='//trim(fname) ) @@ -369,13 +369,14 @@ end subroutine write_from_fields !! @param[in] dir_fix orog fix directory !! @param[in] localpet local pet !! @param[in] npets total number of pets +!! @param[in] imem_ens ensemble member index !! @param[out] fv3_grid output ESMF grid - subroutine create_grid_fv3(res_atm, dir_fix, npets, localpet, fv3_grid) + subroutine create_grid_fv3(res_atm, dir_fix, npets, localpet, imem_ens, fv3_grid) ! INTENT IN - integer, intent(in) :: npets, localpet + integer, intent(in) :: npets, localpet, imem_ens integer, intent(in) :: res_atm character(*), intent(in) :: dir_fix @@ -388,7 +389,7 @@ subroutine create_grid_fv3(res_atm, dir_fix, npets, localpet, fv3_grid) character(len=5) :: rchar character(len=200) :: fname - if (localpet == 0) print*," creating fv3 grid for ", res_atm + if (localpet == 0) print*," creating fv3 grid for ", res_atm, " for ensemble member ", imem_ens ! pet distribution extra = npets / n_tiles @@ -418,13 +419,14 @@ end subroutine create_grid_fv3 !! @param[in] grid_setup data structure with grid details !! @param[in] npets total number of pets !! @param[in] localpet local pet +!! @param[in] imem_ens ensemble member index !! @param[out] gauss_grid output ESMF grid - subroutine create_grid_gauss(grid_setup, npets, localpet, gauss_grid) + subroutine create_grid_gauss(grid_setup, npets, localpet, imem_ens, gauss_grid) ! INTENT IN type(grid_setup_type), intent(in) :: grid_setup - integer, intent(in) :: npets, localpet + integer, intent(in) :: npets, localpet, imem_ens ! INTENT OUT type(esmf_grid) :: gauss_grid @@ -434,7 +436,7 @@ subroutine create_grid_gauss(grid_setup, npets, localpet, gauss_grid) fname = trim(grid_setup%dir_coord)//trim(grid_setup%fname_coord) - if (localpet == 0) print*," creating gauss grid for ", trim(fname) + if (localpet == 0) print*," creating gauss grid for ", trim(fname), " for ensemble member ", imem_ens fac = npets / n_tiles gauss_grid = ESMF_GridCreate(filename=trim(fname), & diff --git a/sorc/regrid_sfc.fd/readin_setup.F90 b/sorc/regrid_sfc.fd/readin_setup.F90 index 26a9c37e0..8c2738ed1 100644 --- a/sorc/regrid_sfc.fd/readin_setup.F90 +++ b/sorc/regrid_sfc.fd/readin_setup.F90 @@ -9,8 +9,10 @@ !! !! @param[in] unt file unit !! @param[in] namel options: input or output +!! @param[in] nmem_ens number of ensemble members +!! @param[in] imem_ens ensemble member index !! @param[out] grid_setup data structure with grid details - subroutine readin_setup(unt,namel,grid_setup) + subroutine readin_setup(unt,namel,nmem_ens,imem_ens,grid_setup) use grids_IO, only : grid_setup_type use utilities, only : error_handler @@ -18,14 +20,14 @@ subroutine readin_setup(unt,namel,grid_setup) implicit none ! INPUTS - integer, intent(in) :: unt + integer, intent(in) :: unt, nmem_ens, imem_ens character(*), intent(in) :: namel ! OUTPUTS type(grid_setup_type), intent(out) :: grid_setup character(len=7) :: gridtype character(len=100) :: fname, fname_mask, fname_coord - character(len=100) :: dir, dir_mask, dir_coord + character(len=100) :: dir(nmem_ens), dir_mask, dir_coord character(len=4) :: default_str="NULL" integer :: ires, jres integer :: ierr @@ -71,7 +73,7 @@ subroutine readin_setup(unt,namel,grid_setup) grid_setup%descriptor = gridtype - grid_setup%dir = dir + grid_setup%dir = dir(imem_ens) grid_setup%fname = fname grid_setup%mask_from_input = .false. @@ -83,7 +85,7 @@ subroutine readin_setup(unt,namel,grid_setup) grid_setup%mask_variable(1) = "vegetation_type" ! if getting from fix file case ("gau_inc") ! gsi-output incr files only, use calculated mask if (trim(fname_mask) == default_str) then ! if not specified, use input file - grid_setup%dir_mask = dir + grid_setup%dir_mask = dir(imem_ens) grid_setup%fname_mask = fname grid_setup%mask_from_input = .true. else diff --git a/sorc/regrid_sfc.fd/regridStates.F90 b/sorc/regrid_sfc.fd/regridStates.F90 index 9fb461cf9..777efd9a6 100644 --- a/sorc/regrid_sfc.fd/regridStates.F90 +++ b/sorc/regrid_sfc.fd/regridStates.F90 @@ -8,7 +8,7 @@ program regridStates - use mpi_f08 + use mpi use esmf use grids_IO, only : setup_grid, & @@ -29,15 +29,16 @@ program regridStates integer :: time_list(10) !< increment forecast hours logical :: add_time_dim !< specify whether the output increment has time dimension real(esmf_kind_r8) :: missing_value ! value given to unmapped cells in the output grid + integer :: nmem_ens type(grid_setup_type) :: grid_setup_in, grid_setup_out - integer :: ierr, localpet, npets + integer :: ierr, localpet, npets, localcomm, subpet, imem_ens integer :: v, t, SRCTERM character(100) :: fname_time - type(esmf_vm) :: vm + type(esmf_vm) :: vmlocal type(esmf_grid), allocatable :: grid_in(:) type(esmf_grid) :: grid_out type(esmf_field), allocatable :: fields_in(:,:) @@ -51,26 +52,42 @@ program regridStates character(len=3) :: tstr ! see README for details of namelist variables. - namelist /config/ n_vars, variable_list, missing_value, extrap_levs, time_list, add_time_dim + namelist /config/ n_vars, variable_list, missing_value, extrap_levs, time_list, add_time_dim, nmem_ens ! INITIALIZE !------------------------------------------------------------------------- call cpu_time(t1) + + ! intialize mpi + call mpi_init(ierr) + if (ierr .ne. MPI_SUCCESS) call error_handler("mpi_init", ierr) - call ESMF_Initialize(rc=ierr) - if(ESMF_logFoundError(rcToCheck=ierr,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("INITIALIZING ESMF", ierr) + call mpi_comm_rank(MPI_COMM_WORLD, localpet, ierr) + if (ierr .ne. MPI_SUCCESS) call error_handler("mpi_comm_rank", ierr) - call ESMF_VMGetGlobal(vm, rc=ierr) - if(ESMF_logFoundError(rcToCheck=ierr,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN VMGetGlobal", ierr) + call mpi_comm_size(MPI_COMM_WORLD, npets, ierr) + if (ierr .ne. MPI_SUCCESS) call error_handler("mpi_comm_size", ierr) + + if (mod(npets,n_tiles) /= 0) then + call error_handler("must run with a task count that is a multiple of 6", 1) + endif + + imem_ens = localpet/n_tiles + 1 + + call mpi_comm_split(MPI_COMM_WORLD, imem_ens-1, localpet, localcomm, ierr) + if (ierr .ne. MPI_SUCCESS) call error_handler("mpi_comm_split", ierr) - call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=ierr) + call mpi_comm_rank(localcomm, subpet, ierr) + if (ierr .ne. MPI_SUCCESS) call error_handler("mpi_comm_rank(localcomm)", ierr) + + ! initialize esmf + + call ESMF_Initialize(rc=ierr, mpiCommunicator=localcomm, logkindflag=ESMF_LOGKIND_MULTI) if(ESMF_logFoundError(rcToCheck=ierr,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN VMGet", ierr) + call error_handler("INITIALIZING ESMF", ierr) !------------------------------------------------------------------------- ! RUN @@ -78,12 +95,6 @@ program regridStates print*,'** pets: local, total: ',localpet, npets - ! checks - - if (mod(npets,n_tiles) /= 0) then - call error_handler("must run with a task count that is a multiple of 6", 1) - endif - !------------------------ ! read in namelist @@ -96,11 +107,13 @@ program regridStates if (ierr /= 0) call error_handler("OPENING regrid NAMELIST.", ierr) read(ut, nml=config, iostat=ierr) if (ierr /= 0) call error_handler("OPENING config NAMELIST.", ierr) - call readin_setup(ut,"input",grid_setup_in) - call readin_setup(ut,"output",grid_setup_out) + if(npets/n_tiles /= nmem_ens) then + call error_handler("number of processor divided by number of tiles must equal number of ensemble members", 1) + endif + call readin_setup(ut,"input",nmem_ens,imem_ens,grid_setup_in) + call readin_setup(ut,"output",nmem_ens,imem_ens,grid_setup_out) close (ut) - n_tims = 0 do t=1,10 if (time_list(t) .lt. 0) exit @@ -115,21 +128,21 @@ program regridStates ! TO DO - can we make the number of tasks more flexible for fv3 - if (localpet==0) print*,'** Setting up grids' + if (subpet==0) print*,'** Setting up grids for ensemble member ', imem_ens allocate(grid_in(n_tims)) do t = 1, n_tims if (grid_setup_in%mask_from_input) then - call setup_grid(localpet, npets, grid_setup_in, grid_in(t), time_list(t) ) + call setup_grid(subpet, n_tiles, imem_ens, grid_setup_in, grid_in(t), time_list(t) ) else - call setup_grid(localpet, npets, grid_setup_in, grid_in(t)) + call setup_grid(subpet, n_tiles, imem_ens, grid_setup_in, grid_in(t)) endif enddo - call setup_grid(localpet, npets, grid_setup_out, grid_out ) + call setup_grid(subpet, n_tiles, imem_ens, grid_setup_out, grid_out ) !------------------------ ! Create input and output fields - if (localpet==0) print*,'** Creating/Reading fields' + if (subpet==0) print*,'** Creating/Reading fields for ensemble member ', imem_ens ! input allocate(fields_in(n_tims,n_vars)) @@ -183,7 +196,7 @@ program regridStates write(tstr,"(I3.3)")time_list(t) fname_time = trim(grid_setup_in%fname)//tstr//".nc" write(6,*) 'reading into ', trim(fname_time) - call read_into_fields(localpet, grid_setup_in%ires, grid_setup_in%jres, & + call read_into_fields(subpet, grid_setup_in%ires, grid_setup_in%jres, & trim(fname_time), trim(grid_setup_in%dir), & grid_setup_in, n_vars, variable_list(1:n_vars), fields_in(t,:)) enddo @@ -192,7 +205,7 @@ program regridStates !------------------------ ! regrid the input fields to the output grid - if (localpet==0) print*,'** Performing regridding' + if (subpet==0) print*,'** Performing regridding for ensemble member', imem_ens SRCTERM=1 ! get regriding route for a field (only uses the grid info in the field) @@ -235,9 +248,9 @@ program regridStates ! write out fields on destination grid. All times into same file. - if (localpet==0) print*,'** Writing out regridded fields' + if (subpet==0) print*,'** Writing out regridded fields for ensemble member ', imem_ens - call write_from_fields(localpet, grid_setup_out%ires, grid_setup_out%jres, & + call write_from_fields(subpet, imem_ens, grid_setup_out%ires, grid_setup_out%jres, & trim(grid_setup_out%fname), trim(grid_setup_out%dir), & n_vars, n_tims, variable_list(1:n_vars), fields_out, add_time_dim) @@ -276,8 +289,8 @@ program regridStates call mpi_finalize(ierr) call cpu_time(t4) - if (localpet==0) print*, '** time in tile2tile', t4 - t1 - if (localpet==0) print*, '** time in RegridStore', t3 - t2 + if (subpet==0) print*, '** time in tile2tile', t4 - t1, 'for ensemble member ', imem_ens + if (subpet==0) print*, '** time in RegridStore', t3 - t2, 'for ensemble member ', imem_ens print*,"** DONE.", localpet diff --git a/tests/regrid_sfc/data/regrid.nml b/tests/regrid_sfc/data/regrid.nml index a3897d2c9..164abf9e7 100644 --- a/tests/regrid_sfc/data/regrid.nml +++ b/tests/regrid_sfc/data/regrid.nml @@ -3,6 +3,7 @@ variable_list="soilt1_inc", "soilt2_inc", "slc1_inc", "slc2_inc", missing_value=0., extrap_levs=2, + nmem_ens=1, / &input gridtype="gau_inc", diff --git a/tests/regrid_sfc/ftst_read_namelist.F90 b/tests/regrid_sfc/ftst_read_namelist.F90 index c99e4fcbc..fa4a9d517 100644 --- a/tests/regrid_sfc/ftst_read_namelist.F90 +++ b/tests/regrid_sfc/ftst_read_namelist.F90 @@ -19,7 +19,7 @@ program read_namelist if (ierr /= 0) stop 66 print*,'Read input namelist.' - call readin_setup(12, "input", grid_setup_in) + call readin_setup(12, "input", 1, 1, grid_setup_in) if (trim(grid_setup_in%descriptor) /= "gau_inc") stop 2 if (trim(grid_setup_in%dir) /= "./") stop 4 @@ -33,7 +33,7 @@ program read_namelist if (grid_setup_in%jres /= 384) stop 20 print*,'Read output namelist.' - call readin_setup(12, "output", grid_setup_out) + call readin_setup(12, "output", 1, 1, grid_setup_out) if (trim(grid_setup_out%descriptor) /= "fv3_rst") stop 32 if (trim(grid_setup_out%dir) /= "./") stop 34