From 03bfaee92db193d80e64f41abd5e6e1d5dd46667 Mon Sep 17 00:00:00 2001 From: Christina Holt <56881914+christinaholtNOAA@users.noreply.github.com> Date: Tue, 8 Mar 2022 10:32:07 -0600 Subject: [PATCH 1/5] Merge NOAA-EMC develop into gsl/develop (#126) * Feature/ccpp codeowners (#442) * Per-file CODEOWNERS in ccpp/physics to set up automatic review requests * Code cleanup. Remove used code/variables. Fix minor inconsistencies. (#440) * Remove ESMF Alarm and TimeInterval variables from module_fv3_config. * Variables nfhmax, nfhmax_hf are unused outside InitializeAdvertise. Declared them as local variables. * There is no need to keep duplicates of all time related variables in atm_int_state when we can easily access them from atm_int_state%Atm. * Remove redundant call to fms_init * Add few missing ESMF_LogFoundError checks in module_fcst_grid_comp.F90 * Delete time_utils.F90. Unused. * print only actual errors to stderr, everything else to stdout * Move realizeConnectedCplFields to module_cplfields from module_cap_cpl * Declare Atmos as module variable, and remove atmos_internalstate_wrapper * Move code from clock_cplIntval to InitializeAdvertise * Removed INTERNAL_FILE_NML from atmos_model.F90 * CCPP cloud cover change for Thompson MP associated with Xu Randall (#443) * Remove old comments from GFS_typedefs.F90. * Update logic that sets Model%cnvcld = .false. * Wrapper for ccpp-physics #806, #807, #813 (#447) * CCPP physics updates from PR #806(only diagnostic changes for RRTMGP - small diag-only RT impact for tests involving RRTMGP),#807 (only aborting model if sfc emis file not present when needed) ,#813(only SCM-specific physics changes) * Wrapper for ccpp-physics #808 and 816 (roughness length over ice and NoahMP tsurf bugfix) (#452) This PR contains the ccpp physics PR #808 and #816. 808 addresses an error in the momentum roughness length over tiles with ice. 816 fixes an occasional segfault bug related to the tsurf variable in NoahMP and updates to "improve snow simulation in NoahMP for P8". * Use 'model set run clock' routine in FV3 NUOPC cap. (#450) * Add 'SetRunClock' specialization routine to FV3 NUOPC cap, which sets fv3 model clock. FV3 cap does not keep local copy of clock (clock_fv3) as saved module variable anymore. * Minor code cleanup. * Clean up iovr=4 (exponential cloud overlapping method) in RRTMG (#445) Clean up the exponential cloud overlapping method in RRTMG, which reflects the practice of the pre-2018 operational HWRF model. * Bug fix for dimensions of eta level variables and WAM variables in Fortran code and CCPP metadata (#431) * Add additional diagnostic arrays for radiation-microphysics development * Bug fixes for WAM model runs with levr < levs * Update inline post with latest UPP release upp_v10.0.11 (#449) * Update UPP revision * Add foundation temperaure in GFS read interface for inline post. * Wrapper for ccpp-physics #812 (#453) * update submodule pointer for regression testing of ccpp-physics#812 * MYNN sfclay (RAP suite) restart reproducibility, P8 suite definition files (#455) * Fix uninitialized variable zmtnblck in ccpp/data/GFS_typedefs.F90 * Fix typo in CCPP standard name for ncnvwind in ccpp/data/GFS_typedefs.meta * Add ten 2d variables required for MYNNSFC restart reproducibility to ccpp/driver/GFS_restart.F90 * create initial p8 suites, P8 initial SDFs as copies of FV3_GFS_v16_coupled_nsstNoahmpUGWPv1 and FV3_GFS_v16_nsstNoahmpUGWPv1 Co-authored-by: Denise Worthen * Fixes on initializing snow depth over ice and changes z0ice (#461) * modify FV3GFS_io.F90 by fixing errors associated with initializing snow depth over ice in the case where both land and water coexist (i.e. fractional grid case) * z0ice is changed to 1.0 cm from 1.1cm in atmos_model.F90 * Radar-derived microphysics temperature tendencies similar to operational HRRR (#457) - implements a feature of the operational HRRR, radar-derived microphysics temperature tendencies applied in the first N minutes of the forecast to improve clouds in the first few hours. * HRRR-like radar-derived temperature tendencies * Give a warning when convection is enabled with radar tten * Fix uninitialized variable zmtnblck in ccpp/data/GFS_typedefs.F90 * Add ten 2d variables required for MYNNSFC restart reproducibility to ccpp/driver/GFS_restart.F90 * fixing snod bug in atmos_model.F90 (#465) * Thompson MP cloud tuning (#463) * Improve cloud fraction when using Thompson MP. See NCAR/ccpp-physics#809 for more details. * Feature/hwrf legacy (#459) * Added a new suite definition file: suite_FV3_HAFS_v0_thompson_tedmf_gfdlsf.xml. This SDF is a legacy hwrf SDF but only the GFDL surface layer scheme and the Thompson scheme are kept. * CCPP: Update consistency checks and effective radii calculation for Thompson MP (#462) * This PR updates the submodule pointer for ccpp-physics for the changes described in NCAR/ccpp-physics#786 (Update consistency checks and effective radii calculation for Thompson MP) * Unified write_netcdf, add single file 'cubed_sphere_grid' output (#466) * Unify write_netcdf and write_netcdf_parallel modules. * Add support for writing 'cubed_sphere_grid' history files in a single netcdf file * Code refactoring and cleanup. * Change standard name and unit of CCPP error flag variable in CCPP framework and physics (#467) *Change standard name and unit of CCPP error flag variable in CCPP framework and physics. * Add code to enable ESMF managed threading (#469) * Implement ESMF-managed-threading for fcstComp and wrtComp's. * Revisions to repair iovr=5 cloud overlap option (#471) *This PR addresses part 2 of CCPP issue #748 to activate the exponential-random cloud overlap method (iovr=5) in RRTMG. * Add 2d decomposition on the write grid comp (#470) * update write grid comp to have 2D decomposition on output grid. * combine PR#468: Bug fix in FV3GFS_io.F90 for allocation of temp2d Co-authored-by: Ted Mansell * 4DIAU bug when iau_filter_increments=T (#458) * Add lsm_cold_start variable for RUC LSM SCM support and gwdps bugfix (combined) (#475) * add lsm_cold_start variable in GFS_typedefs.F90/meta and update ccpp/physics for testing * includes @SMoorthi-emc 's bugfix for gwdps.f. * add lon info in the write group (#476) * Multiple output grids (#480) Update fv3 cap and write grid component to enable outputting multiple domains. This is done be creating an array of fcstGrids, and array of rout handles where each element of these arrays correspond to one atm domain. In the write grid component updates were made to allow grid spec parameters for each output grid to be specified separately. Co-authored-by: Gerhard Theurich * GPU-enabled version of Grell-Freitas convection in ccpp-physics (#479) * Enable Thompson MP when coupling with UFS-Aerosols (#484) * Add support for Stochastically Perturbed Parameterizations (SPP) in FV3 and add the FV3_RRFS_v1alpha SDF. (#454) Adds the necessary code in fv3atm to allow for Stochastically Perturbed Parameterizations (SPP) in a set of RAP/HRRR-based physics parameterizations. Specific to the fv3atm repository, code in this PR defines the necessary variables associated with various SPP-related fields (e.g., logical to activate SPP, parameterization-specific SPP variables, etc.) that are then passed to ccpp-physics. * lateral boundary fix for regional runs (#482) * Updating pointer to ccpp/physics. * Point to Christina's branches. * Point to NOAA-GSL gsl/develop for ccpp/physics Co-authored-by: Samuel Trahan (NOAA contractor) <39415369+SamuelTrahanNOAA@users.noreply.github.com> Co-authored-by: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Co-authored-by: Dom Heinzeller Co-authored-by: Grant Firl Co-authored-by: mzhangw Co-authored-by: WenMeng-NOAA <48260754+WenMeng-NOAA@users.noreply.github.com> Co-authored-by: Denise Worthen Co-authored-by: SMoorthi-emc <47667426+SMoorthi-emc@users.noreply.github.com> Co-authored-by: ChunxiZhang-NOAA <49283036+ChunxiZhang-NOAA@users.noreply.github.com> Co-authored-by: Jun Wang <37633869+junwang-noaa@users.noreply.github.com> Co-authored-by: Ted Mansell Co-authored-by: Jeff Whitaker Co-authored-by: Gerhard Theurich Co-authored-by: DomHeinzeller <58610420+DomHeinzeller@users.noreply.github.com> Co-authored-by: Raffaele Montuoro Co-authored-by: JeffBeck-NOAA <55201531+JeffBeck-NOAA@users.noreply.github.com> Co-authored-by: MatthewPyle-NOAA <48285220+MatthewPyle-NOAA@users.noreply.github.com> Co-authored-by: samuel.trahan --- CMakeLists.txt | 1 - atmos_cubed_sphere | 2 +- atmos_model.F90 | 123 +- ccpp/data/CCPP_typedefs.F90 | 4 +- ccpp/data/GFS_typedefs.F90 | 262 +++- ccpp/data/GFS_typedefs.meta | 182 ++- ccpp/driver/GFS_diagnostics.F90 | 152 ++- ccpp/driver/GFS_restart.F90 | 107 +- ccpp/framework | 2 +- ccpp/physics | 2 +- ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml | 95 ++ ccpp/suites/suite_FV3_GFS_v16_p8.xml | 28 +- ...ite_FV3_HAFS_v0_thompson_tedmf_gfdlsf.xml} | 20 +- ccpp/suites/suite_FV3_RRFS_v1alpha.xml | 84 ++ cpl/module_block_data.F90 | 13 + cpl/module_cap_cpl.F90 | 337 +---- cpl/module_cplfields.F90 | 165 ++- fv3_cap.F90 | 499 +++---- io/FV3GFS_io.F90 | 89 +- io/inline_post.F90 | 30 +- io/module_fv3_io_def.F90 | 26 +- io/module_write_internal_state.F90 | 4 +- io/module_write_netcdf.F90 | 1019 ++++++++++----- io/module_write_netcdf_parallel.F90 | 627 --------- io/module_wrt_grid_comp.F90 | 1154 ++++++++--------- io/post_gfs.F90 | 17 +- io/post_regional.F90 | 87 +- module_fcst_grid_comp.F90 | 983 +++++++------- module_fv3_config.F90 | 10 +- .../stochastic_physics_wrapper.F90 | 61 +- time_utils.F90 | 170 --- upp | 2 +- 32 files changed, 3202 insertions(+), 3155 deletions(-) create mode 100644 ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml rename ccpp/suites/{suite_FV3_HAFS_v0_hwrf_thompson.xml => suite_FV3_HAFS_v0_thompson_tedmf_gfdlsf.xml} (93%) create mode 100644 ccpp/suites/suite_FV3_RRFS_v1alpha.xml delete mode 100644 io/module_write_netcdf_parallel.F90 delete mode 100644 time_utils.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index ec9721ba6..718ba11b4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -43,7 +43,6 @@ add_library(fv3atm cpl/module_cap_cpl.F90 io/FV3GFS_io.F90 io/module_write_netcdf.F90 - io/module_write_netcdf_parallel.F90 io/module_fv3_io_def.F90 io/module_write_internal_state.F90 io/module_wrt_grid_comp.F90 diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index fa86482e4..7ce7aa94b 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit fa86482e48f1d5b594acb369e68b8488de84dc66 +Subproject commit 7ce7aa94b33b5f3cb351867df50a2ad624bb405f diff --git a/atmos_model.F90 b/atmos_model.F90 index 3ac2555e9..291c2bf69 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -74,7 +74,7 @@ module atmos_model_mod use atmosphere_mod, only: atmosphere_scalar_field_halo use atmosphere_mod, only: atmosphere_get_bottom_layer use atmosphere_mod, only: set_atmosphere_pelist -use atmosphere_mod, only: Atm, mygrid +use atmosphere_mod, only: Atm, mygrid, get_nth_domain_info use block_control_mod, only: block_control_type, define_blocks_packed use DYCORE_typedefs, only: DYCORE_data_type, DYCORE_diag_type @@ -113,6 +113,7 @@ module atmos_model_mod public atmos_model_exchange_phase_1, atmos_model_exchange_phase_2 public atmos_model_restart public get_atmos_model_ungridded_dim +public atmos_model_get_nth_domain_info public addLsmask2grid public setup_exportdata !----------------------------------------------------------------------- @@ -125,6 +126,8 @@ module atmos_model_mod integer :: layout(2) ! computer task laytout logical :: regional ! true if domain is regional logical :: nested ! true if there is a nest + integer :: ngrids ! + integer :: mygrid ! integer :: mlon, mlat integer :: iau_offset ! iau running window length logical :: pe ! current pe. @@ -165,7 +168,6 @@ module atmos_model_mod ! DYCORE containers !------------------- type(DYCORE_data_type), allocatable :: DYCORE_Data(:) ! number of blocks -type(DYCORE_diag_type) :: DYCORE_Diag(25) !---------------- ! GFS containers @@ -262,7 +264,7 @@ subroutine update_atmos_radiation_physics (Atmos) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed') if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & - GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca .or. GFS_Control%do_spp) then !--- call stochastic physics pattern generation / cellular automata call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') @@ -380,7 +382,7 @@ subroutine update_atmos_radiation_physics (Atmos) if(GFS_control%print_diff_pgr) then call atmos_timestep_diagnostics(Atmos) endif - + ! Update flag for first time step of time integration GFS_control%first_time_step = .false. @@ -444,7 +446,7 @@ subroutine atmos_timestep_diagnostics(Atmos) enddo pcount = pcount+count enddo - + ! Sum pgr stats from psum/pcount and convert to hPa/hour global avg: sendbuf(1:2) = (/ psum, pcount /) call MPI_Allreduce(sendbuf,recvbuf,2,MPI_DOUBLE_PRECISION,MPI_SUM,GFS_Control%communicator,ierror) @@ -454,7 +456,7 @@ subroutine atmos_timestep_diagnostics(Atmos) sendbuf(1:2) = (/ maxabs, dble(GFS_Control%me) /) call MPI_Allreduce(sendbuf,recvbuf,1,MPI_2DOUBLE_PRECISION,MPI_MAXLOC,GFS_Control%communicator,ierror) call MPI_Bcast(pmaxloc,size(pmaxloc),MPI_DOUBLE_PRECISION,nint(recvbuf(2)),GFS_Control%communicator,ierror) - + if(GFS_Control%me == GFS_Control%master) then 2933 format('At forecast hour ',F9.3,' mean abs pgr change is ',F16.8,' hPa/hr') 2934 format(' max abs change ',F15.10,' bar at tile=',I0,' i=',I0,' j=',I0) @@ -491,23 +493,17 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) type (atmos_data_type), intent(inout) :: Atmos type (time_type), intent(in) :: Time_init, Time, Time_step !--- local variables --- - integer :: unit, ntdiag, ntfamily, i, j, k - integer :: mlon, mlat, nlon, nlat, nlev, sec, dt + integer :: unit, i + integer :: mlon, mlat, nlon, nlat, nlev, sec integer :: ierr, io, logunit - integer :: idx, tile_num + integer :: tile_num integer :: isc, iec, jsc, jec - integer :: isd, ied, jsd, jed - integer :: blk, ibs, ibe, jbs, jbe real(kind=GFS_kind_phys) :: dt_phys - real, allocatable :: q(:,:,:,:), p_half(:,:,:) - character(len=80) :: control - character(len=64) :: filename, filename2, pelist_name - character(len=132) :: text - logical :: p_hydro, hydro, fexist + logical :: p_hydro, hydro logical, save :: block_message = .true. type(GFS_init_type) :: Init_parm integer :: bdat(8), cdat(8) - integer :: ntracers, maxhf, maxh + integer :: ntracers character(len=32), allocatable, target :: tracer_names(:) integer, allocatable, target :: tracer_types(:) integer :: nthrds, nb @@ -533,7 +529,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call atmosphere_resolution (nlon, nlat, global=.false.) call atmosphere_resolution (mlon, mlat, global=.true.) call alloc_atmos_data_type (nlon, nlat, Atmos) - call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional, Atmos%nested, Atmos%pelist) + call atmosphere_domain (Atmos%domain, Atmos%layout, Atmos%regional, Atmos%nested, Atmos%ngrids, Atmos%mygrid, Atmos%pelist) call atmosphere_diag_axes (Atmos%axes) call atmosphere_etalvls (Atmos%ak, Atmos%bk, flip=flip_vc) call atmosphere_grid_bdry (Atmos%lon_bnd, Atmos%lat_bnd, global=.false.) @@ -547,7 +543,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !---------------------------------------------------------------------------------------------- ! initialize atmospheric model - must happen AFTER atmosphere_init so that nests work correctly - IF ( file_exists('input.nml')) THEN + if (file_exists('input.nml')) then read(input_nml_file, nml=atmos_model_nml, iostat=io) ierr = check_nml_error(io, 'atmos_model_nml') endif @@ -635,19 +631,10 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) Init_parm%restart = Atm(mygrid)%flagstruct%warm_start Init_parm%hydrostatic = Atm(mygrid)%flagstruct%hydrostatic -#ifdef INTERNAL_FILE_NML ! allocate required to work around GNU compiler bug 100886 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 allocate(Init_parm%input_nml_file, mold=input_nml_file) Init_parm%input_nml_file => input_nml_file Init_parm%fn_nml='using internal file' -#else - pelist_name=mpp_get_current_pelist_name() - Init_parm%fn_nml='input_'//trim(pelist_name)//'.nml' - inquire(FILE=Init_parm%fn_nml, EXIST=fexist) - if (.not. fexist ) then - Init_parm%fn_nml='input.nml' - endif -#endif call GFS_initialize (GFS_control, GFS_data%Statein, GFS_data%Stateout, GFS_data%Sfcprop, & GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, & @@ -711,7 +698,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP physics_init step failed') if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & - GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca) then + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca .or. GFS_Control%do_spp) then !--- Initialize stochastic physics pattern generation / cellular automata for first time step call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) @@ -964,7 +951,7 @@ subroutine atmos_model_end (Atmos) use update_ca, only: write_ca_restart type (atmos_data_type), intent(inout) :: Atmos !---local variables - integer :: idx, seconds, ierr + integer :: ierr !----------------------------------------------------------------------- !---- termination routine for atmospheric model ---- @@ -977,7 +964,7 @@ subroutine atmos_model_end (Atmos) ! call write_stoch_restart_atm('RESTART/atm_stoch.res.nc') endif if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & - GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca .or. GFS_Control%do_spp) then if(restart_endfcst) then call write_stoch_restart_atm('RESTART/atm_stoch.res.nc') if (GFS_control%do_ca)then @@ -993,6 +980,8 @@ subroutine atmos_model_end (Atmos) call CCPP_step (step="finalize", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP finalize step failed') + call dealloc_atmos_data_type (Atmos) + end subroutine atmos_model_end ! @@ -1541,53 +1530,6 @@ subroutine update_atmos_chemistry(state, rc) end select end subroutine update_atmos_chemistry -! - -!####################################################################### -! -! -! -! Print checksums of the various fields in the atmos_data_type. -! - -! -! Routine to print checksums of the various fields in the atmos_data_type. -! - -! - -! -! Derived-type variable that contains fields in the atmos_data_type. -! -! -! -! Label to differentiate where this routine in being called from. -! -! -! -! An integer to indicate which timestep this routine is being called for. -! -! -subroutine atmos_data_type_chksum(id, timestep, atm) -type(atmos_data_type), intent(in) :: atm - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - integer :: n, outunit - -100 format("CHECKSUM::",A32," = ",Z20) -101 format("CHECKSUM::",A16,a,'%',a," = ",Z20) - - outunit = stdout() - write(outunit,*) 'BEGIN CHECKSUM(Atmos_data_type):: ', id, timestep - write(outunit,100) ' atm%lon_bnd ', mpp_chksum(atm%lon_bnd) - write(outunit,100) ' atm%lat_bnd ', mpp_chksum(atm%lat_bnd) - write(outunit,100) ' atm%lon ', mpp_chksum(atm%lon) - write(outunit,100) ' atm%lat ', mpp_chksum(atm%lat) - -end subroutine atmos_data_type_chksum - ! subroutine alloc_atmos_data_type (nlon, nlat, Atmos) @@ -1623,7 +1565,6 @@ subroutine assign_importdata(jdat, rc) integer :: sphum, liq_wat, ice_wat, o3mr character(len=128) :: impfield_name, fldname type(ESMF_TypeKind_Flag) :: datatype - real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer:: datar83d real(kind=GFS_kind_phys), dimension(:,:), pointer :: datar8 @@ -1634,7 +1575,7 @@ subroutine assign_importdata(jdat, rc) type(ESMF_Grid) :: grid type(ESMF_Field) :: dbgField character(19) :: currtimestring - real (kind=GFS_kind_phys), parameter :: z0ice=1.1 ! (in cm) + real (kind=GFS_kind_phys), parameter :: z0ice=1.0 ! (in cm) ! ! real(kind=GFS_kind_phys), parameter :: himax = 8.0 !< maximum ice thickness allowed @@ -1690,10 +1631,6 @@ subroutine assign_importdata(jdat, rc) if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplIMP,atmos gets ',trim(impfield_name),' datar8=', & datar8(isc,jsc), maxval(datar8), minval(datar8) found = .true. -! gfs physics runs with r8 -! else -! call ESMF_FieldGet(importFields(n),farrayPtr=datar42d,localDE=0, rc=rc) -! datar8 = datar42d endif else if( dimCount == 3) then @@ -2489,7 +2426,7 @@ subroutine assign_importdata(jdat, rc) if (GFS_data(nb)%Sfcprop%fice(ix) >= GFS_control%min_seaice) then GFS_data(nb)%Coupling%hsnoin_cpl(ix) = min(hsmax, GFS_data(nb)%Coupling%hsnoin_cpl(ix) & - / (GFS_data(nb)%Sfcprop%fice(ix)*GFS_data(nb)%Sfcprop%oceanfrac(ix))) + / GFS_data(nb)%Sfcprop%fice(ix)) GFS_data(nb)%Sfcprop%zorli(ix) = z0ice tem = GFS_data(nb)%Sfcprop%tisfc(ix) * GFS_data(nb)%Sfcprop%tisfc(ix) tem = con_sbc * tem * tem @@ -2546,7 +2483,6 @@ subroutine assign_importdata(jdat, rc) rc=0 ! - if (mpp_pe() == mpp_root_pe()) print *,'end of assign_importdata' end subroutine assign_importdata ! @@ -2560,9 +2496,9 @@ subroutine setup_exportdata(rc) integer, optional, intent(out) :: rc !--- local variables - integer :: i, j, k, idx, ix + integer :: i, j, ix integer :: isc, iec, jsc, jec - integer :: ib, jb, nb, nsb, nk + integer :: nb, nk integer :: sphum, liq_wat, ice_wat, o3mr real(GFS_kind_phys) :: rtime, rtimek @@ -2586,7 +2522,6 @@ subroutine setup_exportdata(rc) jsc = Atm_block%jsc jec = Atm_block%jec nk = Atm_block%npz - nsb = Atm_block%blkno(isc,jsc) rtime = one / GFS_control%dtp rtimek = GFS_control%rho_h2o * rtime @@ -2895,7 +2830,6 @@ subroutine addLsmask2grid(fcstGrid, rc) integer isc, iec, jsc, jec integer i, j, nb, ix ! integer CLbnd(2), CUbnd(2), CCount(2), TLbnd(2), TUbnd(2), TCount(2) - type(ESMF_StaggerLoc) :: staggerloc integer, allocatable :: lsmask(:,:) integer(kind=ESMF_KIND_I4), pointer :: maskPtr(:,:) ! @@ -2947,5 +2881,14 @@ subroutine addLsmask2grid(fcstGrid, rc) end subroutine addLsmask2grid !------------------------------------------------------------------------------ + subroutine atmos_model_get_nth_domain_info(n, layout, nx, ny, pelist) + integer, intent(in) :: n + integer, intent(out) :: layout(2) + integer, intent(out) :: nx, ny + integer, pointer, intent(out) :: pelist(:) + + call get_nth_domain_info(n, layout, nx, ny, pelist) + + end subroutine atmos_model_get_nth_domain_info end module atmos_model_mod diff --git a/ccpp/data/CCPP_typedefs.F90 b/ccpp/data/CCPP_typedefs.F90 index 01695bc4a..1e2171838 100644 --- a/ccpp/data/CCPP_typedefs.F90 +++ b/ccpp/data/CCPP_typedefs.F90 @@ -141,8 +141,8 @@ subroutine interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd, jed ! For multi-gases physics integer, intent(in) :: nwat integer, intent(in), optional :: ngas - real(kind_dyn), intent(in), optional :: rilist(:) - real(kind_dyn), intent(in), optional :: cpilist(:) + real(kind_dyn), intent(in), optional :: rilist(0:) + real(kind_dyn), intent(in), optional :: cpilist(0:) integer, intent(in) :: mpirank integer, intent(in) :: mpiroot ! diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 5190b7bc0..1dd3a1cc3 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -48,6 +48,10 @@ module GFS_typedefs integer, parameter :: naux2dmax = 20 !< maximum number of auxiliary 2d arrays in output (for debugging) integer, parameter :: naux3dmax = 20 !< maximum number of auxiliary 3d arrays in output (for debugging) + integer, parameter :: dfi_radar_max_intervals = 4 !< Number of radar-derived temperature tendency and/or convection suppression intervals. Do not change. + + real(kind=kind_phys), parameter :: limit_unspecified = 1e12 !< special constant for "namelist value was not provided" in radar-derived temperature tendency limit range + !> \section arg_table_GFS_typedefs !! \htmlinclude GFS_typedefs.html !! @@ -537,6 +541,11 @@ module GFS_typedefs real (kind=kind_phys), pointer :: skebu_wts (:,:) => null() ! real (kind=kind_phys), pointer :: skebv_wts (:,:) => null() ! real (kind=kind_phys), pointer :: sfc_wts (:,:) => null() ! mg, sfc-perts + real (kind=kind_phys), pointer :: spp_wts_pbl (:,:) => null() ! spp-pbl-perts + real (kind=kind_phys), pointer :: spp_wts_sfc (:,:) => null() ! spp-sfc-perts + real (kind=kind_phys), pointer :: spp_wts_mp (:,:) => null() ! spp-mp-perts + real (kind=kind_phys), pointer :: spp_wts_gwd (:,:) => null() ! spp-gwd-perts + real (kind=kind_phys), pointer :: spp_wts_rad (:,:) => null() ! spp-rad-perts !--- aerosol surface emissions for Thompson microphysics real (kind=kind_phys), pointer :: nwfa2d (:) => null() !< instantaneous water-friendly sfc aerosol source @@ -802,6 +811,15 @@ module GFS_typedefs real(kind=kind_phys) :: tcr real(kind=kind_phys) :: tcrf ! + integer :: num_dfi_radar !< number of timespans with radar-prescribed temperature tendencies + real (kind=kind_phys) :: fh_dfi_radar(1+dfi_radar_max_intervals) !< begin+end of timespans to receive radar-prescribed temperature tendencies + logical :: do_cap_suppress !< enable convection suppression in GF scheme if fh_dfi_radar is specified + real (kind=kind_phys) :: radar_tten_limits(2) !< radar_tten values outside this range (min,max) are discarded + integer :: ix_dfi_radar(dfi_radar_max_intervals) = -1 !< Index within dfi_radar_tten of each timespan (-1 means "none") + integer :: dfi_radar_max_intervals + integer :: dfi_radar_max_intervals_plus_one + + ! logical :: effr_in !< eg to turn on ffective radii for MG logical :: microp_uniform logical :: do_cldliq @@ -1160,6 +1178,16 @@ module GFS_typedefs ! multiple patterns. It wasn't fully coded (and wouldn't have worked ! with nlndp>1, so I just dropped it). If we want to code it properly, ! we'd need to make this dim(6,5). + logical :: do_spp ! Overall flag to turn on SPP or not + integer :: spp_pbl + integer :: spp_sfc + integer :: spp_mp + integer :: spp_rad + integer :: spp_gwd + integer :: n_var_spp + character(len=3) , pointer :: spp_var_list(:) ! dimension here must match n_var_spp in stochy_nml_def + real(kind=kind_phys), pointer :: spp_prt_list(:) ! dimension here must match n_var_spp in stochy_nml_def + !--- tracer handling character(len=32), pointer :: tracer_names(:) !< array of initialized tracers from dynamic core integer :: ntrac !< number of tracers @@ -1196,6 +1224,7 @@ module GFS_typedefs integer :: index_of_process_conv_trans !< tracer changes caused by convective transport integer :: index_of_process_physics !< tracer changes caused by physics schemes integer :: index_of_process_non_physics !< tracer changes caused by everything except physics schemes + integer :: index_of_process_dfi_radar !< tracer changes caused by radar mp temperature tendency forcing integer :: index_of_process_photochem !< all changes to ozone logical, pointer :: is_photochem(:) => null()!< flags for which processes should be summed as photochemical @@ -1278,6 +1307,7 @@ module GFS_typedefs integer :: kdt !< current forecast iteration logical :: first_time_step !< flag signaling first time step for time integration routine logical :: restart !< flag whether this is a coldstart (.false.) or a warmstart/restart (.true.) + logical :: lsm_cold_start logical :: hydrostatic !< flag whether this is a hydrostatic or non-hydrostatic run integer :: jdat(1:8) !< current forecast date and time !< (yr, mon, day, t-zone, hr, min, sec, mil-sec) @@ -1454,6 +1484,10 @@ module GFS_typedefs real (kind=kind_phys), pointer :: phy_myj_a1t(:) => null() ! real (kind=kind_phys), pointer :: phy_myj_a1q(:) => null() ! + !--- DFI Radar + real (kind=kind_phys), pointer :: dfi_radar_tten(:,:,:) => null() ! + real (kind=kind_phys), pointer :: cap_suppress(:,:) => null() ! + contains procedure :: create => tbd_create !< allocate array data end type GFS_tbd_type @@ -1655,8 +1689,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: tdomzr (:) => null() !< dominant accumulated freezing rain type real (kind=kind_phys), pointer :: tdomip (:) => null() !< dominant accumulated sleet type real (kind=kind_phys), pointer :: tdoms (:) => null() !< dominant accumulated snow type - - real (kind=kind_phys), pointer :: zmtnblck(:) => null() ! null() ! levs) then + write(0,*) "Logic error, number of radiation levels (levr) cannot exceed number of model levels (levs)" + stop else Model%levr = levr endif @@ -4408,12 +4481,23 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%lndp_type = lndp_type Model%n_var_lndp = n_var_lndp Model%lndp_each_step = lndp_each_step + Model%do_spp = do_spp + Model%n_var_spp = n_var_spp + if (Model%lndp_type/=0) then allocate(Model%lndp_var_list(Model%n_var_lndp)) allocate(Model%lndp_prt_list(Model%n_var_lndp)) Model%lndp_var_list(:) = '' Model%lndp_prt_list(:) = clear_val end if + + if (Model%do_spp) then + allocate(Model%spp_var_list(Model%n_var_spp)) + allocate(Model%spp_prt_list(Model%n_var_spp)) + Model%spp_var_list(:) = '' + Model%spp_prt_list(:) = clear_val + end if + !--- cellular automata options ! force namelist constsitency allocate(Model%vfact_ca(levs)) @@ -4512,17 +4596,18 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%index_of_process_rayleigh_damping = 12 Model%index_of_process_nonorographic_gwd = 13 Model%index_of_process_conv_trans = 14 + Model%index_of_process_dfi_radar = 15 ! Number of processes to sum (last index of prior set) - Model%nprocess_summed = 14 + Model%nprocess_summed = Model%index_of_process_dfi_radar ! Sums of other processes, which must be after nprocess_summed: - Model%index_of_process_physics = 15 - Model%index_of_process_non_physics = 16 - Model%index_of_process_photochem = 17 + Model%index_of_process_physics = Model%nprocess_summed+1 + Model%index_of_process_non_physics = Model%nprocess_summed+2 + Model%index_of_process_photochem = Model%nprocess_summed+3 ! Total number of processes (last index of prior set) - Model%nprocess = 17 + Model%nprocess = Model%index_of_process_photochem ! List which processes should be summed as photochemical: allocate(Model%is_photochem(Model%nprocess)) @@ -4637,6 +4722,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & call label_dtend_cause(Model,Model%index_of_process_ozmix,'o3mix','tendency due to ozone mixing ratio') call label_dtend_cause(Model,Model%index_of_process_temp,'temp','tendency due to temperature') call label_dtend_cause(Model,Model%index_of_process_overhead_ozone,'o3column','tendency due to overhead ozone column') + call label_dtend_cause(Model,Model%index_of_process_dfi_radar,'dfi_radar','tendency due to dfi radar mp temperature forcing') call label_dtend_cause(Model,Model%index_of_process_photochem,'photochem','tendency due to photochemical processes') call label_dtend_cause(Model,Model%index_of_process_physics,'phys','tendency due to physics') call label_dtend_cause(Model,Model%index_of_process_non_physics,'nophys','tendency due to non-physics processes', & @@ -4654,6 +4740,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & call fill_dtidx(Model,dtend_select,Model%index_of_temperature,Model%index_of_process_dcnv,have_dcnv) call fill_dtidx(Model,dtend_select,Model%index_of_temperature,Model%index_of_process_scnv,have_scnv) call fill_dtidx(Model,dtend_select,Model%index_of_temperature,Model%index_of_process_mp,have_mp) + call fill_dtidx(Model,dtend_select,Model%index_of_temperature,Model%index_of_process_dfi_radar,have_mp .and. Model%num_dfi_radar>0) call fill_dtidx(Model,dtend_select,Model%index_of_temperature,Model%index_of_process_orographic_gwd) call fill_dtidx(Model,dtend_select,Model%index_of_temperature,Model%index_of_process_rayleigh_damping,have_rdamp) call fill_dtidx(Model,dtend_select,Model%index_of_temperature,Model%index_of_process_nonorographic_gwd) @@ -4787,14 +4874,15 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%kdt = nint(Model%fhour*con_hr/Model%dtp) Model%first_time_step = .true. Model%restart = restart + Model%lsm_cold_start = .not. restart Model%hydrostatic = hydrostatic Model%jdat(1:8) = jdat(1:8) - allocate(Model%si(Model%levr+1)) + allocate(Model%si(Model%levs+1)) !--- Define sigma level for radiation initialization !--- The formula converting hybrid sigma pressure coefficients to sigma coefficients follows Eckermann (2009, MWR) !--- ps is replaced with p0. The value of p0 uses that in http://www.emc.ncep.noaa.gov/officenotes/newernotes/on461.pdf !--- ak/bk have been flipped from their original FV3 orientation and are defined sfc -> toa - Model%si = (ak + bk * con_p0 - ak(Model%levr+1)) / (con_p0 - ak(Model%levr+1)) + Model%si(1:Model%levs+1) = (ak(1:Model%levs+1) + bk(1:Model%levs+1) * con_p0 - ak(Model%levs+1)) / (con_p0 - ak(Model%levs+1)) Model%sec = 0 Model%yearlen = 365 Model%julian = -9999. @@ -5069,7 +5157,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%num_p3d = 4 Model%num_p2d = 3 Model%shcnvcw = .false. -! Model%ncnd = 1 ! ncnd is the number of cloud condensate types Model%nT2delt = 1 Model%nqv2delt = 2 Model%nTdelt = 3 @@ -5086,7 +5173,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%npdf3d = 3 Model%num_p3d = 4 Model%num_p2d = 3 -! Model%ncnd = 1 if (Model%me == Model%master) print *,'Using Zhao/Carr/Sundqvist Microphysics with PDF Cloud' else if (Model%imp_physics == Model%imp_physics_fer_hires) then ! Ferrier-Aligo scheme @@ -5095,8 +5181,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%num_p2d = 1 Model%pdfcld = .false. Model%shcnvcw = .false. - ! DH* REALLY ? -! Model%ncnd = 3 !???????? need to clarify this - Moorthi Model%nleffr = 1 Model%nieffr = 2 Model%nseffr = 3 @@ -5116,7 +5200,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !Model%num_p2d = 1 !Model%pdfcld = .false. !Model%shcnvcw = .false. -! !Model%ncnd = 5 !Model%nleffr = 1 !Model%nieffr = 2 !Model%nseffr = 3 @@ -5128,7 +5211,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%num_p2d = 1 Model%pdfcld = .false. Model%shcnvcw = .false. -! Model%ncnd = 5 Model%nleffr = 1 Model%nieffr = 2 Model%nseffr = 3 @@ -5159,7 +5241,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%num_p2d = 1 Model%pdfcld = .false. Model%shcnvcw = .false. -! Model%ncnd = 2 Model%nleffr = 2 Model%nieffr = 3 Model%nreffr = 4 @@ -5172,16 +5253,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' Morrison-Gettelman MP requires nwat to be set to 6 - job aborted' stop end if -! if (abs(Model%fprcp) == 1) then -! Model%ncnd = 4 -! elseif (Model%fprcp >= 2) then -! Model%ncnd = 4 -! if (Model%mg_do_graupel .or. Model%mg_do_hail) then -! Model%ncnd = 5 -! endif -! Model%num_p3d = 6 -! Model%ngeffr = 6 -! endif if (Model%me == Model%master) & print *,' Using Morrison-Gettelman double moment microphysics', & ' iaerclm=', Model%iaerclm, ' iccn=', Model%iccn, & @@ -5218,7 +5289,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%num_p2d = 1 Model%pdfcld = .false. Model%shcnvcw = .false. -! Model%ncnd = 5 if (nwat /= 6) then print *,' GFDL MP requires nwat to be set to 6 - job aborted' stop @@ -5232,7 +5302,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & endif if(Model%ras .or. Model%cscnv) Model%cnvcld = .false. - if(Model%do_shoc .or. Model%pdfcld .or. Model%do_mynnedmf) Model%cnvcld = .false. + if(Model%do_shoc .or. Model%pdfcld .or. Model%do_mynnedmf .or. Model%imfdeepcnv == Model%imfdeepcnv_gf) Model%cnvcld = .false. if(Model%cnvcld) Model%ncnvcld3d = 1 !--- get cnvwind index in phy_f2d; last entry in phy_f2d array @@ -5274,7 +5344,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & endif if (me == Model%master) & - write(0,*) ' num_p3d=', Model%num_p3d, ' num_p2d=', Model%num_p2d, & + write(*,*) ' num_p3d=', Model%num_p3d, ' num_p2d=', Model%num_p2d, & ' crtrh=', Model%crtrh, ' npdf3d=', Model%npdf3d, & ' pdfcld=', Model%pdfcld, ' shcnvcw=', Model%shcnvcw, & ' cnvcld=', Model%cnvcld, ' ncnvcld3d=',Model%ncnvcld3d, & @@ -5318,6 +5388,68 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & end subroutine control_initialize + subroutine control_initialize_radar_tten(Model, radar_tten_limits) + implicit none + + ! Helper subroutine for initializing variables for radar-derived + ! temperature tendency or convection suppression. + + class(GFS_control_type) :: Model + real(kind_phys) :: radar_tten_limits(2) + integer :: i + + Model%num_dfi_radar = 0 + do i=1,dfi_radar_max_intervals + if(Model%fh_dfi_radar(i)>-1e10 .and. Model%fh_dfi_radar(i+1)>-1e10) then + Model%num_dfi_radar = Model%num_dfi_radar+1 + Model%ix_dfi_radar(i) = Model%num_dfi_radar + else + Model%ix_dfi_radar(i) = -1 + endif + enddo + + if(Model%num_dfi_radar>0) then + if(radar_tten_limits(1)==limit_unspecified) then + if(radar_tten_limits(2)==limit_unspecified) then + radar_tten_limits(1) = -19 + radar_tten_limits(2) = 19 + if(Model%me==Model%master) then + write(0,*) 'Warning: using internal defaults for radar_tten_limits. If the oceans boil, try different values.' + write(0,'(A,F12.4,A)') 'radar_tten_limits(1) = ',radar_tten_limits(1),' <-- lower limit' + write(0,'(A,F12.4,A)') 'radar_tten_limits(2) = ',radar_tten_limits(2),' <-- upper limit' + endif + else + radar_tten_limits(1) = -abs(radar_tten_limits(2)) + radar_tten_limits(2) = abs(radar_tten_limits(2)) + endif + else if(radar_tten_limits(2)==limit_unspecified) then + radar_tten_limits(1) = -abs(radar_tten_limits(1)) + radar_tten_limits(2) = abs(radar_tten_limits(1)) + else if(radar_tten_limits(1)>radar_tten_limits(2)) then + if(Model%me==Model%master) then + write(0,*) 'Error: radar_tten_limits lower limit is higher than upper!' + write(0,'(A,F12.4,A)') 'radar_tten_limits(1) = ',radar_tten_limits(1),' <-- lower limit' + write(0,'(A,F12.4,A)') 'radar_tten_limits(2) = ',radar_tten_limits(2),' <-- upper limit' + write(0,*) "If you do not want me to apply the prescribed tendencies, just say so! Remove fh_dfi_radar from your namelist." + stop + endif + else + !o! Rejoice !o! Radar_tten_limits had lower and upper bounds. + endif + Model%radar_tten_limits = radar_tten_limits + + if(Model%do_cap_suppress) then + if(Model%me==Model%master .and. Model%imfdeepcnv>=0) then + if(Model%imfdeepcnv/=3) then + write(0,*) 'Warning: untested configuration in use! Radar-derived convection suppression is only supported for the GF deep scheme. That feature will be inactive, but microphysics tendencies will still be enabled. This combination is untested. Beware!' + else + write(0,*) 'Warning: experimental configuration in use! Radar-derived convection suppression is experimental (GF deep scheme with fh_dfi_radar).' + endif + endif + endif + endif + + end subroutine control_initialize_radar_tten !--------------------------- ! GFS_control%init_chemistry @@ -5426,6 +5558,9 @@ subroutine control_print(Model) !--- interface variables class(GFS_control_type) :: Model +!--- local variables + integer :: i + if (Model%me == Model%master) then print *, ' ' print *, 'basic control parameters' @@ -5593,6 +5728,18 @@ subroutine control_print(Model) print *, ' icloud : ', Model%icloud print *, ' ' endif + if (Model%num_dfi_radar>0) then + print *, ' num_dfi_radar : ', Model%num_dfi_radar + print *, ' do_cap_suppress : ', Model%do_cap_suppress + do i = 1, dfi_radar_max_intervals+1 +8888 format(' fh_dfi_radar(',I0,') :',F12.4) + if(Model%fh_dfi_radar(i)>-1e10) then + print 8888,i,Model%fh_dfi_radar(i) + endif + enddo +9999 format(' radar_tten_limits: ', F12.4, ' ... ',F12.4) + print 9999,Model%radar_tten_limits(1),Model%radar_tten_limits(2) + endif print *, 'land/surface model parameters' print *, ' lsm : ', Model%lsm print *, ' lsoil : ', Model%lsoil @@ -5780,6 +5927,8 @@ subroutine control_print(Model) print *, ' lndp_type : ', Model%lndp_type print *, ' n_var_lndp : ', Model%n_var_lndp print *, ' lndp_each_step : ', Model%lndp_each_step + print *, ' do_spp : ', Model%do_spp + print *, ' n_var_spp : ', Model%n_var_spp print *, ' ' print *, 'cellular automata' print *, ' nca : ', Model%nca @@ -5872,6 +6021,7 @@ subroutine control_print(Model) print *, ' sec : ', Model%sec print *, ' first_time_step : ', Model%first_time_step print *, ' restart : ', Model%restart + print *, ' lsm_cold_start : ', Model%lsm_cold_start print *, ' hydrostatic : ', Model%hydrostatic endif @@ -5972,6 +6122,19 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%icsdlw = zero endif +!--- DFI radar forcing + nullify(Tbd%dfi_radar_tten) + nullify(Tbd%cap_suppress) + if(Model%num_dfi_radar>0) then + allocate(Tbd%dfi_radar_tten(IM,Model%levs,Model%num_dfi_radar)) + Tbd%dfi_radar_tten = -20.0 + Tbd%dfi_radar_tten(:,1,:) = zero + if(Model%do_cap_suppress) then + allocate(Tbd%cap_suppress(IM,Model%num_dfi_radar)) + Tbd%cap_suppress(:,:) = zero + endif + endif + !--- ozone and stratosphere h2o needs allocate (Tbd%ozpl (IM,levozp,oz_coeff)) allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) @@ -6819,6 +6982,7 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%tdomzr = zero Diag%tdomip = zero Diag%tdoms = zero + Diag%zmtnblck = zero if(Model%lsm == Model%lsm_noahmp)then Diag%paha = zero @@ -7499,9 +7663,7 @@ subroutine interstitial_setup_tracers(Interstitial, Model) endif if (Model%cplchm) then - ! Only Zhao/Carr/Sundqvist and GFDL microphysics schemes are supported - ! when coupling with chemistry. PBL diffusion of aerosols is only supported - ! for GFDL microphysics and MG microphysics. + ! Only the following microphysics schemes are supported with coupled chemistry if (Model%imp_physics == Model%imp_physics_zhao_carr) then Interstitial%nvdiff = 3 elseif (Model%imp_physics == Model%imp_physics_mg) then @@ -7512,8 +7674,14 @@ subroutine interstitial_setup_tracers(Interstitial, Model) endif elseif (Model%imp_physics == Model%imp_physics_gfdl) then Interstitial%nvdiff = 7 + elseif (Model%imp_physics == Model%imp_physics_thompson) then + if (Model%ltaerosol) then + Interstitial%nvdiff = 12 + else + Interstitial%nvdiff = 9 + endif else - write(0,*) "Only Zhao/Carr/Sundqvist and GFDL microphysics schemes are supported when coupling with chemistry" + write(0,*) "Selected microphysics scheme is not supported when coupling with chemistry" stop endif if (Interstitial%trans_aero) Interstitial%nvdiff = Interstitial%nvdiff + Model%ntchm diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index a45b55866..3c3b31c0c 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2244,10 +2244,50 @@ type = real kind = kind_phys active = (flag_for_stochastic_skeb_option) +[spp_wts_pbl] + standard_name = spp_weights_for_pbl_scheme + long_name = spp weights for pbl scheme + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_stochastically_perturbed_parameterizations) +[spp_wts_sfc] + standard_name = spp_weights_for_surface_layer_scheme + long_name = spp weights for surface layer scheme + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_stochastically_perturbed_parameterizations) +[spp_wts_mp] + standard_name = spp_weights_for_microphysics_scheme + long_name = spp weights for microphysics scheme + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_stochastically_perturbed_parameterizations) +[spp_wts_gwd] + standard_name = spp_weights_for_gravity_wave_drag_scheme + long_name = spp weights for gravity wave drag scheme + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_stochastically_perturbed_parameterizations) +[spp_wts_rad] + standard_name = spp_weights_for_radiation_scheme + long_name = spp weights for radiation scheme + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_stochastically_perturbed_parameterizations) [sfc_wts] standard_name = surface_stochastic_weights_from_coupled_process long_name = weights for stochastic surface physics perturbation - units = none + units = 1 dimensions = (horizontal_loop_extent,number_of_perturbed_land_surface_variables) type = real kind = kind_phys @@ -2519,13 +2559,13 @@ standard_name = sigma_pressure_hybrid_coordinate_a_coefficient long_name = a parameter for sigma pressure level calculations units = Pa - dimensions = (vertical_interface_dimension_for_radiation) + dimensions = (vertical_interface_dimension) type = real [bk] standard_name = sigma_pressure_hybrid_coordinate_b_coefficient long_name = b parameter for sigma pressure level calculations units = none - dimensions = (vertical_interface_dimension_for_radiation) + dimensions = (vertical_interface_dimension) type = real [levsp1] standard_name = vertical_interface_dimension @@ -3381,6 +3421,24 @@ dimensions = () type = real kind = kind_phys +[num_dfi_radar] + standard_name = number_of_radar_derived_temperature_or_convection_suppression_intervals + long_name = number of time ranges with radar-derived microphysics temperature tendencies or radar-derived convection suppression + units = count + dimensions = () + type = integer +[dfi_radar_max_intervals] + standard_name = maximum_number_of_radar_derived_temperature_or_convection_suppression_intervals + long_name = maximum allowed number of time ranges with radar-derived microphysics temperature tendencies or radar-derived convection suppression + units = count + dimensions = () + type = integer +[dfi_radar_max_intervals_plus_one] + standard_name = maximum_number_of_radar_derived_temperature_or_convection_suppression_intervals_plus_one + long_name = one more than the maximum allowed number of time ranges with radar-derived microphysics temperature tendencies or radar-derived convection suppression + units = count + dimensions = () + type = integer [effr_in] standard_name = flag_for_cloud_effective_radii long_name = flag for cloud effective radii calculations in GFDL microphysics @@ -3459,6 +3517,32 @@ units = flag dimensions = () type = logical +[radar_tten_limits] + standard_name = allowed_bounds_of_radar_prescribed_tendencies + long_name = allowed bounds of prescribed microphysics temperature tendencies + units = K s-1 + dimensions = (2) + type = real + kind = kind_phys +[do_cap_suppress] + standard_name = flag_for_radar_derived_convection_suppression + long_name = flag for radar-derived convection suppression + units = flag + dimensions = () + type = logical +[fh_dfi_radar] + standard_name = forecast_lead_times_bounding_radar_derived_temperature_or_convection_suppression_intervals + long_name = forecast lead times bounding radar derived temperature or convection suppression intervals + units = h + dimensions = (maximum_number_of_radar_derived_temperature_or_convection_suppression_intervals_plus_one) + type = real + kind = kind_phys +[ix_dfi_radar] + standard_name = indices_with_radar_derived_temperature_or_convection_suppression_data + long_name = indices with radar derived temperature or convection suppression data + units = index + dimensions = (maximum_number_of_radar_derived_temperature_or_convection_suppression_intervals) + type = integer [shoc_parm(1)] standard_name = pressure_threshold_for_increased_tke_dissipation long_name = pressure below which extra TKE diss. is applied in SHOC @@ -4566,6 +4650,12 @@ units = flag dimensions = () type = logical +[do_spp] + standard_name = do_stochastically_perturbed_parameterizations + long_name = flag for stochastic spp option + units = flag + dimensions = () + type = logical [lndp_type] standard_name = control_for_stochastic_land_surface_perturbation long_name = index for stochastic land surface perturbations type @@ -4594,6 +4684,56 @@ type = character kind = len=3 active = (control_for_stochastic_land_surface_perturbation /= 0) +[n_var_spp] + standard_name = number_of_perturbed_spp_schemes + long_name = number of perturbed spp schemes + units = count + dimensions = () + type = integer +[spp_prt_list] + standard_name =magnitude_of_spp_perturbations + long_name = magnitude of spp perturbations + units = 1 + dimensions = (number_of_spp_schemes_perturbed) + type = real + kind = kind_phys +[spp_var_list] + standard_name = perturbed_spp_schemes + long_name = perturbed spp schemes + units = none + dimensions = (number_of_spp_schemes_perturbed) + type = character + kind = len=3 +[spp_pbl] + standard_name = control_for_pbl_spp_perturbations + long_name = control for pbl spp perturbations + units = count + dimensions = () + type = integer +[spp_sfc] + standard_name = control_for_surface_layer_spp_perturbations + long_name = control for surface layer spp perturbations + units = count + dimensions = () + type = integer +[spp_mp] + standard_name = control_for_microphysics_spp_perturbations + long_name = control for microphysics spp perturbations + units = count + dimensions = () + type = integer +[spp_rad] + standard_name = control_for_radiation_spp_perturbations + long_name = control for radiation spp perturbations + units = count + dimensions = () + type = integer +[spp_gwd] + standard_name = control_for_gravity_wave_drag_spp_perturbations + long_name = control for gravity wave drag spp perturbations + units = count + dimensions = () + type = integer [ntrac] standard_name = number_of_tracers long_name = number of tracers @@ -4720,6 +4860,12 @@ units = index dimensions = () type = integer +[index_of_process_dfi_radar] + standard_name = index_of_radar_derived_microphysics_temperature_forcing_in_cumulative_change_index + long_name = index of radar-derived microphysics temperature forcing in second dimension of array cumulative change index + units = index + dimensions = () + type = integer [index_of_process_physics] standard_name = index_of_all_physics_process_in_cumulative_change_index long_name = index of all physics transport process in second dimension of array cumulative change index @@ -5058,7 +5204,7 @@ dimensions = () type = integer [ncnvwind] - standard_name = index_of_enhancement_to_wind_speed_at_surface_adjacent_layer_due_to_convectionin_in_xy_dimensioned_restart_array + standard_name = index_of_enhancement_to_wind_speed_at_surface_adjacent_layer_due_to_convection_in_xy_dimensioned_restart_array long_name = the index of surface wind enhancement due to convection in phy f2d units = dimensions = () @@ -5180,6 +5326,12 @@ units = flag dimensions = () type = logical +[lsm_cold_start] + standard_name = do_lsm_cold_start + long_name = flag to signify LSM is cold-started + units = flag + dimensions = () + type = logical [hydrostatic] standard_name = flag_for_hydrostatic_solver long_name = flag for hydrostatic solver from dynamics @@ -5228,7 +5380,7 @@ standard_name = sigma_pressure_hybrid_vertical_coordinate long_name = vertical sigma coordinate for radiation initialization units = none - dimensions = (vertical_interface_dimension_for_radiation) + dimensions = (vertical_interface_dimension) type = real kind = kind_phys [dxinv] @@ -5902,14 +6054,14 @@ type = real kind = kind_phys active = (index_of_surface_air_pressure_on_previous_timestep_in_xyz_dimensioned_restart_array > 0) -[phy_f2d(:,index_of_enhancement_to_wind_speed_at_surface_adjacent_layer_due_to_convectionin_in_xy_dimensioned_restart_array)] +[phy_f2d(:,index_of_enhancement_to_wind_speed_at_surface_adjacent_layer_due_to_convection_in_xy_dimensioned_restart_array)] standard_name = enhancement_to_wind_speed_at_surface_adjacent_layer_due_to_convection long_name = surface wind enhancement due to convection units = m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (index_of_enhancement_to_wind_speed_at_surface_adjacent_layer_due_to_convectionin_in_xy_dimensioned_restart_array > 0) + active = (index_of_enhancement_to_wind_speed_at_surface_adjacent_layer_due_to_convection_in_xy_dimensioned_restart_array > 0) [phy_f3d(:,:,index_of_air_temperature_two_timesteps_back_in_xyz_dimensioned_restart_array)] standard_name = air_temperature_two_timesteps_back long_name = air temperature two timesteps back @@ -6244,6 +6396,22 @@ type = real kind = kind_phys active = (flag_for_mellor_yamada_janjic_surface_layer_scheme .or. flag_for_mellor_yamada_janjic_pbl_scheme) +[dfi_radar_tten] + standard_name = radar_derived_microphysics_temperature_tendency + long_name = radar-derived microphysics temperature tendency + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_radar_derived_temperature_or_convection_suppression_intervals) + type = real + kind = kind_phys + active = (number_of_radar_derived_temperature_or_convection_suppression_intervals>0) +[cap_suppress] + standard_name = radar_derived_convection_suppression + long_name = radar-derived convection suppression + units = unitless + dimensions = (horizontal_loop_extent,number_of_radar_derived_temperature_or_convection_suppression_intervals) + type = real + kind = kind_phys + active = (number_of_radar_derived_temperature_or_convection_suppression_intervals>0 .and. flag_for_radar_derived_convection_suppression) ######################################################################## [ccpp-table-properties] diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 8d9e67cdb..6e4b62337 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -138,7 +138,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 + integer :: idt, idx, num, nb, nblks, 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 @@ -2296,6 +2296,71 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo endif + if (Model%do_spp) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'spp_wts_pbl' + 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(nb)%spp_wts_pbl(:,:) + enddo + endif + + if (Model%do_spp) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'spp_wts_sfc' + 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(nb)%spp_wts_sfc(:,:) + enddo + endif + + if (Model%do_spp) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'spp_wts_mp' + 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(nb)%spp_wts_mp(:,:) + enddo + endif + + if (Model%do_spp) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'spp_wts_gwd' + 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(nb)%spp_wts_gwd(:,:) + enddo + endif + + if (Model%do_spp) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'spp_wts_rad' + 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(nb)%spp_wts_rad(:,:) + enddo + endif + if (Model%lndp_type /= 0) then idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3476,39 +3541,58 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo end if thompson_extended_diagnostics - !! Cloud effective radii from Microphysics - !if (Model%imp_physics == Model%imp_physics_thompson .or. Model%imp_physics == Model%imp_physics_wsm6 .or. Model%imp_physics == Model%imp_physics_fer_hires) then - ! idx = idx + 1 - ! ExtDiag(idx)%axes = 3 - ! ExtDiag(idx)%name = 'cleffr' - ! 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(nb)%phy_f3d(:,:,Model%nleffr) - ! enddo - ! 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(nb)%phy_f3d(:,:,Model%nieffr) - ! enddo - ! 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(nb)%phy_f3d(:,:,Model%nseffr) - ! enddo - !endif + do i=1,Model%num_dfi_radar + idx = idx + 1 + ExtDiag(idx)%axes = 3 + if(i>1) then + write(ExtDiag(idx)%name,'(A,I0)') 'radar_tten_',i + else + ExtDiag(idx)%name = 'radar_tten' + endif + write(ExtDiag(idx)%desc,'(A,I0,A,I0)') 'temperature tendency due to dfi radar tendencies ',i,' of ',Model%num_dfi_radar + 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(nb)%dfi_radar_tten(:,:,i) + enddo + enddo + + ! Cloud effective radii from Microphysics + if (Model%imp_physics == Model%imp_physics_thompson .or. Model%imp_physics == Model%imp_physics_fer_hires) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'cleffr' + 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(nb)%phy_f3d(:,:,Model%nleffr) + enddo + 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(nb)%phy_f3d(:,:,Model%nieffr) + enddo + 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(nb)%phy_f3d(:,:,Model%nseffr) + enddo + endif !MYNN if (Model%do_mynnedmf) then diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index 07d52a8f0..1ffaed4dc 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -60,7 +60,7 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & !--- local variables integer :: idx, ndiag_rst - integer :: ndiag_idx(20) + integer :: ndiag_idx(20), itime integer :: nblks, num, nb, max_rstrt, offset character(len=2) :: c2 = '' @@ -115,14 +115,20 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & endif ! MYNN SFC if (Model%do_mynnsfclay) then - Restart%num2d = Restart%num2d + 1 + Restart%num2d = Restart%num2d + 13 endif ! Thompson aerosol-aware if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then Restart%num2d = Restart%num2d + 2 endif + if (Model%do_cap_suppress .and. Model%num_dfi_radar>0) then + Restart%num2d = Restart%num2d + Model%num_dfi_radar + endif Restart%num3d = Model%ntot3d + if (Model%num_dfi_radar>0) then + Restart%num3d = Restart%num3d + Model%num_dfi_radar + endif if(Model%lrefres) then Restart%num3d = Model%ntot3d+1 endif @@ -134,7 +140,7 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & if (Model%imfdeepcnv == 3) then Restart%num3d = Restart%num3d + 3 endif - ! MYNN PBL + ! MYNN PBL if (Model%do_mynnedmf) then Restart%num3d = Restart%num3d + 9 endif @@ -309,6 +315,66 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & do nb = 1,nblks Restart%data(nb,num)%var2p => Sfcprop(nb)%uustar(:) enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_hpbl' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Tbd(nb)%hpbl(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_ustm' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%ustm(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_zol' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%zol(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_mol' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%mol(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_flhc' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%flhc(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_flqc' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%flqc(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_chs2' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%chs2(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_cqs2' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%cqs2(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_lh' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%lh(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_hflx' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%hflx(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_evap' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%evap(:) + enddo + num = num + 1 + Restart%name2d(num) = 'mynn_2d_qss' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%qss(:) + enddo endif ! Thompson aerosol-aware if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then @@ -324,6 +390,23 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & enddo 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 + if(itime==1) then + Restart%name2d(num) = 'cap_suppress' + else + write(Restart%name2d(num),'("cap_suppress_",I0)') itime + endif + do nb = 1,nblks + Restart%data(nb,num)%var2p => Tbd(nb)%cap_suppress(:,Model%ix_dfi_radar(itime)) + enddo + endif + enddo + endif + !--- phy_f3d variables do num = 1,Model%ntot3d !--- set the variable name @@ -422,6 +505,24 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & enddo 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 + if(itime==1) then + Restart%name3d(num) = 'radar_tten' + else + write(Restart%name3d(num),'("radar_tten_",I0)') itime + endif + do nb = 1,nblks + Restart%data(nb,num)%var3p => Tbd(nb)%dfi_radar_tten( & + :,:,Model%ix_dfi_radar(itime)) + enddo + endif + enddo + endif + end subroutine GFS_restart_populate end module GFS_restart diff --git a/ccpp/framework b/ccpp/framework index 64b5afd13..a55457fe3 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 64b5afd1352d709f3b72734bf960e36024a838d3 +Subproject commit a55457fe3ef66e1651c94f99e72aba3362b105a2 diff --git a/ccpp/physics b/ccpp/physics index 84b76468d..8c2450b4c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 84b76468d8fced8fba8c7fa1593bfd0a25a11f15 +Subproject commit 8c2450b4c7d2791f80128538bdb18940b3c40b9b diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml b/ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml new file mode 100644 index 000000000..423d37f6d --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml @@ -0,0 +1,95 @@ + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + GFS_radiation_surface + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_cice + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v16_p8.xml b/ccpp/suites/suite_FV3_GFS_v16_p8.xml index ef860e66d..8828f503a 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_p8.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_p8.xml @@ -10,7 +10,7 @@ GFS_time_vary_pre - GFS_rrtmgp_setup + GFS_rrtmg_setup GFS_rad_time_vary GFS_phys_time_vary @@ -18,25 +18,15 @@ GFS_suite_interstitial_rad_reset - GFS_rrtmgp_pre + GFS_rrtmg_pre GFS_radiation_surface - GFS_rrtmgp_gfdlmp_pre - GFS_rrtmgp_cloud_overlap_pre - GFS_cloud_diagnostics - GFS_rrtmgp_sw_pre - rrtmgp_sw_gas_optics - rrtmgp_sw_aerosol_optics - rrtmgp_sw_cloud_optics - rrtmgp_sw_cloud_sampling - rrtmgp_sw_rte - GFS_rrtmgp_sw_post - rrtmgp_lw_pre - rrtmgp_lw_gas_optics - rrtmgp_lw_aerosol_optics - rrtmgp_lw_cloud_optics - rrtmgp_lw_cloud_sampling - rrtmgp_lw_rte - GFS_rrtmgp_lw_post + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_HAFS_v0_hwrf_thompson.xml b/ccpp/suites/suite_FV3_HAFS_v0_thompson_tedmf_gfdlsf.xml similarity index 93% rename from ccpp/suites/suite_FV3_HAFS_v0_hwrf_thompson.xml rename to ccpp/suites/suite_FV3_HAFS_v0_thompson_tedmf_gfdlsf.xml index 2bc2f8592..652c5eabb 100644 --- a/ccpp/suites/suite_FV3_HAFS_v0_hwrf_thompson.xml +++ b/ccpp/suites/suite_FV3_HAFS_v0_thompson_tedmf_gfdlsf.xml @@ -1,6 +1,6 @@ - + @@ -13,17 +13,15 @@ GFS_suite_interstitial_rad_reset - GFS_rrtmg_pre GFS_radiation_surface - rrtmg_lw_pre - rrtmg_lw - rrtmg_lw_post rrtmg_sw_pre rrtmg_sw rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post GFS_rrtmg_post - @@ -45,7 +43,7 @@ sfc_nst_pre sfc_nst sfc_nst_post - noahmpdrv + lsm_noah sfc_sice GFS_surface_loop_control_part2 @@ -56,7 +54,7 @@ sfc_diag_post GFS_surface_generic_post GFS_PBL_generic_pre - hedmf + satmedmfvdifq GFS_PBL_generic_post GFS_GWD_generic_pre cires_ugwp @@ -65,9 +63,9 @@ GFS_suite_stateout_update ozphys_2015 h2ophys - GFS_DCNV_generic_pre get_phi_fv3 GFS_suite_interstitial_3 + GFS_DCNV_generic_pre samfdeepcnv GFS_DCNV_generic_post GFS_SCNV_generic_pre @@ -77,7 +75,11 @@ cnvc90 GFS_MP_generic_pre mp_thompson_pre + + mp_thompson + + mp_thompson_post GFS_MP_generic_post maximum_hourly_diagnostics diff --git a/ccpp/suites/suite_FV3_RRFS_v1alpha.xml b/ccpp/suites/suite_FV3_RRFS_v1alpha.xml new file mode 100644 index 000000000..b3622828e --- /dev/null +++ b/ccpp/suites/suite_FV3_RRFS_v1alpha.xml @@ -0,0 +1,84 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_suite_interstitial_4 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/cpl/module_block_data.F90 b/cpl/module_block_data.F90 index 02ef0ebc8..9d2cc9192 100644 --- a/cpl/module_block_data.F90 +++ b/cpl/module_block_data.F90 @@ -71,6 +71,7 @@ subroutine block_copy_1d_i4_to_2d_r8(destin_ptr, source_ptr, block, block_index, if (associated(destin_ptr) .and. associated(source_ptr)) then factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -105,6 +106,7 @@ subroutine block_copy_1d_to_2d_r8(destin_ptr, source_ptr, block, block_index, sc if (associated(destin_ptr) .and. associated(source_ptr)) then factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -144,6 +146,7 @@ subroutine block_copy_1dslice_to_2d_r8(destin_ptr, source_ptr, slice, block, blo if (slice > 0 .and. slice <= size(source_ptr, dim=2)) then factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -182,6 +185,7 @@ subroutine block_copy_2d_to_3d_r8(destin_ptr, source_ptr, block, block_index, sc factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor do k = 1, size(source_ptr, dim=2) +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -219,6 +223,7 @@ subroutine block_copy_2d_to_2d_r8(destin_ptr, source_ptr, block, block_index, sc if (associated(destin_ptr) .and. associated(source_ptr)) then factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -253,6 +258,7 @@ subroutine block_array_copy_2d_to_2d_r8(destin_ptr, source_arr, block, block_ind if (associated(destin_ptr)) then factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -290,6 +296,7 @@ subroutine block_copy_3d_to_3d_r8(destin_ptr, source_ptr, block, block_index, sc factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor do k = 1, size(source_ptr, dim=3) +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -326,6 +333,7 @@ subroutine block_array_copy_3d_to_3d_r8(destin_ptr, source_arr, block, block_ind factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor do k = 1, size(source_arr, dim=3) +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -367,6 +375,7 @@ subroutine block_copy_3dslice_to_3d_r8(destin_ptr, source_ptr, slice, block, blo factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor do k = 1, size(source_ptr, dim=3) +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -407,6 +416,7 @@ subroutine block_array_copy_3dslice_to_3d_r8(destin_ptr, source_arr, slice, bloc factor = 1._kind_phys if (present(scale_factor)) factor = scale_factor do k = 1, size(source_arr, dim=3) +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -441,6 +451,7 @@ subroutine block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc) ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr)) then +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -474,6 +485,7 @@ subroutine block_fill_3d_r8(destin_ptr, fill_value, block, block_index, rc) localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr)) then do k = 1, size(destin_ptr, dim=3) +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) @@ -586,6 +598,7 @@ subroutine block_combine_frac_1d_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, bl localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr) .and. & associated(fract1_ptr) .and. associated(fract2_ptr)) then +!$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) ib = block%index(block_index)%ii(ix) jb = block%index(block_index)%jj(ix) diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 index 47f48ce4d..d69f6c989 100644 --- a/cpl/module_cap_cpl.F90 +++ b/cpl/module_cap_cpl.F90 @@ -6,253 +6,15 @@ module module_cap_cpl ! 12 Mar 2018: J. Wang Pull coupled subroutines from fv3_cap.F90 to this module ! use ESMF - use NUOPC - use module_cplfields, only : FieldInfo -! implicit none + private - public clock_cplIntval - ! public realizeConnectedInternCplField - public realizeConnectedCplFields public diagnose_cplFields ! contains !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - - subroutine clock_cplIntval(gcomp, CF) - - type(ESMF_GridComp) :: gcomp - type(ESMF_Config) :: CF -! - real(ESMF_KIND_R8) :: medAtmCouplingIntervalSec - type(ESMF_Clock) :: fv3Clock - type(ESMF_TimeInterval) :: fv3Step - integer :: rc -! - call ESMF_ConfigGetAttribute(config=CF, value=medAtmCouplingIntervalSec, & - label="atm_coupling_interval_sec:", default=-1.0_ESMF_KIND_R8, rc=RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - - if (medAtmCouplingIntervalSec > 0._ESMF_KIND_R8) then ! The coupling time step is provided - call ESMF_TimeIntervalSet(fv3Step, s_r8=medAtmCouplingIntervalSec, rc=RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_GridCompGet(gcomp, clock=fv3Clock, rc=RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_ClockSet(fv3Clock, timestep=fv3Step, rc=RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - end subroutine clock_cplIntval - - !----------------------------------------------------------------------------- - - subroutine addFieldMetadata(field, key, values, rc) - - ! This subroutine implements a preliminary method to provide metadata to - ! a coupled model that is accessing the field via reference sharing - ! (NUOPC SharedStatusField=.true.). The method sets a (key, values) pair - ! in the field's array ESMF_Info object to retrieve an array of strings - ! encoding metadata. - ! - ! Such a capability should be implemented in the standard NUOPC connector - ! for more general applications, possibly providing access to the field's - ! ESMF_Info object. - - type(ESMF_Field) :: field - character(len=*), intent(in) :: key - character(len=*), intent(in) :: values(:) - integer, optional, intent(out) :: rc - - ! local variable - integer :: localrc - type(ESMF_Array) :: array - type(ESMF_Info) :: info - - ! begin - if (present(rc)) rc = ESMF_SUCCESS - - call ESMF_FieldGet(field, array=array, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call ESMF_InfoGetFromHost(array, info, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call ESMF_InfoSet(info, key, values, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - end subroutine addFieldMetadata - - !----------------------------------------------------------------------------- - -#if 0 - subroutine realizeConnectedInternCplField(state, field, standardName, grid, rc) - - type(ESMF_State) :: state - type(ESMF_Field), optional :: field - character(len=*), optional :: standardName - type(ESMF_Grid), optional :: grid - integer, intent(out), optional :: rc - - ! local variables - character(len=80) :: fieldName - type(ESMF_ArraySpec) :: arrayspec - integer :: i, localrc - logical :: isConnected - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - if (present(rc)) rc = ESMF_SUCCESS - - fieldName = standardName ! use standard name as field name - - !! Create fields using wam2dmesh if they are WAM fields - isConnected = NUOPC_IsConnected(state, fieldName=fieldName, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - if (isConnected) then - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name=fieldName, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call NUOPC_Realize(state, field=field, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - call ESMF_FieldGet(field, farrayPtr=fptr, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - fptr=0._ESMF_KIND_R8 ! zero out the entire field - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - else - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/fieldName/), rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - endif - - end subroutine realizeConnectedInternCplField -#endif - !----------------------------------------------------------------------------- - - subroutine realizeConnectedCplFields(state, grid, & - numLevels, numSoilLayers, numTracers, & - fields_info, state_tag, fieldList, fill_value, rc) - - use field_manager_mod, only: MODEL_ATMOS - use tracer_manager_mod, only: get_number_tracers, get_tracer_names - - type(ESMF_State), intent(inout) :: state - type(ESMF_Grid), intent(in) :: grid - integer, intent(in) :: numLevels - integer, intent(in) :: numSoilLayers - integer, intent(in) :: numTracers - type(FieldInfo), dimension(:), intent(in) :: fields_info - character(len=*), intent(in) :: state_tag !< Import or export. - type(ESMF_Field), dimension(:), intent(out) :: fieldList - real(ESMF_KIND_R8), optional , intent(in) :: fill_value - integer, intent(out) :: rc - - ! local variables - - integer :: item, pos, tracerCount - logical :: isConnected - type(ESMF_Field) :: field - real(ESMF_KIND_R8) :: l_fill_value - real(ESMF_KIND_R8), parameter :: d_fill_value = 0._ESMF_KIND_R8 - type(ESMF_StateIntent_Flag) :: stateintent - character(len=32), allocatable, dimension(:) :: tracerNames, tracerUnits - - ! begin - rc = ESMF_SUCCESS - - if (present(fill_value)) then - l_fill_value = fill_value - else - l_fill_value = d_fill_value - end if - - ! attach list of tracer names to exported tracer field as metadata - call ESMF_StateGet(state, stateintent=stateintent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if (stateintent == ESMF_STATEINTENT_EXPORT) then - call get_number_tracers(MODEL_ATMOS, num_tracers=tracerCount) - allocate(tracerNames(tracerCount), tracerUnits(tracerCount)) - do item = 1, tracerCount - call get_tracer_names(MODEL_ATMOS, item, tracerNames(item), units=tracerUnits(item)) - end do - end if - - do item = 1, size(fields_info) - isConnected = NUOPC_IsConnected(state, fieldName=trim(fields_info(item)%name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (isConnected) then - call ESMF_StateGet(state, field=field, itemName=trim(fields_info(item)%name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldEmptySet(field, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - select case (fields_info(item)%type) - case ('l','layer') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - case ('i','interface') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/numLevels+1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - case ('t','tracer') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1, 1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (allocated(tracerNames)) then - call addFieldMetadata(field, 'tracerNames', tracerNames, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - if (allocated(tracerUnits)) then - call addFieldMetadata(field, 'tracerUnits', tracerUnits, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - case ('s','surface') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - case ('g','soil') - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/numSoilLayers/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - case default - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="exportFieldType = '"//trim(fields_info(item)%type)//"' not recognized", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - end select - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! -- initialize field value - call ESMF_FieldFill(field, dataFillScheme="const", const1=l_fill_value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! -- save field - fieldList(item) = field - call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & - // ' is connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) - else - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/trim(fields_info(item)%name)/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & - // ' is not connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) - end if - end do - - if (allocated(tracerNames)) deallocate(tracerNames) - if (allocated(tracerUnits)) deallocate(tracerUnits) - - end subroutine realizeConnectedCplFields - !----------------------------------------------------------------------------- subroutine diagnose_cplFields(gcomp, clock_fv3, fcstpe, & @@ -316,103 +78,6 @@ subroutine diagnose_cplFields(gcomp, clock_fv3, fcstpe, & end subroutine diagnose_cplFields - !----------------------------------------------------------------------------- - - subroutine ESMFPP_RegridWriteState(state, fileName, timeslice, rc) - - type(ESMF_State), intent(in) :: state - character(len=*), intent(in) :: fileName - integer, intent(in) :: timeslice - integer, intent(out) :: rc - - ! local - type(ESMF_Field) :: field - type(ESMF_Grid) :: outGrid - integer :: i, icount - character(64), allocatable :: itemNameList(:) - type(ESMF_StateItem_Flag), allocatable :: typeList(:) - - rc = ESMF_SUCCESS - - ! 1degx1deg - outGrid = ESMF_GridCreate1PeriDimUfrm(maxIndex=(/360,180/), & - minCornerCoord=(/0.0_ESMF_KIND_R8,-90.0_ESMF_KIND_R8/), & - maxCornerCoord=(/360.0_ESMF_KIND_R8,90.0_ESMF_KIND_R8/), & - staggerLocList=(/ESMF_STAGGERLOC_CORNER, ESMF_STAGGERLOC_CENTER/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_StateGet(state, itemCount=icount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(typeList(icount), itemNameList(icount)) - call ESMF_StateGet(state, itemTypeList=typeList, itemNameList=itemNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - do i = 1, icount - if(typeList(i) == ESMF_STATEITEM_FIELD) then - call ESMF_LogWrite("RegridWrite Field Name Initiated: "//trim(itemNameList(i)), ESMF_LOGMSG_INFO) - call ESMF_StateGet(state, itemName=itemNameList(i), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMFPP_RegridWrite(field, outGrid, ESMF_REGRIDMETHOD_BILINEAR, & - fileName//trim(itemNameList(i))//'.nc', trim(itemNameList(i)), timeslice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite("RegridWrite Field Name done: "//trim(itemNameList(i)), ESMF_LOGMSG_INFO) - endif - enddo - - deallocate(typeList, itemNameList) - - call ESMF_GridDestroy(outGrid,noGarbage=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - end subroutine ESMFPP_RegridWriteState - - subroutine ESMFPP_RegridWrite(inField, outGrid, regridMethod, fileName, fieldName, timeslice, rc) - - ! input arguments - type(ESMF_Field), intent(in) :: inField - type(ESMF_Grid), intent(in) :: outGrid - type(ESMF_RegridMethod_Flag), intent(in) :: regridMethod - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: fieldName - integer, intent(in) :: timeslice - integer, intent(inout) :: rc - - ! local variables - integer :: srcTermProcessing - type(ESMF_Routehandle) :: rh - type(ESMF_Field) :: outField - - outField = ESMF_FieldCreate(outGrid, typekind=ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! Perform entire regridding arithmetic on the destination PET - srcTermProcessing = 0 - ! For other options for the regrid operation, please refer to: - ! http://www.earthsystemmodeling.org/esmf_releases/last_built/ESMF_refdoc/node5.html#SECTION050366000000000000000 - call ESMF_FieldRegridStore(inField, outField, regridMethod=regridMethod, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - srcTermProcessing=srcTermProcessing, Routehandle=rh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! Use fixed ascending order for the sum terms based on their source - ! sequence index to ensure bit-for-bit reproducibility - call ESMF_FieldRegrid(inField, outField, Routehandle=rh, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldWrite(outField, fileName, variableName=fieldName, timeslice=timeslice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldRegridRelease(routehandle=rh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldDestroy(outField,noGarbage=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - rc = ESMF_SUCCESS - - end subroutine ESMFPP_RegridWrite - !----------------------------------------------------------------------------- ! This subroutine requires ESMFv8 - for coupled FV3 diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 380c49c77..68d6f10d8 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -6,6 +6,7 @@ module module_cplfields !----------------------------------------------------------------------------- use ESMF + use NUOPC implicit none @@ -224,6 +225,7 @@ module module_cplfields ! Methods public queryImportFields, queryExportFields public cplFieldGet + public realizeConnectedCplFields !----------------------------------------------------------------------------- contains @@ -237,6 +239,8 @@ integer function queryExportFields(fieldname, abortflag) end function queryExportFields +!----------------------------------------------------------------------------- + integer function queryImportFields(fieldname, abortflag) character(len=*),intent(in) :: fieldname @@ -246,6 +250,7 @@ integer function queryImportFields(fieldname, abortflag) end function queryImportFields +!----------------------------------------------------------------------------- integer function queryFieldList(fieldsInfo, fieldname, abortflag) ! returns integer index of first found fieldname in fieldlist @@ -282,9 +287,9 @@ integer function queryFieldList(fieldsInfo, fieldname, abortflag) CALL ESMF_Finalize(endflag=ESMF_END_ABORT) endif end function queryFieldList -! -!------------------------------------------------------------------------------ -! + +!----------------------------------------------------------------------------- + subroutine cplStateGet(state, fieldList, fieldCount, rc) character(len=*), intent(in) :: state @@ -311,6 +316,7 @@ subroutine cplStateGet(state, fieldList, fieldCount, rc) end subroutine cplStateGet +!----------------------------------------------------------------------------- subroutine cplFieldGet(state, name, localDe, & farrayPtr2d, farrayPtr3d, farrayPtr4d, rc) @@ -379,6 +385,159 @@ subroutine cplFieldGet(state, name, localDe, & end do end subroutine cplFieldGet + + + subroutine realizeConnectedCplFields(state, grid, & + numLevels, numSoilLayers, numTracers, & + fields_info, state_tag, fieldList, fill_value, rc) + + use field_manager_mod, only: MODEL_ATMOS + use tracer_manager_mod, only: get_number_tracers, get_tracer_names + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: numLevels + integer, intent(in) :: numSoilLayers + integer, intent(in) :: numTracers + type(FieldInfo), dimension(:), intent(in) :: fields_info + character(len=*), intent(in) :: state_tag !< Import or export. + type(ESMF_Field), dimension(:), intent(out) :: fieldList + real(ESMF_KIND_R8), optional , intent(in) :: fill_value + integer, intent(out) :: rc + + ! local variables + + integer :: item, pos, tracerCount + logical :: isConnected + type(ESMF_Field) :: field + real(ESMF_KIND_R8) :: l_fill_value + real(ESMF_KIND_R8), parameter :: d_fill_value = 0._ESMF_KIND_R8 + type(ESMF_StateIntent_Flag) :: stateintent + character(len=32), allocatable, dimension(:) :: tracerNames, tracerUnits + + ! begin + rc = ESMF_SUCCESS + + if (present(fill_value)) then + l_fill_value = fill_value + else + l_fill_value = d_fill_value + end if + + ! attach list of tracer names to exported tracer field as metadata + call ESMF_StateGet(state, stateintent=stateintent, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (stateintent == ESMF_STATEINTENT_EXPORT) then + call get_number_tracers(MODEL_ATMOS, num_tracers=tracerCount) + allocate(tracerNames(tracerCount), tracerUnits(tracerCount)) + do item = 1, tracerCount + call get_tracer_names(MODEL_ATMOS, item, tracerNames(item), units=tracerUnits(item)) + end do + end if + + do item = 1, size(fields_info) + isConnected = NUOPC_IsConnected(state, fieldName=trim(fields_info(item)%name), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (isConnected) then + call ESMF_StateGet(state, field=field, itemName=trim(fields_info(item)%name), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldEmptySet(field, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + select case (fields_info(item)%type) + case ('l','layer') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + case ('i','interface') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/numLevels+1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + case ('t','tracer') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1, 1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (allocated(tracerNames)) then + call addFieldMetadata(field, 'tracerNames', tracerNames, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + if (allocated(tracerUnits)) then + call addFieldMetadata(field, 'tracerUnits', tracerUnits, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + case ('s','surface') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + case ('g','soil') + call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/numSoilLayers/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + case default + call ESMF_LogSetError(ESMF_RC_NOT_VALID, & + msg="exportFieldType = '"//trim(fields_info(item)%type)//"' not recognized", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end select + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! -- initialize field value + call ESMF_FieldFill(field, dataFillScheme="const", const1=l_fill_value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! -- save field + fieldList(item) = field + call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & + // ' is connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) + else + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/trim(fields_info(item)%name)/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & + // ' is not connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) + end if + end do + + if (allocated(tracerNames)) deallocate(tracerNames) + if (allocated(tracerUnits)) deallocate(tracerUnits) + + end subroutine realizeConnectedCplFields + +!----------------------------------------------------------------------------- + + subroutine addFieldMetadata(field, key, values, rc) + + ! This subroutine implements a preliminary method to provide metadata to + ! a coupled model that is accessing the field via reference sharing + ! (NUOPC SharedStatusField=.true.). The method sets a (key, values) pair + ! in the field's array ESMF_Info object to retrieve an array of strings + ! encoding metadata. + ! + ! Such a capability should be implemented in the standard NUOPC connector + ! for more general applications, possibly providing access to the field's + ! ESMF_Info object. + + type(ESMF_Field) :: field + character(len=*), intent(in) :: key + character(len=*), intent(in) :: values(:) + integer, optional, intent(out) :: rc + + ! local variable + integer :: localrc + type(ESMF_Array) :: array + type(ESMF_Info) :: info + + ! begin + if (present(rc)) rc = ESMF_SUCCESS + + call ESMF_FieldGet(field, array=array, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + call ESMF_InfoGetFromHost(array, info, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + call ESMF_InfoSet(info, key, values, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + end subroutine addFieldMetadata ! !------------------------------------------------------------------------------ ! diff --git a/fv3_cap.F90 b/fv3_cap.F90 index a256fbdf6..87dbe0e69 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -16,21 +16,20 @@ module fv3gfs_cap_mod use ESMF use NUOPC use NUOPC_Model, only: model_routine_SS => SetServices, & + SetVM, & routine_Run, & label_Advertise, & label_RealizeProvided, & label_Advance, & label_CheckImport, & + label_SetRunClock, & label_TimestampExport, & label_Finalize, & NUOPC_ModelGet ! use module_fv3_config, only: quilting, output_fh, & nfhout, nfhout_hf, nsout, dt_atmos, & - nfhmax, nfhmax_hf,output_hfmax, & - output_interval,output_interval_hf, & - calendar, calendar_type, & - force_date_from_configure, & + calendar, & cplprint_flag,output_1st_tstep_rst, & first_kdt @@ -38,12 +37,11 @@ module fv3gfs_cap_mod num_files, filename_base, & wrttasks_per_group, n_group, & lead_wrttask, last_wrttask, & - output_grid, output_file, & nsout_io, iau_offset, lflname_fulltime ! use module_fcst_grid_comp, only: fcstSS => SetServices, & fcstGrid, numLevels, numSoilLayers, & - numTracers + numTracers, mygrid, grid_number_on_all_pets use module_wrt_grid_comp, only: wrtSS => SetServices ! @@ -51,8 +49,8 @@ module fv3gfs_cap_mod nImportFields, importFields, importFieldsInfo, & importFieldsValid, queryImportFields - use module_cap_cpl, only: realizeConnectedCplFields, & - clock_cplIntval, diagnose_cplFields + use module_cplfields, only: realizeConnectedCplFields + use module_cap_cpl, only: diagnose_cplFields use atmos_model_mod, only: setup_exportdata @@ -62,7 +60,6 @@ module fv3gfs_cap_mod ! !----------------------------------------------------------------------- ! - type(ESMF_Clock),save :: clock_fv3 type(ESMF_GridComp) :: fcstComp type(ESMF_State) :: fcstState @@ -138,6 +135,14 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="phase2", specRoutine=ModelAdvance_phase2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! specializations to set fv3 cap run clock (model clock) + call ESMF_MethodRemove(gcomp, label=label_SetRunClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call NUOPC_CompSpecialize(gcomp, specLabel=label_SetRunClock, & + specRoutine=ModelSetRunClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! specializations required to support 'inline' run sequences call NUOPC_CompSpecialize(gcomp, specLabel=label_CheckImport, & specPhaseLabel="phase1", specRoutine=fv3_checkimport, rc=rc) @@ -173,40 +178,45 @@ subroutine InitializeAdvertise(gcomp, rc) character(240) :: msgString logical :: isPresent, isSet type(ESMF_VM) :: vm, fcstVM - type(ESMF_Time) :: currTime, startTime, stopTime - type(ESMF_TimeInterval) :: RunDuration, timeStep, rsthour, IAU_offsetTI + type(ESMF_Time) :: currTime, startTime + type(ESMF_TimeInterval) :: timeStep, rsthour type(ESMF_Config) :: cf type(ESMF_RegridMethod_Flag) :: regridmethod - type(ESMF_TimeInterval) :: earthStep - integer(ESMF_KIND_I4) :: nhf, nrg - integer,dimension(6) :: date, date_init - integer :: i, j, k, io_unit, urc, ierr, ist + integer :: i, j, k, urc, ist integer :: noutput_fh, nfh, nfh2 integer :: petcount - integer :: num_output_file + integer :: nfhmax_hf + real :: nfhmax real :: output_startfh, outputfh, outputfh2(2) - logical :: opened, loutput_fh, lfreq + logical :: loutput_fh, lfreq character(ESMF_MAXSTR) :: name integer,dimension(:), allocatable :: petList, fcstPetList, originPetList, targetPetList character(len=esmf_maxstr),allocatable :: fcstItemNameList(:) type(ESMF_StateItem_Flag), allocatable :: fcstItemTypeList(:) character(20) :: cwrtcomp integer :: isrcTermProcessing + type(ESMF_Info) :: parentInfo, childInfo character(len=*),parameter :: subname='(fv3_cap:InitializeAdvertise)' - real(kind=8) :: MPI_Wtime, timewri, timeis, timerhs + real(kind=8) :: MPI_Wtime, timeis, timerhs ! !------------------------------------------------------------------------ ! rc = ESMF_SUCCESS timeis = MPI_Wtime() + call ESMF_GridCompGet(gcomp,name=name,vm=vm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, petCount=petcount, localpet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! query for importState and exportState call NUOPC_ModelGet(gcomp, driverClock=clock, importState=importState, exportState=exportState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & + call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return profile_memory = (trim(value)/="false") @@ -228,18 +238,6 @@ subroutine InitializeAdvertise(gcomp, rc) write(msgString,'(A,i6)') trim(subname)//' dbug = ',dbug call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - call ESMF_GridCompGet(gcomp,name=name,vm=vm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_VMGet(vm, petCount=petcount, localpet=mype, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - -! print *,'in fv3_cap,initAdvertize,name=',trim(name),'petcount=',petcount,'mype=',mype -! -! create an instance clock for fv3 - clock_fv3 = ESMF_ClockCreate(clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! !------------------------------------------------------------------------ ! get config variables ! @@ -265,8 +263,8 @@ subroutine InitializeAdvertise(gcomp, rc) noutput_fh = ESMF_ConfigGetLen(config=CF, label ='output_fh:',rc=rc) - if(mype == 0) print *,'af nems config,quilting=',quilting,'calendar=', trim(calendar),' iau_offset=',iau_offset, & - 'noutput_fh=',noutput_fh + if(mype == 0) print *,'af nems config,quilting=',quilting,' calendar=', trim(calendar),' iau_offset=',iau_offset, & + ' noutput_fh=',noutput_fh ! nfhout = 0 ; nfhmax_hf = 0 ; nfhout_hf = 0 ; nsout = 0 if ( quilting ) then @@ -282,9 +280,8 @@ subroutine InitializeAdvertise(gcomp, rc) label ='isrcTermProcessing:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(mype == 0) print *,'af nems config,quilting=',quilting,'write_groups=', & - write_groups,wrttasks_per_group,'calendar=',trim(calendar),'calendar_type=',calendar_type, & - 'isrcTermProcessing=', isrcTermProcessing + if(mype == 0) print *,'af nems config,quilting=',quilting,' write_groups=', & + write_groups,wrttasks_per_group,' isrcTermProcessing=', isrcTermProcessing ! call ESMF_ConfigGetAttribute(config=CF,value=num_files, & label ='num_files:',rc=rc) @@ -297,33 +294,6 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo - allocate(output_file(num_files)) - num_output_file = ESMF_ConfigGetLen(config=CF, label ='output_file:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (num_files == num_output_file) then - call ESMF_ConfigGetAttribute(CF,valueList=output_file,label='output_file:', & - count=num_files, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - do i = 1, num_files - if(output_file(i) /= "netcdf" .and. output_file(i) /= "netcdf_parallel") then - write(0,*)"fv3_cap.F90: only netcdf and netcdf_parallel are allowed for multiple values of output_file" - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - enddo - else if ( num_output_file == 1) then - call ESMF_ConfigGetAttribute(CF,valuelist=output_file,label='output_file:', count=1, rc=rc) - output_file(1:num_files) = output_file(1) - else - output_file(1:num_files) = 'netcdf' - endif - if(mype == 0) then - print *,'af nems config,num_files=',num_files - do i=1,num_files - print *,'num_file=',i,'filename_base= ',trim(filename_base(i)),& - ' output_file= ',trim(output_file(i)) - enddo - endif -! ! variables for output call ESMF_ConfigGetAttribute(config=CF, value=nfhout, label ='nfhout:', default=-1,rc=rc) call ESMF_ConfigGetAttribute(config=CF, value=nfhmax_hf,label ='nfhmax_hf:',default=-1,rc=rc) @@ -338,75 +308,9 @@ subroutine InitializeAdvertise(gcomp, rc) call ESMF_ConfigGetAttribute(config=CF, value=dt_atmos, label ='dt_atmos:', rc=rc) call ESMF_ConfigGetAttribute(config=CF, value=nfhmax, label ='nhours_fcst:',rc=rc) if(mype == 0) print *,'af nems config,dt_atmos=',dt_atmos,'nfhmax=',nfhmax - call ESMF_TimeIntervalSet(timeStep,s=dt_atmos,rc=rc) - call ESMF_ClockSet(clock_fv3,timeStep=timeStep, rc=rc) -! -!------------------------------------------------------------------------ -! may need to set currTime for restart -! - call ESMF_ClockGet(clock_fv3, currTime=currTime, StartTime=startTime, & - RunDuration=RunDuration, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - stopTime = startTime + RunDuration -! *** read restart time from restart file - do i=751,899 - inquire(i, opened=opened) - if(.not. opened)then - io_unit = i - exit - endif - enddo -! - date = 0 ; date_init = 0 - force_date_from_configure = .true. -! - open(unit=io_unit, file=trim('INPUT/coupler.res'),status="old",err=998 ) - read (io_unit,*,err=999) calendar_type - read (io_unit,*) date_init - read (io_unit,*) date - close(io_unit) - force_date_from_configure = .false. -! - if(date(1) == 0 .and. date_init(1) /= 0) date = date_init - if(mype == 0) print *,'bf clock_fv3,date=',date,'date_init=',date_init - - call ESMF_VMbroadcast(vm, date, 6, 0) - call ESMF_TimeSet(time=currTime,yy=date(1),mm=date(2),dd=date(3),h=date(4), & - m=date(5),s=date(6),rc=rc) + call ESMF_TimeIntervalSet(timeStep, s=dt_atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -999 continue -998 continue -! if(mype==0) print *,'final date =',date,'date_init=',date_init - -!reset currTime in clock - call ESMF_ClockSet(clock_fv3, currTime=currTime, startTime=startTime, & - stopTime=stopTime, timeStep=timeStep, rc=rc) - - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! - !Under NUOPC, the EARTH driver clock is a separate instance from the - ! - fv3 clock. However, the fv3 clock may have been reset from restart - ! - therefore the EARTH driver clock must also be adjusted. - ! - Affected: currTime, timeStep - call ESMF_ClockGet(clock, timeStep=earthStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - if (earthStep > (stopTime-currTime)) earthStep = stopTime - currTime - call ESMF_ClockSet(clock, currTime=currTime, timeStep=earthStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Set fv3 component clock as copy of EARTH clock. - call NUOPC_CompSetClock(gcomp, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Read in the FV3 coupling interval - call clock_cplIntval(gcomp, CF) first_kdt = 1 if( output_1st_tstep_rst) then @@ -436,6 +340,18 @@ subroutine InitializeAdvertise(gcomp, rc) fcstComp = ESMF_GridCompCreate(petList=fcstPetList, name='fv3_fcst', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! + ! copy attributes from fv3cap component to fcstComp + call ESMF_InfoGetFromHost(gcomp, info=parentInfo, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetFromHost(fcstComp, info=childInfo, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoUpdate(lhs=childInfo, rhs=parentInfo, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! use the generic SetVM method to do resource and threading control + call ESMF_GridCompSetVM(fcstComp, SetVM, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return call ESMF_GridCompSetServices(fcstComp, fcstSS, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -449,12 +365,12 @@ subroutine InitializeAdvertise(gcomp, rc) ! call fcst Initialize (including creating fcstgrid and fcst fieldbundle) call ESMF_GridCompInitialize(fcstComp, exportState=fcstState, & - clock=clock_fv3, userRc=urc, rc=rc) + clock=clock, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return ! -! reconcile the fcstComp's import state +! reconcile the fcstComp's export state call ESMF_StateReconcile(fcstState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! @@ -483,7 +399,9 @@ subroutine InitializeAdvertise(gcomp, rc) ! pull out the item names and item types from fcstState call ESMF_StateGet(fcstState, itemNameList=fcstItemNameList, & - itemTypeList=fcstItemTypeList, rc=rc) + itemTypeList=fcstItemTypeList, & + !itemorderflag=ESMF_ITEMORDER_ADDORDER, & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! loop over all items in the fcstState and collect all FieldBundles @@ -502,9 +420,6 @@ subroutine InitializeAdvertise(gcomp, rc) return endif enddo -! -! set up ESMF time interval at center of iau window - call ESMF_TimeIntervalSet(IAU_offsetTI, h=iau_offset, rc=rc) ! k = num_pes_fcst timerhs = MPI_Wtime() @@ -526,6 +441,17 @@ subroutine InitializeAdvertise(gcomp, rc) ! print *,'af wrtComp(i)=',i,'name=',trim(cwrtcomp),'rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! copy attributes from fv3cap component to wrtComp + call ESMF_InfoGetFromHost(wrtComp(i), info=childInfo, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoUpdate(lhs=childInfo, rhs=parentInfo, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +! use the generic SetVM method to do resource and threading control + call ESMF_GridCompSetVM(wrtComp(i), SetVM, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + ! call into wrtComp(i) SetServices call ESMF_GridCompSetServices(wrtComp(i), wrtSS, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -550,7 +476,7 @@ subroutine InitializeAdvertise(gcomp, rc) ! call into wrtComp(i) Initialize call ESMF_GridCompInitialize(wrtComp(i), importState=wrtstate(i), & - clock=clock_fv3, phase=1, userRc=urc, rc=rc) + clock=clock, phase=1, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -603,10 +529,8 @@ subroutine InitializeAdvertise(gcomp, rc) if (i==1) then ! this is a Store() for the first wrtComp -> must do the Store() - timewri = MPI_Wtime() - - call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,i), & - regridMethod=regridmethod, routehandle=routehandle(j,i), & + call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,1), & + regridMethod=regridmethod, routehandle=routehandle(j,1), & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & srcTermProcessing=isrcTermProcessing, rc=rc) @@ -633,10 +557,10 @@ subroutine InitializeAdvertise(gcomp, rc) endif write(msgString,"(A,I2.2,',',I2.2,A)") "... returned from wrtFB(",j,i, ") FieldBundleRegridStore()." call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - enddo + enddo ! j=1, FBcount ! end write_groups - enddo + enddo ! i=1, write_groups if(mype==0) print *,'in fv3cap init, time wrtcrt/regrdst',MPI_Wtime()-timerhs deallocate(petList) deallocate(originPetList) @@ -660,7 +584,7 @@ subroutine InitializeAdvertise(gcomp, rc) !--- use nsout for output frequency nsout*dt_atmos nfh = 0 if( nfhmax > output_startfh ) nfh = nint((nfhmax-output_startfh)/(nsout*dt_atmos/3600.))+1 - if(nfh >0) then + if(nfh >0) then allocate(output_fh(nfh)) if( output_startfh == 0) then output_fh(1) = dt_atmos/3600. @@ -746,7 +670,7 @@ subroutine InitializeAdvertise(gcomp, rc) endif do i=2,nfh output_fh(i) = (i-1)*outputfh2(1) + output_startfh - ! Except fh000, which is the first time output, if any other of the + ! Except fh000, which is the first time output, if any other of the ! output time is not integer hour, set lflname_fulltime to be true, so the ! history file names will contain the full time stamp (HHH-MM-SS). if(.not.lflname_fulltime) then @@ -764,7 +688,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if( output_startfh == 0) then ! If the output time in output_fh array contains first time stamp output, - ! check the rest of output time, otherwise, check all the output time. + ! check the rest of output time, otherwise, check all the output time. ! If any of them is not integer hour, the history file names will ! contain the full time stamp (HHH-MM-SS) ist = 1 @@ -790,7 +714,7 @@ subroutine InitializeAdvertise(gcomp, rc) endif endif endif ! end loutput_fh - endif + endif if(mype==0) print *,'output_fh=',output_fh(1:size(output_fh)),'lflname_fulltime=',lflname_fulltime ! ! --- advertise Fields in importState and exportState ------------------- @@ -824,10 +748,9 @@ subroutine InitializeRealize(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname='(fv3gfs_cap:InitializeRealize)' - type(ESMF_State) :: importState, exportState - logical :: isPetLocal - integer :: n + character(len=*),parameter :: subname='(fv3gfs_cap:InitializeRealize)' + type(ESMF_State) :: importState, exportState + logical :: isPetLocal rc = ESMF_SUCCESS @@ -843,7 +766,7 @@ subroutine InitializeRealize(gcomp, rc) if (isPetLocal) then ! -- realize connected fields in exportState - call realizeConnectedCplFields(exportState, fcstGrid, & + call realizeConnectedCplFields(exportState, fcstGrid(mygrid), & numLevels, numSoilLayers, numTracers, & exportFieldsInfo, 'FV3 Export', exportFields, 0.0_ESMF_KIND_R8, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -853,7 +776,7 @@ subroutine InitializeRealize(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! -- realize connected fields in importState - call realizeConnectedCplFields(importState, fcstGrid, & + call realizeConnectedCplFields(importState, fcstGrid(mygrid), & numLevels, numSoilLayers, numTracers, & importFieldsInfo, 'FV3 Import', importFields, 9.99e20_ESMF_KIND_R8, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -869,88 +792,18 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime, startTime, stopTime - type(ESMF_TimeInterval) :: timeStep - - integer :: i, urc - character(len=*),parameter :: subname='(fv3_cap:ModelAdvance)' - character(240) :: msgString - character(240) :: startTime_str, currTime_str, stopTime_str, timeStep_str - !----------------------------------------------------------------------------- rc = ESMF_SUCCESS if (profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance: ") - ! Because of the way that the internal Clock was set in SetClock(), - ! its timeStep is likely smaller than the parent timeStep. As a consequence - ! the time interval covered by a single parent timeStep will result in - ! multiple calls to the ModelAdvance() routine. Every time the currTime - ! will come in by one internal timeStep advanced. This goes until the - ! stopTime of the internal Clock has been reached. - - call ESMF_ClockPrint(clock_fv3, options="currTime", & - preString="------>Advancing FV3 from: ", unit=msgString, rc=rc) + call ModelAdvance_phase1(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ModelAdvance_phase2(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -!----------------------------------------------------------------------- -!*** Use the internal Clock set by NUOPC layer for FV3 but update stopTime -!----------------------------------------------------------------------- - - ! Component internal Clock gets updated per NUOPC rules - call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! The stopTime will be updated to be the next coupling time - call ESMF_ClockGet(clock, currTime=currTime, stopTime=stopTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! Set the coupling time to be stopTime in Clock that FV3 core uses - call ESMF_ClockSet(clock_fv3, currTime=currTime, stopTime=stopTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_ClockPrint(clock_fv3, options="currTime", & - preString="entering FV3_ADVANCE with clock_fv3 current: ", & - unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - call ESMF_ClockPrint(clock_fv3, options="startTime", & - preString="entering FV3_ADVANCE with clock_fv3 start: ", & - unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - call ESMF_ClockPrint(clock_fv3, options="stopTime", & - preString="entering FV3_ADVANCE with clock_fv3 stop: ", & - unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - - ! call ESMF_ClockGet(clock_fv3, startTime=startTime, currTime=currTime, & - ! timeStep=timeStep, stopTime=stopTime, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! call ESMF_TimeGet(startTime, timestring=startTime_str, rc=rc) - ! call ESMF_TimeGet(currTime, timestring=currTime_str, rc=rc) - ! call ESMF_TimeGet(stopTime, timestring=stopTime_str, rc=rc) - ! call ESMF_TimeIntervalGet(timeStep, timestring=timeStep_str, rc=rc) - -! -!----------------------------------------------------------------------------- -!*** integration loop - - integrate: do while(.NOT.ESMF_ClockIsStopTime(clock_fv3, rc=rc)) - - call ModelAdvance_phase1(gcomp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ModelAdvance_phase2(gcomp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - enddo integrate -! if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance: ") end subroutine ModelAdvance @@ -962,105 +815,42 @@ subroutine ModelAdvance_phase1(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime, stopTime - integer :: urc logical :: fcstpe character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase1)' character(240) :: msgString - integer :: date(6) - !----------------------------------------------------------------------------- rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase1: ") - fcstpe = .false. - if( mype < num_pes_fcst ) fcstpe = .true. - - ! Expecting to be called by NUOPC run method exactly once for every coupling - ! step. - ! Also expecting the coupling step to be identical to the timeStep for - ! clock_fv3. - - call ESMF_ClockPrint(clock_fv3, options="currTime", & - preString="------>Advancing FV3 phase1 from: ", unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - -!----------------------------------------------------------------------- -!*** Use the internal Clock set by NUOPC layer for FV3 but update stopTime -!----------------------------------------------------------------------- - - ! Component internal Clock gets updated per NUOPC rules call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! The stopTime will be updated to be the next external coupling time - call ESMF_ClockGet(clock, currTime=currTime, stopTime=stopTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! Set the FV3-OCN coupling time to be stopTime in Clock that FV3 core uses - !call ESMF_ClockSet(clock_fv3, currTime=currTime, stopTime=stopTime, rc=rc) - call ESMF_ClockSet(clock_fv3, stopTime=stopTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_ClockPrint(clock_fv3, options="currTime", & - preString="entering FV3_ADVANCE phase1 with clock_fv3 current: ", & + call ESMF_ClockPrint(clock, options="currTime", & + preString="entering FV3_ADVANCE phase1 with clock current: ", & unit=msgString) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - call ESMF_ClockPrint(clock_fv3, options="startTime", & - preString="entering FV3_ADVANCE phase1 with clock_fv3 start: ", & + call ESMF_ClockPrint(clock, options="startTime", & + preString="entering FV3_ADVANCE phase1 with clock start: ", & unit=msgString) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - call ESMF_ClockPrint(clock_fv3, options="stopTime", & - preString="entering FV3_ADVANCE phase1 with clock_fv3 stop: ", & + call ESMF_ClockPrint(clock, options="stopTime", & + preString="entering FV3_ADVANCE phase1 with clock stop: ", & unit=msgString) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - call ESMF_ClockGet(clock_fv3, startTime=startTime, currTime=currTime, & - timeStep=timeStep, stopTime=stopTime, rc=rc) + call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock, phase=1, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - -! if(mype==0) print *,'total steps=', nint((stopTime-startTime)/timeStep) -! if(mype==lead_wrttask(1)) print *,'on wrt lead,total steps=', nint((stopTime-startTime)/timeStep) - call ESMF_TimeGet(time=stopTime,yy=date(1),mm=date(2),dd=date(3),h=date(4), & - m=date(5),s=date(6),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! if(mype==0) print *,'af clock,stop date=',date -! if(mype==lead_wrttask(1)) print *,'on wrt lead,af clock,stop date=',date - call ESMF_TimeIntervalGet(timeStep,yy=date(1),mm=date(2),d=date(3),h=date(4), & - m=date(5),s=date(6),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! if(mype==0) print *,'af clock,timestep date=',date -! if(mype==lead_wrttask(1)) print *,'on wrt lead,af clock,timestep date=',date - - call ESMF_LogWrite('Model Advance phase1: before fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock_fv3, & - phase=1, userRc=urc, rc=rc) - if (rc /= ESMF_SUCCESS) then - if(mype==0) print *,'after fcstComp phase1 rc=',rc - endif - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call ESMF_LogWrite('Model Advance phase1: after fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! assign import_data called during phase=1 if( dbug > 0 .or. cplprint_flag ) then - call diagnose_cplFields(gcomp, clock_fv3, fcstpe, cplprint_flag, dbug, 'import') + fcstpe = .false. + if( mype < num_pes_fcst ) fcstpe = .true. + call diagnose_cplFields(gcomp, clock, fcstpe, cplprint_flag, dbug, 'import') endif if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase1: ") @@ -1074,73 +864,63 @@ subroutine ModelAdvance_phase2(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime, stopTime + type(ESMF_Time) :: startTime type(ESMF_TimeInterval) :: time_elapsed - integer :: na, i, urc + integer :: na, j, urc integer :: nfseconds logical :: fcstpe character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase2)' character(240) :: msgString - real(kind=8) :: MPI_Wtime - real(kind=8) :: timewri, timerhi, timerh + + type(ESMF_Clock) :: clock, clock_out !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase2: ") - fcstpe = .false. - if( mype < num_pes_fcst ) fcstpe = .true. -! - timewri = MPI_Wtime() - call ESMF_LogWrite('Model Advance phase2: before fcstComp run phase2', ESMF_LOGMSG_INFO, rc=rc) + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock_fv3, & - phase=2, userRc=urc, rc=rc) - + call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock, phase=2, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call ESMF_LogWrite('Model Advance phase2: after fcstComp run phase2', ESMF_LOGMSG_INFO, rc=rc) + clock_out = ESMF_ClockCreate(clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ClockAdvance(clock = clock_fv3, rc = RC) + call ESMF_ClockAdvance(clock_out, rc = RC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ClockGet(clock_fv3, startTime=startTime, currTime=currTime, & - timeStep=timeStep, stopTime=stopTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - time_elapsed = currtime - starttime - na = nint(time_elapsed/timeStep) - call ESMF_TimeIntervalGet(time_elapsed, s=nfseconds, rc=rc) -! - if(mype==0) print *,'n fv3_cap,in model run, advance,na=',na - !------------------------------------------------------------------------------- !*** if it is output time, call data transfer and write grid comp run if( quilting ) then + call ESMF_ClockGet(clock_out, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + time_elapsed = currTime - startTime + na = nint(time_elapsed/timeStep) + call ESMF_TimeIntervalGet(time_elapsed, s=nfseconds, rc=rc) + output: if (ANY(nint(output_fh(:)*3600.0) == nfseconds)) then ! if (mype == 0 .or. mype == lead_wrttask(1)) print *,' aft fcst run output time=',nfseconds, & 'FBcount=',FBcount,'na=',na - timerhi = MPI_Wtime() call ESMF_VMEpochEnter(epoch=ESMF_VMEpoch_Buffer, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - do i=1, FBCount + do j=1, FBCount - call ESMF_FieldBundleRegrid(fcstFB(i), wrtFB(i,n_group), & - routehandle=routehandle(i, n_group), & + call ESMF_FieldBundleRegrid(fcstFB(j), wrtFB(j,n_group), & + routehandle=routehandle(j, n_group), & termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! @@ -1149,15 +929,10 @@ subroutine ModelAdvance_phase2(gcomp, rc) call ESMF_VMEpochExit(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! if(mype==0 .or. mype==lead_wrttask(1)) print *,'on wrt bf wrt run, na=',na call ESMF_LogWrite('Model Advance: before wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - timerhi = MPI_Wtime() - call ESMF_GridCompRun(wrtComp(n_group), importState=wrtState(n_group), clock=clock_fv3,userRc=urc,rc=rc) - - timerh = MPI_Wtime() - + call ESMF_GridCompRun(wrtComp(n_group), importState=wrtState(n_group), clock=clock_out, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -1174,28 +949,63 @@ subroutine ModelAdvance_phase2(gcomp, rc) endif ! quilting -!jw check clock - call ESMF_ClockPrint(clock_fv3, options="currTime", & - preString="leaving FV3_ADVANCE phase2 with clock_fv3 current: ", & + call ESMF_ClockPrint(clock, options="currTime", & + preString="leaving FV3_ADVANCE phase2 with clock current: ", & unit=msgString) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - call ESMF_ClockPrint(clock_fv3, options="startTime", & - preString="leaving FV3_ADVANCE phase2 with clock_fv3 start: ", & + call ESMF_ClockPrint(clock, options="startTime", & + preString="leaving FV3_ADVANCE phase2 with clock start: ", & unit=msgString) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - call ESMF_ClockPrint(clock_fv3, options="stopTime", & - preString="leaving FV3_ADVANCE phase2 with clock_fv3 stop: ", & + call ESMF_ClockPrint(clock, options="stopTime", & + preString="leaving FV3_ADVANCE phase2 with clock stop: ", & unit=msgString) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) if( dbug > 0 .or. cplprint_flag ) then - call diagnose_cplFields(gcomp, clock_fv3, fcstpe, cplprint_flag, dbug, 'export') + fcstpe = .false. + if( mype < num_pes_fcst ) fcstpe = .true. + call diagnose_cplFields(gcomp, clock_out, fcstpe, cplprint_flag, dbug, 'export') end if if(profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase2: ") end subroutine ModelAdvance_phase2 +!----------------------------------------------------------------------------- + + subroutine ModelSetRunClock(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: dclock, mclock + type(ESMF_TimeInterval) :: dtimestep, mtimestep + type(ESMF_Time) :: mcurrtime, mstoptime + +!----------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_ClockGet(dclock, timeStep=dtimestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ClockGet(mclock, currTime=mcurrtime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_TimeIntervalSet(mtimestep,s=dt_atmos,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + mstoptime = mcurrtime + dtimestep + + call ESMF_ClockSet(mclock, timeStep=mtimestep, stopTime=mstoptime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine ModelSetRunClock + !----------------------------------------------------------------------------- subroutine fv3_checkimport(gcomp, rc) @@ -1218,6 +1028,8 @@ subroutine fv3_checkimport(gcomp, rc) character(esmf_maxstr) :: msgString integer :: date(6) + rc = ESMF_SUCCESS + ! query the Component for its clock call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1323,7 +1135,7 @@ subroutine ModelFinalize(gcomp, rc) ! local variables character(len=*),parameter :: subname='(fv3gfs_cap:ModelFinalize)' - integer :: i, unit, urc + integer :: i, urc type(ESMF_VM) :: vm real(kind=8) :: MPI_Wtime, timeffs ! @@ -1334,6 +1146,7 @@ subroutine ModelFinalize(gcomp, rc) rc = ESMF_SUCCESS ! call ESMF_GridCompGet(gcomp,vm=vm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! !*** finalize grid comps if( quilting ) then diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 3827ccb68..041a2d46b 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -196,7 +196,7 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) nsfcprop2d = nsfcprop2d + 16 endif - allocate (temp2d(isc:iec,jsc:jec,nsfcprop2d+Model%ntot3d+Model%nctp)) + allocate (temp2d(isc:iec,jsc:jec,nsfcprop2d+Model%ntot2d+Model%nctp)) allocate (temp3d(isc:iec,jsc:jec,1:lev,14+Model%ntot3d+2*ntr)) allocate (temp3dlevsp1(isc:iec,jsc:jec,1:lev+1,3)) @@ -1462,7 +1462,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) if (Sfcprop(nb)%landfrac(ix) > zero) then - tem = one / Sfcprop(nb)%landfrac(ix) + tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) Sfcprop(nb)%snodl(ix) = Sfcprop(nb)%snowd(ix) * tem else Sfcprop(nb)%snodl(ix) = zero @@ -1477,7 +1477,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) if (Sfcprop(nb)%landfrac(ix) > zero) then - tem = one / Sfcprop(nb)%landfrac(ix) + tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) Sfcprop(nb)%weasdl(ix) = Sfcprop(nb)%weasd(ix) * tem else Sfcprop(nb)%weasdl(ix) = zero @@ -1501,7 +1501,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%zorlw(ix) = Sfcprop(nb)%zorl(ix) !--- compute zorlw from existing variables + if (Sfcprop(nb)%landfrac(ix) < one .and. Sfcprop(nb)%fice(ix) < one) then + Sfcprop(nb)%zorlw(ix) = min(Sfcprop(nb)%zorl(ix), 0.317) + endif enddo enddo endif @@ -1521,7 +1523,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorl(ix) !--- compute zorli from existing variables + if (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix)) > zero) then + Sfcprop(nb)%zorli(ix) = one + endif enddo enddo endif @@ -1547,6 +1551,36 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo endif + if (sfc_var2(i,j,47) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing snodi') +!$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%fice(ix) > zero) then + tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) + Sfcprop(nb)%snodi(ix) = min(Sfcprop(nb)%snowd(ix) * tem, 3.0) + else + Sfcprop(nb)%snodi(ix) = zero + endif + enddo + enddo + endif + + if (sfc_var2(i,j,48) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing weasdi') +!$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%fice(ix) > zero) then + tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) + Sfcprop(nb)%weasdi(ix) = Sfcprop(nb)%weasd(ix)*tem + else + Sfcprop(nb)%weasdi(ix) = zero + endif + enddo + enddo + endif + if (Model%use_cice_alb) then if (sfc_var2(i,j,49) < -9990.0_r8) then !$omp parallel do default(shared) private(nb, ix) @@ -3047,7 +3081,7 @@ end subroutine store_data3D ! #ifdef use_WRTCOMP - subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nbdlphys) + subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nbdlphys, rc) ! !------------------------------------------------------------- !*** set esmf bundle for phys output fields @@ -3058,15 +3092,17 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb ! implicit none ! - type(GFS_externaldiag_type),intent(in) :: Diag(:) + type(GFS_externaldiag_type),intent(in) :: Diag(:) integer, intent(in) :: axes(:) type(ESMF_FieldBundle),intent(inout) :: phys_bundle(:) type(ESMF_Grid),intent(inout) :: fcst_grid logical,intent(in) :: quilting integer, intent(in) :: nbdlphys + integer,intent(out) :: rc + ! !*** local variables - integer i, j, k, n, rc, idx, ibdl, nbdl + integer i, j, k, n, idx, ibdl, nbdl integer id, axis_length, direction, edges, axis_typ integer num_attributes, num_field_dyn integer currdate(6) @@ -3099,7 +3135,7 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb !------------------------------------------------------------ ! allocate(bdl_intplmethod(nbdlphys), outputfile(nbdlphys)) - if(mpp_pe()==mpp_root_pe())print *,'in fv_phys bundle,nbdl=',nbdlphys + if(mpp_pe()==mpp_root_pe()) print *,'in fv_phys bundle,nbdl=',nbdlphys do ibdl = 1, nbdlphys loutputfile = .false. call ESMF_FieldBundleGet(phys_bundle(ibdl), name=physbdl_name,rc=rc) @@ -3178,14 +3214,14 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb allocate(udimList(udimCount)) call ESMF_AttributeGet(fcst_grid, convention="NetCDF", purpose="FV3", & name="vertical_dim_labels", valueList=udimList, rc=rc) -! if(mpp_pe()==mpp_root_pe())print *,'in fv3gfsio, vertical +! if(mpp_pe()==mpp_root_pe()) print *,'in fv3gfsio, vertical ! list=',udimList(1:udimCount),'rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return else - if(mpp_pe()==mpp_root_pe())print *,'in fv_dyn bundle,axis_name_vert=',axis_name_vert + if(mpp_pe()==mpp_root_pe()) print *,'in fv_dyn bundle,axis_name_vert=',axis_name_vert call ESMF_AttributeAdd(fcst_grid, convention="NetCDF", purpose="FV3", & attrList=(/"vertical_dim_labels"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -3193,6 +3229,7 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb name="vertical_dim_labels", valueList=axis_name_vert, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif + deallocate(axis_name_vert) endif !*** add attributes @@ -3207,13 +3244,13 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb direction, edges, Domain, DomainU, axis_data, & num_attributes=num_attributes, attributes=attributes) ! - edgesS='' + edgesS = '' do i = 1,num_axes_phys if(axes(i) == edges) edgesS=axis_name(i) enddo ! Add vertical dimension Attributes to Grid if( id>2 ) then -! if(mpp_pe()==mpp_root_pe())print *,' in dyn add grid, axis_name=', & +! if(mpp_pe()==mpp_root_pe()) print *,' in dyn add grid, axis_name=', & ! trim(axis_name(id)),'axis_data=',axis_data if(trim(edgesS)/='') then call ESMF_AttributeAdd(fcst_grid, convention="NetCDF", purpose="FV3", & @@ -3307,6 +3344,8 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb endif enddo + deallocate(axis_name) + deallocate(all_axes) end subroutine fv_phys_bundle_setup ! @@ -3415,62 +3454,62 @@ subroutine add_field_to_phybundle(var_name,long_name,units,cell_methods, axes,ph ! !*** add field attributes call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"long_name"/), rc=rc) + attrList=(/"long_name"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='long_name',value=trim(long_name),rc=rc) + name='long_name',value=trim(long_name),rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"units"/), rc=rc) + attrList=(/"units"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='units',value=trim(units),rc=rc) + name='units',value=trim(units),rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"missing_value"/), rc=rc) + attrList=(/"missing_value"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='missing_value',value=missing_value,rc=rc) + name='missing_value',value=missing_value,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"_FillValue"/), rc=rc) + attrList=(/"_FillValue"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='_FillValue',value=missing_value,rc=rc) + name='_FillValue',value=missing_value,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"cell_methods"/), rc=rc) + attrList=(/"cell_methods"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='cell_methods',value=trim(cell_methods),rc=rc) + name='cell_methods',value=trim(cell_methods),rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"output_file"/), rc=rc) + attrList=(/"output_file"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='output_file',value=trim(output_file),rc=rc) + name='output_file',value=trim(output_file),rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) diff --git a/io/inline_post.F90 b/io/inline_post.F90 index b51e2e7ac..2e123346e 100644 --- a/io/inline_post.F90 +++ b/io/inline_post.F90 @@ -16,7 +16,7 @@ module inline_post contains - subroutine inline_post_run(wrt_int_state,mypei,mpicomp,lead_write, & + subroutine inline_post_run(wrt_int_state,grid_id,mypei,mpicomp,lead_write, & mynfhr,mynfmin,mynfsec) ! ! revision history: @@ -30,6 +30,7 @@ subroutine inline_post_run(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! type(wrt_internal_state),intent(in) :: wrt_int_state + integer,intent(in) :: grid_id integer,intent(in) :: mypei integer,intent(in) :: mpicomp integer,intent(in) :: lead_write @@ -37,14 +38,14 @@ subroutine inline_post_run(wrt_int_state,mypei,mpicomp,lead_write, & integer,intent(in) :: mynfmin integer,intent(in) :: mynfsec ! - if(mypei == 0) print *,'inline_post_run, output_grid=',trim(output_grid) - if(trim(output_grid) == 'gaussian_grid' & - .or. trim(output_grid) == 'global_latlon') then + if(mypei == 0) print *,'inline_post_run, output_grid=',trim(output_grid(grid_id)) + if(trim(output_grid(grid_id)) == 'gaussian_grid' & + .or. trim(output_grid(grid_id)) == 'global_latlon') then call post_run_gfs(wrt_int_state, mypei, mpicomp, lead_write, & mynfhr, mynfmin,mynfsec) - else if( trim(output_grid) == 'regional_latlon' & - .or. trim(output_grid) == 'rotated_latlon' & - .or. trim(output_grid) == 'lambert_conformal') then + else if( trim(output_grid(grid_id)) == 'regional_latlon' & + .or. trim(output_grid(grid_id)) == 'rotated_latlon' & + .or. trim(output_grid(grid_id)) == 'lambert_conformal') then if(mypei == 0) print *,'inline_post_run, call post_run_regional' call post_run_regional(wrt_int_state, mypei, mpicomp, lead_write, & mynfhr, mynfmin,mynfsec) @@ -55,21 +56,22 @@ end subroutine inline_post_run ! !----------------------------------------------------------------------- ! - subroutine inline_post_getattr(wrt_int_state) + subroutine inline_post_getattr(wrt_int_state,grid_id) ! use esmf ! implicit none ! type(wrt_internal_state),intent(inout) :: wrt_int_state + integer, intent(in) :: grid_id ! - if(trim(output_grid) == 'gaussian_grid' & - .or. trim(output_grid) == 'global_latlon') then + if(trim(output_grid(grid_id)) == 'gaussian_grid' & + .or. trim(output_grid(grid_id)) == 'global_latlon') then call post_getattr_gfs(wrt_int_state) - else if( trim(output_grid) == 'regional_latlon' & - .or. trim(output_grid) == 'rotated_latlon' & - .or. trim(output_grid) == 'lambert_conformal') then - call post_getattr_regional(wrt_int_state) + else if( trim(output_grid(grid_id)) == 'regional_latlon' & + .or. trim(output_grid(grid_id)) == 'rotated_latlon' & + .or. trim(output_grid(grid_id)) == 'lambert_conformal') then + call post_getattr_regional(wrt_int_state,grid_id) endif ! end subroutine inline_post_getattr diff --git a/io/module_fv3_io_def.F90 b/io/module_fv3_io_def.F90 index 65d2b926b..dda5310ad 100644 --- a/io/module_fv3_io_def.F90 +++ b/io/module_fv3_io_def.F90 @@ -1,4 +1,4 @@ - module module_fv3_io_def +module module_fv3_io_def ! !*** fv3 io related configration variables ! @@ -9,24 +9,26 @@ module module_fv3_io_def ! use esmf, only : esmf_maxstr implicit none -! + integer :: num_pes_fcst integer :: wrttasks_per_group, write_groups integer :: n_group integer :: num_files - character(len=esmf_maxstr) :: app_domain - character(len=esmf_maxstr) :: output_grid - integer :: imo,jmo - integer :: ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d integer :: nbdlphys - integer :: nsout_io, iau_offset, ideflate, nbits + integer :: nsout_io, iau_offset logical :: lflname_fulltime - real :: cen_lon, cen_lat, lon1, lat1, lon2, lat2, dlon, dlat - real :: stdlat1, stdlat2, dx, dy + character(len=esmf_maxstr),dimension(:),allocatable :: filename_base character(len=esmf_maxstr),dimension(:),allocatable :: output_file -! + integer,dimension(:),allocatable :: lead_wrttask, last_wrttask -! - end module module_fv3_io_def + character(len=esmf_maxstr),dimension(:),allocatable :: output_grid + integer,dimension(:),allocatable :: imo,jmo + real,dimension(:),allocatable :: cen_lon, cen_lat + real,dimension(:),allocatable :: lon1, lat1, lon2, lat2, dlon, dlat + real,dimension(:),allocatable :: stdlat1, stdlat2, dx, dy + integer,dimension(:),allocatable :: ideflate, nbits + integer,dimension(:),allocatable :: ichunk2d, jchunk2d, ichunk3d, jchunk3d, kchunk3d + +end module module_fv3_io_def diff --git a/io/module_write_internal_state.F90 b/io/module_write_internal_state.F90 index e396063c9..9c9ebbe26 100644 --- a/io/module_write_internal_state.F90 +++ b/io/module_write_internal_state.F90 @@ -49,8 +49,8 @@ module write_internal_state integer :: lat_start, lon_start integer :: lat_end, lon_end real :: latstart, latlast, lonstart, lonlast - integer,dimension(:),allocatable :: lat_start_wrtgrp - integer,dimension(:),allocatable :: lat_end_wrtgrp + integer,dimension(:),allocatable :: lat_start_wrtgrp, lon_start_wrtgrp + integer,dimension(:),allocatable :: lat_end_wrtgrp, lon_end_wrtgrp real,dimension(:,:),allocatable :: lonPtr, latPtr ! !-------------------------- diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index 30959e625..1445d5e04 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -1,7 +1,8 @@ -#define ESMF_ERR_RETURN(rc) if (ESMF_LogFoundError(rc, msg="Breaking out of subroutine", line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) +#define ESMF_ERR_RETURN(rc) \ + if (ESMF_LogFoundError(rc, msg="Breaking out of subroutine", line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) #define NC_ERR_STOP(status) \ - if (status /= nf90_noerr) write(0,*) "line ", __LINE__, trim(nf90_strerror(status)); \ + if (status /= nf90_noerr) write(0,*) "file: ", __FILE__, " line: ", __LINE__, trim(nf90_strerror(status)); \ if (status /= nf90_noerr) call ESMF_Finalize(endflag=ESMF_END_ABORT) module module_write_netcdf @@ -9,84 +10,159 @@ module module_write_netcdf use esmf use netcdf use module_fv3_io_def,only : ideflate, nbits, & + ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d, & output_grid,dx,dy,lon1,lat1,lon2,lat2 + use mpi implicit none private public write_netcdf + logical :: par + + interface quantize_array + module procedure quantize_array_3d + module procedure quantize_array_4d + end interface + contains !---------------------------------------------------------------------------------------- - subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d, rc) + subroutine write_netcdf(wrtfb, filename, & + use_parallel_netcdf, mpi_comm, mype, & + grid_id, rc) ! - type(ESMF_FieldBundle), intent(in) :: fieldbundle type(ESMF_FieldBundle), intent(in) :: wrtfb character(*), intent(in) :: filename + logical, intent(in) :: use_parallel_netcdf integer, intent(in) :: mpi_comm integer, intent(in) :: mype - integer, intent(in) :: im, jm - integer, intent(in) :: ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d + integer, intent(in) :: grid_id integer, optional,intent(out) :: rc ! !** local vars - integer :: i,j,m,n,k - integer :: lm + integer :: i,j,t, istart,iend,jstart,jend + integer :: im, jm, lm + + integer, dimension(:), allocatable :: fldlev + + real(ESMF_KIND_R4), dimension(:,:), pointer :: array_r4 + real(ESMF_KIND_R4), dimension(:,:,:), pointer :: array_r4_cube + real(ESMF_KIND_R4), dimension(:,:,:), pointer :: array_r4_3d + real(ESMF_KIND_R4), dimension(:,:,:,:), pointer :: array_r4_3d_cube - integer, dimension(:), allocatable :: fldlev - real(4), dimension(:,:), allocatable :: arrayr4 - real(8), dimension(:,:), allocatable :: arrayr8 - real(4), dimension(:,:,:), allocatable :: arrayr4_3d,arrayr4_3d_save - real(8), dimension(:,:,:), allocatable :: arrayr8_3d + real(ESMF_KIND_R8), dimension(:,:), pointer :: array_r8 + real(ESMF_KIND_R8), dimension(:,:,:), pointer :: array_r8_cube + real(ESMF_KIND_R8), dimension(:,:,:), pointer :: array_r8_3d + real(ESMF_KIND_R8), dimension(:,:,:,:), pointer :: array_r8_3d_cube - real(8) x(im),y(jm) + real(8), dimension(:), allocatable :: x,y integer :: fieldCount, fieldDimCount, gridDimCount integer, dimension(:), allocatable :: ungriddedLBound, ungriddedUBound + integer, dimension(:), allocatable :: start_idx type(ESMF_Field), allocatable :: fcstField(:) type(ESMF_TypeKind_Flag) :: typekind type(ESMF_TypeKind_Flag) :: attTypeKind type(ESMF_Grid) :: wrtgrid type(ESMF_Array) :: array + type(ESMF_DistGrid) :: distgrid - integer :: attcount + integer :: attCount character(len=ESMF_MAXSTR) :: attName, fldName integer :: varival - real(4) :: varr4val, scale_fact, offset, dataMin, dataMax + real(4) :: varr4val, dataMin, dataMax real(4), allocatable, dimension(:) :: compress_err real(8) :: varr8val character(len=ESMF_MAXSTR) :: varcval - character(128) :: time_units - - integer :: ncerr + integer :: ncerr,ierr integer :: ncid integer :: oldMode - integer :: im_dimid, jm_dimid, pfull_dimid, phalf_dimid, time_dimid - integer :: im_varid, jm_varid, lm_varid, time_varid, lon_varid, lat_varid + integer :: im_dimid, jm_dimid, tile_dimid, pfull_dimid, phalf_dimid, time_dimid + integer :: im_varid, jm_varid, tile_varid, lon_varid, lat_varid + integer, dimension(:), allocatable :: dimids_2d, dimids_3d integer, dimension(:), allocatable :: varids logical shuffle - call ESMF_FieldBundleGet(fieldbundle, fieldCount=fieldCount, rc=rc); ESMF_ERR_RETURN(rc) + logical :: is_cubed_sphere + integer :: rank, deCount, localDeCount, dimCount, tileCount + integer :: my_tile, start_i, start_j + integer, dimension(:,:), allocatable :: minIndexPDe, maxIndexPDe + integer, dimension(:,:), allocatable :: minIndexPTile, maxIndexPTile + integer, dimension(:), allocatable :: deToTileMap, localDeToDeMap + logical :: do_io + integer :: par_access +! + is_cubed_sphere = .false. + tileCount = 0 + my_tile = 0 + start_i = -10000000 + start_j = -10000000 + + par = use_parallel_netcdf + do_io = par .or. (mype==0) + + call ESMF_FieldBundleGet(wrtfb, fieldCount=fieldCount, rc=rc); ESMF_ERR_RETURN(rc) allocate(compress_err(fieldCount)); compress_err=-999. allocate(fldlev(fieldCount)) ; fldlev = 0 allocate(fcstField(fieldCount)) allocate(varids(fieldCount)) - call ESMF_FieldBundleGet(fieldbundle, fieldList=fcstField, grid=wrtGrid, & + call ESMF_FieldBundleGet(wrtfb, fieldList=fcstField, grid=wrtGrid, & ! itemorderflag=ESMF_ITEMORDER_ADDORDER, & rc=rc); ESMF_ERR_RETURN(rc) call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc); ESMF_ERR_RETURN(rc) do i=1,fieldCount - call ESMF_FieldGet(fcstField(i), dimCount=fieldDimCount, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_FieldGet(fcstField(i), dimCount=fieldDimCount, array=array, rc=rc); ESMF_ERR_RETURN(rc) + if (fieldDimCount > 3) then write(0,*)"write_netcdf: Only 2D and 3D fields are supported!" - stop + call ESMF_Finalize(endflag=ESMF_END_ABORT) end if + + ! use first field to determine tile number, grid size, start index etc. + if (i == 1) then + call ESMF_ArrayGet(array, & + distgrid=distgrid, & + dimCount=dimCount, & + deCount=deCount, & + localDeCount=localDeCount, & + tileCount=tileCount, & + rc=rc); ESMF_ERR_RETURN(rc) + + allocate(minIndexPDe(dimCount,deCount)) + allocate(maxIndexPDe(dimCount,deCount)) + allocate(minIndexPTile(dimCount, tileCount)) + allocate(maxIndexPTile(dimCount, tileCount)) + call ESMF_DistGridGet(distgrid, & + minIndexPDe=minIndexPDe, maxIndexPDe=maxIndexPDe, & + minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, & + rc=rc); ESMF_ERR_RETURN(rc) + + allocate(deToTileMap(deCount)) + allocate(localDeToDeMap(localDeCount)) + call ESMF_ArrayGet(array, & + deToTileMap=deToTileMap, & + localDeToDeMap=localDeToDeMap, & + rc=rc); ESMF_ERR_RETURN(rc) + + is_cubed_sphere = (tileCount == 6) + my_tile = deToTileMap(localDeToDeMap(1)+1) + im = maxIndexPTile(1,1) + jm = maxIndexPTile(2,1) + start_i = minIndexPDe(1,localDeToDeMap(1)+1) + start_j = minIndexPDe(2,localDeToDeMap(1)+1) + if (.not. par) then + start_i = 1 + start_j = 1 + end if + end if + if (fieldDimCount > gridDimCount) then allocate(ungriddedLBound(fieldDimCount-gridDimCount)) allocate(ungriddedUBound(fieldDimCount-gridDimCount)) @@ -104,301 +180,559 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, ic lm = maxval(fldlev(:)) - allocate(arrayr4(im,jm)) - allocate(arrayr8(im,jm)) - allocate(arrayr4_3d(im,jm,lm),arrayr4_3d_save(im,jm,lm)) - allocate(arrayr8_3d(im,jm,lm)) - -! create netcdf file and enter define mode - if (mype==0) then - - ncerr = nf90_create(trim(filename),& - cmode=IOR(IOR(NF90_CLOBBER,NF90_NETCDF4),NF90_CLASSIC_MODEL),& - ncid=ncid); NC_ERR_STOP(ncerr) - ncerr = nf90_set_fill(ncid, NF90_NOFILL, oldMode); NC_ERR_STOP(ncerr) - - ! define dimensions - ncerr = nf90_def_dim(ncid, "grid_xt", im, im_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_dim(ncid, "grid_yt", jm, jm_dimid); NC_ERR_STOP(ncerr) - ! define coordinate variables - ncerr = nf90_def_var(ncid, "grid_xt", NF90_DOUBLE, im_dimid, im_varid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "lon", NF90_DOUBLE, (/im_dimid,jm_dimid/), lon_varid); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, lon_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, lon_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, im_varid, "cartesian_axis", "X"); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "grid_yt", NF90_DOUBLE, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "lat", NF90_DOUBLE, (/im_dimid,jm_dimid/), lat_varid); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, lat_varid, "long_name", "T-cell latitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, lat_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "cartesian_axis", "Y"); NC_ERR_STOP(ncerr) - - if (lm > 1) then - call add_dim(ncid, "pfull", pfull_dimid, wrtgrid, rc) - call add_dim(ncid, "phalf", phalf_dimid, wrtgrid, rc) + ! for serial output allocate 'global' arrays + if (.not. par) then + allocate(array_r4(im,jm)) + allocate(array_r8(im,jm)) + allocate(array_r4_3d(im,jm,lm)) + allocate(array_r8_3d(im,jm,lm)) + if (is_cubed_sphere) then + allocate(array_r4_cube(im,jm,tileCount)) + allocate(array_r8_cube(im,jm,tileCount)) + allocate(array_r4_3d_cube(im,jm,lm,tileCount)) + allocate(array_r8_3d_cube(im,jm,lm,tileCount)) + end if end if - call add_dim(ncid, "time", time_dimid, wrtgrid, rc) + ! create netcdf file and enter define mode + if (do_io) then + + if (par) then + ncerr = nf90_create(trim(filename),& + cmode=IOR(IOR(NF90_CLOBBER,NF90_NETCDF4),NF90_CLASSIC_MODEL),& + comm=mpi_comm, info = MPI_INFO_NULL, ncid=ncid); NC_ERR_STOP(ncerr) + else + ncerr = nf90_create(trim(filename),& + cmode=IOR(IOR(NF90_CLOBBER,NF90_NETCDF4),NF90_CLASSIC_MODEL),& + ncid=ncid); NC_ERR_STOP(ncerr) + end if - call get_global_attr(wrtfb, ncid, rc) + ! disable auto filling. + ncerr = nf90_set_fill(ncid, NF90_NOFILL, oldMode); NC_ERR_STOP(ncerr) - do i=1, fieldCount - call ESMF_FieldGet(fcstField(i), name=fldName, typekind=typekind, rc=rc); ESMF_ERR_RETURN(rc) - - ! define variables - if (fldlev(i) == 1) then - if (typekind == ESMF_TYPEKIND_R4) then - if (ideflate > 0) then - if (ichunk2d < 0 .or. jchunk2d < 0) then - ! let netcdf lib choose chunksize - ! shuffle filter on for 2d fields (lossless compression) - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,time_dimid/), varids(i), & - shuffle=.true.,deflate_level=ideflate); NC_ERR_STOP(ncerr) - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,time_dimid/), varids(i), & - shuffle=.true.,deflate_level=ideflate,& - chunksizes=(/ichunk2d,jchunk2d,1/),cache_size=40*im*jm); NC_ERR_STOP(ncerr) - endif - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,time_dimid/), varids(i)); NC_ERR_STOP(ncerr) - endif - else if (typekind == ESMF_TYPEKIND_R8) then - ncerr = nf90_def_var(ncid, trim(fldName), NF90_DOUBLE, & - (/im_dimid,jm_dimid,time_dimid/), varids(i)); NC_ERR_STOP(ncerr) - else - write(0,*)'Unsupported typekind ', typekind - stop - end if - else if (fldlev(i) > 1) then - if (typekind == ESMF_TYPEKIND_R4) then - if (ideflate > 0) then - ! shuffle filter off for 3d fields using lossy compression - if (nbits > 0) then - shuffle=.false. + ! define dimensions [grid_xt, grid_yta ,(pfull/phalf), (tile), time] + ncerr = nf90_def_dim(ncid, "grid_xt", im, im_dimid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_dim(ncid, "grid_yt", jm, jm_dimid); NC_ERR_STOP(ncerr) + if (lm > 1) then + call add_dim(ncid, "pfull", pfull_dimid, wrtgrid, rc) + call add_dim(ncid, "phalf", phalf_dimid, wrtgrid, rc) + end if + if (is_cubed_sphere) then + ncerr = nf90_def_dim(ncid, "tile", tileCount, tile_dimid); NC_ERR_STOP(ncerr) + end if + call add_dim(ncid, "time", time_dimid, wrtgrid, rc) + + ! define coordinate variables + ncerr = nf90_def_var(ncid, "grid_xt", NF90_DOUBLE, im_dimid, im_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, im_varid, "cartesian_axis", "X"); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "grid_yt", NF90_DOUBLE, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, jm_varid, "cartesian_axis", "Y"); NC_ERR_STOP(ncerr) + if (is_cubed_sphere) then + ncerr = nf90_def_var(ncid, "tile", NF90_INT, tile_dimid, tile_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, tile_varid, "long_name", "cubed-spehere face"); NC_ERR_STOP(ncerr) + end if + + ! coordinate variable attributes based on output_grid type + if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & + trim(output_grid(grid_id)) == 'global_latlon' .or. & + trim(output_grid(grid_id)) == 'regional_latlon') then + ncerr = nf90_put_att(ncid, im_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, im_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, jm_varid, "long_name", "T-cell latiitude"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) + else if (trim(output_grid(grid_id)) == 'rotated_latlon') then + ncerr = nf90_put_att(ncid, im_varid, "long_name", "rotated T-cell longiitude"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, im_varid, "units", "degrees"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, jm_varid, "long_name", "rotated T-cell latiitude"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees"); NC_ERR_STOP(ncerr) + else if (trim(output_grid(grid_id)) == 'lambert_conformal') then + ncerr = nf90_put_att(ncid, im_varid, "long_name", "x-coordinate of projection"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, im_varid, "units", "meters"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, jm_varid, "long_name", "y-coordinate of projection"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, jm_varid, "units", "meters"); NC_ERR_STOP(ncerr) + end if + + ! define longitude variable + if (is_cubed_sphere) then + ncerr = nf90_def_var(ncid, "lon", NF90_DOUBLE, [im_dimid,jm_dimid,tile_dimid], lon_varid); NC_ERR_STOP(ncerr) + else + ncerr = nf90_def_var(ncid, "lon", NF90_DOUBLE, [im_dimid,jm_dimid ], lon_varid); NC_ERR_STOP(ncerr) + end if + ncerr = nf90_put_att(ncid, lon_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, lon_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr) + + ! define latitude variable + if (is_cubed_sphere) then + ncerr = nf90_def_var(ncid, "lat", NF90_DOUBLE, [im_dimid,jm_dimid,tile_dimid], lat_varid); NC_ERR_STOP(ncerr) + else + ncerr = nf90_def_var(ncid, "lat", NF90_DOUBLE, [im_dimid,jm_dimid ], lat_varid); NC_ERR_STOP(ncerr) + end if + ncerr = nf90_put_att(ncid, lat_varid, "long_name", "T-cell latitude"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, lat_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) + + if (par) then + ncerr = nf90_var_par_access(ncid, im_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) + ncerr = nf90_var_par_access(ncid, lon_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) + ncerr = nf90_var_par_access(ncid, jm_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) + ncerr = nf90_var_par_access(ncid, lat_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) + if (is_cubed_sphere) then + ncerr = nf90_var_par_access(ncid, tile_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) + end if + end if + + + call get_global_attr(wrtfb, ncid, rc) + + + ! define variables (fields) + if (is_cubed_sphere) then + allocate(dimids_2d(4)) + allocate(dimids_3d(5)) + dimids_2d = [im_dimid,jm_dimid, tile_dimid,time_dimid] + if (lm > 1) dimids_3d = [im_dimid,jm_dimid,pfull_dimid,tile_dimid,time_dimid] + else + allocate(dimids_2d(3)) + allocate(dimids_3d(4)) + dimids_2d = [im_dimid,jm_dimid, time_dimid] + if (lm > 1) dimids_3d = [im_dimid,jm_dimid,pfull_dimid, time_dimid] + end if + + do i=1, fieldCount + call ESMF_FieldGet(fcstField(i), name=fldName, rank=rank, typekind=typekind, rc=rc); ESMF_ERR_RETURN(rc) + + par_access = NF90_INDEPENDENT + ! define variables + if (rank == 2) then + if (typekind == ESMF_TYPEKIND_R4) then + if (ideflate(grid_id) > 0) then + if (ichunk2d(grid_id) < 0 .or. jchunk2d(grid_id) < 0) then + ! let netcdf lib choose chunksize + ! shuffle filter on for 2d fields (lossless compression) + ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & + dimids_2d, varids(i), & + shuffle=.true.,deflate_level=ideflate(grid_id)); NC_ERR_STOP(ncerr) + else + if (is_cubed_sphere) then + ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & + dimids_2d, varids(i), & + shuffle=.true.,deflate_level=ideflate(grid_id),& + chunksizes=[ichunk2d(grid_id),jchunk2d(grid_id),tileCount,1]); NC_ERR_STOP(ncerr) + else + ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & + dimids_2d, varids(i), & + shuffle=.true.,deflate_level=ideflate(grid_id),& + chunksizes=[ichunk2d(grid_id),jchunk2d(grid_id), 1]); NC_ERR_STOP(ncerr) + end if + end if + ! compression filters require collective access. + par_access = NF90_COLLECTIVE else - shuffle=.true. - endif - if (ichunk3d < 0 .or. jchunk3d < 0 .or. kchunk3d < 0) then - ! let netcdf lib choose chunksize - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,pfull_dimid,time_dimid/), varids(i), & - shuffle=shuffle,deflate_level=ideflate); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & + dimids_2d, varids(i)); NC_ERR_STOP(ncerr) + end if + else if (typekind == ESMF_TYPEKIND_R8) then + ncerr = nf90_def_var(ncid, trim(fldName), NF90_DOUBLE, & + dimids_2d, varids(i)); NC_ERR_STOP(ncerr) + else + write(0,*)'Unsupported typekind ', typekind + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + else if (rank == 3) then + if (typekind == ESMF_TYPEKIND_R4) then + if (ideflate(grid_id) > 0) then + ! shuffle filter off for 3d fields using lossy compression + if (nbits(grid_id) > 0) then + shuffle=.false. + else + shuffle=.true. + end if + if (ichunk3d(grid_id) < 0 .or. jchunk3d(grid_id) < 0 .or. kchunk3d(grid_id) < 0) then + ! let netcdf lib choose chunksize + ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & + dimids_3d, varids(i), & + shuffle=shuffle,deflate_level=ideflate(grid_id)); NC_ERR_STOP(ncerr) + else + if (is_cubed_sphere) then + ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & + dimids_3d, varids(i), & + shuffle=shuffle,deflate_level=ideflate(grid_id),& + chunksizes=[ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id),tileCount,1]); NC_ERR_STOP(ncerr) + else + ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & + dimids_3d, varids(i), & + shuffle=shuffle,deflate_level=ideflate(grid_id),& + chunksizes=[ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id), 1]); NC_ERR_STOP(ncerr) + end if + end if + ! compression filters require collective access. + par_access = NF90_COLLECTIVE else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,pfull_dimid,time_dimid/), varids(i), & - shuffle=shuffle,deflate_level=ideflate,& - chunksizes=(/ichunk3d,jchunk3d,kchunk3d,1/)); NC_ERR_STOP(ncerr) - endif + ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & + dimids_3d, varids(i)); NC_ERR_STOP(ncerr) + end if + else if (typekind == ESMF_TYPEKIND_R8) then + ncerr = nf90_def_var(ncid, trim(fldName), NF90_DOUBLE, & + dimids_3d, varids(i)); NC_ERR_STOP(ncerr) else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,pfull_dimid,time_dimid/), varids(i)); NC_ERR_STOP(ncerr) - endif - else if (typekind == ESMF_TYPEKIND_R8) then - ncerr = nf90_def_var(ncid, trim(fldName), NF90_DOUBLE, & - (/im_dimid,jm_dimid,pfull_dimid,time_dimid/), varids(i)); NC_ERR_STOP(ncerr) - else - write(0,*)'Unsupported typekind ', typekind - stop - end if - end if - - ! define variable attributes - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, & - rc=rc); ESMF_ERR_RETURN(rc) - - do j=1,attCount - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=j, & - name=attName, typekind=attTypeKind, itemCount=n, & - rc=rc); ESMF_ERR_RETURN(rc) + write(0,*)'Unsupported typekind ', typekind + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + else + write(0,*)'Unsupported rank ', rank + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + if (par) then + ncerr = nf90_var_par_access(ncid, varids(i), par_access); NC_ERR_STOP(ncerr) + end if - if ( index(trim(attName),"ESMF") /= 0 ) then - cycle - endif + ! define variable attributes + call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, count=attCount, & + rc=rc); ESMF_ERR_RETURN(rc) - if (attTypeKind==ESMF_TYPEKIND_I4) then + do j=1,attCount call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=j, & + name=attName, typekind=attTypeKind, & rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, varids(i), trim(attName), varival); NC_ERR_STOP(ncerr) - else if (attTypeKind==ESMF_TYPEKIND_R4) then - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, & - rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, varids(i), trim(attName), varr4val); NC_ERR_STOP(ncerr) + if (index(trim(attName),"ESMF") /= 0) then + cycle + end if - else if (attTypeKind==ESMF_TYPEKIND_R8) then - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr8val, & - rc=rc); ESMF_ERR_RETURN(rc) - if (trim(attName) /= '_FillValue') then - ! FIXME: _FillValue must be cast to var type for recent versions of netcdf - ncerr = nf90_put_att(ncid, varids(i), trim(attName), varr8val); NC_ERR_STOP(ncerr) - endif + if (attTypeKind==ESMF_TYPEKIND_I4) then + call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varival, & + rc=rc); ESMF_ERR_RETURN(rc) + ncerr = nf90_put_att(ncid, varids(i), trim(attName), varival); NC_ERR_STOP(ncerr) + + else if (attTypeKind==ESMF_TYPEKIND_R4) then + call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varr4val, & + rc=rc); ESMF_ERR_RETURN(rc) + ncerr = nf90_put_att(ncid, varids(i), trim(attName), varr4val); NC_ERR_STOP(ncerr) + + else if (attTypeKind==ESMF_TYPEKIND_R8) then + call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varr8val, & + rc=rc); ESMF_ERR_RETURN(rc) + if (trim(attName) /= '_FillValue') then + ! FIXME: _FillValue must be cast to var type when using NF90_NETCDF4 + ncerr = nf90_put_att(ncid, varids(i), trim(attName), varr8val); NC_ERR_STOP(ncerr) + end if + + else if (attTypeKind==ESMF_TYPEKIND_CHARACTER) then + call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varcval, & + rc=rc); ESMF_ERR_RETURN(rc) + ncerr = nf90_put_att(ncid, varids(i), trim(attName), trim(varcval)); NC_ERR_STOP(ncerr) - else if (attTypeKind==ESMF_TYPEKIND_CHARACTER) then - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varcval, & - rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, varids(i), trim(attName), trim(varcval)); NC_ERR_STOP(ncerr) - - end if - - end do ! j=1,attCount - - end do ! i=1,fieldCount - - ! write grid_xt, grid_yt attributes - if (trim(output_grid) == 'gaussian_grid' .or. & - trim(output_grid) == 'global_latlon' .or. & - trim(output_grid) == 'regional_latlon') then - ncerr = nf90_put_att(ncid, im_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, im_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "long_name", "T-cell latiitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'rotated_latlon') then - ncerr = nf90_put_att(ncid, im_varid, "long_name", "rotated T-cell longiitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, im_varid, "units", "degrees"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "long_name", "rotated T-cell latiitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees"); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'lambert_conformal') then - ncerr = nf90_put_att(ncid, im_varid, "long_name", "x-coordinate of projection"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, im_varid, "units", "meters"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "long_name", "y-coordinate of projection"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "units", "meters"); NC_ERR_STOP(ncerr) - endif - - ncerr = nf90_enddef(ncid); NC_ERR_STOP(ncerr) + end if + + end do ! j=1,attCount + + if (is_cubed_sphere) then + ncerr = nf90_put_att(ncid, varids(i), 'coordinates', 'lon lat'); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, varids(i), 'grid_mapping', 'cubed_sphere'); NC_ERR_STOP(ncerr) + end if + + end do ! i=1,fieldCount + + ncerr = nf90_enddef(ncid); NC_ERR_STOP(ncerr) + end if + ! end of define mode + + ! + ! write dimension variables and lon,lat variables + ! + if (allocated(start_idx)) deallocate(start_idx) + if (is_cubed_sphere) then + allocate(start_idx(3)) + start_idx = [start_i, start_j, my_tile] + else + allocate(start_idx(2)) + start_idx = [start_i, start_j] + end if + + ! write lon (lon_varid) + if (par) then + call ESMF_GridGetCoord(wrtGrid, coordDim=1, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) + ncerr = nf90_put_var(ncid, lon_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) + else + call ESMF_GridGetCoord(wrtGrid, coordDim=1, array=array, rc=rc); ESMF_ERR_RETURN(rc) + if (is_cubed_sphere) then + do t=1,tileCount + call ESMF_ArrayGather(array, array_r8_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) + end do + if (do_io) then + ncerr = nf90_put_var(ncid, lon_varid, values=array_r8_cube, start=start_idx); NC_ERR_STOP(ncerr) + end if + else + call ESMF_ArrayGather(array, array_r8, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) + if (do_io) then + ncerr = nf90_put_var(ncid, lon_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) + end if + endif end if -! end of define mode - - ! write grid_xt, grid_yt values - call ESMF_GridGetCoord(wrtGrid, coordDim=1, array=array, rc=rc); ESMF_ERR_RETURN(rc) - call ESMF_ArrayGather(array, arrayr8, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) - if (mype==0) then - if (trim(output_grid) == 'gaussian_grid' .or. & - trim(output_grid) == 'global_latlon' .or. & - trim(output_grid) == 'regional_latlon') then - ncerr = nf90_put_var(ncid, im_varid, values=arrayr8(:,1) ); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'rotated_latlon') then + istart = lbound(array_r8,1); iend = ubound(array_r8,1) + jstart = lbound(array_r8,2); jend = ubound(array_r8,2) + + ! write grid_xt (im_varid) + if (do_io) then + allocate (x(im)) + if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & + trim(output_grid(grid_id)) == 'global_latlon' .or. & + trim(output_grid(grid_id)) == 'regional_latlon') then + ncerr = nf90_put_var(ncid, im_varid, values=array_r8(:,jstart), start=[istart], count=[iend-istart+1]); NC_ERR_STOP(ncerr) + else if (trim(output_grid(grid_id)) == 'rotated_latlon') then + do i=1,im + x(i) = lon1(grid_id) + (lon2(grid_id)-lon1(grid_id))/(im-1) * (i-1) + end do + ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr) + else if (trim(output_grid(grid_id)) == 'lambert_conformal') then do i=1,im - x(i) = lon1 + (lon2-lon1)/(im-1) * (i-1) - enddo - ncerr = nf90_put_var(ncid, im_varid, values=x ); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'lambert_conformal') then + x(i) = dx(grid_id) * (i-1) + end do + ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr) + else if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then do i=1,im - x(i) = dx * (i-1) - enddo - ncerr = nf90_put_var(ncid, im_varid, values=x ); NC_ERR_STOP(ncerr) + x(i) = i + end do + ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr) + else + write(0,*)'unknown output_grid ', trim(output_grid(grid_id)) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + end if + + ! write lat (lat_varid) + if (par) then + call ESMF_GridGetCoord(wrtGrid, coordDim=2, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) + ncerr = nf90_put_var(ncid, lat_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) + else + call ESMF_GridGetCoord(wrtGrid, coordDim=2, array=array, rc=rc); ESMF_ERR_RETURN(rc) + if (is_cubed_sphere) then + do t=1,tileCount + call ESMF_ArrayGather(array, array_r8_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) + end do + if (do_io) then + ncerr = nf90_put_var(ncid, lat_varid, values=array_r8_cube, start=start_idx); NC_ERR_STOP(ncerr) + end if + else + call ESMF_ArrayGather(array, array_r8, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) + if (do_io) then + ncerr = nf90_put_var(ncid, lat_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) + end if endif - ncerr = nf90_put_var(ncid, lon_varid, values=arrayr8 ); NC_ERR_STOP(ncerr) - endif - - call ESMF_GridGetCoord(wrtGrid, coordDim=2, array=array, rc=rc); ESMF_ERR_RETURN(rc) - call ESMF_ArrayGather(array, arrayr8, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) - if (mype==0) then - if (trim(output_grid) == 'gaussian_grid' .or. & - trim(output_grid) == 'global_latlon' .or. & - trim(output_grid) == 'regional_latlon') then - ncerr = nf90_put_var(ncid, jm_varid, values=arrayr8(1,:) ); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'rotated_latlon') then + end if + + ! write grid_yt (jm_varid) + if (do_io) then + allocate (y(jm)) + if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & + trim(output_grid(grid_id)) == 'global_latlon' .or. & + trim(output_grid(grid_id)) == 'regional_latlon') then + ncerr = nf90_put_var(ncid, jm_varid, values=array_r8(istart,:), start=[jstart], count=[jend-jstart+1]); NC_ERR_STOP(ncerr) + else if (trim(output_grid(grid_id)) == 'rotated_latlon') then do j=1,jm - y(j) = lat1 + (lat2-lat1)/(jm-1) * (j-1) - enddo - ncerr = nf90_put_var(ncid, jm_varid, values=y ); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'lambert_conformal') then + y(j) = lat1(grid_id) + (lat2(grid_id)-lat1(grid_id))/(jm-1) * (j-1) + end do + ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr) + else if (trim(output_grid(grid_id)) == 'lambert_conformal') then do j=1,jm - y(j) = dy * (j-1) - enddo - ncerr = nf90_put_var(ncid, jm_varid, values=y ); NC_ERR_STOP(ncerr) - endif - ncerr = nf90_put_var(ncid, lat_varid, values=arrayr8 ); NC_ERR_STOP(ncerr) - endif + y(j) = dy(grid_id) * (j-1) + end do + ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr) + else if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then + do j=1,jm + y(j) = j + end do + ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr) + else + write(0,*)'unknown output_grid ', trim(output_grid(grid_id)) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + end if + ! write tile (tile_varid) + if (do_io .and. is_cubed_sphere) then + ncerr = nf90_put_var(ncid, tile_varid, values=[1,2,3,4,5,6]); NC_ERR_STOP(ncerr) + end if + + ! write variables (fields) do i=1, fieldCount - call ESMF_FieldGet(fcstField(i),name=fldName,typekind=typekind, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_FieldGet(fcstField(i),name=fldName,rank=rank,typekind=typekind, rc=rc); ESMF_ERR_RETURN(rc) - if (fldlev(i) == 1) then - if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGather(fcstField(i), arrayr4, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) - if (mype==0) then - ncerr = nf90_put_var(ncid, varids(i), values=arrayr4, start=(/1,1,1/),count=(/im,jm,1/) ); NC_ERR_STOP(ncerr) - end if - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGather(fcstField(i), arrayr8, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) - if (mype==0) then - ncerr = nf90_put_var(ncid, varids(i), values=arrayr8, start=(/1,1,1/),count=(/im,jm,1/) ); NC_ERR_STOP(ncerr) - end if + if (rank == 2) then + + if (allocated(start_idx)) deallocate(start_idx) + if (is_cubed_sphere) then + allocate(start_idx(4)) + start_idx = [start_i,start_j,my_tile,1] + else + allocate(start_idx(3)) + start_idx = [start_i,start_j, 1] end if - else if (fldlev(i) > 1) then + if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGather(fcstField(i), arrayr4_3d, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) - if (mype==0) then - if (ideflate > 0 .and. nbits > 0) then - ! Lossy compression if nbits>0. - ! The floating point data is quantized to improve compression - ! See doi:10.5194/gmd-10-413-2017. The method employed - ! here is identical to the 'scaled linear packing' method in - ! that paper, except that the data are scaling into an arbitrary - ! range (2**nbits-1 not just 2**16-1) and are stored as - ! re-scaled floats instead of short integers. - ! The zlib algorithm does almost as - ! well packing the re-scaled floats as it does the scaled - ! integers, and this avoids the need for the client to apply the - ! rescaling (plus it allows the ability to adjust the packing - ! range). - arrayr4_3d_save = arrayr4_3d - dataMax = maxval(arrayr4_3d); dataMin = minval(arrayr4_3d) - arrayr4_3d = quantized(arrayr4_3d_save, nbits, dataMin, dataMax) - ! compute max abs compression error, save as a variable - ! attribute. - compress_err(i) = maxval(abs(arrayr4_3d_save-arrayr4_3d)) - endif - ncerr = nf90_put_var(ncid, varids(i), values=arrayr4_3d, start=(/1,1,1/),count=(/im,jm,lm,1/) ); NC_ERR_STOP(ncerr) - end if + if (par) then + call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=array_r4, rc=rc); ESMF_ERR_RETURN(rc) + ncerr = nf90_put_var(ncid, varids(i), values=array_r4, start=start_idx); NC_ERR_STOP(ncerr) + else + if (is_cubed_sphere) then + call ESMF_FieldGet(fcstField(i), array=array, rc=rc); ESMF_ERR_RETURN(rc) + do t=1,tileCount + call ESMF_ArrayGather(array, array_r4_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) + end do + if (do_io) then + ncerr = nf90_put_var(ncid, varids(i), values=array_r4_cube, start=start_idx); NC_ERR_STOP(ncerr) + end if + else + call ESMF_FieldGather(fcstField(i), array_r4, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) + if (do_io) then + ncerr = nf90_put_var(ncid, varids(i), values=array_r4, start=start_idx); NC_ERR_STOP(ncerr) + end if + end if + end if else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGather(fcstField(i), arrayr8_3d, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) - if (mype==0) then - ncerr = nf90_put_var(ncid, varids(i), values=arrayr8_3d, start=(/1,1,1/),count=(/im,jm,lm,1/) ); NC_ERR_STOP(ncerr) - end if + if (par) then + call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) + ncerr = nf90_put_var(ncid, varids(i), values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) + else + if (is_cubed_sphere) then + call ESMF_FieldGet(fcstField(i), array=array, rc=rc); ESMF_ERR_RETURN(rc) + do t=1,tileCount + call ESMF_ArrayGather(array, array_r8_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) + end do + if (do_io) then + ncerr = nf90_put_var(ncid, varids(i), values=array_r8_cube, start=start_idx); NC_ERR_STOP(ncerr) + end if + else + call ESMF_FieldGather(fcstField(i), array_r8, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) + if (do_io) then + ncerr = nf90_put_var(ncid, varids(i), values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) + end if + end if + end if end if - end if + else if (rank == 3) then - end do + if (allocated(start_idx)) deallocate(start_idx) + if (is_cubed_sphere) then + allocate(start_idx(5)) + start_idx = [start_i,start_j,1,my_tile,1] + else + allocate(start_idx(4)) + start_idx = [start_i,start_j,1, 1] + end if - if (ideflate > 0 .and. nbits > 0 .and. mype == 0) then + if (typekind == ESMF_TYPEKIND_R4) then + if (par) then + call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=array_r4_3d, rc=rc); ESMF_ERR_RETURN(rc) + if (ideflate(grid_id) > 0 .and. nbits(grid_id) > 0) then + dataMax = maxval(array_r4_3d) + dataMin = minval(array_r4_3d) + call mpi_allreduce(mpi_in_place,dataMax,1,mpi_real4,mpi_max,mpi_comm,ierr) + call mpi_allreduce(mpi_in_place,dataMin,1,mpi_real4,mpi_min,mpi_comm,ierr) + call quantize_array(array_r4_3d, dataMin, dataMax, nbits(grid_id), compress_err(i)) + call mpi_allreduce(mpi_in_place,compress_err(i),1,mpi_real4,mpi_max,mpi_comm,ierr) + end if + ncerr = nf90_put_var(ncid, varids(i), values=array_r4_3d, start=start_idx); NC_ERR_STOP(ncerr) + else + if (is_cubed_sphere) then + call ESMF_FieldGet(fcstField(i), array=array, rc=rc); ESMF_ERR_RETURN(rc) + do t=1,tileCount + call ESMF_ArrayGather(array, array_r4_3d_cube(:,:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) + end do + if (mype==0) then + if (ideflate(grid_id) > 0 .and. nbits(grid_id) > 0) then + call quantize_array(array_r4_3d_cube, minval(array_r4_3d_cube), maxval(array_r4_3d_cube), nbits(grid_id), compress_err(i)) + end if + ncerr = nf90_put_var(ncid, varids(i), values=array_r4_3d_cube, start=start_idx); NC_ERR_STOP(ncerr) + end if + else + call ESMF_FieldGather(fcstField(i), array_r4_3d, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) + if (mype==0) then + if (ideflate(grid_id) > 0 .and. nbits(grid_id) > 0) then + call quantize_array(array_r4_3d, minval(array_r4_3d), maxval(array_r4_3d), nbits(grid_id), compress_err(i)) + end if + ncerr = nf90_put_var(ncid, varids(i), values=array_r4_3d, start=start_idx); NC_ERR_STOP(ncerr) + end if + end if + end if + else if (typekind == ESMF_TYPEKIND_R8) then + if (par) then + call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=array_r8_3d, rc=rc); ESMF_ERR_RETURN(rc) + ncerr = nf90_put_var(ncid, varids(i), values=array_r8_3d, start=start_idx); NC_ERR_STOP(ncerr) + else + if (is_cubed_sphere) then + call ESMF_FieldGet(fcstField(i), array=array, rc=rc); ESMF_ERR_RETURN(rc) + do t=1,tileCount + call ESMF_ArrayGather(array, array_r8_3d_cube(:,:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) + end do + if (mype==0) then + ncerr = nf90_put_var(ncid, varids(i), values=array_r8_3d_cube, start=start_idx); NC_ERR_STOP(ncerr) + end if + else + call ESMF_FieldGather(fcstField(i), array_r8_3d, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) + if (mype==0) then + ncerr = nf90_put_var(ncid, varids(i), values=array_r8_3d, start=start_idx); NC_ERR_STOP(ncerr) + end if + end if + end if + end if ! end typekind + + else + + write(0,*)'Unsupported rank ', rank + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + end if ! end rank + + end do ! end fieldCount + + if (ideflate(grid_id) > 0 .and. nbits(grid_id) > 0 .and. do_io) then ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) do i=1, fieldCount if (compress_err(i) > 0) then ncerr = nf90_put_att(ncid, varids(i), 'max_abs_compression_error', compress_err(i)); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, varids(i), 'nbits', nbits); NC_ERR_STOP(ncerr) - endif - enddo + ncerr = nf90_put_att(ncid, varids(i), 'nbits', nbits(grid_id)); NC_ERR_STOP(ncerr) + end if + end do ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) - endif + end if - deallocate(arrayr4) - deallocate(arrayr8) - deallocate(arrayr4_3d,arrayr4_3d_save) - deallocate(arrayr8_3d) + if (.not. par) then + deallocate(array_r4) + deallocate(array_r8) + deallocate(array_r4_3d) + deallocate(array_r8_3d) + if (is_cubed_sphere) then + deallocate(array_r4_cube) + deallocate(array_r8_cube) + deallocate(array_r4_3d_cube) + deallocate(array_r8_3d_cube) + end if + end if + + if (do_io) then + deallocate(dimids_2d) + deallocate(dimids_3d) + end if deallocate(fcstField) deallocate(varids) deallocate(compress_err) - if (mype==0) then - ncerr = nf90_close(ncid=ncid); NC_ERR_STOP(ncerr) + if (do_io) then + ncerr = nf90_close(ncid=ncid); NC_ERR_STOP(ncerr) end if end subroutine write_netcdf -! + !---------------------------------------------------------------------------------------- subroutine get_global_attr(fldbundle, ncid, rc) type(ESMF_FieldBundle), intent(in) :: fldbundle @@ -406,21 +740,19 @@ subroutine get_global_attr(fldbundle, ncid, rc) integer, intent(out) :: rc ! local variable - integer :: i, attcount + integer :: i, attCount integer :: ncerr character(len=ESMF_MAXSTR) :: attName type(ESMF_TypeKind_Flag) :: typekind integer :: varival - real(ESMF_KIND_R4) :: varr4val real(ESMF_KIND_R4), dimension(:), allocatable :: varr4list - real(ESMF_KIND_R8) :: varr8val real(ESMF_KIND_R8), dimension(:), allocatable :: varr8list integer :: itemCount character(len=ESMF_MAXSTR) :: varcval ! call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, & + attnestflag=ESMF_ATTNEST_OFF, count=attCount, & rc=rc); ESMF_ERR_RETURN(rc) do i=1,attCount @@ -458,7 +790,7 @@ subroutine get_global_attr(fldbundle, ncid, rc) end do end subroutine get_global_attr -! + !---------------------------------------------------------------------------------------- subroutine get_grid_attr(grid, prefix, ncid, varid, rc) type(ESMF_Grid), intent(in) :: grid @@ -468,7 +800,7 @@ subroutine get_grid_attr(grid, prefix, ncid, varid, rc) integer, intent(out) :: rc ! local variable - integer :: i, attcount, n, ind + integer :: i, attCount, n, ind integer :: ncerr character(len=ESMF_MAXSTR) :: attName type(ESMF_TypeKind_Flag) :: typekind @@ -479,16 +811,14 @@ subroutine get_grid_attr(grid, prefix, ncid, varid, rc) character(len=ESMF_MAXSTR) :: varcval ! call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, & + attnestflag=ESMF_ATTNEST_OFF, count=attCount, & rc=rc); ESMF_ERR_RETURN(rc) - !write(0,*)'grid attcount = ', attcount do i=1,attCount call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & typekind=typekind, itemCount=n, rc=rc); ESMF_ERR_RETURN(rc) - !write(0,*)'grid att = ',i,trim(attName), ' itemCount = ' , n if (index(trim(attName), trim(prefix)//":")==1) then ind = len(trim(prefix)//":") @@ -507,10 +837,10 @@ subroutine get_grid_attr(grid, prefix, ncid, varid, rc) call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc); ESMF_ERR_RETURN(rc) if (trim(attName) /= '_FillValue') then - ! FIXME: _FillValue must be cast to var type for recent versions - ! of netcdf + ! FIXME: _FillValue must be cast to var type when using + ! NF90_NETCDF4. Until this is fixed, using netCDF default _FillValue. ncerr = nf90_put_att(ncid, varid, trim(attName(ind+1:len(attName))), varr8val); NC_ERR_STOP(ncerr) - endif + end if else if (typekind==ESMF_TYPEKIND_CHARACTER) then call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & @@ -525,6 +855,7 @@ subroutine get_grid_attr(grid, prefix, ncid, varid, rc) end subroutine get_grid_attr +!---------------------------------------------------------------------------------------- subroutine add_dim(ncid, dim_name, dimid, grid, rc) integer, intent(in) :: ncid character(len=*), intent(in) :: dim_name @@ -533,75 +864,127 @@ subroutine add_dim(ncid, dim_name, dimid, grid, rc) integer, intent(out) :: rc ! local variable - integer :: i, attcount, n, dim_varid + integer :: n, dim_varid integer :: ncerr - character(len=ESMF_MAXSTR) :: attName type(ESMF_TypeKind_Flag) :: typekind - integer, allocatable :: valueListI(:) real(ESMF_KIND_R4), allocatable :: valueListR4(:) real(ESMF_KIND_R8), allocatable :: valueListR8(:) - character(len=ESMF_MAXSTR), allocatable :: valueListC(:) ! call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, name=dim_name, & typekind=typekind, itemCount=n, rc=rc); ESMF_ERR_RETURN(rc) - if ( trim(dim_name) == "time" ) then - ncerr = nf90_def_dim(ncid, trim(dim_name), NF90_UNLIMITED, dimid); NC_ERR_STOP(ncerr) + if (trim(dim_name) == "time") then + ! using an unlimited dim requires collective mode (NF90_COLLECTIVE) + ! for parallel writes, which seems to slow things down on hera. + !ncerr = nf90_def_dim(ncid, trim(dim_name), NF90_UNLIMITED, dimid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_dim(ncid, trim(dim_name), 1, dimid); NC_ERR_STOP(ncerr) else ncerr = nf90_def_dim(ncid, trim(dim_name), n, dimid); NC_ERR_STOP(ncerr) end if if (typekind==ESMF_TYPEKIND_R8) then - ncerr = nf90_def_var(ncid, dim_name, NF90_REAL8, dimids=(/dimid/), varid=dim_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, dim_name, NF90_REAL8, dimids=[dimid], varid=dim_varid); NC_ERR_STOP(ncerr) allocate(valueListR8(n)) call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & name=trim(dim_name), valueList=valueListR8, rc=rc); ESMF_ERR_RETURN(rc) ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) - ncerr = nf90_put_var(ncid, dim_varid, values=valueListR8 ); NC_ERR_STOP(ncerr) + ncerr = nf90_put_var(ncid, dim_varid, values=valueListR8); NC_ERR_STOP(ncerr) ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) deallocate(valueListR8) else if (typekind==ESMF_TYPEKIND_R4) then - ncerr = nf90_def_var(ncid, dim_name, NF90_REAL4, dimids=(/dimid/), varid=dim_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, dim_name, NF90_REAL4, dimids=[dimid], varid=dim_varid); NC_ERR_STOP(ncerr) allocate(valueListR4(n)) call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & name=trim(dim_name), valueList=valueListR4, rc=rc); ESMF_ERR_RETURN(rc) ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) - ncerr = nf90_put_var(ncid, dim_varid, values=valueListR4 ); NC_ERR_STOP(ncerr) + ncerr = nf90_put_var(ncid, dim_varid, values=valueListR4); NC_ERR_STOP(ncerr) ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) deallocate(valueListR4) else write(0,*)'Error in module_write_netcdf.F90(add_dim) unknown typekind for ',trim(dim_name) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if + if (par) then + ncerr = nf90_var_par_access(ncid, dim_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) + end if call get_grid_attr(grid, dim_name, ncid, dim_varid, rc) end subroutine add_dim -! + !---------------------------------------------------------------------------------------- - subroutine nccheck(status) - use netcdf - implicit none - integer, intent (in) :: status - - if (status /= nf90_noerr) then - write(0,*) status, trim(nf90_strerror(status)) - stop "stopped" + subroutine quantize_array_3d(array, dataMin, dataMax, nbits, compress_err) + + real(4), dimension(:,:,:), intent(inout) :: array + real(4), intent(in) :: dataMin, dataMax + integer, intent(in) :: nbits + real(4), intent(out) :: compress_err + + real(4) :: scale_fact, offset + real(4), dimension(:,:,:), allocatable :: array_save + ! Lossy compression if nbits>0. + ! The floating point data is quantized to improve compression + ! See doi:10.5194/gmd-10-413-2017. The method employed + ! here is identical to the 'scaled linear packing' method in + ! that paper, except that the data are scaling into an arbitrary + ! range (2**nbits-1 not just 2**16-1) and are stored as + ! re-scaled floats instead of short integers. + ! The zlib algorithm does almost as + ! well packing the re-scaled floats as it does the scaled + ! integers, and this avoids the need for the client to apply the + ! rescaling (plus it allows the ability to adjust the packing + ! range). + scale_fact = (dataMax - dataMin) / (2**nbits-1) + offset = dataMin + if (scale_fact > 0.) then + allocate(array_save, source=array) + array = scale_fact*(nint((array_save - offset) / scale_fact)) + offset + ! compute max abs compression error + compress_err = maxval(abs(array_save-array)) + deallocate(array_save) + else + ! field is constant + compress_err = 0. end if - end subroutine nccheck - - elemental real function quantized(dataIn, nbits, dataMin, dataMax) - integer, intent(in) :: nbits - real(4), intent(in) :: dataIn, dataMin, dataMax - real(4) offset, scale_fact - ! convert data to 32 bit integers in range 0 to 2**nbits-1, then cast - ! cast back to 32 bit floats (data is then quantized in steps - ! proportional to 2**nbits so last 32-nbits in floating - ! point representation should be zero for efficient zlib compression). - scale_fact = (dataMax - dataMin) / (2**nbits-1); offset = dataMin - quantized = scale_fact*(nint((dataIn - offset) / scale_fact)) + offset - end function quantized + end subroutine quantize_array_3d + + subroutine quantize_array_4d(array, dataMin, dataMax, nbits, compress_err) + + real(4), dimension(:,:,:,:), intent(inout) :: array + real(4), intent(in) :: dataMin, dataMax + integer, intent(in) :: nbits + real(4), intent(out) :: compress_err + + real(4) :: scale_fact, offset + real(4), dimension(:,:,:,:), allocatable :: array_save + + ! Lossy compression if nbits>0. + ! The floating point data is quantized to improve compression + ! See doi:10.5194/gmd-10-413-2017. The method employed + ! here is identical to the 'scaled linear packing' method in + ! that paper, except that the data are scaling into an arbitrary + ! range (2**nbits-1 not just 2**16-1) and are stored as + ! re-scaled floats instead of short integers. + ! The zlib algorithm does almost as + ! well packing the re-scaled floats as it does the scaled + ! integers, and this avoids the need for the client to apply the + ! rescaling (plus it allows the ability to adjust the packing + ! range). + scale_fact = (dataMax - dataMin) / (2**nbits-1) + offset = dataMin + if (scale_fact > 0.) then + allocate(array_save, source=array) + array = scale_fact*(nint((array_save - offset) / scale_fact)) + offset + ! compute max abs compression error + compress_err = maxval(abs(array_save-array)) + deallocate(array_save) + else + ! field is constant + compress_err = 0. + end if + end subroutine quantize_array_4d +!---------------------------------------------------------------------------------------- end module module_write_netcdf diff --git a/io/module_write_netcdf_parallel.F90 b/io/module_write_netcdf_parallel.F90 deleted file mode 100644 index 0506d794a..000000000 --- a/io/module_write_netcdf_parallel.F90 +++ /dev/null @@ -1,627 +0,0 @@ -#define ESMF_ERR_RETURN(rc) if (ESMF_LogFoundError(rc, msg="Breaking out of subroutine", line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - -#define NC_ERR_STOP(status) \ - if (status /= nf90_noerr) write(0,*) "line ", __LINE__, trim(nf90_strerror(status)); \ - if (status /= nf90_noerr) call ESMF_Finalize(endflag=ESMF_END_ABORT) - -module module_write_netcdf_parallel - - use esmf - use netcdf - use module_fv3_io_def,only : ideflate, nbits, & - output_grid,dx,dy,lon1,lat1,lon2,lat2 - use mpi - - implicit none - private - public write_netcdf_parallel - - contains - -#ifdef NO_PARALLEL_NETCDF -!---------------------------------------------------------------------------------------- - subroutine write_netcdf_parallel(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, ichunk2d, jchunk2d, ichunk3d, jchunk3d, kchunk3d, rc) - type(ESMF_FieldBundle), intent(in) :: fieldbundle - type(ESMF_FieldBundle), intent(in) :: wrtfb - character(*), intent(in) :: filename - integer, intent(in) :: mpi_comm - integer, intent(in) :: mype - integer, intent(in) :: im, jm, ichunk2d, jchunk2d, & - ichunk3d, jchunk3d, kchunk3d - integer, optional,intent(out) :: rc - print *,'in stub write_netcdf_parallel - model not built with parallel netcdf support, return' - end subroutine write_netcdf_parallel -#else -!---------------------------------------------------------------------------------------- - subroutine write_netcdf_parallel(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, ichunk2d, jchunk2d, ichunk3d, jchunk3d, kchunk3d, rc) -! - type(ESMF_FieldBundle), intent(in) :: fieldbundle - type(ESMF_FieldBundle), intent(in) :: wrtfb - character(*), intent(in) :: filename - integer, intent(in) :: mpi_comm - integer, intent(in) :: mype - integer, intent(in) :: im, jm, ichunk2d, jchunk2d, & - ichunk3d, jchunk3d, kchunk3d - integer, optional,intent(out) :: rc -! -!** local vars - integer :: i,j,m,n,k,istart,iend,jstart,jend,i1,i2,j1,j2,k1,k2 - integer :: lm - - integer, dimension(:), allocatable :: fldlev - real(ESMF_KIND_R4), dimension(:,:), pointer :: arrayr4 - real(ESMF_KIND_R8), dimension(:,:), pointer :: arrayr8 - real(ESMF_KIND_R4), dimension(:,:,:), pointer :: arrayr4_3d,arrayr4_3d_save - real(ESMF_KIND_R8), dimension(:,:,:), pointer :: arrayr8_3d - - real(8) x(im),y(jm) - integer :: fieldCount, fieldDimCount, gridDimCount - integer, dimension(:), allocatable :: ungriddedLBound, ungriddedUBound - - type(ESMF_Field), allocatable :: fcstField(:) - type(ESMF_TypeKind_Flag) :: typekind - type(ESMF_TypeKind_Flag) :: attTypeKind - type(ESMF_Grid) :: wrtgrid - type(ESMF_Array) :: array - - integer :: attcount - character(len=ESMF_MAXSTR) :: attName, fldName - integer :: totalLBound2d(2),totalUBound2d(2),totalLBound3d(3),totalUBound3d(3) - - integer :: varival - real(4) :: varr4val, scale_fact, offset, dataMin, dataMax - real(4), allocatable, dimension(:) :: compress_err - real(8) :: varr8val - character(len=ESMF_MAXSTR) :: varcval - - character(128) :: time_units - - integer :: ncerr,ierr - integer :: ncid - integer :: oldMode - integer :: im_dimid, jm_dimid, pfull_dimid, phalf_dimid, time_dimid - integer :: im_varid, jm_varid, lm_varid, time_varid, lon_varid, lat_varid - integer, dimension(:), allocatable :: varids - logical shuffle -! - call ESMF_FieldBundleGet(fieldbundle, fieldCount=fieldCount, rc=rc); ESMF_ERR_RETURN(rc) - - allocate(compress_err(fieldCount)); compress_err=-999. - allocate(fldlev(fieldCount)) ; fldlev = 0 - allocate(fcstField(fieldCount)) - allocate(varids(fieldCount)) - - call ESMF_FieldBundleGet(fieldbundle, fieldList=fcstField, grid=wrtGrid, & -! itemorderflag=ESMF_ITEMORDER_ADDORDER, & - rc=rc); ESMF_ERR_RETURN(rc) - - call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc); ESMF_ERR_RETURN(rc) - - do i=1,fieldCount - call ESMF_FieldGet(fcstField(i), dimCount=fieldDimCount, rc=rc); ESMF_ERR_RETURN(rc) - if (fieldDimCount > 3) then - write(0,*)"write_netcdf: Only 2D and 3D fields are supported!" - stop - end if - if (fieldDimCount > gridDimCount) then - allocate(ungriddedLBound(fieldDimCount-gridDimCount)) - allocate(ungriddedUBound(fieldDimCount-gridDimCount)) - call ESMF_FieldGet(fcstField(i), & - ungriddedLBound=ungriddedLBound, & - ungriddedUBound=ungriddedUBound, rc=rc); ESMF_ERR_RETURN(rc) - fldlev(i) = ungriddedUBound(fieldDimCount-gridDimCount) - & - ungriddedLBound(fieldDimCount-gridDimCount) + 1 - deallocate(ungriddedLBound) - deallocate(ungriddedUBound) - else if (fieldDimCount == 2) then - fldlev(i) = 1 - end if - end do - - lm = maxval(fldlev(:)) - -! create netcdf file for parallel access - - ncerr = nf90_create(trim(filename),& - cmode=IOR(IOR(NF90_CLOBBER,NF90_NETCDF4),NF90_CLASSIC_MODEL),& - comm=mpi_comm, info = MPI_INFO_NULL, ncid=ncid); NC_ERR_STOP(ncerr) -! disable auto filling. - ncerr = nf90_set_fill(ncid, NF90_NOFILL, oldMode); NC_ERR_STOP(ncerr) - - ! define dimensions - ncerr = nf90_def_dim(ncid, "grid_xt", im, im_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_dim(ncid, "grid_yt", jm, jm_dimid); NC_ERR_STOP(ncerr) - ! define coordinate variables - ncerr = nf90_def_var(ncid, "grid_xt", NF90_DOUBLE, im_dimid, im_varid); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, im_varid, NF90_INDEPENDENT) - ncerr = nf90_def_var(ncid, "lon", NF90_DOUBLE, (/im_dimid,jm_dimid/), lon_varid); NC_ERR_STOP(ncerr) - !ncerr = nf90_var_par_access(ncid, lon_varid, NF90_INDEPENDENT) - ncerr = nf90_put_att(ncid, lon_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, lon_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, im_varid, "cartesian_axis", "X"); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "grid_yt", NF90_DOUBLE, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, jm_varid, NF90_INDEPENDENT) - ncerr = nf90_def_var(ncid, "lat", NF90_DOUBLE, (/im_dimid,jm_dimid/), lat_varid); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, lat_varid, NF90_INDEPENDENT) - ncerr = nf90_put_att(ncid, lat_varid, "long_name", "T-cell latitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, lat_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "cartesian_axis", "Y"); NC_ERR_STOP(ncerr) - - if (lm > 1) then - call add_dim(ncid, "pfull", pfull_dimid, wrtgrid, rc) - call add_dim(ncid, "phalf", phalf_dimid, wrtgrid, rc) - end if - - call add_dim(ncid, "time", time_dimid, wrtgrid, rc) - - call get_global_attr(wrtfb, ncid, rc) - - do i=1, fieldCount - call ESMF_FieldGet(fcstField(i), name=fldName, typekind=typekind, rc=rc); ESMF_ERR_RETURN(rc) - - ! define variables - if (fldlev(i) == 1) then - if (typekind == ESMF_TYPEKIND_R4) then - if (ideflate > 0) then - if (ichunk2d < 0 .or. jchunk2d < 0) then - ! let netcdf lib choose chunksize - ! shuffle filter on for 2d fields (lossless compression) - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,time_dimid/), varids(i), & - shuffle=.true.,deflate_level=ideflate); NC_ERR_STOP(ncerr) - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,time_dimid/), varids(i), & - shuffle=.true.,deflate_level=ideflate,& - chunksizes=(/ichunk2d,jchunk2d,1/)); NC_ERR_STOP(ncerr) - endif - ! compression filters require collective access. - ncerr = nf90_var_par_access(ncid, varids(i), NF90_COLLECTIVE) - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,time_dimid/), varids(i)); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, varids(i), NF90_INDEPENDENT) - endif - else if (typekind == ESMF_TYPEKIND_R8) then - ncerr = nf90_def_var(ncid, trim(fldName), NF90_DOUBLE, & - (/im_dimid,jm_dimid,time_dimid/), varids(i)); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, varids(i), NF90_INDEPENDENT) - else - write(0,*)'Unsupported typekind ', typekind - stop - end if - else if (fldlev(i) > 1) then - if (typekind == ESMF_TYPEKIND_R4) then - if (ideflate > 0) then - ! shuffle filter off for 3d fields using lossy compression - if (nbits > 0) then - shuffle=.false. - else - shuffle=.true. - endif - if (ichunk3d < 0 .or. jchunk3d < 0 .or. kchunk3d < 0) then - ! let netcdf lib choose chunksize - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,pfull_dimid,time_dimid/), varids(i), & - shuffle=shuffle,deflate_level=ideflate); NC_ERR_STOP(ncerr) - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,pfull_dimid,time_dimid/), varids(i), & - shuffle=shuffle,deflate_level=ideflate,& - chunksizes=(/ichunk3d,jchunk3d,kchunk3d,1/)); NC_ERR_STOP(ncerr) - endif - ! compression filters require collective access. - ncerr = nf90_var_par_access(ncid, varids(i), NF90_COLLECTIVE) - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - (/im_dimid,jm_dimid,pfull_dimid,time_dimid/), varids(i)); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, varids(i), NF90_INDEPENDENT) - endif - else if (typekind == ESMF_TYPEKIND_R8) then - ncerr = nf90_def_var(ncid, trim(fldName), NF90_DOUBLE, & - (/im_dimid,jm_dimid,pfull_dimid,time_dimid/), varids(i)); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, varids(i), NF90_INDEPENDENT) - else - write(0,*)'Unsupported typekind ', typekind - stop - end if - end if - - ! define variable attributes - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, & - rc=rc); ESMF_ERR_RETURN(rc) - - do j=1,attCount - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=j, & - name=attName, typekind=attTypeKind, itemCount=n, & - rc=rc); ESMF_ERR_RETURN(rc) - - if ( index(trim(attName),"ESMF") /= 0 ) then - cycle - endif - - if (attTypeKind==ESMF_TYPEKIND_I4) then - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, & - rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, varids(i), trim(attName), varival); NC_ERR_STOP(ncerr) - - else if (attTypeKind==ESMF_TYPEKIND_R4) then - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, & - rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, varids(i), trim(attName), varr4val); NC_ERR_STOP(ncerr) - - else if (attTypeKind==ESMF_TYPEKIND_R8) then - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr8val, & - rc=rc); ESMF_ERR_RETURN(rc) - if (trim(attName) /= '_FillValue') then - ! FIXME: _FillValue must be cast to var type when using NF90_NETCDF4 - ncerr = nf90_put_att(ncid, varids(i), trim(attName), varr8val); NC_ERR_STOP(ncerr) - endif - - else if (attTypeKind==ESMF_TYPEKIND_CHARACTER) then - call ESMF_AttributeGet(fcstField(i), convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varcval, & - rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, varids(i), trim(attName), trim(varcval)); NC_ERR_STOP(ncerr) - - end if - - end do ! j=1,attCount - - end do ! i=1,fieldCount - - ! write grid_xt, grid_yt attributes - if (trim(output_grid) == 'gaussian_grid' .or. & - trim(output_grid) == 'global_latlon' .or. & - trim(output_grid) == 'regional_latlon') then - ncerr = nf90_put_att(ncid, im_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, im_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "long_name", "T-cell latiitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'rotated_latlon') then - ncerr = nf90_put_att(ncid, im_varid, "long_name", "rotated T-cell longiitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, im_varid, "units", "degrees"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "long_name", "rotated T-cell latiitude"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees"); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'lambert_conformal') then - ncerr = nf90_put_att(ncid, im_varid, "long_name", "x-coordinate of projection"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, im_varid, "units", "meters"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "long_name", "y-coordinate of projection"); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, jm_varid, "units", "meters"); NC_ERR_STOP(ncerr) - endif - - ncerr = nf90_enddef(ncid); NC_ERR_STOP(ncerr) - -! end of define mode - - ! write grid_xt, grid_yt values - call ESMF_GridGetCoord(wrtGrid, coordDim=1, farrayPtr=arrayr8, rc=rc); ESMF_ERR_RETURN(rc) - istart = lbound(arrayr8,1); iend = ubound(arrayr8,1) - jstart = lbound(arrayr8,2); jend = ubound(arrayr8,2) - !print *,'in write netcdf mpi dim 1',istart,iend,jstart,jend,shape(arrayr8),minval(arrayr8(:,jstart)),maxval(arrayr8(:,jstart)) - - if (trim(output_grid) == 'gaussian_grid' .or. & - trim(output_grid) == 'global_latlon' .or. & - trim(output_grid) == 'regional_latlon') then - ncerr = nf90_put_var(ncid, im_varid, values=arrayr8(:,jstart),start=(/istart/), count=(/iend-istart+1/)); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'rotated_latlon') then - do i=1,im - x(i) = lon1 + (lon2-lon1)/(im-1) * (i-1) - enddo - ncerr = nf90_put_var(ncid, im_varid, values=x ); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'lambert_conformal') then - do i=1,im - x(i) = dx * (i-1) - enddo - ncerr = nf90_put_var(ncid, im_varid, values=x ); NC_ERR_STOP(ncerr) - endif - ncerr = nf90_put_var(ncid, lon_varid, values=arrayr8, start=(/istart,jstart/)); NC_ERR_STOP(ncerr) - - call ESMF_GridGetCoord(wrtGrid, coordDim=2, farrayPtr=arrayr8, rc=rc); ESMF_ERR_RETURN(rc) - !print *,'in write netcdf mpi dim 2',istart,iend,jstart,jend,shape(arrayr8),minval(arrayr8(istart,:)),maxval(arrayr8(istart,:)) - if (trim(output_grid) == 'gaussian_grid' .or. & - trim(output_grid) == 'global_latlon' .or. & - trim(output_grid) == 'regional_latlon') then - ncerr = nf90_put_var(ncid, jm_varid, values=arrayr8(istart,:),start=(/jstart/),count=(/jend-jstart+1/)); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'rotated_latlon') then - do j=1,jm - y(j) = lat1 + (lat2-lat1)/(jm-1) * (j-1) - enddo - ncerr = nf90_put_var(ncid, jm_varid, values=y ); NC_ERR_STOP(ncerr) - else if (trim(output_grid) == 'lambert_conformal') then - do j=1,jm - y(j) = dy * (j-1) - enddo - ncerr = nf90_put_var(ncid, jm_varid, values=y ); NC_ERR_STOP(ncerr) - endif - ncerr = nf90_put_var(ncid, lat_varid, values=arrayr8, start=(/istart,jstart/)); NC_ERR_STOP(ncerr) - - do i=1, fieldCount - - call ESMF_FieldGet(fcstField(i),name=fldName,typekind=typekind, rc=rc); ESMF_ERR_RETURN(rc) - - if (fldlev(i) == 1) then - if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=arrayr4, totalLBound=totalLBound2d, totalUBound=totalUBound2d,rc=rc); ESMF_ERR_RETURN(rc) - !print *,'field name=',trim(fldName),'bound=',totalLBound2d,'ubound=',totalUBound2d - ncerr = nf90_put_var(ncid, varids(i), values=arrayr4, start=(/totalLBound2d(1),totalLBound2d(2),1/)); NC_ERR_STOP(ncerr) - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=arrayr8, totalLBound=totalLBound2d, totalUBound=totalUBound2d,rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_var(ncid, varids(i), values=arrayr8, start=(/totalLBound2d(1),totalLBound2d(2),1/)); NC_ERR_STOP(ncerr) - end if - else if (fldlev(i) > 1) then - if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=arrayr4_3d, totalLBound=totalLBound3d, totalUBound=totalUBound3d,rc=rc); ESMF_ERR_RETURN(rc) - if (ideflate > 0 .and. nbits > 0) then - i1=totalLBound3d(1);i2=totalUBound3d(1) - j1=totalLBound3d(2);j2=totalUBound3d(2) - k1=totalLBound3d(3);k2=totalUBound3d(3) - dataMax = maxval(arrayr4_3d(i1:i2,j1:j2,k1:k2)) - dataMin = minval(arrayr4_3d(i1:i2,j1:j2,k1:k2)) - call mpi_allreduce(mpi_in_place,dataMax,1,mpi_real4,mpi_max,mpi_comm,ierr) - call mpi_allreduce(mpi_in_place,dataMin,1,mpi_real4,mpi_min,mpi_comm,ierr) - ! Lossy compression if nbits>0. - ! The floating point data is quantized to improve compression - ! See doi:10.5194/gmd-10-413-2017. The method employed - ! here is identical to the 'scaled linear packing' method in - ! that paper, except that the data are scaling into an arbitrary - ! range (2**nbits-1 not just 2**16-1) and are stored as - ! re-scaled floats instead of short integers. - ! The zlib algorithm does almost as - ! well packing the re-scaled floats as it does the scaled - ! integers, and this avoids the need for the client to apply the - ! rescaling (plus it allows the ability to adjust the packing - ! range) - scale_fact = (dataMax - dataMin) / (2**nbits-1); offset = dataMin - if (scale_fact > 0.) then - allocate(arrayr4_3d_save(i1:i2,j1:j2,k1:k2)) - arrayr4_3d_save(i1:i2,j1:j2,k1:k2)=arrayr4_3d(i1:i2,j1:j2,k1:k2) - arrayr4_3d = scale_fact*(nint((arrayr4_3d_save - offset) / scale_fact)) + offset - ! compute max abs compression error. - compress_err(i) = & - maxval(abs(arrayr4_3d_save(i1:i2,j1:j2,k1:k2)-arrayr4_3d(i1:i2,j1:j2,k1:k2))) - deallocate(arrayr4_3d_save) - call mpi_allreduce(mpi_in_place,compress_err(i),1,mpi_real4,mpi_max,mpi_comm,ierr) - !print *,'field name=',trim(fldName),dataMin,dataMax,compress_err(i) - else - ! field is constant - compress_err(i) = 0. - endif - endif - ncerr = nf90_put_var(ncid, varids(i), values=arrayr4_3d, start=(/totalLBound3d(1),totalLBound3d(2),totalLBound3d(3),1/)); NC_ERR_STOP(ncerr) - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=arrayr8_3d, totalLBound=totalLBound3d, totalUBound=totalUBound3d,rc=rc); ESMF_ERR_RETURN(rc) - !print *,'field name=',trim(fldName),'bound=',totalLBound3d,'ubound=',totalUBound3d - ncerr = nf90_put_var(ncid, varids(i), values=arrayr8_3d, start=(/totalLBound3d(1),totalLBound3d(2),totalLBound3d(3),1/)); NC_ERR_STOP(ncerr) - end if - - end if !end fldlev(i) - - end do ! end fieldCount - - if (ideflate > 0 .and. nbits > 0) then - ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) - do i=1, fieldCount - if (compress_err(i) > 0) then - ncerr = nf90_put_att(ncid, varids(i), 'max_abs_compression_error', compress_err(i)); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, varids(i), 'nbits', nbits); NC_ERR_STOP(ncerr) - endif - enddo - ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) - endif - - deallocate(fcstField) - deallocate(varids) - deallocate(compress_err) - - ncerr = nf90_close(ncid=ncid); NC_ERR_STOP(ncerr) - !call mpi_barrier(mpi_comm,ierr) - !print *,'netcdf parallel close, finished write_netcdf_parallel' - - end subroutine write_netcdf_parallel -#endif - -!---------------------------------------------------------------------------------------- - subroutine get_global_attr(fldbundle, ncid, rc) - type(ESMF_FieldBundle), intent(in) :: fldbundle - integer, intent(in) :: ncid - integer, intent(out) :: rc - -! local variable - integer :: i, attcount - integer :: ncerr - character(len=ESMF_MAXSTR) :: attName - type(ESMF_TypeKind_Flag) :: typekind - - integer :: varival - real(ESMF_KIND_R4) :: varr4val - real(ESMF_KIND_R4), dimension(:), allocatable :: varr4list - real(ESMF_KIND_R8) :: varr8val - real(ESMF_KIND_R8), dimension(:), allocatable :: varr8list - integer :: itemCount - character(len=ESMF_MAXSTR) :: varcval -! - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, & - rc=rc); ESMF_ERR_RETURN(rc) - - do i=1,attCount - - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=itemCount, rc=rc); ESMF_ERR_RETURN(rc) - - if (typekind==ESMF_TYPEKIND_I4) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, NF90_GLOBAL, trim(attName), varival); NC_ERR_STOP(ncerr) - - else if (typekind==ESMF_TYPEKIND_R4) then - allocate (varr4list(itemCount)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=varr4list, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, NF90_GLOBAL, trim(attName), varr4list); NC_ERR_STOP(ncerr) - deallocate(varr4list) - - else if (typekind==ESMF_TYPEKIND_R8) then - allocate (varr8list(itemCount)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=varr8list, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, NF90_GLOBAL, trim(attName), varr8list); NC_ERR_STOP(ncerr) - deallocate(varr8list) - - else if (typekind==ESMF_TYPEKIND_CHARACTER) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varcval, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, NF90_GLOBAL, trim(attName), trim(varcval)); NC_ERR_STOP(ncerr) - - end if - - end do - - end subroutine get_global_attr -! -!---------------------------------------------------------------------------------------- - subroutine get_grid_attr(grid, prefix, ncid, varid, rc) - type(ESMF_Grid), intent(in) :: grid - character(len=*), intent(in) :: prefix - integer, intent(in) :: ncid - integer, intent(in) :: varid - integer, intent(out) :: rc - -! local variable - integer :: i, attcount, n, ind - integer :: ncerr - character(len=ESMF_MAXSTR) :: attName - type(ESMF_TypeKind_Flag) :: typekind - - integer :: varival - real(ESMF_KIND_R4) :: varr4val - real(ESMF_KIND_R8) :: varr8val - character(len=ESMF_MAXSTR) :: varcval -! - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, & - rc=rc); ESMF_ERR_RETURN(rc) - - !write(0,*)'grid attcount = ', attcount - do i=1,attCount - - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc); ESMF_ERR_RETURN(rc) - !write(0,*)'grid att = ',i,trim(attName), ' itemCount = ' , n - - if (index(trim(attName), trim(prefix)//":")==1) then - ind = len(trim(prefix)//":") - - if (typekind==ESMF_TYPEKIND_I4) then - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, varid, trim(attName(ind+1:len(attName))), varival); NC_ERR_STOP(ncerr) - - else if (typekind==ESMF_TYPEKIND_R4) then - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, varid, trim(attName(ind+1:len(attName))), varr4val); NC_ERR_STOP(ncerr) - - else if (typekind==ESMF_TYPEKIND_R8) then - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr8val, rc=rc); ESMF_ERR_RETURN(rc) - if (trim(attName) /= '_FillValue') then - ! FIXME: _FillValue must be cast to var type when using - ! NF90_NETCDF4. Until this is fixed, using netCDF default _FillValue. - ncerr = nf90_put_att(ncid, varid, trim(attName(ind+1:len(attName))), varr8val); NC_ERR_STOP(ncerr) - endif - - else if (typekind==ESMF_TYPEKIND_CHARACTER) then - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varcval, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, varid, trim(attName(ind+1:len(attName))), trim(varcval)); NC_ERR_STOP(ncerr) - - end if - - end if - - end do - - end subroutine get_grid_attr - - subroutine add_dim(ncid, dim_name, dimid, grid, rc) - integer, intent(in) :: ncid - character(len=*), intent(in) :: dim_name - integer, intent(inout) :: dimid - type(ESMF_Grid), intent(in) :: grid - integer, intent(out) :: rc - -! local variable - integer :: i, attcount, n, dim_varid - integer :: ncerr - character(len=ESMF_MAXSTR) :: attName - type(ESMF_TypeKind_Flag) :: typekind - - integer, allocatable :: valueListI(:) - real(ESMF_KIND_R4), allocatable :: valueListR4(:) - real(ESMF_KIND_R8), allocatable :: valueListR8(:) - character(len=ESMF_MAXSTR), allocatable :: valueListC(:) -! - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, name=dim_name, & - typekind=typekind, itemCount=n, rc=rc); ESMF_ERR_RETURN(rc) - - if ( trim(dim_name) == "time" ) then - ! using an unlimited dim requires collective mode (NF90_COLLECTIVE) - ! for parallel writes, which seems to slow things down on hera. - !ncerr = nf90_def_dim(ncid, trim(dim_name), NF90_UNLIMITED, dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_dim(ncid, trim(dim_name), 1, dimid); NC_ERR_STOP(ncerr) - else - ncerr = nf90_def_dim(ncid, trim(dim_name), n, dimid); NC_ERR_STOP(ncerr) - end if - - if (typekind==ESMF_TYPEKIND_R8) then - ncerr = nf90_def_var(ncid, dim_name, NF90_REAL8, dimids=(/dimid/), varid=dim_varid); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, dim_varid, NF90_INDEPENDENT) - allocate(valueListR8(n)) - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - name=trim(dim_name), valueList=valueListR8, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) - ncerr = nf90_put_var(ncid, dim_varid, values=valueListR8 ); NC_ERR_STOP(ncerr) - ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) - deallocate(valueListR8) - else if (typekind==ESMF_TYPEKIND_R4) then - ncerr = nf90_def_var(ncid, dim_name, NF90_REAL4, dimids=(/dimid/), varid=dim_varid); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, dim_varid, NF90_INDEPENDENT) - allocate(valueListR4(n)) - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - name=trim(dim_name), valueList=valueListR4, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) - ncerr = nf90_put_var(ncid, dim_varid, values=valueListR4 ); NC_ERR_STOP(ncerr) - ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) - deallocate(valueListR4) - else - write(0,*)'Error in module_write_netcdf.F90(add_dim) unknown typekind for ',trim(dim_name) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - call get_grid_attr(grid, dim_name, ncid, dim_varid, rc) - - end subroutine add_dim -! -!---------------------------------------------------------------------------------------- - subroutine nccheck(status) - use netcdf - implicit none - integer, intent (in) :: status - - if (status /= nf90_noerr) then - write(0,*) status, trim(nf90_strerror(status)) - stop "stopped" - end if - end subroutine nccheck - -end module module_write_netcdf_parallel diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 70257b8d6..0bbf2a221 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -31,7 +31,7 @@ module module_wrt_grid_comp use write_internal_state use module_fv3_io_def, only : num_pes_fcst, & - n_group, num_files, app_domain, & + n_group, num_files, & filename_base, output_grid, output_file, & imo,jmo,ichunk2d,jchunk2d, & ichunk3d,jchunk3d,kchunk3d,nbits, & @@ -43,7 +43,6 @@ module module_wrt_grid_comp use module_write_netcdf, only : write_netcdf use physcons, only : pi => con_pi use inline_post, only : inline_post_run, inline_post_getattr - use module_write_netcdf_parallel, only : write_netcdf_parallel ! !----------------------------------------------------------------------- ! @@ -55,31 +54,22 @@ module module_wrt_grid_comp ! !----------------------------------------------------------------------- ! - real, parameter :: rdgas=287.04, grav=9.80 - real, parameter :: stndrd_atmos_ps = 101325. - real, parameter :: stndrd_atmos_lapse = 0.0065 ! integer,save :: lead_write_task !<-- Rank of the first write task in the write group integer,save :: last_write_task !<-- Rank of the last write task in the write group integer,save :: ntasks !<-- # of write tasks in the current group + integer,save :: itasks, jtasks !<-- # of write tasks in i/j direction in the current group - integer,save :: mytile !<-- the tile number in write task integer,save :: wrt_mpi_comm !<-- the mpi communicator in the write comp integer,save :: idate(7) logical,save :: write_nsflip - logical,save :: first_init=.false. - logical,save :: first_run=.false. - logical,save :: first_getlatlon=.true. - logical,save :: first_getmaskwrt=.true. !<-- for mask the output grid of the write comp logical,save :: change_wrtidate=.false. ! !----------------------------------------------------------------------- ! - type(wrt_internal_state),pointer :: wrt_int_state ! The internal state pointer. type(ESMF_FieldBundle) :: gridFB integer :: FBcount character(len=esmf_maxstr),allocatable :: fcstItemNameList(:) - real(ESMF_KIND_R4), dimension(:,:), allocatable :: maskwrt ! !----------------------------------------------------------------------- REAL(KIND=8) :: btim,btim0 @@ -113,15 +103,15 @@ subroutine SetServices(wrt_comp, rc) call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_INITIALIZE, & userRoutine=wrt_initialize, rc=rc) - if(rc/=0) write(*,*)'Error: write grid comp, initial' -! + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_RUN, & userRoutine=wrt_run, rc=rc) - if(rc/=0) write(*,*)'Error: write grid comp, run' -! + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_FINALIZE, & userRoutine=wrt_finalize, rc=rc) - if(rc/=0) write(*,*)'Error: write grid comp, run' + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end subroutine SetServices ! @@ -146,21 +136,20 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) type(write_wrap) :: WRAP type(wrt_internal_state),pointer :: wrt_int_state - integer :: ISTAT, tl, i, j, n, k + integer :: tl, i, j, n, k integer,dimension(2,6) :: decomptile integer,dimension(2) :: regDecomp !define delayout for the nest grid integer :: fieldCount integer :: vm_mpi_comm - character(40) :: fieldName, axesname,longname - type(ESMF_Config) :: cf + character(40) :: fieldName + type(ESMF_Config) :: cf, cf_output_grid type(ESMF_DELayout) :: delayout - type(ESMF_Grid) :: wrtGrid, fcstGrid + type(ESMF_Grid) :: fcstGrid + type(ESMF_Grid), allocatable :: wrtGrid(:) type(ESMF_Array) :: array - type(ESMF_FieldBundle) :: fieldbdl_work type(ESMF_Field) :: field_work, field type(ESMF_Decomp_Flag) :: decompflagPTile(2,6) - character(len=80) :: attrValueSList(2) type(ESMF_StateItem_Flag), allocatable :: fcstItemTypeList(:) type(ESMF_FieldBundle) :: fcstFB, fieldbundle type(ESMF_Field), allocatable :: fcstField(:) @@ -179,7 +168,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) real(ESMF_KIND_R4) :: valueR4 real(ESMF_KIND_R8) :: valueR8 - integer :: attCount, axeslen, jidx, idx, noutfile + integer :: attCount, jidx, idx, noutfile character(19) :: newdate character(128) :: FBlist_outfilename(100), outfile_name character(128),dimension(:,:), allocatable :: outfilename @@ -189,19 +178,17 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) real(ESMF_KIND_R8) :: rot_lon, rot_lat real(ESMF_KIND_R8) :: geo_lon, geo_lat real(ESMF_KIND_R8) :: lon1_r8, lat1_r8 - real(ESMF_KIND_R8) :: x1, y1, x, y, delat + real(ESMF_KIND_R8) :: x1, y1, x, y, delat, delon type(ESMF_TimeInterval) :: IAU_offsetTI - type(ESMF_DataCopy_Flag) :: copyflag=ESMF_DATACOPY_REFERENCE -! real(8),parameter :: PI=3.14159265358979d0 + character(256) :: cf_open, cf_close character(256) :: gridfile integer :: num_output_file - ! - logical,save :: first=.true. logical :: lprnt -!test - real(ESMF_KIND_R8),dimension(:,:), pointer :: glatPtr, glonPtr + + integer :: ngrids, grid_id + logical :: top_parent_is_global ! !----------------------------------------------------------------------- !*********************************************************************** @@ -243,6 +230,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! lead_write_task,'last_write_task=',last_write_task, & ! 'mype=',wrt_int_state%mype,'jidx=',jidx,' comm=',wrt_mpi_comm ! + !----------------------------------------------------------------------- !*** get configuration variables !----------------------------------------------------------------------- @@ -265,115 +253,206 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return + if( wrt_int_state%write_dopost ) then +#ifdef NO_INLINE_POST + rc = ESMF_RC_NOT_IMPL + print *,'inline post not available on this machine' + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return +#endif + call esmf_configgetattribute(cf,wrt_int_state%post_nlunit,default=777,label='nlunit:',rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ConfigGetAttribute(config=CF,value=wrt_int_state%post_namelist,default='itag', & + label ='post_namelist:',rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + endif - ! chunksizes for netcdf_parallel - call ESMF_ConfigGetAttribute(config=CF,value=ichunk2d,default=0,label ='ichunk2d:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF,value=jchunk2d,default=0,label ='jchunk2d:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF,value=ichunk3d,default=0,label ='ichunk3d:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF,value=jchunk3d,default=0,label ='jchunk3d:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF,value=kchunk3d,default=0,label ='kchunk3d:',rc=rc) - - ! zlib compression flag - call ESMF_ConfigGetAttribute(config=CF,value=ideflate,default=0,label ='ideflate:',rc=rc) - if (ideflate < 0) ideflate=0 - - call ESMF_ConfigGetAttribute(config=CF,value=nbits,default=0,label ='nbits:',rc=rc) - ! nbits quantization level for lossy compression (must be between 1 and 31) - ! 1 is most compression, 31 is least. If outside this range, set to zero - ! which means use lossless compression. - if (nbits < 1 .or. nbits > 31) nbits=0 ! lossless compression (no quantization) -! variables for I/O options - call ESMF_ConfigGetAttribute(config=CF,value=app_domain, default="global", & - label ='app_domain:',rc=rc) + allocate(output_file(num_files)) + num_output_file = ESMF_ConfigGetLen(config=CF, label ='output_file:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (num_files == num_output_file) then + call ESMF_ConfigGetAttribute(CF,valueList=output_file,label='output_file:', & + count=num_files, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + do i = 1, num_files + if(output_file(i) /= "netcdf" .and. output_file(i) /= "netcdf_parallel") then + write(0,*)"Only netcdf and netcdf_parallel are allowed for multiple values of output_file" + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + enddo + else if ( num_output_file == 1) then + call ESMF_ConfigGetAttribute(CF,valuelist=output_file,label='output_file:', count=1, rc=rc) + output_file(1:num_files) = output_file(1) + else + output_file(1:num_files) = 'netcdf' + endif + if(lprnt) then + print *,'num_files=',num_files + do i=1,num_files + print *,'num_file=',i,'filename_base= ',trim(filename_base(i)),' output_file= ',trim(output_file(i)) + enddo + endif + + call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & + name="ngrids", value=ngrids, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & + name="top_parent_is_global", value=top_parent_is_global, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate(wrtGrid(ngrids)) + + allocate(output_grid(ngrids)) + + allocate(imo(ngrids)) + allocate(jmo(ngrids)) + + allocate(cen_lon(ngrids)) + allocate(cen_lat(ngrids)) + allocate(lon1(ngrids)) + allocate(lat1(ngrids)) + allocate(lon2(ngrids)) + allocate(lat2(ngrids)) + allocate(dlon(ngrids)) + allocate(dlat(ngrids)) + + allocate(stdlat1(ngrids)) + allocate(stdlat2(ngrids)) + allocate(dx(ngrids)) + allocate(dy(ngrids)) + + allocate(ichunk2d(ngrids)) + allocate(jchunk2d(ngrids)) + allocate(ichunk3d(ngrids)) + allocate(jchunk3d(ngrids)) + allocate(kchunk3d(ngrids)) + allocate(ideflate(ngrids)) + allocate(nbits(ngrids)) + + do n=1, ngrids - call ESMF_ConfigGetAttribute(config=CF, value=output_grid, label ='output_grid:',rc=rc) + if (n == 1) then + ! for top level domain look directly in cf + cf_output_grid = cf + else + ! for nest domains, look under specific section + write(cf_open,'("")') n + write(cf_close,'("")') n + cf_output_grid = ESMF_ConfigCreate(cf, openLabel=trim(cf_open), closeLabel=trim(cf_close), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + + if (allocated(wrt_int_state%lat_start_wrtgrp)) deallocate (wrt_int_state%lat_start_wrtgrp) + if (allocated(wrt_int_state%lat_end_wrtgrp )) deallocate (wrt_int_state%lat_end_wrtgrp ) + if (allocated(wrt_int_state%lon_start_wrtgrp)) deallocate (wrt_int_state%lon_start_wrtgrp) + if (allocated(wrt_int_state%lon_end_wrtgrp )) deallocate (wrt_int_state%lon_end_wrtgrp ) + if (allocated(wrt_int_state%latPtr) ) deallocate (wrt_int_state%latPtr) + if (allocated(wrt_int_state%lonPtr) ) deallocate (wrt_int_state%lonPtr) + + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=output_grid(n), label ='output_grid:',rc=rc) if (lprnt) then - print *,'output_grid=',trim(output_grid) + print *,'grid_id= ', n, ' output_grid= ', trim(output_grid(n)) end if - if(trim(output_grid) == 'gaussian_grid' .or. trim(output_grid) == 'global_latlon') then - call ESMF_ConfigGetAttribute(config=CF, value=imo, label ='imo:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=jmo, label ='jmo:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF, value=itasks,default=1,label ='itasks:',rc=rc) + jtasks = ntasks + if(itasks > 0 ) jtasks = ntasks/itasks + if( itasks*jtasks /= ntasks ) then + itasks = 1 + jtasks = ntasks + endif + + if(trim(output_grid(n)) == 'gaussian_grid' .or. trim(output_grid(n)) == 'global_latlon') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='imo:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='jmo:',rc=rc) if (lprnt) then - print *,'imo=',imo,'jmo=',jmo + print *,'imo=',imo(n),'jmo=',jmo(n) end if - else if(trim(output_grid) == 'regional_latlon') then - call ESMF_ConfigGetAttribute(config=CF, value=lon1, label ='lon1:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=lat1, label ='lat1:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=lon2, label ='lon2:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=lat2, label ='lat2:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=dlon, label ='dlon:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=dlat, label ='dlat:',rc=rc) - imo = (lon2-lon1)/dlon + 1 - jmo = (lat2-lat1)/dlat + 1 + else if(trim(output_grid(n)) == 'regional_latlon') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon2(n), label ='lon2:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat2(n), label ='lat2:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlon(n), label ='dlon:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlat(n), label ='dlat:',rc=rc) + imo(n) = (lon2(n)-lon1(n))/dlon(n) + 1 + jmo(n) = (lat2(n)-lat1(n))/dlat(n) + 1 if (lprnt) then - print *,'lon1=',lon1,' lat1=',lat1 - print *,'lon2=',lon2,' lat2=',lat2 - print *,'dlon=',dlon,' dlat=',dlat - print *,'imo =',imo, ' jmo=',jmo + print *,'lon1=',lon1(n),' lat1=',lat1(n) + print *,'lon2=',lon2(n),' lat2=',lat2(n) + print *,'dlon=',dlon(n),' dlat=',dlat(n) + print *,'imo =',imo(n), ' jmo =',jmo(n) end if - else if (trim(output_grid) == 'rotated_latlon') then - call ESMF_ConfigGetAttribute(config=CF, value=cen_lon, label ='cen_lon:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=cen_lat, label ='cen_lat:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=lon1, label ='lon1:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=lat1, label ='lat1:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=lon2, label ='lon2:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=lat2, label ='lat2:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=dlon, label ='dlon:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=dlat, label ='dlat:', rc=rc) - imo = (lon2-lon1)/dlon + 1 - jmo = (lat2-lat1)/dlat + 1 + else if (trim(output_grid(n)) == 'rotated_latlon') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lon(n), label ='cen_lon:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lat(n), label ='cen_lat:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon2(n), label ='lon2:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat2(n), label ='lat2:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlon(n), label ='dlon:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlat(n), label ='dlat:', rc=rc) + imo(n) = (lon2(n)-lon1(n))/dlon(n) + 1 + jmo(n) = (lat2(n)-lat1(n))/dlat(n) + 1 if (lprnt) then - print *,'lon1=',lon1,' lat1=',lat1 - print *,'lon2=',lon2,' lat2=',lat2 - print *,'dlon=',dlon,' dlat=',dlat - print *,'imo =',imo, ' jmo=',jmo + print *,'lon1=',lon1(n),' lat1=',lat1(n) + print *,'lon2=',lon2(n),' lat2=',lat2(n) + print *,'dlon=',dlon(n),' dlat=',dlat(n) + print *,'imo =',imo(n), ' jmo =',jmo(n) end if - else if (trim(output_grid) == 'lambert_conformal') then - call ESMF_ConfigGetAttribute(config=CF, value=cen_lon, label ='cen_lon:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=cen_lat, label ='cen_lat:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=stdlat1, label ='stdlat1:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=stdlat2, label ='stdlat2:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=imo, label ='nx:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=jmo, label ='ny:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=lon1, label ='lon1:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=lat1, label ='lat1:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=dx, label ='dx:', rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=dy, label ='dy:', rc=rc) + else if (trim(output_grid(n)) == 'lambert_conformal') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lon(n), label ='cen_lon:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lat(n), label ='cen_lat:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=stdlat1(n), label ='stdlat1:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=stdlat2(n), label ='stdlat2:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='nx:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='ny:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dx(n), label ='dx:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dy(n), label ='dy:', rc=rc) if (lprnt) then - print *,'cen_lon=',cen_lon,' cen_lat=',cen_lat - print *,'stdlat1=',stdlat1,' stdlat2=',stdlat2 - print *,'lon1=',lon1,' lat1=',lat1 - print *,'nx=',imo, ' ny=',jmo - print *,'dx=',dx,' dy=',dy + print *,'cen_lon=',cen_lon(n),' cen_lat=',cen_lat(n) + print *,'stdlat1=',stdlat1(n),' stdlat2=',stdlat2(n) + print *,'lon1=',lon1(n),' lat1=',lat1(n) + print *,'nx=',imo(n), ' ny=',jmo(n) + print *,'dx=',dx(n),' dy=',dy(n) endif endif ! output_grid - if( wrt_int_state%write_dopost ) then -#ifdef NO_INLINE_POST - rc = ESMF_RC_NOT_IMPL - print *,'inline post not available on this machine' - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return -#endif - call esmf_configgetattribute(cf,wrt_int_state%post_nlunit,default=777,label='nlunit:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_ConfigGetAttribute(config=CF,value=wrt_int_state%post_namelist,default='itag', & - label ='post_namelist:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + + ! chunksizes for netcdf_parallel + call ESMF_ConfigGetAttribute(config=CF,value=ichunk2d(n),default=0,label ='ichunk2d:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=jchunk2d(n),default=0,label ='jchunk2d:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=ichunk3d(n),default=0,label ='ichunk3d:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=jchunk3d(n),default=0,label ='jchunk3d:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=kchunk3d(n),default=0,label ='kchunk3d:',rc=rc) + + ! zlib compression flag + call ESMF_ConfigGetAttribute(config=CF,value=ideflate(n),default=0,label ='ideflate:',rc=rc) + if (ideflate(n) < 0) ideflate(n)=0 + + call ESMF_ConfigGetAttribute(config=CF,value=nbits(n),default=0,label ='nbits:',rc=rc) + if (lprnt) then + print *,'ideflate=',ideflate(n),' nbits=',nbits(n) + end if + ! nbits quantization level for lossy compression (must be between 1 and 31) + ! 1 is most compression, 31 is least. If outside this range, set to zero + ! which means use lossless compression. + if (nbits(n) < 1 .or. nbits(n) > 31) nbits(n)=0 ! lossless compression (no quantization) + + if (cf_output_grid /= cf) then + ! destroy the temporary config object created for nest domains + call ESMF_ConfigDestroy(config=cf_output_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif -! -!----------------------------------------------------------------------- -!*** Create the cubed sphere grid with field on PETs -!*** first try: Create cubed sphere grid from file -!----------------------------------------------------------------------- -! - if ( trim(output_grid) == 'cubed_sphere_grid' ) then - mytile = mod(wrt_int_state%mype,ntasks)+1 - if ( trim(app_domain) == 'global' ) then + if ( trim(output_grid(n)) == 'cubed_sphere_grid' ) then + !*** Create cubed sphere grid from file + if (top_parent_is_global .and. n==1) then + gridfile = 'grid_spec.nc' ! global top-level parent do tl=1,6 decomptile(1,tl) = 1 decomptile(2,tl) = jidx @@ -383,19 +462,23 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) name="gridfile", value=gridfile, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - CALL ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) - wrtgrid = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & + call ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) + wrtGrid(n) = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & regDecompPTile=decomptile,tileFilePath="INPUT/", & decompflagPTile=decompflagPTile, & staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & name='wrt_grid', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return else - if(trim(app_domain) == 'nested') then - gridfile='grid.nest02.tile7.nc' - else if(trim(app_domain) == 'regional') then - gridfile='grid.tile7.halo0.nc' - endif + if (top_parent_is_global) then + write(gridfile,'(A,I2.2,A,I1,A)') 'grid.nest', n, '.tile', n+5, '.nc' + else + if (n == 1) then + gridfile='grid.tile7.halo0.nc' ! regional top-level parent + else + write(gridfile,'(A,I2.2,A,I1,A)') 'grid.nest', n, '.tile', n, '.nc' + endif + end if regDecomp(1) = 1 regDecomp(2) = ntasks allocate(petMap(ntasks)) @@ -406,62 +489,63 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! create the nest Grid by reading it from file but use DELayout - wrtGrid = ESMF_GridCreate(filename="INPUT/"//trim(gridfile), & + call ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) + wrtGrid(n) = ESMF_GridCreate(filename="INPUT/"//trim(gridfile), & fileformat=ESMF_FILEFORMAT_GRIDSPEC, regDecomp=regDecomp, & decompflag=(/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/), & delayout=delayout, isSphere=.false., indexflag=ESMF_INDEX_DELOCAL, & rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - print *,'in nested/regional cubed_sphere grid, regDecomp=',regDecomp,' PetMap=',petMap(1),petMap(ntasks), & + if (lprnt) print *,'in nested/regional cubed_sphere grid, regDecomp=',regDecomp,' PetMap=',petMap(1),petMap(ntasks), & 'gridfile=',trim(gridfile) deallocate(petMap) endif - else if ( trim(output_grid) == 'gaussian_grid') then + else if ( trim(output_grid(n)) == 'gaussian_grid') then - wrtgrid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & - maxIndex=(/imo,jmo/), regDecomp=(/1,ntasks/), & - indexflag=ESMF_INDEX_GLOBAL, & - name='wrt_grid',rc=rc) -! indexflag=ESMF_INDEX_GLOBAL, coordSys=ESMF_COORDSYS_SPH_DEG + wrtGrid(n) = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/imo(n),jmo(n)/), regDecomp=(/itasks,jtasks/), & + indexflag=ESMF_INDEX_GLOBAL, & + name='wrt_grid',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridAddCoord(wrtgrid, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + call ESMF_GridAddCoord(wrtGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtgrid, coordDim=1, farrayPtr=lonPtr, rc=rc) + call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, farrayPtr=lonPtr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtgrid, coordDim=2, farrayPtr=latPtr, rc=rc) + call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, farrayPtr=latPtr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! - allocate(slat(jmo), lat(jmo), lon(imo)) - call splat(4, jmo, slat) + allocate(slat(jmo(n)), lat(jmo(n)), lon(imo(n))) + call splat(4, jmo(n), slat) if(write_nsflip) then - do j=1,jmo + do j=1,jmo(n) lat(j) = asin(slat(j)) * radi enddo else - do j=1,jmo - lat(jmo-j+1) = asin(slat(j)) * radi + do j=1,jmo(n) + lat(jmo(n)-j+1) = asin(slat(j)) * radi enddo endif wrt_int_state%latstart = lat(1) - wrt_int_state%latlast = lat(jmo) - do j=1,imo - lon(j) = 360.d0/real(imo,8) *real(j-1,8) + wrt_int_state%latlast = lat(jmo(n)) + do j=1,imo(n) + lon(j) = 360.d0/real(imo(n),8) *real(j-1,8) enddo wrt_int_state%lonstart = lon(1) - wrt_int_state%lonlast = lon(imo) + wrt_int_state%lonlast = lon(imo(n)) do j=lbound(latPtr,2),ubound(latPtr,2) do i=lbound(lonPtr,1),ubound(lonPtr,1) - lonPtr(i,j) = 360.d0/real(imo,8) * real(i-1,8) + lonPtr(i,j) = 360.d0/real(imo(n),8) * real(i-1,8) latPtr(i,j) = lat(j) enddo enddo -! print *,'aft wrtgrd, Gaussian, dimi,i=',lbound(lonPtr,1),ubound(lonPtr,1), & -! ' j=',lbound(lonPtr,2),ubound(lonPtr,2),'imo=',imo,'jmo=',jmo + if(lprnt) print *,'aft wrtgrd, Gaussian, dimi,i=',lbound(lonPtr,1),ubound(lonPtr,1), & + lbound(lonPtr,2),ubound(lonPtr,2),'j(i)=',lbound(latPtr,1),ubound(latPtr,1),& + ' j(j)=',lbound(latPtr,2),ubound(latPtr,2),'imo=',imo,'jmo=',jmo ! if(wrt_int_state%mype==0) print *,'aft wrtgrd, lon=',lonPtr(1:5,1), & ! 'lat=',latPtr(1,1:5),'imo,jmo=',imo,jmo ! lonPtr(lbound(lonPtr,1),ubound(lonPtr,2)),'lat=',latPtr(lbound(lonPtr,1),lbound(lonPtr,2)), & @@ -472,12 +556,20 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) wrt_int_state%lon_end = ubound(lonPtr,1) allocate( wrt_int_state%lat_start_wrtgrp(wrt_int_state%petcount)) allocate( wrt_int_state%lat_end_wrtgrp (wrt_int_state%petcount)) + allocate( wrt_int_state%lon_start_wrtgrp(wrt_int_state%petcount)) + allocate( wrt_int_state%lon_end_wrtgrp (wrt_int_state%petcount)) call mpi_allgather(wrt_int_state%lat_start,1,MPI_INTEGER, & wrt_int_state%lat_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) call mpi_allgather(wrt_int_state%lat_end, 1,MPI_INTEGER, & wrt_int_state%lat_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + call mpi_allgather(wrt_int_state%lon_start,1,MPI_INTEGER, & + wrt_int_state%lon_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + call mpi_allgather(wrt_int_state%lon_end, 1,MPI_INTEGER, & + wrt_int_state%lon_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) if( lprnt ) print *,'aft wrtgrd, Gaussian, dimj_start=',wrt_int_state%lat_start_wrtgrp, & - 'dimj_end=',wrt_int_state%lat_end_wrtgrp, 'wrt_group=',n_group + 'dimj_end=',wrt_int_state%lat_end_wrtgrp, 'wrt_group=',n_group, & + 'lon_start,end=',wrt_int_state%lon_start,wrt_int_state%lon_end, & + 'lat_start,end=',wrt_int_state%lat_start, wrt_int_state%lat_end allocate( wrt_int_state%latPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & wrt_int_state%lat_start:wrt_int_state%lat_end)) allocate( wrt_int_state%lonPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & @@ -488,60 +580,63 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) wrt_int_state%lonPtr(i,j) = lonPtr(i,j) enddo enddo - wrt_int_state%im = imo - wrt_int_state%jm = jmo + wrt_int_state%im = imo(n) + wrt_int_state%jm = jmo(n) wrt_int_state%post_maptype = 4 - deallocate(slat) - else if ( trim(output_grid) == 'global_latlon') then - wrtgrid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & - maxIndex=(/imo,jmo/), regDecomp=(/1,ntasks/), & - indexflag=ESMF_INDEX_GLOBAL, name='wrt_grid',rc=rc) + deallocate(slat, lat, lon) + + else if ( trim(output_grid(n)) == 'global_latlon') then + wrtGrid(n) = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/imo(n),jmo(n)/), regDecomp=(/itasks,jtasks/), & + indexflag=ESMF_INDEX_GLOBAL, & + name='wrt_grid',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridAddCoord(wrtgrid, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + call ESMF_GridAddCoord(wrtGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtgrid, coordDim=1, farrayPtr=lonPtr, rc=rc) + call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, farrayPtr=lonPtr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtgrid, coordDim=2, farrayPtr=latPtr, rc=rc) + call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, farrayPtr=latPtr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! - allocate(lat(jmo), lon(imo)) - if (mod(jmo,2) == 0) then + allocate(lat(jmo(n)), lon(imo(n))) + if (mod(jmo(n),2) == 0) then ! if jmo even, lats do not include poles and equator - delat = 180.d0/real(jmo,8) + delat = 180.d0/real(jmo(n),8) if(write_nsflip) then - do j=1,jmo + do j=1,jmo(n) lat(j) = 90.d0 - 0.5*delat - real(j-1,8)*delat enddo else - do j=1,jmo + do j=1,jmo(n) lat(j) = -90.d0 + 0.5*delat + real(j-1,8)*delat enddo endif else ! if jmo odd, lats include poles and equator - delat = 180.d0/real(jmo-1,8) + delat = 180.d0/real(jmo(n)-1,8) if(write_nsflip) then - do j=1,jmo + do j=1,jmo(n) lat(j) = 90.d0 - real(j-1,8)*delat enddo else - do j=1,jmo + do j=1,jmo(n) lat(j) = -90.d0 + real(j-1,8)*delat enddo endif endif wrt_int_state%latstart = lat(1) - wrt_int_state%latlast = lat(jmo) - do i=1,imo - lon(i) = 360.d0/real(imo,8) *real(i-1,8) + wrt_int_state%latlast = lat(jmo(n)) + delon = 360.d0/real(imo(n),8) + do i=1,imo(n) + lon(i) = real(i-1,8)*delon enddo wrt_int_state%lonstart = lon(1) - wrt_int_state%lonlast = lon(imo) + wrt_int_state%lonlast = lon(imo(n)) do j=lbound(latPtr,2),ubound(latPtr,2) do i=lbound(lonPtr,1),ubound(lonPtr,1) lonPtr(i,j) = lon(i) @@ -552,12 +647,24 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) wrt_int_state%lat_end = ubound(latPtr,2) wrt_int_state%lon_start = lbound(lonPtr,1) wrt_int_state%lon_end = ubound(lonPtr,1) + lon1(n) = wrt_int_state%lonstart + lon2(n) = wrt_int_state%lonlast + lat1(n) = wrt_int_state%latstart + lat2(n) = wrt_int_state%latlast + dlon(n) = delon + dlat(n) = delat allocate( wrt_int_state%lat_start_wrtgrp(wrt_int_state%petcount)) allocate( wrt_int_state%lat_end_wrtgrp (wrt_int_state%petcount)) + allocate( wrt_int_state%lon_start_wrtgrp(wrt_int_state%petcount)) + allocate( wrt_int_state%lon_end_wrtgrp (wrt_int_state%petcount)) call mpi_allgather(wrt_int_state%lat_start,1,MPI_INTEGER, & wrt_int_state%lat_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) call mpi_allgather(wrt_int_state%lat_end, 1,MPI_INTEGER, & wrt_int_state%lat_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + call mpi_allgather(wrt_int_state%lon_start,1,MPI_INTEGER, & + wrt_int_state%lon_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + call mpi_allgather(wrt_int_state%lon_end, 1,MPI_INTEGER, & + wrt_int_state%lon_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) if( lprnt ) print *,'aft wrtgrd, latlon, dimj_start=',wrt_int_state%lat_start_wrtgrp, & 'dimj_end=',wrt_int_state%lat_end_wrtgrp, 'wrt_group=',n_group allocate( wrt_int_state%latPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & @@ -570,62 +677,64 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) wrt_int_state%lonPtr(i,j) = lonPtr(i,j) enddo enddo - wrt_int_state%im = imo - wrt_int_state%jm = jmo + wrt_int_state%im = imo(n) + wrt_int_state%jm = jmo(n) wrt_int_state%post_maptype = 0 - else if ( trim(output_grid) == 'regional_latlon' .or. & - trim(output_grid) == 'rotated_latlon' .or. & - trim(output_grid) == 'lambert_conformal' ) then + deallocate(lat, lon) - wrtgrid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & - maxIndex=(/imo,jmo/), regDecomp=(/1,ntasks/), & - indexflag=ESMF_INDEX_GLOBAL, & - name='wrt_grid',rc=rc) + else if ( trim(output_grid(n)) == 'regional_latlon' .or. & + trim(output_grid(n)) == 'rotated_latlon' .or. & + trim(output_grid(n)) == 'lambert_conformal' ) then + + wrtGrid(n) = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), & + maxIndex=(/imo(n),jmo(n)/), regDecomp=(/itasks,jtasks/), & + indexflag=ESMF_INDEX_GLOBAL, & + name='wrt_grid',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridAddCoord(wrtgrid, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + call ESMF_GridAddCoord(wrtGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtgrid, coordDim=1, farrayPtr=lonPtr, rc=rc) + call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, farrayPtr=lonPtr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtgrid, coordDim=2, farrayPtr=latPtr, rc=rc) + call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, farrayPtr=latPtr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - wrt_int_state%im = imo - wrt_int_state%jm = jmo - if ( trim(output_grid) == 'regional_latlon' ) then + wrt_int_state%im = imo(n) + wrt_int_state%jm = jmo(n) + if ( trim(output_grid(n)) == 'regional_latlon' ) then do j=lbound(lonPtr,2),ubound(lonPtr,2) do i=lbound(lonPtr,1),ubound(lonPtr,1) - lonPtr(i,j) = lon1 + (lon2-lon1)/(imo-1) * (i-1) - latPtr(i,j) = lat1 + (lat2-lat1)/(jmo-1) * (j-1) + lonPtr(i,j) = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (i-1) + latPtr(i,j) = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (j-1) enddo enddo wrt_int_state%post_maptype = 0 - else if ( trim(output_grid) == 'rotated_latlon' ) then + else if ( trim(output_grid(n)) == 'rotated_latlon' ) then do j=lbound(lonPtr,2),ubound(lonPtr,2) do i=lbound(lonPtr,1),ubound(lonPtr,1) - rot_lon = lon1 + (lon2-lon1)/(imo-1) * (i-1) - rot_lat = lat1 + (lat2-lat1)/(jmo-1) * (j-1) - call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon), dble(cen_lat)) + rot_lon = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (i-1) + rot_lat = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (j-1) + call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 lonPtr(i,j) = geo_lon latPtr(i,j) = geo_lat enddo enddo wrt_int_state%post_maptype = 207 - else if ( trim(output_grid) == 'lambert_conformal' ) then - lon1_r8 = dble(lon1) - lat1_r8 = dble(lat1) - call lambert(dble(stdlat1),dble(stdlat2),dble(cen_lat),dble(cen_lon), & + else if ( trim(output_grid(n)) == 'lambert_conformal' ) then + lon1_r8 = dble(lon1(n)) + lat1_r8 = dble(lat1(n)) + call lambert(dble(stdlat1(n)),dble(stdlat2(n)),dble(cen_lat(n)),dble(cen_lon(n)), & lon1_r8,lat1_r8,x1,y1, 1) do j=lbound(lonPtr,2),ubound(lonPtr,2) do i=lbound(lonPtr,1),ubound(lonPtr,1) - x = x1 + dx * (i-1) - y = y1 + dy * (j-1) - call lambert(dble(stdlat1),dble(stdlat2),dble(cen_lat),dble(cen_lon), & + x = x1 + dx(n) * (i-1) + y = y1 + dy(n) * (j-1) + call lambert(dble(stdlat1(n)),dble(stdlat2(n)),dble(cen_lat(n)),dble(cen_lon(n)), & geo_lon,geo_lat,x,y,-1) if (geo_lon <0.0) geo_lon = geo_lon + 360.0 lonPtr(i,j) = geo_lon @@ -641,10 +750,16 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) wrt_int_state%lon_end = ubound(lonPtr,1) allocate( wrt_int_state%lat_start_wrtgrp(wrt_int_state%petcount)) allocate( wrt_int_state%lat_end_wrtgrp (wrt_int_state%petcount)) + allocate( wrt_int_state%lon_start_wrtgrp(wrt_int_state%petcount)) + allocate( wrt_int_state%lon_end_wrtgrp (wrt_int_state%petcount)) call mpi_allgather(wrt_int_state%lat_start,1,MPI_INTEGER, & - wrt_int_state%lat_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + wrt_int_state%lat_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) call mpi_allgather(wrt_int_state%lat_end, 1,MPI_INTEGER, & wrt_int_state%lat_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + call mpi_allgather(wrt_int_state%lon_start,1,MPI_INTEGER, & + wrt_int_state%lon_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + call mpi_allgather(wrt_int_state%lon_end, 1,MPI_INTEGER, & + wrt_int_state%lon_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) allocate( wrt_int_state%latPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & wrt_int_state%lat_start:wrt_int_state%lat_end)) allocate( wrt_int_state%lonPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & @@ -658,11 +773,13 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) else - write(0,*)"wrt_initialize: Unknown output_grid ", trim(output_grid) - call ESMF_LogWrite("wrt_initialize: Unknown output_grid "//trim(output_grid),ESMF_LOGMSG_ERROR,rc=RC) + write(0,*)"wrt_initialize: Unknown output_grid ", trim(output_grid(n)) + call ESMF_LogWrite("wrt_initialize: Unknown output_grid "//trim(output_grid(n)),ESMF_LOGMSG_ERROR,rc=RC) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif + + end do ! n = 1, ngrids ! !----------------------------------------------------------------------- !*** get write grid component initial time from clock @@ -686,17 +803,9 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) m=idate(5),s=idate(6),rc=rc) wrt_int_state%idate = idate change_wrtidate = .true. - if (lprnt) print *,'in wrt initial, with iau, io_baseline time=',idate,'rc=',rc + if (lprnt) print *,'in wrt initial, with iau, io_baseline time=',idate,'rc=',rc endif ! -! Create field bundle -!------------------------------------------------------------------- -! -!--- check grid dim count first - call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! !--- Look at the incoming FieldBundles in the imp_state_write, and mirror them ! call ESMF_StateGet(imp_state_write, itemCount=FBCount, rc=rc) @@ -716,12 +825,14 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) outfilename = '' call ESMF_StateGet(imp_state_write, itemNameList=fcstItemNameList, & - itemTypeList=fcstItemTypeList, rc=rc) + itemTypeList=fcstItemTypeList, & + !itemorderflag=ESMF_ITEMORDER_ADDORDER, & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return !loop over all items in the imp_state_write and collect all FieldBundles - do i=1, FBcount + do i=1, FBCount if (fcstItemTypeList(i) == ESMF_STATEITEM_FIELDBUNDLE) then @@ -730,6 +841,15 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeGet(fcstFB, convention="NetCDF", purpose="FV3", & + name="grid_id", value=grid_id, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +!--- check grid dim count first + call ESMF_GridGet(wrtGrid(grid_id), dimCount=gridDimCount, rc=rc) + + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! create a mirror FieldBundle and add it to importState fieldbundle = ESMF_FieldBundleCreate(name="mirror_"//trim(fcstItemNameList(i)), rc=rc) @@ -772,7 +892,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_FieldGet(fcstField(j), gridToFieldMap=gridToFieldMap, & ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, & rc=rc) - CALL ESMF_LogWrite("after field create on wrt comp",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("after field create on wrt comp",ESMF_LOGMSG_INFO,rc=RC) ! if (lprnt) print *,'in wrt,fcstfld,fieldname=', & ! trim(fieldname),'fieldDimCount=',fieldDimCount,'gridDimCount=',gridDimCount, & @@ -783,12 +903,12 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! create the mirror field - CALL ESMF_LogWrite("call field create on wrt comp",ESMF_LOGMSG_INFO,rc=RC) - field_work = ESMF_FieldCreate(wrtGrid, typekind, name=fieldName, & + call ESMF_LogWrite("call field create on wrt comp",ESMF_LOGMSG_INFO,rc=RC) + field_work = ESMF_FieldCreate(wrtGrid(grid_id), typekind, name=fieldName, & gridToFieldMap=gridToFieldMap, & ungriddedLBound=ungriddedLBound, & ungriddedUBound=ungriddedUBound, rc=rc) - CALL ESMF_LogWrite("aft call field create on wrt comp",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("aft call field create on wrt comp",ESMF_LOGMSG_INFO,rc=RC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -803,11 +923,11 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) name="output_file", value=outfile_name, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - CALL ESMF_LogWrite("bf fcstfield, get output_file "//trim(outfile_name)//" "//trim(fieldName),ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("bf fcstfield, get output_file "//trim(outfile_name)//" "//trim(fieldName),ESMF_LOGMSG_INFO,rc=RC) if (trim(outfile_name) /= '') then outfilename(j,i) = trim(outfile_name) endif - CALL ESMF_LogWrite("af fcstfield, get output_file",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("af fcstfield, get output_file",ESMF_LOGMSG_INFO,rc=RC) ! if (lprnt) print *,' i=',i,' j=',j,' outfilename=',trim(outfilename(j,i)) @@ -820,7 +940,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) deallocate(gridToFieldMap, ungriddedLBound, ungriddedUBound) enddo ! - call ESMF_AttributeCopy(fcstGrid, wrtGrid, & + call ESMF_AttributeCopy(fcstGrid, wrtGrid(grid_id), & attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -845,7 +965,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! !create output field bundles - allocate(wrt_int_state%wrtFB(num_files)) + allocate(wrt_int_state%wrtFB(wrt_int_state%FBcount)) do i=1, wrt_int_state%FBcount wrt_int_state%wrtFB_names(i) = trim(FBlist_outfilename(i)) @@ -858,13 +978,17 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(n)), & fieldbundle=fcstFB, rc=rc) - if( index(trim(fcstItemNameList(n)),trim(FBlist_outfilename(i))) > 0 ) then + if( index(trim(fcstItemNameList(n)),trim(FBlist_outfilename(i))) == 1 ) then ! ! copy the mirror fcstfield bundle Attributes to the output field bundle call ESMF_AttributeCopy(fcstFB, wrt_int_state%wrtFB(i), & attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeGet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & + name="grid_id", value=grid_id, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, rc=rc) @@ -905,57 +1029,43 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="source", value="FV3GFS", rc=rc) - if (trim(output_grid) == 'cubed_sphere_grid') then + if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="cubed_sphere", rc=rc) - else if (trim(output_grid) == 'gaussian_grid') then + else if (trim(output_grid(grid_id)) == 'gaussian_grid') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="gaussian", rc=rc) call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & attrList=(/"im","jm"/), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="im", value=imo, rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="jm", value=jmo, rc=rc) - - else if (trim(output_grid) == 'global_latlon') then - - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="grid", value="latlon", rc=rc) - call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - attrList=(/"lonstart","latstart","lonlast ","latlast "/), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lonstart", value=wrt_int_state%lonstart, rc=rc) + name="im", value=imo(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="latstart", value=wrt_int_state%latstart, rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lonlast", value=wrt_int_state%lonlast, rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="latlast", value=wrt_int_state%latlast, rc=rc) + name="jm", value=jmo(grid_id), rc=rc) - else if (trim(output_grid) == 'regional_latlon') then + else if (trim(output_grid(grid_id)) == 'regional_latlon' & + .or. trim(output_grid(grid_id)) == 'global_latlon') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="latlon", rc=rc) call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & attrList=(/"lon1","lat1","lon2","lat2","dlon","dlat"/), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon1", value=lon1, rc=rc) + name="lon1", value=lon1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat1", value=lat1, rc=rc) + name="lat1", value=lat1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon2", value=lon2, rc=rc) + name="lon2", value=lon2(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat2", value=lat2, rc=rc) + name="lat2", value=lat2(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dlon", value=dlon, rc=rc) + name="dlon", value=dlon(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dlat", value=dlat, rc=rc) + name="dlat", value=dlat(grid_id), rc=rc) - else if (trim(output_grid) == 'rotated_latlon') then + else if (trim(output_grid(grid_id)) == 'rotated_latlon') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="rotated_latlon", rc=rc) @@ -969,23 +1079,23 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) "dlon ",& "dlat "/), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="cen_lon", value=cen_lon, rc=rc) + name="cen_lon", value=cen_lon(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="cen_lat", value=cen_lat, rc=rc) + name="cen_lat", value=cen_lat(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon1", value=lon1, rc=rc) + name="lon1", value=lon1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat1", value=lat1, rc=rc) + name="lat1", value=lat1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon2", value=lon2, rc=rc) + name="lon2", value=lon2(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat2", value=lat2, rc=rc) + name="lat2", value=lat2(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dlon", value=dlon, rc=rc) + name="dlon", value=dlon(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dlat", value=dlat, rc=rc) + name="dlat", value=dlat(grid_id), rc=rc) - else if (trim(output_grid) == 'lambert_conformal') then + else if (trim(output_grid(grid_id)) == 'lambert_conformal') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="lambert_conformal", rc=rc) @@ -1001,25 +1111,25 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) "dx ",& "dy "/), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="cen_lon", value=cen_lon, rc=rc) + name="cen_lon", value=cen_lon(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="cen_lat", value=cen_lat, rc=rc) + name="cen_lat", value=cen_lat(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="stdlat1", value=stdlat1, rc=rc) + name="stdlat1", value=stdlat1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="stdlat2", value=stdlat2, rc=rc) + name="stdlat2", value=stdlat2(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="nx", value=imo, rc=rc) + name="nx", value=imo(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="ny", value=jmo, rc=rc) + name="ny", value=jmo(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat1", value=lat1, rc=rc) + name="lat1", value=lat1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon1", value=lon1, rc=rc) + name="lon1", value=lon1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dx", value=dx, rc=rc) + name="dx", value=dx(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dy", value=dy, rc=rc) + name="dy", value=dy(grid_id), rc=rc) end if @@ -1066,8 +1176,10 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) endif enddo + + do n = 1, ngrids ! add the transfer attributes from importState to grid - call ESMF_AttributeAdd(wrtgrid, convention="NetCDF", purpose="FV3", & + call ESMF_AttributeAdd(wrtGrid(n), convention="NetCDF", purpose="FV3", & attrList=attNameList(1:j-1), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1093,7 +1205,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if(lprnt) print *,'in write grid comp, new time:unit=',trim(valueS) endif endif - call ESMF_AttributeSet(wrtgrid, convention="NetCDF", purpose="FV3", & + call ESMF_AttributeSet(wrtGrid(n), convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueS, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1105,7 +1217,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrtgrid, convention="NetCDF", purpose="FV3", & + call ESMF_AttributeSet(wrtGrid(n), convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueI4, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1117,7 +1229,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrtgrid, convention="NetCDF", purpose="FV3", & + call ESMF_AttributeSet(wrtGrid(n), convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueR4, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1129,7 +1241,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrtgrid, convention="NetCDF", purpose="FV3", & + call ESMF_AttributeSet(wrtGrid(n), convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueR8, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1138,17 +1250,16 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! Add special attribute that holds names of "time" related attributes ! for faster access during Run(). - call ESMF_AttributeAdd(wrtgrid, convention="NetCDF", purpose="FV3", & + call ESMF_AttributeAdd(wrtGrid(n), convention="NetCDF", purpose="FV3", & attrList=(/"TimeAttributes"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrtgrid, convention="NetCDF", purpose="FV3", & + call ESMF_AttributeSet(wrtGrid(n), convention="NetCDF", purpose="FV3", & name="TimeAttributes", valueList=attNameList2(1:k-1), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - deallocate(attNameList, attNameList2, typekindList) ! !*** create temporary field bundle for axes information @@ -1158,20 +1269,14 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeGet(wrtGrid, convention="NetCDF", purpose="FV3", & - name="ESMF:gridded_dim_labels", valueList=attrValueSList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtGrid, coordDim=1, & + call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, & staggerloc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! write(0,*) 'create gridFB,fieldname=',trim(attrValueSList(1)),trim(attrValueSList(2)), & -! 'lon value=',array(1:5) - - field = ESMF_FieldCreate(wrtGrid, array, name=trim(attrValueSList(1)), rc=rc) + field = ESMF_FieldCreate(wrtGrid(n), array, name="grid_xt", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1213,15 +1318,12 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! ! get 2nd dimension - call ESMF_GridGetCoord(wrtGrid, coordDim=2, & + call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, & staggerloc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! write(0,*) 'create gridFB,fieldname=',trim(attrValueSList(1)),trim(attrValueSList(2)), & -! 'lat value=',array(1:5,1),array(1,1:5) - - field = ESMF_FieldCreate(wrtGrid, array, name=trim(attrValueSList(2)), rc=rc) + field = ESMF_FieldCreate(wrtGrid(n), array, name="grid_yt", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return !add attribute info @@ -1260,6 +1362,10 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_FieldBundleAdd(gridFB, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end do ! n=1, ngrids + + deallocate(attNameList, attNameList2, typekindList) ! !----------------------------------------------------------------------- !*** SET THE FIRST HISTORY FILE'S TIME INDEX. @@ -1274,17 +1380,9 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_LogWrite("before initialize for POST", ESMF_LOGMSG_INFO, rc=rc) if (lprnt) print *,'in wrt grid comp, dopost=',wrt_int_state%write_dopost if( wrt_int_state%write_dopost ) then - call inline_post_getattr(wrt_int_state) + call inline_post_getattr(wrt_int_state,1) endif ! -!----------------------------------------------------------------------- -! - IF(RC /= ESMF_SUCCESS) THEN - WRITE(0,*)"FAIL: Write_Initialize." -! ELSE -! WRITE(0,*)"PASS: Write_Initialize." - ENDIF -! ! write_init_tim = MPI_Wtime() - btim0 ! !----------------------------------------------------------------------- @@ -1312,9 +1410,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) TYPE(ESMF_VM) :: VM type(ESMF_FieldBundle) :: file_bundle type(ESMF_Time) :: currtime - type(ESMF_TypeKind_Flag) :: datatype - type(ESMF_Field) :: field_work - type(ESMF_Grid) :: fbgrid, wrtgrid + type(ESMF_Grid) :: fbgrid, wrtGrid type(ESMF_State),save :: stateGridFB type(optimizeT), save :: optimize(4) type(ESMF_GridComp), save, allocatable :: compsGridFB(:) @@ -1322,34 +1418,27 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) type(write_wrap) :: wrap type(wrt_internal_state),pointer :: wrt_int_state ! - integer :: i,j,n,mype,nolog + integer :: i,j,n,mype,nolog, grid_id ! integer :: nf_hours,nf_seconds, nf_minutes, & nseconds,nseconds_num,nseconds_den ! - integer :: id - integer :: nbdl, idx, date(6), ndig + integer :: nbdl, date(6), ndig, nnnn integer :: step=1 ! logical :: opened logical :: lmask_fields - logical,save :: first=.true. - logical,save :: file_first=.true. ! - character(esmf_maxstr) :: filename,compname,bundle_name + character(esmf_maxstr) :: filename,compname character(40) :: cfhour, cform real(ESMF_KIND_R8) :: time ! - real(kind=8) :: wait_time, MPI_Wtime - real(kind=8) :: times,times2,etim - character(10) :: timeb - real(kind=8) :: tbeg,tend + real(kind=8) :: MPI_Wtime + real(kind=8) :: tbeg real(kind=8) :: wbeg,wend - real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer :: datar8 - real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d -! - logical lprnt + logical :: use_parallel_netcdf + logical :: lprnt ! !----------------------------------------------------------------------- !*********************************************************************** @@ -1359,16 +1448,11 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) rc = esmf_success ! !----------------------------------------------------------------------- -!*** get the current write grid comp name, id, and internal state +!*** get the current write grid comp name, and internal state ! call ESMF_GridCompGet(wrt_comp, name=compname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! print *,'in wrt run. compname=',trim(compname),' rc=',rc - -! instance id from name - read(compname(10:11),"(I2)") id - ! Provide log message indicating which wrtComp is active call ESMF_LogWrite("Write component activated: "//trim(compname), & ESMF_LOGMSG_INFO, rc=rc) @@ -1424,7 +1508,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) nf_seconds = nf_hours*3600+nf_minuteS*60+nseconds+real(nseconds_num)/real(nseconds_den) wrt_int_state%nfhour = nf_seconds/3600. nf_hours = int(nf_seconds/3600.) - if(mype == lead_write_task) print *,'in write grid comp, nf_hours=',nf_hours + if(lprnt) print *,'in write grid comp, nf_hours=',nf_hours ! if iau_offset > nf_hours, don't write out anything if (nf_hours < 0) return @@ -1448,25 +1532,20 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ! ' nf_seconds=',nf_seconds,wrt_int_state%nfhour ! access the time Attribute which is updated by the driver each time - call ESMF_LogWrite("before Write component get time", ESMF_LOGMSG_INFO, rc=rc) call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & name="time", value=time, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_LogWrite("before Write component af get time", ESMF_LOGMSG_INFO, rc=rc) ! !----------------------------------------------------------------------- !*** loop on the files that need to write out !----------------------------------------------------------------------- do i=1, FBCount - call ESMF_LogWrite("before Write component get mirror file bundle", ESMF_LOGMSG_INFO, rc=rc) call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(i)), & fieldbundle=file_bundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite("before Write component af get mirror file bundle", ESMF_LOGMSG_INFO, rc=rc) + !recover fields from cartesian vector and sfc pressure call recover_fields(file_bundle,rc) enddo @@ -1478,26 +1557,25 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if( wrt_int_state%write_dopost ) then ! wbeg = MPI_Wtime() - if (trim(output_grid) == 'regional_latlon' .or. & - trim(output_grid) == 'rotated_latlon' .or. & - trim(output_grid) == 'lambert_conformal') then + if (trim(output_grid(1)) == 'regional_latlon' .or. & + trim(output_grid(1)) == 'rotated_latlon' .or. & + trim(output_grid(1)) == 'lambert_conformal') then !mask fields according to sfc pressure do nbdl=1, wrt_int_state%FBCount - call ESMF_LogWrite("before mask_fields for wrt field bundle", ESMF_LOGMSG_INFO, rc=rc) call mask_fields(wrt_int_state%wrtFB(nbdl),rc) - call ESMF_LogWrite("after mask_fields for wrt field bundle", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo lmask_fields = .true. endif - call inline_post_run(wrt_int_state, mype, wrt_mpi_comm, lead_write_task, & + call inline_post_run(wrt_int_state, 1, mype, wrt_mpi_comm, lead_write_task, & nf_hours, nf_minutes,nseconds) wend = MPI_Wtime() if (lprnt) then write(*,'(A,F10.5,A,I4.2,A,I2.2)')' actual inline post Time is ',wend-wbeg & ,' at Fcst ',nf_hours,':',nf_minutes - endif + endif endif ! @@ -1509,52 +1587,60 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) file_loop_all: do nbdl=1, wrt_int_state%FBCount ! + ! get grid_id + call ESMF_AttributeGet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="grid_id", value=grid_id, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if(step == 1) then file_bundle = wrt_int_state%wrtFB(nbdl) endif + ! FIXME map nbdl to [1:num_files], only used for output_file + nnnn = mod(nbdl-1, num_files) + 1 + ! set default chunksizes for netcdf output ! (use MPI decomposition size). ! if chunksize parameter set to negative value, ! netcdf library default is used. - if (output_file(nbdl)(1:6) == 'netcdf') then - if (ichunk2d == 0) then + if (output_file(nnnn)(1:6) == 'netcdf') then + if (ichunk2d(grid_id) == 0) then if( wrt_int_state%mype == 0 ) & - ichunk2d = wrt_int_state%lon_end-wrt_int_state%lon_start+1 - call mpi_bcast(ichunk2d,1,mpi_integer,0,wrt_mpi_comm,rc) + ichunk2d(grid_id) = wrt_int_state%lon_end-wrt_int_state%lon_start+1 + call mpi_bcast(ichunk2d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif - if (jchunk2d == 0) then + if (jchunk2d(grid_id) == 0) then if( wrt_int_state%mype == 0 ) & - jchunk2d = wrt_int_state%lat_end-wrt_int_state%lat_start+1 - call mpi_bcast(jchunk2d,1,mpi_integer,0,wrt_mpi_comm,rc) + jchunk2d(grid_id) = wrt_int_state%lat_end-wrt_int_state%lat_start+1 + call mpi_bcast(jchunk2d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif - if (ichunk3d == 0) then + if (ichunk3d(grid_id) == 0) then if( wrt_int_state%mype == 0 ) & - ichunk3d = wrt_int_state%lon_end-wrt_int_state%lon_start+1 - call mpi_bcast(ichunk3d,1,mpi_integer,0,wrt_mpi_comm,rc) + ichunk3d(grid_id) = wrt_int_state%lon_end-wrt_int_state%lon_start+1 + call mpi_bcast(ichunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif - if (jchunk3d == 0) then + if (jchunk3d(grid_id) == 0) then if( wrt_int_state%mype == 0 ) & - jchunk3d = wrt_int_state%lat_end-wrt_int_state%lat_start+1 - call mpi_bcast(jchunk3d,1,mpi_integer,0,wrt_mpi_comm,rc) + jchunk3d(grid_id) = wrt_int_state%lat_end-wrt_int_state%lat_start+1 + call mpi_bcast(jchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif - if (kchunk3d == 0 .and. nbdl == 1) then + if (kchunk3d(grid_id) == 0 .and. nbdl == 1) then if( wrt_int_state%mype == 0 ) then - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), grid=wrtgrid) - call ESMF_AttributeGet(wrtgrid, convention="NetCDF", purpose="FV3", & + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), grid=wrtGrid) + call ESMF_AttributeGet(wrtGrid, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, name='pfull', & - itemCount=kchunk3d, rc=rc) + itemCount=kchunk3d(grid_id), rc=rc) endif - call mpi_bcast(kchunk3d,1,mpi_integer,0,wrt_mpi_comm,rc) + call mpi_bcast(kchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif if (wrt_int_state%mype == 0) then - print *,'ichunk2d,jchunk2d',ichunk2d,jchunk2d - print *,'ichunk3d,jchunk3d,kchunk3d',ichunk3d,jchunk3d,kchunk3d + print *,'ichunk2d,jchunk2d',ichunk2d(grid_id),jchunk2d(grid_id) + print *,'ichunk3d,jchunk3d,kchunk3d',ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id) endif endif filename = trim(wrt_int_state%wrtFB_names(nbdl))//'f'//trim(cfhour)//'.nc' -! if(mype == lead_write_task) print *,'in wrt run,filename=',trim(filename) + if(mype == lead_write_task) print *,'in wrt run,filename= ',nbdl,trim(filename) ! ! set the time Attribute on the grid to carry it into the lower levels @@ -1573,183 +1659,86 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (trim(output_grid) == 'cubed_sphere_grid') then - - wbeg = MPI_Wtime() - call ESMFproto_FieldBundleWrite(gridFB, filename=trim(filename), & - convention="NetCDF", purpose="FV3", & - status=ESMF_FILESTATUS_REPLACE, & - state=stateGridFB, comps=compsGridFB,rc=rc) - - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMFproto_FieldBundleWrite(wrt_int_state%wrtFB(nbdl), & - filename=trim(filename), convention="NetCDF", & - purpose="FV3", status=ESMF_FILESTATUS_OLD, & - timeslice=step, state=optimize(nbdl)%state, & - comps=optimize(nbdl)%comps, rc=rc) - - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - wend = MPI_Wtime() - if (lprnt) then - write(*,'(A,F10.5,A,I4.2,A,I2.2)')' actual netcdf Write Time is ',wend-wbeg & - ,' at Fcst ',NF_HOURS,':',NF_MINUTES - endif - - else if (trim(output_grid) == 'gaussian_grid') then - - if (trim(output_file(nbdl)) == 'netcdf') then - - wbeg = MPI_Wtime() - call write_netcdf(file_bundle,wrt_int_state%wrtFB(nbdl),trim(filename), & - wrt_mpi_comm,wrt_int_state%mype,imo,jmo,& - ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d,rc) - wend = MPI_Wtime() - if (lprnt) then - write(*,'(A,F10.5,A,I4.2,A,I2.2)')' netcdf Write Time is ',wend-wbeg & - ,' at Fcst ',NF_HOURS,':',NF_MINUTES - endif - - else if (trim(output_file(nbdl)) == 'netcdf_parallel') then - -#ifdef NO_PARALLEL_NETCDF - rc = ESMF_RC_NOT_IMPL - print *,'netcdf_parallel not available on this machine' - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return -#endif - wbeg = MPI_Wtime() - call write_netcdf_parallel(file_bundle,wrt_int_state%wrtFB(nbdl), & - trim(filename), wrt_mpi_comm,wrt_int_state%mype,imo,jmo,& - ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d,rc) - wend = MPI_Wtime() - if (lprnt) then - write(*,'(A,F10.5,A,I4.2,A,I2.2)')' parallel netcdf Write Time is ',wend-wbeg & - ,' at Fcst ',NF_HOURS,':',NF_MINUTES - endif + if (trim(output_file(nnnn)) == 'netcdf') then + use_parallel_netcdf = .false. + else if (trim(output_file(nnnn)) == 'netcdf_parallel') then + use_parallel_netcdf = .true. + else + call ESMF_LogWrite("wrt_run: Unknown output_file",ESMF_LOGMSG_ERROR,rc=RC) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif - else if (trim(output_file(nbdl)) == 'netcdf_esmf') then + if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then - wbeg = MPI_Wtime() - call ESMFproto_FieldBundleWrite(gridFB, filename=trim(filename), & - convention="NetCDF", purpose="FV3", & - status=ESMF_FILESTATUS_REPLACE, state=stateGridFB, comps=compsGridFB,rc=rc) + wbeg = MPI_Wtime() + if (trim(output_file(nnnn)) == 'netcdf_parallel') then + call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & + .true., wrt_mpi_comm,wrt_int_state%mype, & + grid_id,rc) + else + call ESMFproto_FieldBundleWrite(gridFB, filename=trim(filename), & + convention="NetCDF", purpose="FV3", & + status=ESMF_FILESTATUS_REPLACE, & + state=stateGridFB, comps=compsGridFB,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMFproto_FieldBundleWrite(wrt_int_state%wrtFB(nbdl), & - filename=trim(filename), convention="NetCDF", & - purpose="FV3", status=ESMF_FILESTATUS_OLD, & - timeslice=step, state=optimize(nbdl)%state, & + call ESMFproto_FieldBundleWrite(wrt_int_state%wrtFB(nbdl), & + filename=trim(filename), convention="NetCDF", & + purpose="FV3", status=ESMF_FILESTATUS_OLD, & + timeslice=step, state=optimize(nbdl)%state, & comps=optimize(nbdl)%comps, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - wend = MPI_Wtime() - if (lprnt) then - write(*,'(A,F10.5,A,I4.2,A,I2.2)')' netcdf_esmf Write Time is ',wend-wbeg & - ,' at Fcst ',NF_HOURS,':',NF_MINUTES - endif + end if + wend = MPI_Wtime() + if (lprnt) then + write(*,'(A15,A,F10.5,A,I4.2,A,I2.2,1X,A)')trim(output_file(nnnn)),' Write Time is ',wend-wbeg & + ,' at Fcst ',NF_HOURS,':',NF_MINUTES endif - else if (trim(output_grid) == 'global_latlon') then - - if (trim(output_file(nbdl)) == 'netcdf') then - - wbeg = MPI_Wtime() - call write_netcdf(file_bundle,wrt_int_state%wrtFB(nbdl),trim(filename), & - wrt_mpi_comm,wrt_int_state%mype,imo,jmo,& - ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d,rc) - wend = MPI_Wtime() - if (lprnt) then - write(*,'(A,F10.5,A,I4.2,A,I2.2)')' netcdf Write Time is ',wend-wbeg & - ,' at Fcst ',NF_HOURS,':',NF_MINUTES - endif - - else if (trim(output_file(nbdl)) == 'netcdf_parallel') then - -#ifdef NO_PARALLEL_NETCDF - rc = ESMF_RC_NOT_IMPL - print *,'netcdf_parallel not available on this machine' - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return -#endif - wbeg = MPI_Wtime() - call write_netcdf_parallel(file_bundle,wrt_int_state%wrtFB(nbdl), & - trim(filename), wrt_mpi_comm,wrt_int_state%mype,imo,jmo,& - ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d,rc) - wend = MPI_Wtime() - if (lprnt) then - write(*,'(A,F10.5,A,I4.2,A,I2.2)')' parallel netcdf Write Time is ',wend-wbeg & - ,' at Fcst ',NF_HOURS,':',NF_MINUTES - endif - - else ! unknown output_file - - call ESMF_LogWrite("wrt_run: Unknown output_file",ESMF_LOGMSG_ERROR,rc=RC) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + else if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & + trim(output_grid(grid_id)) == 'global_latlon') then + wbeg = MPI_Wtime() + call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & + use_parallel_netcdf, wrt_mpi_comm,wrt_int_state%mype, & + grid_id,rc) + wend = MPI_Wtime() + if (lprnt) then + write(*,'(A15,A,F10.5,A,I4.2,A,I2.2,1X,A)')trim(output_file(nnnn)),' Write Time is ',wend-wbeg & + ,' at Fcst ',NF_HOURS,':',NF_MINUTES endif - else if (trim(output_grid) == 'regional_latlon' .or. & - trim(output_grid) == 'rotated_latlon' .or. & - trim(output_grid) == 'lambert_conformal') then + else if (trim(output_grid(grid_id)) == 'regional_latlon' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon' .or. & + trim(output_grid(grid_id)) == 'lambert_conformal') then !mask fields according to sfc pressure - !if (mype == lead_write_task) print *,'before mask_fields' if( .not. lmask_fields ) then wbeg = MPI_Wtime() - call ESMF_LogWrite("before mask_fields for wrt field bundle", ESMF_LOGMSG_INFO, rc=rc) - !call mask_fields(wrt_int_state%wrtFB(nbdl),rc) call mask_fields(file_bundle,rc) - !if (mype == lead_write_task) print *,'after mask_fields' - call ESMF_LogWrite("after mask_fields for wrt field bundle", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return wend = MPI_Wtime() - if (mype == lead_write_task) then + if (lprnt) then write(*,'(A,F10.5,A,I4.2,A,I2.2)')' mask_fields time is ',wend-wbeg endif endif - if (trim(output_file(nbdl)) == 'netcdf' .and. nbits==0) then - - wbeg = MPI_Wtime() - call write_netcdf(file_bundle,wrt_int_state%wrtFB(nbdl),trim(filename), & - wrt_mpi_comm,wrt_int_state%mype,imo,jmo,& - ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d,rc) - wend = MPI_Wtime() - if (mype == lead_write_task) then - write(*,'(A,F10.5,A,I4.2,A,I2.2)')' netcdf Write Time is ',wend-wbeg & - ,' at Fcst ',NF_HOURS,':',NF_MINUTES - endif - - else if (trim(output_file(nbdl)) == 'netcdf_parallel' .and. nbits==0) then - -#ifdef NO_PARALLEL_NETCDF - rc = ESMF_RC_NOT_IMPL - print *,'netcdf_parallel not available on this machine' - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return -#endif - wbeg = MPI_Wtime() - call write_netcdf_parallel(file_bundle,wrt_int_state%wrtFB(nbdl), & - trim(filename), wrt_mpi_comm,wrt_int_state%mype,imo,jmo,& - ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d,rc) - wend = MPI_Wtime() - if (lprnt) then - write(*,'(A,F10.5,A,I4.2,A,I2.2)')' parallel netcdf Write Time is ',wend-wbeg & - ,' at Fcst ',NF_HOURS,':',NF_MINUTES - endif - else ! unknown output_file - - if( nbits /= 0) then - call ESMF_LogWrite("wrt_run: lossy compression is not supported for regional grids",ESMF_LOGMSG_ERROR,rc=RC) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - else - call ESMF_LogWrite("wrt_run: Unknown output_file",ESMF_LOGMSG_ERROR,rc=RC) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif + if (nbits(grid_id) /= 0) then + call ESMF_LogWrite("wrt_run: lossy compression is not supported for regional grids",ESMF_LOGMSG_ERROR,rc=RC) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + wbeg = MPI_Wtime() + call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & + use_parallel_netcdf, wrt_mpi_comm,wrt_int_state%mype, & + grid_id,rc) + wend = MPI_Wtime() + if (lprnt) then + write(*,'(A15,A,F10.5,A,I4.2,A,I2.2,1X,A)')trim(output_file(nnnn)),' Write Time is ',wend-wbeg & + ,' at Fcst ',NF_HOURS,':',NF_MINUTES endif else ! unknown output_grid @@ -1766,7 +1755,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ! !** write out log file ! - if(mype == lead_write_task) then + if (mype == lead_write_task) then do n=701,900 inquire(n,opened=OPENED) if(.not.opened)then @@ -1785,6 +1774,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) !----------------------------------------------------------------------- ! call ESMF_VMBarrier(VM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! write_run_tim = MPI_Wtime() - tbeg ! @@ -1792,12 +1782,6 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) WRITE(*,'(A,F10.5,A,I4.2,A,I2.2)')' total Write Time is ',write_run_tim & ,' at Fcst ',NF_HOURS,':',NF_MINUTES ENDIF -! - IF(RC /= ESMF_SUCCESS) THEN - WRITE(0,*)"FAIL: WRITE_RUN" -! ELSE -! WRITE(0,*)"PASS: WRITE_RUN" - ENDIF ! !----------------------------------------------------------------------- ! @@ -1840,21 +1824,14 @@ subroutine wrt_finalize(wrt_comp, imp_state_write, exp_state_write, clock, rc) !----------------------------------------------------------------------- ! call ESMF_GridCompGetInternalState(wrt_comp, wrap, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + deallocate(wrap%write_int_state,stat=stat) -! if (ESMF_LogFoundDeallocError(statusToCheck=stat, & msg="Deallocation of internal state memory failed.", & line=__LINE__, file=__FILE__)) return ! !----------------------------------------------------------------------- -! - IF(RC /= ESMF_SUCCESS)THEN - WRITE(0,*)'FAIL: Write_Finalize.' -! ELSE -! WRITE(0,*)'PASS: Write_Finalize.' - ENDIF -! -!----------------------------------------------------------------------- ! end subroutine wrt_finalize ! @@ -1865,8 +1842,12 @@ subroutine recover_fields(file_bundle,rc) type(ESMF_FieldBundle), intent(in) :: file_bundle integer, intent(out), optional :: rc ! + real, parameter :: rdgas = 287.04, grav = 9.80 + real, parameter :: stndrd_atmos_ps = 101325. + real, parameter :: stndrd_atmos_lapse = 0.0065 + integer i,j,k,ifld,fieldCount,nstt,nend,fieldDimCount,gridDimCount - integer istart,iend,jstart,jend,kstart,kend,km + integer istart,iend,jstart,jend,kstart,kend logical uPresent, vPresent type(ESMF_Grid) fieldGrid type(ESMF_Field) ufield, vfield @@ -1880,68 +1861,63 @@ subroutine recover_fields(file_bundle,rc) real(ESMF_KIND_R4), dimension(:,:,:), pointer :: uwind3dr4,vwind3dr4 real(ESMF_KIND_R4), dimension(:,:,:), pointer :: cart3dPtr2dr4 real(ESMF_KIND_R4), dimension(:,:,:,:), pointer :: cart3dPtr3dr4 - real(ESMF_KIND_R8), dimension(:,:,:,:), pointer :: cart3dPtr3dr8 - save lonloc, latloc real(ESMF_KIND_R8) :: coslon, sinlon, sinlat ! ! get filed count call ESMF_FieldBundleGet(file_bundle, fieldCount=fieldCount, & grid=fieldGrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! - CALL ESMF_LogWrite("call recover field on wrt comp",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("call recover field on wrt comp",ESMF_LOGMSG_INFO,rc=RC) call ESMF_GridGet(fieldgrid, dimCount=gridDimCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if( first_getlatlon ) then - CALL ESMF_LogWrite("call recover field get coord 1",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("call recover field get coord 1",ESMF_LOGMSG_INFO,rc=RC) - call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lon, rc=rc) + call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lon, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(lonloc(lbound(lon,1):ubound(lon,1),lbound(lon,2):ubound(lon,2))) - istart = lbound(lon,1) - iend = ubound(lon,1) - jstart = lbound(lon,2) - jend = ubound(lon,2) + allocate(lonloc(lbound(lon,1):ubound(lon,1),lbound(lon,2):ubound(lon,2))) + istart = lbound(lon,1) + iend = ubound(lon,1) + jstart = lbound(lon,2) + jend = ubound(lon,2) !$omp parallel do default(none) shared(lon,lonloc,jstart,jend,istart,iend) & !$omp private(i,j) - do j=jstart,jend - do i=istart,iend - lonloc(i,j) = lon(i,j) * pi/180. - enddo - enddo + do j=jstart,jend + do i=istart,iend + lonloc(i,j) = lon(i,j) * pi/180. + enddo + enddo - CALL ESMF_LogWrite("call recover field get coord 2",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("call recover field get coord 2",ESMF_LOGMSG_INFO,rc=RC) - call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=lat, rc=rc) + call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=lat, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(latloc(lbound(lat,1):ubound(lat,1),lbound(lat,2):ubound(lat,2))) - istart = lbound(lat,1) - iend = ubound(lat,1) - jstart = lbound(lat,2) - jend = ubound(lat,2) + allocate(latloc(lbound(lat,1):ubound(lat,1),lbound(lat,2):ubound(lat,2))) + istart = lbound(lat,1) + iend = ubound(lat,1) + jstart = lbound(lat,2) + jend = ubound(lat,2) !$omp parallel do default(none) shared(lat,latloc,jstart,jend,istart,iend) & !$omp private(i,j) - do j=jstart,jend - do i=istart,iend - latloc(i,j) = lat(i,j) * pi/180.d0 - enddo - enddo - first_getlatlon = .false. - endif + do j=jstart,jend + do i=istart,iend + latloc(i,j) = lat(i,j) * pi/180.d0 + enddo + enddo ! allocate(fcstField(fieldCount)) - CALL ESMF_LogWrite("call recover field get fcstField",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("call recover field get fcstField",ESMF_LOGMSG_INFO,rc=RC) call ESMF_FieldBundleGet(file_bundle, fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) ! do ifld=1,fieldCount - CALL ESMF_LogWrite("call recover field get fieldname, type dimcount",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("call recover field get fieldname, type dimcount",ESMF_LOGMSG_INFO,rc=RC) call ESMF_FieldGet(fcstField(ifld),name=fieldName,typekind=typekind,dimCount=fieldDimCount, rc=rc) ! convert back wind @@ -1957,7 +1933,7 @@ subroutine recover_fields(file_bundle,rc) endif ! print *,'in get 3D vector wind, uwindname=',trim(uwindname),' v=', trim(vwindname),' fieldname=',trim(fieldname) ! get u , v wind - CALL ESMF_LogWrite("call recover field get u, v field",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("call recover field get u, v field",ESMF_LOGMSG_INFO,rc=RC) call ESMF_FieldBundleGet(file_bundle,trim(uwindname),field=ufield,isPresent=uPresent,rc=rc) call ESMF_FieldBundleGet(file_bundle,trim(vwindname),field=vfield,isPresent=vPresent,rc=rc) if(.not. uPresent .or. .not.vPresent) then @@ -1969,7 +1945,7 @@ subroutine recover_fields(file_bundle,rc) ! get field data if ( typekind == ESMF_TYPEKIND_R4 ) then if( fieldDimCount > gridDimCount+1 ) then - CALL ESMF_LogWrite("call recover field get 3d card wind farray",ESMF_LOGMSG_INFO,rc=RC) + call ESMF_LogWrite("call recover field get 3d card wind farray",ESMF_LOGMSG_INFO,rc=RC) call ESMF_FieldGet(fcstField(ifld), localDe=0, farrayPtr=cart3dPtr3dr4, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if( ubound(cart3dPtr3dr4,1)-lbound(cart3dPtr3dr4,1)+1/=3) then @@ -2006,11 +1982,11 @@ subroutine recover_fields(file_bundle,rc) enddo else call ESMF_FieldGet(fcstField(ifld), localDe=0, farrayPtr=cart3dPtr2dr4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if( ubound(cart3dPtr2dr4,1)-lbound(cart3dPtr2dr4,1)+1 /= 3) then rc=991 - print *,'ERROR, 2D the vector dimension /= 3, rc=',rc - exit + write(0,*) 'ERROR, 2D the vector dimension /= 3, rc=',rc + call ESMF_Finalize(endflag=ESMF_END_ABORT) endif istart = lbound(cart3dPtr2dr4,2) iend = ubound(cart3dPtr2dr4,2) @@ -2067,8 +2043,8 @@ subroutine mask_fields(file_bundle,rc) type(ESMF_FieldBundle), intent(in) :: file_bundle integer, intent(out), optional :: rc ! - integer i,j,k,ifld,fieldCount,nstt,nend,fieldDimCount,gridDimCount - integer istart,iend,jstart,jend,kstart,kend,km + integer i,j,k,ifld,fieldCount,fieldDimCount,gridDimCount + integer istart,iend,jstart,jend,kstart,kend type(ESMF_Grid) fieldGrid type(ESMF_TypeKind_Flag) typekind type(ESMF_TypeKind_Flag) attTypeKind @@ -2085,8 +2061,6 @@ subroutine mask_fields(file_bundle,rc) real(ESMF_KIND_R8) :: missing_value_r8=9.99e20 character(len=ESMF_MAXSTR) :: msg - save maskwrt - call ESMF_LogWrite("call mask field on wrt comp",ESMF_LOGMSG_INFO,rc=RC) ! get fieldCount @@ -2104,8 +2078,6 @@ subroutine mask_fields(file_bundle,rc) call ESMF_FieldBundleGet(file_bundle, fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) ! generate the maskwrt according to surface pressure - if( first_getmaskwrt ) then - do ifld=1,fieldCount !call ESMF_LogWrite("call mask field get fieldname, type dimcount",ESMF_LOGMSG_INFO,rc=RC) call ESMF_FieldGet(fcstField(ifld),name=fieldName,typekind=typekind,dimCount=fieldDimCount, rc=rc) @@ -2142,9 +2114,6 @@ subroutine mask_fields(file_bundle,rc) exit endif enddo - first_getmaskwrt = .false. - - endif !first_getmaskwrt ! loop to mask all fields according to maskwrt do ifld=1,fieldCount @@ -2164,8 +2133,8 @@ subroutine mask_fields(file_bundle,rc) line=__LINE__, file=__FILE__)) return ! bail out if( ubound(vect4dPtr3dr4,1)-lbound(vect4dPtr3dr4,1)+1/=3 ) then rc=991 - print *,'ERROR, 3D the vector dimension /= 3, rc=',rc - exit + write(0,*) 'ERROR, 3D the vector dimension /= 3, rc=',rc + call ESMF_Finalize(endflag=ESMF_END_ABORT) endif ! Get the _FillValue from the field attribute if exists call ESMF_AttributeGet(fcstField(ifld), convention="NetCDF", purpose="FV3", & @@ -2207,8 +2176,8 @@ subroutine mask_fields(file_bundle,rc) line=__LINE__, file=__FILE__)) return ! bail out if( ubound(vect3dPtr2dr4,1)-lbound(vect3dPtr2dr4,1)+1 /= 3 ) then rc=991 - print *,'ERROR, 2D the vector dimension /= 3, rc=',rc - exit + write(0,*) 'ERROR, 2D the vector dimension /= 3, rc=',rc + call ESMF_Finalize(endflag=ESMF_END_ABORT) endif ! Get the _FillValue from the field attribute if exists call ESMF_AttributeGet(fcstField(ifld), convention="NetCDF", purpose="FV3", & @@ -2318,6 +2287,7 @@ subroutine mask_fields(file_bundle,rc) endif enddo ! + deallocate(maskwrt) deallocate(fcstField) rc = 0 @@ -3346,12 +3316,12 @@ subroutine splat4(idrt,jmax,aslat) 121.737742088d0, 124.879308913d0, 128.020877005d0, 131.162446275d0, & 134.304016638d0, 137.445588020d0, 140.587160352d0, 143.728733573d0, & 146.870307625d0, 150.011882457d0, 153.153458019d0, 156.295034268d0 / - real(8) :: dlt,d1=1.d0 - integer :: jhe,jho,j0=0 + real(8) :: dlt + integer :: jhe,jho ! real(8),parameter :: PI=3.14159265358979d0,C=(1.d0-(2.d0/PI)**2)*0.25d0 real(8),parameter :: C=(1.d0-(2.d0/PI)**2)*0.25d0 real(8) r - integer jh,js,n,j + integer jh,n,j ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! GAUSSIAN LATITUDES IF(IDRT.EQ.4) THEN @@ -3456,12 +3426,12 @@ subroutine splat8(idrt,jmax,aslat) 121.737742088d0, 124.879308913d0, 128.020877005d0, 131.162446275d0, & 134.304016638d0, 137.445588020d0, 140.587160352d0, 143.728733573d0, & 146.870307625d0, 150.011882457d0, 153.153458019d0, 156.295034268d0 / - real(8) :: dlt,d1=1.d0 - integer(4) :: jhe,jho,j0=0 + real(8) :: dlt + integer(4) :: jhe,jho ! real(8),parameter :: PI=3.14159265358979d0,C=(1.d0-(2.d0/PI)**2)*0.25d0 real(8),parameter :: C=(1.d0-(2.d0/PI)**2)*0.25d0 real(8) r - integer jh,js,n,j + integer jh,n,j ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! GAUSSIAN LATITUDES IF(IDRT.EQ.4) THEN @@ -3611,7 +3581,7 @@ subroutine lambert(stlat1,stlat2,c_lat,c_lon,glon,glat,x,y,inv) ! inv == 1 (glon,glat) ---> (x,y) lat/lon to grid ! inv == -1 (x,y) ---> (glon,glat) grid to lat/lon - real(ESMF_KIND_R8) :: en,f,rho,rho0, dlon, theta, xp, yp + real(ESMF_KIND_R8) :: en,f,rho,rho0, dlon, theta IF (stlat1 == stlat2) THEN en=sin(stlat1*dtor) @@ -3653,7 +3623,7 @@ subroutine get_outfile(nfl, filename, outfile_name,noutfile) character(*), intent(inout) :: outfile_name(:) integer, intent(inout) :: noutfile - integer :: i,j,n,idx + integer :: i,j,n logical :: found ! noutfile = 0 diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 08079d9c9..c0adaa0a5 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -368,7 +368,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & avgetrans, avgesnow, avgprec_cont, avgcprate_cont,& avisbeamswin, avisdiffswin, airbeamswin, airdiffswin, & alwoutc, alwtoac, aswoutc, aswtoac, alwinc, aswinc,& - avgpotevp, snoavg, ti, si, cuppt + avgpotevp, snoavg, ti, si, cuppt, fdnsst use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & @@ -505,13 +505,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! GFS does not have surface specific humidity ! inst sensible heat flux ! inst latent heat flux -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) +!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths,fdnsst) do j=jsta,jend do i=1,im qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL ths(i,j) = SPVAL + fdnsst(i,j) = SPVAL enddo enddo @@ -917,6 +918,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo endif + ! foundation temperature + if(trim(fieldname)=='tref') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,fdnsst) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + fdnsst(i,j) = arrayr42d(i,j) + endif + enddo + enddo + endif + ! convective precip in m per physics time step if(trim(fieldname)=='cpratb_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) diff --git a/io/post_regional.F90 b/io/post_regional.F90 index 44ea99b2e..a42e10475 100644 --- a/io/post_regional.F90 +++ b/io/post_regional.F90 @@ -220,7 +220,7 @@ end subroutine post_run_regional ! !----------------------------------------------------------------------- ! - subroutine post_getattr_regional(wrt_int_state) + subroutine post_getattr_regional(wrt_int_state,grid_id) ! use esmf use ctlblk_mod, only: im, jm, mpi_comm_comp,gdsdegr,spval @@ -236,6 +236,7 @@ subroutine post_getattr_regional(wrt_int_state) implicit none ! type(wrt_internal_state),intent(inout) :: wrt_int_state + integer, intent(in) :: grid_id ! ! local variable integer i,j,k,n,kz, attcount, nfb @@ -254,92 +255,92 @@ subroutine post_getattr_regional(wrt_int_state) fldbundle = wrt_int_state%wrtFB(nfb) ! set grid spec: -! if(mype==0) print*,'in post_getattr_lam,output_grid=',trim(output_grid),'nfb=',nfb +! if(mype==0) print*,'in post_getattr_lam,output_grid=',trim(output_grid(grid_id)),'nfb=',nfb ! if(mype==0) print*,'in post_getattr_lam, lon1=',lon1,lon2,lat1,lat2,dlon,dlat gdsdegr = 1000000. - if(trim(output_grid) == 'regional_latlon') then + if(trim(output_grid(grid_id)) == 'regional_latlon') then MAPTYPE=0 gridtype='A' - if( lon1<0 ) then - lonstart = nint((lon1+360.)*gdsdegr) + if( lon1(grid_id)<0 ) then + lonstart = nint((lon1(grid_id)+360.)*gdsdegr) else - lonstart = nint(lon1*gdsdegr) + lonstart = nint(lon1(grid_id)*gdsdegr) endif - if( lon2<0 ) then - lonlast = nint((lon2+360.)*gdsdegr) + if( lon2(grid_id)<0 ) then + lonlast = nint((lon2(grid_id)+360.)*gdsdegr) else - lonlast = nint(lon2*gdsdegr) + lonlast = nint(lon2(grid_id)*gdsdegr) endif - latstart = nint(lat1*gdsdegr) - latlast = nint(lat2*gdsdegr) + latstart = nint(lat1(grid_id)*gdsdegr) + latlast = nint(lat2(grid_id)*gdsdegr) - dxval = dlon*gdsdegr - dyval = dlat*gdsdegr + dxval = dlon(grid_id)*gdsdegr + dyval = dlat(grid_id)*gdsdegr ! if(mype==0) print*,'lonstart,latstart,dyval,dxval', & ! lonstart,lonlast,latstart,latlast,dyval,dxval - else if(trim(output_grid) == 'lambert_conformal') then + else if(trim(output_grid(grid_id)) == 'lambert_conformal') then MAPTYPE=1 GRIDTYPE='A' - if( cen_lon<0 ) then - cenlon = nint((cen_lon+360.)*gdsdegr) + if( cen_lon(grid_id)<0 ) then + cenlon = nint((cen_lon(grid_id)+360.)*gdsdegr) else - cenlon = nint(cen_lon*gdsdegr) + cenlon = nint(cen_lon(grid_id)*gdsdegr) endif - cenlat = cen_lat*gdsdegr - if( lon1<0 ) then - lonstart = nint((lon1+360.)*gdsdegr) + cenlat = cen_lat(grid_id)*gdsdegr + if( lon1(grid_id)<0 ) then + lonstart = nint((lon1(grid_id)+360.)*gdsdegr) else - lonstart = nint(lon1*gdsdegr) + lonstart = nint(lon1(grid_id)*gdsdegr) endif - latstart = nint(lat1*gdsdegr) + latstart = nint(lat1(grid_id)*gdsdegr) - truelat1 = nint(stdlat1*gdsdegr) - truelat2 = nint(stdlat2*gdsdegr) + truelat1 = nint(stdlat1(grid_id)*gdsdegr) + truelat2 = nint(stdlat2(grid_id)*gdsdegr) - if(dxin atm_int_state - call ESMF_GridCompSetInternalState(fcst_comp, wrap, rc) + call ESMF_VMGetCurrent(vm=vm,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! - call ESMF_VMGetCurrent(vm=VM,rc=RC) - call ESMF_VMGet(vm=VM, localPet=mype, mpiCommunicator=fcst_mpi_comm, & + + call ESMF_VMGet(vm=vm, localPet=mype, mpiCommunicator=fcst_mpi_comm, & petCount=fcst_ntasks, rc=rc) - if (mype == 0) write(0,*)'in fcst comp init, fcst_ntasks=',fcst_ntasks -! + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (mype == 0) write(*,*)'in fcst comp init, fcst_ntasks=',fcst_ntasks + CF = ESMF_ConfigCreate(rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ConfigLoadFile(config=CF ,filename='model_configure' ,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + num_restart_interval = ESMF_ConfigGetLen(config=CF, label ='restart_interval:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(mype == 0) print *,'af nems config,num_restart_interval=',num_restart_interval + if (mype == 0) print *,'af nems config,num_restart_interval=',num_restart_interval if (num_restart_interval<=0) num_restart_interval = 1 allocate(restart_interval(num_restart_interval)) restart_interval = 0 call ESMF_ConfigGetAttribute(CF,valueList=restart_interval,label='restart_interval:', & - count=num_restart_interval, rc=rc) + count=num_restart_interval, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(mype == 0) print *,'af nems config,restart_interval=',restart_interval - + if (mype == 0) print *,'af nems config,restart_interval=',restart_interval ! call fms_init(fcst_mpi_comm) call mpp_init() initClock = mpp_clock_id( 'Initialization' ) call mpp_clock_begin (initClock) !nesting problem - call fms_init call constants_init call sat_vapor_pres_init -! - if ( force_date_from_configure ) then - - select case( uppercase(trim(calendar)) ) - case( 'JULIAN' ) - calendar_type = JULIAN - case( 'GREGORIAN' ) - calendar_type = GREGORIAN - case( 'NOLEAP' ) - calendar_type = NOLEAP - case( 'THIRTY_DAY' ) - calendar_type = THIRTY_DAY_MONTHS - case( 'NO_CALENDAR' ) - calendar_type = NO_CALENDAR - case default - call mpp_error ( FATAL, 'fcst_initialize: calendar must be one of '// & - 'JULIAN|GREGORIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) - end select - endif -! - call set_calendar_type (calendar_type ) + select case( uppercase(trim(calendar)) ) + case( 'JULIAN' ) + calendar_type = JULIAN + case( 'GREGORIAN' ) + calendar_type = GREGORIAN + case( 'NOLEAP' ) + calendar_type = NOLEAP + case( 'THIRTY_DAY' ) + calendar_type = THIRTY_DAY_MONTHS + case( 'NO_CALENDAR' ) + calendar_type = NO_CALENDAR + case default + call mpp_error ( FATAL, 'fcst_initialize: calendar must be one of '// & + 'JULIAN|GREGORIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) + end select + + call set_calendar_type (calendar_type) ! !----------------------------------------------------------------------- !*** set atmos time @@ -293,61 +443,105 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) call ESMF_ClockGet(clock, CurrTime=CurrTime, StartTime=StartTime, & StopTime=StopTime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - RunDuration = StopTime - CurrTime date_init = 0 call ESMF_TimeGet (StartTime, & YY=date_init(1), MM=date_init(2), DD=date_init(3), & - H=date_init(4), M =date_init(5), S =date_init(6), RC=rc) + H=date_init(4), M =date_init(5), S =date_init(6), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if ( date_init(1) == 0 ) date_init = date - atm_int_state%Time_init = set_date (date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6)) - if(mype==0) write(*,'(A,6I5)') 'StartTime=',date_init + Time_init = set_date (date_init(1), date_init(2), date_init(3), & + date_init(4), date_init(5), date_init(6)) + if (mype == 0) write(*,'(A,6I5)') 'StartTime=',date_init date=0 call ESMF_TimeGet (CurrTime, & YY=date(1), MM=date(2), DD=date(3), & - H=date(4), M =date(5), S =date(6), RC=rc ) + H=date(4), M =date(5), S =date(6), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(mype==0) write(*,'(A,6I5)') 'CurrTime =',date - - atm_int_state%Time_atmos = set_date (date(1), date(2), date(3), & - date(4), date(5), date(6)) + Time = set_date (date(1), date(2), date(3), & + date(4), date(5), date(6)) + if (mype == 0) write(*,'(A,6I5)') 'CurrTime =',date date_end=0 call ESMF_TimeGet (StopTime, & YY=date_end(1), MM=date_end(2), DD=date_end(3), & - H=date_end(4), M =date_end(5), S =date_end(6), RC=rc ) + H=date_end(4), M =date_end(5), S =date_end(6), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if ( date_end(1) == 0 ) date_end = date - atm_int_state%Time_end = set_date (date_end(1), date_end(2), date_end(3), & - date_end(4), date_end(5), date_end(6)) - if(mype==0) write(*,'(A,6I5)') 'StopTime =',date_end -! - call diag_manager_set_time_end(atm_int_state%Time_end) -! - CALL ESMF_TimeIntervalGet(RunDuration, S=Run_length, RC=rc) + Time_end = set_date (date_end(1), date_end(2), date_end(3), & + date_end(4), date_end(5), date_end(6)) + if (mype == 0) write(*,'(A,6I5)') 'StopTime =',date_end + +!------------------------------------------------------------------------ +! If this is a restarted run ('INPUT/coupler.res' file exists), +! compare date and date_init to the values in 'coupler.res' + + if (mype == 0) then + inquire(FILE='INPUT/coupler.res', EXIST=fexist) + if (fexist) then ! file exists, this is a restart run + + call ESMF_UtilIOUnitGet(unit=io_unit, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + open(unit=io_unit, file='INPUT/coupler.res', status='old', action='read', err=998) + read (io_unit,*,err=999) calendar_type_res + read (io_unit,*) date_init_res + read (io_unit,*) date_res + close(io_unit) + + if(date_res(1) == 0 .and. date_init_res(1) /= 0) date_res = date_init_res + + if(mype == 0) write(*,'(A,6(I4))') 'INPUT/coupler.res: date_init=',date_init_res + if(mype == 0) write(*,'(A,6(I4))') 'INPUT/coupler.res: date =',date_res + + if (calendar_type /= calendar_type_res) then + write(0,'(A)') 'fcst_initialize ERROR: calendar_type /= calendar_type_res' + write(0,'(A,6(I4))')' calendar_type = ', calendar_type + write(0,'(A,6(I4))')' calendar_type_res = ', calendar_type_res + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + + if (.not. ALL(date_init.EQ.date_init_res)) then + write(0,'(A)') 'fcst_initialize ERROR: date_init /= date_init_res' + write(0,'(A,6(I4))')' date_init = ', date_init + write(0,'(A,6(I4))')' date_init_res = ', date_init_res + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + + if (.not. ALL(date.EQ.date_res)) then + write(0,'(A)') 'fcst_initialize ERROR: date /= date_res' + write(0,'(A,6(I4))')' date = ', date + write(0,'(A,6(I4))')' date_res = ', date_res + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + + 999 continue + 998 continue + + endif ! fexist + endif ! mype == 0 + + RunDuration = StopTime - CurrTime + + CALL ESMF_TimeIntervalGet(RunDuration, S=Run_length, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call diag_manager_init (TIME_INIT=date) - call diag_manager_set_time_end(atm_int_state%Time_end) + call diag_manager_set_time_end(Time_end) ! - atm_int_state%Time_step_atmos = set_time (dt_atmos,0) - atm_int_state%num_atmos_calls = Run_length / dt_atmos - atm_int_state%Time_atstart = atm_int_state%Time_atmos - if (mype == 0) write(0,*)'num_atmos_calls=',atm_int_state%num_atmos_calls,'time_init=', & - date_init,'time_atmos=',date,'time_end=',date_end,'dt_atmos=',dt_atmos, & + Time_step = set_time (dt_atmos,0) + num_atmos_calls = Run_length / dt_atmos + if (mype == 0) write(*,*)'num_atmos_calls=',num_atmos_calls,'time_init=', & + date_init,'time=',date,'time_end=',date_end,'dt_atmos=',dt_atmos, & 'Run_length=',Run_length ! set up forecast time array that controls when to write out restart files frestart = 0 - call get_time(atm_int_state%Time_end - atm_int_state%Time_init,total_inttime) + call get_time(Time_end - Time_init, total_inttime) ! set iau offset time - atm_int_state%Atm%iau_offset = iau_offset + Atmos%iau_offset = iau_offset if(iau_offset > 0 ) then iautime = set_time(iau_offset * 3600, 0) endif @@ -359,19 +553,19 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if(freq_restart) then if(restart_interval(1) >= 0) then tmpvar = restart_interval(1) * 3600 - atm_int_state%Time_step_restart = set_time (tmpvar, 0) + Time_step_restart = set_time (tmpvar, 0) if(iau_offset > 0 ) then - atm_int_state%Time_restart = atm_int_state%Time_init + iautime + atm_int_state%Time_step_restart + Time_restart = Time_init + iautime + Time_step_restart frestart(1) = tmpvar + iau_offset *3600 else - atm_int_state%Time_restart = atm_int_state%Time_init + atm_int_state%Time_step_restart + Time_restart = Time_init + Time_step_restart frestart(1) = tmpvar endif if(restart_interval(1) > 0) then i = 2 - do while ( atm_int_state%Time_restart < atm_int_state%Time_end ) + do while ( Time_restart < Time_end ) frestart(i) = frestart(i-1) + tmpvar - atm_int_state%Time_restart = atm_int_state%Time_restart + atm_int_state%Time_step_restart + Time_restart = Time_restart + Time_step_restart i = i + 1 enddo endif @@ -396,9 +590,9 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if ( ANY(frestart(:) == total_inttime) ) restart_endfcst = .true. if (mype == 0) print *,'frestart=',frestart(1:10)/3600, 'restart_endfcst=',restart_endfcst, & 'total_inttime=',total_inttime -! if there is restart writing during integration - atm_int_state%intrm_rst = 0 - if (frestart(1)>0) atm_int_state%intrm_rst = 1 +! if there is restart writing during integration + intrm_rst = 0 + if (frestart(1)>0) intrm_rst = 1 ! !----- write time stamps (for start time and end time) ------ @@ -412,14 +606,11 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! !------ initialize component models ------ - call atmos_model_init (atm_int_state%Atm, atm_int_state%Time_init, & - atm_int_state%Time_atmos, atm_int_state%Time_step_atmos) + call atmos_model_init (Atmos, Time_init, Time, Time_step) ! inquire(FILE='data_table', EXIST=fexist) if (fexist) then - call data_override_init ( ) ! Atm_domain_in = Atm%domain, & - ! Ice_domain_in = Ice%domain, & - ! Land_domain_in = Land%domain ) + call data_override_init() endif !----------------------------------------------------------------------- !---- open and close dummy file in restart dir to check if dir exists -- @@ -429,10 +620,8 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) call mpp_close(unit, MPP_DELETE) endif ! -! !----------------------------------------------------------------------- -!*** create grid for output fields -!*** first try: Create cubed sphere grid from file +!*** create grid for output fields, using FV3 parameters !----------------------------------------------------------------------- ! call mpp_error(NOTE, 'before create fcst grid') @@ -443,157 +632,102 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) call read_data("INPUT/grid_spec.nc", "atm_mosaic_file", gridfile) endif - if (mpp_pe() == mpp_root_pe()) & - write(*, *) 'create fcst grid: mype,regional,nested=',mype,atm_int_state%Atm%regional,atm_int_state%Atm%nested - - ! regional-only without nests - if( atm_int_state%Atm%regional .and. .not. atm_int_state%Atm%nested ) then - - call atmosphere_control_data (isc, iec, jsc, jec, nlev) - - domain = atm_int_state%Atm%domain - fcstNpes = atm_int_state%Atm%layout(1)*atm_int_state%Atm%layout(2) - allocate(isl(fcstNpes), iel(fcstNpes), jsl(fcstNpes), jel(fcstNpes)) - allocate(deBlockList(2,2,fcstNpes)) - call mpp_get_compute_domains(domain,xbegin=isl,xend=iel,ybegin=jsl,yend=jel) - do n=1,fcstNpes - deBlockList(:,1,n) = (/ isl(n),iel(n) /) - deBlockList(:,2,n) = (/ jsl(n),jel(n) /) - end do - delayout = ESMF_DELayoutCreate(petMap=(/(i,i=0,fcstNpes-1)/), rc=rc); ESMF_ERR_ABORT(rc) - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), & - maxIndex=(/atm_int_state%Atm%mlon,atm_int_state%Atm%mlat/), & - delayout=delayout, & - deBlockList=deBlockList, rc=rc); ESMF_ERR_ABORT(rc) - - fcstGrid = ESMF_GridCreateNoPeriDim(regDecomp=(/atm_int_state%Atm%layout(1),atm_int_state%Atm%layout(2)/), & - minIndex=(/1,1/), & - maxIndex=(/atm_int_state%Atm%mlon,atm_int_state%Atm%mlat/), & - gridAlign=(/-1,-1/), & - decompflag=(/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/), & - name="fcst_grid", & - indexflag=ESMF_INDEX_DELOCAL, & - rc=rc); ESMF_ERR_ABORT(rc) - - ! add and define "center" coordinate values - call ESMF_GridAddCoord(fcstGrid, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc); ESMF_ERR_ABORT(rc) - call ESMF_GridGetCoord(fcstGrid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=glonPtr, rc=rc); ESMF_ERR_ABORT(rc) - call ESMF_GridGetCoord(fcstGrid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=glatPtr, rc=rc); ESMF_ERR_ABORT(rc) + ngrids = Atmos%ngrids + mygrid = Atmos%mygrid + allocate(grid_number_on_all_pets(fcst_ntasks)) + call mpi_allgather(mygrid, 1, MPI_INTEGER, & + grid_number_on_all_pets, 1, MPI_INTEGER, & + fcst_mpi_comm, rc) + + allocate (fcstGrid(ngrids),fcstGridComp(ngrids)) + do n=1,ngrids + + pelist => null() + call atmos_model_get_nth_domain_info(n, layout, nx, ny, pelist) + call ESMF_VMBroadcast(vm, bcstData=layout, count=2, rootPet=pelist(1), rc=rc); ESMF_ERR_ABORT(rc) + + if (n==1) then + ! on grid==1 (top level parent) determine if the domain is global or regional + top_parent_is_global = .true. + if(mygrid==1) then + if (Atmos%regional) top_parent_is_global = .false. + endif + call mpi_bcast(top_parent_is_global, 1, MPI_LOGICAL, 0, fcst_mpi_comm, rc) + endif - do j = jsc, jec - do i = isc, iec - glonPtr(i-isc+1,j-jsc+1) = atm_int_state%Atm%lon(i-isc+1,j-jsc+1) * dtor - glatPtr(i-isc+1,j-jsc+1) = atm_int_state%Atm%lat(i-isc+1,j-jsc+1) * dtor - enddo - enddo + if (n==1 .and. top_parent_is_global) then - ! add and define "corner" coordinate values - call ESMF_GridAddCoord(fcstGrid, staggerLoc=ESMF_STAGGERLOC_CORNER, & - rc=rc); ESMF_ERR_ABORT(rc) - call ESMF_GridGetCoord(fcstGrid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, & - totalLBound=tlb, totalUBound=tub, & - farrayPtr=glonPtr, rc=rc); ESMF_ERR_ABORT(rc) - glonPtr(tlb(1):tub(1),tlb(2):tub(2)) = & - atm_int_state%Atm%lon_bnd(tlb(1):tub(1),tlb(2):tub(2)) * dtor - call ESMF_GridGetCoord(fcstGrid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, & - totalLBound=tlb, totalUBound=tub, & - farrayPtr=glatPtr, rc=rc); ESMF_ERR_ABORT(rc) - glatPtr(tlb(1):tub(1),tlb(2):tub(2)) = & - atm_int_state%Atm%lat_bnd(tlb(1):tub(1),tlb(2):tub(2)) * dtor - - call mpp_error(NOTE, 'after create fcst grid for regional-only') - - else ! not regional only - - if (.not. atm_int_state%Atm%regional .and. .not. atm_int_state%Atm%nested ) then !! global only - - do tl=1,6 - decomptile(1,tl) = atm_int_state%Atm%layout(1) - decomptile(2,tl) = atm_int_state%Atm%layout(2) - decompflagPTile(:,tl) = (/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/) - enddo - fcstGrid = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & - regDecompPTile=decomptile,tileFilePath="INPUT/", & - decompflagPTile=decompflagPTile, & - staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & - name='fcst_grid', rc=rc) + fcstGridComp(n) = ESMF_GridCompCreate(name="global", petList=pelist, rc=rc); ESMF_ERR_ABORT(rc) + + call ESMF_InfoGetFromHost(fcstGridComp(n), info=info, rc=rc); ESMF_ERR_ABORT(rc) + call ESMF_InfoSet(info, key="layout", values=layout, rc=rc); ESMF_ERR_ABORT(rc) + call ESMF_InfoSet(info, key="tilesize", value=Atmos%mlon, rc=rc); ESMF_ERR_ABORT(rc) + + call ESMF_GridCompSetServices(fcstGridComp(n), SetServicesNest, userrc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + else - call mpp_error(NOTE, 'after create fcst grid for global-only with INPUT/'//trim(gridfile)) + allocate(petListNest(layout(1)*layout(2))) + k=pelist(1) + do j=1,layout(2) + do i=1,layout(1) + petListNest(k-pelist(1)+1) = k + k = k + 1 + end do + end do - else !! global-nesting or regional-nesting + fcstGridComp(n) = ESMF_GridCompCreate(name="nest", petList=petListNest, rc=rc); ESMF_ERR_ABORT(rc) - if (mype==0) TileLayout = atm_int_state%Atm%layout - call ESMF_VMBroadcast(vm, bcstData=TileLayout, count=2, & - rootPet=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetFromHost(fcstGridComp(n), info=info, rc=rc); ESMF_ERR_ABORT(rc) + call ESMF_InfoSet(info, key="layout", values=layout, rc=rc); ESMF_ERR_ABORT(rc) + call ESMF_InfoSet(info, key="nx", value=nx, rc=rc); ESMF_ERR_ABORT(rc) + call ESMF_InfoSet(info, key="ny", value=ny, rc=rc); ESMF_ERR_ABORT(rc) - if (mype==0) npes(1) = mpp_npes() - call ESMF_VMBroadcast(vm, bcstData=npes, count=1, & - rootPet=0, rc=rc) + call ESMF_GridCompSetServices(fcstGridComp(n), SetServicesNest, userrc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - if ( npes(1) == TileLayout(1) * TileLayout(2) * 6 ) then - ! global-nesting - nestRootPet = npes(1) - gridfile="grid.nest02.tile7.nc" - else if ( npes(1) == TileLayout(1) * TileLayout(2) ) then - ! regional-nesting - nestRootPet = npes(1) - gridfile="grid.nest02.tile2.nc" - else - call mpp_error(FATAL, 'Inconsistent nestRootPet and Atm%layout') - endif - if (mype == nestRootPet) then - if (nestRootPet /= atm_int_state%Atm%pelist(1)) then - write(0,*)'error in fcst_initialize: nestRootPet /= atm_int_state%Atm%pelist(1)' - write(0,*)'error in fcst_initialize: nestRootPet = ',nestRootPet - write(0,*)'error in fcst_initialize: atm_int_state%Atm%pelist(1) = ',atm_int_state%Atm%pelist(1) - ESMF_ERR_ABORT(100) - endif - endif + deallocate(petListNest) - ! nest rootPet shares peList with others - if (mype == nestRootPet) peListSize(1) = size(atm_int_state%Atm%pelist) - call ESMF_VMBroadcast(vm, bcstData=peListSize, count=1, rootPet=nestRootPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if - ! nest rootPet shares layout with others - if (mype == nestRootPet) regDecomp = atm_int_state%Atm%layout - call ESMF_VMBroadcast(vm, bcstData=regDecomp, count=2, rootPet=nestRootPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_GridCompIsPetLocal(fcstGridComp(n), rc=rc)) then + call ESMF_GridCompGet(fcstGridComp(n), grid=fcstGrid(n), rc=rc); ESMF_ERR_ABORT(rc) - ! prepare petMap variable - allocate(petMap(peListSize(1))) - if (mype == nestRootPet) petMap = atm_int_state%Atm%pelist - ! do the actual broadcast of the petMap - call ESMF_VMBroadcast(vm, bcstData=petMap, count=peListSize(1), rootPet=nestRootPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddCoord(fcstGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc); ESMF_ERR_ABORT(rc) + call ESMF_GridAddCoord(fcstGrid(n), staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc); ESMF_ERR_ABORT(rc) - ! create the DELayout that maps DEs to the PETs in the petMap - delayout = ESMF_DELayoutCreate(petMap=petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! define "center" coordinate values + call ESMF_GridGetCoord(fcstGrid(n), coordDim=1, staggerLoc=ESMF_STAGGERLOC_CENTER, & + totalLBound=tlb, totalUBound=tub, & + farrayPtr=glonPtr, rc=rc); ESMF_ERR_ABORT(rc) + glonPtr(tlb(1):tub(1),tlb(2):tub(2)) = Atmos%lon(tlb(1):tub(1),tlb(2):tub(2)) - ! create the nest Grid by reading it from file but use DELayout - fcstGrid = ESMF_GridCreate(filename="INPUT/"//trim(gridfile), & - fileformat=ESMF_FILEFORMAT_GRIDSPEC, regDecomp=regDecomp, & - decompflag=(/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/), & - delayout=delayout, isSphere=.false., indexflag=ESMF_INDEX_DELOCAL, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(fcstGrid(n), coordDim=2, staggerLoc=ESMF_STAGGERLOC_CENTER, & + totalLBound=tlb, totalUBound=tub, & + farrayPtr=glatPtr, rc=rc); ESMF_ERR_ABORT(rc) + glatPtr(tlb(1):tub(1),tlb(2):tub(2)) = Atmos%lat(tlb(1):tub(1),tlb(2):tub(2)) - call mpp_error(NOTE, 'after create fcst grid with INPUT/'//trim(gridfile)) + ! define "corner" coordinate values + call ESMF_GridGetCoord(fcstGrid(n), coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, & + totalLBound=tlb, totalUBound=tub, & + farrayPtr=glonPtr, rc=rc); ESMF_ERR_ABORT(rc) + glonPtr(tlb(1):tub(1),tlb(2):tub(2)) = Atmos%lon_bnd(tlb(1):tub(1),tlb(2):tub(2)) - endif + call ESMF_GridGetCoord(fcstGrid(n), coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, & + totalLBound=tlb, totalUBound=tub, & + farrayPtr=glatPtr, rc=rc); ESMF_ERR_ABORT(rc) + glatPtr(tlb(1):tub(1),tlb(2):tub(2)) = Atmos%lat_bnd(tlb(1):tub(1),tlb(2):tub(2)) + end if ! IsPetLocal - endif + end do ! !! FIXME - if ( .not. atm_int_state%Atm%nested ) then !! global only - call addLsmask2grid(fcstGrid, rc=rc) + if ( .not. Atmos%nested ) then !! global only + call addLsmask2grid(fcstGrid(mygrid), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! print *,'call addLsmask2grid after fcstGrid, rc=',rc endif @@ -607,7 +741,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! ! Write grid to netcdf file if( cplprint_flag ) then - call wrt_fcst_grid(fcstGrid, "diagnostic_FV3_fcstGrid.nc", & + call wrt_fcst_grid(fcstGrid(mygrid), "diagnostic_FV3_fcstGrid.nc", & regridArea=.TRUE., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif @@ -621,15 +755,39 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) name="gridfile", value=trim(gridfile), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! Add total number of domains(grids) Attribute to the exportState + call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & + attrList=(/"ngrids"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(exportState, convention="NetCDF", purpose="FV3", & + name="ngrids", value=ngrids, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +! Add top_parent_is_global Attribute to the exportState + call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & + attrList=(/"top_parent_is_global"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(exportState, convention="NetCDF", purpose="FV3", & + name="top_parent_is_global", value=top_parent_is_global, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! Add dimension Attributes to Grid - call ESMF_AttributeAdd(fcstGrid, convention="NetCDF", purpose="FV3", & + do n=1,ngrids + if (ESMF_GridCompIsPetLocal(fcstGridComp(n), rc=rc)) then + + call ESMF_AttributeAdd(fcstGrid(n), convention="NetCDF", purpose="FV3", & attrList=(/"ESMF:gridded_dim_labels"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(fcstGrid, convention="NetCDF", purpose="FV3", & + call ESMF_AttributeSet(fcstGrid(n), convention="NetCDF", purpose="FV3", & name="ESMF:gridded_dim_labels", valueList=(/"grid_xt", "grid_yt"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + endif + end do + ! Add time Attribute to the exportState call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & attrList=(/ "time ", & @@ -653,11 +811,10 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) dateS="hours since "//dateSY//'-'//dateSM//'-'//dateSD//' '//dateSH//':'// & dateSN//":"//dateSS - if (mype == 0) write(0,*)'dateS=',trim(dateS),'date_init=',date_init + if (mype == 0) write(*,*)'dateS=',trim(dateS),'date_init=',date_init call ESMF_AttributeSet(exportState, convention="NetCDF", purpose="FV3", & name="time:units", value=trim(dateS), rc=rc) -! name="time:units", value="hours since 2016-10-03 00:00:00", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_AttributeSet(exportState, convention="NetCDF", purpose="FV3", & @@ -679,49 +836,73 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! Create FieldBundle for Fields that need to be regridded bilinear if( quilting ) then + allocate(fieldbundle(ngrids)) + nbdlphys = 2 + allocate(fieldbundlephys(nbdlphys,ngrids)) + + do n=1,ngrids + bundle_grid='' + if (ngrids > 1 .and. n >= 2) then + write(bundle_grid,'(A5,I2.2,A1)') '.nest', n, '.' + endif + do i=1,num_files ! - name_FB = filename_base(i) + tempState = ESMF_StateCreate(rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + name_FB = trim(filename_base(i)) // trim(bundle_grid) ! if( i==1 ) then ! for dyn name_FB1 = trim(name_FB)//'_bilinear' - fieldbundle = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) - if (mype == 0) write(0,*)'af create fcst fieldbundle, name=',trim(name_FB),'rc=',rc + fieldbundle(n) = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeAdd(fieldbundle(n), convention="NetCDF", purpose="FV3", & + attrList=(/"grid_id"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fieldbundle(n), convention="NetCDF", purpose="FV3", & + name="grid_id", value=n, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call fv_dyn_bundle_setup(atm_int_state%Atm%axes, & - fieldbundle, fcstGrid, quilting, rc=rc) + call ESMF_StateAdd(tempState, (/fieldbundle(n)/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! Add the field to the importState so parent can connect to it - call ESMF_StateAdd(exportState, (/fieldbundle/), rc=rc) + call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState,& + exportState=exportState, phase=1, userrc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return else if( i==2 ) then ! for phys - nbdlphys = 2 - allocate(fieldbundlephys(nbdlphys)) do j=1, nbdlphys if( j==1 ) then name_FB1 = trim(name_FB)//'_nearest_stod' else name_FB1 = trim(name_FB)//'_bilinear' endif - fieldbundlephys(j) = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) - if (mype == 0) write(0,*)'af create fcst fieldbundle, name=',trim(name_FB1),'rc=',rc + fieldbundlephys(j,n) = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - enddo -! - call fv_phys_bundle_setup(atm_int_state%Atm%diag, atm_int_state%Atm%axes, & - fieldbundlephys, fcstGrid, quilting, nbdlphys) -! - ! Add the field to the importState so parent can connect to it - do j=1,nbdlphys - call ESMF_StateAdd(exportState, (/fieldbundlephys(j)/), rc=rc) + + call ESMF_AttributeAdd(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3", & + attrList=(/"grid_id"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3", & + name="grid_id", value=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateAdd(tempState, (/fieldbundlephys(j,n)/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo + call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState,& + exportState=exportState, phase=2, userrc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + else write(0,*)' unknown name_FB ', trim(name_FB) @@ -729,7 +910,11 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) endif ! - enddo + call ESMF_StateDestroy(tempState, noGarbage=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + enddo ! num_files + enddo ! ngrids !end qulting endif @@ -737,16 +922,8 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) call get_atmos_model_ungridded_dim(nlev=numLevels, & nsoillev=numSoilLayers, & ntracers=numTracers) -! -!----------------------------------------------------------------------- -! - IF(rc /= ESMF_SUCCESS) THEN - WRITE(0,*)"FAIL: Fcst_Initialize." -! ELSE -! WRITE(0,*)"PASS: Fcst_Initialize." - ENDIF -! - if (mype == 0) write(0,*)'in fcst,init total time: ', mpi_wtime() - timeis + + if (mype == 0) write(*,*)'fcst_initialize total time: ', mpi_wtime() - timeis ! !----------------------------------------------------------------------- ! @@ -767,30 +944,22 @@ subroutine fcst_run_phase_1(fcst_comp, importState, exportState,clock,rc) type(ESMF_Clock) :: clock integer,intent(out) :: rc ! -!----------------------------------------------------------------------- !*** local variables ! - integer :: i,j, mype, na, date(6) - character(20) :: compname - - type(ESMF_Time) :: currtime + integer :: mype, na integer(kind=ESMF_KIND_I8) :: ntimestep_esmf - character(len=64) :: timestamp -! -!----------------------------------------------------------------------- -! - real(kind=8) :: mpi_wtime, tbeg1 + real(kind=8) :: mpi_wtime, tbeg1 ! !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- ! tbeg1 = mpi_wtime() - rc = esmf_success + rc = ESMF_SUCCESS ! !----------------------------------------------------------------------- ! - call ESMF_GridCompGet(fcst_comp, name=compname, localpet=mype, rc=rc) + call ESMF_GridCompGet(fcst_comp, localpet=mype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call ESMF_ClockGet(clock, advanceCount=NTIMESTEP_ESMF, rc=rc) @@ -801,31 +970,21 @@ subroutine fcst_run_phase_1(fcst_comp, importState, exportState,clock,rc) !----------------------------------------------------------------------- ! *** call fcst integration subroutines - call get_date (atm_int_state%Time_atmos, date(1), date(2), date(3), & - date(4), date(5), date(6)) - atm_int_state%Time_atmos = atm_int_state%Time_atmos + atm_int_state%Time_step_atmos - - call update_atmos_model_dynamics (atm_int_state%Atm) + call update_atmos_model_dynamics (Atmos) - call update_atmos_radiation_physics (atm_int_state%Atm) + call update_atmos_radiation_physics (Atmos) - call atmos_model_exchange_phase_1 (atm_int_state%Atm, rc=rc) + call atmos_model_exchange_phase_1 (Atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -!----------------------------------------------------------------------- -! -! IF(RC /= ESMF_SUCCESS) THEN -! if(mype==0) WRITE(0,*)"FAIL: fcst_RUN" -! ELSE - if(mype==0) WRITE(*,*)"PASS: fcstRUN phase 1, na = ",na, ' time is ', mpi_wtime()-tbeg1 -! ENDIF + if (mype == 0) write(*,*)"PASS: fcstRUN phase 1, na = ",na, ' time is ', mpi_wtime()-tbeg1 ! !----------------------------------------------------------------------- ! end subroutine fcst_run_phase_1 ! !----------------------------------------------------------------------- -!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!####################################################################### !----------------------------------------------------------------------- ! subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) @@ -839,78 +998,78 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) type(ESMF_Clock) :: clock integer,intent(out) :: rc ! -!----------------------------------------------------------------------- !*** local variables ! - integer :: i,j, mype, na, date(6), seconds - character(20) :: compname - - type(time_type) :: restart_inctime - type(ESMF_Time) :: currtime + integer :: mype, na, date(6), seconds integer(kind=ESMF_KIND_I8) :: ntimestep_esmf character(len=64) :: timestamp -! -!----------------------------------------------------------------------- -! - real(kind=8) :: mpi_wtime, tbeg1 + integer :: unit + real(kind=8) :: mpi_wtime, tbeg1 ! !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- ! tbeg1 = mpi_wtime() - rc = esmf_success + rc = ESMF_SUCCESS ! !----------------------------------------------------------------------- ! - call ESMF_GridCompGet(fcst_comp, name=compname, localpet=mype, rc=rc) + call ESMF_GridCompGet(fcst_comp, localpet=mype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + call ESMF_ClockGet(clock, advanceCount=NTIMESTEP_ESMF, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return na = NTIMESTEP_ESMF - if (mype == 0) write(0,*)'in fcst run phase 2, na=',na ! !----------------------------------------------------------------------- ! *** call fcst integration subroutines - call atmos_model_exchange_phase_2 (atm_int_state%Atm, rc=rc) + call atmos_model_exchange_phase_2 (Atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call update_atmos_model_state (atm_int_state%Atm, rc=rc) + call update_atmos_model_state (Atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -!--- intermediate restart - if (atm_int_state%intrm_rst>0) then - if (na /= atm_int_state%num_atmos_calls-1) then - call get_time(atm_int_state%Time_atmos - atm_int_state%Time_init, seconds) + !--- intermediate restart + if (intrm_rst>0) then + if (na /= num_atmos_calls-1) then + call get_time(Atmos%Time - Atmos%Time_init, seconds) if (ANY(frestart(:) == seconds)) then - if (mype == 0) write(0,*)'write out restart at na=',na,' seconds=',seconds, & - 'integration lenght=',na*dt_atmos/3600. - timestamp = date_to_string (atm_int_state%Time_atmos) - call atmos_model_restart(atm_int_state%Atm, timestamp) + if (mype == 0) write(*,*)'write out restart at na=',na,' seconds=',seconds, & + 'integration lenght=',na*dt_atmos/3600. + + timestamp = date_to_string (Atmos%Time) + call atmos_model_restart(Atmos, timestamp) call write_stoch_restart_atm('RESTART/'//trim(timestamp)//'.atm_stoch.res.nc') - call wrt_atmres_timestamp(atm_int_state,timestamp) + !----- write restart file ------ + if (mpp_pe() == mpp_root_pe())then + call get_date (Atmos%Time, date(1), date(2), date(3), & + date(4), date(5), date(6)) + call mpp_open( unit, 'RESTART/'//trim(timestamp)//'.coupler.res', nohdrs=.TRUE. ) + write( unit, '(i6,8x,a)' )calendar_type, & + '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' + + write( unit, '(6i6,8x,a)' )date_init, & + 'Model start time: year, month, day, hour, minute, second' + write( unit, '(6i6,8x,a)' )date, & + 'Current model time: year, month, day, hour, minute, second' + call mpp_close(unit) + endif endif endif endif -! -!----------------------------------------------------------------------- -! -! IF(RC /= ESMF_SUCCESS) THEN -! if(mype==0) WRITE(0,*)"FAIL: fcst_RUN" -! ELSE - if(mype==0) WRITE(*,*)"PASS: fcstRUN phase 2, na = ",na, ' time is ', mpi_wtime()-tbeg1 -! ENDIF + + if (mype == 0) write(*,*)"PASS: fcstRUN phase 2, na = ",na, ' time is ', mpi_wtime()-tbeg1 ! !----------------------------------------------------------------------- ! end subroutine fcst_run_phase_2 ! !----------------------------------------------------------------------- -!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!####################################################################### !----------------------------------------------------------------------- ! subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) @@ -919,45 +1078,33 @@ subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) !*** finalize the forecast grid component. !----------------------------------------------------------------------- ! - type(ESMF_GridComp) :: fcst_comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer,intent(out) :: rc + type(ESMF_GridComp) :: fcst_comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer,intent(out) :: rc ! !*** local variables ! - integer :: unit - integer,dimension(6) :: date - - real(8) mpi_wtime, tfs, tfe + integer :: mype + integer :: unit + integer,dimension(6) :: date + real(kind=8) :: mpi_wtime, tbeg1 ! !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- ! - tfs = mpi_wtime() - rc = ESMF_SUCCESS -! -!----------------------------------------------------------------------- -!*** retrieve the fcst component's esmf internal state -!----------------------------------------------------------------------- -! - call ESMF_GridCompGetInternalState(fcst_comp, wrap, rc) - atm_int_state => wrap%ptr -! -!----------------------------------------------------------------------- -! - call atmos_model_end (atm_int_state%atm) -! -!*** check time versus expected ending time + tbeg1 = mpi_wtime() + rc = ESMF_SUCCESS - if (atm_int_state%Time_atmos /= atm_int_state%Time_end) & - call error_mesg ('program coupler', & - 'final time does not match expected ending time', WARNING) + call ESMF_GridCompGet(fcst_comp, localpet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call atmos_model_end (Atmos) !*** write restart file if( restart_endfcst ) then - call get_date (atm_int_state%Time_atmos, date(1), date(2), date(3), & + call get_date (Atmos%Time, date(1), date(2), date(3), & date(4), date(5), date(6)) call mpp_open( unit, 'RESTART/coupler.res', nohdrs=.TRUE. ) if (mpp_pe() == mpp_root_pe())then @@ -971,56 +1118,18 @@ subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) endif call mpp_close(unit) endif -! - call diag_manager_end(atm_int_state%Time_atmos ) + + call diag_manager_end (Atmos%Time) call fms_end + + if (mype == 0) write(*,*)'fcst_finalize total time: ', mpi_wtime() - tbeg1 ! !----------------------------------------------------------------------- -! - IF(RC /= ESMF_SUCCESS)THEN - WRITE(0,*)'FAIL: Write_Finalize.' -! ELSE -! WRITE(0,*)'PASS: Write_Finalize.' - ENDIF -! - tfe = mpi_wtime() -! print *,'fms end time: ', tfe-tfs -!----------------------------------------------------------------------- ! end subroutine fcst_finalize ! !####################################################################### -!-- change name from coupler_res to wrt_res_stamp to avoid confusion, -!-- here we only write out atmos restart time stamp -! - subroutine wrt_atmres_timestamp(atm_int_state,timestamp) - type(atmos_internalstate_type), intent(in) :: atm_int_state - character(len=32), intent(in) :: timestamp - - integer :: unit, date(6) - -!----- compute current date ------ - - call get_date (atm_int_state%Time_atmos, date(1), date(2), date(3), & - date(4), date(5), date(6)) - -!----- write restart file ------ - - if (mpp_pe() == mpp_root_pe())then - call mpp_open( unit, 'RESTART/'//trim(timestamp)//'.coupler.res', nohdrs=.TRUE. ) - write( unit, '(i6,8x,a)' )calendar_type, & - '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - - write( unit, '(6i6,8x,a)' )date_init, & - 'Model start time: year, month, day, hour, minute, second' - write( unit, '(6i6,8x,a)' )date, & - 'Current model time: year, month, day, hour, minute, second' - call mpp_close(unit) - endif - end subroutine wrt_atmres_timestamp -! -!####################################################################### !-- write forecast grid to NetCDF file for diagnostics ! subroutine wrt_fcst_grid(grid, fileName, relaxedflag, regridArea, rc) @@ -1030,7 +1139,6 @@ subroutine wrt_fcst_grid(grid, fileName, relaxedflag, regridArea, rc) logical, intent(in), optional :: regridArea integer, intent(out) :: rc ! -!----------------------------------------------------------------------- !*** local variables ! logical :: ioCapable @@ -1040,7 +1148,6 @@ subroutine wrt_fcst_grid(grid, fileName, relaxedflag, regridArea, rc) type(ESMF_Array) :: array type(ESMF_ArrayBundle) :: arraybundle logical :: isPresent - integer :: stat logical :: hasCorners logical :: lRegridArea type(ESMF_Field) :: areaField diff --git a/module_fv3_config.F90 b/module_fv3_config.F90 index 53963b488..64522ec8e 100644 --- a/module_fv3_config.F90 +++ b/module_fv3_config.F90 @@ -2,7 +2,7 @@ module module_fv3_config !------------------------------------------------------------------------ ! -!*** fv3 configure variablse from model_configure +!*** fv3 configure variables from model_configure ! ! revision history ! 01/2017 Jun Wang Initial code @@ -14,21 +14,15 @@ module module_fv3_config implicit none ! integer :: nfhout, nfhout_hf, nsout, dt_atmos - integer :: nfhmax_hf, first_kdt + integer :: first_kdt integer :: fcst_mpi_comm, fcst_ntasks - real :: nfhmax - type(ESMF_Alarm) :: alarm_output_hf, alarm_output - type(ESMF_TimeInterval) :: output_hfmax - type(ESMF_TimeInterval) :: output_interval,output_interval_hf ! logical :: cplprint_flag logical :: quilting, output_1st_tstep_rst - logical :: force_date_from_configure logical :: restart_endfcst ! real,dimension(:),allocatable :: output_fh character(esmf_maxstr),dimension(:),allocatable :: filename_base character(17) :: calendar=' ' - integer :: calendar_type = -99 ! end module module_fv3_config diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 45e8532a8..ae67c0daf 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -12,6 +12,7 @@ module stochastic_physics_wrapper_mod real(kind=kind_phys), dimension(:,:,:), allocatable, save :: skebu_wts real(kind=kind_phys), dimension(:,:,:), allocatable, save :: skebv_wts real(kind=kind_phys), dimension(:,:,:), allocatable, save :: sfc_wts + real(kind=kind_phys), dimension(:,:,:,:), allocatable, save :: spp_wts logical, save :: is_initialized = .false. integer, save :: lsoil = -999 @@ -78,7 +79,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) type(block_control_type), intent(inout) :: Atm_block integer, intent(out) :: ierr - integer :: nthreads, nb, levs, maxblk, nblks + integer :: nthreads, nb, levs, maxblk, nblks, n logical :: param_update_flag #ifdef _OPENMP @@ -96,7 +97,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) initalize_stochastic_physics: if (.not. is_initialized) then - if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type > 0) ) then + if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type > 0) .OR. GFS_Control%do_spp) then allocate(xlat(1:nblks,maxblk)) allocate(xlon(1:nblks,maxblk)) do nb=1,nblks @@ -108,6 +109,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) GFS_Control%input_nml_file, GFS_Control%fn_nml, GFS_Control%nlunit, xlon, xlat, GFS_Control%do_sppt, GFS_Control%do_shum, & GFS_Control%do_skeb, GFS_Control%lndp_type, GFS_Control%n_var_lndp, GFS_Control%use_zmtnblck, GFS_Control%skeb_npass, & GFS_Control%lndp_var_list, GFS_Control%lndp_prt_list, & + GFS_Control%n_var_spp, GFS_Control%spp_var_list, GFS_Control%spp_prt_list, GFS_Control%do_spp, & GFS_Control%ak, GFS_Control%bk, nthreads, GFS_Control%master, GFS_Control%communicator, ierr) if (ierr/=0) then write(6,*) 'call to init_stochastic_physics failed' @@ -124,6 +126,23 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) allocate(skebu_wts(1:nblks,maxblk,1:levs)) allocate(skebv_wts(1:nblks,maxblk,1:levs)) end if + if ( GFS_Control%do_spp ) then + allocate(spp_wts(1:nblks,maxblk,1:levs,1:GFS_Control%n_var_spp)) + do n=1,GFS_Control%n_var_spp + select case (trim(GFS_Control%spp_var_list(n))) + case('pbl') + GFS_Control%spp_pbl = 1 + case('sfc') + GFS_Control%spp_sfc = 1 + case('mp') + GFS_Control%spp_mp = 7 + case('rad') + GFS_Control%spp_rad = 1 + case('gwd') + GFS_Control%spp_gwd = 1 + end select + end do + end if if ( GFS_Control%lndp_type == 2 ) then ! this scheme updates through forecast allocate(sfc_wts(1:nblks,maxblk,1:GFS_Control%n_var_lndp)) end if @@ -154,7 +173,8 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) allocate(sfc_wts(1:nblks, maxblk, GFS_Control%n_var_lndp)) call run_stochastic_physics(levs, GFS_Control%kdt, GFS_Control%fhour, GFS_Control%blksz, & sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, & - skebv_wts=skebv_wts, sfc_wts=sfc_wts, nthreads=nthreads) + skebv_wts=skebv_wts, sfc_wts=sfc_wts, & + spp_wts=spp_wts, nthreads=nthreads) ! Copy contiguous data back do nb=1,nblks GFS_Data(nb)%Coupling%sfc_wts(:,:) = sfc_wts(nb,1:GFS_Control%blksz(nb),:) @@ -188,10 +208,10 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) is_initialized = .true. else initalize_stochastic_physics - if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type == 2) ) then + if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type == 2) .OR. GFS_Control%do_spp) then call run_stochastic_physics(levs, GFS_Control%kdt, GFS_Control%fhour, GFS_Control%blksz, & sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, skebv_wts=skebv_wts, sfc_wts=sfc_wts, & - nthreads=nthreads) + spp_wts=spp_wts, nthreads=nthreads) ! Copy contiguous data back if (GFS_Control%do_sppt) then do nb=1,nblks @@ -209,6 +229,32 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) GFS_Data(nb)%Coupling%skebv_wts(:,:) = skebv_wts(nb,1:GFS_Control%blksz(nb),:) end do end if + if (GFS_Control%do_spp) then + do n=1,GFS_Control%n_var_spp + select case (trim(GFS_Control%spp_var_list(n))) + case('pbl') + do nb=1,Atm_block%nblks + GFS_Data(nb)%Coupling%spp_wts_pbl(:,:) = spp_wts(nb,1:GFS_Control%blksz(nb),:,n) + end do + case('sfc') + do nb=1,Atm_block%nblks + GFS_Data(nb)%Coupling%spp_wts_sfc(:,:) = spp_wts(nb,1:GFS_Control%blksz(nb),:,n) + end do + case('mp') + do nb=1,Atm_block%nblks + GFS_Data(nb)%Coupling%spp_wts_mp(:,:) = spp_wts(nb,1:GFS_Control%blksz(nb),:,n) + end do + case('gwd') + do nb=1,Atm_block%nblks + GFS_Data(nb)%Coupling%spp_wts_gwd(:,:) = spp_wts(nb,1:GFS_Control%blksz(nb),:,n) + end do + case('rad') + do nb=1,Atm_block%nblks + GFS_Data(nb)%Coupling%spp_wts_rad(:,:) = spp_wts(nb,1:GFS_Control%blksz(nb),:,n) + end do + end select + end do + end if if (GFS_Control%lndp_type == 2) then ! save wts, and apply lndp scheme do nb=1,nblks GFS_Data(nb)%Coupling%sfc_wts(:,:) = sfc_wts(nb,1:GFS_Control%blksz(nb),:) @@ -347,7 +393,7 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) type(GFS_control_type), intent(inout) :: GFS_Control - if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type > 0) ) then + if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type > 0) .OR. GFS_Control%do_spp) then if (allocated(xlat)) deallocate(xlat) if (allocated(xlon)) deallocate(xlon) if (GFS_Control%do_sppt) then @@ -360,6 +406,9 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) if (allocated(skebu_wts)) deallocate(skebu_wts) if (allocated(skebv_wts)) deallocate(skebv_wts) end if + if (GFS_Control%do_spp) then + if (allocated(spp_wts)) deallocate(spp_wts) + end if if ( GFS_Control%lndp_type == 2 ) then ! this scheme updates through forecast lsoil = -999 if (allocated(sfc_wts)) deallocate(sfc_wts) diff --git a/time_utils.F90 b/time_utils.F90 deleted file mode 100644 index 69aafcb60..000000000 --- a/time_utils.F90 +++ /dev/null @@ -1,170 +0,0 @@ -module time_utils_mod - - use fms_mod, only: uppercase - use mpp_mod, only: mpp_error, FATAL - use time_manager_mod, only: time_type, set_time, set_date, get_date - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - use ESMF - - implicit none - private - - !-------------------- interface blocks --------------------- - interface fms2esmf_cal - module procedure fms2esmf_cal_c - module procedure fms2esmf_cal_i - end interface fms2esmf_cal - interface esmf2fms_time - module procedure esmf2fms_time_t - module procedure esmf2fms_timestep - end interface esmf2fms_time - - public fms2esmf_cal - public esmf2fms_time - public fms2esmf_time - public string_to_date - - contains - - !-------------------- module code --------------------- - - function fms2esmf_cal_c(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c -! ! Arguments: - character(len=*), intent(in) :: calendar - - select case( uppercase(trim(calendar)) ) - case( 'GREGORIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN - case( 'JULIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_JULIAN - case( 'NOLEAP' ) - fms2esmf_cal_c = ESMF_CALKIND_NOLEAP - case( 'THIRTY_DAY' ) - fms2esmf_cal_c = ESMF_CALKIND_360DAY - case( 'NO_CALENDAR' ) - fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR - case default - call mpp_error(FATAL, & - 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) - end select - end function fms2esmf_cal_c - - function fms2esmf_cal_i(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i -! ! Arguments: - integer, intent(in) :: calendar - - select case(calendar) - case(THIRTY_DAY_MONTHS) - fms2esmf_cal_i = ESMF_CALKIND_360DAY - case(GREGORIAN) - fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN - case(JULIAN) - fms2esmf_cal_i = ESMF_CALKIND_JULIAN - case(NOLEAP) - fms2esmf_cal_i = ESMF_CALKIND_NOLEAP - case(NO_CALENDAR) - fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR - end select - end function fms2esmf_cal_i - - function esmf2fms_time_t(time) - ! Return Value - type(Time_type) :: esmf2fms_time_t - ! Input Arguments - type(ESMF_Time), intent(in) :: time - ! Local Variables - integer :: yy, mm, dd, h, m, s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & - calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) - - end function esmf2fms_time_t - - function esmf2fms_timestep(timestep) - ! Return Value - type(Time_type) :: esmf2fms_timestep - ! Input Arguments - type(ESMF_TimeInterval), intent(in):: timestep - ! Local Variables - integer :: s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_timestep = set_time(s, 0) - - end function esmf2fms_timestep - - function fms2esmf_time(time, calkind) - ! Return Value - type(ESMF_Time) :: fms2esmf_time - ! Input Arguments - type(Time_type), intent(in) :: time - type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind - ! Local Variables - integer :: yy, mm, d, h, m, s - type(ESMF_CALKIND_FLAG) :: l_calkind - - integer :: rc - - integer :: yy1, mm1, d1, h1, m1, s1 - - if(present(calkind)) then - l_calkind = calkind - else - l_calkind = fms2esmf_cal(fms_get_calendar_type()) - endif - - call get_date(time, yy, mm, d, h, m, s) - print *,'in fms2esmf_time,time=',yy,mm,d,h,m,s,'calendar_type=', & - fms_get_calendar_type() - - call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, rc=rc) -! call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & -! calkindflag=l_calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -!test - call ESMF_TimeGet(fms2esmf_time,yy=yy1, mm=mm1, d=d1, h=h1, m=m1, s=s1,rc=rc) - print *,'in fms2esmf_time,test time=',yy1,mm1,d1,h1,m1,s1 - - end function fms2esmf_time - - function string_to_date(string, rc) - character(len=15), intent(in) :: string - integer, intent(out), optional :: rc - type(time_type) :: string_to_date - - integer :: yr,mon,day,hr,min,sec - - if(present(rc)) rc = ESMF_SUCCESS - - read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec - string_to_date = set_date(yr, mon, day, hr, min, sec) - - end function string_to_date - -end module time_utils_mod diff --git a/upp b/upp index c939eae6b..0dc3c0c1d 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit c939eae6bacb3c2a93753bba54b8646f32a0a7ab +Subproject commit 0dc3c0c1dbdcdc5025dff0c6b06b16aa2a7ddda9 From b82d5c6a29722c24a6369f8cf521c9700ccd0ae1 Mon Sep 17 00:00:00 2001 From: Hannah C Barnes <38660891+hannahcbarnes@users.noreply.github.com> Date: Wed, 9 Mar 2022 12:36:01 -0700 Subject: [PATCH 2/5] Remove GF Consistency Check & Add SDFs - V2 (#127) * - Removes consistency check in GF, allows GF to run with different or no shallow scheme - Add additional RAP based SDF * Point to gsl/develop for ccpp/physics Co-authored-by: Samuel Trahan --- ccpp/physics | 2 +- .../suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml | 94 +++++++++++++++++++ ...uite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml | 90 ++++++++++++++++++ 3 files changed, 185 insertions(+), 1 deletion(-) create mode 100644 ccpp/suites/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml create mode 100644 ccpp/suites/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml diff --git a/ccpp/physics b/ccpp/physics index 8c2450b4c..278a6d25b 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 8c2450b4c7d2791f80128538bdb18940b3c40b9b +Subproject commit 278a6d25bda3aa434bb3dd6f67c389ecae657fdb diff --git a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml new file mode 100644 index 000000000..924398609 --- /dev/null +++ b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml @@ -0,0 +1,94 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_gf_driver_pre + cu_gf_driver + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + cu_gf_driver_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml new file mode 100644 index 000000000..f639f233f --- /dev/null +++ b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml @@ -0,0 +1,90 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + unified_ugwp + unified_ugwp_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_gf_driver_pre + cu_gf_driver + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + cu_gf_driver_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + From ae7feac6f416af5db9ea9148e494628498e95c03 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Thu, 10 Mar 2022 12:27:14 -0700 Subject: [PATCH 3/5] Update to top of gsl/physics to get codeowners (#130) --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 278a6d25b..791fab61a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 278a6d25bda3aa434bb3dd6f67c389ecae657fdb +Subproject commit 791fab61a61ae6189a450c2343af6665f58d360d From c6ae1c240b0279d6e23936e1a9e84f9a8e7a5da0 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Tue, 15 Mar 2022 15:21:56 +0000 Subject: [PATCH 4/5] Put a comment back in the ccpp/physics. --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 4a0c1ab3d..d8db18ba9 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 4a0c1ab3d0aff6ee65e2925293fc8ed0272ba613 +Subproject commit d8db18ba90b807f729d0b03ff9d49bc6b7fc437d From fb91e7c992894a83712ba7db39628c4873b8013e Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Tue, 15 Mar 2022 17:22:08 +0000 Subject: [PATCH 5/5] point to head of ccpp/physics RRFS_dev branch --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index d8db18ba9..f0d6dcc7c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d8db18ba90b807f729d0b03ff9d49bc6b7fc437d +Subproject commit f0d6dcc7cbc583974e555fa3990486ca1a225a34