diff --git a/CMakeLists.txt b/CMakeLists.txt index ec9721ba6..169ca6e93 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -14,6 +14,9 @@ set(use_WRTCOMP ON) set(GFS_PHYS ON) set(GFS_TYPES ON) set(USE_GFSL63 ON) +if(MOVING_NEST) + set(MOVING_NEST ON) +endif() add_subdirectory(atmos_cubed_sphere) ############################################################################### @@ -22,7 +25,7 @@ add_subdirectory(atmos_cubed_sphere) if(INLINE_POST) set(BUILD_POSTEXEC OFF) add_subdirectory(upp) - set(POST_SRC io/inline_post.F90 io/post_nems_routines.F90 io/post_gfs.F90 io/post_regional.F90) + set(POST_SRC io/inline_post.F90 io/post_nems_routines.F90 io/post_fv3.F90) else() set(POST_SRC io/inline_post_stub.F90) list(APPEND _fv3atm_defs_private NO_INLINE_POST) @@ -32,6 +35,10 @@ if(NOT PARALLEL_NETCDF) list(APPEND _fv3atm_defs_private NO_PARALLEL_NETCDF) endif() +if(MOVING_NEST) + list(APPEND _fv3atm_defs_private MOVING_NEST) +endif() + add_library(fv3atm atmos_model.F90 fv3_cap.F90 @@ -43,7 +50,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..fad4c9f1f 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit fa86482e48f1d5b594acb369e68b8488de84dc66 +Subproject commit fad4c9f1fc29c0cbb47df9a07a573249155a1c42 diff --git a/atmos_model.F90 b/atmos_model.F90 index 3ac2555e9..e0ea26292 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -63,6 +63,7 @@ module atmos_model_mod use atmosphere_mod, only: atmosphere_restart use atmosphere_mod, only: atmosphere_end use atmosphere_mod, only: atmosphere_state_update +use atmosphere_mod, only: atmosphere_fill_nest_cpl use atmosphere_mod, only: atmos_phys_driver_statein use atmosphere_mod, only: atmosphere_control_data use atmosphere_mod, only: atmosphere_resolution, atmosphere_domain @@ -74,7 +75,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 @@ -101,6 +102,9 @@ module atmos_model_mod block_data_copy_or_fill, & block_data_combine_fractions +#ifdef MOVING_NEST +use fv_moving_nest_main_mod, only: update_moving_nest, dump_moving_nest +#endif !----------------------------------------------------------------------- implicit none @@ -113,6 +117,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,12 +130,16 @@ 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 + logical :: moving_nest_parent ! true if this grid has a moving nest child + logical :: is_moving_nest ! true if this is a moving nest grid + integer :: ngrids ! + integer :: mygrid ! integer :: mlon, mlat integer :: iau_offset ! iau running window length logical :: pe ! current pe. real(kind=8), pointer, dimension(:) :: ak, bk - real, pointer, dimension(:,:) :: lon_bnd => null() ! local longitude axis grid box corners in radians. - real, pointer, dimension(:,:) :: lat_bnd => null() ! local latitude axis grid box corners in radians. + real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lon_bnd => null() ! local longitude axis grid box corners in radians. + real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lat_bnd => null() ! local latitude axis grid box corners in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lon => null() ! local longitude axis grid box centers in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lat => null() ! local latitude axis grid box centers in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: dx, dy @@ -146,6 +155,14 @@ module atmos_model_mod ! to calculate gradient on cubic sphere grid. ! +! these two arrays, lon_bnd_work and lat_bnd_work are 'working' arrays, always allocated +! as (nlon+1, nlat+1) and are used to get the corner lat/lon values from the dycore. +! these values are then copied to Atmos%lon_bnd, Atmos%lat_bnd which are allocated with +! sizes that correspond to the corner coordinates distgrid in fcstGrid +real(kind=GFS_kind_phys), pointer, dimension(:,:), save :: lon_bnd_work => null() +real(kind=GFS_kind_phys), pointer, dimension(:,:), save :: lat_bnd_work => null() +integer, save :: i_bnd_size, j_bnd_size + integer :: fv3Clock, getClock, updClock, setupClock, radClock, physClock !----------------------------------------------------------------------- @@ -165,7 +182,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 +278,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') @@ -272,6 +288,17 @@ subroutine update_atmos_radiation_physics (Atmos) call assign_importdata(jdat(:),rc) if (rc/=0) call mpp_error(FATAL, 'Call to assign_importdata failed') + ! Currently for FV3ATM, it is only enabled for parent domain coupling + ! with other model components. In this case, only the parent domain + ! receives coupled fields through the above assign_importdata step. Thus, + ! an extra step is needed to fill the coupling variables in the nest, + ! by downscaling the coupling variables from its parent. + if (Atmos%ngrids > 1) then + if (GFS_control%cplocn2atm .or. GFS_control%cplwav2atm) then + call atmosphere_fill_nest_cpl(Atm_block, GFS_control, GFS_data) + endif + endif + ! Calculate total non-physics tendencies by substracting old GFS Stateout ! variables from new/updated GFS Statein variables (gives the tendencies ! due to anything else than physics) @@ -380,7 +407,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 +471,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 +481,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 +518,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 @@ -532,12 +553,35 @@ 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%moving_nest_parent, Atmos%is_moving_nest, & + 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.) + + call atmosphere_control_data (isc, iec, jsc, jec, nlev, p_hydro, hydro, tile_num) + + allocate (Atmos%lon(nlon,nlat), Atmos%lat(nlon,nlat)) call atmosphere_grid_ctr (Atmos%lon, Atmos%lat) + + i_bnd_size = nlon + j_bnd_size = nlat + if (iec == mlon) then + ! we are on task at the 'east' edge of the cubed sphere face or regional domain + ! corner arrays should have one extra element in 'i' direction + i_bnd_size = nlon + 1 + end if + if (jec == mlat) then + ! we are on task at the 'north' edge of the cubed sphere face or regional domain + ! corner arrays should have one extra element in 'j' direction + j_bnd_size = nlat + 1 + end if + allocate (Atmos%lon_bnd(i_bnd_size,j_bnd_size), Atmos%lat_bnd(i_bnd_size,j_bnd_size)) + allocate (lon_bnd_work(nlon+1,nlat+1), lat_bnd_work(nlon+1,nlat+1)) + call atmosphere_grid_bdry (lon_bnd_work, lat_bnd_work) + Atmos%lon_bnd(1:i_bnd_size,1:j_bnd_size) = lon_bnd_work(1:i_bnd_size,1:j_bnd_size) + Atmos%lat_bnd(1:i_bnd_size,1:j_bnd_size) = lat_bnd_work(1:i_bnd_size,1:j_bnd_size) + call atmosphere_hgt (Atmos%layer_hgt, 'layer', relative=.false., flip=flip_vc) call atmosphere_hgt (Atmos%level_hgt, 'level', relative=.false., flip=flip_vc) @@ -547,7 +591,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 @@ -555,7 +599,6 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !----------------------------------------------------------------------- !--- before going any further check definitions for 'blocks' !----------------------------------------------------------------------- - call atmosphere_control_data (isc, iec, jsc, jec, nlev, p_hydro, hydro, tile_num) call define_blocks_packed ('atmos_model', Atm_block, isc, iec, jsc, jec, nlev, & blocksize, block_message) @@ -635,19 +678,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 +745,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) @@ -775,8 +809,23 @@ subroutine update_atmos_model_dynamics (Atmos) type (atmos_data_type), intent(in) :: Atmos call set_atmosphere_pelist() +#ifdef MOVING_NEST + ! W. Ramstrom, AOML/HRD -- May 28, 2021 + ! Evaluates whether to move nest, then performs move if needed + if (Atmos%moving_nest_parent .or. Atmos%is_moving_nest ) then + call update_moving_nest (Atm_block, GFS_control, GFS_data, Atmos%Time) + endif +#endif call mpp_clock_begin(fv3Clock) call atmosphere_dynamics (Atmos%Time) +#ifdef MOVING_NEST + ! W. Ramstrom, AOML/HRD -- June 9, 2021 + ! Debugging output of moving nest code. Called from this level to access needed input variables. + if (Atmos%moving_nest_parent .or. Atmos%is_moving_nest ) then + call dump_moving_nest (Atm_block, GFS_control, GFS_data, Atmos%Time) + endif +#endif + call mpp_clock_end(fv3Clock) end subroutine update_atmos_model_dynamics @@ -933,6 +982,14 @@ subroutine update_atmos_model_state (Atmos, rc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return + !--- conditionally update the coordinate arrays for moving domains + if (Atmos%is_moving_nest) then + call atmosphere_grid_ctr (Atmos%lon, Atmos%lat) + call atmosphere_grid_bdry (lon_bnd_work, lat_bnd_work, global=.false.) + Atmos%lon_bnd(1:i_bnd_size,1:j_bnd_size) = lon_bnd_work(1:i_bnd_size,1:j_bnd_size) + Atmos%lat_bnd(1:i_bnd_size,1:j_bnd_size) = lat_bnd_work(1:i_bnd_size,1:j_bnd_size) + endif + end subroutine update_atmos_model_state ! @@ -964,7 +1021,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 +1034,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 @@ -988,11 +1045,18 @@ subroutine atmos_model_end (Atmos) endif ! Fast physics (from dynamics) are finalized in atmosphere_end above; -! standard/slow physics (from CCPP) are finalized in CCPP_step 'finalize'. +! standard/slow physics (from CCPP) are finalized in CCPP_step 'physics_finalize'. + call CCPP_step (step="physics_finalize", nblks=Atm_block%nblks, ierr=ierr) + if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP physics_finalize step failed') + ! The CCPP framework for all cdata structures is finalized in CCPP_step 'finalize'. call CCPP_step (step="finalize", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP finalize step failed') + deallocate (Atmos%lon, Atmos%lat) + deallocate (Atmos%lon_bnd, Atmos%lat_bnd) + deallocate (lon_bnd_work, lat_bnd_work) + end subroutine atmos_model_end ! @@ -1181,16 +1245,20 @@ subroutine update_atmos_chemistry(state, rc) integer :: nb, ix, i, j, k, k1, it integer :: ib, jb - real(ESMF_KIND_R8), dimension(:,:,:), pointer :: prsl, phil, & - prsi, phii, & - temp, cldfra, & - pflls, pfils, & - ua, va, slc + real(ESMF_KIND_R8), dimension(:,:,:), pointer :: cldfra, & + pfils, pflls, & + phii, phil, & + prsi, prsl, & + slc, smc, & + stc, temp, & + ua, va + real(ESMF_KIND_R8), dimension(:,:,:,:), pointer :: q - real(ESMF_KIND_R8), dimension(:,:), pointer :: hpbl, area, rainc, & - uustar, rain, slmsk, tsfc, shfsfc, zorl, focn, flake, fice, & - fsnow, u10m, v10m, swet + real(ESMF_KIND_R8), dimension(:,:), pointer :: aod, area, canopy, cmm, & + dqsfc, dtsfc, fice, flake, focn, fsnow, hpbl, nswsfc, oro, psfc, & + q2m, rain, rainc, rca, shfsfc, slmsk, stype, swet, t2m, tsfc, & + u10m, uustar, v10m, vfrac, xlai, zorl ! logical, parameter :: diag = .true. @@ -1211,6 +1279,12 @@ subroutine update_atmos_chemistry(state, rc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return + if (GFS_control%cplaqm) then + call cplFieldGet(state,'inst_tracer_diag_aod', farrayPtr2d=aod, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + end if + !--- do not import tracer concentrations by default ntb = nt + 1 nte = nt @@ -1267,26 +1341,41 @@ subroutine update_atmos_chemistry(state, rc) end do end if + if (GFS_control%cplaqm) then + !--- other diagnostics +!$OMP parallel do default (none) & +!$OMP shared (nj, ni, Atm_block, GFS_Data, aod) & +!$OMP private (j, jb, i, ib, nb, ix) + do j = 1, nj + jb = j + Atm_block%jsc - 1 + do i = 1, ni + ib = i + Atm_block%isc - 1 + nb = Atm_block%blkno(ib,jb) + ix = Atm_block%ixp(ib,jb) + GFS_Data(nb)%IntDiag%aod(ix) = aod(i,j) + enddo + enddo + end if + if (GFS_control%debug) then write(6,'("update_atmos: ",a,": qgrs - min/max/avg",3g16.6)') & trim(state), minval(q), maxval(q), sum(q)/size(q) + if (GFS_control%cplaqm) & + write(6,'("update_atmos: ",a,": aod - min/max ",3g16.6)') & + trim(state), minval(aod), maxval(aod) end if case ('export') !--- retrieve references to allocated memory for each field - call cplFieldGet(state,'inst_pres_interface', farrayPtr3d=prsi, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_pres_levels', farrayPtr3d=prsl, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_geop_interface', farrayPtr3d=phii, rc=localrc) + call cplFieldGet(state,'inst_geop_levels', farrayPtr3d=phil, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_geop_levels', farrayPtr3d=phil, rc=localrc) + call cplFieldGet(state,'inst_geop_interface', farrayPtr3d=phii, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -1335,28 +1424,10 @@ subroutine update_atmos_chemistry(state, rc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_up_sensi_heat_flx', farrayPtr2d=shfsfc, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_surface_roughness', farrayPtr2d=zorl, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_soil_moisture_content', farrayPtr3d=slc, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - call cplFieldGet(state,'inst_liq_nonconv_tendency_levels', & - farrayPtr3d=pflls, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__, rcToReturn=rc)) return - - call cplFieldGet(state,'inst_ice_nonconv_tendency_levels', & - farrayPtr3d=pfils, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_cloud_frac_levels', farrayPtr3d=cldfra, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -1369,25 +1440,113 @@ subroutine update_atmos_chemistry(state, rc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'inst_surface_soil_wetness', farrayPtr2d=swet, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'ice_fraction_in_atm', farrayPtr2d=fice, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'lake_fraction', farrayPtr2d=flake, rc=localrc) + call cplFieldGet(state,'surface_snow_area_fraction', farrayPtr2d=fsnow, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__, rcToReturn=rc)) return - call cplFieldGet(state,'ocean_fraction', farrayPtr2d=focn, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__, rcToReturn=rc)) return + if (GFS_Control%cplaqm) then - call cplFieldGet(state,'surface_snow_area_fraction', farrayPtr2d=fsnow, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__, rcToReturn=rc)) return + call cplFieldGet(state,'canopy_moisture_storage', farrayPtr2d=canopy, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_aerodynamic_conductance', farrayPtr2d=cmm, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_laten_heat_flx', farrayPtr2d=dqsfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_sensi_heat_flx', farrayPtr2d=dtsfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_net_sw_flx', farrayPtr2d=nswsfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'height', farrayPtr2d=oro, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_pres_height_surface', farrayPtr2d=psfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_spec_humid_height2m', farrayPtr2d=q2m, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_canopy_resistance', farrayPtr2d=rca, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_soil_moisture_content', farrayPtr3d=smc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'temperature_of_soil_layer', farrayPtr3d=stc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_temp_height2m', farrayPtr2d=t2m, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_vegetation_area_frac', farrayPtr2d=vfrac, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'leaf_area_index', farrayPtr2d=xlai, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'soil_type', farrayPtr2d=stype, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + else + + call cplFieldGet(state,'inst_pres_interface', farrayPtr3d=prsi, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_liq_nonconv_tendency_levels', & + farrayPtr3d=pflls, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_ice_nonconv_tendency_levels', & + farrayPtr3d=pfils, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'lake_fraction', farrayPtr2d=flake, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'ocean_fraction', farrayPtr2d=focn, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_up_sensi_heat_flx', farrayPtr2d=shfsfc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_soil_moisture_content', farrayPtr3d=slc, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + call cplFieldGet(state,'inst_surface_soil_wetness', farrayPtr2d=swet, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__, rcToReturn=rc)) return + + end if !--- handle all three-dimensional variables !$OMP parallel do default (none) & @@ -1403,7 +1562,6 @@ subroutine update_atmos_chemistry(state, rc) nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) !--- interface values - prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k) phii(i,j,k) = GFS_data(nb)%Statein%phii(ix,k) !--- layer values prsl(i,j,k) = GFS_Data(nb)%Statein%prsl(ix,k) @@ -1412,8 +1570,13 @@ subroutine update_atmos_chemistry(state, rc) ua (i,j,k) = GFS_Data(nb)%Stateout%gu0(ix,k) va (i,j,k) = GFS_Data(nb)%Stateout%gv0(ix,k) cldfra(i,j,k) = GFS_Data(nb)%IntDiag%cldfra(ix,k) - pfils (i,j,k) = GFS_Data(nb)%Coupling%pfi_lsan(ix,k) - pflls (i,j,k) = GFS_Data(nb)%Coupling%pfl_lsan(ix,k) + if (.not.GFS_Control%cplaqm) then + !--- interface values + prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k) + !--- layer values + pfils (i,j,k) = GFS_Data(nb)%Coupling%pfi_lsan(ix,k) + pflls (i,j,k) = GFS_Data(nb)%Coupling%pfl_lsan(ix,k) + end if enddo enddo enddo @@ -1427,8 +1590,9 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k) phii(i,j,k) = GFS_data(nb)%Statein%phii(ix,k) + if (.not.GFS_Control%cplaqm) & + prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k) enddo enddo @@ -1452,9 +1616,11 @@ subroutine update_atmos_chemistry(state, rc) !$OMP parallel do default (none) & !$OMP shared (nj, ni, Atm_block, GFS_data, GFS_Control, & -!$OMP hpbl, area, rainc, rain, uustar, & -!$OMP fice, flake, focn, fsnow, u10m, v10m, & -!$OMP slmsk, tsfc, shfsfc, zorl, slc, swet) & +!$OMP area, canopy, cmm, dqsfc, dtsfc, fice, & +!$OMP flake, focn, fsnow, hpbl, nswsfc, oro, & +!$OMP psfc, q2m, rain, rainc, rca, shfsfc, slc, & +!$OMP slmsk, smc, stc, stype, swet, t2m, tsfc, & +!$OMP u10m, uustar, v10m, vfrac, xlai, zorl) & !$OMP private (j, jb, i, ib, nb, ix) do j = 1, nj jb = j + Atm_block%jsc - 1 @@ -1469,20 +1635,46 @@ subroutine update_atmos_chemistry(state, rc) + GFS_Data(nb)%Coupling%snow_cpl(ix) uustar(i,j) = GFS_Data(nb)%Sfcprop%uustar(ix) slmsk(i,j) = GFS_Data(nb)%Sfcprop%slmsk(ix) - shfsfc(i,j) = GFS_Data(nb)%Coupling%ushfsfci(ix) tsfc(i,j) = GFS_Data(nb)%Coupling%tsfci_cpl(ix) zorl(i,j) = GFS_Data(nb)%Sfcprop%zorl(ix) - slc(i,j,:) = GFS_Data(nb)%Sfcprop%slc(ix,:) u10m(i,j) = GFS_Data(nb)%Coupling%u10mi_cpl(ix) v10m(i,j) = GFS_Data(nb)%Coupling%v10mi_cpl(ix) - focn(i,j) = GFS_Data(nb)%Sfcprop%oceanfrac(ix) - flake(i,j) = max(zero, GFS_Data(nb)%Sfcprop%lakefrac(ix)) fice(i,j) = GFS_Data(nb)%Sfcprop%fice(ix) fsnow(i,j) = GFS_Data(nb)%Sfcprop%sncovr(ix) - if (GFS_Control%lsm == GFS_Control%lsm_ruc) then - swet(i,j) = GFS_Data(nb)%Sfcprop%wetness(ix) + if (GFS_Control%cplaqm) then + canopy(i,j) = GFS_Data(nb)%Sfcprop%canopy(ix) + cmm(i,j) = GFS_Data(nb)%IntDiag%cmm(ix) + dqsfc(i,j) = GFS_Data(nb)%Coupling%dqsfci_cpl(ix) + dtsfc(i,j) = GFS_Data(nb)%Coupling%dtsfci_cpl(ix) + nswsfc(i,j) = GFS_Data(nb)%Coupling%nswsfci_cpl(ix) + oro(i,j) = max(0.d0, GFS_Data(nb)%Sfcprop%oro(ix)) + psfc(i,j) = GFS_Data(nb)%Coupling%psurfi_cpl(ix) + q2m(i,j) = GFS_Data(nb)%Coupling%q2mi_cpl(ix) + rca(i,j) = GFS_Data(nb)%Sfcprop%rca(ix) + smc(i,j,:) = GFS_Data(nb)%Sfcprop%smc(ix,:) + stc(i,j,:) = GFS_Data(nb)%Sfcprop%stc(ix,:) + t2m(i,j) = GFS_Data(nb)%Coupling%t2mi_cpl(ix) + vfrac(i,j) = GFS_Data(nb)%Sfcprop%vfrac(ix) + xlai(i,j) = GFS_Data(nb)%Sfcprop%xlaixy(ix) + if (nint(slmsk(i,j)) == 2) then + if (GFS_Control%isot == 1) then + stype(i,j) = 16._ESMF_KIND_R8 + else + stype(i,j) = 9._ESMF_KIND_R8 + endif + else + stype(i,j) = real(int( GFS_Data(nb)%Sfcprop%stype(ix)+0.5 ), kind=ESMF_KIND_R8) + endif else - swet(i,j) = GFS_Data(nb)%IntDiag%wet1(ix) + flake(i,j) = max(zero, GFS_Data(nb)%Sfcprop%lakefrac(ix)) + focn(i,j) = GFS_Data(nb)%Sfcprop%oceanfrac(ix) + shfsfc(i,j) = GFS_Data(nb)%Coupling%ushfsfci(ix) + slc(i,j,:) = GFS_Data(nb)%Sfcprop%slc(ix,:) + if (GFS_Control%lsm == GFS_Control%lsm_ruc) then + swet(i,j) = GFS_Data(nb)%Sfcprop%wetness(ix) + else + swet(i,j) = GFS_Data(nb)%IntDiag%wet1(ix) + end if end if enddo enddo @@ -1507,7 +1699,6 @@ subroutine update_atmos_chemistry(state, rc) if (GFS_control%debug) then ! -- diagnostics - write(6,'("update_atmos: prsi - min/max/avg",3g16.6)') minval(prsi), maxval(prsi), sum(prsi)/size(prsi) write(6,'("update_atmos: phii - min/max/avg",3g16.6)') minval(phii), maxval(phii), sum(phii)/size(phii) write(6,'("update_atmos: prsl - min/max/avg",3g16.6)') minval(prsl), maxval(prsl), sum(prsl)/size(prsl) write(6,'("update_atmos: phil - min/max/avg",3g16.6)') minval(phil), maxval(phil), sum(phil)/size(phil) @@ -1519,21 +1710,40 @@ subroutine update_atmos_chemistry(state, rc) write(6,'("update_atmos: hpbl - min/max/avg",3g16.6)') minval(hpbl), maxval(hpbl), sum(hpbl)/size(hpbl) write(6,'("update_atmos: rainc - min/max/avg",3g16.6)') minval(rainc), maxval(rainc), sum(rainc)/size(rainc) write(6,'("update_atmos: rain - min/max/avg",3g16.6)') minval(rain), maxval(rain), sum(rain)/size(rain) - write(6,'("update_atmos: shfsfc - min/max/avg",3g16.6)') minval(shfsfc), maxval(shfsfc), sum(shfsfc)/size(shfsfc) write(6,'("update_atmos: slmsk - min/max/avg",3g16.6)') minval(slmsk), maxval(slmsk), sum(slmsk)/size(slmsk) write(6,'("update_atmos: tsfc - min/max/avg",3g16.6)') minval(tsfc), maxval(tsfc), sum(tsfc)/size(tsfc) write(6,'("update_atmos: area - min/max/avg",3g16.6)') minval(area), maxval(area), sum(area)/size(area) write(6,'("update_atmos: zorl - min/max/avg",3g16.6)') minval(zorl), maxval(zorl), sum(zorl)/size(zorl) - write(6,'("update_atmos: slc - min/max/avg",3g16.6)') minval(slc), maxval(slc), sum(slc)/size(slc) write(6,'("update_atmos: cldfra - min/max/avg",3g16.6)') minval(cldfra), maxval(cldfra), sum(cldfra)/size(cldfra) write(6,'("update_atmos: fice - min/max/avg",3g16.6)') minval(fice), maxval(fice), sum(fice)/size(fice) - write(6,'("update_atmos: flake - min/max/avg",3g16.6)') minval(flake), maxval(flake), sum(flake)/size(flake) - write(6,'("update_atmos: focn - min/max/avg",3g16.6)') minval(focn), maxval(focn), sum(focn)/size(focn) write(6,'("update_atmos: pfils - min/max/avg",3g16.6)') minval(pfils), maxval(pfils), sum(pfils)/size(pfils) write(6,'("update_atmos: pflls - min/max/avg",3g16.6)') minval(pflls), maxval(pflls), sum(pflls)/size(pflls) - write(6,'("update_atmos: swet - min/max/avg",3g16.6)') minval(swet), maxval(swet), sum(swet)/size(swet) write(6,'("update_atmos: u10m - min/max/avg",3g16.6)') minval(u10m), maxval(u10m), sum(u10m)/size(u10m) write(6,'("update_atmos: v10m - min/max/avg",3g16.6)') minval(v10m), maxval(v10m), sum(v10m)/size(v10m) + if (GFS_Control%cplaqm) then + write(6,'("update_atmos: canopy - min/max/avg",3g16.6)') minval(canopy), maxval(canopy), sum(canopy)/size(canopy) + write(6,'("update_atmos: cmm - min/max/avg",3g16.6)') minval(cmm), maxval(cmm), sum(cmm)/size(cmm) + write(6,'("update_atmos: dqsfc - min/max/avg",3g16.6)') minval(dqsfc), maxval(dqsfc), sum(dqsfc)/size(dqsfc) + write(6,'("update_atmos: dtsfc - min/max/avg",3g16.6)') minval(dtsfc), maxval(dtsfc), sum(dtsfc)/size(dtsfc) + write(6,'("update_atmos: nswsfc - min/max/avg",3g16.6)') minval(nswsfc), maxval(nswsfc), sum(nswsfc)/size(nswsfc) + write(6,'("update_atmos: oro - min/max/avg",3g16.6)') minval(oro), maxval(oro), sum(oro)/size(oro) + write(6,'("update_atmos: psfc - min/max/avg",3g16.6)') minval(psfc), maxval(psfc), sum(psfc)/size(psfc) + write(6,'("update_atmos: q2m - min/max/avg",3g16.6)') minval(q2m), maxval(q2m), sum(q2m)/size(q2m) + write(6,'("update_atmos: rca - min/max/avg",3g16.6)') minval(rca), maxval(rca), sum(rca)/size(rca) + write(6,'("update_atmos: smc - min/max/avg",3g16.6)') minval(smc), maxval(smc), sum(smc)/size(smc) + write(6,'("update_atmos: stc - min/max/avg",3g16.6)') minval(stc), maxval(stc), sum(stc)/size(stc) + write(6,'("update_atmos: t2m - min/max/avg",3g16.6)') minval(t2m), maxval(t2m), sum(t2m)/size(t2m) + write(6,'("update_atmos: vfrac - min/max/avg",3g16.6)') minval(vfrac), maxval(vfrac), sum(vfrac)/size(vfrac) + write(6,'("update_atmos: xlai - min/max/avg",3g16.6)') minval(xlai), maxval(xlai), sum(xlai)/size(xlai) + write(6,'("update_atmos: stype - min/max/avg",3g16.6)') minval(stype), maxval(stype), sum(stype)/size(stype) + else + write(6,'("update_atmos: prsi - min/max/avg",3g16.6)') minval(prsi), maxval(prsi), sum(prsi)/size(prsi) + write(6,'("update_atmos: flake - min/max/avg",3g16.6)') minval(flake), maxval(flake), sum(flake)/size(flake) + write(6,'("update_atmos: focn - min/max/avg",3g16.6)') minval(focn), maxval(focn), sum(focn)/size(focn) + write(6,'("update_atmos: shfsfc - min/max/avg",3g16.6)') minval(shfsfc), maxval(shfsfc), sum(shfsfc)/size(shfsfc) + write(6,'("update_atmos: slc - min/max/avg",3g16.6)') minval(slc), maxval(slc), sum(slc)/size(slc) + write(6,'("update_atmos: swet - min/max/avg",3g16.6)') minval(swet), maxval(swet), sum(swet)/size(swet) + end if end if case default @@ -1543,71 +1753,6 @@ subroutine update_atmos_chemistry(state, rc) 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) - integer, intent(in) :: nlon, nlat - type(atmos_data_type), intent(inout) :: Atmos - allocate ( Atmos % lon_bnd (nlon+1,nlat+1), & - Atmos % lat_bnd (nlon+1,nlat+1), & - Atmos % lon (nlon,nlat), & - Atmos % lat (nlon,nlat) ) - - end subroutine alloc_atmos_data_type - - subroutine dealloc_atmos_data_type (Atmos) - type(atmos_data_type), intent(inout) :: Atmos - deallocate (Atmos%lon_bnd, & - Atmos%lat_bnd, & - Atmos%lon, & - Atmos%lat ) - end subroutine dealloc_atmos_data_type - subroutine assign_importdata(jdat, rc) use module_cplfields, only: importFields, nImportFields, queryImportFields, & @@ -1623,7 +1768,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 +1778,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 +1834,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 @@ -2071,6 +2211,105 @@ subroutine assign_importdata(jdat, rc) endif endif +! get upward LW flux: for open ocean +!---------------------------------------------- + fldname = 'mean_up_lw_flx_ocn' + if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%ulwsfcin_med(ix) = -datar8(i,j) + endif + enddo + enddo + if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get lwflx for open ocean from mediator' + endif + endif + +! get latent heat flux: for open ocean +!------------------------------------------------ + fldname = 'mean_laten_heat_flx_atm_into_ocn' + if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%dqsfcin_med(ix) = -datar8(i,j) + endif + enddo + enddo + if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get laten_heat for open ocean from mediator' + endif + endif + +! get sensible heat flux: for open ocean +!-------------------------------------------------- + fldname = 'mean_sensi_heat_flx_atm_into_ocn' + if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%dtsfcin_med(ix) = -datar8(i,j) + endif + enddo + enddo + if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get sensi_heat for open ocean from mediator' + endif + endif + +! get zonal compt of momentum flux: for open ocean +!------------------------------------------------------------ + fldname = 'stress_on_air_ocn_zonal' + if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%dusfcin_med(ix) = -datar8(i,j) + endif + enddo + enddo + if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get zonal_moment_flx for open ocean from mediator' + endif + endif + +! get meridional compt of momentum flux: for open ocean +!----------------------------------------------------------------- + fldname = 'stress_on_air_ocn_merid' + if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%dvsfcin_med(ix) = -datar8(i,j) + endif + enddo + enddo + if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get merid_moment_flx for open ocean from mediator' + endif + endif endif ! if (datar8(isc,jsc) > -99999.0) then @@ -2489,7 +2728,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 +2785,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 +2798,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 +2824,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 +3132,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 +3183,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/CMakeLists.txt b/ccpp/CMakeLists.txt index 7f1af3301..f204904a3 100644 --- a/ccpp/CMakeLists.txt +++ b/ccpp/CMakeLists.txt @@ -10,13 +10,9 @@ if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) message(STATUS "Setting build type to 'Release' as none was specified.") set(CMAKE_BUILD_TYPE Release CACHE STRING "Choose the type of build." FORCE) # Set the possible values of build type for cmake-gui - set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release" "Coverage") + set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release") endif() -#------------------------------------------------------------------------------ -# CMake Modules -list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/framework/cmake") - #------------------------------------------------------------------------------ # Call to CCPP code generator if(DEBUG) @@ -54,21 +50,13 @@ if(MPI) add_definitions(-DMPI) endif() -#------------------------------------------------------------------------------ -# Set additional flags for debug build -if(DEBUG) - if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -init=snan,arrays") - endif() -endif() - #------------------------------------------------------------------------------ # Set flag for 32bit dynamics build if(32BIT) message(STATUS "Compile CCPP slow physics with 64-bit precision, fast physics with 32-bit precision") add_definitions(-DOVERLOAD_R4) if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 64 -no-prec-div -no-prec-sqrt") + set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 64") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") set(CMAKE_Fortran_FLAGS_PHYSICS "-fdefault-real-8 -fdefault-double-8") endif() @@ -117,7 +105,6 @@ add_library( # Compile GFS_diagnostics.F90 without optimization, this leads to out of memory errors on wcoss_dell_p3 set_property(SOURCE driver/GFS_diagnostics.F90 APPEND_STRING PROPERTY COMPILE_FLAGS "-O0") - target_link_libraries(fv3ccpp PUBLIC ccpp_framework) target_link_libraries(fv3ccpp PUBLIC ccpp_physics) diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index bbc7da433..2d848c1eb 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -47,7 +47,8 @@ 'module_radlw_parameters' : '', }, 'CCPP_typedefs' : { - 'CCPP_interstitial_type' : 'CCPP_interstitial', + 'GFS_interstitial_type' : 'GFS_Interstitial(cdata%thrd_no)', + 'GFDL_interstitial_type' : 'GFDL_interstitial', 'CCPP_typedefs' : '', }, 'CCPP_data' : { @@ -55,7 +56,6 @@ }, 'GFS_typedefs' : { 'GFS_control_type' : 'GFS_Control', - 'GFS_interstitial_type' : 'GFS_Interstitial(cdata%thrd_no)', 'GFS_data_type' : 'GFS_Data(cdata%blk_no)', 'GFS_diag_type' : 'GFS_Data(cdata%blk_no)%Intdiag', 'GFS_tbd_type' : 'GFS_Data(cdata%blk_no)%Tbd', @@ -96,11 +96,16 @@ # Relative path to source (from where ccpp_prebuild.py is called) : [ list of physics sets in which scheme may be called ]; # current restrictions are that each scheme can only belong to one physics set, and all schemes within one group in the # suite definition file have to belong to the same physics set - 'physics/physics/GFS_DCNV_generic.F90', - 'physics/physics/GFS_GWD_generic.F90', - 'physics/physics/GFS_MP_generic.F90', - 'physics/physics/GFS_PBL_generic.F90', - 'physics/physics/GFS_SCNV_generic.F90', + 'physics/physics/GFS_DCNV_generic_pre.F90', + 'physics/physics/GFS_DCNV_generic_post.F90', + 'physics/physics/GFS_GWD_generic_pre.F90', + 'physics/physics/GFS_GWD_generic_post.F90', + 'physics/physics/GFS_MP_generic_pre.F90', + 'physics/physics/GFS_MP_generic_post.F90', + 'physics/physics/GFS_PBL_generic_pre.F90', + 'physics/physics/GFS_PBL_generic_post.F90', + 'physics/physics/GFS_SCNV_generic_pre.F90', + 'physics/physics/GFS_SCNV_generic_post.F90', 'physics/physics/GFS_debug.F90', 'physics/physics/GFS_phys_time_vary.fv3.F90', 'physics/physics/GFS_rad_time_vary.fv3.F90', @@ -109,10 +114,22 @@ 'physics/physics/GFS_rrtmg_pre.F90', 'physics/physics/GFS_rrtmg_setup.F90', 'physics/physics/GFS_stochastics.F90', - 'physics/physics/GFS_suite_interstitial.F90', - 'physics/physics/GFS_surface_generic.F90', - 'physics/physics/GFS_surface_composites.F90', - 'physics/physics/GFS_surface_loop_control.F90', + 'physics/physics/GFS_suite_interstitial_rad_reset.F90', + 'physics/physics/GFS_suite_interstitial_phys_reset.F90', + 'physics/physics/GFS_suite_interstitial_1.F90', + 'physics/physics/GFS_suite_interstitial_2.F90', + 'physics/physics/GFS_suite_stateout_reset.F90', + 'physics/physics/GFS_suite_stateout_update.F90', + 'physics/physics/GFS_suite_interstitial_3.F90', + 'physics/physics/GFS_suite_interstitial_4.F90', + 'physics/physics/GFS_suite_interstitial_5.F90', + 'physics/physics/GFS_surface_generic_pre.F90', + 'physics/physics/GFS_surface_generic_post.F90', + 'physics/physics/GFS_surface_composites_pre.F90', + 'physics/physics/GFS_surface_composites_inter.F90', + 'physics/physics/GFS_surface_composites_post.F90', + 'physics/physics/GFS_surface_loop_control_part1.F90', + 'physics/physics/GFS_surface_loop_control_part2.F90', 'physics/physics/GFS_time_vary_pre.fv3.F90', 'physics/physics/cires_ugwp.F90', 'physics/physics/cires_ugwp_post.F90', @@ -121,20 +138,25 @@ 'physics/physics/ugwpv1_gsldrag.F90', 'physics/physics/ugwpv1_gsldrag_post.F90', 'physics/physics/cnvc90.f', + 'physics/physics/cs_conv_pre.F90', 'physics/physics/cs_conv.F90', + 'physics/physics/cs_conv_post.F90', 'physics/physics/cs_conv_aw_adj.F90', 'physics/physics/cu_ntiedtke_pre.F90', 'physics/physics/cu_ntiedtke.F90', 'physics/physics/cu_ntiedtke_post.F90', - 'physics/physics/dcyc2.f', + 'physics/physics/dcyc2t3.f', 'physics/physics/drag_suite.F90', - 'physics/physics/gcm_shoc.F90', + 'physics/physics/shoc.F90', 'physics/physics/get_prs_fv3.F90', + 'physics/physics/get_phi_fv3.F90', 'physics/physics/gfdl_cloud_microphys.F90', - 'physics/physics/gfdl_fv_sat_adj.F90', + 'physics/physics/fv_sat_adj.F90', 'physics/physics/gfdl_sfc_layer.F90', - 'physics/physics/gscond.f', + 'physics/physics/zhaocarr_gscond.f', + 'physics/physics/gwdc_pre.f', 'physics/physics/gwdc.f', + 'physics/physics/gwdc_post.f', 'physics/physics/gwdps.f', 'physics/physics/h2ophys.f', 'physics/physics/samfdeepcnv.f', @@ -143,28 +165,30 @@ 'physics/physics/shalcnv.F', 'physics/physics/maximum_hourly_diagnostics.F90', 'physics/physics/m_micro.F90', - 'physics/physics/m_micro_interstitial.F90', + 'physics/physics/m_micro_pre.F90', + 'physics/physics/m_micro_post.F90', 'physics/physics/cu_gf_driver_pre.F90', 'physics/physics/cu_gf_driver.F90', 'physics/physics/cu_gf_driver_post.F90', - 'physics/physics/moninedmf.f', + 'physics/physics/hedmf.f', 'physics/physics/moninshoc.f', 'physics/physics/satmedmfvdif.F', 'physics/physics/satmedmfvdifq.F', 'physics/physics/shinhongvdif.F90', 'physics/physics/ysuvdif.F90', - 'physics/physics/module_MYNNPBL_wrapper.F90', - 'physics/physics/module_MYNNSFC_wrapper.F90', - 'physics/physics/module_SGSCloud_RadPre.F90', - 'physics/physics/module_SGSCloud_RadPost.F90', - 'physics/physics/module_MYJSFC_wrapper.F90', - 'physics/physics/module_MYJPBL_wrapper.F90', + 'physics/physics/mynnedmf_wrapper.F90', + 'physics/physics/mynnsfc_wrapper.F90', + 'physics/physics/sgscloud_radpre.F90', + 'physics/physics/sgscloud_radpost.F90', + 'physics/physics/myjsfc_wrapper.F90', + 'physics/physics/myjpbl_wrapper.F90', 'physics/physics/mp_thompson_pre.F90', 'physics/physics/mp_thompson.F90', 'physics/physics/mp_thompson_post.F90', + 'physics/physics/mp_nssl.F90' , 'physics/physics/ozphys.f', 'physics/physics/ozphys_2015.f', - 'physics/physics/precpd.f', + 'physics/physics/zhaocarr_precpd.f', 'physics/physics/phys_tend.F90', 'physics/physics/radlw_main.F90', 'physics/physics/radsw_main.F90', @@ -173,47 +197,49 @@ 'physics/physics/rrtmg_lw_post.F90', 'physics/physics/rrtmg_lw_pre.F90', 'physics/physics/rrtmg_sw_post.F90', - 'physics/physics/rrtmg_sw_pre.F90', + 'physics/physics/rad_sw_pre.F90', 'physics/physics/sfc_diag.f', 'physics/physics/sfc_diag_post.F90', - 'physics/physics/sfc_drv_ruc.F90', + 'physics/physics/lsm_ruc.F90', 'physics/physics/sfc_cice.f', 'physics/physics/sfc_diff.f', - 'physics/physics/sfc_drv.f', - 'physics/physics/sfc_noahmp_drv.F90', + 'physics/physics/lsm_noah.f', + 'physics/physics/noahmpdrv.F90', 'physics/physics/flake_driver.F90', + 'physics/physics/sfc_nst_pre.f', 'physics/physics/sfc_nst.f', + 'physics/physics/sfc_nst_post.f', 'physics/physics/sfc_ocean.F', 'physics/physics/sfc_sice.f', # HAFS FER_HIRES 'physics/physics/mp_fer_hires.F90', + # SMOKE + 'physics/smoke/rrfs_smoke_wrapper.F90', + 'physics/smoke/rrfs_smoke_postpbl.F90', + 'physics/smoke/rrfs_smoke_lsdep_wrapper.F90', # RRTMGP 'physics/physics/rrtmgp_lw_gas_optics.F90', 'physics/physics/rrtmgp_lw_cloud_optics.F90', 'physics/physics/rrtmgp_sw_gas_optics.F90', 'physics/physics/rrtmgp_sw_cloud_optics.F90', - 'physics/physics/rrtmgp_sw_aerosol_optics.F90', + 'physics/physics/rrtmgp_aerosol_optics.F90', 'physics/physics/rrtmgp_lw_rte.F90', 'physics/physics/rrtmgp_sw_rte.F90', - 'physics/physics/rrtmgp_lw_aerosol_optics.F90', 'physics/physics/GFS_rrtmgp_setup.F90', 'physics/physics/GFS_rrtmgp_pre.F90', 'physics/physics/rrtmgp_lw_pre.F90', - 'physics/physics/GFS_rrtmgp_sw_pre.F90', 'physics/physics/GFS_rrtmgp_lw_post.F90', 'physics/physics/rrtmgp_lw_cloud_sampling.F90', 'physics/physics/rrtmgp_sw_cloud_sampling.F90', 'physics/physics/GFS_cloud_diagnostics.F90', - 'physics/physics/GFS_rrtmgp_thompsonmp_pre.F90', - 'physics/physics/GFS_rrtmgp_gfdlmp_pre.F90', - 'physics/physics/GFS_rrtmgp_zhaocarr_pre.F90', - 'physics/physics/GFS_rrtmgp_cloud_overlap_pre.F90', + 'physics/physics/GFS_rrtmgp_cloud_mp.F90', + 'physics/physics/GFS_rrtmgp_cloud_overlap.F90', 'physics/physics/GFS_rrtmgp_sw_post.F90' ] # Default build dir, relative to current working directory, # if not specified as command-line argument -DEFAULT_BUILD_DIR = 'FV3' +DEFAULT_BUILD_DIR = 'build' # Auto-generated makefile/cmakefile snippets that contain all type definitions TYPEDEFS_MAKEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.mk' @@ -238,9 +264,11 @@ # Directory where to write static API to STATIC_API_DIR = '{build_dir}/physics' -STATIC_API_SRCFILE = '{build_dir}/physics/CCPP_STATIC_API.sh' +STATIC_API_CMAKEFILE = '{build_dir}/physics/CCPP_STATIC_API.cmake' +STATIC_API_SOURCEFILE = '{build_dir}/physics/CCPP_STATIC_API.sh' # Directory for writing HTML pages generated from metadata files +# used by metadata2html.py for generating scientific documentation METADATA_HTML_OUTPUT_DIR = '{build_dir}/physics/physics/docs' # HTML document containing the model-defined CCPP variables diff --git a/ccpp/data/CCPP_data.F90 b/ccpp/data/CCPP_data.F90 index dbb646035..9bba44641 100644 --- a/ccpp/data/CCPP_data.F90 +++ b/ccpp/data/CCPP_data.F90 @@ -5,10 +5,10 @@ module CCPP_data !! use ccpp_types, only: ccpp_t - use CCPP_typedefs, only: CCPP_interstitial_type + use CCPP_typedefs, only: GFS_interstitial_type, & + GFDL_interstitial_type use GFS_typedefs, only: GFS_control_type, & - GFS_data_type, & - GFS_interstitial_type + GFS_data_type implicit none @@ -18,7 +18,7 @@ module CCPP_data cdata_domain, & cdata_block, & ccpp_suite, & - CCPP_interstitial, & + GFDL_interstitial, & GFS_control, & GFS_data, & GFS_interstitial @@ -34,7 +34,7 @@ module CCPP_data !------------------------------------------------------! ! CCPP data containers for dynamics (fast physics) ! !------------------------------------------------------! - type(CCPP_interstitial_type), save, target :: CCPP_interstitial + type(GFDL_interstitial_type), save, target :: GFDL_interstitial !------------------------------------------------------! ! CCPP containers for the six tiles used in dynamics, ! diff --git a/ccpp/data/CCPP_data.meta b/ccpp/data/CCPP_data.meta index 3541b4724..6029873da 100644 --- a/ccpp/data/CCPP_data.meta +++ b/ccpp/data/CCPP_data.meta @@ -12,12 +12,12 @@ units = DDT dimensions = () type = ccpp_t -[CCPP_interstitial] - standard_name = CCPP_interstitial_type_instance - long_name = instance of derived type CCPP_interstitial_type +[GFDL_interstitial] + standard_name = GFDL_interstitial_type_instance + long_name = instance of derived type GFDL_interstitial_type units = DDT dimensions = () - type = CCPP_interstitial_type + type = GFDL_interstitial_type [GFS_Control] standard_name = GFS_control_type_instance long_name = instance of derived type GFS_control_type diff --git a/ccpp/data/CCPP_typedefs.F90 b/ccpp/data/CCPP_typedefs.F90 index 01695bc4a..694e27211 100644 --- a/ccpp/data/CCPP_typedefs.F90 +++ b/ccpp/data/CCPP_typedefs.F90 @@ -4,18 +4,453 @@ module CCPP_typedefs !! \htmlinclude CCPP_typedefs.html !! - use machine, only: kind_grid, kind_dyn + ! Physics kind defininitions needed for interstitial DDTs + use machine, only: kind_grid, kind_dyn, kind_phys + + ! Constants/dimensions needed for interstitial DDTs + use ozne_def, only: oz_coeff + use GFS_typedefs, only: clear_val, LTP + + ! Physics type defininitions needed for interstitial DDTs + use module_radsw_parameters, only: profsw_type, cmpfsw_type, NBDSW + use module_radlw_parameters, only: proflw_type, NBDLW + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_optical_props, only: ty_optical_props_1scl,ty_optical_props_2str + use mo_cloud_optics, only: ty_cloud_optics + use mo_gas_concentrations, only: ty_gas_concs + use mo_source_functions, only: ty_source_func_lw + use GFS_typedefs, only: GFS_control_type implicit none private - public CCPP_interstitial_type + ! To ensure that these values match what's in the physics, array + ! sizes are compared in the auto-generated physics caps in debug mode + ! from module_radiation_aerosols + integer, parameter :: NF_AESW = 3 + integer, parameter :: NF_AELW = 3 + integer, parameter :: NSPC = 5 + integer, parameter :: NSPC1 = NSPC + 1 + ! from module_radiation_clouds + integer, parameter :: NF_CLDS = 9 + ! from module_radiation_gases + integer, parameter :: NF_VGAS = 10 + ! from module_radiation_surface + integer, parameter :: NF_ALBD = 4 + + ! GFS_interstitial_type !< fields required to replace interstitial code in GFS_{physics,radiation}_driver.F90 in CCPP + public GFS_interstitial_type -!! \section arg_table_CCPP_interstitial_type Argument Table -!! \htmlinclude CCPP_interstitial_type.html + ! GFDL_interstitial_type !< fields required to replace interstitial code in FV3 dycore (fv_mapz.F90) in CCPP + public GFDL_interstitial_type + +!! \section arg_table_GFS_interstitial_type +!! \htmlinclude GFS_interstitial_type.html !! - type CCPP_interstitial_type + type GFS_interstitial_type + + real (kind=kind_phys), pointer :: adjsfculw_land(:) => null() !< + real (kind=kind_phys), pointer :: adjsfculw_ice(:) => null() !< + real (kind=kind_phys), pointer :: adjsfculw_water(:) => null() !< + real (kind=kind_phys), pointer :: adjnirbmd(:) => null() !< + real (kind=kind_phys), pointer :: adjnirbmu(:) => null() !< + real (kind=kind_phys), pointer :: adjnirdfd(:) => null() !< + real (kind=kind_phys), pointer :: adjnirdfu(:) => null() !< + real (kind=kind_phys), pointer :: adjvisbmd(:) => null() !< + real (kind=kind_phys), pointer :: adjvisbmu(:) => null() !< + real (kind=kind_phys), pointer :: adjvisdfu(:) => null() !< + real (kind=kind_phys), pointer :: adjvisdfd(:) => null() !< + real (kind=kind_phys), pointer :: aerodp(:,:) => null() !< + real (kind=kind_phys), pointer :: alb1d(:) => null() !< + real (kind=kind_phys), pointer :: alpha(:,:) => null() !< + real (kind=kind_phys), pointer :: bexp1d(:) => null() !< + real (kind=kind_phys), pointer :: cd(:) => null() !< + real (kind=kind_phys), pointer :: cd_ice(:) => null() !< + real (kind=kind_phys), pointer :: cd_land(:) => null() !< + real (kind=kind_phys), pointer :: cd_water(:) => null() !< + real (kind=kind_phys), pointer :: cdq(:) => null() !< + real (kind=kind_phys), pointer :: cdq_ice(:) => null() !< + real (kind=kind_phys), pointer :: cdq_land(:) => null() !< + real (kind=kind_phys), pointer :: cdq_water(:) => null() !< + real (kind=kind_phys), pointer :: cf_upi(:,:) => null() !< + real (kind=kind_phys), pointer :: chh_ice(:) => null() !< + real (kind=kind_phys), pointer :: chh_land(:) => null() !< + real (kind=kind_phys), pointer :: chh_water(:) => null() !< + real (kind=kind_phys), pointer :: clcn(:,:) => null() !< + real (kind=kind_phys), pointer :: cldf(:) => null() !< + real (kind=kind_phys), pointer :: cldsa(:,:) => null() !< + real (kind=kind_phys), pointer :: cldtaulw(:,:) => null() !< + real (kind=kind_phys), pointer :: cldtausw(:,:) => null() !< + real (kind=kind_phys), pointer :: cld1d(:) => null() !< + real (kind=kind_phys), pointer :: clouds(:,:,:) => null() !< + real (kind=kind_phys), pointer :: clw(:,:,:) => null() !< + real (kind=kind_phys), pointer :: clx(:,:) => null() !< + real (kind=kind_phys), pointer :: cmm_ice(:) => null() !< + real (kind=kind_phys), pointer :: cmm_land(:) => null() !< + real (kind=kind_phys), pointer :: cmm_water(:) => null() !< + real (kind=kind_phys), pointer :: cnv_dqldt(:,:) => null() !< + real (kind=kind_phys), pointer :: cnv_fice(:,:) => null() !< + real (kind=kind_phys), pointer :: cnv_mfd(:,:) => null() !< + real (kind=kind_phys), pointer :: cnv_ndrop(:,:) => null() !< + real (kind=kind_phys), pointer :: cnv_nice(:,:) => null() !< + real (kind=kind_phys), pointer :: cnvc(:,:) => null() !< + real (kind=kind_phys), pointer :: cnvw(:,:) => null() !< + real (kind=kind_phys), pointer :: ctei_r(:) => null() !< + real (kind=kind_phys), pointer :: ctei_rml(:) => null() !< + real (kind=kind_phys), pointer :: cumabs(:) => null() !< + real (kind=kind_phys), pointer :: dd_mf(:,:) => null() !< + real (kind=kind_phys), pointer :: de_lgth(:) => null() !< + real (kind=kind_phys), pointer :: del(:,:) => null() !< + real (kind=kind_phys), pointer :: del_gz(:,:) => null() !< + real (kind=kind_phys), pointer :: delr(:,:) => null() !< + real (kind=kind_phys), pointer :: dlength(:) => null() !< + real (kind=kind_phys), pointer :: dqdt(:,:,:) => null() !< + real (kind=kind_phys), pointer :: dqsfc1(:) => null() !< + real (kind=kind_phys), pointer :: drain(:) => null() !< + real (kind=kind_phys), pointer :: dtdt(:,:) => null() !< + real (kind=kind_phys), pointer :: dtsfc1(:) => null() !< + real (kind=kind_phys), pointer :: dtzm(:) => null() !< + real (kind=kind_phys), pointer :: dt_mf(:,:) => null() !< + real (kind=kind_phys), pointer :: dudt(:,:) => null() !< + real (kind=kind_phys), pointer :: dusfcg(:) => null() !< + real (kind=kind_phys), pointer :: dusfc1(:) => null() !< + real (kind=kind_phys), pointer :: dvdftra(:,:,:) => null() !< + real (kind=kind_phys), pointer :: dvdt(:,:) => null() !< + real (kind=kind_phys), pointer :: dvsfcg(:) => null() !< + real (kind=kind_phys), pointer :: dvsfc1(:) => null() !< + real (kind=kind_phys), pointer :: dzlyr(:,:) => null() !< + real (kind=kind_phys), pointer :: elvmax(:) => null() !< + real (kind=kind_phys), pointer :: ep1d(:) => null() !< + real (kind=kind_phys), pointer :: ep1d_ice(:) => null() !< + real (kind=kind_phys), pointer :: ep1d_land(:) => null() !< + real (kind=kind_phys), pointer :: ep1d_water(:) => null() !< + real (kind=kind_phys), pointer :: evap_ice(:) => null() !< + real (kind=kind_phys), pointer :: evap_land(:) => null() !< + real (kind=kind_phys), pointer :: evap_water(:) => null() !< + real (kind=kind_phys), pointer :: evbs(:) => null() !< + real (kind=kind_phys), pointer :: evcw(:) => null() !< + real (kind=kind_phys), pointer :: pah(:) => null() !< + real (kind=kind_phys), pointer :: ecan(:) => null() !< + real (kind=kind_phys), pointer :: etran(:) => null() !< + real (kind=kind_phys), pointer :: edir(:) => null() !< + real (kind=kind_phys), pointer :: faerlw(:,:,:,:) => null() !< + real (kind=kind_phys), pointer :: faersw(:,:,:,:) => null() !< + real (kind=kind_phys), pointer :: ffhh_ice(:) => null() !< + real (kind=kind_phys), pointer :: ffhh_land(:) => null() !< + real (kind=kind_phys), pointer :: ffhh_water(:) => null() !< + real (kind=kind_phys), pointer :: fh2(:) => null() !< + real (kind=kind_phys), pointer :: fh2_ice(:) => null() !< + real (kind=kind_phys), pointer :: fh2_land(:) => null() !< + real (kind=kind_phys), pointer :: fh2_water(:) => null() !< + logical, pointer :: flag_cice(:) => null() !< + logical, pointer :: flag_guess(:) => null() !< + logical, pointer :: flag_iter(:) => null() !< + real (kind=kind_phys), pointer :: ffmm_ice(:) => null() !< + real (kind=kind_phys), pointer :: ffmm_land(:) => null() !< + real (kind=kind_phys), pointer :: ffmm_water(:) => null() !< + real (kind=kind_phys), pointer :: fm10(:) => null() !< + real (kind=kind_phys), pointer :: fm10_ice(:) => null() !< + real (kind=kind_phys), pointer :: fm10_land(:) => null() !< + real (kind=kind_phys), pointer :: fm10_water(:) => null() !< + real (kind=kind_phys) :: frain !< + real (kind=kind_phys), pointer :: frland(:) => null() !< + real (kind=kind_phys), pointer :: fscav(:) => null() !< + real (kind=kind_phys), pointer :: fswtr(:) => null() !< + real (kind=kind_phys), pointer :: gabsbdlw(:) => null() !< + real (kind=kind_phys), pointer :: gabsbdlw_ice(:) => null() !< + real (kind=kind_phys), pointer :: gabsbdlw_land(:) => null() !< + real (kind=kind_phys), pointer :: gabsbdlw_water(:) => null() !< + real (kind=kind_phys), pointer :: gamma(:) => null() !< + real (kind=kind_phys), pointer :: gamq(:) => null() !< + real (kind=kind_phys), pointer :: gamt(:) => null() !< + real (kind=kind_phys), pointer :: gasvmr(:,:,:) => null() !< + real (kind=kind_phys), pointer :: gflx(:) => null() !< + real (kind=kind_phys), pointer :: gflx_ice(:) => null() !< + real (kind=kind_phys), pointer :: gflx_land(:) => null() !< + real (kind=kind_phys), pointer :: gflx_water(:) => null() !< + real (kind=kind_phys), pointer :: graupelmp(:) => null() !< + real (kind=kind_phys), pointer :: gwdcu(:,:) => null() !< + real (kind=kind_phys), pointer :: gwdcv(:,:) => null() !< + real (kind=kind_phys), pointer :: zvfun(:) => null() !< + real (kind=kind_phys), pointer :: hffac(:) => null() !< + real (kind=kind_phys), pointer :: hflxq(:) => null() !< + real (kind=kind_phys), pointer :: hflx_ice(:) => null() !< + real (kind=kind_phys), pointer :: hflx_land(:) => null() !< + real (kind=kind_phys), pointer :: hflx_water(:) => null() !< + !--- radiation variables that need to be carried over from radiation to physics + real (kind=kind_phys), pointer :: htlwc(:,:) => null() !< + real (kind=kind_phys), pointer :: htlw0(:,:) => null() !< + real (kind=kind_phys), pointer :: htswc(:,:) => null() !< + real (kind=kind_phys), pointer :: htsw0(:,:) => null() !< + ! + real (kind=kind_phys), pointer :: icemp(:) => null() !< + logical, pointer :: dry(:) => null() !< + integer, pointer :: idxday(:) => null() !< + logical, pointer :: icy(:) => null() !< + logical, pointer :: lake(:) => null() !< + logical, pointer :: use_flake(:) => null() !< + logical, pointer :: ocean(:) => null() !< + integer :: ipr !< + integer, pointer :: islmsk(:) => null() !< + integer, pointer :: islmsk_cice(:) => null() !< + integer :: itc !< + logical, pointer :: wet(:) => null() !< + integer :: kb !< + integer, pointer :: kbot(:) => null() !< + integer, pointer :: kcnv(:) => null() !< + integer :: kd !< + integer, pointer :: kinver(:) => null() !< + integer, pointer :: kpbl(:) => null() !< + integer :: kt !< + integer, pointer :: ktop(:) => null() !< + integer :: latidxprnt !< + integer :: levi !< + integer :: lmk !< + integer :: lmp !< + integer, pointer :: mbota(:,:) => null() !< + logical :: mg3_as_mg2 !< + integer, pointer :: mtopa(:,:) => null() !< + integer :: nbdlw !< + integer :: nbdsw !< + real (kind=kind_phys), pointer :: ncgl(:,:) => null() !< + real (kind=kind_phys), pointer :: ncpi(:,:) => null() !< + real (kind=kind_phys), pointer :: ncpl(:,:) => null() !< + real (kind=kind_phys), pointer :: ncpr(:,:) => null() !< + real (kind=kind_phys), pointer :: ncps(:,:) => null() !< + integer :: ncstrac !< + integer :: nday !< + integer :: nf_aelw !< + integer :: nf_aesw !< + integer :: nn !< + integer :: nsamftrac !< + integer :: nscav !< + integer :: nspc1 !< + integer :: ntcwx !< + integer :: ntiwx !< + integer :: ntrwx !< + integer :: ntk !< + integer :: ntkev !< + integer :: nvdiff !< + real (kind=kind_phys), pointer :: oa4(:,:) => null() !< + real (kind=kind_phys), pointer :: oc(:) => null() !< + real (kind=kind_phys), pointer :: olyr(:,:) => null() !< + logical , pointer :: otspt(:,:) => null() !< + logical , pointer :: otsptflag(:) => null() !< + integer :: oz_coeffp5 !< + logical :: phys_hydrostatic !< + real (kind=kind_phys), pointer :: plvl(:,:) => null() !< + real (kind=kind_phys), pointer :: plyr(:,:) => null() !< + real (kind=kind_phys), pointer :: prcpmp(:) => null() !< + real (kind=kind_phys), pointer :: prnum(:,:) => null() !< + real (kind=kind_phys), pointer :: q2mp(:) => null() !< + real (kind=kind_phys), pointer :: qgl(:,:) => null() !< + real (kind=kind_phys), pointer :: qicn(:,:) => null() !< + real (kind=kind_phys), pointer :: qlcn(:,:) => null() !< + real (kind=kind_phys), pointer :: qlyr(:,:) => null() !< + real (kind=kind_phys), pointer :: qrn(:,:) => null() !< + real (kind=kind_phys), pointer :: qsnw(:,:) => null() !< + real (kind=kind_phys), pointer :: qss_ice(:) => null() !< + real (kind=kind_phys), pointer :: qss_land(:) => null() !< + real (kind=kind_phys), pointer :: qss_water(:) => null() !< + logical :: radar_reset !< + real (kind=kind_phys) :: raddt !< + real (kind=kind_phys), pointer :: rainmp(:) => null() !< + real (kind=kind_phys), pointer :: raincd(:) => null() !< + real (kind=kind_phys), pointer :: raincs(:) => null() !< + real (kind=kind_phys), pointer :: rainmcadj(:) => null() !< + real (kind=kind_phys), pointer :: rainp(:,:) => null() !< + real (kind=kind_phys), pointer :: rb(:) => null() !< + real (kind=kind_phys), pointer :: rb_ice(:) => null() !< + real (kind=kind_phys), pointer :: rb_land(:) => null() !< + real (kind=kind_phys), pointer :: rb_water(:) => null() !< + logical :: max_hourly_reset !< + logical :: ext_diag_thompson_reset !< + real (kind=kind_phys), pointer :: rhc(:,:) => null() !< + real (kind=kind_phys), pointer :: runoff(:) => null() !< + real (kind=kind_phys), pointer :: save_q(:,:,:) => null() !< + real (kind=kind_phys), pointer :: save_t(:,:) => null() !< + real (kind=kind_phys), pointer :: save_tcp(:,:) => null() !< + real (kind=kind_phys), pointer :: save_u(:,:) => null() !< + real (kind=kind_phys), pointer :: save_v(:,:) => null() !< + real (kind=kind_phys), pointer :: sbsno(:) => null() !< + type (cmpfsw_type), pointer :: scmpsw(:) => null() !< + real (kind=kind_phys), pointer :: sfcalb(:,:) => null() !< + real (kind=kind_phys), pointer :: sigma(:) => null() !< + real (kind=kind_phys), pointer :: sigmaf(:) => null() !< + real (kind=kind_phys), pointer :: sigmafrac(:,:) => null() !< + real (kind=kind_phys), pointer :: sigmatot(:,:) => null() !< + logical :: skip_macro !< + real (kind=kind_phys), pointer :: snowc(:) => null() !< + real (kind=kind_phys), pointer :: snohf(:) => null() !< + real (kind=kind_phys), pointer :: snowmp(:) => null() !< + real (kind=kind_phys), pointer :: snowmt(:) => null() !< + real (kind=kind_phys), pointer :: stress(:) => null() !< + real (kind=kind_phys), pointer :: stress_ice(:) => null() !< + real (kind=kind_phys), pointer :: stress_land(:) => null() !< + real (kind=kind_phys), pointer :: stress_water(:) => null() !< + real (kind=kind_phys), pointer :: t2mmp(:) => null() !< + real (kind=kind_phys), pointer :: theta(:) => null() !< + real (kind=kind_phys), pointer :: tlvl(:,:) => null() !< + real (kind=kind_phys), pointer :: tlyr(:,:) => null() !< + real (kind=kind_phys), pointer :: tprcp_ice(:) => null() !< + real (kind=kind_phys), pointer :: tprcp_land(:) => null() !< + real (kind=kind_phys), pointer :: tprcp_water(:) => null() !< + integer :: tracers_start_index !< + integer :: tracers_total !< + integer :: tracers_water !< + logical :: trans_aero !< + real (kind=kind_phys), pointer :: trans(:) => null() !< + real (kind=kind_phys), pointer :: tseal(:) => null() !< + real (kind=kind_phys), pointer :: tsfa(:) => null() !< + real (kind=kind_phys), pointer :: tsfc_water(:) => null() !< + real (kind=kind_phys), pointer :: tsfg(:) => null() !< + real (kind=kind_phys), pointer :: tsurf_ice(:) => null() !< + real (kind=kind_phys), pointer :: tsurf_land(:) => null() !< + real (kind=kind_phys), pointer :: tsurf_water(:) => null() !< + real (kind=kind_phys), pointer :: ud_mf(:,:) => null() !< + real (kind=kind_phys), pointer :: uustar_ice(:) => null() !< + real (kind=kind_phys), pointer :: uustar_land(:) => null() !< + real (kind=kind_phys), pointer :: uustar_water(:) => null() !< + real (kind=kind_phys), pointer :: vdftra(:,:,:) => null() !< + real (kind=kind_phys), pointer :: vegf1d(:) => null() !< + real (kind=kind_phys) :: lndp_vgf !< + + real (kind=kind_phys), pointer :: w_upi(:,:) => null() !< + real (kind=kind_phys), pointer :: wcbmax(:) => null() !< + real (kind=kind_phys), pointer :: wind(:) => null() !< + real (kind=kind_phys), pointer :: work1(:) => null() !< + real (kind=kind_phys), pointer :: work2(:) => null() !< + real (kind=kind_phys), pointer :: work3(:) => null() !< + real (kind=kind_phys), pointer :: xcosz(:) => null() !< + real (kind=kind_phys), pointer :: xlai1d(:) => null() !< + real (kind=kind_phys), pointer :: xmu(:) => null() !< + real (kind=kind_phys), pointer :: z01d(:) => null() !< + real (kind=kind_phys), pointer :: zt1d(:) => null() !< + real (kind=kind_phys), pointer :: ztmax_ice(:) => null() !< + real (kind=kind_phys), pointer :: ztmax_land(:) => null() !< + real (kind=kind_phys), pointer :: ztmax_water(:) => null() !< +!================================================================================================== +! UGWP - five mechnanisms of momentum deposition due to various types of GWs +! (oss, ofd, obl, ogw) + ngw = sum( sso + ngw) +!================================================================================================== +! nGWs + real (kind=kind_phys), pointer :: dudt_ngw(:,:) => null() !< + real (kind=kind_phys), pointer :: dvdt_ngw(:,:) => null() !< + real (kind=kind_phys), pointer :: dtdt_ngw(:,:) => null() !< + real (kind=kind_phys), pointer :: kdis_ngw(:,:) => null() !< + + real (kind=kind_phys), pointer :: tau_oss(: ) => null() !< instantaneous momentum flux due to OSS + real (kind=kind_phys), pointer :: tau_tofd(:) => null() !< instantaneous momentum flux due to TOFD + real (kind=kind_phys), pointer :: tau_mtb(:) => null() !< instantaneous momentum of mountain blocking drag + real (kind=kind_phys), pointer :: tau_ogw(:) => null() !< instantaneous momentum flux of OGWs + real (kind=kind_phys), pointer :: tau_ngw(:) => null() !< instantaneous momentum flux of NGWs + + real (kind=kind_phys), pointer :: zngw(:) => null() !< launch levels of NGWs + real (kind=kind_phys), pointer :: zmtb(:) => null() !< mountain blocking height + real (kind=kind_phys), pointer :: zlwb(:) => null() !< low level wave breaking height + real (kind=kind_phys), pointer :: zogw(:) => null() !< height of OGW-launch + + real (kind=kind_phys), pointer :: dudt_mtb(:,:) => null() !< daily aver u-wind tend due to mountain blocking + real (kind=kind_phys), pointer :: dudt_tms(:,:) => null() !< daily aver u-wind tend due to TMS + + ! RRTMGP + real (kind=kind_phys), pointer :: p_lay(:,:) => null() !< + real (kind=kind_phys), pointer :: p_lev(:,:) => null() !< + real (kind=kind_phys), pointer :: t_lev(:,:) => null() !< + real (kind=kind_phys), pointer :: t_lay(:,:) => null() !< + real (kind=kind_phys), pointer :: relhum(:,:) => null() !< + real (kind=kind_phys), pointer :: tv_lay(:,:) => null() !< + real (kind=kind_phys), pointer :: qs_lay(:,:) => null() !< + real (kind=kind_phys), pointer :: q_lay(:,:) => null() !< + real (kind=kind_phys), pointer :: deltaZ(:,:) => null() !< + real (kind=kind_phys), pointer :: deltaZc(:,:) => null() !< + real (kind=kind_phys), pointer :: deltaP(:,:) => null() !< + real (kind=kind_phys), pointer :: cloud_overlap_param(:,:) => null() !< Cloud overlap parameter + real (kind=kind_phys), pointer :: cnv_cloud_overlap_param(:,:) => null() !< Convective cloud overlap parameter + real (kind=kind_phys), pointer :: precip_overlap_param(:,:) => null() !< Precipitation overlap parameter + real (kind=kind_phys), pointer :: tracer(:,:,:) => null() !< + real (kind=kind_phys), pointer :: aerosolslw(:,:,:,:) => null() !< Aerosol radiative properties in each LW band. + real (kind=kind_phys), pointer :: aerosolssw(:,:,:,:) => null() !< Aerosol radiative properties in each SW band. + real (kind=kind_phys), pointer :: cld_frac(:,:) => null() !< Total cloud fraction + real (kind=kind_phys), pointer :: cld_lwp(:,:) => null() !< Cloud liquid water path + real (kind=kind_phys), pointer :: cld_reliq(:,:) => null() !< Cloud liquid effective radius + real (kind=kind_phys), pointer :: cld_iwp(:,:) => null() !< Cloud ice water path + real (kind=kind_phys), pointer :: cld_reice(:,:) => null() !< Cloud ice effecive radius + real (kind=kind_phys), pointer :: cld_swp(:,:) => null() !< Cloud snow water path + real (kind=kind_phys), pointer :: cld_resnow(:,:) => null() !< Cloud snow effective radius + real (kind=kind_phys), pointer :: cld_rwp(:,:) => null() !< Cloud rain water path + real (kind=kind_phys), pointer :: cld_rerain(:,:) => null() !< Cloud rain effective radius + real (kind=kind_phys), pointer :: precip_frac(:,:) => null() !< Precipitation fraction + real (kind=kind_phys), pointer :: cld_cnv_frac(:,:) => null() !< SGS convective cloud fraction + real (kind=kind_phys), pointer :: cld_cnv_lwp(:,:) => null() !< SGS convective cloud liquid water path + real (kind=kind_phys), pointer :: cld_cnv_reliq(:,:) => null() !< SGS convective cloud liquid effective radius + real (kind=kind_phys), pointer :: cld_cnv_iwp(:,:) => null() !< SGS convective cloud ice water path + real (kind=kind_phys), pointer :: cld_cnv_reice(:,:) => null() !< SGS convective cloud ice effecive radius + real (kind=kind_phys), pointer :: cld_pbl_lwp(:,:) => null() !< SGS PBL cloud liquid water path + real (kind=kind_phys), pointer :: cld_pbl_reliq(:,:) => null() !< SGS PBL cloud liquid effective radius + real (kind=kind_phys), pointer :: cld_pbl_iwp(:,:) => null() !< SGS PBL cloud ice water path + real (kind=kind_phys), pointer :: cld_pbl_reice(:,:) => null() !< SGS PBL cloud ice effecive radius + real (kind=kind_phys), pointer :: fluxlwUP_allsky(:,:) => null() !< RRTMGP upward longwave all-sky flux profile + real (kind=kind_phys), pointer :: fluxlwDOWN_allsky(:,:) => null() !< RRTMGP downward longwave all-sky flux profile + real (kind=kind_phys), pointer :: fluxlwUP_clrsky(:,:) => null() !< RRTMGP upward longwave clr-sky flux profile + real (kind=kind_phys), pointer :: fluxlwDOWN_clrsky(:,:) => null() !< RRTMGP downward longwave clr-sky flux profile + real (kind=kind_phys), pointer :: fluxswUP_allsky(:,:) => null() !< RRTMGP upward shortwave all-sky flux profile + real (kind=kind_phys), pointer :: fluxswDOWN_allsky(:,:) => null() !< RRTMGP downward shortwave all-sky flux profile + real (kind=kind_phys), pointer :: fluxswUP_clrsky(:,:) => null() !< RRTMGP upward shortwave clr-sky flux profile + real (kind=kind_phys), pointer :: fluxswDOWN_clrsky(:,:) => null() !< RRTMGP downward shortwave clr-sky flux profile + real (kind=kind_phys), pointer :: sfc_emiss_byband(:,:) => null() !< + real (kind=kind_phys), pointer :: sec_diff_byband(:,:) => null() !< + real (kind=kind_phys), pointer :: sfc_alb_nir_dir(:,:) => null() !< + real (kind=kind_phys), pointer :: sfc_alb_nir_dif(:,:) => null() !< + real (kind=kind_phys), pointer :: sfc_alb_uvvis_dir(:,:) => null() !< + real (kind=kind_phys), pointer :: sfc_alb_uvvis_dif(:,:) => null() !< + real (kind=kind_phys), pointer :: toa_src_lw(:,:) => null() !< + real (kind=kind_phys), pointer :: toa_src_sw(:,:) => null() !< + type(proflw_type), pointer :: flxprf_lw(:,:) => null() !< DDT containing RRTMGP longwave fluxes + type(profsw_type), pointer :: flxprf_sw(:,:) => null() !< DDT containing RRTMGP shortwave fluxes + type(ty_optical_props_2str) :: lw_optical_props_cloudsByBand !< RRTMGP DDT + type(ty_optical_props_2str) :: lw_optical_props_clouds !< RRTMGP DDT + type(ty_optical_props_2str) :: lw_optical_props_precipByBand !< RRTMGP DDT + type(ty_optical_props_2str) :: lw_optical_props_precip !< RRTMGP DDT + type(ty_optical_props_2str) :: lw_optical_props_cnvcloudsByBand !< RRTMGP DDT + type(ty_optical_props_2str) :: lw_optical_props_cnvclouds !< RRTMGP DDT + type(ty_optical_props_2str) :: lw_optical_props_MYNNcloudsByBand !< RRTMGP DDT + type(ty_optical_props_1scl) :: lw_optical_props_clrsky !< RRTMGP DDT + type(ty_optical_props_1scl) :: lw_optical_props_aerosol !< RRTMGP DDT + type(ty_optical_props_2str) :: sw_optical_props_cloudsByBand !< RRTMGP DDT + type(ty_optical_props_2str) :: sw_optical_props_clouds !< RRTMGP DDT + type(ty_optical_props_2str) :: sw_optical_props_precipByBand !< RRTMGP DDT + type(ty_optical_props_2str) :: sw_optical_props_precip !< RRTMGP DDT + type(ty_optical_props_2str) :: sw_optical_props_clrsky !< RRTMGP DDT + type(ty_optical_props_2str) :: sw_optical_props_aerosol !< RRTMGP DDT + type(ty_optical_props_2str) :: sw_optical_props_cnvcloudsByBand !< RRTMGP DDT + type(ty_optical_props_2str) :: sw_optical_props_cnvclouds !< RRTMGP DDT + type(ty_optical_props_2str) :: sw_optical_props_MYNNcloudsByBand !< RRTMGP DDT + type(ty_gas_concs) :: gas_concentrations !< RRTMGP DDT + type(ty_source_func_lw) :: sources !< RRTMGP DDT + + !-- GSL drag suite + real (kind=kind_phys), pointer :: varss(:) => null() !< + real (kind=kind_phys), pointer :: ocss(:) => null() !< + real (kind=kind_phys), pointer :: oa4ss(:,:) => null() !< + real (kind=kind_phys), pointer :: clxss(:,:) => null() !< + + !-- 3D diagnostics + integer :: rtg_ozone_index, rtg_tke_index + + contains + + procedure :: create => gfs_interstitial_create !< allocate array data + procedure :: rad_reset => gfs_interstitial_rad_reset !< reset array data for radiation + procedure :: phys_reset => gfs_interstitial_phys_reset !< reset array data for physics + + end type GFS_interstitial_type + +!! \section arg_table_GFDL_interstitial_type Argument Table +!! \htmlinclude GFDL_interstitial_type.html +!! + type GFDL_interstitial_type real(kind_dyn) :: akap real(kind_dyn) :: bdt @@ -73,28 +508,1131 @@ module CCPP_typedefs contains - procedure :: create => interstitial_create !< allocate array data - procedure :: reset => interstitial_reset !< reset array data - procedure :: mprint => interstitial_print !< print array data + procedure :: create => gfdl_interstitial_create !< allocate array data + procedure :: reset => gfdl_interstitial_reset !< reset array data + procedure :: mprint => gfdl_interstitial_print !< print array data - end type CCPP_interstitial_type + end type GFDL_interstitial_type contains -!----------------------------- -! CCPP_interstitial_type -!----------------------------- - subroutine interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd, jed, npz, ng, & - dt_atmos, p_split, k_split, zvir, p_ref, ak, bk, & - do_ql, do_qi, do_qr, do_qs, do_qg, do_qa, & - kappa, hydrostatic, do_sat_adj, & - delp, delz, area, peln, phis, pkz, pt, & - qvi, qv, ql, qi, qr, qs, qg, qc, q_con, & - nthreads, nwat, ngas, rilist, cpilist, mpirank, mpiroot) +!---------------------- +! GFS_interstitial_type +!---------------------- + + subroutine gfs_interstitial_create (Interstitial, IM, Model) + ! + implicit none + ! + class(GFS_interstitial_type) :: Interstitial + integer, intent(in) :: IM + type(GFS_control_type), intent(in) :: Model + integer :: iGas + ! + allocate (Interstitial%otspt (Model%ntracp1,2)) + allocate (Interstitial%otsptflag (Model%ntrac)) + ! Set up numbers of tracers for PBL, convection, etc: sets + ! Interstitial%{nvdiff,mg3_as_mg2,nn,tracers_total,ntcwx,ntiwx,ntk,ntkev,otspt,nsamftrac,ncstrac,nscav} + call gfs_interstitial_setup_tracers(Interstitial, Model) + ! Allocate arrays + allocate (Interstitial%adjsfculw_land (IM)) + allocate (Interstitial%adjsfculw_ice (IM)) + allocate (Interstitial%adjsfculw_water (IM)) + allocate (Interstitial%adjnirbmd (IM)) + allocate (Interstitial%adjnirbmu (IM)) + allocate (Interstitial%adjnirdfd (IM)) + allocate (Interstitial%adjnirdfu (IM)) + allocate (Interstitial%adjvisbmd (IM)) + allocate (Interstitial%adjvisbmu (IM)) + allocate (Interstitial%adjvisdfu (IM)) + allocate (Interstitial%adjvisdfd (IM)) + allocate (Interstitial%aerodp (IM,NSPC1)) + allocate (Interstitial%alb1d (IM)) + if (.not. Model%do_RRTMGP) then + ! RRTMGP uses its own cloud_overlap_param + allocate (Interstitial%alpha (IM,Model%levr+LTP)) + end if + allocate (Interstitial%bexp1d (IM)) + allocate (Interstitial%cd (IM)) + allocate (Interstitial%cd_ice (IM)) + allocate (Interstitial%cd_land (IM)) + allocate (Interstitial%cd_water (IM)) + allocate (Interstitial%cdq (IM)) + allocate (Interstitial%cdq_ice (IM)) + allocate (Interstitial%cdq_land (IM)) + allocate (Interstitial%cdq_water (IM)) + allocate (Interstitial%chh_ice (IM)) + allocate (Interstitial%chh_land (IM)) + allocate (Interstitial%chh_water (IM)) + allocate (Interstitial%cldf (IM)) + allocate (Interstitial%cldsa (IM,5)) + allocate (Interstitial%cldtaulw (IM,Model%levr+LTP)) + allocate (Interstitial%cldtausw (IM,Model%levr+LTP)) + allocate (Interstitial%cld1d (IM)) + allocate (Interstitial%clouds (IM,Model%levr+LTP,NF_CLDS)) + allocate (Interstitial%clw (IM,Model%levs,Interstitial%nn)) + allocate (Interstitial%clx (IM,4)) + allocate (Interstitial%cmm_ice (IM)) + allocate (Interstitial%cmm_land (IM)) + allocate (Interstitial%cmm_water (IM)) + allocate (Interstitial%cnvc (IM,Model%levs)) + allocate (Interstitial%cnvw (IM,Model%levs)) + allocate (Interstitial%ctei_r (IM)) + allocate (Interstitial%ctei_rml (IM)) + allocate (Interstitial%cumabs (IM)) + allocate (Interstitial%dd_mf (IM,Model%levs)) + allocate (Interstitial%de_lgth (IM)) + allocate (Interstitial%del (IM,Model%levs)) + allocate (Interstitial%del_gz (IM,Model%levs+1)) + allocate (Interstitial%delr (IM,Model%levr+LTP)) + allocate (Interstitial%dlength (IM)) + allocate (Interstitial%dqdt (IM,Model%levs,Model%ntrac)) + allocate (Interstitial%dqsfc1 (IM)) + allocate (Interstitial%drain (IM)) + allocate (Interstitial%dtdt (IM,Model%levs)) + allocate (Interstitial%dtsfc1 (IM)) + allocate (Interstitial%dt_mf (IM,Model%levs)) + allocate (Interstitial%dtzm (IM)) + allocate (Interstitial%dudt (IM,Model%levs)) + allocate (Interstitial%dusfcg (IM)) + allocate (Interstitial%dusfc1 (IM)) + allocate (Interstitial%dvdt (IM,Model%levs)) + allocate (Interstitial%dvsfcg (IM)) + allocate (Interstitial%dvsfc1 (IM)) + allocate (Interstitial%dvdftra (IM,Model%levs,Interstitial%nvdiff)) + allocate (Interstitial%dzlyr (IM,Model%levr+LTP)) + allocate (Interstitial%elvmax (IM)) + allocate (Interstitial%ep1d (IM)) + allocate (Interstitial%ep1d_ice (IM)) + allocate (Interstitial%ep1d_land (IM)) + allocate (Interstitial%ep1d_water (IM)) + allocate (Interstitial%evap_ice (IM)) + allocate (Interstitial%evap_land (IM)) + allocate (Interstitial%evap_water (IM)) + allocate (Interstitial%evbs (IM)) + allocate (Interstitial%evcw (IM)) + allocate (Interstitial%pah (IM)) + allocate (Interstitial%ecan (IM)) + allocate (Interstitial%etran (IM)) + allocate (Interstitial%edir (IM)) + allocate (Interstitial%faerlw (IM,Model%levr+LTP,NBDLW,NF_AELW)) + allocate (Interstitial%faersw (IM,Model%levr+LTP,NBDSW,NF_AESW)) + allocate (Interstitial%ffhh_ice (IM)) + allocate (Interstitial%ffhh_land (IM)) + allocate (Interstitial%ffhh_water (IM)) + allocate (Interstitial%fh2 (IM)) + allocate (Interstitial%fh2_ice (IM)) + allocate (Interstitial%fh2_land (IM)) + allocate (Interstitial%fh2_water (IM)) + allocate (Interstitial%flag_cice (IM)) + allocate (Interstitial%flag_guess (IM)) + allocate (Interstitial%flag_iter (IM)) + allocate (Interstitial%ffmm_ice (IM)) + allocate (Interstitial%ffmm_land (IM)) + allocate (Interstitial%ffmm_water (IM)) + allocate (Interstitial%fm10 (IM)) + allocate (Interstitial%fm10_ice (IM)) + allocate (Interstitial%fm10_land (IM)) + allocate (Interstitial%fm10_water (IM)) + allocate (Interstitial%frland (IM)) + allocate (Interstitial%fscav (Interstitial%nscav)) + allocate (Interstitial%fswtr (Interstitial%nscav)) + allocate (Interstitial%gabsbdlw (IM)) + allocate (Interstitial%gabsbdlw_ice (IM)) + allocate (Interstitial%gabsbdlw_land (IM)) + allocate (Interstitial%gabsbdlw_water (IM)) + allocate (Interstitial%gamma (IM)) + allocate (Interstitial%gamq (IM)) + allocate (Interstitial%gamt (IM)) + allocate (Interstitial%gasvmr (IM,Model%levr+LTP,NF_VGAS)) + allocate (Interstitial%gflx (IM)) + allocate (Interstitial%gflx_ice (IM)) + allocate (Interstitial%gflx_land (IM)) + allocate (Interstitial%gflx_water (IM)) + allocate (Interstitial%gwdcu (IM,Model%levs)) + allocate (Interstitial%gwdcv (IM,Model%levs)) + allocate (Interstitial%zvfun (IM)) + allocate (Interstitial%hffac (IM)) + allocate (Interstitial%hflxq (IM)) + allocate (Interstitial%hflx_ice (IM)) + allocate (Interstitial%hflx_land (IM)) + allocate (Interstitial%hflx_water (IM)) + allocate (Interstitial%htlwc (IM,Model%levr+LTP)) + allocate (Interstitial%htlw0 (IM,Model%levr+LTP)) + allocate (Interstitial%htswc (IM,Model%levr+LTP)) + allocate (Interstitial%htsw0 (IM,Model%levr+LTP)) + allocate (Interstitial%dry (IM)) + allocate (Interstitial%idxday (IM)) + allocate (Interstitial%icy (IM)) + allocate (Interstitial%lake (IM)) + allocate (Interstitial%use_flake (IM)) + allocate (Interstitial%ocean (IM)) + allocate (Interstitial%islmsk (IM)) + allocate (Interstitial%islmsk_cice (IM)) + allocate (Interstitial%wet (IM)) + allocate (Interstitial%kbot (IM)) + allocate (Interstitial%kcnv (IM)) + allocate (Interstitial%kinver (IM)) + allocate (Interstitial%kpbl (IM)) + allocate (Interstitial%ktop (IM)) + allocate (Interstitial%mbota (IM,3)) + allocate (Interstitial%mtopa (IM,3)) + allocate (Interstitial%oa4 (IM,4)) + allocate (Interstitial%oc (IM)) + allocate (Interstitial%olyr (IM,Model%levr+LTP)) + allocate (Interstitial%plvl (IM,Model%levr+1+LTP)) + allocate (Interstitial%plyr (IM,Model%levr+LTP)) + allocate (Interstitial%prnum (IM,Model%levs)) + allocate (Interstitial%qlyr (IM,Model%levr+LTP)) + allocate (Interstitial%prcpmp (IM)) + allocate (Interstitial%qss_ice (IM)) + allocate (Interstitial%qss_land (IM)) + allocate (Interstitial%qss_water (IM)) + allocate (Interstitial%raincd (IM)) + allocate (Interstitial%raincs (IM)) + allocate (Interstitial%rainmcadj (IM)) + allocate (Interstitial%rainp (IM,Model%levs)) + allocate (Interstitial%rb (IM)) + allocate (Interstitial%rb_ice (IM)) + allocate (Interstitial%rb_land (IM)) + allocate (Interstitial%rb_water (IM)) + allocate (Interstitial%rhc (IM,Model%levs)) + allocate (Interstitial%runoff (IM)) + allocate (Interstitial%save_q (IM,Model%levs,Model%ntrac)) + allocate (Interstitial%save_t (IM,Model%levs)) + allocate (Interstitial%save_tcp (IM,Model%levs)) + allocate (Interstitial%save_u (IM,Model%levs)) + allocate (Interstitial%save_v (IM,Model%levs)) + allocate (Interstitial%sbsno (IM)) + allocate (Interstitial%scmpsw (IM)) + allocate (Interstitial%sfcalb (IM,NF_ALBD)) + allocate (Interstitial%sigma (IM)) + allocate (Interstitial%sigmaf (IM)) + allocate (Interstitial%sigmafrac (IM,Model%levs)) + allocate (Interstitial%sigmatot (IM,Model%levs)) + allocate (Interstitial%snowc (IM)) + allocate (Interstitial%snohf (IM)) + allocate (Interstitial%snowmt (IM)) + allocate (Interstitial%stress (IM)) + allocate (Interstitial%stress_ice (IM)) + allocate (Interstitial%stress_land (IM)) + allocate (Interstitial%stress_water (IM)) + allocate (Interstitial%theta (IM)) + allocate (Interstitial%tlvl (IM,Model%levr+1+LTP)) + allocate (Interstitial%tlyr (IM,Model%levr+LTP)) + allocate (Interstitial%tprcp_ice (IM)) + allocate (Interstitial%tprcp_land (IM)) + allocate (Interstitial%tprcp_water (IM)) + allocate (Interstitial%trans (IM)) + allocate (Interstitial%tseal (IM)) + allocate (Interstitial%tsfa (IM)) + allocate (Interstitial%tsfc_water (IM)) + allocate (Interstitial%tsfg (IM)) + allocate (Interstitial%tsurf_ice (IM)) + allocate (Interstitial%tsurf_land (IM)) + allocate (Interstitial%tsurf_water (IM)) + allocate (Interstitial%ud_mf (IM,Model%levs)) + allocate (Interstitial%uustar_ice (IM)) + allocate (Interstitial%uustar_land (IM)) + allocate (Interstitial%uustar_water (IM)) + allocate (Interstitial%vdftra (IM,Model%levs,Interstitial%nvdiff)) !GJF first dimension was set as 'IX' in GFS_physics_driver + allocate (Interstitial%vegf1d (IM)) + allocate (Interstitial%wcbmax (IM)) + allocate (Interstitial%wind (IM)) + allocate (Interstitial%work1 (IM)) + allocate (Interstitial%work2 (IM)) + allocate (Interstitial%work3 (IM)) + allocate (Interstitial%xcosz (IM)) + allocate (Interstitial%xlai1d (IM)) + allocate (Interstitial%xmu (IM)) + allocate (Interstitial%z01d (IM)) + allocate (Interstitial%zt1d (IM)) + allocate (Interstitial%ztmax_ice (IM)) + allocate (Interstitial%ztmax_land (IM)) + allocate (Interstitial%ztmax_water (IM)) + + ! RRTMGP + if (Model%do_RRTMGP) then + allocate (Interstitial%tracer (IM, Model%levs,Model%ntrac)) + allocate (Interstitial%tv_lay (IM, Model%levs)) + allocate (Interstitial%relhum (IM, Model%levs)) + allocate (Interstitial%qs_lay (IM, Model%levs)) + allocate (Interstitial%q_lay (IM, Model%levs)) + allocate (Interstitial%deltaZ (IM, Model%levs)) + allocate (Interstitial%deltaZc (IM, Model%levs)) + allocate (Interstitial%deltaP (IM, Model%levs)) + allocate (Interstitial%p_lev (IM, Model%levs+1)) + allocate (Interstitial%p_lay (IM, Model%levs)) + allocate (Interstitial%t_lev (IM, Model%levs+1)) + allocate (Interstitial%t_lay (IM, Model%levs)) + allocate (Interstitial%cloud_overlap_param (IM, Model%levs)) + allocate (Interstitial%precip_overlap_param (IM, Model%levs)) + allocate (Interstitial%fluxlwUP_allsky (IM, Model%levs+1)) + allocate (Interstitial%fluxlwDOWN_allsky (IM, Model%levs+1)) + allocate (Interstitial%fluxlwUP_clrsky (IM, Model%levs+1)) + allocate (Interstitial%fluxlwDOWN_clrsky (IM, Model%levs+1)) + allocate (Interstitial%fluxswUP_allsky (IM, Model%levs+1)) + allocate (Interstitial%fluxswDOWN_allsky (IM, Model%levs+1)) + allocate (Interstitial%fluxswUP_clrsky (IM, Model%levs+1)) + allocate (Interstitial%fluxswDOWN_clrsky (IM, Model%levs+1)) + allocate (Interstitial%aerosolslw (IM, Model%levs, Model%rrtmgp_nBandsLW, NF_AELW)) + allocate (Interstitial%aerosolssw (IM, Model%levs, Model%rrtmgp_nBandsSW, NF_AESW)) + allocate (Interstitial%cld_frac (IM, Model%levs)) + allocate (Interstitial%cld_lwp (IM, Model%levs)) + allocate (Interstitial%cld_reliq (IM, Model%levs)) + allocate (Interstitial%cld_iwp (IM, Model%levs)) + allocate (Interstitial%cld_reice (IM, Model%levs)) + allocate (Interstitial%cld_swp (IM, Model%levs)) + allocate (Interstitial%cld_resnow (IM, Model%levs)) + allocate (Interstitial%cld_rwp (IM, Model%levs)) + allocate (Interstitial%cld_rerain (IM, Model%levs)) + allocate (Interstitial%precip_frac (IM, Model%levs)) + allocate (Interstitial%cld_cnv_frac (IM, Model%levs)) + allocate (Interstitial%cnv_cloud_overlap_param(IM, Model%levs)) + allocate (Interstitial%cld_cnv_lwp (IM, Model%levs)) + allocate (Interstitial%cld_cnv_reliq (IM, Model%levs)) + allocate (Interstitial%cld_cnv_iwp (IM, Model%levs)) + allocate (Interstitial%cld_cnv_reice (IM, Model%levs)) + allocate (Interstitial%cld_pbl_lwp (IM, Model%levs)) + allocate (Interstitial%cld_pbl_reliq (IM, Model%levs)) + allocate (Interstitial%cld_pbl_iwp (IM, Model%levs)) + allocate (Interstitial%cld_pbl_reice (IM, Model%levs)) + allocate (Interstitial%flxprf_lw (IM, Model%levs+1)) + allocate (Interstitial%flxprf_sw (IM, Model%levs+1)) + allocate (Interstitial%sfc_emiss_byband (Model%rrtmgp_nBandsLW,IM)) + allocate (Interstitial%sec_diff_byband (Model%rrtmgp_nBandsLW,IM)) + allocate (Interstitial%sfc_alb_nir_dir (Model%rrtmgp_nBandsSW,IM)) + allocate (Interstitial%sfc_alb_nir_dif (Model%rrtmgp_nBandsSW,IM)) + allocate (Interstitial%sfc_alb_uvvis_dir (Model%rrtmgp_nBandsSW,IM)) + allocate (Interstitial%sfc_alb_uvvis_dif (Model%rrtmgp_nBandsSW,IM)) + allocate (Interstitial%toa_src_sw (IM,Model%rrtmgp_nGptsSW)) + allocate (Interstitial%toa_src_lw (IM,Model%rrtmgp_nGptsLW)) + ! + ! gas_concentrations (ty_gas_concs) + ! + Interstitial%gas_concentrations%ncol = IM + Interstitial%gas_concentrations%nlay = Model%levs + allocate(Interstitial%gas_concentrations%gas_name(Model%nGases)) + allocate(Interstitial%gas_concentrations%concs(Model%nGases)) + do iGas=1,Model%nGases + allocate(Interstitial%gas_concentrations%concs(iGas)%conc(IM, Model%levs)) + enddo + ! + ! lw_optical_props_clrsky (ty_optical_props_1scl) + ! + allocate(Interstitial%lw_optical_props_clrsky%tau( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_clrsky%band2gpt (2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_clrsky%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_clrsky%gpt2band( Model%rrtmgp_nGptsLW )) + ! + ! lw_optical_props_aerosol (ty_optical_props_1scl) + ! + allocate(Interstitial%lw_optical_props_aerosol%tau( IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_aerosol%band2gpt (2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_aerosol%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_aerosol%gpt2band( Model%rrtmgp_nBandsLW )) + ! + ! lw_optical_props_cloudsByBand (ty_optical_props_2str) + ! + allocate(Interstitial%lw_optical_props_cloudsByBand%tau(IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cloudsByBand%ssa(IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cloudsByBand%g( IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cloudsByBand%band2gpt (2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cloudsByBand%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cloudsByBand%gpt2band( Model%rrtmgp_nBandsLW )) + ! + ! lw_optical_props_cnvcloudsByBand (ty_optical_props_2str) + ! + allocate(Interstitial%lw_optical_props_cnvcloudsByBand%tau(IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cnvcloudsByBand%ssa(IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cnvcloudsByBand%g( IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cnvcloudsByBand%band2gpt (2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cnvcloudsByBand%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cnvcloudsByBand%gpt2band( Model%rrtmgp_nBandsLW )) + ! + ! lw_optical_props_MYNNcloudsByBand (ty_optical_props_2str) + ! + allocate(Interstitial%lw_optical_props_MYNNcloudsByBand%tau(IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_MYNNcloudsByBand%ssa(IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_MYNNcloudsByBand%g( IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_MYNNcloudsByBand%band2gpt (2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_MYNNcloudsByBand%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_MYNNcloudsByBand%gpt2band( Model%rrtmgp_nBandsLW )) + ! + ! lw_optical_props_precipByBand (ty_optical_props_2str) + ! + allocate(Interstitial%lw_optical_props_precipByBand%tau(IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_precipByBand%ssa(IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_precipByBand%g( IM, Model%levs, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_precipByBand%band2gpt (2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_precipByBand%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_precipByBand%gpt2band( Model%rrtmgp_nBandsLW )) + ! + ! lw_optical_props_clouds (ty_optical_props_2str) + ! + allocate(Interstitial%lw_optical_props_clouds%tau( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_clouds%ssa( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_clouds%g( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_clouds%band2gpt (2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_clouds%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_clouds%gpt2band( Model%rrtmgp_nGptsLW )) + ! + ! lw_optical_props_cnvclouds (ty_optical_props_2str) + ! + allocate(Interstitial%lw_optical_props_cnvclouds%tau( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_cnvclouds%ssa( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_cnvclouds%g( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_cnvclouds%band2gpt (2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cnvclouds%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_cnvclouds%gpt2band( Model%rrtmgp_nGptsLW )) + ! + ! lw_optical_props_precip (ty_optical_props_2str) + ! + allocate(Interstitial%lw_optical_props_precip%tau( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_precip%ssa( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_precip%g( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%lw_optical_props_precip%band2gpt (2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_precip%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%lw_optical_props_precip%gpt2band( Model%rrtmgp_nGptsLW )) + ! + ! sources (ty_source_func_lw) + ! + allocate(Interstitial%sources%sfc_source( IM, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%sources%lay_source( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%sources%lev_source_inc( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%sources%lev_source_dec( IM, Model%levs, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%sources%sfc_source_Jac( IM, Model%rrtmgp_nGptsLW )) + allocate(Interstitial%sources%band2gpt ( 2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%sources%band_lims_wvn ( 2, Model%rrtmgp_nBandsLW )) + allocate(Interstitial%sources%gpt2band( Model%rrtmgp_nGptsLW )) + end if + +! UGWP common + allocate (Interstitial%tau_mtb (IM)) + allocate (Interstitial%tau_ogw (IM)) + allocate (Interstitial%tau_tofd (IM)) + allocate (Interstitial%tau_ngw (IM)) + allocate (Interstitial%tau_oss (IM)) + allocate (Interstitial%dudt_mtb (IM,Model%levs)) + allocate (Interstitial%dudt_tms (IM,Model%levs)) + allocate (Interstitial%zmtb (IM) ) + allocate (Interstitial%zlwb (IM) ) + allocate (Interstitial%zogw (IM) ) + allocate (Interstitial%zngw (IM) ) + +! CIRES UGWP v1 + if (Model%do_ugwp_v1) then + allocate (Interstitial%dudt_ngw (IM,Model%levs)) + allocate (Interstitial%dvdt_ngw (IM,Model%levs)) + allocate (Interstitial%dtdt_ngw (IM,Model%levs)) + allocate (Interstitial%kdis_ngw (IM,Model%levs)) + end if + +!-- GSL drag suite + if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & + Model%gwd_opt==2 .or. Model%gwd_opt==22 ) then + allocate (Interstitial%varss (IM)) + allocate (Interstitial%ocss (IM)) + allocate (Interstitial%oa4ss (IM,4)) + allocate (Interstitial%clxss (IM,4)) + end if +! + ! Allocate arrays that are conditional on physics choices + if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson & + .or. Model%imp_physics == Model%imp_physics_nssl & + ) then + allocate (Interstitial%graupelmp (IM)) + allocate (Interstitial%icemp (IM)) + allocate (Interstitial%rainmp (IM)) + allocate (Interstitial%snowmp (IM)) + else if (Model%imp_physics == Model%imp_physics_mg) then + allocate (Interstitial%ncgl (IM,Model%levs)) + allocate (Interstitial%ncpr (IM,Model%levs)) + allocate (Interstitial%ncps (IM,Model%levs)) + allocate (Interstitial%qgl (IM,Model%levs)) + allocate (Interstitial%qrn (IM,Model%levs)) + allocate (Interstitial%qsnw (IM,Model%levs)) + allocate (Interstitial%qlcn (IM,Model%levs)) + allocate (Interstitial%qicn (IM,Model%levs)) + allocate (Interstitial%w_upi (IM,Model%levs)) + allocate (Interstitial%cf_upi (IM,Model%levs)) + allocate (Interstitial%cnv_mfd (IM,Model%levs)) + allocate (Interstitial%cnv_dqldt (IM,Model%levs)) + allocate (Interstitial%clcn (IM,Model%levs)) + allocate (Interstitial%cnv_fice (IM,Model%levs)) + allocate (Interstitial%cnv_ndrop (IM,Model%levs)) + allocate (Interstitial%cnv_nice (IM,Model%levs)) + end if + if (Model%do_shoc) then + if (.not. associated(Interstitial%qrn)) allocate (Interstitial%qrn (IM,Model%levs)) + if (.not. associated(Interstitial%qsnw)) allocate (Interstitial%qsnw (IM,Model%levs)) + ! DH* updated version of shoc from May 22 2019 (not yet in CCPP) doesn't use qgl? remove? + if (.not. associated(Interstitial%qgl)) allocate (Interstitial%qgl (IM,Model%levs)) + ! *DH + allocate (Interstitial%ncpi (IM,Model%levs)) + allocate (Interstitial%ncpl (IM,Model%levs)) + end if + if (Model%lsm == Model%lsm_noahmp) then + allocate (Interstitial%t2mmp (IM)) + allocate (Interstitial%q2mp (IM)) + end if + ! + ! Set components that do not change + Interstitial%frain = Model%dtf/Model%dtp + Interstitial%ipr = min(IM,10) + Interstitial%latidxprnt = 1 + Interstitial%levi = Model%levs+1 + Interstitial%lmk = Model%levr+LTP + Interstitial%lmp = Model%levr+1+LTP + Interstitial%nbdlw = NBDLW + Interstitial%nbdsw = NBDSW + Interstitial%nf_aelw = NF_AELW + Interstitial%nf_aesw = NF_AESW + Interstitial%nspc1 = NSPC1 + if (Model%oz_phys .or. Model%oz_phys_2015) then + Interstitial%oz_coeffp5 = oz_coeff+5 + else + Interstitial%oz_coeffp5 = 5 + endif + ! + Interstitial%skip_macro = .false. + ! The value phys_hydrostatic from dynamics does not match the + ! hardcoded value for calling GFDL MP in GFS_physics_driver.F90, + ! which is set to .true. + Interstitial%phys_hydrostatic = .true. + ! + ! Reset all other variables + call Interstitial%rad_reset (Model) + call Interstitial%phys_reset (Model) + ! + end subroutine gfs_interstitial_create + + subroutine gfs_interstitial_setup_tracers(Interstitial, Model) + ! + implicit none + ! + class(GFS_interstitial_type) :: Interstitial + type(GFS_control_type), intent(in) :: Model + integer :: n, tracers + logical :: ltest + + !first, initialize the values (in case the values don't get initialized within if statements below) + Interstitial%nvdiff = Model%ntrac + Interstitial%mg3_as_mg2 = .false. + Interstitial%nn = Model%ntrac + 1 + Interstitial%itc = 0 + Interstitial%ntk = 0 + Interstitial%ntkev = 0 + Interstitial%tracers_total = 0 + Interstitial%otspt(:,:) = .true. + Interstitial%otsptflag(:) = .true. + Interstitial%nsamftrac = 0 + Interstitial%ncstrac = 0 + Interstitial%ntcwx = 0 + Interstitial%ntiwx = 0 + Interstitial%ntrwx = 0 + + ! perform aerosol convective transport and PBL diffusion + Interstitial%trans_aero = Model%cplchm .and. Model%trans_trac + + if (Model%imp_physics == Model%imp_physics_thompson) then + if (Model%ltaerosol) then + Interstitial%nvdiff = 12 + else + Interstitial%nvdiff = 9 + endif + if (Model%satmedmf) Interstitial%nvdiff = Interstitial%nvdiff + 1 + elseif ( Model%imp_physics == Model%imp_physics_nssl ) then + if (Model%me == Model%master) write(0,*) 'nssl_settings1: nvdiff,ntrac = ', Interstitial%nvdiff, Model%ntrac + + IF ( Model%nssl_hail_on ) THEN + Interstitial%nvdiff = 16 ! Model%ntrac ! 17 + ELSE + Interstitial%nvdiff = 13 ! turn off hail q,N, and volume + ENDIF + ! write(*,*) 'NSSL: nvdiff, ntrac = ',Interstitial%nvdiff, Model%ntrac + if (Model%satmedmf) Interstitial%nvdiff = Interstitial%nvdiff + 1 + IF ( Model%nssl_ccn_on ) THEN + Interstitial%nvdiff = Interstitial%nvdiff + 1 + ENDIF + if (Model%me == Model%master) write(0,*) 'nssl_settings2: nvdiff,ntrac = ', Interstitial%nvdiff, Model%ntrac + + elseif (Model%imp_physics == Model%imp_physics_wsm6) then + Interstitial%nvdiff = Model%ntrac -3 + if (Model%satmedmf) Interstitial%nvdiff = Interstitial%nvdiff + 1 + elseif (Model%ntclamt > 0) then ! for GFDL MP don't diffuse cloud amount + Interstitial%nvdiff = Model%ntrac - 1 + endif + + if (Model%imp_physics == Model%imp_physics_mg) then + if (abs(Model%fprcp) == 1) then + Interstitial%mg3_as_mg2 = .false. + elseif (Model%fprcp >= 2) then + if(Model%ntgl > 0 .and. (Model%mg_do_graupel .or. Model%mg_do_hail)) then + Interstitial%mg3_as_mg2 = .false. + else ! MG3 code run without graupel/hail i.e. as MG2 + Interstitial%mg3_as_mg2 = .true. + endif + endif + endif + + Interstitial%nscav = Model%ntrac - Model%ncnd + 2 + + if (Interstitial%nvdiff == Model%ntrac) then + Interstitial%ntcwx = Model%ntcw + Interstitial%ntiwx = Model%ntiw + Interstitial%ntrwx = Model%ntrw + else + if (Model%imp_physics == Model%imp_physics_wsm6) then + Interstitial%ntcwx = 2 + Interstitial%ntiwx = 3 + elseif (Model%imp_physics == Model%imp_physics_thompson) then + Interstitial%ntcwx = 2 + Interstitial%ntiwx = 3 + Interstitial%ntrwx = 4 + elseif (Model%imp_physics == Model%imp_physics_nssl) then + Interstitial%ntcwx = 2 + Interstitial%ntiwx = 3 + Interstitial%ntrwx = 4 + elseif (Model%imp_physics == Model%imp_physics_gfdl) then + Interstitial%ntcwx = 2 + Interstitial%ntiwx = 3 + Interstitial%ntrwx = 4 + ! F-A MP scheme + elseif (Model%imp_physics == Model%imp_physics_fer_hires) then + Interstitial%ntcwx = 2 + Interstitial%ntiwx = 3 + Interstitial%ntrwx = 4 + elseif (Model%imp_physics == Model%imp_physics_mg) then + Interstitial%ntcwx = 2 + Interstitial%ntiwx = 3 + Interstitial%ntrwx = 4 + elseif (Model%imp_physics == Model%imp_physics_zhao_carr) then + Interstitial%ntcwx = 2 + endif + endif + + if (Model%cplchm) then + ! 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 + if (Model%ntgl > 0) then + Interstitial%nvdiff = 12 + else + Interstitial%nvdiff = 10 + 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,*) "Selected microphysics scheme is not supported when coupling with chemistry" + stop + endif + if (Interstitial%trans_aero) Interstitial%nvdiff = Interstitial%nvdiff + Model%ntchm + if (Model%ntke > 0) Interstitial%nvdiff = Interstitial%nvdiff + 1 ! adding tke to the list + endif + + if (Model%ntke > 0) Interstitial%ntkev = Interstitial%nvdiff + + if (Model%ntiw > 0) then + if (Model%ntclamt > 0 .and. Model%ntsigma <= 0) then + Interstitial%nn = Model%ntrac - 2 + elseif (Model%ntclamt <= 0 .and. Model%ntsigma > 0) then + Interstitial%nn = Model%ntrac - 2 + elseif (Model%ntclamt > 0 .and. Model%ntsigma > 0) then + Interstitial%nn = Model%ntrac - 3 + else + Interstitial%nn = Model%ntrac - 1 + endif + elseif (Model%ntcw > 0) then + Interstitial%nn = Model%ntrac + else + Interstitial%nn = Model%ntrac + 1 + endif + + if (Model%cscnv .or. Model%satmedmf .or. Model%trans_trac ) then + Interstitial%otspt(:,:) = .true. ! otspt is used only for cscnv + Interstitial%otspt(1:3,:) = .false. ! this is for sp.hum, ice and liquid water + Interstitial%otsptflag(:) = .true. + tracers = 2 + do n=2,Model%ntrac + ltest = ( n /= Model%ntcw .and. n /= Model%ntiw .and. n /= Model%ntclamt .and. & + n /= Model%ntrw .and. n /= Model%ntsw .and. n /= Model%ntrnc .and. & + n /= Model%ntsnc .and. n /= Model%ntgl .and. n /= Model%ntgnc .and. & + n /= Model%nthl .and. n /= Model%nthnc .and. n /= Model%ntgv .and. & + n /= Model%nthv .and. n /= Model%ntccn .and. n /= Model%ntccna .and. & + n /= Model%ntsigma) + Interstitial%otsptflag(n) = ltest + if ( ltest ) then + tracers = tracers + 1 + if (Model%ntke == n ) then + Interstitial%otspt(tracers+1,1) = .false. + Interstitial%ntk = tracers + endif + if (Model%ntlnc == n .or. Model%ntinc == n .or. Model%ntrnc == n .or. Model%ntsnc == n .or. Model%ntgnc == n) & +! if (ntlnc == n .or. ntinc == n .or. ntrnc == n .or. ntsnc == n .or.& +! ntrw == n .or. ntsw == n .or. ntgl == n) & + Interstitial%otspt(tracers+1,1) = .false. + if (Interstitial%trans_aero .and. Model%ntchs == n) Interstitial%itc = tracers + endif + enddo + Interstitial%tracers_total = tracers - 2 + endif ! end if_ras or cfscnv or samf + if (.not. Model%satmedmf .and. .not. Model%trans_trac .and. & + .not. Model%ras .and. .not. Model%do_shoc) then + Interstitial%nsamftrac = 0 + else + Interstitial%nsamftrac = Interstitial%tracers_total + endif + Interstitial%ncstrac = Interstitial%tracers_total + 3 + + end subroutine gfs_interstitial_setup_tracers + + subroutine gfs_interstitial_rad_reset (Interstitial, Model) + ! + implicit none + ! + class(GFS_interstitial_type) :: Interstitial + type(GFS_control_type), intent(in) :: Model + integer :: iGas + ! + Interstitial%aerodp = clear_val + Interstitial%alb1d = clear_val + if (.not. Model%do_RRTMGP) then + Interstitial%alpha = clear_val + end if + Interstitial%cldsa = clear_val + Interstitial%cldtaulw = clear_val + Interstitial%cldtausw = clear_val + Interstitial%clouds = clear_val + Interstitial%de_lgth = clear_val + Interstitial%delr = clear_val + Interstitial%dzlyr = clear_val + Interstitial%faerlw = clear_val + Interstitial%faersw = clear_val + Interstitial%gasvmr = clear_val + Interstitial%htlwc = clear_val + Interstitial%htlw0 = clear_val + Interstitial%htswc = clear_val + Interstitial%htsw0 = clear_val + Interstitial%idxday = 0 + Interstitial%kb = 0 + Interstitial%kd = 0 + Interstitial%kt = 0 + Interstitial%mbota = 0 + Interstitial%mtopa = 0 + Interstitial%nday = 0 + Interstitial%olyr = clear_val + Interstitial%plvl = clear_val + Interstitial%plyr = clear_val + Interstitial%qlyr = clear_val + Interstitial%raddt = clear_val + Interstitial%sfcalb = clear_val + Interstitial%tlvl = clear_val + Interstitial%tlyr = clear_val + Interstitial%tsfa = clear_val + Interstitial%tsfg = clear_val + + ! Interstitials used by both RRTMG and RRTMGP + Interstitial%scmpsw%uvbfc = clear_val + Interstitial%scmpsw%uvbf0 = clear_val + Interstitial%scmpsw%nirbm = clear_val + Interstitial%scmpsw%nirdf = clear_val + Interstitial%scmpsw%visbm = clear_val + Interstitial%scmpsw%visdf = clear_val + if (Model%do_RRTMGP) then + Interstitial%tracer = clear_val + Interstitial%tv_lay = clear_val + Interstitial%relhum = clear_val + Interstitial%qs_lay = clear_val + Interstitial%q_lay = clear_val + Interstitial%deltaZ = clear_val + Interstitial%deltaZc = clear_val + Interstitial%deltaP = clear_val + Interstitial%p_lev = clear_val + Interstitial%p_lay = clear_val + Interstitial%t_lev = clear_val + Interstitial%t_lay = clear_val + Interstitial%cloud_overlap_param = clear_val + Interstitial%precip_overlap_param = clear_val + Interstitial%fluxlwUP_allsky = clear_val + Interstitial%fluxlwDOWN_allsky = clear_val + Interstitial%fluxlwUP_clrsky = clear_val + Interstitial%fluxlwDOWN_clrsky = clear_val + Interstitial%fluxswUP_allsky = clear_val + Interstitial%fluxswDOWN_allsky = clear_val + Interstitial%fluxswUP_clrsky = clear_val + Interstitial%fluxswDOWN_clrsky = clear_val + Interstitial%aerosolslw = clear_val + Interstitial%aerosolssw = clear_val + Interstitial%cld_frac = clear_val + Interstitial%cld_lwp = clear_val + Interstitial%cld_reliq = clear_val + Interstitial%cld_iwp = clear_val + Interstitial%cld_reice = clear_val + Interstitial%cld_swp = clear_val + Interstitial%cld_resnow = clear_val + Interstitial%cld_rwp = clear_val + Interstitial%cld_rerain = clear_val + Interstitial%precip_frac = clear_val + Interstitial%cld_cnv_frac = clear_val + Interstitial%cnv_cloud_overlap_param = clear_val + Interstitial%cld_cnv_lwp = clear_val + Interstitial%cld_cnv_reliq = clear_val + Interstitial%cld_cnv_iwp = clear_val + Interstitial%cld_cnv_reice = clear_val + Interstitial%cld_pbl_lwp = clear_val + Interstitial%cld_pbl_reliq = clear_val + Interstitial%cld_pbl_iwp = clear_val + Interstitial%cld_pbl_reice = clear_val + Interstitial%sfc_emiss_byband = clear_val + Interstitial%sec_diff_byband = clear_val + Interstitial%sfc_alb_nir_dir = clear_val + Interstitial%sfc_alb_nir_dif = clear_val + Interstitial%sfc_alb_uvvis_dir = clear_val + Interstitial%sfc_alb_uvvis_dif = clear_val + Interstitial%toa_src_sw = clear_val + Interstitial%toa_src_lw = clear_val + do iGas=1,Model%nGases + Interstitial%gas_concentrations%concs(iGas)%conc = clear_val + end do + Interstitial%lw_optical_props_clrsky%tau = clear_val + Interstitial%lw_optical_props_aerosol%tau = clear_val + Interstitial%lw_optical_props_clouds%tau = clear_val + Interstitial%lw_optical_props_clouds%ssa = clear_val + Interstitial%lw_optical_props_clouds%g = clear_val + Interstitial%lw_optical_props_precip%tau = clear_val + Interstitial%lw_optical_props_precip%ssa = clear_val + Interstitial%lw_optical_props_precip%g = clear_val + Interstitial%lw_optical_props_cloudsByBand%tau = clear_val + Interstitial%lw_optical_props_cloudsByBand%ssa = clear_val + Interstitial%lw_optical_props_cloudsByBand%g = clear_val + Interstitial%lw_optical_props_precipByBand%tau = clear_val + Interstitial%lw_optical_props_precipByBand%ssa = clear_val + Interstitial%lw_optical_props_precipByBand%g = clear_val + Interstitial%lw_optical_props_cnvcloudsByBand%tau = clear_val + Interstitial%lw_optical_props_cnvcloudsByBand%ssa = clear_val + Interstitial%lw_optical_props_cnvcloudsByBand%g = clear_val + Interstitial%lw_optical_props_MYNNcloudsByBand%tau = clear_val + Interstitial%lw_optical_props_MYNNcloudsByBand%ssa = clear_val + Interstitial%lw_optical_props_MYNNcloudsByBand%g = clear_val + Interstitial%lw_optical_props_cnvclouds%tau = clear_val + Interstitial%lw_optical_props_cnvclouds%ssa = clear_val + Interstitial%lw_optical_props_cnvclouds%g = clear_val + Interstitial%sources%sfc_source = clear_val + Interstitial%sources%lay_source = clear_val + Interstitial%sources%lev_source_inc = clear_val + Interstitial%sources%lev_source_dec = clear_val + Interstitial%sources%sfc_source_Jac = clear_val + Interstitial%flxprf_lw%upfxc = clear_val + Interstitial%flxprf_lw%dnfxc = clear_val + Interstitial%flxprf_lw%upfx0 = clear_val + Interstitial%flxprf_lw%dnfx0 = clear_val + Interstitial%flxprf_sw%upfxc = clear_val + Interstitial%flxprf_sw%dnfxc = clear_val + Interstitial%flxprf_sw%upfx0 = clear_val + Interstitial%flxprf_sw%dnfx0 = clear_val + end if + ! + end subroutine gfs_interstitial_rad_reset + + subroutine gfs_interstitial_phys_reset (Interstitial, Model) + ! + implicit none + ! + class(GFS_interstitial_type) :: Interstitial + type(GFS_control_type), intent(in) :: Model + ! + Interstitial%adjsfculw_land = clear_val + Interstitial%adjsfculw_ice = clear_val + Interstitial%adjsfculw_water = clear_val + Interstitial%adjnirbmd = clear_val + Interstitial%adjnirbmu = clear_val + Interstitial%adjnirdfd = clear_val + Interstitial%adjnirdfu = clear_val + Interstitial%adjvisbmd = clear_val + Interstitial%adjvisbmu = clear_val + Interstitial%adjvisdfu = clear_val + Interstitial%adjvisdfd = clear_val + Interstitial%bexp1d = clear_val + Interstitial%cd = clear_val + Interstitial%cd_ice = Model%huge + Interstitial%cd_land = Model%huge + Interstitial%cd_water = Model%huge + Interstitial%cdq = clear_val + Interstitial%cdq_ice = Model%huge + Interstitial%cdq_land = Model%huge + Interstitial%cdq_water = Model%huge + Interstitial%chh_ice = Model%huge + Interstitial%chh_land = Model%huge + Interstitial%chh_water = Model%huge + Interstitial%cld1d = clear_val + Interstitial%cldf = clear_val + Interstitial%clw = clear_val + Interstitial%clw(:,:,2) = -999.9 + Interstitial%clx = clear_val + Interstitial%cmm_ice = Model%huge + Interstitial%cmm_land = Model%huge + Interstitial%cmm_water = Model%huge + Interstitial%cnvc = clear_val + Interstitial%cnvw = clear_val + Interstitial%ctei_r = clear_val + Interstitial%ctei_rml = clear_val + Interstitial%cumabs = clear_val + Interstitial%dd_mf = clear_val + Interstitial%del = clear_val + Interstitial%del_gz = clear_val + Interstitial%dlength = clear_val + Interstitial%dqdt = clear_val + Interstitial%dqsfc1 = clear_val + Interstitial%drain = clear_val + Interstitial%dt_mf = clear_val + Interstitial%dtdt = clear_val + Interstitial%dtsfc1 = clear_val + Interstitial%dtzm = clear_val + Interstitial%dudt = clear_val + Interstitial%dusfcg = clear_val + Interstitial%dusfc1 = clear_val + Interstitial%dvdftra = clear_val + Interstitial%dvdt = clear_val + Interstitial%dvsfcg = clear_val + Interstitial%dvsfc1 = clear_val + Interstitial%elvmax = clear_val + Interstitial%ep1d = clear_val + Interstitial%ep1d_ice = Model%huge + Interstitial%ep1d_land = Model%huge + Interstitial%ep1d_water = Model%huge + Interstitial%evap_ice = Model%huge + Interstitial%evap_land = Model%huge + Interstitial%evap_water = Model%huge + Interstitial%evbs = clear_val + Interstitial%evcw = clear_val + Interstitial%pah = clear_val + Interstitial%ecan = clear_val + Interstitial%etran = clear_val + Interstitial%edir = clear_val + Interstitial%ffhh_ice = Model%huge + Interstitial%ffhh_land = Model%huge + Interstitial%ffhh_water = Model%huge + Interstitial%fh2 = clear_val + Interstitial%fh2_ice = Model%huge + Interstitial%fh2_land = Model%huge + Interstitial%fh2_water = Model%huge + Interstitial%flag_cice = .false. + Interstitial%flag_guess = .false. + Interstitial%flag_iter = .true. + Interstitial%ffmm_ice = Model%huge + Interstitial%ffmm_land = Model%huge + Interstitial%ffmm_water = Model%huge + Interstitial%fm10 = clear_val + Interstitial%fm10_ice = Model%huge + Interstitial%fm10_land = Model%huge + Interstitial%fm10_water = Model%huge + Interstitial%frland = clear_val + Interstitial%fscav = clear_val + Interstitial%fswtr = clear_val + Interstitial%gabsbdlw = clear_val + Interstitial%gabsbdlw_ice = clear_val + Interstitial%gabsbdlw_land = clear_val + Interstitial%gabsbdlw_water = clear_val + Interstitial%gamma = clear_val + Interstitial%gamq = clear_val + Interstitial%gamt = clear_val + Interstitial%gflx = clear_val + Interstitial%gflx_ice = clear_val + Interstitial%gflx_land = clear_val + Interstitial%gflx_water = clear_val + Interstitial%gwdcu = clear_val + Interstitial%gwdcv = clear_val + Interstitial%zvfun = clear_val + Interstitial%hffac = clear_val + Interstitial%hflxq = clear_val + Interstitial%hflx_ice = Model%huge + Interstitial%hflx_land = Model%huge + Interstitial%hflx_water = Model%huge + Interstitial%dry = .false. + Interstitial%icy = .false. + Interstitial%lake = .false. + Interstitial%use_flake = .false. + Interstitial%ocean = .false. + Interstitial%islmsk = 0 + Interstitial%islmsk_cice = 0 + Interstitial%wet = .false. + Interstitial%kbot = Model%levs + Interstitial%kcnv = 0 + Interstitial%kinver = Model%levs + Interstitial%kpbl = 0 + Interstitial%ktop = 1 + Interstitial%oa4 = clear_val + Interstitial%oc = clear_val + Interstitial%prcpmp = clear_val + Interstitial%prnum = clear_val + Interstitial%qss_ice = Model%huge + Interstitial%qss_land = Model%huge + Interstitial%qss_water = Model%huge + Interstitial%raincd = clear_val + Interstitial%raincs = clear_val + Interstitial%rainmcadj = clear_val + Interstitial%rainp = clear_val + Interstitial%rb = clear_val + Interstitial%rb_ice = Model%huge + Interstitial%rb_land = Model%huge + Interstitial%rb_water = Model%huge + Interstitial%rhc = clear_val + Interstitial%runoff = clear_val + Interstitial%save_q = clear_val + Interstitial%save_t = clear_val + Interstitial%save_tcp = clear_val + Interstitial%save_u = clear_val + Interstitial%save_v = clear_val + Interstitial%sbsno = clear_val + Interstitial%sigma = clear_val + Interstitial%sigmaf = clear_val + Interstitial%sigmafrac = clear_val + Interstitial%sigmatot = clear_val + Interstitial%snowc = clear_val + Interstitial%snohf = clear_val + Interstitial%snowmt = clear_val + Interstitial%stress = clear_val + Interstitial%stress_ice = Model%huge + Interstitial%stress_land = Model%huge + Interstitial%stress_water = Model%huge + Interstitial%theta = clear_val + Interstitial%tprcp_ice = Model%huge + Interstitial%tprcp_land = Model%huge + Interstitial%tprcp_water = Model%huge + Interstitial%trans = clear_val + Interstitial%tseal = clear_val + Interstitial%tsfc_water = Model%huge + Interstitial%tsurf_ice = Model%huge + Interstitial%tsurf_land = Model%huge + Interstitial%tsurf_water = Model%huge + Interstitial%ud_mf = clear_val + Interstitial%uustar_ice = Model%huge + Interstitial%uustar_land = Model%huge + Interstitial%uustar_water = Model%huge + Interstitial%vdftra = clear_val + Interstitial%vegf1d = clear_val + Interstitial%lndp_vgf = clear_val + Interstitial%wcbmax = clear_val + Interstitial%wind = Model%huge + Interstitial%work1 = clear_val + Interstitial%work2 = clear_val + Interstitial%work3 = clear_val + Interstitial%xcosz = clear_val + Interstitial%xlai1d = clear_val + Interstitial%xmu = clear_val + Interstitial%z01d = clear_val + Interstitial%zt1d = clear_val + Interstitial%ztmax_ice = clear_val + Interstitial%ztmax_land = clear_val + Interstitial%ztmax_water = clear_val + +! UGWP common + Interstitial%tau_mtb = clear_val + Interstitial%tau_ogw = clear_val + Interstitial%tau_tofd = clear_val + Interstitial%tau_ngw = clear_val + Interstitial%tau_oss = clear_val + Interstitial%dudt_mtb = clear_val + Interstitial%dudt_tms = clear_val + Interstitial%zmtb = clear_val + Interstitial%zlwb = clear_val + Interstitial%zogw = clear_val + Interstitial%zngw = clear_val + +! CIRES UGWP v1 + if (Model%do_ugwp_v1) then + Interstitial%dudt_ngw = clear_val + Interstitial%dvdt_ngw = clear_val + Interstitial%dtdt_ngw = clear_val + Interstitial%kdis_ngw = clear_val + end if + +!-- GSL drag suite + if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & + Model%gwd_opt==2 .or. Model%gwd_opt==22) then + Interstitial%varss = clear_val + Interstitial%ocss = clear_val + Interstitial%oa4ss = clear_val + Interstitial%clxss = clear_val + end if +! + ! Reset fields that are conditional on physics choices + if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson & + .or. Model%imp_physics == Model%imp_physics_nssl & + ) then + Interstitial%graupelmp = clear_val + Interstitial%icemp = clear_val + Interstitial%rainmp = clear_val + Interstitial%snowmp = clear_val + else if (Model%imp_physics == Model%imp_physics_mg) then + Interstitial%ncgl = clear_val + Interstitial%ncpr = clear_val + Interstitial%ncps = clear_val + Interstitial%qgl = clear_val + Interstitial%qrn = clear_val + Interstitial%qsnw = clear_val + Interstitial%qlcn = clear_val + Interstitial%qicn = clear_val + Interstitial%w_upi = clear_val + Interstitial%cf_upi = clear_val + Interstitial%cnv_mfd = clear_val + Interstitial%cnv_dqldt = clear_val + Interstitial%clcn = clear_val + Interstitial%cnv_fice = clear_val + Interstitial%cnv_ndrop = clear_val + Interstitial%cnv_nice = clear_val + end if + if (Model%do_shoc) then + Interstitial%qrn = clear_val + Interstitial%qsnw = clear_val + ! DH* updated version of shoc from May 22 2019 doesn't use qgl? remove? + Interstitial%qgl = clear_val + ! *DH + Interstitial%ncpi = clear_val + Interstitial%ncpl = clear_val + end if + if (Model%lsm == Model%lsm_noahmp) then + Interstitial%t2mmp = clear_val + Interstitial%q2mp = clear_val + end if + ! + ! Set flag for resetting maximum hourly output fields + Interstitial%max_hourly_reset = mod(Model%kdt-1, nint(Model%avg_max_length/Model%dtp)) == 0 + ! Use same logic in UFS to reset Thompson extended diagnostics + Interstitial%ext_diag_thompson_reset = Interstitial%max_hourly_reset + ! + ! Set flag for resetting radar reflectivity calculation + if (Model%nsradar_reset<0) then + Interstitial%radar_reset = .true. + else + Interstitial%radar_reset = mod(Model%kdt-1, nint(Model%nsradar_reset/Model%dtp)) == 0 + end if + ! + end subroutine gfs_interstitial_phys_reset + +!----------------------- +! GFDL_interstitial_type +!----------------------- + + subroutine gfdl_interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd, jed, npz, ng, & + dt_atmos, p_split, k_split, zvir, p_ref, ak, bk, & + do_ql, do_qi, do_qr, do_qs, do_qg, do_qa, & + kappa, hydrostatic, do_sat_adj, & + delp, delz, area, peln, phis, pkz, pt, & + qvi, qv, ql, qi, qr, qs, qg, qc, q_con, & + nthreads, nwat, ngas, rilist, cpilist, mpirank, mpiroot) ! implicit none ! - class(CCPP_interstitial_type) :: Interstitial + class(GFDL_interstitial_type) :: Interstitial integer, intent(in) :: is integer, intent(in) :: ie integer, intent(in) :: isd @@ -141,8 +1679,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 ! @@ -190,7 +1728,7 @@ subroutine interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd, jed Interstitial%ng = ng Interstitial%npz = npz Interstitial%npzp1 = npz+1 - ! Set up links from CCPP_interstitial DDT to ATM DDT + ! Set up links from GFDL_interstitial DDT to ATM DDT Interstitial%delp => delp Interstitial%delz => delz Interstitial%area => area @@ -240,18 +1778,18 @@ subroutine interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd, jed Interstitial%mpiroot = mpiroot ! ! Calculate vertical pressure levels - call interstitital_calculate_pressure_levels(Interstitial, npz, p_ref, ak, bk) + call gfdl_interstitital_calculate_pressure_levels(Interstitial, npz, p_ref, ak, bk) ! ! Reset all other variables call Interstitial%reset() ! - end subroutine interstitial_create + end subroutine gfdl_interstitial_create - subroutine interstitital_calculate_pressure_levels(Interstitial, npz, p_ref, ak, bk) + subroutine gfdl_interstitital_calculate_pressure_levels(Interstitial, npz, p_ref, ak, bk) implicit none - class(CCPP_interstitial_type) :: Interstitial + class(GFDL_interstitial_type) :: Interstitial integer, intent(in) :: npz real(kind_dyn), intent(in) :: p_ref real(kind_dyn), intent(in) :: ak(:) @@ -275,13 +1813,13 @@ subroutine interstitital_calculate_pressure_levels(Interstitial, npz, p_ref, ak, Interstitial%kmp = k if ( Interstitial%pfull(k) > 10.E2 ) exit enddo - end subroutine interstitital_calculate_pressure_levels + end subroutine gfdl_interstitital_calculate_pressure_levels - subroutine interstitial_reset (Interstitial) + subroutine gfdl_interstitial_reset (Interstitial) ! implicit none ! - class(CCPP_interstitial_type) :: Interstitial + class(GFDL_interstitial_type) :: Interstitial ! Interstitial%cappa = 0.0 Interstitial%dtdt = 0.0 @@ -291,13 +1829,13 @@ subroutine interstitial_reset (Interstitial) Interstitial%te0_2d = 0.0 Interstitial%te0 = 0.0 ! - end subroutine interstitial_reset + end subroutine gfdl_interstitial_reset - subroutine interstitial_print(Interstitial) + subroutine gfdl_interstitial_print(Interstitial) ! implicit none ! - class(CCPP_interstitial_type) :: Interstitial + class(GFDL_interstitial_type) :: Interstitial ! ! Print static variables write (0,'(a)') 'Interstitial_print' @@ -359,7 +1897,7 @@ subroutine interstitial_print(Interstitial) write (0,*) 'Interstitial%nthreads = ', Interstitial%nthreads write (0,*) 'Interstitial_print: end' ! - end subroutine interstitial_print + end subroutine gfdl_interstitial_print end module CCPP_typedefs diff --git a/ccpp/data/CCPP_typedefs.meta b/ccpp/data/CCPP_typedefs.meta index 9dfabe739..fcdaa0e8a 100644 --- a/ccpp/data/CCPP_typedefs.meta +++ b/ccpp/data/CCPP_typedefs.meta @@ -1,10 +1,2973 @@ [ccpp-table-properties] - name = CCPP_interstitial_type + name = GFS_interstitial_type type = ddt dependencies = [ccpp-arg-table] - name = CCPP_interstitial_type + name = GFS_interstitial_type + type = ddt +[adjsfculw_water] + standard_name = surface_upwelling_longwave_flux_over_water + long_name = surface upwelling longwave flux at current time over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjsfculw_land] + standard_name = surface_upwelling_longwave_flux_over_land + long_name = surface upwelling longwave flux at current time over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjsfculw_ice] + standard_name = surface_upwelling_longwave_flux_over_ice + long_name = surface upwelling longwave flux at current time over ice + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjnirbmd] + standard_name = surface_downwelling_direct_near_infrared_shortwave_flux + long_name = surface downwelling beam near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjnirbmu] + standard_name = surface_upwelling_direct_near_infrared_shortwave_flux + long_name = surface upwelling beam near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjnirdfd] + standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux + long_name = surface downwelling diffuse near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjnirdfu] + standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux + long_name = surface upwelling diffuse near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjvisbmd] + standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux + long_name = surface downwelling beam ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjvisbmu] + standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux + long_name = surface upwelling beam ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjvisdfu] + standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux + long_name = surface upwelling diffuse ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[adjvisdfd] + standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux + long_name = surface downwelling diffuse ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys +[alb1d] + standard_name = surface_albedo_perturbation + long_name = surface albedo perturbation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[alpha] + standard_name = cloud_overlap_decorrelation_parameter + long_name = cloud overlap decorrelation parameter for RRTMG (but not for RRTMGP) + units = frac + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[bexp1d] + standard_name = perturbation_of_soil_type_b_parameter + long_name = perturbation of soil type "b" parameter + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd_water] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_water + long_name = surface exchange coeff for momentum over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd_land] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd_ice] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq_water] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_water + long_name = surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq_land] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq_ice] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[chh_water] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water + long_name = thermal exchange coefficient over water + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[chh_land] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[chh_ice] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + long_name = thermal exchange coefficient over ice + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cf_upi] + standard_name = convective_cloud_fraction_for_microphysics + long_name = convective cloud fraction for microphysics + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[clcn] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[cldf] + standard_name = cloud_area_fraction + long_name = fraction of grid box area in which updrafts occur + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_loop_extent,5) + type = real + kind = kind_phys +[cldtaulw] + standard_name = cloud_optical_depth_layers_at_10mu_band + long_name = approx 10mu band layer cloud optical depth + units = none + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[cldtausw] + standard_name = cloud_optical_depth_layers_at_0p55mu_band + long_name = approx .55mu band layer cloud optical depth + units = none + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[cld1d] + standard_name = cloud_work_function + long_name = cloud work function + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[clouds(:,:,1)] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[clouds(:,:,2)] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[clouds(:,:,3)] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = um + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[clouds(:,:,4)] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[clouds(:,:,5)] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = um + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[clouds(:,:,6)] + standard_name = cloud_rain_water_path + long_name = cloud rain water path + units = g m-2 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[clouds(:,:,7)] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain drop + units = um + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[clouds(:,:,8)] + standard_name = cloud_snow_water_path + long_name = cloud snow water path + units = g m-2 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[clouds(:,:,9)] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow flake + units = um + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys +[clw(:,:,1)] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[clw(:,:,2)] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[clw(:,:,index_for_turbulent_kinetic_energy_convective_transport_tracer)] + standard_name = turbulent_kinetic_energy_convective_transport_tracer + long_name = turbulent kinetic energy in the convectively transported tracer array + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[clx] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height + long_name = frac. of grid box with by subgrid height_above_mean_sea_level higher than critical height + units = frac + dimensions = (horizontal_loop_extent,4) + type = real + kind = kind_phys +[clxss] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale + long_name = frac. of grid box with by subgrid height_above_mean_sea_level higher than critical height small scale + units = frac + dimensions = (horizontal_loop_extent,4) + type = real + kind = kind_phys + active = (control_for_drag_suite_gravity_wave_drag == 3 .or. control_for_drag_suite_gravity_wave_drag == 33) +[cmm_water] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_water + long_name = momentum exchange coefficient over water + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm_land] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm_ice] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice + long_name = momentum exchange coefficient over ice + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cnv_dqldt] + standard_name = tendency_of_cloud_water_due_to_convective_microphysics + long_name = tendency of cloud water due to convective microphysics + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[cnv_fice] + standard_name = ice_fraction_in_convective_tower + long_name = ice fraction in convective tower + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[cnv_mfd] + standard_name = detrained_mass_flux + long_name = detrained mass flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[cnv_ndrop] + standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment + long_name = droplet number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[cnv_nice] + standard_name = number_concentration_of_ice_crystals_for_detrainment + long_name = crystal number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[ctei_r] + standard_name = cloud_top_entrainment_instability_value + long_name = cloud top entrainment instability value + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ctei_rml] + standard_name = grid_sensitive_critical_cloud_top_entrainment_instability_criteria + long_name = grid sensitive critical cloud top entrainment instability criteria + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cumabs] + standard_name = maximum_column_heating_rate + long_name = maximum heating rate in column + units = K s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[del_gz] + standard_name = geopotential_difference_between_midlayers_divided_by_midlayer_virtual_temperature + long_name = difference between mid-layer geopotentials divided by mid-layer virtual temperature + units = m2 s-2 K-1 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys +[delr] + standard_name = layer_pressure_thickness_for_radiation + long_name = layer pressure thickness on radiation levels + units = hPa + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[dlength] + standard_name = characteristic_grid_length_scale + long_name = representative horizontal length scale of grid box + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dqdt] + standard_name = process_split_cumulative_tendency_of_tracers + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys +[dqdt(:,:,index_of_specific_humidity_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_specific_humidity + long_name = water vapor specific humidity tendency due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dqdt(:,:,index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio tendency due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dqdt(:,:,index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dqdt(:,:,index_of_ozone_mixing_ratio_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_ozone_mixing_ratio + long_name = ozone mixing ratio tendency due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dqdt(:,:,index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = number concentration of cloud droplets (liquid) tendency due to model physics + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array > 0) +[dqdt(:,:,index_of_mass_number_concentration_of_cloud_ice_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = number concentration of ice tendency due to model physics + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dqdt(:,:,index_of_mass_number_concentration_of_hygroscopic_aerosols_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_hygroscopic_aerosols + long_name = number concentration of water-friendly aerosols tendency due to model physics + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (index_of_mass_number_concentration_of_hygroscopic_aerosols_in_tracer_concentration_array > 0) +[dqdt(:,:,index_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols + long_name = number concentration of ice-friendly aerosols tendency due to model physics + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (index_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_in_tracer_concentration_array > 0) +[dqdt(:,:,index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array)] + standard_name = tendency_of_cloud_condensation_nuclei_number_concentration_due_to_model_physics + long_name = number concentration of cloud condensation nuclei tendency due to model physics + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array > 0 ) +[dqdt(:,:,index_of_rain_mixing_ratio_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_rain_mixing_ratio + long_name = ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dqdt(:,:,index_of_snow_mixing_ratio_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_snow_mixing_ratio + long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dqdt(:,:,index_of_graupel_mixing_ratio_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_graupel_mixing_ratio + long_name = ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dqdt(:,:,index_of_turbulent_kinetic_energy_in_tracer_concentration_array)] + standard_name = process_split_cumulative_tendency_of_turbulent_kinetic_energy + long_name = turbulent kinetic energy tendency due to model physics + units = J s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dqsfc1] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dtdt] + standard_name = process_split_cumulative_tendency_of_air_temperature + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dtsfc1] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dtzm] + standard_name = mean_change_over_depth_in_sea_water_temperature + long_name = mean of dT(z) (zsea1 to zsea2) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dudt] + standard_name = process_split_cumulative_tendency_of_x_wind + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dusfcg] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dusfc1] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dvdftra] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys +[dvdt] + standard_name = process_split_cumulative_tendency_of_y_wind + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dvsfcg] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dvsfc1] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dzlyr] + standard_name = layer_thickness_for_radiation + long_name = layer thickness on radiation levels + units = km + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[elvmax] + standard_name = maximum_subgrid_orography + long_name = maximum of subgrid height_above_mean_sea_level + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d] + standard_name = surface_upward_potential_latent_heat_flux + long_name = surface upward potential latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d_water] + standard_name = surface_upward_potential_latent_heat_flux_over_water + long_name = surface upward potential latent heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d_land] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d_ice] + standard_name = surface_upward_potential_latent_heat_flux_over_ice + long_name = surface upward potential latent heat flux over ice + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap_water] + standard_name = kinematic_surface_upward_latent_heat_flux_over_water + long_name = kinematic surface upward latent heat flux over water + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap_land] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap_ice] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evbs] + standard_name = soil_upward_latent_heat_flux + long_name = soil upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evcw] + standard_name = canopy_upward_latent_heat_flux + long_name = canopy upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[pah] + standard_name = total_precipitation_advected_heat + long_name = precipitation advected heat - total + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ecan] + standard_name = evaporation_of_intercepted_water + long_name = evaporation of intercepted water + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[etran] + standard_name = transpiration_rate + long_name = transpiration rate + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[edir] + standard_name = soil_surface_evaporation_rate + long_name = soil surface evaporation rate + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[faerlw] + standard_name = aerosol_optical_properties_for_longwave_bands_01_16 + long_name = aerosol optical properties for longwave bands 01-16 + units = mixed + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation,number_of_aerosol_output_fields_for_longwave_radiation) + type = real + kind = kind_phys +[faerlw(:,:,:,1)] + standard_name = aerosol_optical_depth_for_longwave_bands_01_16 + long_name = aerosol optical depth for longwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys +[faerlw(:,:,:,2)] + standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 + long_name = aerosol single scattering albedo for longwave bands 01-16 + units = frac + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys +[faerlw(:,:,:,3)] + standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 + long_name = aerosol asymmetry parameter for longwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys +[faersw] + standard_name = aerosol_optical_properties_for_shortwave_bands_01_16 + long_name = aerosol optical properties for shortwave bands 01-16 + units = mixed + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation,number_of_aerosol_output_fields_for_shortwave_radiation) + type = real + kind = kind_phys +[faersw(:,:,:,1)] + standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 + long_name = aerosol optical depth for shortwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys +[faersw(:,:,:,2)] + standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 + long_name = aerosol single scattering albedo for shortwave bands 01-16 + units = frac + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys +[faersw(:,:,:,3)] + standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 + long_name = aerosol asymmetry parameter for shortwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys +[ffhh_water] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_water + long_name = Monin-Obukhov similarity function for heat over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh_land] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_land + long_name = Monin-Obukhov similarity function for heat over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice + long_name = Monin-Obukhov similarity function for heat over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m + long_name = Monin-Obukhov similarity parameter for heat at 2m + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2_water] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_water + long_name = Monin-Obukhov similarity parameter for heat at 2m over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2_land] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land + long_name = Monin-Obukhov similarity parameter for heat at 2m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice + long_name = Monin-Obukhov similarity parameter for heat at 2m over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[ffmm_water] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_water + long_name = Monin-Obukhov similarity function for momentum over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm_land] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land + long_name = Monin-Obukhov similarity function for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice + long_name = Monin-Obukhov similarity function for momentum over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m + long_name = Monin-Obukhov similarity parameter for momentum at 10m + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10_water] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_water + long_name = Monin-Obukhov similarity parameter for momentum at 10m over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10_land] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land + long_name = Monin-Obukhov similarity parameter for momentum at 10m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[frain] + standard_name = dynamics_to_physics_timestep_ratio + long_name = ratio of dynamics timestep to physics timestep + units = none + dimensions = () + type = real + kind = kind_phys +[frland] + standard_name = land_area_fraction_for_microphysics + long_name = land area fraction used in microphysics schemes + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fscav] + standard_name = fraction_of_tracer_scavenged + long_name = fraction of the tracer (aerosols) that is scavenged by convection + units = km-1 + dimensions = (number_of_tracers_scavenged) + type = real + kind = kind_phys +[fswtr] + standard_name = fraction_of_cloud_top_water_scavenged + long_name = fraction of the tracer (cloud top water) that is scavenged by convection + units = km-1 + dimensions = (number_of_tracers_scavenged) + type = real + kind = kind_phys +[gabsbdlw] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground + long_name = total sky surface downward longwave flux absorbed by the ground + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gabsbdlw_water] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_water + long_name = total sky surface downward longwave flux absorbed by the ground over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gabsbdlw_land] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land + long_name = total sky surface downward longwave flux absorbed by the ground over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gabsbdlw_ice] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ice + long_name = total sky surface downward longwave flux absorbed by the ground over ice + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gamma] + standard_name = anisotropy_of_subgrid_orography + long_name = anisotropy of subgrid height_above_mean_sea_level + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gamq] + standard_name = countergradient_mixing_term_for_water_vapor + long_name = countergradient mixing term for water vapor + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gamt] + standard_name = countergradient_mixing_term_for_temperature + long_name = countergradient mixing term for temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gasvmr(:,:,1)] + standard_name = volume_mixing_ratio_of_co2 + long_name = volume mixing ratio co2 + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gasvmr(:,:,2)] + standard_name = volume_mixing_ratio_of_n2o + long_name = volume mixing ratio no2 + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gasvmr(:,:,3)] + standard_name = volume_mixing_ratio_of_ch4 + long_name = volume mixing ratio ch4 + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gasvmr(:,:,4)] + standard_name = volume_mixing_ratio_of_o2 + long_name = volume mixing ratio o2 + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gasvmr(:,:,5)] + standard_name = volume_mixing_ratio_of_co + long_name = volume mixing ratio co + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gasvmr(:,:,6)] + standard_name = volume_mixing_ratio_of_cfc11 + long_name = volume mixing ratio cfc11 + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gasvmr(:,:,7)] + standard_name = volume_mixing_ratio_of_cfc12 + long_name = volume mixing ratio cfc12 + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gasvmr(:,:,8)] + standard_name = volume_mixing_ratio_of_cfc22 + long_name = volume mixing ratio cfc22 + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gasvmr(:,:,9)] + standard_name = volume_mixing_ratio_of_ccl4 + long_name = volume mixing ratio ccl4 + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gasvmr(:,:,10)] + standard_name = volume_mixing_ratio_of_cfc113 + long_name = volume mixing ratio cfc113 + units = m3 m-3 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[gflx] + standard_name = upward_heat_flux_in_soil + long_name = soil heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx_water] + standard_name = upward_heat_flux_in_soil_over_water + long_name = soil heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx_land] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx_ice] + standard_name = upward_heat_flux_in_soil_over_ice + long_name = soil heat flux over ice + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[graupelmp] + standard_name = lwe_thickness_of_graupel_amount + long_name = explicit graupel fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_gfdl_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_nssl_microphysics_scheme) +[gwdcu] + standard_name = tendency_of_x_wind_due_to_convective_gravity_wave_drag + long_name = zonal wind tendency due to convective gravity wave drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[gwdcv] + standard_name = tendency_of_y_wind_due_to_convective_gravity_wave_drag + long_name = meridional wind tendency due to convective gravity wave drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[zvfun] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction + long_name = function of surface roughness length and green vegetation fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hffac] + standard_name = surface_upward_sensible_heat_flux_reduction_factor + long_name = surface upward sensible heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflxq] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness_and_vegetation + long_name = kinematic surface upward sensible heat flux reduced by surface roughness and vegetation + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx_water] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_water + long_name = kinematic surface upward sensible heat flux over water + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx_land] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[htlwc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels + long_name = total sky heating rate due to longwave radiation + units = K s-1 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[htlw0] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels + long_name = clear sky heating rate due to longwave radiation + units = K s-1 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[htswc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels + long_name = total sky heating rate due to shortwave radiation + units = K s-1 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[htsw0] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels + long_name = clear sky heating rates due to shortwave radiation + units = K s-1 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[icemp] + standard_name = lwe_thickness_of_ice_amount + long_name = explicit ice fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_gfdl_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_nssl_microphysics_scheme) +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_loop_extent) + type = integer +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[lake] + standard_name = flag_nonzero_lake_surface_fraction + long_name = flag indicating presence of some lake surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[use_flake] + standard_name = flag_for_using_flake + long_name = flag indicating lake points using flake model + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[ocean] + standard_name = flag_nonzero_ocean_surface_fraction + long_name = flag indicating presence of some ocean surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_loop_extent) + type = integer +[islmsk_cice] + standard_name = sea_land_ice_mask_cice + long_name = sea/land/ice mask cice (=0/1/2) + units = flag + dimensions = (horizontal_loop_extent) + type = integer +[itc] + standard_name = index_of_first_chemical_tracer_for_convection + long_name = index of first chemical tracer transported/scavenged by convection + units = index + dimensions = () + type = integer +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[kb] + standard_name = vertical_index_difference_between_layer_and_lower_bound + long_name = vertical index difference between layer and lower bound + units = index + dimensions = () + type = integer +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = vertical index at cloud base + units = index + dimensions = (horizontal_loop_extent) + type = integer +[kcnv] + standard_name = flag_deep_convection + long_name = flag indicating whether convection occurs in column (0 or 1) + units = flag + dimensions = (horizontal_loop_extent) + type = integer +[kd] + standard_name = vertical_index_difference_between_inout_and_local + long_name = vertical index difference between in/out and local + units = index + dimensions = () + type = integer +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_loop_extent) + type = integer +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer + units = index + dimensions = (horizontal_loop_extent) + type = integer +[kt] + standard_name = vertical_index_difference_between_layer_and_upper_bound + long_name = vertical index difference between layer and upper bound + units = index + dimensions = () + type = integer +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = vertical index at cloud top + units = index + dimensions = (horizontal_loop_extent) + type = integer +[latidxprnt] + standard_name = latitude_index_in_debug_printouts + long_name = latitude index in debug printouts + units = index + dimensions = () + type = integer +[levi] + standard_name = vertical_interface_dimension_interstitial + long_name = vertical interface dimension + units = count + dimensions = () + type = integer +[lmk] + standard_name = adjusted_vertical_layer_dimension_for_radiation + long_name = adjusted number of vertical layers for radiation + units = count + dimensions = () + type = integer +[lmp] + standard_name = adjusted_vertical_level_dimension_for_radiation + long_name = adjusted number of vertical levels for radiation + units = count + dimensions = () + type = integer +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_loop_extent,3) + type = integer +[mg3_as_mg2] + standard_name = flag_mg3_as_mg2 + long_name = flag for controlling prep for Morrison-Gettelman microphysics + units = flag + dimensions = () + type = logical +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_loop_extent,3) + type = integer +[nbdlw] + standard_name = number_of_aerosol_bands_for_longwave_radiation + long_name = number of aerosol bands for longwave radiation + units = count + dimensions = () + type = integer +[nbdsw] + standard_name = number_of_aerosol_bands_for_shortwave_radiation + long_name = number of aerosol bands for shortwave radiation + units = count + dimensions = () + type = integer +[ncgl] + standard_name = local_graupel_number_concentration + long_name = number concentration of graupel local to physics + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[ncpi] + standard_name = local_ice_number_concentration + long_name = number concentration of ice local to physics + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_shoc) +[ncpl] + standard_name = local_condesed_water_number_concentration + long_name = number concentration of condensed water local to physics + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_shoc) +[ncpr] + standard_name = local_rain_number_concentration + long_name = number concentration of rain local to physics + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[ncps] + standard_name = local_snow_number_concentration + long_name = number concentration of snow local to physics + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[ncstrac] + standard_name = number_of_tracers_for_CS + long_name = number of convectively transported tracers in Chikira-Sugiyama deep convection scheme + units = count + dimensions = () + type = integer +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer +[nf_aelw] + standard_name = number_of_aerosol_output_fields_for_longwave_radiation + long_name = number of aerosol output fields for longwave radiation + units = count + dimensions = () + type = integer +[nf_aesw] + standard_name = number_of_aerosol_output_fields_for_shortwave_radiation + long_name = number of aerosol output fields for shortwave radiation + units = count + dimensions = () + type = integer +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer +[nsamftrac] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer +[nscav] + standard_name = number_of_tracers_scavenged + long_name = number of tracers scavenged + units = count + dimensions = () + type = integer +[nspc1] + standard_name = number_of_species_for_aerosol_optical_depth + long_name = number of species for output aerosol optical depth plus total + units = count + dimensions = () + type = integer +[ntcwx] + standard_name = index_for_liquid_cloud_condensate_vertical_diffusion_tracer + long_name = index for liquid cloud condensate in the vertically diffused tracer array + units = index + dimensions = () + type = integer +[ntiwx] + standard_name = index_for_ice_cloud_condensate_vertical_diffusion_tracer + long_name = index for ice cloud condensate in the vertically diffused tracer array + units = index + dimensions = () + type = integer +[ntrwx] + standard_name = index_for_rain_water_vertical_diffusion_tracer + long_name = tracer index for rain water in the vertically diffused tracer array + units = index + dimensions = () + type = integer +[ntk] + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index + dimensions = () + type = integer +[ntkev] + standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer + long_name = index for turbulent kinetic energy in the vertically diffused tracer array + units = index + dimensions = () + type = integer +[nvdiff] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer +[oa4] + standard_name = asymmetry_of_subgrid_orography + long_name = asymmetry of subgrid height_above_mean_sea_level + units = none + dimensions = (horizontal_loop_extent,4) + type = real + kind = kind_phys +[varss] + standard_name = standard_deviation_of_subgrid_orography_small_scale + long_name = standard deviation of subgrid height_above_mean_sea_level small scale + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_drag_suite_gravity_wave_drag == 3 .or. control_for_drag_suite_gravity_wave_drag == 33) +[oa4ss] + standard_name = asymmetry_of_subgrid_orography_small_scale + long_name = asymmetry of subgrid height_above_mean_sea_level small scale + units = none + dimensions = (horizontal_loop_extent,4) + type = real + kind = kind_phys + active = (control_for_drag_suite_gravity_wave_drag == 3 .or. control_for_drag_suite_gravity_wave_drag == 33) +[oc] + standard_name = convexity_of_subgrid_orography + long_name = convexity of subgrid height_above_mean_sea_level + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ocss] + standard_name = convexity_of_subgrid_orography_small_scale + long_name = convexity of subgrid height_above_mean_sea_level small scale + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_drag_suite_gravity_wave_drag == 3 .or. control_for_drag_suite_gravity_wave_drag == 33) +[olyr] + standard_name = ozone_concentration_at_layer_for_radiation + long_name = ozone concentration layer + units = kg kg-1 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[otspt] + standard_name = flag_convective_tracer_transport + long_name = flag to enable tracer transport by updrafts/downdrafts[(:,1)] or subsidence [(:,2)] + units = flag + dimensions = (number_of_tracers_plus_one,2) + type = logical +[otsptflag] + standard_name = flag_convective_tracer_transport_interstitial + long_name = flag for interstitial tracer transport + units = flag + dimensions = (number_of_tracers) + type = logical +[oz_coeffp5] + standard_name = number_of_coefficients_in_ozone_forcing_data_plus_five + long_name = number of coefficients in ozone forcing data plus five + units = index + dimensions = () + type = integer +[phys_hydrostatic] + standard_name = flag_for_hydrostatic_heating_from_physics + long_name = flag for use of hydrostatic heating in physics + units = flag + dimensions = () + type = logical +[plvl] + standard_name = air_pressure_at_interface_for_radiation_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) + type = real + kind = kind_phys +[plyr] + standard_name = air_pressure_at_layer_for_radiation_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[prnum] + standard_name = prandtl_number + long_name = turbulent Prandtl number + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[q2mp] + standard_name = specific_humidity_at_2m_from_noahmp + long_name = 2 meter specific humidity from noahmp + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme) +[qgl] + standard_name = local_graupel_mixing_ratio + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme .or. flag_for_shoc) +[qicn] + standard_name = mass_fraction_of_convective_cloud_ice + long_name = mass fraction of convective cloud ice water + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[qlcn] + standard_name = mass_fraction_of_convective_cloud_liquid_water + long_name = mass fraction of convective cloud liquid water + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[qlyr] + standard_name = water_vapor_specific_humidity_at_layer_for_radiation + long_name = specific humidity layer + units = kg kg-1 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[qrn] + standard_name = local_rain_water_mixing_ratio + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme .or. flag_for_shoc) +[qsnw] + standard_name = local_snow_water_mixing_ratio + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme .or. flag_for_shoc) +[prcpmp] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qss_water] + standard_name = surface_specific_humidity_over_water + long_name = surface air saturation specific humidity over water + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qss_land] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qss_ice] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[radar_reset] + standard_name = flag_for_resetting_radar_reflectivity_calculation + long_name = flag for resetting radar reflectivity calculation + units = flag + dimensions = () + type = logical +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () + type = real + kind = kind_phys +[raincd] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[raincs] + standard_name = lwe_thickness_of_shallow_convective_precipitation_amount + long_name = shallow convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rainmcadj] + standard_name = lwe_thickness_of_moist_convective_adj_precipitation_amount + long_name = adjusted moist convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rainmp] + standard_name = lwe_thickness_of_explicit_rain_amount + long_name = explicit rain on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_gfdl_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_nssl_microphysics_scheme) +[rainp] + standard_name = tendency_of_rain_water_mixing_ratio_due_to_microphysics + long_name = tendency of rain water mixing ratio due to microphysics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[rb] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb_water] + standard_name = bulk_richardson_number_at_lowest_model_level_over_water + long_name = bulk Richardson number at the surface over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb_land] + standard_name = bulk_richardson_number_at_lowest_model_level_over_land + long_name = bulk Richardson number at the surface over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb_ice] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ice + long_name = bulk Richardson number at the surface over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[max_hourly_reset] + standard_name = flag_reset_maximum_hourly_fields + long_name = flag for resetting maximum hourly fields + units = flag + dimensions = () + type = logical +[ext_diag_thompson_reset] + standard_name = flag_reset_extended_diagnostics_output_arrays_from_thompson_microphysics + long_name = flag for resetting extended diagnostics output arrays from thompson microphysics + units = flag + dimensions = () + type = logical +[rhc] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[rho1] + standard_name = air_density_at_lowest_model_layer + long_name = air density at lowest model layer + units = kg m-3 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[runoff] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[save_q(:,:,index_of_ozone_mixing_ratio_in_tracer_concentration_array)] + standard_name = ozone_mixing_ratio_save + long_name = ozone mixing ratio before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_q(:,:,index_of_turbulent_kinetic_energy_in_tracer_concentration_array)] + standard_name = turbulent_kinetic_energy_save + long_name = turbulent kinetic energy before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_q(:,:,index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array)] + standard_name = cloud_condensed_water_mixing_ratio_save + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_q(:,:,index_of_snow_mixing_ratio_in_tracer_concentration_array)] + standard_name = snow_mixing_ratio_save + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_q(:,:,index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array)] + standard_name = ice_water_mixing_ratio_save + long_name = cloud ice water mixing ratio before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_q(:,:,index_of_specific_humidity_in_tracer_concentration_array)] + standard_name = water_vapor_specific_humidity_save + long_name = water vapor specific humidity before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_q(:,:,index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array)] + standard_name = liquid_cloud_number_concentration_save + long_name = liquid cloud number concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_q(:,:,index_of_mass_number_concentration_of_cloud_ice_in_tracer_concentration_array)] + standard_name = ice_cloud_number_concentration_save + long_name = ice cloud number concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_tcp] + standard_name = air_temperature_save_from_convective_parameterization + long_name = air temperature after cumulus parameterization + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_u] + standard_name = x_wind_save + long_name = x-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[save_v] + standard_name = y_wind_save + long_name = y-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[sbsno] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_loop_extent) + type = cmpfsw_type +[sfcalb] + standard_name = surface_albedo_components + long_name = surface albedo IR/UV/VIS components + units = frac + dimensions = (horizontal_loop_extent,number_of_components_for_surface_albedo) + type = real + kind = kind_phys +[sfcalb(:,1)] + standard_name = surface_albedo_due_to_near_IR_direct + long_name = surface albedo due to near IR direct beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[sfcalb(:,2)] + standard_name = surface_albedo_due_to_near_IR_diffused + long_name = surface albedo due to near IR diffused beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[sfcalb(:,3)] + standard_name = surface_albedo_due_to_UV_and_VIS_direct + long_name = surface albedo due to UV+VIS direct beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[sfcalb(:,4)] + standard_name = surface_albedo_due_to_UV_and_VIS_diffused + long_name = surface albedo due to UV+VIS diffused beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[sigma] + standard_name = slope_of_subgrid_orography + long_name = slope of subgrid height_above_mean_sea_level + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[sigmafrac] + standard_name = convective_updraft_area_fraction + long_name = convective updraft area fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[sigmatot] + standard_name = convective_updraft_area_fraction_at_model_interfaces + long_name = convective updraft area fraction at model interfaces + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[skip_macro] + standard_name = flag_skip_macro + long_name = flag to skip cloud macrophysics in Morrison scheme + units = flag + dimensions = () + type = logical +[snowc] + standard_name = surface_snow_area_fraction + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[snohf] + standard_name = snow_freezing_rain_upward_latent_heat_flux + long_name = latent heat flux due to snow and frz rain + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[snowmp] + standard_name = lwe_thickness_of_snow_amount + long_name = explicit snow fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_gfdl_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_nssl_microphysics_scheme) +[snowmt] + standard_name = surface_snow_melt + long_name = snow melt during timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress_water] + standard_name = surface_wind_stress_over_water + long_name = surface wind stress over water + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress_land] + standard_name = surface_wind_stress_over_land + long_name = surface wind stress over land + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress_ice] + standard_name = surface_wind_stress_over_ice + long_name = surface wind stress over ice + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[t2mmp] + standard_name = temperature_at_2m_from_noahmp + long_name = 2 meter temperature from noahmp + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme) +[theta] + standard_name = angle_from_east_of_maximum_subgrid_orographic_variations + long_name = angle with_respect to east of maximum subgrid orographic variations + units = degree + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tlvl] + standard_name = air_temperature_at_interface_for_radiation + long_name = air temperature at vertical interface for radiation calculation + units = K + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) + type = real + kind = kind_phys +[tlyr] + standard_name = air_temperature_at_layer_for_radiation + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys +[tprcp_water] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_water + long_name = total precipitation amount in each time step over water + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp_land] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp_ice] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice + long_name = total precipitation amount in each time step over ice + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tracers_start_index] + standard_name = start_index_of_other_tracers + long_name = beginning index of the non-water tracer species + units = index + dimensions = () + type = integer +[tracers_total] + standard_name = number_of_total_tracers + long_name = total number of tracers + units = count + dimensions = () + type = integer +[trans_aero] + standard_name = flag_for_aerosol_convective_transport_and_PBL_diffusion + long_name = flag for aerosol convective transport and PBL diffusion + units = flag + dimensions = () + type = logical +[trans] + standard_name = transpiration_flux + long_name = total plant transpiration rate + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tseal] + standard_name = surface_skin_temperature_for_nsst + long_name = ocean surface skin temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsfc_water] + standard_name = surface_skin_temperature_over_water + long_name = surface skin temperature over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsurf_water] + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsurf_land] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tracers_water] + standard_name = number_of_water_tracers + long_name = number of water-related tracers + units = count + dimensions = () + type = integer +[uustar_water] + standard_name = surface_friction_velocity_over_water + long_name = surface friction velocity over water + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar_land] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[vdftra] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys +[lndp_vgf] + standard_name = magnitude_of_perturbation_of_vegetation_fraction + long_name = magnitude of perturbation of vegetation fraction + units = frac + dimensions = () + type = real + kind = kind_phys +[vegf1d] + standard_name = perturbation_of_vegetation_fraction + long_name = perturbation of vegetation fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[w_upi] + standard_name = vertical_velocity_for_updraft + long_name = vertical velocity for updraft + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) +[wcbmax] + standard_name = maximum_updraft_velocity_at_cloud_base + long_name = maximum updraft velocity at cloud base + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[work1] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes + long_name = grid size related coefficient used in scale-sensitive schemes + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[work2] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement + long_name = complement to work1 + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[work3] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[xcosz] + standard_name = instantaneous_cosine_of_zenith_angle + long_name = cosine of zenith angle at current time + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[xlai1d] + standard_name = perturbation_of_leaf_area_index + long_name = perturbation of leaf area index + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[z01d] + standard_name = perturbation_of_momentum_roughness_length + long_name = perturbation of momentum roughness length + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ztmax_water] + standard_name = bounded_surface_roughness_length_for_heat_over_water + long_name = bounded surface roughness length for heat over water + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ztmax_land] + standard_name = bounded_surface_roughness_length_for_heat_over_land + long_name = bounded surface roughness length for heat over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ztmax_ice] + standard_name = bounded_surface_roughness_length_for_heat_over_ice + long_name = bounded surface roughness length for heat over ice + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zt1d] + standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio + long_name = perturbation of heat to momentum roughness length ratio + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zmtb] + standard_name = height_of_mountain_blocking + long_name = height of mountain blocking drag + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dudt_ngw] + standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag + long_name = zonal wind tendency due to non-stationary GWs + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_ugwp_version_1 .or. control_for_drag_suite_gravity_wave_drag==33 .or. control_for_drag_suite_gravity_wave_drag==22 .or. control_for_drag_suite_gravity_wave_drag==3 .or. control_for_drag_suite_gravity_wave_drag==2) +[dvdt_ngw] + standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag + long_name = meridional wind tendency due to non-stationary GWs + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_ugwp_version_1 .or. control_for_drag_suite_gravity_wave_drag==33 .or. control_for_drag_suite_gravity_wave_drag==22 .or. control_for_drag_suite_gravity_wave_drag==3 .or. control_for_drag_suite_gravity_wave_drag==2) +[dtdt_ngw] + standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag + long_name = air temperature tendency due to non-stationary GWs + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_ugwp_version_1 .or. control_for_drag_suite_gravity_wave_drag==33 .or. control_for_drag_suite_gravity_wave_drag==22 .or. control_for_drag_suite_gravity_wave_drag==3 .or. control_for_drag_suite_gravity_wave_drag==2) +[kdis_ngw] + standard_name = atmosphere_momentum_diffusivity_due_to_nonorographic_gravity_wave_drag + long_name = eddy mixing due to non-stationary GWs + units = m2 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_ugwp_version_1 .or. control_for_drag_suite_gravity_wave_drag==33 .or. control_for_drag_suite_gravity_wave_drag==22 .or. control_for_drag_suite_gravity_wave_drag==3 .or. control_for_drag_suite_gravity_wave_drag==2) +[zlwb] + standard_name = height_of_low_level_wave_breaking + long_name = height of low level wave breaking + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zogw] + standard_name = height_of_launch_level_of_orographic_gravity_wave + long_name = height of launch level of orographic gravity wave + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zngw] + standard_name = height_of_launch_level_of_nonorographic_gravity_waves + long_name = height of launch level of non-stationary GWs + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tau_tofd] + standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag + long_name = instantaneous momentum flux due to TOFD + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tau_mtb] + standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag + long_name = instantaneous momentum flux due to mountain blocking drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tau_ogw] + standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = instantaneous momentum flux due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tau_oss] + standard_name = momentum_flux_due_to_subgrid_scale_orographic_gravity_wave_drag + long_name = momentum flux or stress due to SSO including OBL-OSS-OFD + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tau_ngw] + standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave + long_name = instantaneous momentum flux due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dudt_mtb] + standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag + long_name = instantaneous change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[dudt_tms] + standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag + long_name = instantaneous change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[qs_lay] + standard_name = saturation_vapor_pressure + long_name = saturation vapor pressure + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[q_lay] + standard_name = water_vapor_mixing_ratio + long_name = water vaport mixing ratio + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP + long_name = air pressure layer + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP + long_name = air pressure level + units = Pa + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[deltaZc] + standard_name = layer_thickness_from_layer_center + long_name = layer_thickness + units = m + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[deltaP] + standard_name = layer_thickness_in_Pa + long_name = layer_thickness_in_Pa + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter for RRTMGP (but not for RRTMG) + units = km + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[fluxlwUP_allsky] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[fluxlwDOWN_allsky] + standard_name = RRTMGP_lw_flux_profile_downward_allsky + long_name = RRTMGP downward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[fluxlwUP_clrsky] + standard_name = RRTMGP_lw_flux_profile_upward_clrsky + long_name = RRTMGP upward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[fluxlwDOWN_clrsky] + standard_name = RRTMGP_lw_flux_profile_downward_clrsky + long_name = RRTMGP downward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[fluxswUP_allsky] + standard_name = RRTMGP_sw_flux_profile_upward_allsky + long_name = RRTMGP upward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[fluxswDOWN_allsky] + standard_name = RRTMGP_sw_flux_profile_downward_allsky + long_name = RRTMGP downward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[fluxswUP_clrsky] + standard_name = RRTMGP_sw_flux_profile_upward_clrsky + long_name = RRTMGP upward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[fluxswDOWN_clrsky] + standard_name = RRTMGP_sw_flux_profile_downward_clrsky + long_name = RRTMGP downward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[flxprf_lw] + standard_name = RRTMGP_lw_fluxes + long_name = lw fluxes total sky / csk and up / down at levels + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = proflw_type + active = (flag_for_rrtmgp_radiation_scheme) +[flxprf_sw] + standard_name = RRTMGP_sw_fluxes + long_name = sw fluxes total sky / csk and up / down at levels + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = profsw_type + active = (flag_for_rrtmgp_radiation_scheme) +[aerosolslw] + standard_name = RRTMGP_aerosol_optical_properties_for_longwave_bands_01_16 + long_name = aerosol optical properties for longwave bands 01-16 + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_longwave_bands,number_of_aerosol_output_fields_for_longwave_radiation) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[aerosolslw(:,:,:,1)] + standard_name = RRTMGP_aerosol_optical_depth_for_longwave_bands_01_16 + long_name = aerosol optical depth for longwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_longwave_bands) + type = real + kind = kind_phys +[aerosolslw(:,:,:,2)] + standard_name = RRTMGP_aerosol_single_scattering_albedo_for_longwave_bands_01_16 + long_name = aerosol single scattering albedo for longwave bands 01-16 + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_longwave_bands) + type = real + kind = kind_phys +[aerosolslw(:,:,:,3)] + standard_name = RRTMGP_aerosol_asymmetry_parameter_for_longwave_bands_01_16 + long_name = aerosol asymmetry parameter for longwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_longwave_bands) + type = real + kind = kind_phys +[aerosolssw] + standard_name = RRTMGP_aerosol_optical_properties_for_shortwave_bands_01_16 + long_name = aerosol optical properties for shortwave bands 01-16 + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_shortwave_bands, number_of_aerosol_output_fields_for_shortwave_radiation) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[aerosolssw(:,:,:,1)] + standard_name = RRTMGP_aerosol_optical_depth_for_shortwave_bands_01_16 + long_name = aerosol optical depth for shortwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_shortwave_bands) + type = real + kind = kind_phys +[aerosolssw(:,:,:,2)] + standard_name = RRTMGP_aerosol_single_scattering_albedo_for_shortwave_bands_01_16 + long_name = aerosol single scattering albedo for shortwave bands 01-16 + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_shortwave_bands) + type = real + kind = kind_phys +[aerosolssw(:,:,:,3)] + standard_name = RRTMGP_aerosol_asymmetry_parameter_for_shortwave_bands_01_16 + long_name = aerosol asymmetry parameter for shortwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_shortwave_bands) + type = real + kind = kind_phys +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cnv_cloud_overlap_param] + standard_name = convective_cloud_overlap_param + long_name = convective cloud overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cld_cnv_frac] + standard_name = convective_cloud_fraction_for_RRTMGP + long_name = layer convective cloud fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cld_cnv_lwp] + standard_name = convective_cloud_liquid_water_path + long_name = layer convective cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cld_cnv_iwp] + standard_name = convective_cloud_ice_water_path + long_name = layer convective cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cld_cnv_reliq] + standard_name = mean_effective_radius_for_liquid_convective_cloud + long_name = mean effective radius for liquid convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cld_cnv_reice] + standard_name = mean_effective_radius_for_ice_convective_cloud + long_name = mean effective radius for ice convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cld_pbl_lwp] + standard_name = MYNN_SGS_cloud_liquid_water_path + long_name = layer convective cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cld_pbl_iwp] + standard_name = MYNN_SGS_cloud_ice_water_path + long_name = layer convective cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cld_pbl_reliq] + standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud + long_name = mean effective radius for liquid MYNN_SGS cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[cld_pbl_reice] + standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud + long_name = mean effective radius for ice MYNN_SGS cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[sw_optical_props_clrsky] + standard_name = shortwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[sw_optical_props_cloudsByBand] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[sw_optical_props_cnvcloudsByBand] + standard_name = shortwave_optical_properties_for_convective_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str +[sw_optical_props_MYNNcloudsByBand] + standard_name = shortwave_optical_properties_for_MYNN_EDMF_PBL_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[sw_optical_props_cnvclouds] + standard_name = shortwave_optical_properties_for_convective_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) + active = (flag_for_rrtmgp_radiation_scheme) +[sw_optical_props_precipByBand] + standard_name = shortwave_optical_properties_for_precipitation_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[sw_optical_props_precip] + standard_name = shortwave_optical_properties_for_precipitation + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[sw_optical_props_clouds] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[sw_optical_props_aerosol] + standard_name = shortwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs + active = (flag_for_rrtmgp_radiation_scheme) +[sources] + standard_name = longwave_source_function + long_name = Fortran DDT containing RRTMGP source functions + units = DDT + dimensions = () + type = ty_source_func_lw + active = (flag_for_rrtmgp_radiation_scheme) +[lw_optical_props_clrsky] + standard_name = longwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + active = (flag_for_rrtmgp_radiation_scheme) +[lw_optical_props_clouds] + standard_name = longwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[lw_optical_props_precip] + standard_name = longwave_optical_properties_for_precipitation + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[lw_optical_props_cloudsByBand] + standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[lw_optical_props_cnvcloudsByBand] + standard_name = longwave_optical_properties_for_convective_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[lw_optical_props_MYNNcloudsByBand] + standard_name = longwave_optical_properties_for_MYNN_EDMF_PBL_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[lw_optical_props_cnvclouds] + standard_name = longwave_optical_properties_for_convective_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[lw_optical_props_precipByBand] + standard_name = longwave_optical_properties_for_precipitation_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + active = (flag_for_rrtmgp_radiation_scheme) +[lw_optical_props_aerosol] + standard_name = longwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + active = (flag_for_rrtmgp_radiation_scheme) +[sfc_emiss_byband] + standard_name = surface_emissivity_in_each_RRTMGP_LW_band + long_name = surface emissivity in each RRTMGP LW band + units = none + dimensions = (number_of_longwave_bands,horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[sec_diff_byband] + standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band + long_name = secant of diffusivity angle in each RRTMGP LW band + units = none + dimensions = (number_of_longwave_bands,horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[sfc_alb_nir_dir] + standard_name = surface_albedo_nearIR_direct + long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) + units = none + dimensions = (number_of_shortwave_bands,horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[sfc_alb_nir_dif] + standard_name = surface_albedo_nearIR_diffuse + long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) + units = none + dimensions = (number_of_shortwave_bands,horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_uvvis_direct + long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) + units = none + dimensions = (number_of_shortwave_bands,horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_uvvis_diffuse + long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) + units = none + dimensions = (number_of_shortwave_bands,horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[toa_src_lw] + standard_name = toa_incident_lw_flux_by_spectral_point + long_name = TOA longwave incident flux at each spectral points + units = W m-2 + dimensions = (horizontal_loop_extent,number_of_longwave_spectral_points) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[toa_src_sw] + standard_name = toa_incident_sw_flux_by_spectral_point + long_name = TOA shortwave incident flux at each spectral points + units = W m-2 + dimensions = (horizontal_loop_extent,number_of_shortwave_spectral_points) + type = real + kind = kind_phys + active = (flag_for_rrtmgp_radiation_scheme) +[rtg_ozone_index] + standard_name = vertically_diffused_tracer_index_of_ozone + long_name = number of tracers + units = count + dimensions = () + type = integer + +######################################################################## +[ccpp-table-properties] + name = GFDL_interstitial_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = GFDL_interstitial_type type = ddt [akap] standard_name = kappa_dry_for_fast_physics @@ -343,14 +3306,25 @@ [ccpp-table-properties] name = CCPP_typedefs type = module - dependencies = ../physics/physics/machine.F + relative_path = ../physics/physics + dependencies = machine.F,ozne_def.f,radlw_param.f,radsw_param.f + dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rte/mo_optical_props.F90 + dependencies = rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 + dependencies = rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_rte_config.F90 + dependencies = rte-rrtmgp/rte/mo_source_functions.F90 [ccpp-arg-table] name = CCPP_typedefs type = module -[CCPP_interstitial_type] - standard_name = CCPP_interstitial_type - long_name = definition of type CCPP_interstitial_type +[GFS_interstitial_type] + standard_name = GFS_interstitial_type + long_name = definition of type GFS_interstitial_type + units = DDT + dimensions = () + type = GFS_interstitial_type +[GFDL_interstitial_type] + standard_name = GFDL_interstitial_type + long_name = definition of type GFDL_interstitial_type units = DDT dimensions = () - type = CCPP_interstitial_type + type = GFDL_interstitial_type diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 3be66033f..2e984ad1d 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1,79 +1,65 @@ - module GFS_typedefs - use machine, only: kind_phys,kind_dbl_prec - use physcons, only: con_cp, con_fvirt, con_g, & - con_hvap, con_hfus, con_pi, con_rd, con_rv, & - con_t0c, con_cvap, con_cliq, con_eps, con_epsq, & - con_epsm1, con_ttp, rlapse, con_jcal, con_rhw0, & - con_sbc, con_tice, cimin, con_p0, rhowater, & - con_csol, con_epsqs, con_rocp, con_rog, & - con_omega, con_rerth, con_psat, karman, rainmin - - use module_radsw_parameters, only: topfsw_type, sfcfsw_type, profsw_type, cmpfsw_type, NBDSW - use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type, NBDLW - use ozne_def, only: levozp, oz_coeff - use h2o_def, only: levh2o, h2o_coeff - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_1scl,ty_optical_props_2str - use mo_cloud_optics, only: ty_cloud_optics - use mo_gas_concentrations, only: ty_gas_concs - use mo_source_functions, only: ty_source_func_lw - - implicit none - - ! To ensure that these values match what's in the physics, - ! array sizes are compared during model init in GFS_rrtmg_setup_init() - private :: NF_AESW, NF_AELW, NSPC, NSPC1, NF_CLDS, NF_VGAS, NF_ALBD, ntrcaerm - ! from module_radiation_aerosols - integer, parameter :: NF_AESW = 3 - integer, parameter :: NF_AELW = 3 - integer, parameter :: NSPC = 5 - integer, parameter :: NSPC1 = NSPC + 1 - ! from module_radiation_clouds - integer, parameter :: NF_CLDS = 9 - ! from module_radiation_gases - integer, parameter :: NF_VGAS = 10 - ! from module_radiation_surface - integer, parameter :: NF_ALBD = 4 - ! from aerclm_def - integer, parameter :: ntrcaerm = 15 - - ! This will be set later in GFS_Control%initialize, since - ! it depends on the runtime config (Model%aero_in) - private :: ntrcaer - integer :: ntrcaer - - ! If these are changed to >99, need to adjust formatting string in GFS_diagnostics.F90 (and names in diag_tables) - 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) + use machine, only: kind_phys, kind_dbl_prec + use physcons, only: con_cp, con_fvirt, con_g, & + con_hvap, con_hfus, con_pi, con_rd, con_rv, & + con_t0c, con_cvap, con_cliq, con_eps, con_epsq, & + con_epsm1, con_ttp, rlapse, con_jcal, con_rhw0, & + con_sbc, con_tice, cimin, con_p0, rhowater, & + con_csol, con_epsqs, con_rocp, con_rog, & + con_omega, con_rerth, con_psat, karman, rainmin + + use module_radsw_parameters, only: topfsw_type, sfcfsw_type + use module_radlw_parameters, only: topflw_type, sfcflw_type + use ozne_def, only: levozp, oz_coeff + use h2o_def, only: levh2o, h2o_coeff + + implicit none + + ! To ensure that these values match what's in the physics, array + ! sizes are compared in the auto-generated physics caps in debug mode + ! from aerclm_def + integer, parameter, private :: ntrcaerm = 15 + + ! This will be set later in GFS_Control%initialize, since + ! it depends on the runtime config (Model%aero_in) + integer, private :: ntrcaer + + ! If these are changed to >99, need to adjust formatting string in GFS_diagnostics.F90 (and names in diag_tables) + 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 !! - !--- version of physics - character(len=64) :: phys_version = 'v2018 FV3GFS BETA VERSION PHYSICS' - - !--- parameter constants used for default initializations - real(kind=kind_phys), parameter :: zero = 0.0_kind_phys -! real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue - real(kind=kind_phys), parameter :: clear_val = zero - !real(kind=kind_phys), parameter :: clear_val = -9.9999e80 - real(kind=kind_phys), parameter :: rann_init = 0.6_kind_phys - real(kind=kind_phys), parameter :: cn_one = 1._kind_phys - real(kind=kind_phys), parameter :: cn_100 = 100._kind_phys - real(kind=kind_phys), parameter :: cn_th = 1000._kind_phys - real(kind=kind_phys), parameter :: cn_hr = 3600._kind_phys - - ! optional extra top layer on top of low ceiling models - ! this parameter was originally defined in the radiation driver - ! (and is still for standard non-CCPP builds), but is required - ! here for CCPP to allocate arrays used for the interstitial - ! calculations previously in GFS_{physics,radiation}_driver.F90 - ! LTP=0: no extra top layer - integer, parameter :: LTP = 0 ! no extra top layer - !integer, parameter :: LTP = 1 ! add an extra top layer + !--- version of physics + character(len=64) :: phys_version = 'v2021 UFS PHYSICS' + + !--- parameter constants used for default initializations + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + !real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue + real(kind=kind_phys), parameter :: clear_val = zero + !real(kind=kind_phys), parameter :: clear_val = -9.9999e80 + real(kind=kind_phys), parameter :: rann_init = 0.6_kind_phys + real(kind=kind_phys), parameter :: cn_one = 1._kind_phys + real(kind=kind_phys), parameter :: cn_100 = 100._kind_phys + real(kind=kind_phys), parameter :: cn_th = 1000._kind_phys + real(kind=kind_phys), parameter :: cn_hr = 3600._kind_phys + + ! optional extra top layer on top of low ceiling models + ! this parameter was originally defined in the radiation driver + ! (and is still for standard non-CCPP builds), but is required + ! here for CCPP to allocate arrays used for the interstitial + ! calculations previously in GFS_{physics,radiation}_driver.F90 + ! LTP=0: no extra top layer + integer, parameter :: LTP = 0 ! no extra top layer + !integer, parameter :: LTP = 1 ! add an extra top layer !---------------- ! Data Containers @@ -92,8 +78,7 @@ module GFS_typedefs ! GFS_cldprop_type !< cloud fields needed by radiation from physics ! GFS_radtend_type !< radiation tendencies needed in physics ! GFS_diag_type !< fields targetted for diagnostic output -! GFS_interstitial_type !< fields required to replace interstitial code in GFS_{physics,radiation}_driver.F90 in CCPP -! GFS_data_type !< combined type of all of the above except GFS_control_type and GFS_interstitial_type +! GFS_data_type !< combined type of all of the above except GFS_control_type !-------------------------------------------------------------------------------- ! GFS_init_type @@ -243,6 +228,9 @@ module GFS_typedefs real (kind=kind_phys), pointer :: snodi (:) => null() !< snow depth over ice real (kind=kind_phys), pointer :: weasdi (:) => null() !< weasd over ice real (kind=kind_phys), pointer :: hprime (:,:) => null() !< orographic metrics + real (kind=kind_phys), pointer :: dust12m_in (:,:,:) => null() !< fengsha dust input + real (kind=kind_phys), pointer :: emi_in (:,:) => null() !< anthropogenic background input + real (kind=kind_phys), pointer :: smoke_GBBEPx(:,:,:) => null() !< GBBEPx fire input real (kind=kind_phys), pointer :: z0base (:) => null() !< background or baseline surface roughness length in m real (kind=kind_phys), pointer :: semisbase(:) => null() !< background surface emissivity real (kind=kind_phys), pointer :: sfalb_lnd (:) => null() !< surface albedo over land for LSM @@ -291,6 +279,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: ffmm (:) => null() !< fm parameter from PBL scheme real (kind=kind_phys), pointer :: ffhh (:) => null() !< fh parameter from PBL scheme real (kind=kind_phys), pointer :: f10m (:) => null() !< fm at 10m - Ratio of sigma level 1 wind and 10m wind + real (kind=kind_phys), pointer :: rca (:) => null() !< canopy resistance real (kind=kind_phys), pointer :: tprcp (:) => null() !< sfc_fld%tprcp - total precipitation real (kind=kind_phys), pointer :: srflag (:) => null() !< sfc_fld%srflag - snow/rain flag for precipitation real (kind=kind_phys), pointer :: slc (:,:) => null() !< liquid soil moisture @@ -471,6 +460,12 @@ module GFS_typedefs ! real (kind=kind_phys), pointer :: zorlwav_cpl(:) => null() !< roughness length from wave model !--- also needed for ice/ocn coupling real (kind=kind_phys), pointer :: slimskin_cpl(:)=> null() !< aoi_fld%slimskin(item,lan) + !--- variables needed for use_med_flux =.TRUE. + real (kind=kind_phys), pointer :: dusfcin_med(:) => null() !< sfc u momentum flux over ocean + real (kind=kind_phys), pointer :: dvsfcin_med(:) => null() !< sfc v momentum flux over ocean + real (kind=kind_phys), pointer :: dtsfcin_med(:) => null() !< sfc latent heat flux over ocean + real (kind=kind_phys), pointer :: dqsfcin_med(:) => null() !< sfc sensible heat flux over ocean + real (kind=kind_phys), pointer :: ulwsfcin_med(:) => null() !< sfc upward lw flux over ocean !--- outgoing accumulated quantities real (kind=kind_phys), pointer :: rain_cpl (:) => null() !< total rain precipitation @@ -537,17 +532,56 @@ 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 real (kind=kind_phys), pointer :: nifa2d (:) => null() !< instantaneous ice-friendly sfc aerosol source + !--- aerosol surface emissions for Thompson microphysics & smoke + real (kind=kind_phys), pointer :: emdust (:) => null() !< instantaneous dust emission + real (kind=kind_phys), pointer :: emseas (:) => null() !< instantaneous sea salt emission + real (kind=kind_phys), pointer :: emanoc (:) => null() !< instantaneous anthro. oc emission + + !--- These 3 arrays are hourly, so their dimension is imx24 (output is hourly) + real (kind=kind_phys), pointer :: ebb_smoke_hr(:) => null() !< hourly smoke emission + real (kind=kind_phys), pointer :: frp_hr (:) => null() !< hourly FRP + real (kind=kind_phys), pointer :: frp_std_hr (:) => null() !< hourly std. FRP + + !--- For fire diurnal cycle + real (kind=kind_phys), pointer :: fhist (:) => null() !< instantaneous fire coef_bb + real (kind=kind_phys), pointer :: coef_bb_dc (:) => null() !< instantaneous fire coef_bb + real (kind=kind_phys), pointer :: ebu_smoke (:,:) => null() !< 3D ebu array + + !--- For smoke and dust optical extinction + real (kind=kind_phys), pointer :: smoke_ext (:,:) => null() !< 3D aod array + real (kind=kind_phys), pointer :: dust_ext (:,:) => null() !< 3D aod array + !--- For MYNN PBL transport of smoke and dust + real (kind=kind_phys), pointer :: chem3d (:,:,:) => null() !< 3D aod array + + !--- Fire plume rise diagnostics + real (kind=kind_phys), pointer :: min_fplume (:) => null() !< minimum plume rise level + real (kind=kind_phys), pointer :: max_fplume (:) => null() !< maximum plume rise level + !--- hourly fire potential index + real (kind=kind_phys), pointer :: rrfs_hwp (:) => null() !< hourly fire potential index + !--- instantaneous quantities for chemistry coupling real (kind=kind_phys), pointer :: ushfsfci(:) => null() !< instantaneous upward sensible heat flux (w/m**2) real (kind=kind_phys), pointer :: qci_conv(:,:) => null() !< convective cloud condesate after rainout real (kind=kind_phys), pointer :: pfi_lsan(:,:) => null() !< instantaneous 3D flux of ice nonconvective precipitation (kg m-2 s-1) real (kind=kind_phys), pointer :: pfl_lsan(:,:) => null() !< instantaneous 3D flux of liquid nonconvective precipitation (kg m-2 s-1) + !-- prognostic updraft area fraction coupling in convection + real (kind=kind_phys), pointer :: tmf (:,:) => null() !< tmf to be passed from turublence scheme to convection + real (kind=kind_phys), pointer :: dqdt_qmicro(:,:) => null() !< instantanious microphysics tendency to be passed from MP to convection + + !--- instantaneous total moisture tendency for smoke coupling: + real (kind=kind_phys), pointer :: dqdti (:,:) => null() !< rrfs_smoke=true only; instantaneous total moisture tendency (kg/kg/s) + contains procedure :: create => coupling_create !< allocate array data end type GFS_coupling_type @@ -638,10 +672,14 @@ module GFS_typedefs logical :: cplocn2atm !< default yes ocn->atm coupling logical :: cplwav !< default no cplwav collection logical :: cplwav2atm !< default no wav->atm coupling + logical :: cplaqm !< default no cplaqm collection logical :: cplchm !< default no cplchm collection + logical :: rrfs_smoke !< default no rrfs_smoke collection + integer :: dust_smoke_rrtmg_band_number !< band number to affect in rrtmg_pre from smoke and dust logical :: use_cice_alb !< default .false. - i.e. don't use albedo imported from the ice model logical :: cpl_imp_mrg !< default no merge import with internal forcings logical :: cpl_imp_dbg !< default no write import data to file post merge + logical :: use_med_flux !< default .false. - i.e. don't use atmosphere-ocean fluxes imported from mediator !--- integrated dynamics through earth's atmosphere logical :: lsidea @@ -735,6 +773,7 @@ module GFS_typedefs logical :: doG_cldoptics !< Use legacy RRTMG cloud-optics? logical :: doGP_cldoptics_PADE !< Use RRTMGP cloud-optics: PADE approximation? logical :: doGP_cldoptics_LUT !< Use RRTMGP cloud-optics: LUTs? + integer :: iovr_convcld !< Cloud-overlap assumption for convective-cloud integer :: rrtmgp_nrghice !< Number of ice-roughness categories integer :: rrtmgp_nGauss_ang !< Number of angles used in Gaussian quadrature logical :: do_GPsw_Glw !< If set to true use rrtmgp for SW calculation, rrtmg for LW. @@ -744,6 +783,8 @@ module GFS_typedefs real(kind_phys) :: lfnc_k !< Logistic function transition depth (Pa) real(kind_phys) :: lfnc_p0 !< Logistic function transition level (Pa) logical :: doGP_lwscat !< If true, include scattering in longwave cloud-optics, only compatible w/ GP cloud-optics + logical :: doGP_sgs_cnv !< If true, include SubGridScale convective cloud in RRTMGP + logical :: doGP_sgs_mynn !< If true, include SubGridScale MYNN-EDMF cloud in RRTMGP real(kind_phys) :: minGPpres !< Minimum pressure allowed in RRTMGP. real(kind_phys) :: maxGPpres !< Maximum pressure allowed in RRTMGP. real(kind_phys) :: minGPtemp !< Minimum temperature allowed in RRTMGP. @@ -777,6 +818,8 @@ module GFS_typedefs integer :: idcor_con = 0 !< choice for decorrelation-length: Use constant value integer :: idcor_hogan = 1 !< choice for decorrelation-length: (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) integer :: idcor_oreopoulos = 2 !< choice for decorrelation-length: (10.5194/acp-12-9097-2012) + integer :: imp_physics_nssl = 17 !< choice of NSSL microphysics scheme with background CCN + integer :: imp_physics_nssl2mccn = 18 !< choice of NSSL microphysics scheme with predicted CCN (compatibility) !--- Z-C microphysical parameters real(kind=kind_phys) :: psautco(2) !< [in] auto conversion coeff from ice to snow real(kind=kind_phys) :: prautco(2) !< [in] auto conversion coeff from cloud to rain @@ -802,6 +845,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 @@ -821,6 +873,14 @@ module GFS_typedefs real(kind=kind_phys) :: shoc_parm(5) !< critical pressure in Pa for tke dissipation in shoc integer :: ncnd !< number of cloud condensate types + !--- NSSL microphysics params + real(kind=kind_phys) :: nssl_cccn !< CCN concentration (m-3) + real(kind=kind_phys) :: nssl_alphah !< graupel shape parameter + real(kind=kind_phys) :: nssl_alphahl !< hail shape parameter + logical :: nssl_hail_on !< NSSL flag to activate the hail category + logical :: nssl_ccn_on !< NSSL flag to activate the CCN category + logical :: nssl_invertccn !< NSSL flag to treat CCN as activated (true) or unactivated (false) + !--- Thompson's microphysical parameters logical :: ltaerosol !< flag for aerosol version logical :: lradar !< flag for radar reflectivity @@ -867,9 +927,6 @@ module GFS_typedefs logical :: usemonalb !< flag to read surface diffused shortwave albedo from input file for NOAH LSM WRFv4 real(kind=kind_phys) :: aoasis !< potential evaporation multiplication factor for NOAH LSM WRFv4 integer :: fasdas !< flag to use "flux-adjusting surface data assimilation system"; 0 = OFF, 1 = ON - integer :: isurban !< vegetation/land use type corresponding to the urban environment for the chosen ivegsrc - integer :: isice !< vegetation/land use type corresponding to permanent ice/snow for the chosen ivegsrc - integer :: iswater !< vegetation/land use type corresponding to water bodies for the chosen ivegsrc integer :: iopt_thcnd !< option to treat thermal conductivity in Noah LSM (new in 3.8) !< = 1, original (default) !< = 2, McCumber and Pielke for silt loam and sandy loam @@ -887,6 +944,7 @@ module GFS_typedefs integer :: iopt_snf !rainfall & snowfall (1-jordan91; 2->bats; 3->noah) integer :: iopt_tbot !lower boundary of soil temperature (1->zero-flux; 2->noah) integer :: iopt_stc !snow/soil temperature time scheme (only layer 1) + integer :: iopt_trs !thermal roughness scheme (1-z0h=z0m; 2-czil; 3-ec;4-kb inversed) logical :: use_ufo !< flag for gcycle surface option @@ -967,6 +1025,7 @@ module GFS_typedefs integer :: imfshalcnv_gf = 3 !< flag for scale- & aerosol-aware Grell-Freitas scheme (GSD) integer :: imfshalcnv_ntiedtke = 4 !< flag for new Tiedtke scheme (CAPS) logical :: hwrf_samfdeep !< flag for HWRF SAMF deepcnv scheme (HWRF) + logical :: progsigma !< flag for prognostic area fraction in samf ddepcnv scheme (GFS) integer :: imfdeepcnv !< flag for mass-flux deep convection scheme !< 1: July 2010 version of SAS conv scheme !< current operational version as of 2016 @@ -1014,19 +1073,22 @@ module GFS_typedefs logical :: do_mynnedmf logical :: do_mynnsfclay ! DH* TODO - move this to MYNN namelist section - integer :: grav_settling !< flag for initalizing fist time step - integer :: bl_mynn_tkebudget !< flag for activating TKE budget + logical :: bl_mynn_tkebudget !< flag for activating TKE budget logical :: bl_mynn_tkeadvect !< activate computation of TKE advection (not yet in use for FV3) integer :: bl_mynn_cloudpdf !< flag to determine which cloud PDF to use integer :: bl_mynn_mixlength !< flag for different version of mixing length formulation integer :: bl_mynn_edmf !< flag to activate the mass-flux scheme integer :: bl_mynn_edmf_mom !< flag to activate the transport of momentum integer :: bl_mynn_edmf_tke !< flag to activate the transport of TKE - integer :: bl_mynn_edmf_part !< flag to partitioning og the MF and ED areas integer :: bl_mynn_cloudmix !< flag to activate mixing of cloud species integer :: bl_mynn_mixqt !< flag to mix total water or individual species integer :: bl_mynn_output !< flag to initialize and write out extra 3D arrays integer :: icloud_bl !< flag for coupling sgs clouds to radiation + real(kind=kind_phys) :: bl_mynn_closure !< flag to determine closure level of MYNN + logical :: sfclay_compute_flux!< flag for thermal roughness lengths over water in mynnsfclay + logical :: sfclay_compute_diag!< flag for computing surface diagnostics in mynnsfclay + integer :: isftcflx !< flag for thermal roughness lengths over water in mynnsfclay + integer :: iz0tlnd !< flag for thermal roughness lengths over land in mynnsfclay real(kind=kind_phys) :: var_ric real(kind=kind_phys) :: coef_ric_l real(kind=kind_phys) :: coef_ric_s @@ -1150,17 +1212,26 @@ module GFS_typedefs logical :: do_shum logical :: do_skeb integer :: skeb_npass - integer :: lndp_type + integer :: lndp_type ! integer indicating land perturbation scheme type: + ! 0 - none + ! 1 - scheme from Gehne et al, MWR, 2019. (Noah only, not maintained?) + ! 2 - scheme from Draper, JHM, 2021. real(kind=kind_phys) :: sppt_amp ! pjp cloud perturbations integer :: n_var_lndp - logical :: lndp_each_step ! flag to indicate that land perturbations are applied at every time step, - ! otherwise they are applied only after gcycle is run - character(len=3) , pointer :: lndp_var_list(:) ! dimension here must match n_var_max_lndp in stochy_nml_def - real(kind=kind_phys), pointer :: lndp_prt_list(:) ! dimension here must match n_var_max_lndp in stochy_nml_def - ! also previous code had dimension 5 for each pert, to allow - ! 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). + ! next two are duplicated here to support lndp_type=1. If delete that scheme, could remove from GFS defs? + character(len=3) , pointer :: lndp_var_list(:) + real(kind=kind_phys), pointer :: lndp_prt_list(:) + 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(:) + real(kind=kind_phys), pointer :: spp_prt_list(:) + real(kind=kind_phys), pointer :: spp_stddev_cutoff(:) + !--- tracer handling character(len=32), pointer :: tracer_names(:) !< array of initialized tracers from dynamic core integer :: ntrac !< number of tracers @@ -1197,6 +1268,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 @@ -1207,17 +1279,28 @@ module GFS_typedefs integer :: ntrw !< tracer index for rain water integer :: ntsw !< tracer index for snow water integer :: ntgl !< tracer index for graupel + integer :: nthl !< tracer index for hail integer :: ntclamt !< tracer index for cloud amount integer :: ntlnc !< tracer index for liquid number concentration integer :: ntinc !< tracer index for ice number concentration integer :: ntrnc !< tracer index for rain number concentration integer :: ntsnc !< tracer index for snow number concentration integer :: ntgnc !< tracer index for graupel number concentration - integer :: ntke !< tracer index for sgs kinetic energy + integer :: nthnc !< tracer index for hail number concentration + integer :: ntccn !< tracer index for CCN + integer :: ntccna !< tracer index for activated CCN + integer :: ntgv !< tracer index for graupel particle volume + integer :: nthv !< tracer index for hail particle volume + integer :: ntke !< tracer index for kinetic energy + integer :: ntsigma !< tracer index for updraft area fraction integer :: nto !< tracer index for oxygen ion integer :: nto2 !< tracer index for oxygen integer :: ntwa !< tracer index for water friendly aerosol integer :: ntia !< tracer index for ice friendly aerosol + integer :: ntsmoke !< tracer index for smoke + integer :: ntdust !< tracer index for dust + integer :: nchem !< number of prognostic chemical species (vertically mixied) + integer :: ndvel !< number of prognostic chemical species (which are deposited, usually =nchem) integer :: ntchm !< number of prognostic chemical tracers (advected) integer :: ntchs !< tracer index for first prognostic chemical tracer integer :: ntche !< tracer index for last prognostic chemical tracer @@ -1256,6 +1339,22 @@ module GFS_typedefs integer :: npsdelt !< the index of surface air pressure at the previous timestep for Z-C MP in phy_f2d integer :: ncnvwind !< the index of surface wind enhancement due to convection for MYNN SFC and RAS CNV in phy f2d +!-- chem nml variables for RRFS-Smoke + integer :: seas_opt + integer :: dust_opt + integer :: biomass_burn_opt + integer :: drydep_opt + integer :: wetdep_ls_opt + logical :: do_plumerise + integer :: addsmoke_flag + integer :: plumerisefire_frq + logical :: smoke_forecast + logical :: aero_ind_fdb ! WFA/IFA indirect + logical :: aero_dir_fdb ! smoke/dust direct + logical :: rrfs_smoke_debug + logical :: mix_chem + logical :: fire_turb + !--- debug flags logical :: debug logical :: pre_rad !< flag for testing purpose @@ -1279,6 +1378,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) @@ -1419,6 +1519,7 @@ module GFS_typedefs !--- Diagnostic that needs to be carried over to the next time step (removed from diag_type) real (kind=kind_phys), pointer :: hpbl (:) => null() !< Planetary boundary layer height + real (kind=kind_phys), pointer :: ud_mf (:,:) => null() !< updraft mass flux !--- dynamical forcing variables for Grell-Freitas convection real (kind=kind_phys), pointer :: forcet (:,:) => null() !< @@ -1435,6 +1536,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: QI_BL (:,:) => null() ! real (kind=kind_phys), pointer :: el_pbl (:,:) => null() ! real (kind=kind_phys), pointer :: Sh3D (:,:) => null() ! + real (kind=kind_phys), pointer :: Sm3D (:,:) => null() ! real (kind=kind_phys), pointer :: qke (:,:) => null() ! real (kind=kind_phys), pointer :: tsq (:,:) => null() ! real (kind=kind_phys), pointer :: qsq (:,:) => null() ! @@ -1454,6 +1556,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 @@ -1616,6 +1722,11 @@ module GFS_typedefs integer, pointer :: ktop_plume (:) => null() ! real (kind=kind_phys), pointer :: exch_h (:,:) => null() ! real (kind=kind_phys), pointer :: exch_m (:,:) => null() ! + real (kind=kind_phys), pointer :: dqke (:,:) => null() !< timestep change of tke + real (kind=kind_phys), pointer :: qwt (:,:) => null() !< vertical transport of tke + real (kind=kind_phys), pointer :: qshear (:,:) => null() !< shear production of tke + real (kind=kind_phys), pointer :: qbuoy (:,:) => null() !< buoyancy production of tke + real (kind=kind_phys), pointer :: qdiss (:,:) => null() !< dissipation of tke ! Output - only in physics real (kind=kind_phys), pointer :: u10m (:) => null() !< 10 meter u/v wind speed @@ -1650,8 +1761,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() ! null() ! extended diagnostic 3d output arrays from Thompson MP + ! Diagnostics for coupled air quality model + real (kind=kind_phys), pointer :: aod (:) => null() !< instantaneous aerosol optical depth ( n/a ) + ! Auxiliary output arrays for debugging real (kind=kind_phys), pointer :: aux2d(:,:) => null() !< auxiliary 2d arrays in output (for debugging) real (kind=kind_phys), pointer :: aux3d(:,:,:)=> null() !< auxiliary 2d arrays in output (for debugging) @@ -1801,400 +1914,9 @@ module GFS_typedefs procedure :: phys_zero => diag_phys_zero end type GFS_diag_type -!--------------------------------------------------------------------- -! GFS_interstitial_type -! fields required for interstitial code in CCPP schemes, previously -! in GFS_{physics,radiation}_driver.F90 -!--------------------------------------------------------------------- -!! \section arg_table_GFS_interstitial_type -!! \htmlinclude GFS_interstitial_type.html -!! - type GFS_interstitial_type - - real (kind=kind_phys), pointer :: adjsfculw_land(:) => null() !< - real (kind=kind_phys), pointer :: adjsfculw_ice(:) => null() !< - real (kind=kind_phys), pointer :: adjsfculw_water(:) => null() !< - real (kind=kind_phys), pointer :: adjnirbmd(:) => null() !< - real (kind=kind_phys), pointer :: adjnirbmu(:) => null() !< - real (kind=kind_phys), pointer :: adjnirdfd(:) => null() !< - real (kind=kind_phys), pointer :: adjnirdfu(:) => null() !< - real (kind=kind_phys), pointer :: adjvisbmd(:) => null() !< - real (kind=kind_phys), pointer :: adjvisbmu(:) => null() !< - real (kind=kind_phys), pointer :: adjvisdfu(:) => null() !< - real (kind=kind_phys), pointer :: adjvisdfd(:) => null() !< - real (kind=kind_phys), pointer :: aerodp(:,:) => null() !< - real (kind=kind_phys), pointer :: alb1d(:) => null() !< - real (kind=kind_phys), pointer :: alpha(:,:) => null() !< - real (kind=kind_phys), pointer :: bexp1d(:) => null() !< - real (kind=kind_phys), pointer :: cd(:) => null() !< - real (kind=kind_phys), pointer :: cd_ice(:) => null() !< - real (kind=kind_phys), pointer :: cd_land(:) => null() !< - real (kind=kind_phys), pointer :: cd_water(:) => null() !< - real (kind=kind_phys), pointer :: cdq(:) => null() !< - real (kind=kind_phys), pointer :: cdq_ice(:) => null() !< - real (kind=kind_phys), pointer :: cdq_land(:) => null() !< - real (kind=kind_phys), pointer :: cdq_water(:) => null() !< - real (kind=kind_phys), pointer :: cf_upi(:,:) => null() !< - real (kind=kind_phys), pointer :: chh_ice(:) => null() !< - real (kind=kind_phys), pointer :: chh_land(:) => null() !< - real (kind=kind_phys), pointer :: chh_water(:) => null() !< - real (kind=kind_phys), pointer :: clcn(:,:) => null() !< - real (kind=kind_phys), pointer :: cldf(:) => null() !< - real (kind=kind_phys), pointer :: cldsa(:,:) => null() !< - real (kind=kind_phys), pointer :: cldtaulw(:,:) => null() !< - real (kind=kind_phys), pointer :: cldtausw(:,:) => null() !< - real (kind=kind_phys), pointer :: cld1d(:) => null() !< - real (kind=kind_phys), pointer :: clouds(:,:,:) => null() !< - real (kind=kind_phys), pointer :: clw(:,:,:) => null() !< - real (kind=kind_phys), pointer :: clx(:,:) => null() !< - real (kind=kind_phys), pointer :: cmm_ice(:) => null() !< - real (kind=kind_phys), pointer :: cmm_land(:) => null() !< - real (kind=kind_phys), pointer :: cmm_water(:) => null() !< - real (kind=kind_phys), pointer :: cnv_dqldt(:,:) => null() !< - real (kind=kind_phys), pointer :: cnv_fice(:,:) => null() !< - real (kind=kind_phys), pointer :: cnv_mfd(:,:) => null() !< - real (kind=kind_phys), pointer :: cnv_ndrop(:,:) => null() !< - real (kind=kind_phys), pointer :: cnv_nice(:,:) => null() !< - real (kind=kind_phys), pointer :: cnvc(:,:) => null() !< - real (kind=kind_phys), pointer :: cnvw(:,:) => null() !< - real (kind=kind_phys), pointer :: ctei_r(:) => null() !< - real (kind=kind_phys), pointer :: ctei_rml(:) => null() !< - real (kind=kind_phys), pointer :: cumabs(:) => null() !< - real (kind=kind_phys), pointer :: dd_mf(:,:) => null() !< - real (kind=kind_phys), pointer :: de_lgth(:) => null() !< - real (kind=kind_phys), pointer :: del(:,:) => null() !< - real (kind=kind_phys), pointer :: del_gz(:,:) => null() !< - real (kind=kind_phys), pointer :: delr(:,:) => null() !< - real (kind=kind_phys), pointer :: dlength(:) => null() !< - real (kind=kind_phys), pointer :: dqdt(:,:,:) => null() !< - real (kind=kind_phys), pointer :: dqsfc1(:) => null() !< - real (kind=kind_phys), pointer :: drain(:) => null() !< - real (kind=kind_phys), pointer :: dtdt(:,:) => null() !< - real (kind=kind_phys), pointer :: dtsfc1(:) => null() !< - real (kind=kind_phys), pointer :: dtzm(:) => null() !< - real (kind=kind_phys), pointer :: dt_mf(:,:) => null() !< - real (kind=kind_phys), pointer :: dudt(:,:) => null() !< - real (kind=kind_phys), pointer :: dusfcg(:) => null() !< - real (kind=kind_phys), pointer :: dusfc1(:) => null() !< - real (kind=kind_phys), pointer :: dvdftra(:,:,:) => null() !< - real (kind=kind_phys), pointer :: dvdt(:,:) => null() !< - real (kind=kind_phys), pointer :: dvsfcg(:) => null() !< - real (kind=kind_phys), pointer :: dvsfc1(:) => null() !< - real (kind=kind_phys), pointer :: dzlyr(:,:) => null() !< - real (kind=kind_phys), pointer :: elvmax(:) => null() !< - real (kind=kind_phys), pointer :: ep1d(:) => null() !< - real (kind=kind_phys), pointer :: ep1d_ice(:) => null() !< - real (kind=kind_phys), pointer :: ep1d_land(:) => null() !< - real (kind=kind_phys), pointer :: ep1d_water(:) => null() !< - real (kind=kind_phys), pointer :: evap_ice(:) => null() !< - real (kind=kind_phys), pointer :: evap_land(:) => null() !< - real (kind=kind_phys), pointer :: evap_water(:) => null() !< - real (kind=kind_phys), pointer :: evbs(:) => null() !< - real (kind=kind_phys), pointer :: evcw(:) => null() !< - real (kind=kind_phys), pointer :: pah(:) => null() !< - real (kind=kind_phys), pointer :: ecan(:) => null() !< - real (kind=kind_phys), pointer :: etran(:) => null() !< - real (kind=kind_phys), pointer :: edir(:) => null() !< - real (kind=kind_phys), pointer :: faerlw(:,:,:,:) => null() !< - real (kind=kind_phys), pointer :: faersw(:,:,:,:) => null() !< - real (kind=kind_phys), pointer :: ffhh_ice(:) => null() !< - real (kind=kind_phys), pointer :: ffhh_land(:) => null() !< - real (kind=kind_phys), pointer :: ffhh_water(:) => null() !< - real (kind=kind_phys), pointer :: fh2(:) => null() !< - real (kind=kind_phys), pointer :: fh2_ice(:) => null() !< - real (kind=kind_phys), pointer :: fh2_land(:) => null() !< - real (kind=kind_phys), pointer :: fh2_water(:) => null() !< - logical, pointer :: flag_cice(:) => null() !< - logical, pointer :: flag_guess(:) => null() !< - logical, pointer :: flag_iter(:) => null() !< - real (kind=kind_phys), pointer :: ffmm_ice(:) => null() !< - real (kind=kind_phys), pointer :: ffmm_land(:) => null() !< - real (kind=kind_phys), pointer :: ffmm_water(:) => null() !< - real (kind=kind_phys), pointer :: fm10(:) => null() !< - real (kind=kind_phys), pointer :: fm10_ice(:) => null() !< - real (kind=kind_phys), pointer :: fm10_land(:) => null() !< - real (kind=kind_phys), pointer :: fm10_water(:) => null() !< - real (kind=kind_phys) :: frain !< - real (kind=kind_phys), pointer :: frland(:) => null() !< - real (kind=kind_phys), pointer :: fscav(:) => null() !< - real (kind=kind_phys), pointer :: fswtr(:) => null() !< - real (kind=kind_phys), pointer :: gabsbdlw(:) => null() !< - real (kind=kind_phys), pointer :: gabsbdlw_ice(:) => null() !< - real (kind=kind_phys), pointer :: gabsbdlw_land(:) => null() !< - real (kind=kind_phys), pointer :: gabsbdlw_water(:) => null() !< - real (kind=kind_phys), pointer :: gamma(:) => null() !< - real (kind=kind_phys), pointer :: gamq(:) => null() !< - real (kind=kind_phys), pointer :: gamt(:) => null() !< - real (kind=kind_phys), pointer :: gasvmr(:,:,:) => null() !< - real (kind=kind_phys), pointer :: gflx(:) => null() !< - real (kind=kind_phys), pointer :: gflx_ice(:) => null() !< - real (kind=kind_phys), pointer :: gflx_land(:) => null() !< - real (kind=kind_phys), pointer :: gflx_water(:) => null() !< - real (kind=kind_phys), pointer :: graupelmp(:) => null() !< - real (kind=kind_phys), pointer :: gwdcu(:,:) => null() !< - real (kind=kind_phys), pointer :: gwdcv(:,:) => null() !< - real (kind=kind_phys), pointer :: zvfun(:) => null() !< - real (kind=kind_phys), pointer :: hffac(:) => null() !< - real (kind=kind_phys), pointer :: hflxq(:) => null() !< - real (kind=kind_phys), pointer :: hflx_ice(:) => null() !< - real (kind=kind_phys), pointer :: hflx_land(:) => null() !< - real (kind=kind_phys), pointer :: hflx_water(:) => null() !< - !--- radiation variables that need to be carried over from radiation to physics - real (kind=kind_phys), pointer :: htlwc(:,:) => null() !< - real (kind=kind_phys), pointer :: htlw0(:,:) => null() !< - real (kind=kind_phys), pointer :: htswc(:,:) => null() !< - real (kind=kind_phys), pointer :: htsw0(:,:) => null() !< - ! - real (kind=kind_phys), pointer :: icemp(:) => null() !< - logical, pointer :: dry(:) => null() !< - integer, pointer :: idxday(:) => null() !< - logical, pointer :: icy(:) => null() !< - logical, pointer :: lake(:) => null() !< - logical, pointer :: use_flake(:) => null() !< - logical, pointer :: ocean(:) => null() !< - integer :: ipr !< - integer, pointer :: islmsk(:) => null() !< - integer, pointer :: islmsk_cice(:) => null() !< - integer :: itc !< - logical, pointer :: wet(:) => null() !< - integer :: kb !< - integer, pointer :: kbot(:) => null() !< - integer, pointer :: kcnv(:) => null() !< - integer :: kd !< - integer, pointer :: kinver(:) => null() !< - integer, pointer :: kpbl(:) => null() !< - integer :: kt !< - integer, pointer :: ktop(:) => null() !< - integer :: latidxprnt !< - integer :: levi !< - integer :: lmk !< - integer :: lmp !< - integer, pointer :: mbota(:,:) => null() !< - logical :: mg3_as_mg2 !< - integer, pointer :: mtopa(:,:) => null() !< - integer :: nbdlw !< - integer :: nbdsw !< - real (kind=kind_phys), pointer :: ncgl(:,:) => null() !< - real (kind=kind_phys), pointer :: ncpi(:,:) => null() !< - real (kind=kind_phys), pointer :: ncpl(:,:) => null() !< - real (kind=kind_phys), pointer :: ncpr(:,:) => null() !< - real (kind=kind_phys), pointer :: ncps(:,:) => null() !< - integer :: ncstrac !< - integer :: nday !< - integer :: nf_aelw !< - integer :: nf_aesw !< - integer :: nn !< - integer :: nsamftrac !< - integer :: nscav !< - integer :: nspc1 !< - integer :: ntcwx !< - integer :: ntiwx !< - integer :: ntrwx !< - integer :: ntk !< - integer :: ntkev !< - integer :: nvdiff !< - real (kind=kind_phys), pointer :: oa4(:,:) => null() !< - real (kind=kind_phys), pointer :: oc(:) => null() !< - real (kind=kind_phys), pointer :: olyr(:,:) => null() !< - logical , pointer :: otspt(:,:) => null() !< - integer :: oz_coeffp5 !< - logical :: phys_hydrostatic !< - real (kind=kind_phys), pointer :: plvl(:,:) => null() !< - real (kind=kind_phys), pointer :: plyr(:,:) => null() !< - real (kind=kind_phys), pointer :: prcpmp(:) => null() !< - real (kind=kind_phys), pointer :: prnum(:,:) => null() !< - real (kind=kind_phys), pointer :: q2mp(:) => null() !< - real (kind=kind_phys), pointer :: qgl(:,:) => null() !< - real (kind=kind_phys), pointer :: qicn(:,:) => null() !< - real (kind=kind_phys), pointer :: qlcn(:,:) => null() !< - real (kind=kind_phys), pointer :: qlyr(:,:) => null() !< - real (kind=kind_phys), pointer :: qrn(:,:) => null() !< - real (kind=kind_phys), pointer :: qsnw(:,:) => null() !< - real (kind=kind_phys), pointer :: qss_ice(:) => null() !< - real (kind=kind_phys), pointer :: qss_land(:) => null() !< - real (kind=kind_phys), pointer :: qss_water(:) => null() !< - logical :: radar_reset !< - real (kind=kind_phys) :: raddt !< - real (kind=kind_phys), pointer :: rainmp(:) => null() !< - real (kind=kind_phys), pointer :: raincd(:) => null() !< - real (kind=kind_phys), pointer :: raincs(:) => null() !< - real (kind=kind_phys), pointer :: rainmcadj(:) => null() !< - real (kind=kind_phys), pointer :: rainp(:,:) => null() !< - real (kind=kind_phys), pointer :: rb(:) => null() !< - real (kind=kind_phys), pointer :: rb_ice(:) => null() !< - real (kind=kind_phys), pointer :: rb_land(:) => null() !< - real (kind=kind_phys), pointer :: rb_water(:) => null() !< - logical :: max_hourly_reset !< - logical :: ext_diag_thompson_reset !< - real (kind=kind_phys), pointer :: rhc(:,:) => null() !< - real (kind=kind_phys), pointer :: runoff(:) => null() !< - real (kind=kind_phys), pointer :: save_q(:,:,:) => null() !< - real (kind=kind_phys), pointer :: save_t(:,:) => null() !< - real (kind=kind_phys), pointer :: save_tcp(:,:) => null() !< - real (kind=kind_phys), pointer :: save_u(:,:) => null() !< - real (kind=kind_phys), pointer :: save_v(:,:) => null() !< - real (kind=kind_phys), pointer :: sbsno(:) => null() !< - type (cmpfsw_type), pointer :: scmpsw(:) => null() !< - real (kind=kind_phys), pointer :: sfcalb(:,:) => null() !< - real (kind=kind_phys), pointer :: sigma(:) => null() !< - real (kind=kind_phys), pointer :: sigmaf(:) => null() !< - real (kind=kind_phys), pointer :: sigmafrac(:,:) => null() !< - real (kind=kind_phys), pointer :: sigmatot(:,:) => null() !< - logical :: skip_macro !< - real (kind=kind_phys), pointer :: snowc(:) => null() !< - real (kind=kind_phys), pointer :: snohf(:) => null() !< - real (kind=kind_phys), pointer :: snowmp(:) => null() !< - real (kind=kind_phys), pointer :: snowmt(:) => null() !< - real (kind=kind_phys), pointer :: stress(:) => null() !< - real (kind=kind_phys), pointer :: stress_ice(:) => null() !< - real (kind=kind_phys), pointer :: stress_land(:) => null() !< - real (kind=kind_phys), pointer :: stress_water(:) => null() !< - real (kind=kind_phys), pointer :: t2mmp(:) => null() !< - real (kind=kind_phys), pointer :: theta(:) => null() !< - real (kind=kind_phys), pointer :: tlvl(:,:) => null() !< - real (kind=kind_phys), pointer :: tlyr(:,:) => null() !< - real (kind=kind_phys), pointer :: tprcp_ice(:) => null() !< - real (kind=kind_phys), pointer :: tprcp_land(:) => null() !< - real (kind=kind_phys), pointer :: tprcp_water(:) => null() !< - integer :: tracers_start_index !< - integer :: tracers_total !< - integer :: tracers_water !< - logical :: trans_aero !< - real (kind=kind_phys), pointer :: trans(:) => null() !< - real (kind=kind_phys), pointer :: tseal(:) => null() !< - real (kind=kind_phys), pointer :: tsfa(:) => null() !< - real (kind=kind_phys), pointer :: tsfc_water(:) => null() !< - real (kind=kind_phys), pointer :: tsfg(:) => null() !< - real (kind=kind_phys), pointer :: tsurf_ice(:) => null() !< - real (kind=kind_phys), pointer :: tsurf_land(:) => null() !< - real (kind=kind_phys), pointer :: tsurf_water(:) => null() !< - real (kind=kind_phys), pointer :: ud_mf(:,:) => null() !< - real (kind=kind_phys), pointer :: uustar_ice(:) => null() !< - real (kind=kind_phys), pointer :: uustar_land(:) => null() !< - real (kind=kind_phys), pointer :: uustar_water(:) => null() !< - real (kind=kind_phys), pointer :: vdftra(:,:,:) => null() !< - real (kind=kind_phys), pointer :: vegf1d(:) => null() !< - real (kind=kind_phys) :: lndp_vgf !< - - real (kind=kind_phys), pointer :: w_upi(:,:) => null() !< - real (kind=kind_phys), pointer :: wcbmax(:) => null() !< - real (kind=kind_phys), pointer :: wind(:) => null() !< - real (kind=kind_phys), pointer :: work1(:) => null() !< - real (kind=kind_phys), pointer :: work2(:) => null() !< - real (kind=kind_phys), pointer :: work3(:) => null() !< - real (kind=kind_phys), pointer :: xcosz(:) => null() !< - real (kind=kind_phys), pointer :: xlai1d(:) => null() !< - real (kind=kind_phys), pointer :: xmu(:) => null() !< - real (kind=kind_phys), pointer :: z01d(:) => null() !< - real (kind=kind_phys), pointer :: zt1d(:) => null() !< - real (kind=kind_phys), pointer :: ztmax_ice(:) => null() !< - real (kind=kind_phys), pointer :: ztmax_land(:) => null() !< - real (kind=kind_phys), pointer :: ztmax_water(:) => null() !< -!================================================================================================== -! UGWP - five mechnanisms of momentum deposition due to various types of GWs -! (oss, ofd, obl, ogw) + ngw = sum( sso + ngw) -!================================================================================================== -! nGWs - real (kind=kind_phys), pointer :: dudt_ngw(:,:) => null() !< - real (kind=kind_phys), pointer :: dvdt_ngw(:,:) => null() !< - real (kind=kind_phys), pointer :: dtdt_ngw(:,:) => null() !< - real (kind=kind_phys), pointer :: kdis_ngw(:,:) => null() !< - - real (kind=kind_phys), pointer :: tau_oss(: ) => null() !< instantaneous momentum flux due to OSS - real (kind=kind_phys), pointer :: tau_tofd(:) => null() !< instantaneous momentum flux due to TOFD - real (kind=kind_phys), pointer :: tau_mtb(:) => null() !< instantaneous momentum of mountain blocking drag - real (kind=kind_phys), pointer :: tau_ogw(:) => null() !< instantaneous momentum flux of OGWs - real (kind=kind_phys), pointer :: tau_ngw(:) => null() !< instantaneous momentum flux of NGWs - - real (kind=kind_phys), pointer :: zngw(:) => null() !< launch levels of NGWs - real (kind=kind_phys), pointer :: zmtb(:) => null() !< mountain blocking height - real (kind=kind_phys), pointer :: zlwb(:) => null() !< low level wave breaking height - real (kind=kind_phys), pointer :: zogw(:) => null() !< height of OGW-launch - - real (kind=kind_phys), pointer :: dudt_mtb(:,:) => null() !< daily aver u-wind tend due to mountain blocking - real (kind=kind_phys), pointer :: dudt_tms(:,:) => null() !< daily aver u-wind tend due to TMS - - ! RRTMGP - real (kind=kind_phys), pointer :: p_lay(:,:) => null() !< - real (kind=kind_phys), pointer :: p_lev(:,:) => null() !< - real (kind=kind_phys), pointer :: t_lev(:,:) => null() !< - real (kind=kind_phys), pointer :: t_lay(:,:) => null() !< - real (kind=kind_phys), pointer :: relhum(:,:) => null() !< - real (kind=kind_phys), pointer :: tv_lay(:,:) => null() !< - real (kind=kind_phys), pointer :: qs_lay(:,:) => null() !< - real (kind=kind_phys), pointer :: q_lay(:,:) => null() !< - real (kind=kind_phys), pointer :: deltaZ(:,:) => null() !< - real (kind=kind_phys), pointer :: cloud_overlap_param(:,:) => null() !< Cloud overlap parameter - real (kind=kind_phys), pointer :: precip_overlap_param(:,:) => null() !< Precipitation overlap parameter - real (kind=kind_phys), pointer :: tracer(:,:,:) => null() !< - real (kind=kind_phys), pointer :: aerosolslw(:,:,:,:) => null() !< Aerosol radiative properties in each LW band. - real (kind=kind_phys), pointer :: aerosolssw(:,:,:,:) => null() !< Aerosol radiative properties in each SW band. - real (kind=kind_phys), pointer :: cld_frac(:,:) => null() !< Total cloud fraction - real (kind=kind_phys), pointer :: cld_lwp(:,:) => null() !< Cloud liquid water path - real (kind=kind_phys), pointer :: cld_reliq(:,:) => null() !< Cloud liquid effective radius - real (kind=kind_phys), pointer :: cld_iwp(:,:) => null() !< Cloud ice water path - real (kind=kind_phys), pointer :: cld_reice(:,:) => null() !< Cloud ice effecive radius - real (kind=kind_phys), pointer :: cld_swp(:,:) => null() !< Cloud snow water path - real (kind=kind_phys), pointer :: cld_resnow(:,:) => null() !< Cloud snow effective radius - real (kind=kind_phys), pointer :: cld_rwp(:,:) => null() !< Cloud rain water path - real (kind=kind_phys), pointer :: cld_rerain(:,:) => null() !< Cloud rain effective radius - real (kind=kind_phys), pointer :: precip_frac(:,:) => null() !< Precipitation fraction - real (kind=kind_phys), pointer :: fluxlwUP_allsky(:,:) => null() !< RRTMGP upward longwave all-sky flux profile - real (kind=kind_phys), pointer :: fluxlwDOWN_allsky(:,:) => null() !< RRTMGP downward longwave all-sky flux profile - real (kind=kind_phys), pointer :: fluxlwUP_clrsky(:,:) => null() !< RRTMGP upward longwave clr-sky flux profile - real (kind=kind_phys), pointer :: fluxlwDOWN_clrsky(:,:) => null() !< RRTMGP downward longwave clr-sky flux profile - real (kind=kind_phys), pointer :: fluxswUP_allsky(:,:) => null() !< RRTMGP upward shortwave all-sky flux profile - real (kind=kind_phys), pointer :: fluxswDOWN_allsky(:,:) => null() !< RRTMGP downward shortwave all-sky flux profile - real (kind=kind_phys), pointer :: fluxswUP_clrsky(:,:) => null() !< RRTMGP upward shortwave clr-sky flux profile - real (kind=kind_phys), pointer :: fluxswDOWN_clrsky(:,:) => null() !< RRTMGP downward shortwave clr-sky flux profile - real (kind=kind_phys), pointer :: sfc_emiss_byband(:,:) => null() !< - real (kind=kind_phys), pointer :: sec_diff_byband(:,:) => null() !< - real (kind=kind_phys), pointer :: sfc_alb_nir_dir(:,:) => null() !< - real (kind=kind_phys), pointer :: sfc_alb_nir_dif(:,:) => null() !< - real (kind=kind_phys), pointer :: sfc_alb_uvvis_dir(:,:) => null() !< - real (kind=kind_phys), pointer :: sfc_alb_uvvis_dif(:,:) => null() !< - real (kind=kind_phys), pointer :: toa_src_lw(:,:) => null() !< - real (kind=kind_phys), pointer :: toa_src_sw(:,:) => null() !< - type(proflw_type), pointer :: flxprf_lw(:,:) => null() !< DDT containing RRTMGP longwave fluxes - type(profsw_type), pointer :: flxprf_sw(:,:) => null() !< DDT containing RRTMGP shortwave fluxes - type(ty_optical_props_2str) :: lw_optical_props_cloudsByBand !< RRTMGP DDT - type(ty_optical_props_2str) :: lw_optical_props_clouds !< RRTMGP DDT - type(ty_optical_props_2str) :: lw_optical_props_precipByBand !< RRTMGP DDT - type(ty_optical_props_2str) :: lw_optical_props_precip !< RRTMGP DDT - type(ty_optical_props_1scl) :: lw_optical_props_clrsky !< RRTMGP DDT - type(ty_optical_props_1scl) :: lw_optical_props_aerosol !< RRTMGP DDT - type(ty_optical_props_2str) :: sw_optical_props_cloudsByBand !< RRTMGP DDT - type(ty_optical_props_2str) :: sw_optical_props_clouds !< RRTMGP DDT - type(ty_optical_props_2str) :: sw_optical_props_precipByBand !< RRTMGP DDT - type(ty_optical_props_2str) :: sw_optical_props_precip !< RRTMGP DDT - type(ty_optical_props_2str) :: sw_optical_props_clrsky !< RRTMGP DDT - type(ty_optical_props_2str) :: sw_optical_props_aerosol !< RRTMGP DDT - type(ty_gas_concs) :: gas_concentrations !< RRTMGP DDT - type(ty_source_func_lw) :: sources !< RRTMGP DDT - - !-- GSL drag suite - real (kind=kind_phys), pointer :: varss(:) => null() !< - real (kind=kind_phys), pointer :: ocss(:) => null() !< - real (kind=kind_phys), pointer :: oa4ss(:,:) => null() !< - real (kind=kind_phys), pointer :: clxss(:,:) => null() !< - - !-- 3D diagnostics - integer :: rtg_ozone_index, rtg_tke_index - - contains - procedure :: create => interstitial_create !< allocate array data - procedure :: rad_reset => interstitial_rad_reset !< reset array data for radiation - procedure :: phys_reset => interstitial_phys_reset !< reset array data for physics - - end type GFS_interstitial_type - -!------------------------- -! GFS sub-containers -!------------------------- - -!------------------------------------------------------------------------------------ -! combined type of all of the above except GFS_control_type and GFS_interstitial_type -!------------------------------------------------------------------------------------ +!---------------------------------------------------------- +! combined type of all of the above except GFS_control_type +!---------------------------------------------------------- !! \section arg_table_GFS_data_type !! \htmlinclude GFS_data_type.html !! @@ -2218,7 +1940,7 @@ module GFS_typedefs GFS_coupling_type public GFS_control_type, GFS_grid_type, GFS_tbd_type, & GFS_cldprop_type, GFS_radtend_type, GFS_diag_type - public GFS_interstitial_type, GFS_data_type + public GFS_data_type !******************************************************************************************* CONTAINS @@ -2341,6 +2063,9 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%snodi (IM)) allocate (Sfcprop%weasdi (IM)) allocate (Sfcprop%hprime (IM,Model%nmtvr)) + allocate (Sfcprop%dust12m_in (IM,12,5)) + allocate (Sfcprop%smoke_GBBEPx(IM,24,3)) + allocate (Sfcprop%emi_in (IM,1)) allocate(Sfcprop%albdirvis_lnd (IM)) allocate(Sfcprop%albdirnir_lnd (IM)) allocate(Sfcprop%albdifvis_lnd (IM)) @@ -2371,6 +2096,9 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%snodi = clear_val Sfcprop%weasdi = clear_val Sfcprop%hprime = clear_val + Sfcprop%dust12m_in= clear_val + Sfcprop%emi_in = clear_val + Sfcprop%smoke_GBBEPx = clear_val Sfcprop%albdirvis_lnd = clear_val Sfcprop%albdirnir_lnd = clear_val Sfcprop%albdifvis_lnd = clear_val @@ -2533,6 +2261,12 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%dt_cool = zero Sfcprop%qrain = zero endif + if (Model%lsm == Model%lsm_noah) then + allocate (Sfcprop%xlaixy (IM)) + allocate (Sfcprop%rca (IM)) + Sfcprop%xlaixy = clear_val + Sfcprop%rca = clear_val + end if if (Model%lsm == Model%lsm_ruc .or. Model%lsm == Model%lsm_noahmp) then allocate(Sfcprop%raincprv (IM)) allocate(Sfcprop%rainncprv (IM)) @@ -2834,6 +2568,21 @@ subroutine coupling_create (Coupling, IM, Model) ! Coupling%sfc_alb_vis_dir_cpl = clear_val ! Coupling%sfc_alb_vis_dif_cpl = clear_val + ! -- Coupling options to retrive atmosphere-ocean fluxes from mediator + if (Model%use_med_flux) then + allocate (Coupling%dusfcin_med (IM)) + allocate (Coupling%dvsfcin_med (IM)) + allocate (Coupling%dtsfcin_med (IM)) + allocate (Coupling%dqsfcin_med (IM)) + allocate (Coupling%ulwsfcin_med(IM)) + + Coupling%dusfcin_med = clear_val + Coupling%dvsfcin_med = clear_val + Coupling%dtsfcin_med = clear_val + Coupling%dqsfcin_med = clear_val + Coupling%ulwsfcin_med = clear_val + end if + !--- accumulated quantities allocate (Coupling%dusfc_cpl (IM)) allocate (Coupling%dvsfc_cpl (IM)) @@ -2938,7 +2687,7 @@ subroutine coupling_create (Coupling, IM, Model) endif ! -- Aerosols coupling options - if (Model%cplchm) then + if (Model%cplchm .or. Model%rrfs_smoke) then !--- outgoing instantaneous quantities allocate (Coupling%ushfsfci (IM)) !--- accumulated convective rainfall @@ -2952,6 +2701,31 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%pfl_lsan = clear_val endif + ! -- additional coupling options for air quality + if (Model%cplaqm .and. .not.Model%cplflx) then + !--- outgoing instantaneous quantities + allocate (Coupling%dtsfci_cpl (IM)) + allocate (Coupling%dqsfci_cpl (IM)) + allocate (Coupling%nswsfci_cpl (IM)) + allocate (Coupling%t2mi_cpl (IM)) + allocate (Coupling%q2mi_cpl (IM)) + allocate (Coupling%psurfi_cpl (IM)) + Coupling%dtsfci_cpl = clear_val + Coupling%dqsfci_cpl = clear_val + Coupling%nswsfci_cpl = clear_val + Coupling%t2mi_cpl = clear_val + Coupling%q2mi_cpl = clear_val + Coupling%psurfi_cpl = clear_val + endif + + !--prognostic closure - moisture coupling + if(Model%progsigma)then + allocate(Coupling%dqdt_qmicro (IM,Model%levs)) + allocate(Coupling%tmf (IM,Model%levs)) + Coupling%tmf = clear_val + Coupling%dqdt_qmicro = clear_val + endif + !--- stochastic physics option if (Model%do_sppt .or. Model%ca_global) then allocate (Coupling%sppt_wts (IM,Model%levs)) @@ -2972,12 +2746,26 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%skebu_wts = clear_val Coupling%skebv_wts = clear_val endif - + !--- stochastic land perturbation option if (Model%lndp_type /= 0) then allocate (Coupling%sfc_wts (IM,Model%n_var_lndp)) Coupling%sfc_wts = clear_val endif + + !--- stochastic spp perturbation option + if (Model%do_spp) then + allocate (Coupling%spp_wts_pbl (IM,Model%levs)) + Coupling%spp_wts_pbl = clear_val + allocate (Coupling%spp_wts_sfc (IM,Model%levs)) + Coupling%spp_wts_sfc = clear_val + allocate (Coupling%spp_wts_mp (IM,Model%levs)) + Coupling%spp_wts_mp = clear_val + allocate (Coupling%spp_wts_gwd (IM,Model%levs)) + Coupling%spp_wts_gwd = clear_val + allocate (Coupling%spp_wts_rad (IM,Model%levs)) + Coupling%spp_wts_rad = clear_val + endif !--- needed for Thompson's aerosol option if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then @@ -2987,6 +2775,42 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%nifa2d = clear_val endif + if(Model%rrfs_smoke) then + !--- needed for smoke aerosol option + allocate (Coupling%emdust (IM)) + allocate (Coupling%emseas (IM)) + allocate (Coupling%emanoc (IM)) + allocate (Coupling%ebb_smoke_hr (IM)) + allocate (Coupling%frp_hr (IM)) + allocate (Coupling%frp_std_hr(IM)) + allocate (Coupling%fhist (IM)) + allocate (Coupling%coef_bb_dc(IM)) + allocate (Coupling%ebu_smoke (IM,Model%levs)) + allocate (Coupling%smoke_ext (IM,Model%levs)) + allocate (Coupling%dust_ext (IM,Model%levs)) + allocate (Coupling%chem3d (IM,Model%levs,2)) + allocate (Coupling%min_fplume(IM)) + allocate (Coupling%max_fplume(IM)) + allocate (Coupling%rrfs_hwp (IM)) + allocate (Coupling%dqdti (IM,Model%levs)) + Coupling%emdust = clear_val + Coupling%emseas = clear_val + Coupling%emanoc = clear_val + Coupling%ebb_smoke_hr = clear_val + Coupling%frp_hr = clear_val + Coupling%frp_std_hr = clear_val + Coupling%fhist = 1. + Coupling%coef_bb_dc = clear_val + Coupling%ebu_smoke = clear_val + Coupling%smoke_ext = clear_val + Coupling%dust_ext = clear_val + Coupling%chem3d = clear_val + Coupling%min_fplume = clear_val + Coupling%max_fplume = clear_val + Coupling%rrfs_hwp = clear_val + Coupling%dqdti = clear_val + endif + if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then allocate (Coupling%qci_conv (IM,Model%levs)) Coupling%qci_conv = clear_val @@ -3081,10 +2905,14 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: cplocn2atm = .true. !< default yes cplocn2atm coupling (turn on the feedback from ocn to atm) logical :: cplwav = .false. !< default no cplwav collection logical :: cplwav2atm = .false. !< default no cplwav2atm coupling + logical :: cplaqm = .false. !< default no cplaqm collection logical :: cplchm = .false. !< default no cplchm collection + logical :: rrfs_smoke = .false. !< default no rrfs_smoke collection + integer :: dust_smoke_rrtmg_band_number = 10!< band number to affect in rrtmg_pre from smoke and dust logical :: use_cice_alb = .false. !< default no cice albedo logical :: cpl_imp_mrg = .false. !< default no merge import with internal forcings logical :: cpl_imp_dbg = .false. !< default no write import data to file post merge + logical :: use_med_flux = .false. !< default no atmosphere-ocean fluxes from mediator !--- integrated dynamics through earth's atmosphere logical :: lsidea = .false. @@ -3154,6 +2982,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: doG_cldoptics = .false. !< Use legacy RRTMG cloud-optics? logical :: doGP_cldoptics_PADE = .false. !< Use RRTMGP cloud-optics: PADE approximation? logical :: doGP_cldoptics_LUT = .false. !< Use RRTMGP cloud-optics: LUTs? + integer :: iovr_convcld = 1 !< Cloud-overlap assumption for convective-cloud (defaults to iovr if not set) integer :: rrtmgp_nrghice = 3 !< Number of ice-roughness categories integer :: rrtmgp_nGauss_ang = 1 !< Number of angles used in Gaussian quadrature logical :: do_GPsw_Glw = .false. @@ -3162,6 +2991,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: lfnc_k = -999 !< real(kind=kind_phys) :: lfnc_p0 = -999 !< logical :: doGP_lwscat = .false. !< If true, include scattering in longwave cloud-optics, only compatible w/ GP cloud-optics + logical :: doGP_sgs_cnv = .false. !< If true, include SubGridScale convective cloud in RRTMGP + logical :: doGP_sgs_mynn = .false. !< If true, include SubGridScale MYNN-EDMF cloud in RRTMGP !--- Z-C microphysical parameters integer :: imp_physics = 99 !< choice of cloud scheme real(kind=kind_phys) :: psautco(2) = (/6.0d-4,3.0d-4/) !< [in] auto conversion coeff from ice to snow @@ -3207,7 +3038,16 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: mg_do_hail = .false. !< set .true. to turn on prognostic hail (with fprcp=2) logical :: mg_do_ice_gmao = .false. !< set .true. to turn on gmao ice formulation logical :: mg_do_liq_liu = .true. !< set .true. to turn on liu liquid treatment + real(kind=kind_phys) :: fh_dfi_radar(1+dfi_radar_max_intervals) = -2e10 !< begin&end of four timespans over which radar_tten is applied + logical :: do_cap_suppress = .true. !< set .true. to turn on convection suppression in GF scheme during limited intervals when fh_dfi_radar is enabled + !--- NSSL microphysics params + real(kind=kind_phys) :: nssl_cccn = 0.6e9 !< CCN concentration (m-3) + real(kind=kind_phys) :: nssl_alphah = 0.0 !< graupel shape parameter + real(kind=kind_phys) :: nssl_alphahl = 1.0 !< hail shape parameter + logical :: nssl_hail_on = .false. !< NSSL flag to activate the hail category + logical :: nssl_ccn_on = .true. !< NSSL flag to activate the CCN category + logical :: nssl_invertccn = .true. !< NSSL flag to treat CCN as activated (true) or unactivated (false) !--- Thompson microphysical parameters logical :: ltaerosol = .false. !< flag for aerosol version @@ -3260,6 +3100,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: iopt_snf = 1 !rainfall & snowfall (1-jordan91; 2->bats; 3->noah) integer :: iopt_tbot = 2 !lower boundary of soil temperature (1->zero-flux; 2->noah) integer :: iopt_stc = 1 !snow/soil temperature time scheme (only layer 1) + integer :: iopt_trs = 2 !thermal roughness scheme (1-z0h=z0m; 2-czil; 3-ec;4-kb reversed) logical :: use_ufo = .false. !< flag for gcycle surface option @@ -3349,22 +3190,28 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: hwrf_samfdeep = .false. !< flag for HWRF SAMF deepcnv scheme logical :: hwrf_samfshal = .false. !< flag for HWRF SAMF shalcnv scheme + logical :: progsigma = .false. !< flag for prognostic updraft area fraction closure in saSAS logical :: do_mynnedmf = .false. !< flag for MYNN-EDMF logical :: do_mynnsfclay = .false. !< flag for MYNN Surface Layer Scheme ! DH* TODO - move to MYNN namelist section - integer :: grav_settling = 0 - integer :: bl_mynn_tkebudget = 0 + logical :: bl_mynn_tkebudget = .false. logical :: bl_mynn_tkeadvect = .false. integer :: bl_mynn_cloudpdf = 2 - integer :: bl_mynn_mixlength = 2 - integer :: bl_mynn_edmf = 0 + integer :: bl_mynn_mixlength = 1 + integer :: bl_mynn_edmf = 1 integer :: bl_mynn_edmf_mom = 1 integer :: bl_mynn_edmf_tke = 0 - integer :: bl_mynn_edmf_part = 0 integer :: bl_mynn_cloudmix = 1 integer :: bl_mynn_mixqt = 0 integer :: bl_mynn_output = 0 integer :: icloud_bl = 1 + real(kind=kind_phys) :: bl_mynn_closure = 2.6 !< <= 2.5 only prognose tke + !< 2.5 < and < 3.0, prognose tke and q'2 + !< >= 3.0, prognose tke, q'2, T'2, and T'q' + logical :: sfclay_compute_diag = .false. + logical :: sfclay_compute_flux = .false. + integer :: isftcflx = 0 + integer :: iz0tlnd = 0 real(kind=kind_phys) :: var_ric = 1.0 real(kind=kind_phys) :: coef_ric_l = 0.16 real(kind=kind_phys) :: coef_ric_s = 0.25 @@ -3403,12 +3250,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: ral_ts = 0.0d0 !< time scale for Rayleigh damping in days !--- mass flux deep convection -! real(kind=kind_phys) :: clam_deep = 0.1 !< c_e for deep convection (Han and Pan, 2011, eq(6)) - real(kind=kind_phys) :: clam_deep = 0.07 !< c_e for deep convection (Han and Pan, 2011, eq(6)) + real(kind=kind_phys) :: clam_deep = 0.1 !< c_e for deep convection (Han and Pan, 2011, eq(6)) real(kind=kind_phys) :: c0s_deep = 0.002 !< convective rain conversion parameter real(kind=kind_phys) :: c1_deep = 0.002 !< conversion parameter of detrainment from liquid water into grid-scale cloud water - real(kind=kind_phys) :: betal_deep = 0.01 !< fraction factor of downdraft air mass reaching ground surface over land - real(kind=kind_phys) :: betas_deep = 0.01 !< fraction factor of downdraft air mass reaching ground surface over sea + real(kind=kind_phys) :: betal_deep = 0.05 !< fraction factor of downdraft air mass reaching ground surface over land + real(kind=kind_phys) :: betas_deep = 0.05 !< fraction factor of downdraft air mass reaching ground surface over sea real(kind=kind_phys) :: evef = 0.09 !< evaporation factor from convective rain real(kind=kind_phys) :: evfact_deep = 0.3 !< evaporation factor from convective rain real(kind=kind_phys) :: evfactl_deep = 0.3 !< evaporation factor from convective rain over land @@ -3538,12 +3384,37 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: skeb_npass = 11 integer :: lndp_type = 0 integer :: n_var_lndp = 0 - logical :: lndp_each_step = .false. + integer :: n_var_spp = 0 + integer :: spp_pbl = 0 + integer :: spp_sfc = 0 + integer :: spp_mp = 0 + integer :: spp_rad = 0 + integer :: spp_gwd = 0 + logical :: do_spp = .false. + +!-- chem nml variables for RRFS-Smoke + integer :: seas_opt = 2 + integer :: dust_opt = 5 + integer :: biomass_burn_opt = 1 + integer :: drydep_opt = 1 + integer :: wetdep_ls_opt = 1 + logical :: do_plumerise = .false. + integer :: addsmoke_flag = 1 + integer :: plumerisefire_frq = 60 + logical :: smoke_forecast = .false. ! RRFS-smoke diurnal + logical :: aero_ind_fdb = .false. ! RRFS-smoke wfa/ifa emission + logical :: aero_dir_fdb = .false. ! RRFS-smoke smoke/dust radiation feedback + logical :: rrfs_smoke_debug = .false. ! RRFS-smoke plumerise debug + logical :: mix_chem = .false. ! tracer mixing option by MYNN PBL + logical :: fire_turb = .false. ! enh vertmix option by MYNN PBL !--- aerosol scavenging factors - integer, parameter :: max_scav_factors = 25 + integer, parameter :: max_scav_factors = 183 character(len=40) :: fscav_aero(max_scav_factors) + real(kind=kind_phys) :: radar_tten_limits(2) = (/ limit_unspecified, limit_unspecified /) + integer :: itime + !--- END NAMELIST VARIABLES NAMELIST /gfs_physics_nml/ & @@ -3552,15 +3423,15 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & naux3d, aux2d_time_avg, aux3d_time_avg, fhcyc, & thermodyn_id, sfcpress_id, & !--- coupling parameters - cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplchm, & - cpl_imp_mrg, cpl_imp_dbg, & - use_cice_alb, & + cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm, & + cplchm, cpl_imp_mrg, cpl_imp_dbg, rrfs_smoke, & + use_cice_alb, dust_smoke_rrtmg_band_number, & #ifdef IDEA_PHYS lsidea, weimer_model, f107_kp_size, f107_kp_interval, & f107_kp_skip_size, f107_kp_data_size, f107_kp_read_in_start, & ipe_to_wam_coupling, & #else - lsidea, & + lsidea, use_med_flux, & #endif !--- radiation parameters fhswr, fhlwr, levr, nfxr, iaerclm, iflip, isol, ico2, ialb, & @@ -3574,7 +3445,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & rrtmgp_nrghice, rrtmgp_nGauss_ang, do_GPsw_Glw, & use_LW_jacobian, doGP_lwscat, damp_LW_fluxadj, lfnc_k, & - lfnc_p0, & + lfnc_p0, iovr_convcld, doGP_sgs_cnv, doGP_sgs_mynn, & ! IN CCN forcing iccn, & !--- microphysical parameterizations @@ -3588,6 +3459,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ltaerosol, lradar, nsradar_reset, lrefres, ttendlim, & ext_diag_thompson, dt_inner, lgfdlmprad, & sedi_semi, decfl, & + nssl_cccn, nssl_alphah, nssl_alphahl, & + nssl_invertccn, nssl_hail_on, nssl_ccn_on, & !--- max hourly avg_max_length, & !--- land/surface model control @@ -3597,6 +3470,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! Noah MP options iopt_dveg,iopt_crs,iopt_btr,iopt_run,iopt_sfc, iopt_frz, & iopt_inf, iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc, & + iopt_trs, & ! GFDL surface layer options lcurr_sf, pert_cd, ntsflg, sfenth, & !--- lake model control @@ -3608,8 +3482,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & do_mynnedmf, do_mynnsfclay, & ! DH* TODO - move to MYNN namelist section bl_mynn_cloudpdf, bl_mynn_edmf, bl_mynn_edmf_mom, & - bl_mynn_edmf_tke, bl_mynn_edmf_part, bl_mynn_cloudmix, & + bl_mynn_edmf_tke, bl_mynn_mixlength, bl_mynn_cloudmix, & bl_mynn_mixqt, bl_mynn_output, icloud_bl, bl_mynn_tkeadvect, & + bl_mynn_closure, bl_mynn_tkebudget, & + isftcflx, iz0tlnd, sfclay_compute_flux, sfclay_compute_diag, & ! *DH gwd_opt, do_ugwp_v0, do_ugwp_v0_orog_only, & do_ugwp_v0_nst_only, & @@ -3617,7 +3493,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & do_ugwp_v1, do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, & var_ric, coef_ric_l, coef_ric_s, hurr_pbl, & do_myjsfc, do_myjpbl, & - hwrf_samfdeep, hwrf_samfshal, & + hwrf_samfdeep, hwrf_samfshal,progsigma, & h2o_phys, pdfcld, shcnvcw, redrag, hybedmf, satmedmf, & shinhong, do_ysu, dspheat, lheatstrg, lseaspray, cnvcld, & random_clds, shal_cnv, imfshalcnv, imfdeepcnv, isatmedmf, & @@ -3625,7 +3501,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & cs_parm, flgmin, cgwf, ccwf, cdmbgwd, sup, ctei_rm, crtrh, & dlqf, rbcr, shoc_parm, psauras, prauras, wminras, & do_sppt, do_shum, do_skeb, & - lndp_type, n_var_lndp, lndp_each_step, & + do_spp, n_var_spp, & + lndp_type, n_var_lndp, & pert_mp,pert_clds,pert_radtend, & !--- Rayleigh friction prslrd0, ral_ts, ldiag_ugwp, do_ugwp, do_tofd, & @@ -3664,7 +3541,15 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & max_lon, max_lat, min_lon, min_lat, rhcmax, huge, & phys_version, & !--- aerosol scavenging factors ('name:value' string array) - fscav_aero + fscav_aero, & + !--- RRFS smoke namelist + seas_opt, dust_opt, biomass_burn_opt, drydep_opt, & + wetdep_ls_opt, smoke_forecast, aero_ind_fdb, aero_dir_fdb, & + rrfs_smoke_debug, do_plumerise, plumerisefire_frq, & + addsmoke_flag, fire_turb, mix_chem, & + !--- (DFI) time ranges with radar-prescribed microphysics tendencies + ! and (maybe) convection suppression + fh_dfi_radar, radar_tten_limits, do_cap_suppress !--- other parameters integer :: nctp = 0 !< number of cloud types in CS scheme @@ -3738,48 +3623,56 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%flag_for_scnv_generic_tend = .true. Model%flag_for_dcnv_generic_tend = .true. + Model%fh_dfi_radar = fh_dfi_radar + Model%num_dfi_radar = 0 + Model%dfi_radar_max_intervals = dfi_radar_max_intervals ! module-level parameter, top of file + Model%dfi_radar_max_intervals_plus_one = dfi_radar_max_intervals + 1 + Model%do_cap_suppress = do_cap_suppress + + call control_initialize_radar_tten(Model, radar_tten_limits) + if(gwd_opt==1) then if(me==master) & - write(0,*) 'FLAG: gwd_opt==1 so gwd not generic' + write(*,*) 'FLAG: gwd_opt==1 so gwd not generic' Model%flag_for_gwd_generic_tend=.false. elseif(me==master) then - write(0,*) 'NO FLAG: gwd is generic' + write(*,*) 'NO FLAG: gwd is generic' endif if(satmedmf .and. isatmedmf==0) then if(me==master) & - write(0,*) 'FLAG: satmedmf and isatedmf=0 so pbl not generic' + write(*,*) 'FLAG: satmedmf and isatedmf=0 so pbl not generic' Model%flag_for_pbl_generic_tend=.false. elseif(satmedmf .and. isatmedmf==1) then if(me==master) & - write(0,*) 'FLAG: satmedmf and isatedmf=1 so pbl not generic' + write(*,*) 'FLAG: satmedmf and isatedmf=1 so pbl not generic' Model%flag_for_pbl_generic_tend=.false. else if(hybedmf) then if(me==master) & - write(0,*) 'FLAG: hybedmf so pbl not generic' + write(*,*) 'FLAG: hybedmf so pbl not generic' Model%flag_for_pbl_generic_tend=.false. else if(do_mynnedmf) then if(me==master) & - write(0,*) 'FLAG: do_mynnedmf so pbl not generic' + write(*,*) 'FLAG: do_mynnedmf so pbl not generic' Model%flag_for_pbl_generic_tend=.false. elseif(me==master) then - write(0,*) 'NO FLAG: pbl is generic' + write(*,*) 'NO FLAG: pbl is generic' endif if(imfshalcnv == Model%imfshalcnv_gf) then if(me==master) & - write(0,*) 'FLAG: imfshalcnv_gf so scnv not generic' + write(*,*) 'FLAG: imfshalcnv_gf so scnv not generic' Model%flag_for_scnv_generic_tend=.false. elseif(me==master) then - write(0,*) 'NO FLAG: scnv is generic' + write(*,*) 'NO FLAG: scnv is generic' endif if(imfdeepcnv == Model%imfdeepcnv_gf) then if(me==master) & - write(0,*) 'FLAG: imfdeepcnv_gf so dcnv not generic' + write(*,*) 'FLAG: imfdeepcnv_gf so dcnv not generic' Model%flag_for_dcnv_generic_tend=.false. elseif(me==master) then - write(0,*) 'NO FLAG: dcnv is generic' + write(*,*) 'NO FLAG: dcnv is generic' endif ! @@ -3851,10 +3744,30 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%cplocn2atm = cplocn2atm Model%cplwav = cplwav Model%cplwav2atm = cplwav2atm - Model%cplchm = cplchm + Model%cplaqm = cplaqm + Model%cplchm = cplchm .or. cplaqm Model%use_cice_alb = use_cice_alb Model%cpl_imp_mrg = cpl_imp_mrg Model%cpl_imp_dbg = cpl_imp_dbg + Model%use_med_flux = use_med_flux + +!--- RRFS Smoke + Model%rrfs_smoke = rrfs_smoke + Model%dust_smoke_rrtmg_band_number = dust_smoke_rrtmg_band_number + Model%seas_opt = seas_opt + Model%dust_opt = dust_opt + Model%biomass_burn_opt = biomass_burn_opt + Model%drydep_opt = drydep_opt + Model%wetdep_ls_opt = wetdep_ls_opt + Model%do_plumerise = do_plumerise + Model%plumerisefire_frq = plumerisefire_frq + Model%addsmoke_flag = addsmoke_flag + Model%smoke_forecast = smoke_forecast + Model%aero_ind_fdb = aero_ind_fdb + Model%aero_dir_fdb = aero_dir_fdb + Model%rrfs_smoke_debug = rrfs_smoke_debug + Model%mix_chem = mix_chem + Model%fire_turb = fire_turb !--- integrated dynamics through earth's atmosphere Model%lsidea = lsidea @@ -3897,6 +3810,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & if (levr < 0) then Model%levr = levs + else if (levr > levs) then + write(0,*) "Logic error, number of radiation levels (levr) cannot exceed number of model levels (levs)" + stop else Model%levr = levr endif @@ -3962,11 +3878,14 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%doG_cldoptics = doG_cldoptics Model%doGP_cldoptics_PADE = doGP_cldoptics_PADE Model%doGP_cldoptics_LUT = doGP_cldoptics_LUT + Model%iovr_convcld = iovr_convcld Model%use_LW_jacobian = use_LW_jacobian Model%damp_LW_fluxadj = damp_LW_fluxadj Model%lfnc_k = lfnc_k Model%lfnc_p0 = lfnc_p0 Model%doGP_lwscat = doGP_lwscat + Model%doGP_sgs_cnv = doGP_sgs_cnv + Model%doGP_sgs_mynn = doGP_sgs_mynn if (Model%do_RRTMGP) then ! RRTMGP incompatible with levr /= levs if (Model%levr /= Model%levs) then @@ -3978,6 +3897,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & write(0,*) "Logic error, RRTMGP Longwave cloud-scattering not supported with RRTMG cloud-optics." stop end if + if (Model%doGP_sgs_mynn .and. .not. do_mynnedmf) then + write(0,*) "Logic error, RRTMGP flag doGP_sgs_mynn only works with do_mynnedmf=.true." + stop + endif if (Model%doGP_cldoptics_PADE .and. Model%doGP_cldoptics_LUT) then write(0,*) "Logic error, Both RRTMGP cloud-optics options cannot be selected. " stop @@ -4051,6 +3974,14 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%tcr = tcr Model%tcrf = 1.0/(tcr-tf) +!-- NSSL microphysics params + Model%nssl_cccn = nssl_cccn + Model%nssl_alphah = nssl_alphah + Model%nssl_alphahl = nssl_alphahl + Model%nssl_hail_on = nssl_hail_on + Model%nssl_ccn_on = nssl_ccn_on + Model%nssl_invertccn = nssl_invertccn + !--- Thompson MP parameters Model%ltaerosol = ltaerosol Model%lradar = lradar @@ -4071,7 +4002,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- GFDL MP parameters Model%lgfdlmprad = lgfdlmprad -!--- Thompson,GFDL MP parameter +!--- Thompson,GFDL,NSSL MP parameter Model%lrefres = lrefres !--- land/surface model parameters @@ -4093,8 +4024,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & end if ! DH* TODO - need to clean up how different land surface models handle initializing zs and dzs ! For Noah and NoahMP, hardcode here for the moment; for RUC, these variables get initialized - ! in the RUC LSM init calls; for Noah WRF4, dzs gets initialized in sfc_noah_wrfv4_interstitial - ! init, and zs doesn't get used at all. + ! in the RUC LSM init calls. ! Allocate variables to store depth/thickness of soil layers allocate (Model%zs (Model%lsoil_lsm)) allocate (Model%dzs(Model%lsoil_lsm)) @@ -4155,9 +4085,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%lsnow_lsm_lbound = 0 Model%lsnow_lsm_ubound = 0 end if - Model%isurban = -999 !GJF isurban is only used in NOAH WRFv4 and is initialized in sfc_noah_GFS_interstitial.F90/sfc_noah_GFS_pre_init - Model%isice = -999 !GJF isice is only used in NOAH WRFv4 and is initialized in sfc_noah_GFS_interstitial.F90/sfc_noah_GFS_pre_init - Model%iswater = -999 !GJF iswater is only used in NOAH WRFv4 and is initialized in sfc_noah_GFS_interstitial.F90/sfc_noah_GFS_pre_init Model%iopt_thcnd = iopt_thcnd Model%ua_phys = ua_phys Model%usemonalb = usemonalb @@ -4190,6 +4117,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%iopt_snf = iopt_snf Model%iopt_tbot = iopt_tbot Model%iopt_stc = iopt_stc + Model%iopt_trs = iopt_trs !--- tuning parameters for physical parameterizations Model%ras = ras @@ -4220,6 +4148,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%hwrf_samfdeep = hwrf_samfdeep Model%hwrf_samfshal = hwrf_samfshal + if (progsigma .and. imfdeepcnv/=2) then + write(*,*) 'Logic error: progsigma requires imfdeepcnv=2' + stop + end if + Model%progsigma = progsigma + if (oz_phys .and. oz_phys_2015) then write(*,*) 'Logic error: can only use one ozone physics option (oz_phys or oz_phys_2015), not both. Exiting.' stop @@ -4286,10 +4220,14 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%bl_mynn_cloudmix = bl_mynn_cloudmix Model%bl_mynn_mixqt = bl_mynn_mixqt Model%bl_mynn_output = bl_mynn_output - Model%bl_mynn_edmf_part = bl_mynn_edmf_part Model%bl_mynn_tkeadvect = bl_mynn_tkeadvect - Model%grav_settling = grav_settling + Model%bl_mynn_closure = bl_mynn_closure + Model%bl_mynn_tkebudget = bl_mynn_tkebudget Model%icloud_bl = icloud_bl + Model%isftcflx = isftcflx + Model%iz0tlnd = iz0tlnd + Model%sfclay_compute_flux = sfclay_compute_flux + Model%sfclay_compute_diag = sfclay_compute_diag Model%var_ric = var_ric Model%coef_ric_l = coef_ric_l Model%coef_ric_s = coef_ric_s @@ -4401,13 +4339,25 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- stochastic surface perturbation options 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)) + allocate(Model%spp_stddev_cutoff(Model%n_var_spp)) + Model%spp_var_list(:) = '' + Model%spp_prt_list(:) = clear_val + Model%spp_stddev_cutoff(:) = clear_val + end if + !--- cellular automata options ! force namelist constsitency allocate(Model%vfact_ca(levs)) @@ -4471,16 +4421,25 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ntrw = get_tracer_index(Model%tracer_names, 'rainwat', Model%me, Model%master, Model%debug) Model%ntsw = get_tracer_index(Model%tracer_names, 'snowwat', Model%me, Model%master, Model%debug) Model%ntgl = get_tracer_index(Model%tracer_names, 'graupel', Model%me, Model%master, Model%debug) + Model%nthl = get_tracer_index(Model%tracer_names, 'hailwat', Model%me, Model%master, Model%debug) Model%ntclamt = get_tracer_index(Model%tracer_names, 'cld_amt', Model%me, Model%master, Model%debug) Model%ntlnc = get_tracer_index(Model%tracer_names, 'water_nc', Model%me, Model%master, Model%debug) Model%ntinc = get_tracer_index(Model%tracer_names, 'ice_nc', Model%me, Model%master, Model%debug) Model%ntrnc = get_tracer_index(Model%tracer_names, 'rain_nc', Model%me, Model%master, Model%debug) Model%ntsnc = get_tracer_index(Model%tracer_names, 'snow_nc', Model%me, Model%master, Model%debug) Model%ntgnc = get_tracer_index(Model%tracer_names, 'graupel_nc', Model%me, Model%master, Model%debug) + Model%nthnc = get_tracer_index(Model%tracer_names, 'hail_nc', Model%me, Model%master, Model%debug) + Model%ntccn = get_tracer_index(Model%tracer_names, 'ccn_nc', Model%me, Model%master, Model%debug) + Model%ntccna = get_tracer_index(Model%tracer_names, 'ccna_nc', Model%me, Model%master, Model%debug) + Model%ntgv = get_tracer_index(Model%tracer_names, 'graupel_vol',Model%me, Model%master, Model%debug) + Model%nthv = get_tracer_index(Model%tracer_names, 'hail_vol', Model%me, Model%master, Model%debug) Model%ntke = get_tracer_index(Model%tracer_names, 'sgs_tke', Model%me, Model%master, Model%debug) + Model%ntsigma = get_tracer_index(Model%tracer_names, 'sigmab', Model%me, Model%master, Model%debug) Model%nqrimef = get_tracer_index(Model%tracer_names, 'q_rimef', Model%me, Model%master, Model%debug) Model%ntwa = get_tracer_index(Model%tracer_names, 'liq_aero', Model%me, Model%master, Model%debug) Model%ntia = get_tracer_index(Model%tracer_names, 'ice_aero', Model%me, Model%master, Model%debug) + Model%ntsmoke = get_tracer_index(Model%tracer_names, 'smoke', Model%me, Model%master, Model%debug) + Model%ntdust = get_tracer_index(Model%tracer_names, 'dust', Model%me, Model%master, Model%debug) !--- initialize parameters for atmospheric chemistry tracers call Model%init_chemistry(tracer_types) @@ -4506,17 +4465,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)) @@ -4610,12 +4570,17 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & call label_dtend_tracer(Model,100+Model%ntrw,'rainwat','rain water','kg kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntsw,'snowwat','snow water','kg kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntgl,'graupel','graupel','kg kg-1 s-1') + call label_dtend_tracer(Model,100+Model%nthl,'hailwat','hail','kg kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntclamt,'cld_amt','cloud amount integer','kg kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntlnc,'water_nc','liquid number concentration','kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntinc,'ice_nc','ice number concentration','kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntrnc,'rain_nc','rain number concentration','kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntsnc,'snow_nc','snow number concentration','kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntgnc,'graupel_nc','graupel number concentration','kg-1 s-1') + call label_dtend_tracer(Model,100+Model%nthnc,'hail_nc','hail number concentration','kg-1 s-1') + call label_dtend_tracer(Model,100+Model%ntccn,'ccn_nc','CCN number concentration','kg-1 s-1') + call label_dtend_tracer(Model,100+Model%ntgv,'graupel_vol','graupel volume','m3 kg-1 s-1') + call label_dtend_tracer(Model,100+Model%nthv,'hail_vol','hail volume','m3 kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntke,'sgs_tke','turbulent kinetic energy','J s-1') call label_dtend_tracer(Model,100+Model%nqrimef,'q_rimef','mass weighted rime factor','kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntwa,'liq_aero','number concentration of water-friendly aerosols','kg-1 s-1') @@ -4631,6 +4596,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', & @@ -4648,6 +4614,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) @@ -4680,14 +4647,17 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & if(itrac==Model%ntchs) exit ! remaining tracers are chemical if ( itrac /= Model%ntcw .and. itrac /= Model%ntiw .and. itrac /= Model%ntclamt .and. & itrac /= Model%ntrw .and. itrac /= Model%ntsw .and. itrac /= Model%ntrnc .and. & - itrac /= Model%ntsnc .and. itrac /= Model%ntgl .and. itrac /= Model%ntgnc) then + itrac /= Model%ntsnc .and. itrac /= Model%ntgl .and. itrac /= Model%ntgnc .and. & + itrac /= Model%nthl .and. itrac /= Model%nthnc .and. itrac /= Model%nthv .and. & + itrac /= Model%ntgv ) then call fill_dtidx(Model,dtend_select,100+itrac,Model%index_of_process_scnv,have_scnv) call fill_dtidx(Model,dtend_select,100+itrac,Model%index_of_process_dcnv,have_dcnv) else if(Model%ntchs<=0 .or. itrac 1 ) THEN + IF (Model%me == Model%master) then + write(*,*) 'NSSL micro: error! CCN is OFF (nssl_ccn_on = F) but ntccn > 1.' + write(*,*) 'Should either remove ccn_nc from field_table or set nssl_ccn_on = .true.' + write(0,*) 'NSSL micro: error! CCN is OFF (nssl_ccn_on = F) but ntccn > 1.' + write(0,*) 'Should either remove ccn_nc from field_table or set nssl_ccn_on = .true.' + ENDIF + stop + ENDIF + Model%ntccn = -99 + Model%ntccna = -99 + ELSEIF ( Model%ntccn < 1 ) THEN + if (Model%me == Model%master) then + write(*,*) 'NSSL micro: error! CCN is ON but ntccn < 1. Must have ccn_nc in field_table if nssl_ccn_on=T' + write(0,*) 'NSSL micro: error! CCN is ON but ntccn < 1. Must have ccn_nc in field_table if nssl_ccn_on=T' + ENDIF + stop + ELSE + if (Model%me == Model%master) then + write(*,*) 'NSSL micro: CCN is ON' + ENDIF + IF ( Model%ntccna > 1 .and. Model%me == Model%master ) THEN + write(*,*) 'NSSL micro: CCNA is ON' + ENDIF + ENDIF + + if (Model%me == Model%master) then + write(*,*) 'Model%nthl = ',Model%nthl + ENDIF + IF ( ( Model%nthl < 1 ) ) THEN ! check if hail is in the field_table. If not, set flag so the microphysics knows. + if (Model%me == Model%master) then + write(*,*) 'NSSL micro: hail is OFF' + IF ( nssl_hail_on ) write(*,*) 'Namelist had nssl_hail_on=true, but tracer config does not have hailwat' + ENDIF + nssl_hail_on = .false. + Model%nssl_hail_on = .false. + ! pretend that hail exists so that bad arrays are not passed to microphysics +! Model%nthl = Max( 1, Model%ntgl ) +! Model%nthv = Max( 1, Model%ntgv ) +! Model%nthnc = Max( 1, Model%ntgnc ) + ELSE + nssl_hail_on = .true. + Model%nssl_hail_on = .true. + if (Model%me == Model%master) then + write(*,*) 'NSSL micro: hail is ON' + IF ( .not. nssl_hail_on ) write(*,*) 'Namelist had nssl_hail_on=false, but tracer config has hailwat' + ENDIF + IF ( Model%nthv < 1 .or. Model%nthnc < 1 ) THEN + if (Model%me == Model%master) THEN + write(0,*) 'missing needed tracers for NSSL hail! nthl > 1 but either volume or number is not in field_table' + write(0,*) 'nthv, nthnc = ', Model%nthv, Model%nthnc + ENDIF + stop + ENDIF + ENDIF + + Model%nssl_hail_on = nssl_hail_on + + IF ( ( Model%ntccn < 1 ) ) THEN ! check if ccn is in the field_table. If not, set flag so the microphysics knows. + if (Model%me == Model%master) then + write(*,*) 'NSSL micro: CCN is OFF' + ENDIF + nssl_ccn_on = .false. + Model%nssl_ccn_on = .false. + ELSE + nssl_ccn_on = .true. + Model%nssl_ccn_on = .true. + if (Model%me == Model%master) then + write(*,*) 'NSSL micro: CCN is ON' + ENDIF + ENDIF + + IF ( Model%ntgl < 1 .or. Model%ntgv < 1 .or. Model%ntgnc < 1 .or. & + Model%ntsw < 1 .or. Model%ntsnc < 1 .or. & + Model%ntrw < 1 .or. Model%ntrnc < 1 .or. & + Model%ntiw < 1 .or. Model%ntinc < 1 .or. & + Model%ntcw < 1 .or. Model%ntlnc < 1 & + ) THEN + if (Model%me == Model%master) write(0,*) 'missing needed tracers for NSSL!' + stop + ENDIF + + + ENDIF !} + ! To ensure that these values match what's in the physics, ! array sizes are compared during model init in GFS_phys_time_vary_init() ! @@ -4781,14 +4846,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. @@ -4858,9 +4924,19 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ' bl_mynn_cloudpdf=',Model%bl_mynn_cloudpdf, & ' bl_mynn_mixlength=',Model%bl_mynn_mixlength, & ' bl_mynn_edmf=',Model%bl_mynn_edmf, & - ' bl_mynn_output=',Model%bl_mynn_output + ' bl_mynn_output=',Model%bl_mynn_output, & + ' bl_mynn_closure=',Model%bl_mynn_closure endif + !--- mynn surface layer scheme + if (Model%do_mynnsfclay) then + if (Model%me == Model%master) print *,' MYNN surface layer scheme is used:', & + ' isftcflx=',Model%isftcflx, & + ' iz0tlnd=',Model%iz0tlnd, & + ' sfclay_compute_diag=',Model%sfclay_compute_diag, & + ' sfclay_compute_flux=',Model%sfclay_compute_flux + end if + !--- set number of cloud types if (Model%cscnv) then Model%nctp = nint(Model%cs_parm(5)) @@ -4902,6 +4978,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,'iopt_snf = ', Model%iopt_snf print *,'iopt_tbot = ',Model%iopt_tbot print *,'iopt_stc = ', Model%iopt_stc + print *,'iopt_trs = ', Model%iopt_trs elseif (Model%lsm == Model%lsm_ruc) then print *,' RUC Land Surface Model used' else @@ -5063,7 +5140,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 @@ -5080,7 +5156,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 @@ -5089,8 +5164,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 @@ -5110,19 +5183,50 @@ 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 !if (Model%me == Model%master) print *,' Using wsm6 microphysics' + elseif (Model%imp_physics == Model%imp_physics_nssl) then !NSSL microphysics + Model%npdf3d = 0 + Model%num_p3d = 4 ! for size of phy3d + Model%num_p2d = 1 + Model%pdfcld = .false. + Model%shcnvcw = .false. + IF ( Model%nssl_hail_on ) THEN + i = 1 + ELSE + i = 0 + ENDIF + if ( nwat /= 6+i ) then + print *,' NSSL MP requires nwat to be set to ', 6+i,' - job aborted, nssl_hail_on = ',nssl_hail_on + stop + end if + Model%nleffr = 1 + Model%nieffr = 2 + Model%nseffr = 3 + Model%nreffr = 4 + Model%lradar = .true. + if (.not. Model%effr_in) then + print *,' NSSL MP requires effr_in to be set to .true., changing value from false to true' + Model%effr_in = .true. + effr_in = .true. + ENDIF + if (Model%me == Model%master) print *,' Using NSSL double moment microphysics', & + ' nssl_ccn_on =',Model%nssl_ccn_on, & + ' nssl_invertccn =',Model%nssl_invertccn, & + ' lradar =',Model%lradar, & + ' num_p3d =',Model%num_p3d, & + ' num_p2d =',Model%num_p2d + + elseif (Model%imp_physics == Model%imp_physics_thompson) then !Thompson microphysics Model%npdf3d = 0 Model%num_p3d = 3 Model%num_p2d = 1 Model%pdfcld = .false. Model%shcnvcw = .false. -! Model%ncnd = 5 Model%nleffr = 1 Model%nieffr = 2 Model%nseffr = 3 @@ -5153,7 +5257,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 @@ -5166,16 +5269,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, & @@ -5212,7 +5305,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 @@ -5226,7 +5318,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 @@ -5268,7 +5360,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, & @@ -5312,6 +5404,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 @@ -5332,6 +5486,8 @@ subroutine control_chemistry_initialize(Model, tracer_types) integer :: n !--- begin + Model%nchem = 0 + Model%ndvel = 0 Model%ntchm = 0 Model%ntchs = NO_TRACER Model%ntche = NO_TRACER @@ -5339,6 +5495,11 @@ subroutine control_chemistry_initialize(Model, tracer_types) Model%ndchs = NO_TRACER Model%ndche = NO_TRACER + if (Model%rrfs_smoke) then + Model%nchem = 2 + Model%ndvel = 2 + endif + do n = 1, size(tracer_types) select case (tracer_types(n)) case (1) @@ -5420,6 +5581,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' @@ -5465,10 +5629,32 @@ subroutine control_print(Model) print *, ' cplocn2atm : ', Model%cplocn2atm print *, ' cplwav : ', Model%cplwav print *, ' cplwav2atm : ', Model%cplwav2atm + print *, ' cplaqm : ', Model%cplaqm print *, ' cplchm : ', Model%cplchm + print *, ' rrfs_smoke : ', Model%rrfs_smoke print *, ' use_cice_alb : ', Model%use_cice_alb print *, ' cpl_imp_mrg : ', Model%cpl_imp_mrg print *, ' cpl_imp_dbg : ', Model%cpl_imp_dbg + print *, ' use_med_flux : ', Model%use_med_flux + if(model%rrfs_smoke) then + print *, ' ' + print *, 'smoke parameters' + print *, 'dust_smoke_rrtmg_band_number : ',Model%dust_smoke_rrtmg_band_number + print *, 'seas_opt : ',Model%seas_opt + print *, 'dust_opt : ',Model%dust_opt + print *, 'biomass_burn_opt : ',Model%biomass_burn_opt + print *, 'drydep_opt : ',Model%drydep_opt + print *, 'wetdep_ls_opt : ',Model%wetdep_ls_opt + print *, 'do_plumerise : ',Model%do_plumerise + print *, 'plumerisefire_frq: ',Model%plumerisefire_frq + print *, 'addsmoke_flag : ',Model%addsmoke_flag + print *, 'smoke_forecast : ',Model%smoke_forecast + print *, 'aero_ind_fdb : ',Model%aero_ind_fdb + print *, 'aero_dir_fdb : ',Model%aero_dir_fdb + print *, 'rrfs_smoke_debug : ',Model%rrfs_smoke_debug + print *, 'mix_chem : ',Model%mix_chem + print *, 'fire_turb : ',Model%fire_turb + endif print *, ' ' print *, ' lsidea : ', Model%lsidea print *, ' ' @@ -5535,6 +5721,9 @@ subroutine control_print(Model) print *, ' lfnc_k : ', Model%lfnc_k print *, ' lfnc_p0 : ', Model%lfnc_p0 print *, ' doGP_lwscat : ', Model%doGP_lwscat + print *, ' doGP_sgs_cnv : ', Model%doGP_sgs_cnv + print *, ' doGP_sgs_mynn : ', Model%doGP_sgs_cnv + print *, ' iovr_convcld : ', Model%iovr_convcld endif print *, ' ' print *, 'microphysical switch' @@ -5562,6 +5751,15 @@ subroutine control_print(Model) print *, ' decfl : ', Model%decfl print *, ' ' endif + if (Model%imp_physics == Model%imp_physics_nssl) then + print *, ' NSSL microphysical parameters' + print *, ' nssl_cccn - CCCN background CCN conc. : ', Model%nssl_cccn + print *, ' nssl_alphah - graupel shape parameter : ', Model%nssl_alphah + print *, ' nssl_alphahl - hail shape parameter : ', Model%nssl_alphahl + print *, ' nssl_hail_on - hail activation flag : ', Model%nssl_hail_on + print *, ' lradar - radar refl. flag : ', Model%lradar + print *, ' lrefres : ', Model%lrefres + endif if (Model%imp_physics == Model%imp_physics_mg) then print *, ' M-G microphysical parameters' print *, ' fprcp : ', Model%fprcp @@ -5587,6 +5785,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 @@ -5625,6 +5835,7 @@ subroutine control_print(Model) print *, ' iopt_snf : ', Model%iopt_snf print *, ' iopt_tbot : ', Model%iopt_tbot print *, ' iopt_stc : ', Model%iopt_stc + print *, ' iopt_trs : ', Model%iopt_trs endif print *, ' use_ufo : ', Model%use_ufo print *, ' lcurr_sf : ', Model%lcurr_sf @@ -5773,7 +5984,8 @@ subroutine control_print(Model) print *, ' do_skeb : ', Model%do_skeb 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 @@ -5809,17 +6021,28 @@ subroutine control_print(Model) print *, ' ntrw : ', Model%ntrw print *, ' ntsw : ', Model%ntsw print *, ' ntgl : ', Model%ntgl + print *, ' nthl : ', Model%nthl print *, ' ntclamt : ', Model%ntclamt print *, ' ntlnc : ', Model%ntlnc print *, ' ntinc : ', Model%ntinc print *, ' ntrnc : ', Model%ntrnc print *, ' ntsnc : ', Model%ntsnc print *, ' ntgnc : ', Model%ntgnc + print *, ' nthnc : ', Model%nthnc + print *, ' ntccn : ', Model%ntccn + print *, ' ntccna : ', Model%ntccna + print *, ' ntgv : ', Model%ntgv + print *, ' nthv : ', Model%nthv print *, ' ntke : ', Model%ntke + print *, ' ntsigma : ', Model%ntsigma print *, ' nto : ', Model%nto print *, ' nto2 : ', Model%nto2 print *, ' ntwa : ', Model%ntwa print *, ' ntia : ', Model%ntia + print *, ' ntsmoke : ', Model%ntsmoke + print *, ' ntdust : ', Model%ntdust + print *, ' nchem : ', Model%nchem + print *, ' ndvel : ', Model%ndvel print *, ' ntchm : ', Model%ntchm print *, ' ntchs : ', Model%ntchs print *, ' ntche : ', Model%ntche @@ -5866,6 +6089,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 @@ -5966,6 +6190,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)) @@ -6039,15 +6276,24 @@ subroutine tbd_create (Tbd, IM, Model) allocate (Tbd%hpbl (IM)) Tbd%hpbl = clear_val + if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke .or. Model%imfdeepcnv == Model%imfdeepcnv_samf .or. Model%imfshalcnv == Model%imfshalcnv_samf) then + allocate(Tbd%prevsq(IM, Model%levs)) + Tbd%prevsq = clear_val + endif + + if (Model%imfdeepcnv .ge. 0 .or. Model%imfshalcnv .ge. 0) then + allocate(Tbd%ud_mf(IM, Model%levs)) + Tbd%ud_mf = zero + endif + if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke) then allocate(Tbd%forcet(IM, Model%levs)) allocate(Tbd%forceq(IM, Model%levs)) + allocate(Tbd%forcet(IM, Model%levs)) allocate(Tbd%prevst(IM, Model%levs)) - allocate(Tbd%prevsq(IM, Model%levs)) Tbd%forcet = clear_val Tbd%forceq = clear_val Tbd%prevst = clear_val - Tbd%prevsq = clear_val end if if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then @@ -6067,6 +6313,7 @@ subroutine tbd_create (Tbd, IM, Model) allocate (Tbd%qi_bl (IM,Model%levs)) allocate (Tbd%el_pbl (IM,Model%levs)) allocate (Tbd%sh3d (IM,Model%levs)) + allocate (Tbd%sm3d (IM,Model%levs)) allocate (Tbd%qke (IM,Model%levs)) allocate (Tbd%tsq (IM,Model%levs)) allocate (Tbd%qsq (IM,Model%levs)) @@ -6077,6 +6324,7 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%qi_bl = clear_val Tbd%el_pbl = clear_val Tbd%sh3d = clear_val + Tbd%sm3d = clear_val Tbd%qke = zero Tbd%tsq = clear_val Tbd%qsq = clear_val @@ -6643,6 +6891,13 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%det_thl (IM,Model%levs)) allocate (Diag%det_sqv (IM,Model%levs)) endif + if (Model%bl_mynn_tkebudget) then + allocate (Diag%dqke (IM,Model%levs)) + allocate (Diag%qwt (IM,Model%levs)) + allocate (Diag%qshear (IM,Model%levs)) + allocate (Diag%qbuoy (IM,Model%levs)) + allocate (Diag%qdiss (IM,Model%levs)) + endif allocate (Diag%nupdraft (IM)) allocate (Diag%maxmf (IM)) allocate (Diag%ktop_plume(IM)) @@ -6660,6 +6915,13 @@ subroutine diag_create (Diag, IM, Model) Diag%det_thl = clear_val Diag%det_sqv = clear_val endif + if (Model%bl_mynn_tkebudget) then + Diag%dqke = clear_val + Diag%qwt = clear_val + Diag%qshear = clear_val + Diag%qbuoy = clear_val + Diag%qdiss = clear_val + endif Diag%nupdraft = 0 Diag%maxmf = clear_val Diag%ktop_plume = 0 @@ -6673,6 +6935,13 @@ subroutine diag_create (Diag, IM, Model) Diag%thompson_ext_diag3d = clear_val endif + ! Air quality diagnostics + ! -- initialize diagnostic variables + if (Model%cplaqm) then + allocate (Diag%aod(IM)) + Diag%aod = zero + end if + ! Auxiliary arrays in output for debugging if (Model%naux2d>0) then allocate (Diag%aux2d(IM,Model%naux2d)) @@ -6794,6 +7063,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 @@ -6942,1005 +7212,4 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) end subroutine diag_phys_zero - !------------------------- - ! GFS_interstitial_type%create - !------------------------- - subroutine interstitial_create (Interstitial, IM, Model) - ! - implicit none - ! - class(GFS_interstitial_type) :: Interstitial - integer, intent(in) :: IM - type(GFS_control_type), intent(in) :: Model - integer :: iGas - ! - allocate (Interstitial%otspt (Model%ntracp1,2)) - ! Set up numbers of tracers for PBL, convection, etc: sets - ! Interstitial%{nvdiff,mg3_as_mg2,nn,tracers_total,ntcwx,ntiwx,ntk,ntkev,otspt,nsamftrac,ncstrac,nscav} - call interstitial_setup_tracers(Interstitial, Model) - ! Allocate arrays - allocate (Interstitial%adjsfculw_land (IM)) - allocate (Interstitial%adjsfculw_ice (IM)) - allocate (Interstitial%adjsfculw_water (IM)) - allocate (Interstitial%adjnirbmd (IM)) - allocate (Interstitial%adjnirbmu (IM)) - allocate (Interstitial%adjnirdfd (IM)) - allocate (Interstitial%adjnirdfu (IM)) - allocate (Interstitial%adjvisbmd (IM)) - allocate (Interstitial%adjvisbmu (IM)) - allocate (Interstitial%adjvisdfu (IM)) - allocate (Interstitial%adjvisdfd (IM)) - allocate (Interstitial%aerodp (IM,NSPC1)) - allocate (Interstitial%alb1d (IM)) - if (.not. Model%do_RRTMGP) then - ! RRTMGP uses its own cloud_overlap_param - allocate (Interstitial%alpha (IM,Model%levr+LTP)) - end if - allocate (Interstitial%bexp1d (IM)) - allocate (Interstitial%cd (IM)) - allocate (Interstitial%cd_ice (IM)) - allocate (Interstitial%cd_land (IM)) - allocate (Interstitial%cd_water (IM)) - allocate (Interstitial%cdq (IM)) - allocate (Interstitial%cdq_ice (IM)) - allocate (Interstitial%cdq_land (IM)) - allocate (Interstitial%cdq_water (IM)) - allocate (Interstitial%chh_ice (IM)) - allocate (Interstitial%chh_land (IM)) - allocate (Interstitial%chh_water (IM)) - allocate (Interstitial%cldf (IM)) - allocate (Interstitial%cldsa (IM,5)) - allocate (Interstitial%cldtaulw (IM,Model%levr+LTP)) - allocate (Interstitial%cldtausw (IM,Model%levr+LTP)) - allocate (Interstitial%cld1d (IM)) - allocate (Interstitial%clouds (IM,Model%levr+LTP,NF_CLDS)) - allocate (Interstitial%clw (IM,Model%levs,Interstitial%nn)) - allocate (Interstitial%clx (IM,4)) - allocate (Interstitial%cmm_ice (IM)) - allocate (Interstitial%cmm_land (IM)) - allocate (Interstitial%cmm_water (IM)) - allocate (Interstitial%cnvc (IM,Model%levs)) - allocate (Interstitial%cnvw (IM,Model%levs)) - allocate (Interstitial%ctei_r (IM)) - allocate (Interstitial%ctei_rml (IM)) - allocate (Interstitial%cumabs (IM)) - allocate (Interstitial%dd_mf (IM,Model%levs)) - allocate (Interstitial%de_lgth (IM)) - allocate (Interstitial%del (IM,Model%levs)) - allocate (Interstitial%del_gz (IM,Model%levs+1)) - allocate (Interstitial%delr (IM,Model%levr+LTP)) - allocate (Interstitial%dlength (IM)) - allocate (Interstitial%dqdt (IM,Model%levs,Model%ntrac)) - allocate (Interstitial%dqsfc1 (IM)) - allocate (Interstitial%drain (IM)) - allocate (Interstitial%dtdt (IM,Model%levs)) - allocate (Interstitial%dtsfc1 (IM)) - allocate (Interstitial%dt_mf (IM,Model%levs)) - allocate (Interstitial%dtzm (IM)) - allocate (Interstitial%dudt (IM,Model%levs)) - allocate (Interstitial%dusfcg (IM)) - allocate (Interstitial%dusfc1 (IM)) - allocate (Interstitial%dvdt (IM,Model%levs)) - allocate (Interstitial%dvsfcg (IM)) - allocate (Interstitial%dvsfc1 (IM)) - allocate (Interstitial%dvdftra (IM,Model%levs,Interstitial%nvdiff)) - allocate (Interstitial%dzlyr (IM,Model%levr+LTP)) - allocate (Interstitial%elvmax (IM)) - allocate (Interstitial%ep1d (IM)) - allocate (Interstitial%ep1d_ice (IM)) - allocate (Interstitial%ep1d_land (IM)) - allocate (Interstitial%ep1d_water (IM)) - allocate (Interstitial%evap_ice (IM)) - allocate (Interstitial%evap_land (IM)) - allocate (Interstitial%evap_water (IM)) - allocate (Interstitial%evbs (IM)) - allocate (Interstitial%evcw (IM)) - allocate (Interstitial%pah (IM)) - allocate (Interstitial%ecan (IM)) - allocate (Interstitial%etran (IM)) - allocate (Interstitial%edir (IM)) - allocate (Interstitial%faerlw (IM,Model%levr+LTP,NBDLW,NF_AELW)) - allocate (Interstitial%faersw (IM,Model%levr+LTP,NBDSW,NF_AESW)) - allocate (Interstitial%ffhh_ice (IM)) - allocate (Interstitial%ffhh_land (IM)) - allocate (Interstitial%ffhh_water (IM)) - allocate (Interstitial%fh2 (IM)) - allocate (Interstitial%fh2_ice (IM)) - allocate (Interstitial%fh2_land (IM)) - allocate (Interstitial%fh2_water (IM)) - allocate (Interstitial%flag_cice (IM)) - allocate (Interstitial%flag_guess (IM)) - allocate (Interstitial%flag_iter (IM)) - allocate (Interstitial%ffmm_ice (IM)) - allocate (Interstitial%ffmm_land (IM)) - allocate (Interstitial%ffmm_water (IM)) - allocate (Interstitial%fm10 (IM)) - allocate (Interstitial%fm10_ice (IM)) - allocate (Interstitial%fm10_land (IM)) - allocate (Interstitial%fm10_water (IM)) - allocate (Interstitial%frland (IM)) - allocate (Interstitial%fscav (Interstitial%nscav)) - allocate (Interstitial%fswtr (Interstitial%nscav)) - allocate (Interstitial%gabsbdlw (IM)) - allocate (Interstitial%gabsbdlw_ice (IM)) - allocate (Interstitial%gabsbdlw_land (IM)) - allocate (Interstitial%gabsbdlw_water (IM)) - allocate (Interstitial%gamma (IM)) - allocate (Interstitial%gamq (IM)) - allocate (Interstitial%gamt (IM)) - allocate (Interstitial%gasvmr (IM,Model%levr+LTP,NF_VGAS)) - allocate (Interstitial%gflx (IM)) - allocate (Interstitial%gflx_ice (IM)) - allocate (Interstitial%gflx_land (IM)) - allocate (Interstitial%gflx_water (IM)) - allocate (Interstitial%gwdcu (IM,Model%levs)) - allocate (Interstitial%gwdcv (IM,Model%levs)) - allocate (Interstitial%zvfun (IM)) - allocate (Interstitial%hffac (IM)) - allocate (Interstitial%hflxq (IM)) - allocate (Interstitial%hflx_ice (IM)) - allocate (Interstitial%hflx_land (IM)) - allocate (Interstitial%hflx_water (IM)) - allocate (Interstitial%htlwc (IM,Model%levr+LTP)) - allocate (Interstitial%htlw0 (IM,Model%levr+LTP)) - allocate (Interstitial%htswc (IM,Model%levr+LTP)) - allocate (Interstitial%htsw0 (IM,Model%levr+LTP)) - allocate (Interstitial%dry (IM)) - allocate (Interstitial%idxday (IM)) - allocate (Interstitial%icy (IM)) - allocate (Interstitial%lake (IM)) - allocate (Interstitial%use_flake (IM)) - allocate (Interstitial%ocean (IM)) - allocate (Interstitial%islmsk (IM)) - allocate (Interstitial%islmsk_cice (IM)) - allocate (Interstitial%wet (IM)) - allocate (Interstitial%kbot (IM)) - allocate (Interstitial%kcnv (IM)) - allocate (Interstitial%kinver (IM)) - allocate (Interstitial%kpbl (IM)) - allocate (Interstitial%ktop (IM)) - allocate (Interstitial%mbota (IM,3)) - allocate (Interstitial%mtopa (IM,3)) - allocate (Interstitial%oa4 (IM,4)) - allocate (Interstitial%oc (IM)) - allocate (Interstitial%olyr (IM,Model%levr+LTP)) - allocate (Interstitial%plvl (IM,Model%levr+1+LTP)) - allocate (Interstitial%plyr (IM,Model%levr+LTP)) - allocate (Interstitial%prnum (IM,Model%levs)) - allocate (Interstitial%qlyr (IM,Model%levr+LTP)) - allocate (Interstitial%prcpmp (IM)) - allocate (Interstitial%qss_ice (IM)) - allocate (Interstitial%qss_land (IM)) - allocate (Interstitial%qss_water (IM)) - allocate (Interstitial%raincd (IM)) - allocate (Interstitial%raincs (IM)) - allocate (Interstitial%rainmcadj (IM)) - allocate (Interstitial%rainp (IM,Model%levs)) - allocate (Interstitial%rb (IM)) - allocate (Interstitial%rb_ice (IM)) - allocate (Interstitial%rb_land (IM)) - allocate (Interstitial%rb_water (IM)) - allocate (Interstitial%rhc (IM,Model%levs)) - allocate (Interstitial%runoff (IM)) - allocate (Interstitial%save_q (IM,Model%levs,Model%ntrac)) - allocate (Interstitial%save_t (IM,Model%levs)) - allocate (Interstitial%save_tcp (IM,Model%levs)) - allocate (Interstitial%save_u (IM,Model%levs)) - allocate (Interstitial%save_v (IM,Model%levs)) - allocate (Interstitial%sbsno (IM)) - allocate (Interstitial%scmpsw (IM)) - allocate (Interstitial%sfcalb (IM,NF_ALBD)) - allocate (Interstitial%sigma (IM)) - allocate (Interstitial%sigmaf (IM)) - allocate (Interstitial%sigmafrac (IM,Model%levs)) - allocate (Interstitial%sigmatot (IM,Model%levs)) - allocate (Interstitial%snowc (IM)) - allocate (Interstitial%snohf (IM)) - allocate (Interstitial%snowmt (IM)) - allocate (Interstitial%stress (IM)) - allocate (Interstitial%stress_ice (IM)) - allocate (Interstitial%stress_land (IM)) - allocate (Interstitial%stress_water (IM)) - allocate (Interstitial%theta (IM)) - allocate (Interstitial%tlvl (IM,Model%levr+1+LTP)) - allocate (Interstitial%tlyr (IM,Model%levr+LTP)) - allocate (Interstitial%tprcp_ice (IM)) - allocate (Interstitial%tprcp_land (IM)) - allocate (Interstitial%tprcp_water (IM)) - allocate (Interstitial%trans (IM)) - allocate (Interstitial%tseal (IM)) - allocate (Interstitial%tsfa (IM)) - allocate (Interstitial%tsfc_water (IM)) - allocate (Interstitial%tsfg (IM)) - allocate (Interstitial%tsurf_ice (IM)) - allocate (Interstitial%tsurf_land (IM)) - allocate (Interstitial%tsurf_water (IM)) - allocate (Interstitial%ud_mf (IM,Model%levs)) - allocate (Interstitial%uustar_ice (IM)) - allocate (Interstitial%uustar_land (IM)) - allocate (Interstitial%uustar_water (IM)) - allocate (Interstitial%vdftra (IM,Model%levs,Interstitial%nvdiff)) !GJF first dimension was set as 'IX' in GFS_physics_driver - allocate (Interstitial%vegf1d (IM)) - allocate (Interstitial%wcbmax (IM)) - allocate (Interstitial%wind (IM)) - allocate (Interstitial%work1 (IM)) - allocate (Interstitial%work2 (IM)) - allocate (Interstitial%work3 (IM)) - allocate (Interstitial%xcosz (IM)) - allocate (Interstitial%xlai1d (IM)) - allocate (Interstitial%xmu (IM)) - allocate (Interstitial%z01d (IM)) - allocate (Interstitial%zt1d (IM)) - allocate (Interstitial%ztmax_ice (IM)) - allocate (Interstitial%ztmax_land (IM)) - allocate (Interstitial%ztmax_water (IM)) - - ! RRTMGP - if (Model%do_RRTMGP) then - allocate (Interstitial%tracer (IM, Model%levs,Model%ntrac)) - allocate (Interstitial%tv_lay (IM, Model%levs)) - allocate (Interstitial%relhum (IM, Model%levs)) - allocate (Interstitial%qs_lay (IM, Model%levs)) - allocate (Interstitial%q_lay (IM, Model%levs)) - allocate (Interstitial%deltaZ (IM, Model%levs)) - allocate (Interstitial%p_lev (IM, Model%levs+1)) - allocate (Interstitial%p_lay (IM, Model%levs)) - allocate (Interstitial%t_lev (IM, Model%levs+1)) - allocate (Interstitial%t_lay (IM, Model%levs)) - allocate (Interstitial%cloud_overlap_param (IM, Model%levs)) - allocate (Interstitial%precip_overlap_param (IM, Model%levs)) - allocate (Interstitial%fluxlwUP_allsky (IM, Model%levs+1)) - allocate (Interstitial%fluxlwDOWN_allsky (IM, Model%levs+1)) - allocate (Interstitial%fluxlwUP_clrsky (IM, Model%levs+1)) - allocate (Interstitial%fluxlwDOWN_clrsky (IM, Model%levs+1)) - allocate (Interstitial%fluxswUP_allsky (IM, Model%levs+1)) - allocate (Interstitial%fluxswDOWN_allsky (IM, Model%levs+1)) - allocate (Interstitial%fluxswUP_clrsky (IM, Model%levs+1)) - allocate (Interstitial%fluxswDOWN_clrsky (IM, Model%levs+1)) - allocate (Interstitial%aerosolslw (IM, Model%levs, Model%rrtmgp_nBandsLW, NF_AELW)) - allocate (Interstitial%aerosolssw (IM, Model%levs, Model%rrtmgp_nBandsSW, NF_AESW)) - allocate (Interstitial%cld_frac (IM, Model%levs)) - allocate (Interstitial%cld_lwp (IM, Model%levs)) - allocate (Interstitial%cld_reliq (IM, Model%levs)) - allocate (Interstitial%cld_iwp (IM, Model%levs)) - allocate (Interstitial%cld_reice (IM, Model%levs)) - allocate (Interstitial%cld_swp (IM, Model%levs)) - allocate (Interstitial%cld_resnow (IM, Model%levs)) - allocate (Interstitial%cld_rwp (IM, Model%levs)) - allocate (Interstitial%cld_rerain (IM, Model%levs)) - allocate (Interstitial%precip_frac (IM, Model%levs)) - allocate (Interstitial%flxprf_lw (IM, Model%levs+1)) - allocate (Interstitial%flxprf_sw (IM, Model%levs+1)) - allocate (Interstitial%sfc_emiss_byband (Model%rrtmgp_nBandsLW,IM)) - allocate (Interstitial%sec_diff_byband (Model%rrtmgp_nBandsLW,IM)) - allocate (Interstitial%sfc_alb_nir_dir (Model%rrtmgp_nBandsSW,IM)) - allocate (Interstitial%sfc_alb_nir_dif (Model%rrtmgp_nBandsSW,IM)) - allocate (Interstitial%sfc_alb_uvvis_dir (Model%rrtmgp_nBandsSW,IM)) - allocate (Interstitial%sfc_alb_uvvis_dif (Model%rrtmgp_nBandsSW,IM)) - allocate (Interstitial%toa_src_sw (IM,Model%rrtmgp_nGptsSW)) - allocate (Interstitial%toa_src_lw (IM,Model%rrtmgp_nGptsLW)) - ! - ! gas_concentrations (ty_gas_concs) - ! - Interstitial%gas_concentrations%ncol = IM - Interstitial%gas_concentrations%nlay = Model%levs - allocate(Interstitial%gas_concentrations%gas_name(Model%nGases)) - allocate(Interstitial%gas_concentrations%concs(Model%nGases)) - do iGas=1,Model%nGases - allocate(Interstitial%gas_concentrations%concs(iGas)%conc(IM, Model%levs)) - enddo - ! - ! lw_optical_props_clrsky (ty_optical_props_1scl) - ! - allocate(Interstitial%lw_optical_props_clrsky%tau( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%lw_optical_props_clrsky%band2gpt (2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_clrsky%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_clrsky%gpt2band( Model%rrtmgp_nGptsLW )) - ! - ! lw_optical_props_aerosol (ty_optical_props_1scl) - ! - allocate(Interstitial%lw_optical_props_aerosol%tau( IM, Model%levs, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_aerosol%band2gpt (2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_aerosol%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_aerosol%gpt2band( Model%rrtmgp_nBandsLW )) - ! - ! lw_optical_props_cloudsByBand (ty_optical_props_2str) - ! - allocate(Interstitial%lw_optical_props_cloudsByBand%tau(IM, Model%levs, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_cloudsByBand%ssa(IM, Model%levs, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_cloudsByBand%g( IM, Model%levs, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_cloudsByBand%band2gpt (2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_cloudsByBand%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_cloudsByBand%gpt2band( Model%rrtmgp_nBandsLW )) - ! - ! lw_optical_props_precipByBand (ty_optical_props_2str) - ! - allocate(Interstitial%lw_optical_props_precipByBand%tau(IM, Model%levs, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_precipByBand%ssa(IM, Model%levs, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_precipByBand%g( IM, Model%levs, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_precipByBand%band2gpt (2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_precipByBand%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_precipByBand%gpt2band( Model%rrtmgp_nBandsLW )) - ! - ! lw_optical_props_clouds (ty_optical_props_2str) - ! - allocate(Interstitial%lw_optical_props_clouds%tau( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%lw_optical_props_clouds%ssa( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%lw_optical_props_clouds%g( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%lw_optical_props_clouds%band2gpt (2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_clouds%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_clouds%gpt2band( Model%rrtmgp_nGptsLW )) - ! - ! lw_optical_props_precip (ty_optical_props_2str) - ! - allocate(Interstitial%lw_optical_props_precip%tau( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%lw_optical_props_precip%ssa( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%lw_optical_props_precip%g( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%lw_optical_props_precip%band2gpt (2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_precip%band_lims_wvn(2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%lw_optical_props_precip%gpt2band( Model%rrtmgp_nGptsLW )) - ! - ! sources (ty_source_func_lw) - ! - allocate(Interstitial%sources%sfc_source( IM, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%sources%lay_source( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%sources%lev_source_inc( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%sources%lev_source_dec( IM, Model%levs, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%sources%sfc_source_Jac( IM, Model%rrtmgp_nGptsLW )) - allocate(Interstitial%sources%band2gpt ( 2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%sources%band_lims_wvn ( 2, Model%rrtmgp_nBandsLW )) - allocate(Interstitial%sources%gpt2band( Model%rrtmgp_nGptsLW )) - end if - -! UGWP common - allocate (Interstitial%tau_mtb (IM)) - allocate (Interstitial%tau_ogw (IM)) - allocate (Interstitial%tau_tofd (IM)) - allocate (Interstitial%tau_ngw (IM)) - allocate (Interstitial%tau_oss (IM)) - allocate (Interstitial%dudt_mtb (IM,Model%levs)) - allocate (Interstitial%dudt_tms (IM,Model%levs)) - allocate (Interstitial%zmtb (IM) ) - allocate (Interstitial%zlwb (IM) ) - allocate (Interstitial%zogw (IM) ) - allocate (Interstitial%zngw (IM) ) - -! CIRES UGWP v1 - if (Model%do_ugwp_v1) then - allocate (Interstitial%dudt_ngw (IM,Model%levs)) - allocate (Interstitial%dvdt_ngw (IM,Model%levs)) - allocate (Interstitial%dtdt_ngw (IM,Model%levs)) - allocate (Interstitial%kdis_ngw (IM,Model%levs)) - end if - -!-- GSL drag suite - if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & - Model%gwd_opt==2 .or. Model%gwd_opt==22 ) then - allocate (Interstitial%varss (IM)) - allocate (Interstitial%ocss (IM)) - allocate (Interstitial%oa4ss (IM,4)) - allocate (Interstitial%clxss (IM,4)) - end if -! - ! Allocate arrays that are conditional on physics choices - if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then - allocate (Interstitial%graupelmp (IM)) - allocate (Interstitial%icemp (IM)) - allocate (Interstitial%rainmp (IM)) - allocate (Interstitial%snowmp (IM)) - else if (Model%imp_physics == Model%imp_physics_mg) then - allocate (Interstitial%ncgl (IM,Model%levs)) - allocate (Interstitial%ncpr (IM,Model%levs)) - allocate (Interstitial%ncps (IM,Model%levs)) - allocate (Interstitial%qgl (IM,Model%levs)) - allocate (Interstitial%qrn (IM,Model%levs)) - allocate (Interstitial%qsnw (IM,Model%levs)) - allocate (Interstitial%qlcn (IM,Model%levs)) - allocate (Interstitial%qicn (IM,Model%levs)) - allocate (Interstitial%w_upi (IM,Model%levs)) - allocate (Interstitial%cf_upi (IM,Model%levs)) - allocate (Interstitial%cnv_mfd (IM,Model%levs)) - allocate (Interstitial%cnv_dqldt (IM,Model%levs)) - allocate (Interstitial%clcn (IM,Model%levs)) - allocate (Interstitial%cnv_fice (IM,Model%levs)) - allocate (Interstitial%cnv_ndrop (IM,Model%levs)) - allocate (Interstitial%cnv_nice (IM,Model%levs)) - end if - if (Model%do_shoc) then - if (.not. associated(Interstitial%qrn)) allocate (Interstitial%qrn (IM,Model%levs)) - if (.not. associated(Interstitial%qsnw)) allocate (Interstitial%qsnw (IM,Model%levs)) - ! DH* updated version of shoc from May 22 2019 (not yet in CCPP) doesn't use qgl? remove? - if (.not. associated(Interstitial%qgl)) allocate (Interstitial%qgl (IM,Model%levs)) - ! *DH - allocate (Interstitial%ncpi (IM,Model%levs)) - allocate (Interstitial%ncpl (IM,Model%levs)) - end if - if (Model%lsm == Model%lsm_noahmp) then - allocate (Interstitial%t2mmp (IM)) - allocate (Interstitial%q2mp (IM)) - end if - ! - ! Set components that do not change - Interstitial%frain = Model%dtf/Model%dtp - Interstitial%ipr = min(IM,10) - Interstitial%latidxprnt = 1 - Interstitial%levi = Model%levs+1 - Interstitial%lmk = Model%levr+LTP - Interstitial%lmp = Model%levr+1+LTP - Interstitial%nbdlw = NBDLW - Interstitial%nbdsw = NBDSW - Interstitial%nf_aelw = NF_AELW - Interstitial%nf_aesw = NF_AESW - Interstitial%nspc1 = NSPC1 - if (Model%oz_phys .or. Model%oz_phys_2015) then - Interstitial%oz_coeffp5 = oz_coeff+5 - else - Interstitial%oz_coeffp5 = 5 - endif - ! - Interstitial%skip_macro = .false. - ! The value phys_hydrostatic from dynamics does not match the - ! hardcoded value for calling GFDL MP in GFS_physics_driver.F90, - ! which is set to .true. - Interstitial%phys_hydrostatic = .true. - ! - ! Reset all other variables - call Interstitial%rad_reset (Model) - call Interstitial%phys_reset (Model) - ! - end subroutine interstitial_create - - subroutine interstitial_setup_tracers(Interstitial, Model) - ! - implicit none - ! - class(GFS_interstitial_type) :: Interstitial - type(GFS_control_type), intent(in) :: Model - integer :: n, tracers - - !first, initialize the values (in case the values don't get initialized within if statements below) - Interstitial%nvdiff = Model%ntrac - Interstitial%mg3_as_mg2 = .false. - Interstitial%nn = Model%ntrac + 1 - Interstitial%itc = 0 - Interstitial%ntk = 0 - Interstitial%ntkev = 0 - Interstitial%tracers_total = 0 - Interstitial%otspt(:,:) = .true. - Interstitial%nsamftrac = 0 - Interstitial%ncstrac = 0 - Interstitial%ntcwx = 0 - Interstitial%ntiwx = 0 - Interstitial%ntrwx = 0 - - ! perform aerosol convective transport and PBL diffusion - Interstitial%trans_aero = Model%cplchm .and. Model%trans_trac - - if (Model%imp_physics == Model%imp_physics_thompson) then - if (Model%ltaerosol) then - Interstitial%nvdiff = 12 - else - Interstitial%nvdiff = 9 - endif - if (Model%satmedmf) Interstitial%nvdiff = Interstitial%nvdiff + 1 - elseif (Model%imp_physics == Model%imp_physics_wsm6) then - Interstitial%nvdiff = Model%ntrac -3 - if (Model%satmedmf) Interstitial%nvdiff = Interstitial%nvdiff + 1 - elseif (Model%ntclamt > 0) then ! for GFDL MP don't diffuse cloud amount - Interstitial%nvdiff = Model%ntrac - 1 - endif - - if (Model%imp_physics == Model%imp_physics_mg) then - if (abs(Model%fprcp) == 1) then - Interstitial%mg3_as_mg2 = .false. - elseif (Model%fprcp >= 2) then - if(Model%ntgl > 0 .and. (Model%mg_do_graupel .or. Model%mg_do_hail)) then - Interstitial%mg3_as_mg2 = .false. - else ! MG3 code run without graupel/hail i.e. as MG2 - Interstitial%mg3_as_mg2 = .true. - endif - endif - endif - - Interstitial%nscav = Model%ntrac - Model%ncnd + 2 - - if (Interstitial%nvdiff == Model%ntrac) then - Interstitial%ntcwx = Model%ntcw - Interstitial%ntiwx = Model%ntiw - Interstitial%ntrwx = Model%ntrw - else - if (Model%imp_physics == Model%imp_physics_wsm6) then - Interstitial%ntcwx = 2 - Interstitial%ntiwx = 3 - elseif (Model%imp_physics == Model%imp_physics_thompson) then - Interstitial%ntcwx = 2 - Interstitial%ntiwx = 3 - Interstitial%ntrwx = 4 - elseif (Model%imp_physics == Model%imp_physics_gfdl) then - Interstitial%ntcwx = 2 - Interstitial%ntiwx = 3 - Interstitial%ntrwx = 4 - ! F-A MP scheme - elseif (Model%imp_physics == Model%imp_physics_fer_hires) then - Interstitial%ntcwx = 2 - Interstitial%ntiwx = 3 - Interstitial%ntrwx = 4 - elseif (Model%imp_physics == Model%imp_physics_mg) then - Interstitial%ntcwx = 2 - Interstitial%ntiwx = 3 - Interstitial%ntrwx = 4 - elseif (Model%imp_physics == Model%imp_physics_zhao_carr) then - Interstitial%ntcwx = 2 - endif - 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. - if (Model%imp_physics == Model%imp_physics_zhao_carr) then - Interstitial%nvdiff = 3 - elseif (Model%imp_physics == Model%imp_physics_mg) then - if (Model%ntgl > 0) then - Interstitial%nvdiff = 12 - else - Interstitial%nvdiff = 10 - endif - elseif (Model%imp_physics == Model%imp_physics_gfdl) then - Interstitial%nvdiff = 7 - else - write(0,*) "Only Zhao/Carr/Sundqvist and GFDL microphysics schemes are supported when coupling with chemistry" - stop - endif - if (Interstitial%trans_aero) Interstitial%nvdiff = Interstitial%nvdiff + Model%ntchm - if (Model%ntke > 0) Interstitial%nvdiff = Interstitial%nvdiff + 1 ! adding tke to the list - endif - - if (Model%ntke > 0) Interstitial%ntkev = Interstitial%nvdiff - - if (Model%ntiw > 0) then - if (Model%ntclamt > 0) then - Interstitial%nn = Model%ntrac - 2 - else - Interstitial%nn = Model%ntrac - 1 - endif - elseif (Model%ntcw > 0) then - Interstitial%nn = Model%ntrac - else - Interstitial%nn = Model%ntrac + 1 - endif - - if (Model%cscnv .or. Model%satmedmf .or. Model%trans_trac ) then - Interstitial%otspt(:,:) = .true. ! otspt is used only for cscnv - Interstitial%otspt(1:3,:) = .false. ! this is for sp.hum, ice and liquid water - tracers = 2 - do n=2,Model%ntrac - if ( n /= Model%ntcw .and. n /= Model%ntiw .and. n /= Model%ntclamt .and. & - n /= Model%ntrw .and. n /= Model%ntsw .and. n /= Model%ntrnc .and. & - n /= Model%ntsnc .and. n /= Model%ntgl .and. n /= Model%ntgnc) then - tracers = tracers + 1 - if (Model%ntke == n ) then - Interstitial%otspt(tracers+1,1) = .false. - Interstitial%ntk = tracers - endif - if (Model%ntlnc == n .or. Model%ntinc == n .or. Model%ntrnc == n .or. Model%ntsnc == n .or. Model%ntgnc == n) & -! if (ntlnc == n .or. ntinc == n .or. ntrnc == n .or. ntsnc == n .or.& -! ntrw == n .or. ntsw == n .or. ntgl == n) & - Interstitial%otspt(tracers+1,1) = .false. - if (Interstitial%trans_aero .and. Model%ntchs == n) Interstitial%itc = tracers - endif - enddo - Interstitial%tracers_total = tracers - 2 - endif ! end if_ras or cfscnv or samf - if (.not. Model%satmedmf .and. .not. Model%trans_trac .and. & - .not. Model%ras .and. .not. Model%do_shoc) then - Interstitial%nsamftrac = 0 - else - Interstitial%nsamftrac = Interstitial%tracers_total - endif - Interstitial%ncstrac = Interstitial%tracers_total + 3 - - end subroutine interstitial_setup_tracers - - subroutine interstitial_rad_reset (Interstitial, Model) - ! - implicit none - ! - class(GFS_interstitial_type) :: Interstitial - type(GFS_control_type), intent(in) :: Model - integer :: iGas - ! - Interstitial%aerodp = clear_val - Interstitial%alb1d = clear_val - if (.not. Model%do_RRTMGP) then - Interstitial%alpha = clear_val - end if - Interstitial%cldsa = clear_val - Interstitial%cldtaulw = clear_val - Interstitial%cldtausw = clear_val - Interstitial%clouds = clear_val - Interstitial%de_lgth = clear_val - Interstitial%delr = clear_val - Interstitial%dzlyr = clear_val - Interstitial%faerlw = clear_val - Interstitial%faersw = clear_val - Interstitial%gasvmr = clear_val - Interstitial%htlwc = clear_val - Interstitial%htlw0 = clear_val - Interstitial%htswc = clear_val - Interstitial%htsw0 = clear_val - Interstitial%idxday = 0 - Interstitial%kb = 0 - Interstitial%kd = 0 - Interstitial%kt = 0 - Interstitial%mbota = 0 - Interstitial%mtopa = 0 - Interstitial%nday = 0 - Interstitial%olyr = clear_val - Interstitial%plvl = clear_val - Interstitial%plyr = clear_val - Interstitial%qlyr = clear_val - Interstitial%raddt = clear_val - Interstitial%sfcalb = clear_val - Interstitial%tlvl = clear_val - Interstitial%tlyr = clear_val - Interstitial%tsfa = clear_val - Interstitial%tsfg = clear_val - - ! Interstitials used by both RRTMG and RRTMGP - Interstitial%scmpsw%uvbfc = clear_val - Interstitial%scmpsw%uvbf0 = clear_val - Interstitial%scmpsw%nirbm = clear_val - Interstitial%scmpsw%nirdf = clear_val - Interstitial%scmpsw%visbm = clear_val - Interstitial%scmpsw%visdf = clear_val - if (Model%do_RRTMGP) then - Interstitial%tracer = clear_val - Interstitial%tv_lay = clear_val - Interstitial%relhum = clear_val - Interstitial%qs_lay = clear_val - Interstitial%q_lay = clear_val - Interstitial%deltaZ = clear_val - Interstitial%p_lev = clear_val - Interstitial%p_lay = clear_val - Interstitial%t_lev = clear_val - Interstitial%t_lay = clear_val - Interstitial%cloud_overlap_param = clear_val - Interstitial%precip_overlap_param = clear_val - Interstitial%fluxlwUP_allsky = clear_val - Interstitial%fluxlwDOWN_allsky = clear_val - Interstitial%fluxlwUP_clrsky = clear_val - Interstitial%fluxlwDOWN_clrsky = clear_val - Interstitial%fluxswUP_allsky = clear_val - Interstitial%fluxswDOWN_allsky = clear_val - Interstitial%fluxswUP_clrsky = clear_val - Interstitial%fluxswDOWN_clrsky = clear_val - Interstitial%aerosolslw = clear_val - Interstitial%aerosolssw = clear_val - Interstitial%cld_frac = clear_val - Interstitial%cld_lwp = clear_val - Interstitial%cld_reliq = clear_val - Interstitial%cld_iwp = clear_val - Interstitial%cld_reice = clear_val - Interstitial%cld_swp = clear_val - Interstitial%cld_resnow = clear_val - Interstitial%cld_rwp = clear_val - Interstitial%cld_rerain = clear_val - Interstitial%precip_frac = clear_val - Interstitial%sfc_emiss_byband = clear_val - Interstitial%sec_diff_byband = clear_val - Interstitial%sfc_alb_nir_dir = clear_val - Interstitial%sfc_alb_nir_dif = clear_val - Interstitial%sfc_alb_uvvis_dir = clear_val - Interstitial%sfc_alb_uvvis_dif = clear_val - Interstitial%toa_src_sw = clear_val - Interstitial%toa_src_lw = clear_val - do iGas=1,Model%nGases - Interstitial%gas_concentrations%concs(iGas)%conc = clear_val - end do - Interstitial%lw_optical_props_clrsky%tau = clear_val - Interstitial%lw_optical_props_aerosol%tau = clear_val - Interstitial%lw_optical_props_clouds%tau = clear_val - Interstitial%lw_optical_props_clouds%ssa = clear_val - Interstitial%lw_optical_props_clouds%g = clear_val - Interstitial%lw_optical_props_precip%tau = clear_val - Interstitial%lw_optical_props_precip%ssa = clear_val - Interstitial%lw_optical_props_precip%g = clear_val - Interstitial%lw_optical_props_cloudsByBand%tau = clear_val - Interstitial%lw_optical_props_cloudsByBand%ssa = clear_val - Interstitial%lw_optical_props_cloudsByBand%g = clear_val - Interstitial%lw_optical_props_precipByBand%tau = clear_val - Interstitial%lw_optical_props_precipByBand%ssa = clear_val - Interstitial%lw_optical_props_precipByBand%g = clear_val - Interstitial%sources%sfc_source = clear_val - Interstitial%sources%lay_source = clear_val - Interstitial%sources%lev_source_inc = clear_val - Interstitial%sources%lev_source_dec = clear_val - Interstitial%sources%sfc_source_Jac = clear_val - Interstitial%flxprf_lw%upfxc = clear_val - Interstitial%flxprf_lw%dnfxc = clear_val - Interstitial%flxprf_lw%upfx0 = clear_val - Interstitial%flxprf_lw%dnfx0 = clear_val - Interstitial%flxprf_sw%upfxc = clear_val - Interstitial%flxprf_sw%dnfxc = clear_val - Interstitial%flxprf_sw%upfx0 = clear_val - Interstitial%flxprf_sw%dnfx0 = clear_val - end if - ! - end subroutine interstitial_rad_reset - - subroutine interstitial_phys_reset (Interstitial, Model) - ! - implicit none - ! - class(GFS_interstitial_type) :: Interstitial - type(GFS_control_type), intent(in) :: Model - ! - Interstitial%adjsfculw_land = clear_val - Interstitial%adjsfculw_ice = clear_val - Interstitial%adjsfculw_water = clear_val - Interstitial%adjnirbmd = clear_val - Interstitial%adjnirbmu = clear_val - Interstitial%adjnirdfd = clear_val - Interstitial%adjnirdfu = clear_val - Interstitial%adjvisbmd = clear_val - Interstitial%adjvisbmu = clear_val - Interstitial%adjvisdfu = clear_val - Interstitial%adjvisdfd = clear_val - Interstitial%bexp1d = clear_val - Interstitial%cd = clear_val - Interstitial%cd_ice = Model%huge - Interstitial%cd_land = Model%huge - Interstitial%cd_water = Model%huge - Interstitial%cdq = clear_val - Interstitial%cdq_ice = Model%huge - Interstitial%cdq_land = Model%huge - Interstitial%cdq_water = Model%huge - Interstitial%chh_ice = Model%huge - Interstitial%chh_land = Model%huge - Interstitial%chh_water = Model%huge - Interstitial%cld1d = clear_val - Interstitial%cldf = clear_val - Interstitial%clw = clear_val - Interstitial%clw(:,:,2) = -999.9 - Interstitial%clx = clear_val - Interstitial%cmm_ice = Model%huge - Interstitial%cmm_land = Model%huge - Interstitial%cmm_water = Model%huge - Interstitial%cnvc = clear_val - Interstitial%cnvw = clear_val - Interstitial%ctei_r = clear_val - Interstitial%ctei_rml = clear_val - Interstitial%cumabs = clear_val - Interstitial%dd_mf = clear_val - Interstitial%del = clear_val - Interstitial%del_gz = clear_val - Interstitial%dlength = clear_val - Interstitial%dqdt = clear_val - Interstitial%dqsfc1 = clear_val - Interstitial%drain = clear_val - Interstitial%dt_mf = clear_val - Interstitial%dtdt = clear_val - Interstitial%dtsfc1 = clear_val - Interstitial%dtzm = clear_val - Interstitial%dudt = clear_val - Interstitial%dusfcg = clear_val - Interstitial%dusfc1 = clear_val - Interstitial%dvdftra = clear_val - Interstitial%dvdt = clear_val - Interstitial%dvsfcg = clear_val - Interstitial%dvsfc1 = clear_val - Interstitial%elvmax = clear_val - Interstitial%ep1d = clear_val - Interstitial%ep1d_ice = Model%huge - Interstitial%ep1d_land = Model%huge - Interstitial%ep1d_water = Model%huge - Interstitial%evap_ice = Model%huge - Interstitial%evap_land = Model%huge - Interstitial%evap_water = Model%huge - Interstitial%evbs = clear_val - Interstitial%evcw = clear_val - Interstitial%pah = clear_val - Interstitial%ecan = clear_val - Interstitial%etran = clear_val - Interstitial%edir = clear_val - Interstitial%ffhh_ice = Model%huge - Interstitial%ffhh_land = Model%huge - Interstitial%ffhh_water = Model%huge - Interstitial%fh2 = clear_val - Interstitial%fh2_ice = Model%huge - Interstitial%fh2_land = Model%huge - Interstitial%fh2_water = Model%huge - Interstitial%flag_cice = .false. - Interstitial%flag_guess = .false. - Interstitial%flag_iter = .true. - Interstitial%ffmm_ice = Model%huge - Interstitial%ffmm_land = Model%huge - Interstitial%ffmm_water = Model%huge - Interstitial%fm10 = clear_val - Interstitial%fm10_ice = Model%huge - Interstitial%fm10_land = Model%huge - Interstitial%fm10_water = Model%huge - Interstitial%frland = clear_val - Interstitial%fscav = clear_val - Interstitial%fswtr = clear_val - Interstitial%gabsbdlw = clear_val - Interstitial%gabsbdlw_ice = clear_val - Interstitial%gabsbdlw_land = clear_val - Interstitial%gabsbdlw_water = clear_val - Interstitial%gamma = clear_val - Interstitial%gamq = clear_val - Interstitial%gamt = clear_val - Interstitial%gflx = clear_val - Interstitial%gflx_ice = clear_val - Interstitial%gflx_land = clear_val - Interstitial%gflx_water = clear_val - Interstitial%gwdcu = clear_val - Interstitial%gwdcv = clear_val - Interstitial%zvfun = clear_val - Interstitial%hffac = clear_val - Interstitial%hflxq = clear_val - Interstitial%hflx_ice = Model%huge - Interstitial%hflx_land = Model%huge - Interstitial%hflx_water = Model%huge - Interstitial%dry = .false. - Interstitial%icy = .false. - Interstitial%lake = .false. - Interstitial%use_flake = .false. - Interstitial%ocean = .false. - Interstitial%islmsk = 0 - Interstitial%islmsk_cice = 0 - Interstitial%wet = .false. - Interstitial%kbot = Model%levs - Interstitial%kcnv = 0 - Interstitial%kinver = Model%levs - Interstitial%kpbl = 0 - Interstitial%ktop = 1 - Interstitial%oa4 = clear_val - Interstitial%oc = clear_val - Interstitial%prcpmp = clear_val - Interstitial%prnum = clear_val - Interstitial%qss_ice = Model%huge - Interstitial%qss_land = Model%huge - Interstitial%qss_water = Model%huge - Interstitial%raincd = clear_val - Interstitial%raincs = clear_val - Interstitial%rainmcadj = clear_val - Interstitial%rainp = clear_val - Interstitial%rb = clear_val - Interstitial%rb_ice = Model%huge - Interstitial%rb_land = Model%huge - Interstitial%rb_water = Model%huge - Interstitial%rhc = clear_val - Interstitial%runoff = clear_val - Interstitial%save_q = clear_val - Interstitial%save_t = clear_val - Interstitial%save_tcp = clear_val - Interstitial%save_u = clear_val - Interstitial%save_v = clear_val - Interstitial%sbsno = clear_val - Interstitial%sigma = clear_val - Interstitial%sigmaf = clear_val - Interstitial%sigmafrac = clear_val - Interstitial%sigmatot = clear_val - Interstitial%snowc = clear_val - Interstitial%snohf = clear_val - Interstitial%snowmt = clear_val - Interstitial%stress = clear_val - Interstitial%stress_ice = Model%huge - Interstitial%stress_land = Model%huge - Interstitial%stress_water = Model%huge - Interstitial%theta = clear_val - Interstitial%tprcp_ice = Model%huge - Interstitial%tprcp_land = Model%huge - Interstitial%tprcp_water = Model%huge - Interstitial%trans = clear_val - Interstitial%tseal = clear_val - Interstitial%tsfc_water = Model%huge - Interstitial%tsurf_ice = Model%huge - Interstitial%tsurf_land = Model%huge - Interstitial%tsurf_water = Model%huge - Interstitial%ud_mf = clear_val - Interstitial%uustar_ice = Model%huge - Interstitial%uustar_land = Model%huge - Interstitial%uustar_water = Model%huge - Interstitial%vdftra = clear_val - Interstitial%vegf1d = clear_val - Interstitial%lndp_vgf = clear_val - Interstitial%wcbmax = clear_val - Interstitial%wind = Model%huge - Interstitial%work1 = clear_val - Interstitial%work2 = clear_val - Interstitial%work3 = clear_val - Interstitial%xcosz = clear_val - Interstitial%xlai1d = clear_val - Interstitial%xmu = clear_val - Interstitial%z01d = clear_val - Interstitial%zt1d = clear_val - Interstitial%ztmax_ice = clear_val - Interstitial%ztmax_land = clear_val - Interstitial%ztmax_water = clear_val - -! UGWP common - Interstitial%tau_mtb = clear_val - Interstitial%tau_ogw = clear_val - Interstitial%tau_tofd = clear_val - Interstitial%tau_ngw = clear_val - Interstitial%tau_oss = clear_val - Interstitial%dudt_mtb = clear_val - Interstitial%dudt_tms = clear_val - Interstitial%zmtb = clear_val - Interstitial%zlwb = clear_val - Interstitial%zogw = clear_val - Interstitial%zngw = clear_val - -! CIRES UGWP v1 - if (Model%do_ugwp_v1) then - Interstitial%dudt_ngw = clear_val - Interstitial%dvdt_ngw = clear_val - Interstitial%dtdt_ngw = clear_val - Interstitial%kdis_ngw = clear_val - end if - -!-- GSL drag suite - if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & - Model%gwd_opt==2 .or. Model%gwd_opt==22) then - Interstitial%varss = clear_val - Interstitial%ocss = clear_val - Interstitial%oa4ss = clear_val - Interstitial%clxss = clear_val - end if -! - ! Reset fields that are conditional on physics choices - if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then - Interstitial%graupelmp = clear_val - Interstitial%icemp = clear_val - Interstitial%rainmp = clear_val - Interstitial%snowmp = clear_val - else if (Model%imp_physics == Model%imp_physics_mg) then - Interstitial%ncgl = clear_val - Interstitial%ncpr = clear_val - Interstitial%ncps = clear_val - Interstitial%qgl = clear_val - Interstitial%qrn = clear_val - Interstitial%qsnw = clear_val - Interstitial%qlcn = clear_val - Interstitial%qicn = clear_val - Interstitial%w_upi = clear_val - Interstitial%cf_upi = clear_val - Interstitial%cnv_mfd = clear_val - Interstitial%cnv_dqldt = clear_val - Interstitial%clcn = clear_val - Interstitial%cnv_fice = clear_val - Interstitial%cnv_ndrop = clear_val - Interstitial%cnv_nice = clear_val - end if - if (Model%do_shoc) then - Interstitial%qrn = clear_val - Interstitial%qsnw = clear_val - ! DH* updated version of shoc from May 22 2019 doesn't use qgl? remove? - Interstitial%qgl = clear_val - ! *DH - Interstitial%ncpi = clear_val - Interstitial%ncpl = clear_val - end if - if (Model%lsm == Model%lsm_noahmp) then - Interstitial%t2mmp = clear_val - Interstitial%q2mp = clear_val - end if - ! - ! Set flag for resetting maximum hourly output fields - Interstitial%max_hourly_reset = mod(Model%kdt-1, nint(Model%avg_max_length/Model%dtp)) == 0 - ! Use same logic in UFS to reset Thompson extended diagnostics - Interstitial%ext_diag_thompson_reset = Interstitial%max_hourly_reset - ! - ! Set flag for resetting radar reflectivity calculation - if (Model%nsradar_reset<0) then - Interstitial%radar_reset = .true. - else - Interstitial%radar_reset = mod(Model%kdt-1, nint(Model%nsradar_reset/Model%dtp)) == 0 - end if - ! - end subroutine interstitial_phys_reset - end module GFS_typedefs diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index f95931c1b..26635f1b9 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -195,6 +195,14 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys +[qgrs(:,:,index_of_hail_mixing_ratio_in_tracer_concentration_array)] + standard_name = hail_mixing_ratio + long_name = ratio of mass of hail to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (index_of_hail_mixing_ratio_in_tracer_concentration_array > 0) [qgrs(:,:,index_of_ozone_mixing_ratio_in_tracer_concentration_array)] standard_name = ozone_mixing_ratio long_name = ozone mixing ratio @@ -254,6 +262,46 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys +[qgrs(:,:,index_of_mass_number_concentration_of_hail_in_tracer_concentration_array)] + standard_name = mass_number_concentration_of_hail_in_air + long_name = number concentration of hail + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (index_of_mass_number_concentration_of_hail_in_tracer_concentration_array > 0) +[qgrs(:,:,index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array)] + standard_name = cloud_condensation_nuclei_number_concentration + long_name = number concentration of cloud condensation nuclei + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array > 0 ) +[qgrs(:,:,index_of_activated_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array)] + standard_name = activated_cloud_condensation_nuclei_number_concentration + long_name = number concentration of activated cloud condensation nuclei + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_activated_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array > 0 ) +[qgrs(:,:,index_of_graupel_volume_in_tracer_concentration_array)] + standard_name = graupel_volume + long_name = graupel particle volume + units = m3 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_graupel_volume_in_tracer_concentration_array > 0 ) +[qgrs(:,:,index_of_hail_volume_in_tracer_concentration_array)] + standard_name = hail_volume + long_name = hail particle volume + units = m3 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_hail_volume_in_tracer_concentration_array > 0 ) [qgrs(:,:,index_of_turbulent_kinetic_energy_in_tracer_concentration_array)] standard_name = turbulent_kinetic_energy long_name = turbulent kinetic energy @@ -261,6 +309,28 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys +[qgrs(:,:,index_of_updraft_area_fraction_in_tracer_concentration_array)] + standard_name = prognostic_updraft_area_fraction_in_convection + long_name = convective updraft area fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (index_of_updraft_area_fraction_in_tracer_concentration_array > 0 ) +[qgrs(:,:,index_for_smoke_in_tracer_concentration_array)] + standard_name = smoke_tracer_concentration + long_name = concentration of smoke + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys +[qgrs(:,:,index_for_dust_in_tracer_concentration_array)] + standard_name = dust_tracer_concentration + long_name = concentration of dust + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys [diss_est] standard_name = dissipation_estimate_of_air_temperature_at_model_layers long_name = dissipation estimate model layer mean temperature @@ -383,6 +453,14 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys +[gq0(:,:,index_of_hail_mixing_ratio_in_tracer_concentration_array)] + standard_name = hail_mixing_ratio_of_new_state + long_name = ratio of mass of hail to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_hail_mixing_ratio_in_tracer_concentration_array > 0 ) [gq0(:,:,index_of_mass_weighted_rime_factor_in_tracer_concentration_array)] standard_name = mass_weighted_rime_factor_of_new_state long_name = mass weighted rime factor updated by physics @@ -442,6 +520,46 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys +[gq0(:,:,index_of_mass_number_concentration_of_hail_in_tracer_concentration_array)] + standard_name = mass_number_concentration_of_hail_of_new_state + long_name = number concentration of hail updated by physics + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_mass_number_concentration_of_hail_in_tracer_concentration_array > 0 ) +[gq0(:,:,index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array)] + standard_name = cloud_condensation_nuclei_number_concentration_of_new_state + long_name = number concentration of cloud condensation nuclei updated by physics + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array > 0 ) +[gq0(:,:,index_of_activated_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array)] + standard_name = activated_cloud_condensation_nuclei_number_concentration_of_new_state + long_name = number concentration of cloud condensation nuclei updated by physics + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_activated_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array > 0 ) +[gq0(:,:,index_of_graupel_volume_in_tracer_concentration_array)] + standard_name = graupel_volume_of_new_state + long_name = graupel volume updated by physics + units = m3 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_graupel_volume_in_tracer_concentration_array > 0 ) +[gq0(:,:,index_of_hail_volume_in_tracer_concentration_array)] + standard_name = hail_volume_of_new_state + long_name = hail volume updated by physics + units = m3 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_hail_volume_in_tracer_concentration_array > 0 ) [gq0(:,:,index_of_cloud_area_fraction_in_atmosphere_layer_in_tracer_concentration_array)] standard_name = cloud_area_fraction_in_atmosphere_layer_of_new_state long_name = cloud fraction updated by physics @@ -449,7 +567,14 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - +[gq0(:,:,index_of_updraft_area_fraction_in_tracer_concentration_array)] + standard_name = updraft_area_fraction_updated_by_physics + long_name = convective updraft area fraction updated by physics + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_updraft_area_fraction_in_tracer_concentration_array > 0 ) ######################################################################## [ccpp-table-properties] name = GFS_sfcprop_type @@ -620,6 +745,30 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[dust12m_in] + standard_name = fengsha_dust12m_input + long_name = fengsha dust input + units = various + dimensions = (horizontal_dimension,12,5) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[emi_in] + standard_name = anthropogenic_background_input + long_name = anthropogenic background input + units = various + dimensions = (horizontal_dimension,1) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[smoke_GBBEPx] + standard_name = emission_smoke_GBBEPx + long_name = emission fire GBBEPx + units = various + dimensions = (horizontal_dimension,24,3) + type = real + kind = kind_phys + active = (do_smoke_coupling) [z0base] standard_name = baseline_surface_roughness_length long_name = baseline surface roughness length for momentum in meter @@ -859,6 +1008,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[rca] + standard_name = aerodynamic_resistance_in_canopy + long_name = canopy resistance + units = s m-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [tprcp] standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total precipitation amount in each time step @@ -1282,7 +1438,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .and. flag_for_reading_leaf_area_index_from_input)) + active = (control_for_land_surface_scheme == identifier_for_noah_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .and. flag_for_reading_leaf_area_index_from_input)) [xsaixy] standard_name = stem_area_index long_name = stem area index @@ -1981,7 +2137,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [dqsfci_cpl] standard_name = surface_upward_latent_heat_flux_for_coupling long_name = instantaneous sfc latent heat flux @@ -1989,7 +2145,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [dlwsfci_cpl] standard_name = surface_downwelling_longwave_flux_for_coupling long_name = instantaneous sfc downward lw flux @@ -2053,7 +2209,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [nnirbmi_cpl] standard_name = surface_net_downwelling_direct_nir_shortwave_flux_for_coupling long_name = instantaneous net nir beam sfc downward sw flux @@ -2093,7 +2249,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [q2mi_cpl] standard_name = specific_humidity_at_2m_for_coupling long_name = instantaneous Q2m @@ -2101,7 +2257,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [u10mi_cpl] standard_name = x_wind_at_10m_for_coupling long_name = instantaneous U10m @@ -2133,7 +2289,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) [ulwsfcin_cpl] standard_name = surface_upwelling_longwave_flux_from_coupled_process long_name = surface upwelling LW flux for coupling @@ -2174,6 +2330,46 @@ type = real kind = kind_phys active = (flag_for_surface_flux_coupling) +[ulwsfcin_med] + standard_name = surface_upwelling_longwave_flux_over_ocean_from_mediator + long_name = surface upwelling LW flux over ocean for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_surface_flux_coupling .and. do_mediator_atmosphere_ocean_fluxes) +[dusfcin_med] + standard_name = surface_x_momentum_flux_over_ocean_from_mediator + long_name = sfc x momentum flux over ocean for coupling + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_surface_flux_coupling .and. do_mediator_atmosphere_ocean_fluxes) +[dvsfcin_med] + standard_name = surface_y_momentum_flux_over_ocean_from_mediator + long_name = sfc y momentum flux over ocean for coupling + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_surface_flux_coupling .and. do_mediator_atmosphere_ocean_fluxes) +[dtsfcin_med] + standard_name = surface_upward_sensible_heat_flux_over_ocean_from_mediator + long_name = sfc sensible heat flux input over ocean for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_surface_flux_coupling .and. do_mediator_atmosphere_ocean_fluxes) +[dqsfcin_med] + standard_name = surface_upward_latent_heat_flux_over_ocean_from_mediator + long_name = sfc latent heat flux input over ocean for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_surface_flux_coupling .and. do_mediator_atmosphere_ocean_fluxes) [hsnoin_cpl] standard_name = lwe_surface_snow_from_coupled_process long_name = sfc snow depth in meters over sea ice for coupling @@ -2189,6 +2385,22 @@ type = real kind = kind_phys active = (flag_for_surface_flux_coupling) +[tmf] + standard_name = instantaneous_tendency_of_specific_humidity_due_to_PBL + long_name = instantaneous_tendency_of_specific_humidity_due_to_PBL + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_prognostic_updraft_area_fraction) +[dqdt_qmicro] + standard_name = instantaneous_tendency_of_specific_humidity_due_to_microphysics + long_name = instantaneous_tendency_of_specific_humidity_due_to_microphysics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_prognostic_updraft_area_fraction) [ca_deep] standard_name = cellular_automata_area_fraction_for_deep_convection_from_coupled_process long_name = fraction of cellular automata for deep convection @@ -2244,14 +2456,62 @@ 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 active = (control_for_stochastic_land_surface_perturbation /= 0) +[dqdti] + standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection + long_name = instantaneous moisture tendency due to convection + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_smoke_coupling) [nwfa2d] standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer long_name = instantaneous water-friendly sfc aerosol source @@ -2268,6 +2528,126 @@ type = real kind = kind_phys active = (control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) +[emdust] + standard_name = emission_of_dust_for_smoke + long_name = emission of dust for smoke + units = ug m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[emseas] + standard_name = emission_of_seas_for_smoke + long_name = emission of seas for smoke + units = ug m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[emanoc] + standard_name = emission_of_anoc_for_thompson_mp + long_name = emission of anoc for thompson mp + units = ug m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[ebb_smoke_hr] + standard_name = surface_smoke_emission + long_name = emission of surface smoke + units = ug m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[frp_hr] + standard_name = frp_hourly + long_name = hourly fire radiative power + units = MW + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[frp_std_hr] + standard_name = frp_std_hourly + long_name = hourly stdandard deviation of fire radiative power + units = MW + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[fhist] + standard_name = fire_hist + long_name = coefficient to scale the fire activity depending on the fire duration + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[coef_bb_dc] + standard_name = coef_bb_dc + long_name = coef to estimate the fire emission + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[ebu_smoke] + standard_name = ebu_smoke + long_name = buffer of vertical fire emission + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[smoke_ext] + standard_name = extinction_coefficient_in_air_due_to_smoke + long_name = extinction coefficient in air due to smoke + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[dust_ext] + standard_name = extinction_coefficient_in_air_due_to_dust + long_name = extinction coefficient in air due to dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,2) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[min_fplume] + standard_name = minimum_fire_plume_sigma_pressure_level + long_name = minimum model level of fire plumerise + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[max_fplume] + standard_name = maximum_fire_plume_sigma_pressure_level + long_name = maximum model level of fire plumerise + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[rrfs_hwp] + standard_name = hourly_wildfire_potential + long_name = rrfs hourly fire weather potential + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) [ushfsfci] standard_name = surface_upward_sensible_heat_flux_for_chemistry_coupling long_name = instantaneous upward sensible heat flux for chemistry coupling @@ -2413,6 +2793,7 @@ dimensions = (number_of_lines_in_internal_namelist) type = character kind = len=256 + active = (number_of_lines_in_internal_namelist > 0) [logunit] standard_name = iounit_of_log long_name = fortran unit number for logfile @@ -2519,13 +2900,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 @@ -2611,12 +2992,30 @@ units = flag dimensions = () type = logical +[cplaqm] + standard_name = flag_for_air_quality_coupling + long_name = flag controlling cplaqm collection (default off) + units = flag + dimensions = () + type = logical [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) units = flag dimensions = () type = logical +[rrfs_smoke] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_smoke collection (default off) + units = flag + dimensions = () + type = logical +[dust_smoke_rrtmg_band_number] + standard_name = index_of_shortwave_band_affected_by_smoke + long_name = rrtmg band number that smoke and dust should affect + units = count + dimensions = () + type = integer [cpl_imp_mrg] standard_name = flag_for_merging_imported_data long_name = flag controlling cpl_imp_mrg for imported data (default off) @@ -2641,6 +3040,12 @@ units = flag dimensions = () type = logical +[use_med_flux] + standard_name = do_mediator_atmosphere_ocean_fluxes + long_name = flag for using atmosphere-ocean fluxes form mediator (default false) + units = flag + dimensions = () + type = logical [fhcyc] standard_name = frequency_for_surface_cycling_calls long_name = frequency for surface cycling calls @@ -3004,6 +3409,24 @@ units = flag dimensions = () type = logical +[doGP_sgs_cnv] + standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP + long_name = logical flag to control sgs convective cloud in RRTMGP + units = flag + dimensions = () + type = logical +[doGP_sgs_mynn] + standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP + long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP + units = flag + dimensions = () + type = logical +[iovr_convcld] + standard_name = flag_for_convective_cloud_overlap_method_for_radiation + long_name = flag for convective cloud overlap method + units = flag + dimensions = () + type = integer [rrtmgp_nrghice] standard_name = number_of_ice_roughness_categories long_name = number of ice-roughness categories in RRTMGP calculation (Model%rrtmgp_nrghice) @@ -3128,6 +3551,18 @@ units = flag dimensions = () type = integer +[imp_physics_nssl] + standard_name = identifier_for_nssl_microphysics_scheme + long_name = choice of NSSL 2-moment microphysics scheme + units = flag + dimensions = () + type = integer +[imp_physics_nssl2mccn] + standard_name = identifier_for_nssl2mccn_microphysics_scheme + long_name = choice of NSSL 2-moment microphysics scheme with CCN + units = flag + dimensions = () + type = integer [iovr_exp] standard_name = flag_for_exponential_cloud_overlap_method long_name = choice of exponential cloud overlap method @@ -3360,6 +3795,45 @@ dimensions = () type = character kind = len=16 +[nssl_cccn] + standard_name = nssl_ccn_concentration + long_name = CCN concentration + units = m-3 + dimensions = () + type = real + kind = kind_phys +[nssl_alphah] + standard_name = nssl_alpha_graupel + long_name = graupel PSD shape parameter in NSSL micro + units = none + dimensions = () + type = real + kind = kind_phys +[nssl_alphahl] + standard_name = nssl_alpha_hail + long_name = hail PSD shape parameter in NSSL micro + units = none + dimensions = () + type = real + kind = kind_phys +[nssl_ccn_on] + standard_name = nssl_ccn_on + long_name = CCN activation flag in NSSL micro + units = flag + dimensions = () + type = logical +[nssl_hail_on] + standard_name = nssl_hail_on + long_name = hail activation flag in NSSL micro + units = flag + dimensions = () + type = logical +[nssl_invertccn] + standard_name = nssl_invertccn + long_name = flag to invert CCN in NSSL micro + units = flag + dimensions = () + type = logical [tf] standard_name = all_ice_cloud_threshold_temperature long_name = threshold temperature below which all cloud is ice @@ -3381,6 +3855,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 +3951,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 @@ -3687,24 +4205,6 @@ units = index dimensions = () type = integer -[isurban] - standard_name = index_of_urban_vegetation_category - long_name = index of the urban vegetation category in the chosen vegetation dataset - units = index - dimensions = () - type = integer -[isice] - standard_name = index_of_ice_vegetation_category - long_name = index of the permanent snow/ice category in the chosen vegetation dataset - units = index - dimensions = () - type = integer -[iswater] - standard_name = index_of_water_vegetation_category - long_name = index of the water body vegetation category in the chosen vegetation dataset - units = index - dimensions = () - type = integer [iopt_thcnd] standard_name = control_for_land_surface_scheme_thermal_conductivity_option long_name = choice for thermal conductivity option (see module_sf_noahlsm) @@ -3796,6 +4296,12 @@ units = index dimensions = () type = integer +[iopt_trs] + standard_name = control_for_land_surface_scheme_surface_thermal_roughness + long_name = choice for surface thermal roughness option (see noahmp module for definition) + units = index + dimensions = () + type = integer [use_ufo] standard_name = flag_for_gcycle_surface_option long_name = flag for gcycle surface option @@ -4080,7 +4586,13 @@ units = flag dimensions = () type = logical -[isatmedmf] +[progsigma] + standard_name = do_prognostic_updraft_area_fraction + long_name = do_prognostic_updraft_area_fraction + units = flag + dimensions = () + type = logical +[isatmedmf] standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL long_name = choice of scale-aware TKE moist EDMF PBL scheme units = none @@ -4566,6 +5078,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 +5112,66 @@ 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_perturbed_spp_schemes) + type = real + kind = kind_phys + active = (do_stochastically_perturbed_parameterizations) +[spp_stddev_cutoff] + standard_name = magnitude_of_spp_standard_deviation_cutoff + long_name = magnitude of spp standard deviation cutoff + units = 1 + dimensions = (number_of_perturbed_spp_schemes) + type = real + kind = kind_phys + active = (do_stochastically_perturbed_parameterizations) +[spp_var_list] + standard_name = perturbed_spp_schemes + long_name = perturbed spp schemes + units = none + dimensions = (number_of_perturbed_spp_schemes) + type = character + kind = len=3 + active = (do_stochastically_perturbed_parameterizations) +[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 +5298,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 @@ -4804,6 +5388,12 @@ units = index dimensions = () type = integer +[nthl] + standard_name = index_of_hail_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for hail + units = index + dimensions = () + type = integer [ntclamt] standard_name = index_of_cloud_area_fraction_in_atmosphere_layer_in_tracer_concentration_array long_name = tracer index for cloud amount integer @@ -4840,12 +5430,48 @@ units = index dimensions = () type = integer +[nthnc] + standard_name = index_of_mass_number_concentration_of_hail_in_tracer_concentration_array + long_name = tracer index for hail number concentration + units = index + dimensions = () + type = integer +[ntccn] + standard_name = index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array + long_name = tracer index for cloud condensation nuclei number concentration + units = index + dimensions = () + type = integer +[ntccna] + standard_name = index_of_activated_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array + long_name = tracer index for activated cloud condensation nuclei number concentration + units = index + dimensions = () + type = integer +[ntgv] + standard_name = index_of_graupel_volume_in_tracer_concentration_array + long_name = tracer index for graupel particle volume + units = index + dimensions = () + type = integer +[nthv] + standard_name = index_of_hail_volume_in_tracer_concentration_array + long_name = tracer index for hail particle volume + units = index + dimensions = () + type = integer [ntke] standard_name = index_of_turbulent_kinetic_energy_in_tracer_concentration_array long_name = tracer index for turbulent kinetic energy units = index dimensions = () type = integer +[ntsigma] + standard_name = index_of_updraft_area_fraction_in_tracer_concentration_array + long_name = tracer index of updraft_area_fraction + units = index + dimensions = () + type = integer [nqrimef] standard_name = index_of_mass_weighted_rime_factor_in_tracer_concentration_array long_name = tracer index for mass weighted rime factor @@ -4864,6 +5490,30 @@ units = index dimensions = () type = integer +[ntsmoke] + standard_name = index_for_smoke_in_tracer_concentration_array + long_name = tracer index for smoke + units = index + dimensions = () + type = integer +[ntdust] + standard_name = index_for_dust_in_tracer_concentration_array + long_name = tracer index for dust + units = index + dimensions = () + type = integer +[nchem] + standard_name = number_of_chemical_species_vertically_mixed + long_name = number of chemical vertically mixed + units = count + dimensions = () + type = integer +[ndvel] + standard_name = number_of_chemical_species_deposited + long_name = number of chemical pbl deposited + units = count + dimensions = () + type = integer [ntchm] standard_name = number_of_chemical_tracers long_name = number of chemical tracers @@ -4961,6 +5611,104 @@ units = index dimensions = () type = integer +[mix_chem] + standard_name = do_planetary_boundary_layer_smoke_mixing + long_name = flag for rrfs smoke mynn tracer mixing + units = flag + dimensions = () + type = logical + active = (do_smoke_coupling) +[fire_turb] + standard_name = do_planetary_boundary_layer_fire_enhancement + long_name = flag for rrfs smoke mynn enh vermix + units = flag + dimensions = () + type = logical + active = (do_smoke_coupling) +[seas_opt] + standard_name = control_for_smoke_sea_salt + long_name = rrfs smoke sea salt emission option + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) +[dust_opt] + standard_name = control_for_smoke_dust + long_name = rrfs smoke dust chem option + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) +[biomass_burn_opt] + standard_name = control_for_smoke_biomass_burn + long_name = rrfs smoke biomass burning option + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) +[drydep_opt] + standard_name = control_for_smoke_dry_deposition + long_name = rrfs smoke dry deposition option + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) +[wetdep_ls_opt] + standard_name = control_for_smoke_wet_deposition + long_name = rrfs smoke large scale wet deposition option + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) +[do_plumerise] + standard_name = do_smoke_plumerise + long_name = rrfs smoke plumerise option + units = index + dimensions = () + type = logical + active = (do_smoke_coupling) +[plumerisefire_frq] + standard_name = smoke_plumerise_frequency + long_name = rrfs smoke add smoke option + units = min + dimensions = () + type = integer + active = (do_smoke_coupling) +[addsmoke_flag] + standard_name = control_for_smoke_biomass_burning_emissions + long_name = rrfs smoke add smoke option + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) +[smoke_forecast] + standard_name = do_smoke_forecast + long_name = flag for rrfs smoke forecast + units = flag + dimensions = () + type = logical + active = (do_smoke_coupling) +[aero_ind_fdb] + standard_name = do_smoke_aerosol_indirect_feedback + long_name = flag for wfa ifa emission indirect feedback + units = flag + dimensions = () + type = logical + active = (do_smoke_coupling) +[aero_dir_fdb] + standard_name = do_smoke_aerosol_direct_feedback + long_name = flag for smoke and dust radiation feedback + units = flag + dimensions = () + type = logical + active = (do_smoke_coupling) +[rrfs_smoke_debug] + standard_name = do_smoke_debug + long_name = flag for rrfs smoke plumerise debug + units = flag + dimensions = () + type = logical + active = (do_smoke_coupling) [ncnvcld3d] standard_name = number_of_convective_cloud_variables_in_xyz_dimensioned_restart_array long_name = number of convective 3d clouds fields @@ -5058,7 +5806,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 +5928,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 +5982,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] @@ -5302,18 +6056,12 @@ units = flag dimensions = () type = logical -[grav_settling] - standard_name = control_for_gravitational_settling_of_cloud_droplets - long_name = flag to activate gravitational setting of fog - units = flag - dimensions = () - type = integer [bl_mynn_tkebudget] standard_name = control_for_tke_budget_output long_name = flag for activating TKE budget units = flag dimensions = () - type = integer + type = logical [bl_mynn_tkeadvect] standard_name = flag_for_tke_advection long_name = flag for activating TKE advection @@ -5350,12 +6098,6 @@ units = flag dimensions = () type = integer -[bl_mynn_edmf_part] - standard_name = control_for_edmf_partitioning_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to partitioning og the MF and ED areas - units = flag - dimensions = () - type = integer [bl_mynn_cloudmix] standard_name = control_for_cloud_species_mixing_in_mellor_yamada_nakanishi_niino_pbl_scheme long_name = flag to activate mixing of cloud species @@ -5374,12 +6116,42 @@ units = flag dimensions = () type = integer +[bl_mynn_closure] + standard_name = control_for_closure_level_in_mellor_yamada_nakanishi_niino_pbl_scheme + long_name = flag to determine the closure level for the mynn + units = 1 + dimensions = () + type = real [icloud_bl] standard_name = control_for_sgs_cloud_radiation_coupling_in_mellor_yamamda_nakanishi_niino_pbl_scheme long_name = flag for coupling sgs clouds to radiation units = flag dimensions = () type = integer +[isftcflx] + standard_name = control_for_thermal_roughness_lengths_over_water + long_name = flag for thermal roughness lengths over water in mynnsfclay + units = 1 + dimensions = () + type = integer +[iz0tlnd] + standard_name = control_for_thermal_roughness_lengths_over_land + long_name = flag for thermal roughness lengths over land in mynnsfclay + units = 1 + dimensions = () + type = integer +[sfclay_compute_flux] + standard_name = do_compute_surface_scalar_fluxes + long_name = flag for computing surface scalar fluxes in mynnsfclay + units = flag + dimensions = () + type = logical +[sfclay_compute_diag] + standard_name = do_compute_surface_diagnostics + long_name = flag for computing surface diagnostics in mynnsfclay + units = flag + dimensions = () + type = logical [var_ric] standard_name = control_for_variable_bulk_richardson_number long_name = flag for calculating variable bulk richardson number for hurricane PBL @@ -5783,6 +6555,14 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( control_for_deep_convection_scheme .ge. 0 .or. control_for_shallow_convection_scheme .ge. 0 ) [in_nm] standard_name = ice_nucleation_number_from_climatology long_name = ice nucleation number in MG MP @@ -5900,14 +6680,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 @@ -6059,7 +6839,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection .or. control_for_deep_convection_scheme == identifer_for_scale_aware_mass_flux_deep_convection .or. control_for_shallow_convection_scheme == identifier_for_scale_aware_mass_flux_shallow_convection) [cactiv] standard_name = counter_for_grell_freitas_convection long_name = convective activity memory @@ -6114,6 +6894,14 @@ type = real kind = kind_phys active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme) +[Sm3D] + standard_name = stability_function_for_momentum + long_name = stability function for momentum + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme) [qke] standard_name = nonadvected_turbulent_kinetic_energy_multiplied_by_2 long_name = 2 x tke at mass points @@ -6242,6 +7030,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] @@ -7232,6 +8036,46 @@ type = real kind = kind_phys active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. (control_for_additional_diagnostics_in_mellor_yamada_nakanishi_niino_pbl_scheme .ne. 0)) +[dqke] + standard_name = total_time_rate_of_change_of_tke + long_name = total tke tendency + units = m2 s-3 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) +[qwt] + standard_name = tke_tendency_due_to_vertical_transport + long_name = tke tendency due to vertical transport and diffusion + units = m2 s-3 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) +[qshear] + standard_name = tke_tendency_due_to_shear + long_name = tke tendency due to shear + units = m2 s-3 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) +[qbuoy] + standard_name = tke_tendency_due_to_buoyancy + long_name = tke tendency due to buoyancy production or consumption + units = m2 s-3 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) +[qdiss] + standard_name = tke_tendency_due_to_dissipation + long_name = tke tendency due to the dissipation of tke + units = m2 s-3 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output) [nupdraft] standard_name = number_of_plumes long_name = number of plumes per grid column @@ -7261,7 +8105,7 @@ type = integer active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme) [exch_h] - standard_name = atmosphere_heat_diffusivity_for_mynnpbl + standard_name = atmosphere_heat_diffusivity_for_mynnedmf long_name = diffusivity for heat for MYNN PBL (defined for all mass levels) units = m2 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -7269,7 +8113,7 @@ kind = kind_phys active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme) [exch_m] - standard_name = atmosphere_momentum_diffusivity_for_mynnpbl + standard_name = atmosphere_momentum_diffusivity_for_mynnedmf long_name = diffusivity for momentum for MYNN PBL (defined for all mass levels) units = m2 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -7555,2823 +8399,12 @@ ######################################################################## [ccpp-table-properties] - name = GFS_interstitial_type + name = GFS_data_type type = ddt dependencies = [ccpp-arg-table] - name = GFS_interstitial_type - type = ddt -[adjsfculw_water] - standard_name = surface_upwelling_longwave_flux_over_water - long_name = surface upwelling longwave flux at current time over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjsfculw_land] - standard_name = surface_upwelling_longwave_flux_over_land - long_name = surface upwelling longwave flux at current time over land - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjsfculw_ice] - standard_name = surface_upwelling_longwave_flux_over_ice - long_name = surface upwelling longwave flux at current time over ice - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjnirbmd] - standard_name = surface_downwelling_direct_near_infrared_shortwave_flux - long_name = surface downwelling beam near-infrared shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjnirbmu] - standard_name = surface_upwelling_direct_near_infrared_shortwave_flux - long_name = surface upwelling beam near-infrared shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjnirdfd] - standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux - long_name = surface downwelling diffuse near-infrared shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjnirdfu] - standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux - long_name = surface upwelling diffuse near-infrared shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjvisbmd] - standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux - long_name = surface downwelling beam ultraviolet plus visible shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjvisbmu] - standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux - long_name = surface upwelling beam ultraviolet plus visible shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjvisdfu] - standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux - long_name = surface upwelling diffuse ultraviolet plus visible shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjvisdfd] - standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux - long_name = surface downwelling diffuse ultraviolet plus visible shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[aerodp] - standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles - long_name = vertical integrated optical depth for various aerosol species - units = none - dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) - type = real - kind = kind_phys -[alb1d] - standard_name = surface_albedo_perturbation - long_name = surface albedo perturbation - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[alpha] - standard_name = cloud_overlap_decorrelation_parameter - long_name = cloud overlap decorrelation parameter for RRTMG (but not for RRTMGP) - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[bexp1d] - standard_name = perturbation_of_soil_type_b_parameter - long_name = perturbation of soil type "b" parameter - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cd] - standard_name = surface_drag_coefficient_for_momentum_in_air - long_name = surface exchange coeff for momentum - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cd_water] - standard_name = surface_drag_coefficient_for_momentum_in_air_over_water - long_name = surface exchange coeff for momentum over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cd_land] - standard_name = surface_drag_coefficient_for_momentum_in_air_over_land - long_name = surface exchange coeff for momentum over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cd_ice] - standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice - long_name = surface exchange coeff for momentum over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cdq] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air - long_name = surface exchange coeff heat & moisture - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cdq_water] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_water - long_name = surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cdq_land] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land - long_name = surface exchange coeff heat & moisture over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cdq_ice] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice - long_name = surface exchange coeff heat & moisture over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[chh_water] - standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water - long_name = thermal exchange coefficient over water - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[chh_land] - standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land - long_name = thermal exchange coefficient over land - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[chh_ice] - standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice - long_name = thermal exchange coefficient over ice - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cf_upi] - standard_name = convective_cloud_fraction_for_microphysics - long_name = convective cloud fraction for microphysics - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[clcn] - standard_name = convective_cloud_volume_fraction - long_name = convective cloud volume fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[cldf] - standard_name = cloud_area_fraction - long_name = fraction of grid box area in which updrafts occur - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cldsa] - standard_name = cloud_area_fraction_for_radiation - long_name = fraction of clouds for low, middle, high, total and BL - units = frac - dimensions = (horizontal_loop_extent,5) - type = real - kind = kind_phys -[cldtaulw] - standard_name = cloud_optical_depth_layers_at_10mu_band - long_name = approx 10mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[cldtausw] - standard_name = cloud_optical_depth_layers_at_0p55mu_band - long_name = approx .55mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[cld1d] - standard_name = cloud_work_function - long_name = cloud work function - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[clouds(:,:,1)] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,2)] - standard_name = cloud_liquid_water_path - long_name = layer cloud liquid water path - units = g m-2 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,3)] - standard_name = mean_effective_radius_for_liquid_cloud - long_name = mean effective radius for liquid cloud - units = um - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,4)] - standard_name = cloud_ice_water_path - long_name = layer cloud ice water path - units = g m-2 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,5)] - standard_name = mean_effective_radius_for_ice_cloud - long_name = mean effective radius for ice cloud - units = um - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,6)] - standard_name = cloud_rain_water_path - long_name = cloud rain water path - units = g m-2 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,7)] - standard_name = mean_effective_radius_for_rain_drop - long_name = mean effective radius for rain drop - units = um - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,8)] - standard_name = cloud_snow_water_path - long_name = cloud snow water path - units = g m-2 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,9)] - standard_name = mean_effective_radius_for_snow_flake - long_name = mean effective radius for snow flake - units = um - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clw] - standard_name = convective_transportable_tracers - long_name = array to contain cloud water and other convective trans. tracers - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) - type = real - kind = kind_phys -[clw(:,:,1)] - standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[clw(:,:,2)] - standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[clw(:,:,index_for_turbulent_kinetic_energy_convective_transport_tracer)] - standard_name = turbulent_kinetic_energy_convective_transport_tracer - long_name = turbulent kinetic energy in the convectively transported tracer array - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[clx] - standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height - long_name = frac. of grid box with by subgrid height_above_mean_sea_level higher than critical height - units = frac - dimensions = (horizontal_loop_extent,4) - type = real - kind = kind_phys -[clxss] - standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale - long_name = frac. of grid box with by subgrid height_above_mean_sea_level higher than critical height small scale - units = frac - dimensions = (horizontal_loop_extent,4) - type = real - kind = kind_phys - active = (control_for_drag_suite_gravity_wave_drag == 3 .or. control_for_drag_suite_gravity_wave_drag == 33) -[cmm_water] - standard_name = surface_drag_wind_speed_for_momentum_in_air_over_water - long_name = momentum exchange coefficient over water - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cmm_land] - standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land - long_name = momentum exchange coefficient over land - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cmm_ice] - standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice - long_name = momentum exchange coefficient over ice - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cnv_dqldt] - standard_name = tendency_of_cloud_water_due_to_convective_microphysics - long_name = tendency of cloud water due to convective microphysics - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[cnv_fice] - standard_name = ice_fraction_in_convective_tower - long_name = ice fraction in convective tower - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[cnv_mfd] - standard_name = detrained_mass_flux - long_name = detrained mass flux - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[cnv_ndrop] - standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment - long_name = droplet number concentration in convective detrainment - units = m-3 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[cnv_nice] - standard_name = number_concentration_of_ice_crystals_for_detrainment - long_name = crystal number concentration in convective detrainment - units = m-3 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[cnvc] - standard_name = convective_cloud_cover - long_name = convective cloud cover - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[cnvw] - standard_name = convective_cloud_water_mixing_ratio - long_name = moist convective cloud water mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[ctei_r] - standard_name = cloud_top_entrainment_instability_value - long_name = cloud top entrainment instability value - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ctei_rml] - standard_name = grid_sensitive_critical_cloud_top_entrainment_instability_criteria - long_name = grid sensitive critical cloud top entrainment instability criteria - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cumabs] - standard_name = maximum_column_heating_rate - long_name = maximum heating rate in column - units = K s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dd_mf] - standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux - long_name = (downdraft mass flux) * delt - units = kg m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[del] - standard_name = air_pressure_difference_between_midlayers - long_name = air pressure difference between midlayers - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[del_gz] - standard_name = geopotential_difference_between_midlayers_divided_by_midlayer_virtual_temperature - long_name = difference between mid-layer geopotentials divided by mid-layer virtual temperature - units = m2 s-2 K-1 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys -[delr] - standard_name = layer_pressure_thickness_for_radiation - long_name = layer pressure thickness on radiation levels - units = hPa - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[dlength] - standard_name = characteristic_grid_length_scale - long_name = representative horizontal length scale of grid box - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dqdt] - standard_name = process_split_cumulative_tendency_of_tracers - long_name = updated tendency of the tracers due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys -[dqdt(:,:,index_of_specific_humidity_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_specific_humidity - long_name = water vapor specific humidity tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_cloud_liquid_water_mixing_ratio - long_name = cloud condensed water mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_cloud_ice_mixing_ratio - long_name = cloud condensed water mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_of_ozone_mixing_ratio_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_ozone_mixing_ratio - long_name = ozone mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air - long_name = number concentration of cloud droplets (liquid) tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array > 0) -[dqdt(:,:,index_of_mass_number_concentration_of_cloud_ice_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air - long_name = number concentration of ice tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_of_mass_number_concentration_of_hygroscopic_aerosols_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_hygroscopic_aerosols - long_name = number concentration of water-friendly aerosols tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (index_of_mass_number_concentration_of_hygroscopic_aerosols_in_tracer_concentration_array > 0) -[dqdt(:,:,index_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols - long_name = number concentration of ice-friendly aerosols tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (index_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_in_tracer_concentration_array > 0) -[dqdt(:,:,index_of_rain_mixing_ratio_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_rain_mixing_ratio - long_name = ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_of_snow_mixing_ratio_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_snow_mixing_ratio - long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_of_graupel_mixing_ratio_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_graupel_mixing_ratio - long_name = ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_of_turbulent_kinetic_energy_in_tracer_concentration_array)] - standard_name = process_split_cumulative_tendency_of_turbulent_kinetic_energy - long_name = turbulent kinetic energy tendency due to model physics - units = J s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dqsfc1] - standard_name = instantaneous_surface_upward_latent_heat_flux - long_name = surface upward latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[drain] - standard_name = subsurface_runoff_flux - long_name = subsurface runoff flux - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = air temperature tendency due to model physics - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dtsfc1] - standard_name = instantaneous_surface_upward_sensible_heat_flux - long_name = surface upward sensible heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dtzm] - standard_name = mean_change_over_depth_in_sea_water_temperature - long_name = mean of dT(z) (zsea1 to zsea2) - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dt_mf] - standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux - long_name = (detrainment mass flux) * delt - units = kg m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dusfcg] - standard_name = instantaneous_x_stress_due_to_gravity_wave_drag - long_name = zonal surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dusfc1] - standard_name = instantaneous_surface_x_momentum_flux - long_name = x momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dvdftra] - standard_name = tendency_of_vertically_diffused_tracer_concentration - long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_vertical_diffusion_tracers) - type = real - kind = kind_phys -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dvsfcg] - standard_name = instantaneous_y_stress_due_to_gravity_wave_drag - long_name = meridional surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dvsfc1] - standard_name = instantaneous_surface_y_momentum_flux - long_name = y momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dzlyr] - standard_name = layer_thickness_for_radiation - long_name = layer thickness on radiation levels - units = km - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[elvmax] - standard_name = maximum_subgrid_orography - long_name = maximum of subgrid height_above_mean_sea_level - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ep1d] - standard_name = surface_upward_potential_latent_heat_flux - long_name = surface upward potential latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ep1d_water] - standard_name = surface_upward_potential_latent_heat_flux_over_water - long_name = surface upward potential latent heat flux over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ep1d_land] - standard_name = surface_upward_potential_latent_heat_flux_over_land - long_name = surface upward potential latent heat flux over land - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ep1d_ice] - standard_name = surface_upward_potential_latent_heat_flux_over_ice - long_name = surface upward potential latent heat flux over ice - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evap_water] - standard_name = kinematic_surface_upward_latent_heat_flux_over_water - long_name = kinematic surface upward latent heat flux over water - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evap_land] - standard_name = kinematic_surface_upward_latent_heat_flux_over_land - long_name = kinematic surface upward latent heat flux over land - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evap_ice] - standard_name = kinematic_surface_upward_latent_heat_flux_over_ice - long_name = kinematic surface upward latent heat flux over ice - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evbs] - standard_name = soil_upward_latent_heat_flux - long_name = soil upward latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evcw] - standard_name = canopy_upward_latent_heat_flux - long_name = canopy upward latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[pah] - standard_name = total_precipitation_advected_heat - long_name = precipitation advected heat - total - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ecan] - standard_name = evaporation_of_intercepted_water - long_name = evaporation of intercepted water - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[etran] - standard_name = transpiration_rate - long_name = transpiration rate - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[edir] - standard_name = soil_surface_evaporation_rate - long_name = soil surface evaporation rate - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[faerlw] - standard_name = aerosol_optical_properties_for_longwave_bands_01_16 - long_name = aerosol optical properties for longwave bands 01-16 - units = mixed - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation,number_of_aerosol_output_fields_for_longwave_radiation) - type = real - kind = kind_phys -[faerlw(:,:,:,1)] - standard_name = aerosol_optical_depth_for_longwave_bands_01_16 - long_name = aerosol optical depth for longwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) - type = real - kind = kind_phys -[faerlw(:,:,:,2)] - standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 - long_name = aerosol single scattering albedo for longwave bands 01-16 - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) - type = real - kind = kind_phys -[faerlw(:,:,:,3)] - standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 - long_name = aerosol asymmetry parameter for longwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) - type = real - kind = kind_phys -[faersw] - standard_name = aerosol_optical_properties_for_shortwave_bands_01_16 - long_name = aerosol optical properties for shortwave bands 01-16 - units = mixed - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation,number_of_aerosol_output_fields_for_shortwave_radiation) - type = real - kind = kind_phys -[faersw(:,:,:,1)] - standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 - long_name = aerosol optical depth for shortwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) - type = real - kind = kind_phys -[faersw(:,:,:,2)] - standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 - long_name = aerosol single scattering albedo for shortwave bands 01-16 - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) - type = real - kind = kind_phys -[faersw(:,:,:,3)] - standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 - long_name = aerosol asymmetry parameter for shortwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) - type = real - kind = kind_phys -[ffhh_water] - standard_name = Monin_Obukhov_similarity_function_for_heat_over_water - long_name = Monin-Obukhov similarity function for heat over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffhh_land] - standard_name = Monin_Obukhov_similarity_function_for_heat_over_land - long_name = Monin-Obukhov similarity function for heat over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffhh_ice] - standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice - long_name = Monin-Obukhov similarity function for heat over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fh2] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m - long_name = Monin-Obukhov similarity parameter for heat at 2m - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fh2_water] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_water - long_name = Monin-Obukhov similarity parameter for heat at 2m over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fh2_land] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land - long_name = Monin-Obukhov similarity parameter for heat at 2m over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fh2_ice] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice - long_name = Monin-Obukhov similarity parameter for heat at 2m over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[flag_cice] - standard_name = flag_for_cice - long_name = flag for cice - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[flag_guess] - standard_name = flag_for_guess_run - long_name = flag for guess run - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[flag_iter] - standard_name = flag_for_iteration - long_name = flag for iteration - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[ffmm_water] - standard_name = Monin_Obukhov_similarity_function_for_momentum_over_water - long_name = Monin-Obukhov similarity function for momentum over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffmm_land] - standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land - long_name = Monin-Obukhov similarity function for momentum over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffmm_ice] - standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice - long_name = Monin-Obukhov similarity function for momentum over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fm10] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m - long_name = Monin-Obukhov similarity parameter for momentum at 10m - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fm10_water] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_water - long_name = Monin-Obukhov similarity parameter for momentum at 10m over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fm10_land] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land - long_name = Monin-Obukhov similarity parameter for momentum at 10m over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fm10_ice] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice - long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[frain] - standard_name = dynamics_to_physics_timestep_ratio - long_name = ratio of dynamics timestep to physics timestep - units = none - dimensions = () - type = real - kind = kind_phys -[frland] - standard_name = land_area_fraction_for_microphysics - long_name = land area fraction used in microphysics schemes - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fscav] - standard_name = fraction_of_tracer_scavenged - long_name = fraction of the tracer (aerosols) that is scavenged by convection - units = km-1 - dimensions = (number_of_tracers_scavenged) - type = real - kind = kind_phys -[fswtr] - standard_name = fraction_of_cloud_top_water_scavenged - long_name = fraction of the tracer (cloud top water) that is scavenged by convection - units = km-1 - dimensions = (number_of_tracers_scavenged) - type = real - kind = kind_phys -[gabsbdlw] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground - long_name = total sky surface downward longwave flux absorbed by the ground - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gabsbdlw_water] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_water - long_name = total sky surface downward longwave flux absorbed by the ground over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gabsbdlw_land] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land - long_name = total sky surface downward longwave flux absorbed by the ground over land - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gabsbdlw_ice] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ice - long_name = total sky surface downward longwave flux absorbed by the ground over ice - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gamma] - standard_name = anisotropy_of_subgrid_orography - long_name = anisotropy of subgrid height_above_mean_sea_level - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gamq] - standard_name = countergradient_mixing_term_for_water_vapor - long_name = countergradient mixing term for water vapor - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gamt] - standard_name = countergradient_mixing_term_for_temperature - long_name = countergradient mixing term for temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gasvmr(:,:,1)] - standard_name = volume_mixing_ratio_of_co2 - long_name = volume mixing ratio co2 - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,2)] - standard_name = volume_mixing_ratio_of_n2o - long_name = volume mixing ratio no2 - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,3)] - standard_name = volume_mixing_ratio_of_ch4 - long_name = volume mixing ratio ch4 - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,4)] - standard_name = volume_mixing_ratio_of_o2 - long_name = volume mixing ratio o2 - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,5)] - standard_name = volume_mixing_ratio_of_co - long_name = volume mixing ratio co - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,6)] - standard_name = volume_mixing_ratio_of_cfc11 - long_name = volume mixing ratio cfc11 - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,7)] - standard_name = volume_mixing_ratio_of_cfc12 - long_name = volume mixing ratio cfc12 - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,8)] - standard_name = volume_mixing_ratio_of_cfc22 - long_name = volume mixing ratio cfc22 - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,9)] - standard_name = volume_mixing_ratio_of_ccl4 - long_name = volume mixing ratio ccl4 - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,10)] - standard_name = volume_mixing_ratio_of_cfc113 - long_name = volume mixing ratio cfc113 - units = m3 m-3 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gflx] - standard_name = upward_heat_flux_in_soil - long_name = soil heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gflx_water] - standard_name = upward_heat_flux_in_soil_over_water - long_name = soil heat flux over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gflx_land] - standard_name = upward_heat_flux_in_soil_over_land - long_name = soil heat flux over land - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gflx_ice] - standard_name = upward_heat_flux_in_soil_over_ice - long_name = soil heat flux over ice - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[graupelmp] - standard_name = lwe_thickness_of_graupel_amount - long_name = explicit graupel fall on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_gfdl_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme) -[gwdcu] - standard_name = tendency_of_x_wind_due_to_convective_gravity_wave_drag - long_name = zonal wind tendency due to convective gravity wave drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[gwdcv] - standard_name = tendency_of_y_wind_due_to_convective_gravity_wave_drag - long_name = meridional wind tendency due to convective gravity wave drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[zvfun] - standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction - long_name = function of surface roughness length and green vegetation fraction - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hffac] - standard_name = surface_upward_sensible_heat_flux_reduction_factor - long_name = surface upward sensible heat flux reduction factor from canopy heat storage - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hflxq] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness_and_vegetation - long_name = kinematic surface upward sensible heat flux reduced by surface roughness and vegetation - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hflx_water] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_water - long_name = kinematic surface upward sensible heat flux over water - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hflx_land] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_land - long_name = kinematic surface upward sensible heat flux over land - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hflx_ice] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice - long_name = kinematic surface upward sensible heat flux over ice - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[htlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels - long_name = total sky heating rate due to longwave radiation - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[htlw0] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels - long_name = clear sky heating rate due to longwave radiation - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[htswc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels - long_name = total sky heating rate due to shortwave radiation - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[htsw0] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels - long_name = clear sky heating rates due to shortwave radiation - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[icemp] - standard_name = lwe_thickness_of_ice_amount - long_name = explicit ice fall on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_gfdl_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme) -[dry] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[lake] - standard_name = flag_nonzero_lake_surface_fraction - long_name = flag indicating presence of some lake surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[ocean] - standard_name = flag_nonzero_ocean_surface_fraction - long_name = flag indicating presence of some ocean surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer -[islmsk] - standard_name = sea_land_ice_mask - long_name = sea/land/ice mask (=0/1/2) - units = flag - dimensions = (horizontal_loop_extent) - type = integer -[islmsk_cice] - standard_name = sea_land_ice_mask_cice - long_name = sea/land/ice mask cice (=0/1/2) - units = flag - dimensions = (horizontal_loop_extent) - type = integer -[itc] - standard_name = index_of_first_chemical_tracer_for_convection - long_name = index of first chemical tracer transported/scavenged by convection - units = index - dimensions = () - type = integer -[wet] - standard_name = flag_nonzero_wet_surface_fraction - long_name = flag indicating presence of some ocean or lake surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[kb] - standard_name = vertical_index_difference_between_layer_and_lower_bound - long_name = vertical index difference between layer and lower bound - units = index - dimensions = () - type = integer -[kbot] - standard_name = vertical_index_at_cloud_base - long_name = vertical index at cloud base - units = index - dimensions = (horizontal_loop_extent) - type = integer -[kcnv] - standard_name = flag_deep_convection - long_name = flag indicating whether convection occurs in column (0 or 1) - units = flag - dimensions = (horizontal_loop_extent) - type = integer -[kd] - standard_name = vertical_index_difference_between_inout_and_local - long_name = vertical index difference between in/out and local - units = index - dimensions = () - type = integer -[kinver] - standard_name = index_of_highest_temperature_inversion - long_name = index of highest temperature inversion - units = index - dimensions = (horizontal_loop_extent) - type = integer -[kpbl] - standard_name = vertical_index_at_top_of_atmosphere_boundary_layer - long_name = vertical index at top atmospheric boundary layer - units = index - dimensions = (horizontal_loop_extent) - type = integer -[kt] - standard_name = vertical_index_difference_between_layer_and_upper_bound - long_name = vertical index difference between layer and upper bound - units = index - dimensions = () - type = integer -[ktop] - standard_name = vertical_index_at_cloud_top - long_name = vertical index at cloud top - units = index - dimensions = (horizontal_loop_extent) - type = integer -[latidxprnt] - standard_name = latitude_index_in_debug_printouts - long_name = latitude index in debug printouts - units = index - dimensions = () - type = integer -[levi] - standard_name = vertical_interface_dimension_interstitial - long_name = vertical interface dimension - units = count - dimensions = () - type = integer -[lmk] - standard_name = adjusted_vertical_layer_dimension_for_radiation - long_name = adjusted number of vertical layers for radiation - units = count - dimensions = () - type = integer -[lmp] - standard_name = adjusted_vertical_level_dimension_for_radiation - long_name = adjusted number of vertical levels for radiation - units = count - dimensions = () - type = integer -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases - units = index - dimensions = (horizontal_loop_extent,3) - type = integer -[mg3_as_mg2] - standard_name = flag_mg3_as_mg2 - long_name = flag for controlling prep for Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops - units = index - dimensions = (horizontal_loop_extent,3) - type = integer -[nbdlw] - standard_name = number_of_aerosol_bands_for_longwave_radiation - long_name = number of aerosol bands for longwave radiation - units = count - dimensions = () - type = integer -[nbdsw] - standard_name = number_of_aerosol_bands_for_shortwave_radiation - long_name = number of aerosol bands for shortwave radiation - units = count - dimensions = () - type = integer -[ncgl] - standard_name = local_graupel_number_concentration - long_name = number concentration of graupel local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[ncpi] - standard_name = local_ice_number_concentration - long_name = number concentration of ice local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_shoc) -[ncpl] - standard_name = local_condesed_water_number_concentration - long_name = number concentration of condensed water local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_shoc) -[ncpr] - standard_name = local_rain_number_concentration - long_name = number concentration of rain local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[ncps] - standard_name = local_snow_number_concentration - long_name = number concentration of snow local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[ncstrac] - standard_name = number_of_tracers_for_CS - long_name = number of convectively transported tracers in Chikira-Sugiyama deep convection scheme - units = count - dimensions = () - type = integer -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer -[nf_aelw] - standard_name = number_of_aerosol_output_fields_for_longwave_radiation - long_name = number of aerosol output fields for longwave radiation - units = count - dimensions = () - type = integer -[nf_aesw] - standard_name = number_of_aerosol_output_fields_for_shortwave_radiation - long_name = number of aerosol output fields for shortwave radiation - units = count - dimensions = () - type = integer -[nn] - standard_name = number_of_tracers_for_convective_transport - long_name = number of tracers for convective transport - units = count - dimensions = () - type = integer -[nsamftrac] - standard_name = number_of_tracers_for_samf - long_name = number of tracers for scale-aware mass flux schemes - units = count - dimensions = () - type = integer -[nscav] - standard_name = number_of_tracers_scavenged - long_name = number of tracers scavenged - units = count - dimensions = () - type = integer -[nspc1] - standard_name = number_of_species_for_aerosol_optical_depth - long_name = number of species for output aerosol optical depth plus total - units = count - dimensions = () - type = integer -[ntcwx] - standard_name = index_for_liquid_cloud_condensate_vertical_diffusion_tracer - long_name = index for liquid cloud condensate in the vertically diffused tracer array - units = index - dimensions = () - type = integer -[ntiwx] - standard_name = index_for_ice_cloud_condensate_vertical_diffusion_tracer - long_name = index for ice cloud condensate in the vertically diffused tracer array - units = index - dimensions = () - type = integer -[ntrwx] - standard_name = index_for_rain_water_vertical_diffusion_tracer - long_name = tracer index for rain water in the vertically diffused tracer array - units = index - dimensions = () - type = integer -[ntk] - standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer - long_name = index for turbulent kinetic energy in the convectively transported tracer array - units = index - dimensions = () - type = integer -[ntkev] - standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer - long_name = index for turbulent kinetic energy in the vertically diffused tracer array - units = index - dimensions = () - type = integer -[nvdiff] - standard_name = number_of_vertical_diffusion_tracers - long_name = number of tracers to diffuse vertically - units = count - dimensions = () - type = integer -[oa4] - standard_name = asymmetry_of_subgrid_orography - long_name = asymmetry of subgrid height_above_mean_sea_level - units = none - dimensions = (horizontal_loop_extent,4) - type = real - kind = kind_phys -[varss] - standard_name = standard_deviation_of_subgrid_orography_small_scale - long_name = standard deviation of subgrid height_above_mean_sea_level small scale - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_drag_suite_gravity_wave_drag == 3 .or. control_for_drag_suite_gravity_wave_drag == 33) -[oa4ss] - standard_name = asymmetry_of_subgrid_orography_small_scale - long_name = asymmetry of subgrid height_above_mean_sea_level small scale - units = none - dimensions = (horizontal_loop_extent,4) - type = real - kind = kind_phys - active = (control_for_drag_suite_gravity_wave_drag == 3 .or. control_for_drag_suite_gravity_wave_drag == 33) -[oc] - standard_name = convexity_of_subgrid_orography - long_name = convexity of subgrid height_above_mean_sea_level - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ocss] - standard_name = convexity_of_subgrid_orography_small_scale - long_name = convexity of subgrid height_above_mean_sea_level small scale - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_drag_suite_gravity_wave_drag == 3 .or. control_for_drag_suite_gravity_wave_drag == 33) -[olyr] - standard_name = ozone_concentration_at_layer_for_radiation - long_name = ozone concentration layer - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[otspt] - standard_name = flag_convective_tracer_transport - long_name = flag to enable tracer transport by updrafts/downdrafts[(:,1)] or subsidence [(:,2)] - units = flag - dimensions = (number_of_tracers_plus_one,2) - type = logical -[oz_coeffp5] - standard_name = number_of_coefficients_in_ozone_forcing_data_plus_five - long_name = number of coefficients in ozone forcing data plus five - units = index - dimensions = () - type = integer -[phys_hydrostatic] - standard_name = flag_for_hydrostatic_heating_from_physics - long_name = flag for use of hydrostatic heating in physics - units = flag - dimensions = () - type = logical -[plvl] - standard_name = air_pressure_at_interface_for_radiation_in_hPa - long_name = air pressure at vertical interface for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) - type = real - kind = kind_phys -[plyr] - standard_name = air_pressure_at_layer_for_radiation_in_hPa - long_name = air pressure at vertical layer for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[prnum] - standard_name = prandtl_number - long_name = turbulent Prandtl number - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[q2mp] - standard_name = specific_humidity_at_2m_from_noahmp - long_name = 2 meter specific humidity from noahmp - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme) -[qgl] - standard_name = local_graupel_mixing_ratio - long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme .or. flag_for_shoc) -[qicn] - standard_name = mass_fraction_of_convective_cloud_ice - long_name = mass fraction of convective cloud ice water - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[qlcn] - standard_name = mass_fraction_of_convective_cloud_liquid_water - long_name = mass fraction of convective cloud liquid water - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[qlyr] - standard_name = water_vapor_specific_humidity_at_layer_for_radiation - long_name = specific humidity layer - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[qrn] - standard_name = local_rain_water_mixing_ratio - long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme .or. flag_for_shoc) -[qsnw] - standard_name = local_snow_water_mixing_ratio - long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme .or. flag_for_shoc) -[prcpmp] - standard_name = lwe_thickness_of_explicit_precipitation_amount - long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qss_water] - standard_name = surface_specific_humidity_over_water - long_name = surface air saturation specific humidity over water - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qss_land] - standard_name = surface_specific_humidity_over_land - long_name = surface air saturation specific humidity over land - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qss_ice] - standard_name = surface_specific_humidity_over_ice - long_name = surface air saturation specific humidity over ice - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[radar_reset] - standard_name = flag_for_resetting_radar_reflectivity_calculation - long_name = flag for resetting radar reflectivity calculation - units = flag - dimensions = () - type = logical -[raddt] - standard_name = time_step_for_radiation - long_name = radiation time step - units = s - dimensions = () - type = real - kind = kind_phys -[raincd] - standard_name = lwe_thickness_of_deep_convective_precipitation_amount - long_name = deep convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[raincs] - standard_name = lwe_thickness_of_shallow_convective_precipitation_amount - long_name = shallow convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rainmcadj] - standard_name = lwe_thickness_of_moist_convective_adj_precipitation_amount - long_name = adjusted moist convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rainmp] - standard_name = lwe_thickness_of_explicit_rain_amount - long_name = explicit rain on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_gfdl_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme) -[rainp] - standard_name = tendency_of_rain_water_mixing_ratio_due_to_microphysics - long_name = tendency of rain water mixing ratio due to microphysics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[rb] - standard_name = bulk_richardson_number_at_lowest_model_level - long_name = bulk Richardson number at the surface - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rb_water] - standard_name = bulk_richardson_number_at_lowest_model_level_over_water - long_name = bulk Richardson number at the surface over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rb_land] - standard_name = bulk_richardson_number_at_lowest_model_level_over_land - long_name = bulk Richardson number at the surface over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rb_ice] - standard_name = bulk_richardson_number_at_lowest_model_level_over_ice - long_name = bulk Richardson number at the surface over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[max_hourly_reset] - standard_name = flag_reset_maximum_hourly_fields - long_name = flag for resetting maximum hourly fields - units = flag - dimensions = () - type = logical -[ext_diag_thompson_reset] - standard_name = flag_reset_extended_diagnostics_output_arrays_from_thompson_microphysics - long_name = flag for resetting extended diagnostics output arrays from thompson microphysics - units = flag - dimensions = () - type = logical -[rhc] - standard_name = critical_relative_humidity - long_name = critical relative humidity - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[rho1] - standard_name = air_density_at_lowest_model_layer - long_name = air density at lowest model layer - units = kg m-3 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[runoff] - standard_name = surface_runoff_flux - long_name = surface runoff flux - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[save_q(:,:,index_of_ozone_mixing_ratio_in_tracer_concentration_array)] - standard_name = ozone_mixing_ratio_save - long_name = ozone mixing ratio before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_q(:,:,index_of_turbulent_kinetic_energy_in_tracer_concentration_array)] - standard_name = turbulent_kinetic_energy_save - long_name = turbulent kinetic energy before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_q(:,:,index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array)] - standard_name = cloud_condensed_water_mixing_ratio_save - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_q(:,:,index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array)] - standard_name = ice_water_mixing_ratio_save - long_name = cloud ice water mixing ratio before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_q(:,:,index_of_specific_humidity_in_tracer_concentration_array)] - standard_name = water_vapor_specific_humidity_save - long_name = water vapor specific humidity before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_q(:,:,index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array)] - standard_name = liquid_cloud_number_concentration_save - long_name = liquid cloud number concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_q(:,:,index_of_mass_number_concentration_of_cloud_ice_in_tracer_concentration_array)] - standard_name = ice_cloud_number_concentration_save - long_name = ice cloud number concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_tcp] - standard_name = air_temperature_save_from_convective_parameterization - long_name = air temperature after cumulus parameterization - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_u] - standard_name = x_wind_save - long_name = x-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[save_v] - standard_name = y_wind_save - long_name = y-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[sbsno] - standard_name = snow_deposition_sublimation_upward_latent_heat_flux - long_name = latent heat flux from snow depo/subl - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 - dimensions = (horizontal_loop_extent) - type = cmpfsw_type -[sfcalb] - standard_name = surface_albedo_components - long_name = surface albedo IR/UV/VIS components - units = frac - dimensions = (horizontal_loop_extent,number_of_components_for_surface_albedo) - type = real - kind = kind_phys -[sfcalb(:,1)] - standard_name = surface_albedo_due_to_near_IR_direct - long_name = surface albedo due to near IR direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfcalb(:,2)] - standard_name = surface_albedo_due_to_near_IR_diffused - long_name = surface albedo due to near IR diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfcalb(:,3)] - standard_name = surface_albedo_due_to_UV_and_VIS_direct - long_name = surface albedo due to UV+VIS direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfcalb(:,4)] - standard_name = surface_albedo_due_to_UV_and_VIS_diffused - long_name = surface albedo due to UV+VIS diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sigma] - standard_name = slope_of_subgrid_orography - long_name = slope of subgrid height_above_mean_sea_level - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sigmaf] - standard_name = bounded_vegetation_area_fraction - long_name = areal fractional cover of green vegetation bounded on the bottom - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sigmafrac] - standard_name = convective_updraft_area_fraction - long_name = convective updraft area fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[sigmatot] - standard_name = convective_updraft_area_fraction_at_model_interfaces - long_name = convective updraft area fraction at model interfaces - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[skip_macro] - standard_name = flag_skip_macro - long_name = flag to skip cloud macrophysics in Morrison scheme - units = flag - dimensions = () - type = logical -[snowc] - standard_name = surface_snow_area_fraction - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snohf] - standard_name = snow_freezing_rain_upward_latent_heat_flux - long_name = latent heat flux due to snow and frz rain - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snowmp] - standard_name = lwe_thickness_of_snow_amount - long_name = explicit snow fall on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_gfdl_microphysics_scheme .or. control_for_microphysics_scheme == identifier_for_thompson_microphysics_scheme) -[snowmt] - standard_name = surface_snow_melt - long_name = snow melt during timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[stress] - standard_name = surface_wind_stress - long_name = surface wind stress - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[stress_water] - standard_name = surface_wind_stress_over_water - long_name = surface wind stress over water - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[stress_land] - standard_name = surface_wind_stress_over_land - long_name = surface wind stress over land - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[stress_ice] - standard_name = surface_wind_stress_over_ice - long_name = surface wind stress over ice - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[t2mmp] - standard_name = temperature_at_2m_from_noahmp - long_name = 2 meter temperature from noahmp - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme) -[theta] - standard_name = angle_from_east_of_maximum_subgrid_orographic_variations - long_name = angle with_respect to east of maximum subgrid orographic variations - units = degree - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tlvl] - standard_name = air_temperature_at_interface_for_radiation - long_name = air temperature at vertical interface for radiation calculation - units = K - dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) - type = real - kind = kind_phys -[tlyr] - standard_name = air_temperature_at_layer_for_radiation - long_name = air temperature at vertical layer for radiation calculation - units = K - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[tprcp_water] - standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_water - long_name = total precipitation amount in each time step over water - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tprcp_land] - standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land - long_name = total precipitation amount in each time step over land - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tprcp_ice] - standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice - long_name = total precipitation amount in each time step over ice - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tracers_start_index] - standard_name = start_index_of_other_tracers - long_name = beginning index of the non-water tracer species - units = index - dimensions = () - type = integer -[tracers_total] - standard_name = number_of_total_tracers - long_name = total number of tracers - units = count - dimensions = () - type = integer -[trans_aero] - standard_name = flag_for_aerosol_convective_transport_and_PBL_diffusion - long_name = flag for aerosol convective transport and PBL diffusion - units = flag - dimensions = () - type = logical -[trans] - standard_name = transpiration_flux - long_name = total plant transpiration rate - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tseal] - standard_name = surface_skin_temperature_for_nsst - long_name = ocean surface skin temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfc_water] - standard_name = surface_skin_temperature_over_water - long_name = surface skin temperature over water - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsurf_water] - standard_name = surface_skin_temperature_after_iteration_over_water - long_name = surface skin temperature after iteration over water - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsurf_land] - standard_name = surface_skin_temperature_after_iteration_over_land - long_name = surface skin temperature after iteration over land - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsurf_ice] - standard_name = surface_skin_temperature_after_iteration_over_ice - long_name = surface skin temperature after iteration over ice - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tracers_water] - standard_name = number_of_water_tracers - long_name = number of water-related tracers - units = count - dimensions = () - type = integer -[ud_mf] - standard_name = instantaneous_atmosphere_updraft_convective_mass_flux - long_name = (updraft mass flux) * delt - units = kg m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[uustar_water] - standard_name = surface_friction_velocity_over_water - long_name = surface friction velocity over water - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[uustar_land] - standard_name = surface_friction_velocity_over_land - long_name = surface friction velocity over land - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[uustar_ice] - standard_name = surface_friction_velocity_over_ice - long_name = surface friction velocity over ice - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[vdftra] - standard_name = vertically_diffused_tracer_concentration - long_name = tracer concentration diffused by PBL scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_vertical_diffusion_tracers) - type = real - kind = kind_phys -[lndp_vgf] - standard_name = magnitude_of_perturbation_of_vegetation_fraction - long_name = magnitude of perturbation of vegetation fraction - units = frac - dimensions = () - type = real - kind = kind_phys -[vegf1d] - standard_name = perturbation_of_vegetation_fraction - long_name = perturbation of vegetation fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[w_upi] - standard_name = vertical_velocity_for_updraft - long_name = vertical velocity for updraft - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (control_for_microphysics_scheme == identifier_for_morrison_gettelman_microphysics_scheme) -[wcbmax] - standard_name = maximum_updraft_velocity_at_cloud_base - long_name = maximum updraft velocity at cloud base - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[wind] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[work1] - standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes - long_name = grid size related coefficient used in scale-sensitive schemes - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[work2] - standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement - long_name = complement to work1 - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[work3] - standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer - long_name = Exner function ratio bt midlayer and interface at 1st layer - units = ratio - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xcosz] - standard_name = instantaneous_cosine_of_zenith_angle - long_name = cosine of zenith angle at current time - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xlai1d] - standard_name = perturbation_of_leaf_area_index - long_name = perturbation of leaf area index - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xmu] - standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes - long_name = zenith angle temporal adjustment factor for shortwave - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[z01d] - standard_name = perturbation_of_momentum_roughness_length - long_name = perturbation of momentum roughness length - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ztmax_water] - standard_name = bounded_surface_roughness_length_for_heat_over_water - long_name = bounded surface roughness length for heat over water - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ztmax_land] - standard_name = bounded_surface_roughness_length_for_heat_over_land - long_name = bounded surface roughness length for heat over land - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ztmax_ice] - standard_name = bounded_surface_roughness_length_for_heat_over_ice - long_name = bounded surface roughness length for heat over ice - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zt1d] - standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio - long_name = perturbation of heat to momentum roughness length ratio - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zmtb] - standard_name = height_of_mountain_blocking - long_name = height of mountain blocking drag - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dudt_ngw] - standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag - long_name = zonal wind tendency due to non-stationary GWs - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. control_for_drag_suite_gravity_wave_drag==33 .or. control_for_drag_suite_gravity_wave_drag==22 .or. control_for_drag_suite_gravity_wave_drag==3 .or. control_for_drag_suite_gravity_wave_drag==2) -[dvdt_ngw] - standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag - long_name = meridional wind tendency due to non-stationary GWs - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. control_for_drag_suite_gravity_wave_drag==33 .or. control_for_drag_suite_gravity_wave_drag==22 .or. control_for_drag_suite_gravity_wave_drag==3 .or. control_for_drag_suite_gravity_wave_drag==2) -[dtdt_ngw] - standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag - long_name = air temperature tendency due to non-stationary GWs - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. control_for_drag_suite_gravity_wave_drag==33 .or. control_for_drag_suite_gravity_wave_drag==22 .or. control_for_drag_suite_gravity_wave_drag==3 .or. control_for_drag_suite_gravity_wave_drag==2) -[kdis_ngw] - standard_name = atmosphere_momentum_diffusivity_due_to_nonorographic_gravity_wave_drag - long_name = eddy mixing due to non-stationary GWs - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. control_for_drag_suite_gravity_wave_drag==33 .or. control_for_drag_suite_gravity_wave_drag==22 .or. control_for_drag_suite_gravity_wave_drag==3 .or. control_for_drag_suite_gravity_wave_drag==2) -[zlwb] - standard_name = height_of_low_level_wave_breaking - long_name = height of low level wave breaking - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zogw] - standard_name = height_of_launch_level_of_orographic_gravity_wave - long_name = height of launch level of orographic gravity wave - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zngw] - standard_name = height_of_launch_level_of_nonorographic_gravity_waves - long_name = height of launch level of non-stationary GWs - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_tofd] - standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag - long_name = instantaneous momentum flux due to TOFD - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_mtb] - standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag - long_name = instantaneous momentum flux due to mountain blocking drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_ogw] - standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag - long_name = instantaneous momentum flux due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_oss] - standard_name = momentum_flux_due_to_subgrid_scale_orographic_gravity_wave_drag - long_name = momentum flux or stress due to SSO including OBL-OSS-OFD - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_ngw] - standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave - long_name = instantaneous momentum flux due to nonstationary gravity waves - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dudt_mtb] - standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag - long_name = instantaneous change in x wind due to mountain blocking drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[dudt_tms] - standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag - long_name = instantaneous change in x wind due to TOFD - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[qs_lay] - standard_name = saturation_vapor_pressure - long_name = saturation vapor pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[q_lay] - standard_name = water_vapor_mixing_ratio - long_name = water vaport mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP - long_name = air pressure layer - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure level - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[t_lev] - standard_name = air_temperature_at_interface_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[relhum] - standard_name = relative_humidity - long_name = layer relative humidity - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[deltaZ] - standard_name = layer_thickness - long_name = layer_thickness - units = m - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[cloud_overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter for RRTMGP (but not for RRTMG) - units = km - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[precip_overlap_param] - standard_name = precip_overlap_param - long_name = precipitation overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxlwUP_allsky] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxlwDOWN_allsky] - standard_name = RRTMGP_lw_flux_profile_downward_allsky - long_name = RRTMGP downward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxlwUP_clrsky] - standard_name = RRTMGP_lw_flux_profile_upward_clrsky - long_name = RRTMGP upward longwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxlwDOWN_clrsky] - standard_name = RRTMGP_lw_flux_profile_downward_clrsky - long_name = RRTMGP downward longwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxswUP_allsky] - standard_name = RRTMGP_sw_flux_profile_upward_allsky - long_name = RRTMGP upward shortwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxswDOWN_allsky] - standard_name = RRTMGP_sw_flux_profile_downward_allsky - long_name = RRTMGP downward shortwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxswUP_clrsky] - standard_name = RRTMGP_sw_flux_profile_upward_clrsky - long_name = RRTMGP upward shortwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxswDOWN_clrsky] - standard_name = RRTMGP_sw_flux_profile_downward_clrsky - long_name = RRTMGP downward shortwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[flxprf_lw] - standard_name = RRTMGP_lw_fluxes - long_name = lw fluxes total sky / csk and up / down at levels - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = proflw_type - active = (flag_for_rrtmgp_radiation_scheme) -[flxprf_sw] - standard_name = RRTMGP_sw_fluxes - long_name = sw fluxes total sky / csk and up / down at levels - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = profsw_type - active = (flag_for_rrtmgp_radiation_scheme) -[aerosolslw] - standard_name = RRTMGP_aerosol_optical_properties_for_longwave_bands_01_16 - long_name = aerosol optical properties for longwave bands 01-16 - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_longwave_bands,number_of_aerosol_output_fields_for_longwave_radiation) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[aerosolslw(:,:,:,1)] - standard_name = RRTMGP_aerosol_optical_depth_for_longwave_bands_01_16 - long_name = aerosol optical depth for longwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_longwave_bands) - type = real - kind = kind_phys -[aerosolslw(:,:,:,2)] - standard_name = RRTMGP_aerosol_single_scattering_albedo_for_longwave_bands_01_16 - long_name = aerosol single scattering albedo for longwave bands 01-16 - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_longwave_bands) - type = real - kind = kind_phys -[aerosolslw(:,:,:,3)] - standard_name = RRTMGP_aerosol_asymmetry_parameter_for_longwave_bands_01_16 - long_name = aerosol asymmetry parameter for longwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_longwave_bands) - type = real - kind = kind_phys -[aerosolssw] - standard_name = RRTMGP_aerosol_optical_properties_for_shortwave_bands_01_16 - long_name = aerosol optical properties for shortwave bands 01-16 - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_shortwave_bands, number_of_aerosol_output_fields_for_shortwave_radiation) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[aerosolssw(:,:,:,1)] - standard_name = RRTMGP_aerosol_optical_depth_for_shortwave_bands_01_16 - long_name = aerosol optical depth for shortwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_shortwave_bands) - type = real - kind = kind_phys -[aerosolssw(:,:,:,2)] - standard_name = RRTMGP_aerosol_single_scattering_albedo_for_shortwave_bands_01_16 - long_name = aerosol single scattering albedo for shortwave bands 01-16 - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_shortwave_bands) - type = real - kind = kind_phys -[aerosolssw(:,:,:,3)] - standard_name = RRTMGP_aerosol_asymmetry_parameter_for_shortwave_bands_01_16 - long_name = aerosol asymmetry parameter for shortwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension, number_of_shortwave_bands) - type = real - kind = kind_phys -[precip_frac] - standard_name = precipitation_fraction_by_layer - long_name = precipitation fraction in each layer - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_clrsky] - standard_name = shortwave_optical_properties_for_clear_sky - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_cloudsByBand] - standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_precipByBand] - standard_name = shortwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_precip] - standard_name = shortwave_optical_properties_for_precipitation - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_clouds] - standard_name = shortwave_optical_properties_for_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_aerosol] - standard_name = shortwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[gas_concentrations] - standard_name = Gas_concentrations_for_RRTMGP_suite - long_name = DDT containing gas concentrations for RRTMGP radiation scheme - units = DDT - dimensions = () - type = ty_gas_concs - active = (flag_for_rrtmgp_radiation_scheme) -[sources] - standard_name = longwave_source_function - long_name = Fortran DDT containing RRTMGP source functions - units = DDT - dimensions = () - type = ty_source_func_lw - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_clrsky] - standard_name = longwave_optical_properties_for_clear_sky - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_clouds] - standard_name = longwave_optical_properties_for_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_precip] - standard_name = longwave_optical_properties_for_precipitation - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_cloudsByBand] - standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_precipByBand] - standard_name = longwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_aerosol] - standard_name = longwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_emiss_byband] - standard_name = surface_emissivity_in_each_RRTMGP_LW_band - long_name = surface emissivity in each RRTMGP LW band - units = none - dimensions = (number_of_longwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sec_diff_byband] - standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band - long_name = secant of diffusivity angle in each RRTMGP LW band - units = none - dimensions = (number_of_longwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_alb_nir_dir] - standard_name = surface_albedo_nearIR_direct - long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) - units = none - dimensions = (number_of_shortwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_alb_nir_dif] - standard_name = surface_albedo_nearIR_diffuse - long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) - units = none - dimensions = (number_of_shortwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_alb_uvvis_dir] - standard_name = surface_albedo_uvvis_direct - long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) - units = none - dimensions = (number_of_shortwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_alb_uvvis_dif] - standard_name = surface_albedo_uvvis_diffuse - long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) - units = none - dimensions = (number_of_shortwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[toa_src_lw] - standard_name = toa_incident_lw_flux_by_spectral_point - long_name = TOA longwave incident flux at each spectral points - units = W m-2 - dimensions = (horizontal_loop_extent,number_of_longwave_spectral_points) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[toa_src_sw] - standard_name = toa_incident_sw_flux_by_spectral_point - long_name = TOA shortwave incident flux at each spectral points - units = W m-2 - dimensions = (horizontal_loop_extent,number_of_shortwave_spectral_points) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[rtg_ozone_index] - standard_name = vertically_diffused_tracer_index_of_ozone - long_name = number of tracers - units = count - dimensions = () - type = integer - -######################################################################## -[ccpp-table-properties] - name = GFS_data_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_data_type + name = GFS_data_type type = ddt [Statein] standard_name = GFS_statein_type_instance @@ -10433,9 +8466,8 @@ name = GFS_typedefs type = module relative_path = ../physics/physics - dependencies = machine.F,physcons.F90,radlw_param.f,radsw_param.f,GFDL_parse_tracers.F90 - dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 - dependencies = rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_rte_config.F90,rte-rrtmgp/rte/mo_source_functions.F90 + dependencies = machine.F,physcons.F90,radlw_param.f,radsw_param.f + dependencies = GFDL_parse_tracers.F90,h2o_def.f,ozne_def.f [ccpp-arg-table] name = GFS_typedefs @@ -10476,12 +8508,6 @@ units = DDT dimensions = () type = GFS_grid_type -[GFS_interstitial_type] - standard_name = GFS_interstitial_type - long_name = definition of type GFS_interstitial_type - units = DDT - dimensions = () - type = GFS_interstitial_type [GFS_radtend_type] standard_name = GFS_radtend_type long_name = definition of type GFS_radtend_type diff --git a/ccpp/driver/CCPP_driver.F90 b/ccpp/driver/CCPP_driver.F90 index 392b37151..ec36e2ad3 100644 --- a/ccpp/driver/CCPP_driver.F90 +++ b/ccpp/driver/CCPP_driver.F90 @@ -1,6 +1,6 @@ module CCPP_driver - use ccpp_api, only: ccpp_t + use ccpp_types, only: ccpp_t use ccpp_static_api, only: ccpp_physics_init, & ccpp_physics_timestep_init, & @@ -101,8 +101,8 @@ subroutine CCPP_step (step, nblks, ierr) else if (trim(step)=="physics_init") then ! Since the physics init step is independent of the blocking structure, - ! we can use cdata_domain here. Since we don't use threading on the outside, - ! we can allow threading inside the physics init routines. + ! we can use cdata_domain. And since we don't use threading on the host + ! model side, we can allow threading inside the physics init routines. GFS_control%nthreads = nthrds call ccpp_physics_init(cdata_domain, suite_name=trim(ccpp_suite), ierr=ierr) @@ -116,8 +116,8 @@ subroutine CCPP_step (step, nblks, ierr) else if (trim(step)=="timestep_init") then ! Since the physics timestep init step is independent of the blocking structure, - ! we can use cdata_domain here. Since we don't use threading on the outside, - ! we can allow threading inside the timestep init (time_vary) routines. + ! we can use cdata_domain. And since we don't use threading on the host + ! model side, we can allow threading inside the timestep init (time_vary) routines. GFS_control%nthreads = nthrds call ccpp_physics_timestep_init(cdata_domain, suite_name=trim(ccpp_suite), group_name="time_vary", ierr=ierr) @@ -149,7 +149,7 @@ subroutine CCPP_step (step, nblks, ierr) endif !--- determine if physics diagnostics buckets need to be cleared - if (mod(GFS_control%kdt,GFS_control%nszero) == 1) then + if ((mod(GFS_control%kdt-1,GFS_control%nszero)) == 0) then do nb = 1,nblks call GFS_data(nb)%Intdiag%phys_zero(GFS_control) end do @@ -159,11 +159,11 @@ subroutine CCPP_step (step, nblks, ierr) ! *DH 20210104 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Radiation and stochastic physics + ! Radiation, physics and and stochastic physics - threaded regions using blocked data structures else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then ! Set number of threads available to physics schemes to one, - ! because threads are used on the outside for blocking + ! because threads are used on the host model side for blocking GFS_control%nthreads = 1 !$OMP parallel num_threads (nthrds) & @@ -188,8 +188,8 @@ subroutine CCPP_step (step, nblks, ierr) call ccpp_physics_run(cdata_block(nb,ntX), suite_name=trim(ccpp_suite), group_name=trim(step), ierr=ierr2) if (ierr2/=0) then write(0,'(2a,3(a,i4),a)') "An error occurred in ccpp_physics_run for group ", trim(step), & - ", block ", nb, " and thread ", nt, " (ntX=", ntX, ")" - write(0,'(a)') trim(cdata_block(nb,nt)%errmsg) + ", block ", nb, " and thread ", nt, " (ntX=", ntX, "):" + write(0,'(a)') trim(cdata_block(nb,ntX)%errmsg) ierr = ierr + ierr2 end if end do @@ -202,7 +202,7 @@ subroutine CCPP_step (step, nblks, ierr) else if (trim(step)=="timestep_finalize") then ! Since the physics timestep finalize step is independent of the blocking structure, - ! we can use cdata_domain here. Since we don't use threading on the outside, + ! we can use cdata_domain. And since we don't use threading on the host model side, ! we can allow threading inside the timestep finalize (time_vary) routines. GFS_control%nthreads = nthrds @@ -213,27 +213,23 @@ subroutine CCPP_step (step, nblks, ierr) return end if - ! Finalize - else if (trim(step)=="finalize") then + ! Physics finalize + else if (trim(step)=="physics_finalize") then - ! Loop over blocks, don't use threading on the outside but allowing threading - ! inside the finalization, similar to what is done for the initialization + ! Since the physics finalize step is independent of the blocking structure, + ! we can use cdata_domain. And since we don't use threading on the host + ! model side, we can allow threading inside the physics finalize routines. GFS_control%nthreads = nthrds - ! Fast physics are finalized in atmosphere_end, loop over - ! all blocks and threads to finalize all other physics - do nt=1,nthrdsX - do nb=1,nblks - !--- Finalize CCPP physics - call ccpp_physics_finalize(cdata_block(nb,nt), suite_name=trim(ccpp_suite), ierr=ierr) - if (ierr/=0) then - write(0,'(a,i4,a,i4)') "An error occurred in ccpp_physics_finalize for block ", nb, " and thread ", nt - write(0,'(a)') trim(cdata_block(nb,nt)%errmsg) - return - end if - end do - end do + call ccpp_physics_finalize(cdata_domain, suite_name=trim(ccpp_suite), ierr=ierr) + if (ierr/=0) then + write(0,'(a)') "An error occurred in ccpp_physics_finalize" + write(0,'(a)') trim(cdata_domain%errmsg) + return + end if + ! Finalize + else if (trim(step)=="finalize") then ! Deallocate cdata structure for blocks and threads if (allocated(cdata_block)) deallocate(cdata_block) diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 8d9e67cdb..dd8eaed80 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 @@ -1764,6 +1764,20 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ! if(mpp_pe()==mpp_root_pe())print *,'in gfdl_diag_register,af totgrp,idx=',idx +!--- RRFS Smoke --- + if (Model%rrfs_smoke) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'dqdti' + ExtDiag(idx)%desc = 'dqdti' + ExtDiag(idx)%unit = 'kg kg-1 s-1' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%dqdti(:,:) + enddo + endif + !--- physics instantaneous diagnostics --- idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2296,28 +2310,83 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo endif - if (Model%lndp_type /= 0) then + if (Model%do_spp) then idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'sfc_wts1' - ExtDiag(idx)%desc = 'perturbation amplitude' - ExtDiag(idx)%unit = 'none' + 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)%var2 => Coupling(nb)%sfc_wts(:,1) + 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 - ExtDiag(idx)%name = 'sfc_wts2' + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'sfc_wts' ExtDiag(idx)%desc = 'perturbation amplitude' ExtDiag(idx)%unit = 'none' ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%sfc_wts(:,2) + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%sfc_wts(:,:) enddo + endif if (Model%do_ca) then @@ -3476,39 +3545,205 @@ 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 + if (Model%rrfs_smoke .and. Model%ntsmoke>0) then + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'emdust' + ExtDiag(idx)%desc = 'emission of dust for smoke' + ExtDiag(idx)%unit = 'ug m-2 s-1' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%emdust + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'emseas' + ExtDiag(idx)%desc = 'emission of seas for smoke' + ExtDiag(idx)%unit = 'ug m-2 s-1' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%emseas + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'emanoc' + ExtDiag(idx)%desc = 'emission of anoc for thompson mp' + ExtDiag(idx)%unit = 'ug m-2 s-1' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%emanoc + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'coef_bb_dc' + ExtDiag(idx)%desc = 'coeff bb for smoke' + ExtDiag(idx)%unit = '' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%coef_bb_dc + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'min_fplume' + ExtDiag(idx)%desc = 'minimum smoke plume height' + ExtDiag(idx)%unit = '' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%min_fplume + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'max_fplume' + ExtDiag(idx)%desc = 'maximum smoke plume height' + ExtDiag(idx)%unit = '' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%max_fplume + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'HWP' + ExtDiag(idx)%desc = 'hourly fire weather potential' + ExtDiag(idx)%unit = ' ' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%rrfs_hwp + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'ebb_smoke_hr' + ExtDiag(idx)%desc = 'hourly smoke emission' + ExtDiag(idx)%unit = 'ug m-2 s-1' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ebb_smoke_hr + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'frp_hr' + ExtDiag(idx)%desc = 'hourly frp' + ExtDiag(idx)%unit = 'mw' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%frp_hr + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'frp_std_hr' + ExtDiag(idx)%desc = 'hourly std frp' + ExtDiag(idx)%unit = 'mw' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%frp_std_hr + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'ebu_smoke' + ExtDiag(idx)%desc = 'smoke emission' + ExtDiag(idx)%unit = 'ug/m2/s' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%ebu_smoke(:,:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'smoke_ext' + ExtDiag(idx)%desc = 'smoke extinction at 550nm' + ExtDiag(idx)%unit = ' ' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%smoke_ext(:,:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'dust_ext' + ExtDiag(idx)%desc = 'dust extinction at 550nm' + ExtDiag(idx)%unit = ' ' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%dust_ext(:,:) + 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 .or. & + Model%imp_physics == Model%imp_physics_nssl ) 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_init.F90 b/ccpp/driver/GFS_init.F90 index 70f0f8494..793ed4c2e 100644 --- a/ccpp/driver/GFS_init.F90 +++ b/ccpp/driver/GFS_init.F90 @@ -6,8 +6,8 @@ module GFS_init GFS_sfcprop_type, GFS_coupling_type, & GFS_control_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type, & - GFS_interstitial_type + GFS_radtend_type, GFS_diag_type + use CCPP_typedefs, only: GFS_interstitial_type implicit none @@ -17,6 +17,7 @@ module GFS_init ! Public entities !---------------- public GFS_initialize !< GFS initialization routine + public GFS_grid_populate !< Lat/lon/area setting -- exposed for moving nest CONTAINS !******************************************************************************************* diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index e4c4061f1..4774ff299 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,25 +115,47 @@ 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 + ! General Convection + if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then + Restart%num3d = Restart%num3d + 1 + endif ! GF 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 + !Prognostic area fraction + if (Model%progsigma) then + Restart%num3d = Restart%num3d + 2 + endif + + if (Model%num_dfi_radar > 0) then + do itime=1,Model%dfi_radar_max_intervals + if(Model%ix_dfi_radar(itime)>0) then + Restart%num3d = Restart%num3d + 1 + endif + enddo + endif allocate (Restart%name2d(Restart%num2d)) allocate (Restart%name3d(Restart%num3d)) @@ -305,6 +327,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 @@ -320,6 +402,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 @@ -336,12 +435,36 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%data(nb,num)%var3p => IntDiag(nb)%refl_10cm(:,:) enddo endif - if (Model%lrefres) then num = Model%ntot3d+1 else num = Model%ntot3d endif + + !Prognostic closure + if(Model%progsigma)then + num = num + 1 + Restart%name3d(num) = 'sas_3d_qgrs_dsave' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Tbd(nb)%prevsq(:,:) + enddo + num = num + 1 + Restart%name3d(num) = 'sas_3d_dqdt_qmicro' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Coupling(nb)%dqdt_qmicro(:,:) + enddo + endif + + !--Convection variable used in CB cloud fraction. Presently this + !--is only needed in sgscloud_radpre for imfdeepcnv == imfdeepcnv_gf. + if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then + num = num + 1 + Restart%name3d(num) = 'cnv_3d_ud_mf' + do nb = 1,nblks + Restart%data(nb,num)%var3p => Tbd(nb)%ud_mf(:,:) + enddo + endif + !--- RAP/HRRR-specific variables, 3D ! GF if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then @@ -410,6 +533,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..167313e02 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 64b5afd1352d709f3b72734bf960e36024a838d3 +Subproject commit 167313e029f62833a7390fac06cfe3869b00b2da diff --git a/ccpp/physics b/ccpp/physics index 98ebf42c0..9cfe75e0b 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 98ebf42c08d960addf4debe08226aff79e960211 +Subproject commit 9cfe75e0b3986f7d11c3f54cc7afb1d4ca67ba3e diff --git a/ccpp/suites/suite_FV3_CPT_v0.xml b/ccpp/suites/suite_FV3_CPT_v0.xml index 97780d609..b239bdb0a 100644 --- a/ccpp/suites/suite_FV3_CPT_v0.xml +++ b/ccpp/suites/suite_FV3_CPT_v0.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017.xml b/ccpp/suites/suite_FV3_GFS_2017.xml index e9a558052..01996d34b 100644 --- a/ccpp/suites/suite_FV3_GFS_2017.xml +++ b/ccpp/suites/suite_FV3_GFS_2017.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_csawmg.xml b/ccpp/suites/suite_FV3_GFS_2017_csawmg.xml index 634b6f1bc..dd7a2d421 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_csawmg.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_csawmg.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml b/ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml index 3cf427182..a8210303d 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml index fc50b260d..4538a691c 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml index 77ffb364b..8e7e56605 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml index b68ae6324..a7aeda91a 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml index d9b253972..94ea0134a 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml b/ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml index 0f74901cb..9c481b3b0 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_myj.xml b/ccpp/suites/suite_FV3_GFS_2017_myj.xml index 44fbc8e8b..bc426c0dd 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_myj.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_myj.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml b/ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml index 5f7e38fc6..98cb3f658 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml b/ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml index 8cadb634c..82ca8a779 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_sas.xml b/ccpp/suites/suite_FV3_GFS_2017_sas.xml index 2a3c81ce8..0a5409419 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_sas.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_sas.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml b/ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml index 554a8e27a..2b2d9b87d 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml b/ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml index 665b592d1..1f7072b28 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_shinhong.xml b/ccpp/suites/suite_FV3_GFS_2017_shinhong.xml index 8e97dcff7..1a47f747f 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_shinhong.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_shinhong.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_stretched.xml b/ccpp/suites/suite_FV3_GFS_2017_stretched.xml index afce01ff5..1c213c760 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_stretched.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_stretched.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_2017_ysu.xml b/ccpp/suites/suite_FV3_GFS_2017_ysu.xml index b5421d98e..677530687 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_ysu.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_ysu.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml index 49aef95fd..339c0b087 100644 --- a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml index 48454781d..9a1e946ba 100644 --- a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml index e271f2adb..8de2261ac 100644 --- a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml index 2c844d67a..63a8d22c0 100644 --- a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml index 7a4ac83b5..a04344b22 100644 --- a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml index 73db27626..cd37e1b4a 100644 --- a/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml index f81376bc1..201c074c5 100644 --- a/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15.xml b/ccpp/suites/suite_FV3_GFS_v15.xml index e2910d586..c712c71fe 100644 --- a/ccpp/suites/suite_FV3_GFS_v15.xml +++ b/ccpp/suites/suite_FV3_GFS_v15.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15_gf.xml b/ccpp/suites/suite_FV3_GFS_v15_gf.xml index ac4d30e09..f0422a5af 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_gf.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_gf.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml b/ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml index 333a9f966..747e6fa0a 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15_mynn.xml b/ccpp/suites/suite_FV3_GFS_v15_mynn.xml index 765911524..7cfeaee11 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_mynn.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_mynn.xml @@ -21,7 +21,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15_ras.xml b/ccpp/suites/suite_FV3_GFS_v15_ras.xml index c97e8ca3f..e03b8b3a8 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_ras.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_ras.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml index 13c386267..c0d95d323 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson.xml b/ccpp/suites/suite_FV3_GFS_v15_thompson.xml index a26ec33fd..b911e489c 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_thompson.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_thompson.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml index 882f4ada0..b52da32cd 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml index f5da59232..3bca27630 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15p2.xml b/ccpp/suites/suite_FV3_GFS_v15p2.xml index 10c8e363a..e87305c66 100644 --- a/ccpp/suites/suite_FV3_GFS_v15p2.xml +++ b/ccpp/suites/suite_FV3_GFS_v15p2.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15p2_no_nsst.xml b/ccpp/suites/suite_FV3_GFS_v15p2_no_nsst.xml index d5c965ccb..870ee75d9 100644 --- a/ccpp/suites/suite_FV3_GFS_v15p2_no_nsst.xml +++ b/ccpp/suites/suite_FV3_GFS_v15p2_no_nsst.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15plus.xml b/ccpp/suites/suite_FV3_GFS_v15plus.xml index ef91b9a8b..61c11cd5e 100644 --- a/ccpp/suites/suite_FV3_GFS_v15plus.xml +++ b/ccpp/suites/suite_FV3_GFS_v15plus.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15plusras.xml b/ccpp/suites/suite_FV3_GFS_v15plusras.xml index 1bbbe4ae3..1317676d1 100644 --- a/ccpp/suites/suite_FV3_GFS_v15plusras.xml +++ b/ccpp/suites/suite_FV3_GFS_v15plusras.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16.xml b/ccpp/suites/suite_FV3_GFS_v16.xml index 2f76cee2b..122b937e1 100644 --- a/ccpp/suites/suite_FV3_GFS_v16.xml +++ b/ccpp/suites/suite_FV3_GFS_v16.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled.xml b/ccpp/suites/suite_FV3_GFS_v16_coupled.xml index b529bf27f..90c1b3ce6 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_coupled.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_coupled.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_noahmp.xml b/ccpp/suites/suite_FV3_GFS_v16_coupled_noahmp.xml index 306b37656..96d615e33 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_coupled_noahmp.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_coupled_noahmp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmp.xml b/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmp.xml index ccc58c0a5..70676ec7f 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmp.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml b/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml index a745a5056..9825441a5 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_p7_rrtmgp.xml b/ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml similarity index 76% rename from ccpp/suites/suite_FV3_GFS_v16_coupled_p7_rrtmgp.xml rename to ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml index 055f14dde..df3364d0e 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_coupled_p7_rrtmgp.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml @@ -1,6 +1,6 @@ - + @@ -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 + rad_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_GFSv17alp_cpldnsstrasugwprrtmgp.xml b/ccpp/suites/suite_FV3_GFS_v16_coupled_p8_sfcocn.xml similarity index 72% rename from ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwprrtmgp.xml rename to ccpp/suites/suite_FV3_GFS_v16_coupled_p8_sfcocn.xml index ab494c52a..09ab367ba 100644 --- a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwprrtmgp.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_coupled_p8_sfcocn.xml @@ -1,6 +1,6 @@ - + @@ -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 + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post @@ -55,12 +45,10 @@ sfc_diff GFS_surface_loop_control_part1 - lsm_noah + sfc_ocean + noahmpdrv sfc_cice sfc_sice - sfc_nst_pre - sfc_nst - sfc_nst_post GFS_surface_loop_control_part2 @@ -82,7 +70,7 @@ get_phi_fv3 GFS_suite_interstitial_3 GFS_DCNV_generic_pre - rascnv + samfdeepcnv GFS_DCNV_generic_post GFS_SCNV_generic_pre samfshalcnv diff --git a/ccpp/suites/suite_FV3_GFS_v16_couplednsst.xml b/ccpp/suites/suite_FV3_GFS_v16_couplednsst.xml index df4c32414..a00d4dfaf 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_couplednsst.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_couplednsst.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml b/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml index 3f782047f..8c32e3d76 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_flake.xml b/ccpp/suites/suite_FV3_GFS_v16_flake.xml index 60d245402..12c48225f 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_flake.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_flake.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml b/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml index b3de0328d..d8cafbbd0 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_no_nsst.xml b/ccpp/suites/suite_FV3_GFS_v16_no_nsst.xml index ff5408de5..9191333a9 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_no_nsst.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_no_nsst.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_noahmp.xml b/ccpp/suites/suite_FV3_GFS_v16_noahmp.xml index d2594fb48..dc941c20b 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_noahmp.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_noahmp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml b/ccpp/suites/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml index 27bd85442..a9b051b10 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_p8.xml b/ccpp/suites/suite_FV3_GFS_v16_p8.xml index ef860e66d..deede436e 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 + rad_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_GFS_v16_ras.xml b/ccpp/suites/suite_FV3_GFS_v16_ras.xml index fd43954ca..be4aa4a13 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_ras.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_ras.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_thompson.xml b/ccpp/suites/suite_FV3_GFS_v16_thompson.xml index 43283b636..2bdd8a9e7 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_thompson.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_thompson.xml @@ -15,7 +15,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_ugwpv1.xml b/ccpp/suites/suite_FV3_GFS_v16_ugwpv1.xml index 915e0b837..c477a1531 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_ugwpv1.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_ugwpv1.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v16_RRTMGP.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml similarity index 66% rename from ccpp/suites/suite_FV3_GFS_v16_RRTMGP.xml rename to ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml index d161e34b1..4a2cb64fc 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_RRTMGP.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml @@ -1,16 +1,11 @@ - + - - - fv_sat_adj - - GFS_time_vary_pre - GFS_rrtmgp_setup + GFS_rrtmg_setup GFS_rad_time_vary GFS_phys_time_vary @@ -18,25 +13,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 + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post @@ -58,7 +43,8 @@ sfc_nst_pre sfc_nst sfc_nst_post - lsm_noah + noahmpdrv + sfc_cice sfc_sice GFS_surface_loop_control_part2 @@ -72,8 +58,8 @@ satmedmfvdifq GFS_PBL_generic_post GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post + unified_ugwp + unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update ozphys_2015 @@ -89,15 +75,21 @@ GFS_suite_interstitial_4 cnvc90 GFS_MP_generic_pre - gfdl_cloud_microphys - GFS_MP_generic_post - maximum_hourly_diagnostics - phys_tend - + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + GFS_stochastics + phys_tend diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml new file mode 100644 index 000000000..b68abf3f2 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.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 + GFS_rrtmg_pre + GFS_radiation_surface + rad_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_ocean + 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 + 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 + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + phys_tend + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8.xml b/ccpp/suites/suite_FV3_GFS_v17_p8.xml new file mode 100644 index 000000000..c4b295a6d --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_p8.xml @@ -0,0 +1,95 @@ + + + + + + + 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 + rad_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_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 + 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 + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + phys_tend + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v16_p7_rrtmgp.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_rrtmgp.xml similarity index 83% rename from ccpp/suites/suite_FV3_GFS_v16_p7_rrtmgp.xml rename to ccpp/suites/suite_FV3_GFS_v17_p8_rrtmgp.xml index e02969d3f..8b87043f4 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_p7_rrtmgp.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_rrtmgp.xml @@ -1,12 +1,7 @@ - + - - - fv_sat_adj - - GFS_time_vary_pre @@ -20,19 +15,18 @@ GFS_suite_interstitial_rad_reset GFS_rrtmgp_pre GFS_radiation_surface - GFS_rrtmgp_gfdlmp_pre - GFS_rrtmgp_cloud_overlap_pre + GFS_rrtmgp_cloud_mp + GFS_rrtmgp_cloud_overlap GFS_cloud_diagnostics - GFS_rrtmgp_sw_pre + rad_sw_pre + rrtmgp_aerosol_optics 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 @@ -72,8 +66,8 @@ satmedmfvdifq GFS_PBL_generic_post GFS_GWD_generic_pre - ugwpv1_gsldrag - ugwpv1_gsldrag_post + unified_ugwp + unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update ozphys_2015 @@ -89,15 +83,21 @@ GFS_suite_interstitial_4 cnvc90 GFS_MP_generic_pre - gfdl_cloud_microphys - GFS_MP_generic_post - maximum_hourly_diagnostics - phys_tend - + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + GFS_stochastics + phys_tend diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml index 0f9268de2..c5289bef9 100644 --- a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml +++ b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml index 8b1a37662..c5595cd16 100644 --- a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml +++ b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml index 10d0043aa..a9ca7c5cb 100644 --- a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml +++ b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras.xml b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras.xml index 640228132..bd5b1a1c9 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_flake.xml b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_flake.xml index 7e8fd184c..88c8b13db 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_flake.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_flake.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml index 69ab6dc53..cf285cd2d 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml index 98a7faca0..d1d640ccf 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas.xml b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas.xml index b18b457ca..5ff64b4db 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml index 6b6dd9c2d..8f9f07899 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_ras.xml b/ccpp/suites/suite_FV3_GFSv17alpha_ras.xml index 8b48ccfd9..10fff2a8c 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_ras.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_ras.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_ras_flake.xml b/ccpp/suites/suite_FV3_GFSv17alpha_ras_flake.xml index d1bdac439..6c8947356 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_ras_flake.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_ras_flake.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_ras_ugwp.xml b/ccpp/suites/suite_FV3_GFSv17alpha_ras_ugwp.xml index 786cbb074..cbd6bf517 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_ras_ugwp.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_ras_ugwp.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_sas.xml b/ccpp/suites/suite_FV3_GFSv17alpha_sas.xml index 6238d52f0..1b0940e2d 100644 --- a/ccpp/suites/suite_FV3_GFSv17alpha_sas.xml +++ b/ccpp/suites/suite_FV3_GFSv17alpha_sas.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf.xml b/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf.xml index 3285f72a6..cb94cc03a 100644 --- a/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf.xml +++ b/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf_nonsst.xml b/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf_nonsst.xml index 97437e886..c588d8598 100644 --- a/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf_nonsst.xml +++ b/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf_nonsst.xml @@ -20,7 +20,7 @@ GFS_suite_interstitial_rad_reset GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre 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 92% 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..3e35b94a8 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 + rad_sw_pre + rrtmg_sw + rrtmg_sw_post rrtmg_lw_pre rrtmg_lw rrtmg_lw_post - rrtmg_sw_pre - rrtmg_sw - rrtmg_sw_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 diff --git a/ccpp/suites/suite_FV3_HRRR.xml b/ccpp/suites/suite_FV3_HRRR.xml index d3408f0ba..a4c5b7dbc 100644 --- a/ccpp/suites/suite_FV3_HRRR.xml +++ b/ccpp/suites/suite_FV3_HRRR.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre @@ -42,10 +42,8 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 - sfc_nst_pre - sfc_nst - sfc_nst_post lsm_ruc + flake_driver GFS_surface_loop_control_part2 diff --git a/ccpp/suites/suite_FV3_HRRR_smoke.xml b/ccpp/suites/suite_FV3_HRRR_smoke.xml new file mode 100644 index 000000000..e3f51c14d --- /dev/null +++ b/ccpp/suites/suite_FV3_HRRR_smoke.xml @@ -0,0 +1,83 @@ + + + + + + + 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 + rad_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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + lsm_ruc + flake_driver + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + rrfs_smoke_wrapper + mynnedmf_wrapper + rrfs_smoke_postpbl + GFS_GWD_generic_pre + drag_suite + 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 + rrfs_smoke_lsdep_wrapper + phys_tend + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_RAP.xml b/ccpp/suites/suite_FV3_RAP.xml index 66fab81d6..f03c1a1e8 100644 --- a/ccpp/suites/suite_FV3_RAP.xml +++ b/ccpp/suites/suite_FV3_RAP.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_RAP_RRTMGP.xml b/ccpp/suites/suite_FV3_RAP_RRTMGP.xml index 83542fae6..9377033cc 100644 --- a/ccpp/suites/suite_FV3_RAP_RRTMGP.xml +++ b/ccpp/suites/suite_FV3_RAP_RRTMGP.xml @@ -13,26 +13,23 @@ GFS_suite_interstitial_rad_reset - sgscloud_radpre GFS_rrtmgp_pre GFS_radiation_surface - GFS_rrtmgp_thompsonmp_pre - GFS_rrtmgp_cloud_overlap_pre + GFS_rrtmgp_cloud_mp + GFS_rrtmgp_cloud_overlap GFS_cloud_diagnostics - GFS_rrtmgp_sw_pre + rad_sw_pre + rrtmgp_aerosol_optics 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 - sgscloud_radpost GFS_rrtmgp_lw_post diff --git a/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml b/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml index 7f43ed2b8..3530d16ef 100644 --- a/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml +++ b/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_RAP_flake.xml b/ccpp/suites/suite_FV3_RAP_flake.xml index 734f6dd89..be66bbaa0 100644 --- a/ccpp/suites/suite_FV3_RAP_flake.xml +++ b/ccpp/suites/suite_FV3_RAP_flake.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_RAP_noah.xml b/ccpp/suites/suite_FV3_RAP_noah.xml index dd4eb76f9..f5ce01c87 100644 --- a/ccpp/suites/suite_FV3_RAP_noah.xml +++ b/ccpp/suites/suite_FV3_RAP_noah.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml index f849a2b62..b0bf553bb 100644 --- a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml +++ b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_RRTMGP.xml b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml similarity index 69% rename from ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_RRTMGP.xml rename to ccpp/suites/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml index 87459ed65..00ef6952c 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_RRTMGP.xml +++ b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml @@ -1,11 +1,11 @@ - + GFS_time_vary_pre - GFS_rrtmgp_setup + GFS_rrtmg_setup GFS_rad_time_vary GFS_phys_time_vary @@ -14,26 +14,16 @@ GFS_suite_interstitial_rad_reset sgscloud_radpre - GFS_rrtmgp_pre + GFS_rrtmg_pre GFS_radiation_surface - GFS_rrtmgp_thompsonmp_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 + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw sgscloud_radpost - GFS_rrtmgp_lw_post + rrtmg_lw_post + GFS_rrtmg_post @@ -67,8 +57,8 @@ GFS_surface_generic_post mynnedmf_wrapper GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post + ugwpv1_gsldrag + ugwpv1_gsldrag_post GFS_GWD_generic_post GFS_suite_stateout_update ozphys_2015 @@ -76,18 +66,21 @@ get_phi_fv3 GFS_suite_interstitial_3 GFS_DCNV_generic_pre - samfdeepcnv + cu_gf_driver_pre + cu_gf_driver GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - GFS_SCNV_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 diff --git a/ccpp/suites/suite_FV3_GFS_v15p2_RRTMGP.xml b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml similarity index 62% rename from ccpp/suites/suite_FV3_GFS_v15p2_RRTMGP.xml rename to ccpp/suites/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml index 4628d385f..5230d75d6 100644 --- a/ccpp/suites/suite_FV3_GFS_v15p2_RRTMGP.xml +++ b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml @@ -1,16 +1,11 @@ - + - - - fv_sat_adj - - GFS_time_vary_pre - GFS_rrtmgp_setup + GFS_rrtmg_setup GFS_rad_time_vary GFS_phys_time_vary @@ -18,25 +13,17 @@ GFS_suite_interstitial_rad_reset - GFS_rrtmgp_pre + sgscloud_radpre + 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 + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + rrtmg_lw_post + GFS_rrtmg_post @@ -68,12 +55,10 @@ sfc_diag sfc_diag_post GFS_surface_generic_post - GFS_PBL_generic_pre - hedmf - GFS_PBL_generic_post + mynnedmf_wrapper GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post + unified_ugwp + unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update ozphys_2015 @@ -81,16 +66,17 @@ get_phi_fv3 GFS_suite_interstitial_3 GFS_DCNV_generic_pre - samfdeepcnv + cu_gf_driver_pre + cu_gf_driver 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 + mp_thompson_pre + mp_thompson + mp_thompson_post GFS_MP_generic_post + cu_gf_driver_post maximum_hourly_diagnostics phys_tend diff --git a/ccpp/suites/suite_FV3_RAP_sfcdiff.xml b/ccpp/suites/suite_FV3_RAP_sfcdiff.xml index 82acb849a..0793433c6 100644 --- a/ccpp/suites/suite_FV3_RAP_sfcdiff.xml +++ b/ccpp/suites/suite_FV3_RAP_sfcdiff.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml b/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml index b79398ef7..0b04d9622 100644 --- a/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml +++ b/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_RRFS_v1alpha.xml b/ccpp/suites/suite_FV3_RRFS_v1alpha.xml new file mode 100644 index 000000000..11b555375 --- /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 + rad_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/ccpp/suites/suite_FV3_RRFS_v1beta.xml b/ccpp/suites/suite_FV3_RRFS_v1beta.xml index 51e0f03cb..97228c0a6 100644 --- a/ccpp/suites/suite_FV3_RRFS_v1beta.xml +++ b/ccpp/suites/suite_FV3_RRFS_v1beta.xml @@ -16,7 +16,7 @@ sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface - rrtmg_sw_pre + rad_sw_pre rrtmg_sw rrtmg_sw_post rrtmg_lw_pre diff --git a/ccpp/suites/suite_FV3_RRFS_v1nssl.xml b/ccpp/suites/suite_FV3_RRFS_v1nssl.xml new file mode 100644 index 000000000..d2a2ae911 --- /dev/null +++ b/ccpp/suites/suite_FV3_RRFS_v1nssl.xml @@ -0,0 +1,80 @@ + + + + + + + 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 + rad_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 + + + + mynnsfc_wrapper + 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_MP_generic_pre + mp_nssl + 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..be8dcd67b 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 @@ -521,7 +186,7 @@ subroutine state_diagnose(State,string, rc) type(ESMF_StateItem_Flag) :: itemType real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) real(ESMF_KIND_R8), pointer :: dataPtr3d(:,:,:) - integer :: lrc, dimCount + integer :: lrc, localDeCount, dimCount character(len=*),parameter :: subname='(FV3: state_diagnose)' lstring = '' @@ -546,23 +211,25 @@ subroutine state_diagnose(State,string, rc) call ESMF_StateGet(State, itemName=trim(itemNameList(n)), field=lfield, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldGet(lfield, dimCount=dimcount, rc=lrc) + call ESMF_FieldGet(lfield, localDeCount=localDeCount, dimCount=dimcount, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(dimcount == 2)then - call ESMF_FieldGet(lfield, farrayPtr=dataPtr2d, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & - minval(dataPtr2d),maxval(dataPtr2d),sum(dataPtr2d) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) - else - call ESMF_FieldGet(lfield, farrayPtr=dataPtr3d, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & - minval(dataPtr3d),maxval(dataPtr3d),sum(dataPtr3d) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) + if(localDeCount.gt.0) then + if(dimcount == 2)then + call ESMF_FieldGet(lfield, farrayPtr=dataPtr2d, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & + minval(dataPtr2d),maxval(dataPtr2d),sum(dataPtr2d) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) + else + call ESMF_FieldGet(lfield, farrayPtr=dataPtr3d, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & + minval(dataPtr3d),maxval(dataPtr3d),sum(dataPtr3d) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) + end if end if end if enddo diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 380c49c77..48c430eaa 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -6,6 +6,7 @@ module module_cplfields !----------------------------------------------------------------------------- use ESMF + use NUOPC implicit none @@ -25,7 +26,7 @@ module module_cplfields ! l : model levels (3D) ! s : surface (2D) ! t : tracers (4D) - integer, public, parameter :: NexportFields = 105 + integer, public, parameter :: NexportFields = 111 type(ESMF_Field), target, public :: exportFields(NexportFields) type(FieldInfo), dimension(NexportFields), public, parameter :: exportFieldsInfo = [ & @@ -109,6 +110,12 @@ module module_cplfields FieldInfo("lake_fraction ", "s"), & FieldInfo("ocean_fraction ", "s"), & FieldInfo("surface_snow_area_fraction ", "s"), & + FieldInfo("canopy_moisture_storage ", "s"), & + FieldInfo("inst_aerodynamic_conductance ", "s"), & + FieldInfo("inst_canopy_resistance ", "s"), & + FieldInfo("leaf_area_index ", "s"), & + FieldInfo("temperature_of_soil_layer ", "g"), & + FieldInfo("height ", "s"), & ! For JEDI @@ -141,7 +148,7 @@ module module_cplfields FieldInfo("t2m ", "s") ] ! Import Fields ---------------------------------------- - integer, public, parameter :: NimportFields = 42 + integer, public, parameter :: NimportFields = 48 logical, public :: importFieldsValid(NimportFields) type(ESMF_Field), target, public :: importFields(NimportFields) @@ -163,6 +170,14 @@ module module_cplfields FieldInfo("inst_ice_vis_dif_albedo ", "s"), & FieldInfo("inst_ice_vis_dir_albedo ", "s"), & FieldInfo("wave_z0_roughness_length ", "s"), & + FieldInfo("inst_tracer_diag_aod ", "s"), & + + ! For receiving fluxes from mediator + FieldInfo("stress_on_air_ocn_zonal ", "s"), & + FieldInfo("stress_on_air_ocn_merid ", "s"), & + FieldInfo("mean_laten_heat_flx_atm_into_ocn ", "s"), & + FieldInfo("mean_sensi_heat_flx_atm_into_ocn ", "s"), & + FieldInfo("mean_up_lw_flx_ocn ", "s"), & ! For JEDI ! dynamics @@ -218,12 +233,21 @@ module module_cplfields "ice_fraction_in_atm ", & "lake_fraction ", & "ocean_fraction ", & - "surface_snow_area_fraction " & + "surface_snow_area_fraction ", & + "inst_vegetation_area_frac ", & + "canopy_moisture_storage ", & + "inst_aerodynamic_conductance ", & + "inst_canopy_resistance ", & + "leaf_area_index ", & + "soil_type ", & + "temperature_of_soil_layer ", & + "height " & ] ! Methods public queryImportFields, queryExportFields public cplFieldGet + public realizeConnectedCplFields !----------------------------------------------------------------------------- contains @@ -237,6 +261,8 @@ integer function queryExportFields(fieldname, abortflag) end function queryExportFields +!----------------------------------------------------------------------------- + integer function queryImportFields(fieldname, abortflag) character(len=*),intent(in) :: fieldname @@ -246,6 +272,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 +309,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 +338,7 @@ subroutine cplStateGet(state, fieldList, fieldCount, rc) end subroutine cplStateGet +!----------------------------------------------------------------------------- subroutine cplFieldGet(state, name, localDe, & farrayPtr2d, farrayPtr3d, farrayPtr4d, rc) @@ -379,6 +407,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..0c72a2cd1 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, cpl_grid_id, & cplprint_flag,output_1st_tstep_rst, & first_kdt @@ -38,23 +37,15 @@ 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 + use module_fcst_grid_comp, only: fcstSS => SetServices use module_wrt_grid_comp, only: wrtSS => SetServices ! - use module_cplfields, only: nExportFields, exportFields, exportFieldsInfo, & - nImportFields, importFields, importFieldsInfo, & - importFieldsValid, queryImportFields + use module_cplfields, only: importFieldsValid, queryImportFields - use module_cap_cpl, only: realizeConnectedCplFields, & - clock_cplIntval, diagnose_cplFields - - use atmos_model_mod, only: setup_exportdata + use module_cap_cpl, only: diagnose_cplFields implicit none private @@ -62,7 +53,6 @@ module fv3gfs_cap_mod ! !----------------------------------------------------------------------- ! - type(ESMF_Clock),save :: clock_fv3 type(ESMF_GridComp) :: fcstComp type(ESMF_State) :: fcstState @@ -74,6 +64,9 @@ module fv3gfs_cap_mod type(ESMF_FieldBundle), allocatable :: wrtFB(:,:) type(ESMF_RouteHandle), allocatable :: routehandle(:,:) + type(ESMF_RouteHandle), allocatable :: gridRedistRH(:,:) + type(ESMF_Grid), allocatable :: srcGrid(:,:), dstGrid(:,:) + logical, allocatable :: is_moving_FB(:) logical :: profile_memory = .true. @@ -138,6 +131,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) @@ -172,41 +173,59 @@ subroutine InitializeAdvertise(gcomp, rc) character(len=10) :: value 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_VM) :: vm, wrtVM + 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, grid_id 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, info + logical, allocatable :: is_moving(:) + logical :: needGridTransfer + type(ESMF_DistGrid) :: providerDG, acceptorDG + type(ESMF_Grid) :: grid, providerGrid + integer :: fieldCount, ii + type(ESMF_FieldBundle) :: mirrorFB + type(ESMF_Field), allocatable :: fieldList(:) 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="cpl_grid_id", value=value, defaultValue="1", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + cpl_grid_id = ESMF_UtilString2Int(value, 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="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 +247,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 +272,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 +289,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 +303,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,76 +317,10 @@ 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) - 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) + call ESMF_TimeIntervalSet(timeStep, s=dt_atmos, 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 rsthour = currTime - StartTime @@ -436,25 +349,34 @@ 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 -! obtain fcst VM - call ESMF_GridCompGet(fcstComp, vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! create fcst state fcstState = ESMF_StateCreate(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call fcst Initialize (including creating fcstgrid and fcst fieldbundle) call ESMF_GridCompInitialize(fcstComp, exportState=fcstState, & - clock=clock_fv3, 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 ! -! 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 ! @@ -464,7 +386,27 @@ subroutine InitializeAdvertise(gcomp, rc) if(mype == 0) print *,'af fcstCom FBCount= ',FBcount ! ! set start time for output - output_startfh = 0. + output_startfh = 0. +! +! query the is_moving array from the fcstState (was set by fcstComp.Initialize() above) + call ESMF_InfoGetFromHost(fcstState, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="is_moving", values=is_moving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + needGridTransfer = any(is_moving) + + allocate(is_moving_fb(FBcount)) + is_moving_fb = .false. ! init + + write(msgString,'(A,L4)') trim(subname)//" needGridTransfer = ", needGridTransfer + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(msgString,'(A,8L4)') trim(subname)//" is_moving = ", is_moving + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! !----------------------------------------------------------------------- !*** create and initialize Write component(s). @@ -475,6 +417,7 @@ subroutine InitializeAdvertise(gcomp, rc) allocate(fcstFB(FBCount), fcstItemNameList(FBCount), fcstItemTypeList(FBCount)) allocate(wrtComp(write_groups), wrtState(write_groups) ) allocate(wrtFB(FBCount,write_groups), routehandle(FBCount,write_groups)) + allocate(srcGrid(FBCount,write_groups), dstGrid(FBCount,write_groups), gridRedistRH(FBCount,write_groups)) allocate(lead_wrttask(write_groups), last_wrttask(write_groups)) allocate(petList(wrttasks_per_group)) allocate(originPetList(num_pes_fcst+wrttasks_per_group)) @@ -483,7 +426,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 @@ -501,10 +446,10 @@ subroutine InitializeAdvertise(gcomp, rc) line=__LINE__, file=__FILE__, rcToReturn=rc) return endif + call ESMF_AttributeGet(fcstFB(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 + is_moving_fb(i) = is_moving(grid_id) 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 +471,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 @@ -535,31 +491,28 @@ subroutine InitializeAdvertise(gcomp, rc) call ESMF_GridCompSet(gridcomp=wrtComp(i),config=CF,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! create wrtstate(i) - wrtstate(i) = ESMF_StateCreate(rc=rc) +! create wrtState(i) + wrtState(i) = ESMF_StateCreate(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! add the fcst FieldBundles to the wrtState(i) so write component can ! use this info to create mirror objects - call ESMF_AttributeCopy(fcstState, wrtState(i), & - attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) + call ESMF_AttributeCopy(fcstState, wrtState(i), attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_StateAdd(wrtState(i), fcstFB, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call into wrtComp(i) Initialize - call ESMF_GridCompInitialize(wrtComp(i), importState=wrtstate(i), & - clock=clock_fv3, phase=1, userRc=urc, rc=rc) + call ESMF_GridCompInitialize(wrtComp(i), importState=wrtState(i), 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 ! remove fcst FieldBundles from the wrtState(i) because done with it call ESMF_StateRemove(wrtState(i), fcstItemNameList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! reconcile the wrtComp(i)'s export state +! reconcile the wrtComp(i)'s import state call ESMF_StateReconcile(wrtState(i), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -569,74 +522,206 @@ subroutine InitializeAdvertise(gcomp, rc) attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! loop over all FieldBundle in the states and precompute Regrid operation - do j=1, FBcount +! deal with GridTransfer if needed - ! access the mirrored FieldBundle in the wrtState(i) - call ESMF_StateGet(wrtState(i), & - itemName="mirror_"//trim(fcstItemNameList(j)), & - fieldbundle=wrtFB(j,i), rc=rc) - if(mype == 0) print *,'af get wrtfb=',"mirror_"//trim(fcstItemNameList(j)),' rc=',rc - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (needGridTransfer) then -! determine regridmethod - if (index(fcstItemNameList(j),"_bilinear") >0 ) then - regridmethod = ESMF_REGRIDMETHOD_BILINEAR - else if (index(fcstItemNameList(j),"_patch") >0) then - regridmethod = ESMF_REGRIDMETHOD_PATCH - else if (index(fcstItemNameList(j),"_nearest_stod") >0) then - regridmethod = ESMF_REGRIDMETHOD_NEAREST_STOD - else if (index(fcstItemNameList(j),"_nearest_dtos") >0) then - regridmethod = ESMF_REGRIDMETHOD_NEAREST_DTOS - else if (index(fcstItemNameList(j),"_conserve") >0) then - regridmethod = ESMF_REGRIDMETHOD_CONSERVE - else - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg="Unable to determine regrid method.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + ! obtain wrtComp VM needed for acceptor DistGrid + call ESMF_GridCompGet(wrtComp(i), vm=wrtVM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite('bf FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) - write(msgString,"(A,I2.2,',',I2.2,A)") "calling into wrtFB(",j,i, ") FieldBundleRegridStore()...." - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + ! loop over all FieldBundle in the states, for moving nests initiate GridTransfer + do j=1, FBcount + if (is_moving_fb(j)) then + ! access the fcst (provider) Grid + call ESMF_FieldBundleGet(fcstFB(j), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the mirror FieldBundle on the wrtComp + call ESMF_StateGet(wrtState(i), itemName="mirror_"//trim(fcstItemNameList(j)), fieldbundle=mirrorFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! determine whether there are fields in the mirror FieldBundle + call ESMF_FieldBundleGet(mirrorFB, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (fieldCount > 0) then + ! access the providerDG + call ESMF_GridGet(grid, distgrid=providerDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! construct an acceptorDG with the same number of DEs for the acceptor side + acceptorDG = ESMF_DistGridCreate(providerDG, vm=wrtVM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! need a grid on the accptor side to carry the acceptorDG + grid = ESMF_GridEmptyCreate(vm=wrtVM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! set the acceptorDG + call ESMF_GridSet(grid, distgrid=acceptorDG, vm=wrtVM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! associate the grid with the mirror FieldBundle + call ESMF_FieldBundleSet(mirrorFB, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + endif + enddo - if (i==1) then -! this is a Store() for the first wrtComp -> must do the Store() - timewri = MPI_Wtime() + ! Call into wrtComp(i) Initialize() phase=2 to re-balance the mirrored grid distribution on its PETs + call ESMF_GridCompInitialize(wrtComp(i), importState=wrtState(i), 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_FieldBundleRegridStore(fcstFB(j), wrtFB(j,i), & - regridMethod=regridmethod, routehandle=routehandle(j,i), & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - srcTermProcessing=isrcTermProcessing, rc=rc) + ! Reconcile any changes (re-balanced grid distribution) across the wrtState(i) + call ESMF_StateReconcile(wrtState(i), 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 (rc /= ESMF_SUCCESS) then - write(0,*)'fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore' - call ESMF_LogWrite('fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore', ESMF_LOGMSG_ERROR, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + ! loop over all FieldBundle in the states, for moving nests handle GridTransfer + do j=1, FBcount + if (is_moving_fb(j)) then + ! access the fcst (provider) Grid + call ESMF_FieldBundleGet(fcstFB(j), grid=providerGrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the mirror FieldBundle on the wrtComp + call ESMF_StateGet(wrtState(i), itemName="mirror_"//trim(fcstItemNameList(j)), fieldbundle=mirrorFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! determine whether there are fields in the mirror FieldBundle + call ESMF_FieldBundleGet(mirrorFB, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (fieldCount > 0) then + ! access the field in the mirror FieldBundle + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(mirrorFB, fieldList=fieldList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the balanced mirror Grid from the first Field in the mirror FieldBundle + call ESMF_FieldGet(fieldList(1), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the balanced mirror DistGrid from the mirror Grid + call ESMF_GridGet(grid, distgrid=acceptorDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! construct a complete balanced mirror Grid with redistributed coordinates + call ESMF_TraceRegionEnter("ESMF_GridCreate(fromGrid,newDistGrid)", rc=rc) + grid = ESMF_GridCreate(providerGrid, acceptorDG, routehandle=gridRedistRH(j,i), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_GridCreate(fromGrid,newDistGrid)", rc=rc) + ! keep src and dst Grids for run-loop + srcGrid(j,i) = providerGrid + dstGrid(j,i) = grid + ! loop over all the mirror fields and set the balanced mirror Grid + do ii=1, fieldCount + call ESMF_FieldEmptySet(fieldList(ii), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo + ! clean-up + deallocate(fieldList) + endif endif - call ESMF_LogWrite('af FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo - originPetList(1:num_pes_fcst) = fcstPetList(:) - originPetList(num_pes_fcst+1:) = petList(:) + ! Call into wrtComp(i) Initialize() phase=3 to finish up creating the mirror Fields + call ESMF_GridCompInitialize(wrtComp(i), importState=wrtState(i), clock=clock, phase=3, 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 any changes (finished mirror Fields) across the wrtState(i) + call ESMF_StateReconcile(wrtState(i), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + endif + +! loop over all FieldBundle in the states and precompute Regrid operation + do j=1, FBcount + ! decide between Redist() and Regrid() + if (is_moving_fb(j)) then + ! this is a moving domain -> use a static Redist() to move data to wrtComp(:) + ! access the mirror FieldBundle in the wrtState(i) + call ESMF_StateGet(wrtState(i), & + itemName="mirror_"//trim(fcstItemNameList(j)), & + fieldbundle=wrtFB(j,i), rc=rc) + if (i==1) then + ! this is a Store() for the first wrtComp -> must do the Store() + call ESMF_TraceRegionEnter("ESMF_FieldBundleRedistStore()", rc=rc) + call ESMF_FieldBundleRedistStore(fcstFB(j), wrtFB(j,1), & + routehandle=routehandle(j,1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_FieldBundleRedistStore()", rc=rc) + originPetList(1:num_pes_fcst) = fcstPetList(:) + originPetList(num_pes_fcst+1:) = petList(:) + else + targetPetList(1:num_pes_fcst) = fcstPetList(:) + targetPetList(num_pes_fcst+1:) = petList(:) + call ESMF_TraceRegionEnter("ESMF_RouteHandleCreate() in lieu of ESMF_FieldBundleRedistStore()", rc=rc) + routehandle(j,i) = ESMF_RouteHandleCreate(routehandle(j,1), & + originPetList=originPetList, & + targetPetList=targetPetList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_RouteHandleCreate() in lieu of ESMF_FieldBundleRedistStore()", rc=rc) + endif else - targetPetList(1:num_pes_fcst) = fcstPetList(:) - targetPetList(num_pes_fcst+1:) = petList(:) - routehandle(j,i) = ESMF_RouteHandleCreate(routehandle(j,1), & - originPetList=originPetList, & - targetPetList=targetPetList, rc=rc) + ! this is a static domain -> do Regrid() "on the fly" when sending data to wrtComp(:) + ! access the output FieldBundle in the wrtState(i) + call ESMF_StateGet(wrtState(i), & + itemName="output_"//trim(fcstItemNameList(j)), & + fieldbundle=wrtFB(j,i), rc=rc) + if(mype == 0) print *,'af get wrtfb=',"output_"//trim(fcstItemNameList(j)),' rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! determine regridmethod + if (index(fcstItemNameList(j),"_bilinear") >0 ) then + regridmethod = ESMF_REGRIDMETHOD_BILINEAR + else if (index(fcstItemNameList(j),"_patch") >0) then + regridmethod = ESMF_REGRIDMETHOD_PATCH + else if (index(fcstItemNameList(j),"_nearest_stod") >0) then + regridmethod = ESMF_REGRIDMETHOD_NEAREST_STOD + else if (index(fcstItemNameList(j),"_nearest_dtos") >0) then + regridmethod = ESMF_REGRIDMETHOD_NEAREST_DTOS + else if (index(fcstItemNameList(j),"_conserve") >0) then + regridmethod = ESMF_REGRIDMETHOD_CONSERVE + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Unable to determine regrid method.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + call ESMF_LogWrite('bf FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) + write(msgString,"(A,I2.2,',',I2.2,A)") "calling into wrtFB(",j,i, ") FieldBundleRegridStore()...." + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + + if (i==1) then + ! this is a Store() for the first wrtComp -> must do the Store() + call ESMF_TraceRegionEnter("ESMF_FieldBundleRegridStore()", rc=rc) + call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,1), & + regridMethod=regridmethod, routehandle=routehandle(j,1), & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + srcTermProcessing=isrcTermProcessing, rc=rc) + +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (rc /= ESMF_SUCCESS) then + write(0,*)'fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore' + call ESMF_LogWrite('fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore', ESMF_LOGMSG_ERROR, rc=rc) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + call ESMF_TraceRegionExit("ESMF_FieldBundleRegridStore()", rc=rc) + call ESMF_LogWrite('af FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + originPetList(1:num_pes_fcst) = fcstPetList(:) + originPetList(num_pes_fcst+1:) = petList(:) + + else + targetPetList(1:num_pes_fcst) = fcstPetList(:) + targetPetList(num_pes_fcst+1:) = petList(:) + call ESMF_TraceRegionEnter("ESMF_RouteHandleCreate() in lieu of ESMF_FieldBundleRegridStore()", rc=rc) + routehandle(j,i) = ESMF_RouteHandleCreate(routehandle(j,1), & + originPetList=originPetList, & + targetPetList=targetPetList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_RouteHandleCreate() in lieu of ESMF_FieldBundleRegridStore()", rc=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) 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 +745,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 +831,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 +849,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,26 +875,17 @@ 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 ------------------- - ! importable fields: - do i = 1, size(importFieldsInfo) - call NUOPC_Advertise(importState, & - StandardName=trim(importFieldsInfo(i)%name), & - SharePolicyField='share', vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end do +! call fcst Initialize (advertise phase) + call ESMF_GridCompInitialize(fcstComp, importState=importState, exportState=exportState, & + clock=clock, phase=2, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! exportable fields: - do i = 1, size(exportFieldsInfo) - call NUOPC_Advertise(exportState, & - StandardName=trim(exportFieldsInfo(i)%name), & - SharePolicyField='share', vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end do + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return if(mype==0) print *,'in fv3_cap, aft import, export fields in atmos' if(mype==0) print *,'in fv3_cap, init time=',MPI_Wtime()-timeis @@ -824,41 +900,25 @@ 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_Clock) :: clock + type(ESMF_State) :: importState, exportState + integer :: urc rc = ESMF_SUCCESS ! query for importState and exportState - call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) + 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 ! --- conditionally realize or remove Fields in importState and exportState ------------------- - isPetLocal = ESMF_GridCompIsPetLocal(fcstComp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if (isPetLocal) then - - ! -- realize connected fields in exportState - call realizeConnectedCplFields(exportState, fcstGrid, & - 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 - - ! -- initialize export fields if applicable - call setup_exportdata(rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! -- realize connected fields in importState - call realizeConnectedCplFields(importState, fcstGrid, & - 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 + ! call fcst Initialize (realize phase) + call ESMF_GridCompInitialize(fcstComp, importState=importState, exportState=exportState, & + clock=clock, phase=3, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return end subroutine InitializeRealize @@ -869,88 +929,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) - 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_phase1(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) + call ModelAdvance_phase2(gcomp, 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 +952,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) - 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 + 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 (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,90 +1001,86 @@ 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) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_ClockAdvance(clock = clock_fv3, 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_ClockGet(clock_fv3, startTime=startTime, currTime=currTime, & - timeStep=timeStep, stopTime=stopTime, rc=rc) + call ESMF_ClockAdvance(clock_out, 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 + if (mype == 0 .or. mype == lead_wrttask(1)) print *,' aft fcst run output time=',nfseconds, & + 'FBcount=',FBcount,'na=',na + + call ESMF_TraceRegionEnter("ESMF_VMEpoch:fcstFB->wrtFB", rc=rc) - 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), & - termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) + if (is_moving_fb(j)) then + ! Grid coords need to be redistributed to the mirror Grid on wrtComp + call ESMF_GridRedist(srcGrid(j, n_group), dstGrid(j, n_group), routehandle=gridRedistRH(j, n_group), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + ! execute the routehandle from fcstFB -> wrtFB (either Regrid() or Redist()) + call ESMF_FieldBundleSMM(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 -! + enddo 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_TraceRegionExit("ESMF_VMEpoch:fcstFB->wrtFB", rc=rc) + 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 +1097,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 +1176,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 +1283,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,11 +1294,12 @@ 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 do i = 1, write_groups - call ESMF_GridCompFinalize(wrtComp(i), importState=wrtstate(i),userRc=urc, rc=rc) + call ESMF_GridCompFinalize(wrtComp(i), importState=wrtState(i),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 enddo diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 3827ccb68..ef7cbf008 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -60,9 +60,12 @@ module FV3GFS_io_mod character(len=32) :: fn_oro_ss = 'oro_data_ss.nc' character(len=32) :: fn_srf = 'sfc_data.nc' character(len=32) :: fn_phy = 'phy_data.nc' + character(len=32) :: fn_dust12m= 'dust12m_data.nc' + character(len=32) :: fn_emi = 'emi_data.nc' + character(len=32) :: fn_gbbepx = 'SMOKE_GBBEPx_data.nc' !--- GFDL FMS netcdf restart data types defined in fms2_io - type(FmsNetcdfDomainFile_t) :: Oro_restart, Sfc_restart, Phy_restart + type(FmsNetcdfDomainFile_t) :: Oro_restart, Sfc_restart, Phy_restart, dust12m_restart, emi_restart, gbbepx_restart type(FmsNetcdfDomainFile_t) :: Oro_ls_restart, Oro_ss_restart !--- GFDL FMS restart containers @@ -71,6 +74,10 @@ module FV3GFS_io_mod character(len=32), allocatable, dimension(:) :: oro_ls_ss_name real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: oro_ls_var, oro_ss_var real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3, phy_var3 + character(len=32), allocatable, dimension(:) :: dust12m_name, emi_name, gbbepx_name + real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: gbbepx_var + real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: dust12m_var + real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: emi_var !--- Noah MP restart containers real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3sn,sfc_var3eq,sfc_var3zn @@ -196,7 +203,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)) @@ -515,6 +522,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta integer :: nvar_o2, nvar_s2m, nvar_s2o, nvar_s3 integer :: nvar_oro_ls_ss integer :: nvar_s2r, nvar_s2mp, nvar_s3mp, isnow + integer :: nvar_emi, nvar_dust12m, nvar_gbbepx real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p1 => NULL() @@ -534,6 +542,15 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta nvar_o2 = 19 nvar_oro_ls_ss = 10 nvar_s2o = 18 + if(Model%rrfs_smoke) then + nvar_dust12m = 5 + nvar_gbbepx = 3 + nvar_emi = 1 + else + nvar_dust12m = 0 + nvar_gbbepx = 0 + nvar_emi = 0 + endif if (Model%lsm == Model%lsm_ruc .and. warm_start) then if(Model%rdlai) then @@ -675,6 +692,150 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) + if_smoke: if(Model%rrfs_smoke) then ! for RRFS-Smoke + + !--- Dust input FILE + !--- open file + infile=trim(indir)//'/'//trim(fn_dust12m) + amiopen=open_file(dust12m_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if (.not.amiopen) call mpp_error( FATAL, 'Error with opening file'//trim(infile) ) + + if (.not. allocated(dust12m_name)) then + !--- allocate the various containers needed for fengsha dust12m data + allocate(dust12m_name(nvar_dust12m)) + allocate(dust12m_var(nx,ny,12,nvar_dust12m)) + + dust12m_name(1) = 'clay' + dust12m_name(2) = 'rdrag' + dust12m_name(3) = 'sand' + dust12m_name(4) = 'ssm' + dust12m_name(5) = 'uthr' + + !--- register axis + call register_axis(dust12m_restart, 'lon', 'X') + call register_axis(dust12m_restart, 'lat', 'Y') + call register_axis(dust12m_restart, 'time', 12) + !--- register the 3D fields + do num = 1,nvar_dust12m + var3_p2 => dust12m_var(:,:,:,num) + call register_restart_field(dust12m_restart, dust12m_name(num), var3_p2, dimensions=(/'time', 'lat ', 'lon '/),& + &is_optional=.not.mand) + enddo + nullify(var3_p2) + endif + + !--- read new GSL created dust12m restart/data + call mpp_error(NOTE,'reading dust12m information from INPUT/dust12m_data.tile*.nc') + call read_restart(dust12m_restart) + call close_file(dust12m_restart) + + do nb = 1, Atm_block%nblks + !--- 3D variables + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + do k = 1, 12 + Sfcprop(nb)%dust12m_in(ix,k,1) = dust12m_var(i,j,k,1) + Sfcprop(nb)%dust12m_in(ix,k,2) = dust12m_var(i,j,k,2) + Sfcprop(nb)%dust12m_in(ix,k,3) = dust12m_var(i,j,k,3) + Sfcprop(nb)%dust12m_in(ix,k,4) = dust12m_var(i,j,k,4) + Sfcprop(nb)%dust12m_in(ix,k,5) = dust12m_var(i,j,k,5) + enddo + enddo + enddo + + deallocate(dust12m_name,dust12m_var) + + !--- open anthropogenic emission file + infile=trim(indir)//'/'//trim(fn_emi) + amiopen=open_file(emi_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if (.not.amiopen) call mpp_error( FATAL, 'Error with opening file'//trim(infile) ) + + if (.not. allocated(emi_name)) then + !--- allocate the various containers needed for anthropogenic emission data + allocate(emi_name(nvar_emi)) + allocate(emi_var(nx,ny,nvar_emi)) + + emi_name(1) = 'e_oc' + !--- register axis + call register_axis( emi_restart, "grid_xt", 'X' ) + call register_axis( emi_restart, "grid_yt", 'Y' ) + !--- register the 2D fields + do num = 1,nvar_emi + var2_p => emi_var(:,:,num) + call register_restart_field(emi_restart, emi_name(num), var2_p, dimensions=(/'grid_yt','grid_xt'/)) + enddo + nullify(var2_p) + endif + + !--- read new GSL created emi restart/data + call mpp_error(NOTE,'reading emi information from INPUT/emi_data.tile*.nc') + call read_restart(emi_restart) + call close_file(emi_restart) + + do nb = 1, Atm_block%nblks + !--- 2D variables + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + Sfcprop(nb)%emi_in(ix,1) = emi_var(i,j,1) + enddo + enddo + + !--- deallocate containers and free restart container + deallocate(emi_name, emi_var) + + !--- Dust input FILE + !--- open file + infile=trim(indir)//'/'//trim(fn_gbbepx) + amiopen=open_file(gbbepx_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if (.not.amiopen) call mpp_error( FATAL, 'Error with opening file'//trim(infile) ) + + if (.not. allocated(gbbepx_name)) then + !--- allocate the various containers needed for gbbepx fire data + allocate(gbbepx_name(nvar_gbbepx)) + allocate(gbbepx_var(nx,ny,24,nvar_gbbepx)) + + gbbepx_name(1) = 'ebb_smoke_hr' + gbbepx_name(2) = 'frp_avg_hr' + gbbepx_name(3) = 'frp_std_hr' + + !--- register axis + call register_axis(gbbepx_restart, 'lon', 'X') + call register_axis(gbbepx_restart, 'lat', 'Y') + call register_axis(gbbepx_restart, 't', 24) + !--- register the 3D fields + mand = .false. + do num = 1,nvar_gbbepx + var3_p2 => gbbepx_var(:,:,:,num) + call register_restart_field(gbbepx_restart, gbbepx_name(num), var3_p2, dimensions=(/'t ', 'lat', 'lon'/),& + &is_optional=.not.mand) + enddo + nullify(var3_p2) + endif + + !--- read new GSL created gbbepx restart/data + call mpp_error(NOTE,'reading gbbepx information from INPUT/SMOKE_GBBEPx_data.nc') + call read_restart(gbbepx_restart) + call close_file(gbbepx_restart) + + do nb = 1, Atm_block%nblks + !--- 3D variables + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + !--- assign hprime(1:10) and hprime(15:24) with new oro stat data + do k = 1, 24 + Sfcprop(nb)%smoke_GBBEPx(ix,k,1) = gbbepx_var(i,j,k,1) + Sfcprop(nb)%smoke_GBBEPx(ix,k,2) = gbbepx_var(i,j,k,2) + Sfcprop(nb)%smoke_GBBEPx(ix,k,3) = gbbepx_var(i,j,k,3) + enddo + enddo + enddo + + deallocate(gbbepx_name, gbbepx_var) + endif if_smoke ! RRFS_Smoke + !--- Modify/read-in additional orographic static fields for GSL drag suite if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & Model%gwd_opt==2 .or. Model%gwd_opt==22 ) then @@ -1462,7 +1623,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 +1638,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 +1662,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 +1684,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 +1712,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 +3242,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 +3253,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 +3296,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 +3375,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 +3390,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 +3405,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 +3505,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 +3615,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..57b9f8d5d 100644 --- a/io/inline_post.F90 +++ b/io/inline_post.F90 @@ -7,8 +7,7 @@ module inline_post use module_fv3_io_def, only : wrttasks_per_group,filename_base, & output_grid use write_internal_state, only : wrt_internal_state - use post_gfs, only : post_getattr_gfs, post_run_gfs - use post_regional, only : post_getattr_regional, post_run_regional + use post_fv3, only : post_getattr_fv3, post_run_fv3 implicit none @@ -16,11 +15,12 @@ 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: ! Jul 2019 J. Wang create interface to run inline post for FV3 +! Apr 2022 W. Meng unify global and regional inline posts ! ! !----------------------------------------------------------------------- @@ -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,39 +38,37 @@ 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 - call post_run_gfs(wrt_int_state, mypei, mpicomp, lead_write, & + if(mypei == 0) print *,'inline_post_run, output_grid=',trim(output_grid(grid_id)), & + ', call post_run_fv3' + if(trim(output_grid(grid_id)) == 'gaussian_grid' & + .or. trim(output_grid(grid_id)) == 'global_latlon' & + .or. 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_run_fv3(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 - 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) - endif + endif ! 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 -! - if(trim(output_grid) == 'gaussian_grid' & - .or. trim(output_grid) == '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) + integer, intent(in) :: grid_id +! + if(trim(output_grid(grid_id)) == 'gaussian_grid' & + .or. trim(output_grid(grid_id)) == 'global_latlon' & + .or. 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_fv3(wrt_int_state,grid_id) endif ! end subroutine inline_post_getattr diff --git a/io/inline_post_stub.F90 b/io/inline_post_stub.F90 index f33c78d6e..40ad2a203 100644 --- a/io/inline_post_stub.F90 +++ b/io/inline_post_stub.F90 @@ -13,7 +13,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: @@ -28,6 +28,7 @@ subroutine inline_post_run(wrt_int_state,mypei,mpicomp,lead_write, & ! type(wrt_internal_state),intent(in) :: wrt_int_state integer,intent(in) :: mypei + integer,intent(in) :: grid_id integer,intent(in) :: mpicomp integer,intent(in) :: lead_write integer,intent(in) :: mynfhr @@ -40,11 +41,12 @@ end subroutine inline_post_run ! !----------------------------------------------------------------------- ! - subroutine inline_post_getattr(wrt_int_state) + subroutine inline_post_getattr(wrt_int_state,grid_id) ! implicit none ! type(wrt_internal_state),intent(inout) :: wrt_int_state + integer,intent(in) :: grid_id ! ! print *,'in stub inline_post_getattr - not supported on this machine, return' 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..8b9bb0b1d 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 ! !-------------------------- @@ -79,8 +79,6 @@ module write_internal_state !------------------------------------- ! type(ESMF_Time) :: io_basetime - type(ESMF_TimeInterval) :: io_currtimediff - real :: nfhour integer :: idate(7) integer :: fdate(7) ! @@ -89,7 +87,6 @@ module write_internal_state !----------------------------------------- ! logical :: output_history - logical :: write_netcdfflag ! !----------------------------------------- !*** POST flags and required variables diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index 30959e625..c11e45b4b 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, ch_dimid + integer :: im_varid, jm_varid, tile_varid, lon_varid, lat_varid, timeiso_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,578 @@ 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) + ncerr = nf90_def_dim(ncid, "nchars", 20, ch_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-sphere face"); NC_ERR_STOP(ncerr) + end if + + ncerr = nf90_def_var(ncid, "time_iso", NF90_CHAR, [ch_dimid,time_dimid], timeiso_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, timeiso_varid, "long_name", "valid time"); NC_ERR_STOP(ncerr) + ncerr = nf90_put_att(ncid, timeiso_varid, "description", "ISO 8601 datetime string"); NC_ERR_STOP(ncerr) + + ! 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' .or. & + trim(output_grid(grid_id)) == 'regional_latlon_moving') 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' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') 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) + ncerr = nf90_var_par_access(ncid, timeiso_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 -! 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 + ! 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 + + 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' .or. & + trim(output_grid(grid_id)) == 'regional_latlon_moving') 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' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') 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' .or. & + trim(output_grid(grid_id)) == 'regional_latlon_moving') 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' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') 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 time_iso (timeiso_varid) + if (do_io) then + call ESMF_AttributeGet(wrtgrid, convention="NetCDF", purpose="FV3", & + name="time_iso", value=varcval, rc=rc); ESMF_ERR_RETURN(rc) + ncerr = nf90_put_var(ncid, timeiso_varid, values=[trim(varcval)]); 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 +759,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 +809,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 +819,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 +830,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 +856,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 +874,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 +883,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..0e37d230c 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -8,7 +8,7 @@ module module_wrt_grid_comp !*** At initialization step, write grid is defined. The forecast field !*** bundle is mirrored and output field information inside the field !*** bundle is used to create ESMF field on the write grid and added in -!*** the mirror field bundle on write grid component. Also the IO_BaseTime +!*** the output field bundle on write grid component. Also the IO_BaseTime !*** is set to the initial clock time. !*** At the run step, output time is set from the write grid comp clock !*** the ESMF field bundles that contains the data on write grid are @@ -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 @@ -111,17 +101,25 @@ subroutine SetServices(wrt_comp, rc) rc = ESMF_SUCCESS - call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_INITIALIZE, & - userRoutine=wrt_initialize, rc=rc) - if(rc/=0) write(*,*)'Error: write grid comp, initial' -! + call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_INITIALIZE, phase=1, & + userRoutine=wrt_initialize_p1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_INITIALIZE, phase=2, & + userRoutine=wrt_initialize_p2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(wrt_comp, ESMF_METHOD_INITIALIZE, phase=3, & + userRoutine=wrt_initialize_p3, rc=rc) + 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 ! @@ -129,12 +127,13 @@ end subroutine SetServices !####################################################################### !----------------------------------------------------------------------- ! - subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) + subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! !----------------------------------------------------------------------- !*** INITIALIZE THE WRITE GRIDDED COMPONENT. !----------------------------------------------------------------------- ! + use ctlblk_mod, only: numx type(esmf_GridComp) :: wrt_comp type(ESMF_State) :: imp_state_write, exp_state_write type(esmf_Clock) :: clock @@ -146,27 +145,27 @@ 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_Info) :: info 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_FieldBundle) :: fcstFB, fieldbundle, mirrorFB type(ESMF_Field), allocatable :: fcstField(:) type(ESMF_TypeKind_Flag) :: typekind character(len=80), allocatable :: fieldnamelist(:) - integer :: fieldDimCount, gridDimCount + integer :: fieldDimCount, gridDimCount, tk integer, allocatable :: petMap(:) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: ungriddedLBound(:) @@ -178,8 +177,9 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) integer :: valueI4 real(ESMF_KIND_R4) :: valueR4 real(ESMF_KIND_R8) :: valueR8 + logical, allocatable :: is_moving(:) - 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 +189,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,11 +241,12 @@ 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 !----------------------------------------------------------------------- ! - call esmf_GridCompGet(gridcomp=wrt_comp,config=CF,rc=RC) + call ESMF_GridCompGet(gridcomp=wrt_comp,config=CF,rc=RC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out ! variables for post @@ -265,115 +264,224 @@ 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 + + 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_InfoGetFromHost(imp_state_write, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="is_moving", values=is_moving, 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="ngrids", value=ngrids, 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,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) + 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 - call ESMF_ConfigGetAttribute(config=CF, value=output_grid, label ='output_grid:',rc=rc) + 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 + + 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 + numx = itasks + if (lprnt) print *,'jtasks=',jtasks,' itasks=',itasks,' numx=',numx + + 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 *,'cen_lon=',cen_lon(n),' cen_lat=',cen_lat(n) + 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)) == 'rotated_latlon_moving' .or. & + trim(output_grid(n)) == 'regional_latlon_moving') 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) + 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) 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 *,'imo =',imo(n), ' jmo =',jmo(n) + print *,'dlon=',dlon(n),' dlat=',dlat(n) + end if + 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(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 +491,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 +518,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 +585,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 +609,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 +676,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 +706,72 @@ 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) + + else if ( trim(output_grid(n)) == 'regional_latlon' .or. & + trim(output_grid(n)) == 'regional_latlon_moving' .or. & + trim(output_grid(n)) == 'rotated_latlon' .or. & + trim(output_grid(n)) == 'rotated_latlon_moving' .or. & + trim(output_grid(n)) == 'lambert_conformal' ) then - wrtgrid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & - maxIndex=(/imo,jmo/), regDecomp=(/1,ntasks/), & - indexflag=ESMF_INDEX_GLOBAL, & - name='wrt_grid',rc=rc) + 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)) == 'regional_latlon_moving' ) then + ! Do not compute lonPtr, latPtr here. Will be done in the run phase + wrt_int_state%post_maptype = 0 + 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)) == 'rotated_latlon_moving' ) then + ! Do not compute lonPtr, latPtr here. Will be done in the run phase + wrt_int_state%post_maptype = 207 + 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 +787,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 +810,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_p1: Unknown output_grid ", trim(output_grid(n)) + call ESMF_LogWrite("wrt_initialize_p1: 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,18 +840,10 @@ 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 +!--- Look at the incoming FieldBundles in the imp_state_write, and mirror them as 'output_' bundles ! call ESMF_StateGet(imp_state_write, itemCount=FBCount, rc=rc) @@ -716,12 +862,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,22 +878,43 @@ 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 a mirror FieldBundle and add it to importState - fieldbundle = ESMF_FieldBundleCreate(name="mirror_"//trim(fcstItemNameList(i)), rc=rc) + 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 +!--- get grid dim count + call ESMF_GridGet(wrtGrid(grid_id), dimCount=gridDimCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_StateAdd(imp_state_write, (/fieldbundle/), rc=rc) +! create a mirrored 'output_' FieldBundle and add it to importState + fieldbundle = ESMF_FieldBundleCreate(name="output_"//trim(fcstItemNameList(i)), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_StateAdd(imp_state_write, (/fieldbundle/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! copy the fcstFB Attributes to the mirror FieldBundle +! copy the fcstFB Attributes to the 'output_' FieldBundle call ESMF_AttributeCopy(fcstFB, fieldbundle, attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! - call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, rc=rc) +! grids in fcstFB for which 'is_moving' is .true. must provide a first level mirror for the Redist() target + if (is_moving(grid_id)) then + +! create a mirrored 'mirror_' FieldBundle and add it to importState + mirrorFB = ESMF_FieldBundleCreate(name="mirror_"//trim(fcstItemNameList(i)), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateAdd(imp_state_write, (/mirrorFB/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +! copy the fcstFB Attributes to the 'mirror_' FieldBundle + call ESMF_AttributeCopy(fcstFB, mirrorFB, attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + endif + +! deal with all of the Fields inside this fcstFB + call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (fieldCount > 0) then @@ -772,7 +941,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, & @@ -781,14 +950,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 -! create the mirror field +! create the output 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,24 +972,48 @@ 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)) -! add the mirror field to the mirror FieldBundle +! add the output field to the 'output_' FieldBundle call ESMF_FieldBundleAdd(fieldbundle, (/field_work/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! deal with grids for which 'is_moving' is .true. + if (is_moving(grid_id)) then + ! create an empty field that will serve as acceptor for GridTransfer of fcstGrid + field_work = ESMF_FieldEmptyCreate(name=fieldName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! use attributes to carry information for later FieldEmptyComplete() + call ESMF_InfoGetFromHost(field_work, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + tk = typekind ! convert TypeKind_Flag to integer + call ESMF_InfoSet(info, key="typekind", value=tk, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoSet(info, key="gridToFieldMap", values=gridToFieldMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoSet(info, key="ungriddedLBound", values=ungriddedLBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoSet(info, key="ungriddedUBound", values=ungriddedUBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! add to 'mirror_' FieldBundle + call ESMF_FieldBundleAdd(mirrorFB, (/field_work/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + endif + ! local garbage collection 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 +1038,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)) @@ -855,16 +1048,20 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) do n=1, FBcount - call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(n)), & + call ESMF_StateGet(imp_state_write, itemName="output_"//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 +! copy the 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 +1102,46 @@ 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) - 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) + name="im", value=imo(grid_id), 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)) == 'regional_latlon_moving' & + .or. trim(output_grid(grid_id)) == 'global_latlon') then + ! for 'regional_latlon_moving' lon1/2 and lat1/2 will be overwritten in run phase 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' & + .or. trim(output_grid(grid_id)) == 'rotated_latlon_moving') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="rotated_latlon", rc=rc) @@ -968,24 +1154,25 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) "lat2 ",& "dlon ",& "dlat "/), rc=rc) + ! for 'rotated_latlon_moving' cen_lon and cen_lat will be overwritten in run phase 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 +1188,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 +1253,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 +1282,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 +1294,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 +1306,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 +1318,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 +1327,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 +1346,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 +1395,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,12 +1439,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 -! -!----------------------------------------------------------------------- -!*** SET THE FIRST HISTORY FILE'S TIME INDEX. -!----------------------------------------------------------------------- -! - wrt_int_state%NFHOUR = 0 + + end do ! n=1, ngrids + + deallocate(attNameList, attNameList2, typekindList) ! !----------------------------------------------------------------------- !*** Initialize for POST @@ -1274,22 +1451,205 @@ 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 ! +! write_init_tim = MPI_Wtime() - btim0 +! !----------------------------------------------------------------------- ! - IF(RC /= ESMF_SUCCESS) THEN - WRITE(0,*)"FAIL: Write_Initialize." -! ELSE -! WRITE(0,*)"PASS: Write_Initialize." - ENDIF + end subroutine wrt_initialize_p1 ! -! write_init_tim = MPI_Wtime() - btim0 +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine wrt_initialize_p2(wrt_comp, imp_state_write, exp_state_write, clock, rc) +! +!----------------------------------------------------------------------- +!*** INITIALIZE THE WRITE GRIDDED COMPONENT. +!----------------------------------------------------------------------- +! + type(esmf_GridComp) :: wrt_comp + type(ESMF_State) :: imp_state_write, exp_state_write + type(esmf_Clock) :: clock + integer,intent(out) :: rc +! +!*** LOCAL VARIABLES + type(ESMF_Info) :: info + logical, allocatable :: is_moving(:) + type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) + character(len=ESMF_MAXSTR),allocatable :: itemNameList(:) + integer :: i, j, bundleCount, fieldCount + type(ESMF_FieldBundle) :: mirrorFB + type(ESMF_Field), allocatable :: fieldList(:) + type(ESMF_Grid) :: grid + type(ESMF_DistGrid) :: acceptorDG, newAcceptorDG +! +! +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- +! + rc = ESMF_SUCCESS ! + call ESMF_InfoGetFromHost(imp_state_write, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="is_moving", values=is_moving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(imp_state_write, itemCount=bundleCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate(itemNameList(bundleCount), itemTypeList(bundleCount)) + + call ESMF_StateGet(imp_state_write, itemNameList=itemNameList, & + itemTypeList=itemTypeList, & + !itemorderflag=ESMF_ITEMORDER_ADDORDER, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do i=1, bundleCount + + if (itemTypeList(i) == ESMF_STATEITEM_FIELDBUNDLE) then + + if (index(trim(itemNameList(i)), "mirror_")==1) then + ! this is a 'mirror_' FieldBundle -> GridTransfer acceptor side + call ESMF_StateGet(imp_state_write, itemName=trim(itemNameList(i)), fieldbundle=mirrorFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the grid that is passed in from the provider side + call ESMF_FieldBundleGet(mirrorFB, grid=grid, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! access the acceptor DistGrid + call ESMF_GridGet(grid, distgrid=acceptorDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! rebalance the acceptor DistGrid across the local PETs + newAcceptorDG = ESMF_DistGridCreate(acceptorDG, balanceflag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! create a new Grid on the rebalanced DistGrid + grid = ESMF_GridCreate(newAcceptorDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! point all of the acceptor fields to the new acceptor Grid + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(mirrorFB, fieldList=fieldList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + do j=1, fieldCount + call ESMF_FieldEmptySet(fieldList(j), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo + ! clean-up + deallocate(fieldList) + endif + + else ! anything but a FieldBundle in the state is unexpected here + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="Only FieldBundles supported in fcstState.", line=__LINE__, file=__FILE__) + return + endif + + enddo + !----------------------------------------------------------------------- ! - end subroutine wrt_initialize + end subroutine wrt_initialize_p2 +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine wrt_initialize_p3(wrt_comp, imp_state_write, exp_state_write, clock, rc) +! +!----------------------------------------------------------------------- +!*** INITIALIZE THE WRITE GRIDDED COMPONENT. +!----------------------------------------------------------------------- +! + type(esmf_GridComp) :: wrt_comp + type(ESMF_State) :: imp_state_write, exp_state_write + type(esmf_Clock) :: clock + integer,intent(out) :: rc +!*** LOCAL VARIABLES + type(ESMF_Info) :: info + logical, allocatable :: is_moving(:) + type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) + character(len=ESMF_MAXSTR),allocatable :: itemNameList(:) + integer :: i, j, bundleCount, fieldCount + type(ESMF_FieldBundle) :: mirrorFB + type(ESMF_Field), allocatable :: fieldList(:) + type(ESMF_TypeKind_Flag) :: typekind + integer :: tk + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: ungriddedLBound(:) + integer, allocatable :: ungriddedUBound(:) + +! +! +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- +! + rc = ESMF_SUCCESS +! + call ESMF_InfoGetFromHost(imp_state_write, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="is_moving", values=is_moving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(imp_state_write, itemCount=bundleCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate(itemNameList(bundleCount), itemTypeList(bundleCount)) + + call ESMF_StateGet(imp_state_write, itemNameList=itemNameList, & + itemTypeList=itemTypeList, & + !itemorderflag=ESMF_ITEMORDER_ADDORDER, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do i=1, bundleCount + + if (itemTypeList(i) == ESMF_STATEITEM_FIELDBUNDLE) then + + if (index(trim(itemNameList(i)), "mirror_")==1) then + ! this is a 'mirror_' FieldBundle -> GridTransfer acceptor side + call ESMF_StateGet(imp_state_write, itemName=trim(itemNameList(i)), fieldbundle=mirrorFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! finish creating all the mirror Fields + call ESMF_FieldBundleGet(mirrorFB, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(mirrorFB, fieldList=fieldList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + do j=1, fieldCount + ! first access information stored on the field needed for completion + call ESMF_InfoGetFromHost(fieldList(j), info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGet(info, key="typekind", value=tk, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + typekind = tk ! convert integer into TypeKind_Flag + call ESMF_InfoGetAlloc(info, key="gridToFieldMap", values=gridToFieldMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="ungriddedLBound", values=ungriddedLBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGetAlloc(info, key="ungriddedUBound", values=ungriddedUBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! now complete the field creation + call ESMF_FieldEmptyComplete(fieldList(j), typekind=typekind, gridToFieldMap=gridToFieldMap, & + ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo + ! clean-up + deallocate(fieldList) + endif + + else ! anything but a FieldBundle in the state is unexpected here + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="Only FieldBundles supported in fcstState.", line=__LINE__, file=__FILE__) + return + endif + + enddo + +!----------------------------------------------------------------------- +! + end subroutine wrt_initialize_p3 ! !----------------------------------------------------------------------- !####################################################################### @@ -1310,46 +1670,62 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) !*** local variables ! TYPE(ESMF_VM) :: VM - type(ESMF_FieldBundle) :: file_bundle + type(ESMF_FieldBundle) :: file_bundle, mirror_bundle + type(ESMF_StateItem_Flag) :: itemType type(ESMF_Time) :: currtime - type(ESMF_TypeKind_Flag) :: datatype - type(ESMF_Field) :: field_work - type(ESMF_Grid) :: fbgrid, wrtgrid + type(ESMF_TimeInterval) :: io_currtimediff + type(ESMF_Grid) :: fbgrid, wrtGrid type(ESMF_State),save :: stateGridFB type(optimizeT), save :: optimize(4) type(ESMF_GridComp), save, allocatable :: compsGridFB(:) + type(ESMF_RouteHandle) :: rh + type(ESMF_RegridMethod_Flag) :: regridmethod + integer :: srcTermProcessing ! 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, localPet ! - integer :: nf_hours,nf_seconds, nf_minutes, & - nseconds,nseconds_num,nseconds_den + integer :: nf_hours,nf_seconds,nf_minutes + real(ESMF_KIND_R8) :: nfhour ! - 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, traceString 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 + character(20) :: time_iso +! + type(ESMF_Grid) :: grid + type(ESMF_Info) :: info + real(ESMF_KIND_R8), allocatable :: values(:) + character(160) :: msgString + type(ESMF_Field), allocatable :: fieldList(:) + type(ESMF_Array) :: coordArray(2) + type(ESMF_DistGrid) :: coordDG + type(ESMF_DELayout) :: coordDL + integer :: fieldCount, deCount, rootPet + integer :: minIndexPTile(2,1), maxIndexPTile(2,1), centerIndex(2) + integer, allocatable :: minIndexPDe(:,:), maxIndexPDe(:,:), petMap(:) + real(ESMF_KIND_R8), pointer :: farrayPtr(:,:) + real(ESMF_KIND_R8) :: centerCoord(2) + + integer :: ii, jj + real(ESMF_KIND_R8), pointer :: lonPtr(:,:), latPtr(:,:) + real(ESMF_KIND_R8) :: rot_lon, rot_lat + real(ESMF_KIND_R8) :: geo_lon, geo_lat + real(ESMF_KIND_R8), parameter :: rtod=180.0/pi + + 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 +1735,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) + call ESMF_GridCompGet(wrt_comp, name=compname, localPet=localPet, 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) @@ -1391,82 +1762,220 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) !*** get current time and elapsed forecast time call ESMF_ClockGet(clock=CLOCK, currTime=CURRTIME, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_TimeGet(time=currTime,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 + wrt_int_state%fdate(7) = 1 wrt_int_state%fdate(1:6) = date(1:6) + write(time_iso,'(I4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2,"Z")') date(1:6) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! if(mype == lead_write_task) print *,'in wrt run, curr time=',date -! call ESMF_TimeGet(time=wrt_int_state%IO_BASETIME,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 + + io_currtimediff = currtime - wrt_int_state%IO_BASETIME + + call ESMF_TimeIntervalGet(timeinterval=io_currtimediff & + ,h_r8=nfhour,h=nf_hours,m=nf_minutes,s=nf_seconds,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 -! print *,'in wrt run, io_baseline time=',date -! - wrt_int_state%IO_CURRTIMEDIFF = CURRTIME-wrt_int_state%IO_BASETIME -! - call ESMF_TimeIntervalGet(timeinterval=wrt_int_state%IO_CURRTIMEDIFF & - ,h =nf_hours & !<-- Hours of elapsed time - ,m =nf_minutes & !<-- Minutes of elapsed time - ,s =nseconds & !<-- Seconds of elapsed time - ,sN =nseconds_num & !<-- Numerator of fractional elapsed seconds - ,sD =nseconds_den & !<-- denominator of fractional elapsed seconds - ,rc =RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! if (lprnt) print *,'in wrt run, nf_hours=',nf_hours,nf_minutes,nseconds, & -! 'nseconds_num=',nseconds_num,nseconds_den,'mype=',mype -! - 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 iau_offset > nf_hours, don't write out anything if (nf_hours < 0) return - nf_minutes = int((nf_seconds-nf_hours*3600.)/60.) - nseconds = int(nf_seconds-nf_hours*3600.-nf_minutes*60.) if (nsout > 0 .or. lflname_fulltime) then ndig = max(log10(nf_hours+0.5)+1., 3.) write(cform, '("(I",I1,".",I1,",A1,I2.2,A1,I2.2)")') ndig, ndig - write(cfhour, cform) nf_hours,'-',nf_minutes,'-',nseconds + write(cfhour, cform) nf_hours,'-',nf_minutes,'-',nf_seconds else ndig = max(log10(nf_hours+0.5)+1., 3.) write(cform, '("(I",I1,".",I1,")")') ndig, ndig write(cfhour, cform) nf_hours endif ! - if(lprnt) print *,'in wrt run, nf_hours=',nf_hours,nf_minutes,nseconds, & - 'nseconds_num=',nseconds_num,nseconds_den,' FBCount=',FBCount,' cfhour=',trim(cfhour) - -! if(lprnt) print *,'in wrt run, cfhour=',cfhour, & -! print *,'in wrt run, cfhour=',cfhour, & -! ' 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 - - call ESMF_LogWrite("before Write component af get time", ESMF_LOGMSG_INFO, rc=rc) + if(lprnt) print *,'in wrt run, nfhour=',nfhour,' cfhour=',trim(cfhour) ! !----------------------------------------------------------------------- -!*** loop on the files that need to write out +!*** loop on the "output_" FieldBundles, i.e. 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)), & + call ESMF_StateGet(imp_state_write, itemName="output_"//trim(fcstItemNameList(i)), & fieldbundle=file_bundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! see whether a "mirror_" FieldBundle exists, i.e. dealing with moving domain that needs updated Regrid() here. + call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(i)), & + itemType=itemType, 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) + + if (itemType == ESMF_STATEITEM_FIELDBUNDLE) then + ! Regrid() for a moving domain + call ESMF_LogWrite("Regrid() for moving domain: mirror_"//trim(fcstItemNameList(i)), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(i)), & + fieldbundle=mirror_bundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! Find the centerCoord of the moving domain + + call ESMF_FieldBundleGet(mirror_bundle, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(mirror_bundle, fieldList=fieldList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(fieldList(1), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + deallocate(fieldList) + + call ESMF_GridGetCoord(grid, coordDim=1, array=coordArray(1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=2, array=coordArray(2), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ArrayGet(coordArray(1), distgrid=coordDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_DistGridGet(coordDG, deCount=deCount, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, & + delayout=coordDL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(petMap(deCount),minIndexPDe(2,deCount), maxIndexPDe(2,deCount)) + call ESMF_DELayoutGet(coordDL, petMap=petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_DistGridGet(coordDG, minIndexPDe=minIndexPDe, maxIndexPDe=maxIndexPDe, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + centerIndex(1) = (maxIndexPTile(1,1)-minIndexPTile(1,1)+1)/2 + centerIndex(2) = (maxIndexPTile(2,1)-minIndexPTile(2,1)+1)/2 + +! write(msgString,*) "Determined centerIndex: ", centerIndex +! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do n=1, deCount + if (minIndexPDe(1,n)<=centerIndex(1) .and. centerIndex(1)<=maxIndexPDe(1,n) .and. & + minIndexPDe(2,n)<=centerIndex(2) .and. centerIndex(2)<=maxIndexPDe(2,n)) then + ! found the DE that holds the center coordinate + rootPet = petMap(n) + if (localPet == rootPet) then + ! center DE is on local PET -> fill centerCoord locally + call ESMF_ArrayGet(coordArray(1), farrayPtr=farrayPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + centerCoord(1) = farrayPtr(centerIndex(1)-minIndexPDe(1,n)+1,centerIndex(2)-minIndexPDe(2,n)+1) + call ESMF_ArrayGet(coordArray(2), farrayPtr=farrayPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + centerCoord(2) = farrayPtr(centerIndex(1)-minIndexPDe(1,n)+1,centerIndex(2)-minIndexPDe(2,n)+1) +! write(msgString,*) "Found centerCoord: ", centerCoord +! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + exit + endif + enddo + + deallocate(petMap,minIndexPDe,maxIndexPDe) + + call ESMF_VMBroadcast(vm, centerCoord, count=2, rootPet=rootPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(msgString,*) "All PETs know centerCoord in radians: ", centerCoord + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! determine regridmethod + if (index(fcstItemNameList(i),"_bilinear") >0 ) then + traceString = "-bilinear" + regridmethod = ESMF_REGRIDMETHOD_BILINEAR + else if (index(fcstItemNameList(i),"_patch") >0) then + traceString = "-patch" + regridmethod = ESMF_REGRIDMETHOD_PATCH + else if (index(fcstItemNameList(i),"_nearest_stod") >0) then + traceString = "-nearest_stod" + regridmethod = ESMF_REGRIDMETHOD_NEAREST_STOD + else if (index(fcstItemNameList(i),"_nearest_dtos") >0) then + traceString = "-nearest_dtos" + regridmethod = ESMF_REGRIDMETHOD_NEAREST_DTOS + else if (index(fcstItemNameList(i),"_conserve") >0) then + traceString = "-conserve" + regridmethod = ESMF_REGRIDMETHOD_CONSERVE + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Unable to determine regrid method.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + srcTermProcessing = 1 ! have this fixed for bit-for-bit reproducibility + ! RegridStore() + + ! update output grid coordinates based of fcstgrid center lat/lon + call ESMF_FieldBundleGet(file_bundle, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=1, farrayPtr=lonPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=2, farrayPtr=latPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeGet(mirror_bundle, 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 (trim(output_grid(grid_id)) == 'regional_latlon_moving' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + n = grid_id + cen_lon(n) = centerCoord(1)*rtod + cen_lat(n) = centerCoord(2)*rtod + if (cen_lon(n) > 180.0) cen_lon(n) = cen_lon(n) - 360.0 + cen_lon(n) = NINT(cen_lon(n)*1000.0)/1000.0 + cen_lat(n) = NINT(cen_lat(n)*1000.0)/1000.0 + endif + + if (trim(output_grid(grid_id)) == 'regional_latlon_moving') then + lon1(n) = cen_lon(n) - 0.5 * (imo(n)-1) * dlon(n) + lat1(n) = cen_lat(n) - 0.5 * (jmo(n)-1) * dlat(n) + lon2(n) = cen_lon(n) + 0.5 * (imo(n)-1) * dlon(n) + lat2(n) = cen_lat(n) + 0.5 * (jmo(n)-1) * dlat(n) + do jj=lbound(lonPtr,2),ubound(lonPtr,2) + do ii=lbound(lonPtr,1),ubound(lonPtr,1) + lonPtr(ii,jj) = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (ii-1) + latPtr(ii,jj) = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (jj-1) + enddo + enddo + else if (trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + lon1(n) = - 0.5 * (imo(n)-1) * dlon(n) + lat1(n) = - 0.5 * (jmo(n)-1) * dlat(n) + lon2(n) = 0.5 * (imo(n)-1) * dlon(n) + lat2(n) = 0.5 * (jmo(n)-1) * dlat(n) + do jj=lbound(lonPtr,2),ubound(lonPtr,2) + do ii=lbound(lonPtr,1),ubound(lonPtr,1) + rot_lon = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (ii-1) + rot_lat = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (jj-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(ii,jj) = geo_lon + latPtr(ii,jj) = geo_lat + enddo + enddo + endif + + call ESMF_TraceRegionEnter("ESMF_FieldBundleRegridStore()"//trim(traceString), rc=rc) + call ESMF_FieldBundleRegridStore(mirror_bundle, file_bundle, & + regridMethod=regridmethod, routehandle=rh, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + srcTermProcessing=srcTermProcessing, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_FieldBundleRegridStore()"//trim(traceString), rc=rc) + ! Regrid() + call ESMF_TraceRegionEnter("ESMF_FieldBundleRegrid()"//trim(traceString), rc=rc) + call ESMF_FieldBundleRegrid(mirror_bundle, file_bundle, & + routehandle=rh, termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_FieldBundleRegrid()"//trim(traceString), rc=rc) + ! RegridRelease() + call ESMF_FieldBundleRegridRelease(routehandle=rh, noGarbage=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! done + call ESMF_LogWrite("Done Regrid() for moving domain: mirror_"//trim(fcstItemNameList(i)), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + !recover fields from cartesian vector and sfc pressure call recover_fields(file_bundle,rc) enddo @@ -1478,26 +1987,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, & - nf_hours, nf_minutes,nseconds) + call inline_post_run(wrt_int_state, 1, mype, wrt_mpi_comm, lead_write_task, & + nf_hours, nf_minutes, nf_seconds) 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 +2017,98 @@ 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 + + ! update lon1/2 and lat1/2 for regional_latlon_moving + if (trim(output_grid(grid_id)) == 'regional_latlon_moving') then + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon1", value=lon1(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat1", value=lat1(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon2", value=lon2(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat2", value=lat2(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + ! update cen_lon/cen_lat, lon1/2 and lat1/2 for rotated_latlon_moving + if (trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="cen_lon", value=cen_lon(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="cen_lat", value=cen_lat(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon1", value=lon1(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat1", value=lat1(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon2", value=lon2(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat2", value=lat2(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + 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 @@ -1563,7 +2117,12 @@ 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 call ESMF_AttributeSet(fbgrid, convention="NetCDF", purpose="FV3", & - name="time", value=real(wrt_int_state%nfhour,ESMF_KIND_R8), rc=rc) + name="time", value=nfhour, rc=rc) + + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fbgrid, convention="NetCDF", purpose="FV3", & + name="time_iso", value=trim(time_iso), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1573,183 +2132,88 @@ 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)) == 'regional_latlon_moving' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving' .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 +2230,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 @@ -1776,7 +2240,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) enddo ! open(nolog,file='logf'//trim(cfhour),form='FORMATTED') - write(nolog,100)wrt_int_state%nfhour,idate(1:6) + write(nolog,100)nfhour,idate(1:6) 100 format(' completed fv3gfs fhour=',f10.3,2x,6(i4,2x)) close(nolog) endif @@ -1785,6 +2249,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 +2257,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 +2299,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 +2317,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 +2336,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 +2408,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 +2420,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 +2457,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 +2518,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 +2536,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 +2553,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 +2589,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 +2608,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 +2651,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 +2762,7 @@ subroutine mask_fields(file_bundle,rc) endif enddo ! + deallocate(maskwrt) deallocate(fcstField) rc = 0 @@ -3346,12 +3791,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 +3901,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 @@ -3598,45 +4043,55 @@ end subroutine rtll subroutine lambert(stlat1,stlat2,c_lat,c_lon,glon,glat,x,y,inv) !------------------------------------------------------------------------------- - real(ESMF_KIND_R8), intent(in) :: stlat1,stlat2,c_lat,c_lon - real(ESMF_KIND_R8), intent(inout) :: glon, glat + real(ESMF_KIND_R8), intent(in) :: stlat1,stlat2,c_lat,c_lon + real(ESMF_KIND_R8), intent(inout) :: glon, glat real(ESMF_KIND_R8), intent(inout) :: x, y - integer, intent(in) :: inv + integer, intent(in) :: inv !------------------------------------------------------------------------------- -! real(ESMF_KIND_R8), parameter :: pi=3.14159265358979323846 - real(ESMF_KIND_R8), parameter :: dtor=pi/180.0 - real(ESMF_KIND_R8), parameter :: rtod=180.0/pi +! real(ESMF_KIND_R8), parameter :: pi = 3.14159265358979323846 + real(ESMF_KIND_R8), parameter :: dtor = pi/180.0 + real(ESMF_KIND_R8), parameter :: rtod = 180.0/pi real(ESMF_KIND_R8), parameter :: a = 6371200.0 !------------------------------------------------------------------------------- -! inv == 1 (glon,glat) ---> (x,y) lat/lon to grid -! inv == -1 (x,y) ---> (glon,glat) grid to lat/lon +! inv == 1 (glon,glat) ---> (x,y) +! inv == -1 (x,y) ---> (glon,glat) - real(ESMF_KIND_R8) :: en,f,rho,rho0, dlon, theta, xp, yp + real(ESMF_KIND_R8) :: xp, yp, en, de, rho, rho0, rho2, dlon, theta, dr2 + real(ESMF_KIND_R8) :: h = 1.0 - IF (stlat1 == stlat2) THEN - en=sin(stlat1*dtor) - ELSE - en=log(cos(stlat1*dtor)/cos(stlat2*dtor))/ & - log(tan((45+0.5*stlat2)*dtor)/tan((45+0.5*stlat1)*dtor)) - ENDIF + ! For reference see: + ! John P. Snyder (1987), Map projections: A working manual (pp. 104-110) + ! https://doi.org/10.3133/pp1395 - f=(cos(stlat1*dtor)*tan((45+0.5*stlat1)*dtor)**en)/en - rho0=a*f/(tan((45+0.5*c_lat)*dtor)**en) + if (stlat1 == stlat2) then + en = sin(stlat1*dtor) + else + en = log(cos(stlat1*dtor)/cos(stlat2*dtor)) / & + log(tan((45+0.5*stlat2)*dtor)/tan((45+0.5*stlat1)*dtor)) ! (15-3) + endif + h = sign(1.0_ESMF_KIND_R8,en) + + de = a*(cos(stlat1*dtor)*tan((45+0.5*stlat1)*dtor)**en)/en ! (15-2) + rho0 = de/(tan((45+0.5*c_lat)*dtor)**en) ! (15-1a) if (inv == 1) then ! FORWARD TRANSFORMATION - rho=a*f/(tan((45+0.5*glat)*dtor)**en) - dlon=modulo(glon-c_lon+180+3600,360.)-180.D0 - theta=en*dlon*dtor - x=rho*sin(theta) - y=rho0-rho*cos(theta) + rho = de/(tan((45+0.5*glat)*dtor)**en) ! (15-1) + dlon = modulo(glon-c_lon+180.0+3600.0,360.0)-180.0 + theta = en*dlon*dtor ! (14-4) + x = rho*sin(theta) ! (14-1) + y = rho0-rho*cos(theta) ! (14-2) else if (inv == -1) then ! INVERSE TRANSFORMATION - y=rho0-y - rho = sqrt(x*x+y*y) - theta=atan2(x,y) - glon=c_lon+(theta/en)*rtod - glon=modulo(glon+180+3600,360.)-180.D0 -! glat=(2.0*atan((a*f/rho)**(1.0/en))-0.5*pi)*rtod - glat=(0.5*pi-2.0*atan((rho/(a*f))**(1.0/en)))*rtod + xp = h*x; + yp = h*(rho0-y) + theta = atan2(xp,yp) ! (14-11) + glon = c_lon+(theta/en)*rtod ! (14-9) + glon = modulo(glon+180.0+3600.0,360.0)-180.0 + rho2 = xp*xp+yp*yp ! (14-10) + if (rho2 == 0.0) then + glat = h*90.0 + else + glat = 2.0*atan((de*de/rho2)**(1.0/(2.0*en)))*rtod-90.0 ! (15-5) + endif else write (unit=*,fmt=*) " lambert: unknown inv argument" return @@ -3653,7 +4108,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_regional.F90 b/io/post_fv3.F90 similarity index 84% rename from io/post_regional.F90 rename to io/post_fv3.F90 index 44ea99b2e..5f057c34a 100644 --- a/io/post_regional.F90 +++ b/io/post_fv3.F90 @@ -2,7 +2,7 @@ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !----------------------------------------------------------------------- ! -module post_regional +module post_fv3 use module_fv3_io_def, only : wrttasks_per_group,filename_base, & lon1, lat1, lon2, lat2, dlon, dlat, & @@ -16,16 +16,27 @@ module post_regional integer mype, nbdl logical setvar_atmfile, setvar_sfcfile, read_postcntrl - public post_run_regional, post_getattr_regional + public post_run_fv3, post_getattr_fv3 contains - subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & + subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & mynfhr,mynfmin,mynfsec) ! ! revision history: ! Jul 2019 J. Wang create interface to run inline post for FV3 ! Sep 2020 J. Dong/J. Wang create interface to run inline post for FV3-LAM +! Apr 2021 R. Sun Added variables for Thomspon MP +! Apr 2022 W. Meng 1)unify global and regional inline post interfaces +! 2)add bug fix for dx/dy computation +! 3)add reading pwat from FV3 +! 4)remove some variable initializations +! 5)read max/min 2m T from tmax_max2m/tmin_min2m +! for GFS, and from t02max/min for RRFS +! and HAFS. +! 6)read 3D cloud fraction from cld_amt for GFDL MP, +! and from cldfra for other MPs. +! Jun 2022 J. Meng 2D decomposition ! !----------------------------------------------------------------------- !*** run post on write grid comp @@ -33,7 +44,7 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat + jend,ista,iend, im, nsoil, filenameflat,numx use gridspec_mod, only : maptype, gridtype,latstart,latlast, & lonstart,lonlast use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl @@ -59,6 +70,8 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & ! integer n,nwtpg,ieof,lcntrl,ierr,i,j,k,jts,jte,mynsoil integer,allocatable :: jstagrp(:),jendgrp(:) + integer its,ite + integer,allocatable :: istagrp(:),iendgrp(:) integer,save :: kpo,kth,kpv logical,save :: log_postalct=.false. real,dimension(komax),save :: po, th, pv @@ -69,13 +82,13 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & ! real(kind=8) :: btim0, btim1, btim2, btim3,btim4,btim5,btim6,btim7 ! +! print *,'in post_run start' !----------------------------------------------------------------------- !*** set up dimensions !----------------------------------------------------------------------- ! btim0 = MPI_Wtime() - modelname = "FV3R" grib = "grib2" gridtype = "A" nsoil = 4 @@ -83,6 +96,8 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & nwtpg = wrt_int_state%petcount jts = wrt_int_state%lat_start !<-- Starting J of this write task's subsection jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection + its = wrt_int_state%lon_start !<-- Starting I of this write task's subsection + ite = wrt_int_state%lon_end !<-- Ending I of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount @@ -97,12 +112,16 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & if (.not.log_postalct) then ! allocate(jstagrp(nwtpg),jendgrp(nwtpg)) + allocate(istagrp(nwtpg),iendgrp(nwtpg)) ! do n=0,nwtpg-1 jstagrp(n+1) = wrt_int_state%lat_start_wrtgrp(n+1) jendgrp(n+1) = wrt_int_state%lat_end_wrtgrp (n+1) + istagrp(n+1) = wrt_int_state%lon_start_wrtgrp(n+1) + iendgrp(n+1) = wrt_int_state%lon_end_wrtgrp (n+1) enddo if(mype==0) print *,'in post_run,jstagrp=',jstagrp,'jendgrp=',jendgrp + if(mype==0) print *,'in post_run,istagrp=',istagrp,'iendgrp=',iendgrp !----------------------------------------------------------------------- !*** read namelist for pv,th,po @@ -121,7 +140,7 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & 'jstagrp=',jstagrp,'jendgrp=',jendgrp call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + mpicomp,jts,jte,jstagrp,jendgrp,its,ite,istagrp,iendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po @@ -143,7 +162,7 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr setvar_atmfile=.false. setvar_sfcfile=.false. - call set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & + call set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & @@ -190,11 +209,11 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & npset = npset + 1 call set_outflds(kth,th,kpv,pv) if(allocated(datapd))deallocate(datapd) - allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) -!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) + allocate(datapd(ite-its+1,jte-jts+1,nrecout+100)) +!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd,ista,iend) do k=1,nrecout+100 do j=1,jend+1-jsta - do i=1,im + do i=1,iend+1-ista datapd(i,j,k) = 0. enddo enddo @@ -216,11 +235,11 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & ! endif - end subroutine post_run_regional + end subroutine post_run_fv3 ! !----------------------------------------------------------------------- ! - subroutine post_getattr_regional(wrt_int_state) + subroutine post_getattr_fv3(wrt_int_state,grid_id) ! use esmf use ctlblk_mod, only: im, jm, mpi_comm_comp,gdsdegr,spval @@ -236,6 +255,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 @@ -250,96 +270,97 @@ subroutine post_getattr_regional(wrt_int_state) type(ESMF_FieldBundle) :: fldbundle ! spval = 9.99e20 +! field bundle do nfb=1, wrt_int_state%FBcount 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 im) ip1 = ip1 - im + !if (ip1 > im) ip1 = ip1 - im dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr dy(i,j) = erad*(gdlat(i,j+1)-gdlat(i,j))*dtr ! like A*DPH end do @@ -585,40 +630,24 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & bk5(i) = wrt_int_state%bk(i) enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) end do end do ! pt = ak5(1) -! GFS may not have model derived radar ref. -! TKE -! cloud amount -!$omp parallel do default(none),private(i,j,l), & -!$omp& shared(lm,jsta,jend,im,spval,ref_10cm,q2,cfr) - do l=1,lm - do j=jsta,jend - do i=1,im - ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL - cfr(i,j,l) = SPVAL - enddo - enddo - enddo - ! 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,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL enddo enddo @@ -632,22 +661,22 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m theta ! 10 m humidity ! snow free albedo -!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & +!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval,ista,iend), & !$omp& shared(cldefi,lspa,th10,q10,albase) do j=jsta,jend - do i=1,im + do i=ista,iend cldefi(i,j) = SPVAL lspa(i,j) = SPVAL th10(i,j) = SPVAL q10(i,j) = SPVAL - albase(i,j) = 0. + albase(i,j) = SPVAL enddo enddo ! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend cprate(i,j) = 0. enddo enddo @@ -657,13 +686,12 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & ! inst cloud fraction for high, middle, and low cloud, ! cfrach ! inst ground heat flux, grnflx -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval), & +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,ista,iend), & !$omp& shared(czen,czmean,radot,cfrach,cfracl,cfracm,grnflx) do j=jsta,jend - do i=1,im + do i=ista,iend czen(i,j) = SPVAL czmean(i,j) = SPVAL - radot(i,j) = SPVAL cfrach(i,j) = SPVAL cfracl(i,j) = SPVAL cfracm(i,j) = SPVAL @@ -681,29 +709,24 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & ! cfrcv to 1 ! time averaged cloud fraction, set acfrst to spval, ncfrst to 1 ! UNDERGROUND RUNOFF, bgroff -! inst incoming sfc longwave, rlwin +! inst incoming sfc longwave ! inst model top outgoing longwave,rlwtoa ! inst incoming sfc shortwave, rswin ! inst incoming clear sky sfc shortwave, rswinc ! inst outgoing sfc shortwave, rswout ! snow phase change heat flux, snopcx ! GFS does not use total momentum flux,sfcuvx -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval), & -!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rlwin,rlwtoa,rswin,rswinc,rswout,snopcx,sfcuvx) +!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,ista,iend), & +!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rlwtoa,rswin,rswinc,rswout,snopcx,sfcuvx) do j=jsta,jend - do i=1,im + do i=ista,iend acfrcv(i,j) = spval ncfrcv(i,j) = 1.0 acfrst(i,j) = spval ncfrst(i,j) = 1.0 bgroff(i,j) = spval - rlwin(i,j) = spval rlwtoa(i,j) = spval - rswin(i,j) = spval rswinc(i,j) = spval - rswout(i,j) = spval - snopcx(i,j) = spval - sfcuvx(i,j) = spval enddo enddo @@ -719,10 +742,10 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & ! temperature tendency due to latent heating from convection ! temperature tendency due to latent heating from grid scale do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l), & +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l,ista_2l,iend_2u), & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u - do i=1,im + do i=ista_2l,iend_2u rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval @@ -749,10 +772,10 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & ! v at roughness length, vz0 ! shelter rh max, maxrhshltr ! shelter rh min, minrhshltr -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,ista_2l,iend_2u), & !$omp& shared(smstav,sfcevp,acsnow,acsnom,qz0,uz0,vz0,maxrhshltr,minrhshltr) do j=jsta_2l,jend_2u - do i=1,im + do i=ista_2l,iend_2u smstav(i,j) = spval sfcevp(i,j) = spval acsnow(i,j) = spval @@ -760,17 +783,15 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & qz0(i,j) = spval uz0(i,j) = spval vz0(i,j) = spval - maxrhshltr(i,j) = SPVAL - minrhshltr(i,j) = SPVAL enddo enddo ! GFS does not have mixing length,el_pbl ! exchange coefficient, exch_h do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h) +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h,ista_2l,iend_2u) do j=jsta_2l,jend_2u - do i=1,im + do i=ista_2l,iend_2u el_pbl(i,j,l) = spval exch_h(i,j,l) = spval enddo @@ -778,10 +799,10 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & enddo ! GFS does not have deep convective cloud top and bottom fields -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,ista_2l,iend_2u), & !$omp& shared(htopd,hbotd,htops,hbots,cuppt) do j=jsta_2l,jend_2u - do i=1,im + do i=ista_2l,iend_2u htopd(i,j) = SPVAL hbotd(i,j) = SPVAL htops(i,j) = SPVAL @@ -814,48 +835,6 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & ! tstart = 0. ! -!** initialize cloud water and ice mixing ratio -!$omp parallel do default(none),private(i,j,l),shared(lm,jsta,jend,im), & -!$omp& shared(qqw,qqr,qqs,qqi) - do l = 1,lm - do j = jsta, jend - do i = 1,im - qqw(i,j,l) = 0. - qqr(i,j,l) = 0. - qqs(i,j,l) = 0. - qqi(i,j,l) = 0. - enddo - enddo - enddo -! -!** temporary fix: initialize t10m, t10avg, psfcavg, akhsavg, akmsavg, -!** albedo, tg -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im), & -!$omp& shared(t10m,t10avg,psfcavg,akhsavg,akmsavg,albedo,tg) - do j=jsta_2l,jend_2u - do i=1,im - t10m(i,j) = 0. - t10avg(i,j) = 0. - psfcavg(i,j) = 0. - akhsavg(i,j) = 0. - akmsavg(i,j) = 0. - albedo(i,j) = 0. - tg(i,j) = 0. - enddo - enddo -!$omp parallel do default(none),private(i,j,k),shared(jsta_2l,jend_2u,im,lm), & -!$omp& shared(extcof55,aextc55,u,v) - do k=1,lm - do j=jsta_2l,jend_2u - do i=1,im - extcof55(i,j,k) = 0. - aextc55(i,j,k) = 0. - u(i,j,k) = 0. - v(i,j,k) = 0. - enddo - enddo - enddo -! !----------------------------------------------------------------------------- ! get post fields !----------------------------------------------------------------------------- @@ -884,8 +863,6 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & line=__LINE__, file=__FILE__)) return ! bail out ! print *,'in post_lam, get land field value,fillvalue=',fillvalue - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm,fillValue) do j=jsta, jend do i=ista, iend @@ -918,8 +895,6 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in post_lam, get icec field value,fillvalue=',fillvalue - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm,fillValue) do j=jsta, jend do i=ista, iend @@ -1092,6 +1067,18 @@ subroutine set_postvars_regional(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,dtq2,arrayr42d,avgcprate,fillValue,spval) @@ -1170,7 +1157,7 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & if (arrayr42d(i,j) /= spval .and. abs(arrayr42d(i,j)-fillValue) > small) then cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp else - cprate(i,j) = spval + cprate(i,j) = 0. endif enddo enddo @@ -1341,6 +1328,17 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & enddo endif + ! land fraction + if(trim(fieldname)=='lfrac') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,landfrac,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + landfrac(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) landfrac(i,j) = spval + enddo + enddo + endif + ! ave high cloud fraction if(trim(fieldname)=='tcdc_avehcl') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d,fillValue) @@ -2001,12 +1999,110 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) - if( abs(arrayr42d(i,j)-fillValue) < small) pbot(i,j) = spval + if( abs(arrayr42d(i,j)-fillValue) < small) pbot(i,j) = spval if(pbot(i,j) <= 0.0) pbot(i,j) = spval enddo enddo endif + ! time averaged low cloud top pressure + if(trim(fieldname)=='pres_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptopl,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + ptopl(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) ptopl(i,j) = spval + enddo + enddo + endif + + ! time averaged low cloud bottom pressure + if(trim(fieldname)=='pres_avelcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbotl,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + pbotl(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) pbotl(i,j) = spval + enddo + enddo + endif + + ! time averaged low cloud top temperature + if(trim(fieldname)=='tmp_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ttopl,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + ttopl(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) ttopl(i,j) = spval + enddo + enddo + endif + + ! time averaged middle cloud top pressure + if(trim(fieldname)=='pres_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptopm,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + ptopm(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) ptopm(i,j) = spval + enddo + enddo + endif + ! time averaged middle cloud bottom pressure + if(trim(fieldname)=='pres_avemcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbotm,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + pbotm(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) pbotm(i,j) = spval + enddo + enddo + endif + + ! time averaged middle cloud top temperature + if(trim(fieldname)=='tmp_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ttopm,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + ttopm(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) ttopm(i,j) = spval + enddo + enddo + endif + + ! time averaged high cloud top pressure + if(trim(fieldname)=='pres_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptoph,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + ptoph(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) ptoph(i,j) = spval + enddo + enddo + endif + + ! time averaged high cloud bottom pressure + if(trim(fieldname)=='pres_avehcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pboth,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + pboth(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) pboth(i,j) = spval + enddo + enddo + endif + + ! time averaged high cloud top temperature + if(trim(fieldname)=='tmp_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ttoph,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + ttoph(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) ttoph(i,j) = spval + enddo + enddo + endif + ! time averaged boundary layer cloud cover if(trim(fieldname)=='tcdc_avebndcl') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d,fillValue) @@ -2042,7 +2138,66 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & enddo endif + ! accumulated evaporation of intercepted water + if(trim(fieldname)=='ecan_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,tecan,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + tecan(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) tecan(i,j) = spval + if (sm(i,j) /= 0.0) tecan(i,j) = spval + enddo + enddo + endif + + ! accumulated plant transpiration + if(trim(fieldname)=='etran_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,tetran,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + tetran(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) tetran(i,j) = spval + if (sm(i,j) /= 0.0) tetran(i,j) = spval + enddo + enddo + endif + + ! accumulated soil surface evaporation + if(trim(fieldname)=='edir_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,tedir,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + tedir(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) tedir(i,j) = spval + if (sm(i,j) /= 0.0) tedir(i,j) = spval + enddo + enddo + endif + + ! total water storage in aquifer + if(trim(fieldname)=='wa_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twa,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + twa(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) twa(i,j) = spval + if (sm(i,j) /= 0.0) twa(i,j) = spval + enddo + enddo + endif + ! shelter max temperature + if(modelname=='GFS') then + if(trim(fieldname)=='tmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d,fillValue,spval) + do j=jsta,jend + do i=ista, iend + maxtshltr(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) maxtshltr(i,j) = spval + enddo + enddo + endif + else if(trim(fieldname)=='t02max') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d,fillValue,spval) do j=jsta,jend @@ -2052,9 +2207,10 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo endif + endif ! shelter min temperature - if(trim(fieldname)=='t02min') then + if(trim(fieldname)=='t02min' .or. trim(fieldname)=='tmin_min2m') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d,fillValue,spval) do j=jsta,jend do i=ista, iend @@ -2086,6 +2242,28 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & enddo endif + ! shelter max specific humidity + if(trim(fieldname)=='spfhmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,maxqshltr,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + maxqshltr(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) maxqshltr(i,j) = spval + enddo + enddo + endif + + ! shelter min temperature + if(trim(fieldname)=='spfhmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,minqshltr,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + minqshltr(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) minqshltr(i,j) = spval + enddo + enddo + endif + ! ice thickness if(trim(fieldname)=='icetk') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d,fillValue,spval) @@ -2278,6 +2456,30 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & enddo endif + ! AVERAGED PRECIP ADVECTED HEAT FLUX + if(trim(fieldname)=='pah_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,paha,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + paha(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) paha(i,j) = spval + if (sm(i,j) /= 0.0) paha(i,j) = spval + enddo + enddo + endif + + ! instantaneous PRECIP ADVECTED HEAT FLUX + if(trim(fieldname)=='pahi') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pahi,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + pahi(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) pahi(i,j) = spval + if (sm(i,j) /= 0.0) pahi(i,j) = spval + enddo + enddo + endif + ! plant transpiration if(trim(fieldname)=='trans_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm,fillValue) @@ -2325,10 +2527,22 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo endif + + + ! snow phase change heat flux + if(trim(fieldname)=='pwat') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pwat,arrayr42d,fillValue) + do j=jsta,jend + do i=ista, iend + pwat(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) pwat(i,j) = spval + enddo + enddo + endif ! model level upvvelmax if(trim(fieldname)=='upvvelmax') then - !$omp parallel do default(none) private(i,j,l) shared(jsta,jend,ista,iend,spval,w_up_max,arrayr42d,fillvalue) + !$omp parallel do default(none) private(i,j,l) shared(jsta,jend,ista,iend,spval,w_up_max,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend w_up_max(i,j) = arrayr42d(i,j) @@ -2339,7 +2553,7 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & ! model level dnvvelmax if(trim(fieldname)=='dnvvelmax') then - !$omp parallel do default(none) private(i,j,l) shared(jsta,jend,ista,iend,spval,w_dn_max,arrayr42d,fillvalue) + !$omp parallel do default(none) private(i,j,l) shared(jsta,jend,ista,iend,spval,w_dn_max,arrayr42d,fillValue) do j=jsta,jend do i=ista, iend w_dn_max(i,j) = arrayr42d(i,j) @@ -2587,7 +2801,11 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ozone mixing ratio +#ifdef MULTI_GASES + if(trim(fieldname)=='spo3') then +#else if(trim(fieldname)=='o3mr') then +#endif !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d,fillvalue,spval) do l=1,lm do j=jsta,jend @@ -2599,8 +2817,8 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & enddo endif -! for GFDL MP -! if (imp_physics == 11) then +! for GFDL MP or Thompson MP + if (imp_physics == 11 .or. imp_physics == 8) then ! model level cloud water mixing ratio if(trim(fieldname)=='clwmr') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d,fillvalue,spval) @@ -2671,10 +2889,79 @@ subroutine set_postvars_regional(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo endif -!gfdlmp -! endif + + if(imp_physics == 8) then + ! model level rain number + if(trim(fieldname)=='ncrain') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d,spval,fillvalue) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnr(i,j,l)=arrayr43d(i,j,l) + if(abs(arrayr43d(i,j,l)-fillvalue)0) then - do i=1,size(paramset) - if (associated(paramset(i)%param)) then - if (size(paramset(i)%param)>0) then - deallocate(paramset(i)%param) - nullify(paramset(i)%param) - endif - endif - enddo - deallocate(paramset) - nullify(paramset) - endif - endif - num_pset = 0 - call read_xml() - if(mype==0) print *,'af read_xml,name=',trim(filenameflat),'ifhr=',ifhr - read_postcntrl = .false. - endif - endif -! - IEOF = 0 - npset = 0 - icount_calmict = 0 - do while( IEOF == 0) -! - if(grib == "grib2") then - npset = npset + 1 - call set_outflds(kth,th,kpv,pv) - if(allocated(datapd))deallocate(datapd) - allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) -!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) - do k=1,nrecout+100 - do j=1,jend+1-jsta - do i=1,im - datapd(i,j,k) = 0. - enddo - enddo - enddo - call get_postfilename(post_fname) - if (mype==0) write(0,*)'post_fname=',trim(post_fname) -! - if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) -! - call mpi_barrier(mpicomp,ierr) - call gribit2(post_fname) - if(allocated(datapd))deallocate(datapd) - if(allocated(fld_info))deallocate(fld_info) - if(npset >= num_pset) exit - - endif -! - enddo -! - endif - - end subroutine post_run_gfs -! -!----------------------------------------------------------------------- -! - subroutine post_getattr_gfs(wrt_int_state) -! - use esmf - use ctlblk_mod, only: im, jm, mpi_comm_comp - use masks, only: gdlat, gdlon, dx, dy - use gridspec_mod, only: latstart, latlast, lonstart, & - lonlast, cenlon, cenlat -! - implicit none -! - type(wrt_internal_state),intent(inout) :: wrt_int_state -! -! local variable - integer i,j,k,n,kz, attcount, nfb - integer ni,naryi,nr4,nr8,rc - integer aklen,varival - real(4) varr4val - real(8) varr8val - character(80) attName, hydrostatics, fldname - type(ESMF_TypeKind_Flag) :: typekind - real(4), dimension(:), allocatable :: ak4,bk4 - real(8), dimension(:), allocatable :: ak8,bk8 - type(ESMF_FieldBundle) :: fldbundle -! -! field bundle - do nfb=1, wrt_int_state%FBcount - fldbundle = wrt_int_state%wrtFB(nfb) - -! look at the field bundle attributes - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out -! - aklen=0. - do i=1, attCount - - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out - - if (typekind==ESMF_TYPEKIND_I4 ) then - if(n==1) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival - if (trim(attName) == 'ncld') wrt_int_state%ncld=varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival - endif - else if (typekind==ESMF_TYPEKIND_R4) then - if(n==1) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (trim(attName) == 'dtp') then - wrt_int_state%dtp=varr4val - endif - else if(n>1) then - if(trim(attName) =="ak") then - if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) - allocate(wrt_int_state%ak(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) - wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then - if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) - allocate(wrt_int_state%bk(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) - endif - endif - else if (typekind==ESMF_TYPEKIND_R8) then - if(n==1) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (trim(attName) == 'dtp') then - wrt_int_state%dtp=varr8val - endif - else if(n>1) then - if(trim(attName) =="ak") then - if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) - allocate(wrt_int_state%ak(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) - wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then - if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) - allocate(wrt_int_state%bk(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) - endif - wrt_int_state%lm = size(wrt_int_state%ak) - 1 - endif - endif -! - enddo -! - enddo !end nfb -! print *,'in post_getattr, dtp=',wrt_int_state%dtp -! - end subroutine post_getattr_gfs -!----------------------------------------------------------------------- -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -!----------------------------------------------------------------------- -! - subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) -! -! revision history: -! Jul 2019 J. Wang Initial code -! -!----------------------------------------------------------------------- -!*** set up post fields from nmint_state -!----------------------------------------------------------------------- -! - use esmf - use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & - qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & - q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, qqni,qqnr,qqnwfa,qqnifa - use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& - qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& - cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& - avgalbedo, avgtcdc, czen, czmean, mxsnal,landfrac,& - radot, cfrach, cfracl, cfracm, avgcfrach, qshltr, & - avgcfracl, avgcfracm, cnvcfr, islope, cmc, grnflx,& - vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, & - bgroff, rlwin, & - rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, & - rswinc, rswout, aswin, auvbin, auvbinc, aswout, & - aswtoa, sfcshx, sfclhx, subshx, snopcx, sfcux, & - sfcvx, sfcuvx, gtaux, gtauy, potevp, u10, v10, & - smstav, smstot, ivgtyp, isltyp, sfcevp, sfcexc, & - acsnow, acsnom, sst, thz0, qz0, uz0, vz0, ptop, & - htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, & - pbotm, ttopm, ptoph, pboth, pblcfr, ttoph, runoff,& - tecan, tetran, tedir, twa, & - maxtshltr, mintshltr, maxrhshltr, minrhshltr, & - dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, & - htops, hbots, aswintoa, maxqshltr, minqshltr, & - acond, sr, u10h, v10h, avgedir, avgecan,paha,pahi,& - avgetrans, avgesnow, avgprec_cont, avgcprate_cont,& - avisbeamswin, avisdiffswin, airbeamswin, airdiffswin, & - alwoutc, alwtoac, aswoutc, aswtoac, alwinc, aswinc,& - avgpotevp, snoavg, ti, si, cuppt - 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, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & - ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst - use params_mod, only: erad, dtr, capa, p1000 - use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat - use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & - qs0, sqs, sthe, ttblq, rdpq, rdtheq, stheq, the0q, the0 - use physcons, only: grav => con_g, fv => con_fvirt, rgas => con_rd, & - eps => con_eps, epsm1 => con_epsm1 - use rqstfld_mod -! -! use write_internal_state, only: wrt_internal_state -! -!----------------------------------------------------------------------- -! - implicit none -! - include 'mpif.h' -! -!----------------------------------------------------------------------- -! - type(wrt_internal_state),intent(in) :: wrt_int_state - integer,intent(in) :: mpicomp - logical,intent(inout) :: setvar_atmfile,setvar_sfcfile -! -!----------------------------------------------------------------------- -! - integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend - integer ista,iend,fieldDimCount,gridDimCount,ncount_field - integer jdate(8) - logical foundland, foundice, found - real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp - real, dimension(:),allocatable :: ak5, bk5 - real(4),dimension(:,:),pointer :: arrayr42d - real(8),dimension(:,:),pointer :: arrayr82d - real(4),dimension(:,:,:),pointer :: arrayr43d - real(8),dimension(:,:,:),pointer :: arrayr83d - real,dimension(:), allocatable :: slat,qstl - real,external::FPVSNEW - real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, & - cw2d, cfr2d - character(len=80) :: fieldname, wrtFBName - type(ESMF_Grid) :: wrtGrid - type(ESMF_Field) :: theField - type(ESMF_Field), allocatable :: fcstField(:) - type(ESMF_TypeKind_Flag) :: typekind -! -!----------------------------------------------------------------------- -!*** INTEGER SCALAR/1D HISTORY VARIABLES -!----------------------------------------------------------------------- -! - imp_physics = wrt_int_state%imp_physics !set GFS mp physics to 99 for Zhao scheme - dtp = wrt_int_state%dtp - iSF_SURFACE_PHYSICS = 2 - spval = 9.99e20 - -! -! nems gfs has zhour defined - tprec = float(wrt_int_state%fhzero) - tclod = tprec - trdlw = tprec - trdsw = tprec - tsrfc = tprec - tmaxmin = tprec - td3d = tprec - if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'nbdl=',nbdl, 'tprec=',tprec,'tclod=',tclod, & - 'dtp=',dtp,'tmaxmin=',tmaxmin - -! write(6,*) 'maptype and gridtype is ', maptype,gridtype -! -!$omp parallel do default(shared),private(i,j) - do j=jsta,jend - do i=1,im - gdlat(i,j) = wrt_int_state%latPtr(i,j) - gdlon(i,j) = wrt_int_state%lonPtr(i,j) - enddo - enddo -! - lonstart = nint(wrt_int_state%lonstart*gdsdegr) - lonlast = nint(wrt_int_state%lonlast*gdsdegr) - latstart = nint(wrt_int_state%latstart*gdsdegr) - latlast = nint(wrt_int_state%latlast*gdsdegr) -! print*,'latstart,latlast B bcast= ',latstart,latlast -! print*,'lonstart,lonlast B bcast= ',lonstart,lonlast - -!$omp parallel do default(none),private(i,j,ip1), & -!$omp& shared(jsta,jend_m,im,dx,gdlat,gdlon,dy) - do j = jsta, jend_m - do i = 1, im - ip1 = i + 1 - if (ip1 > im) ip1 = ip1 - im - dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr - dy(i,j) = erad*(gdlat(i,j)-gdlat(i,j+1))*dtr ! like A*DPH - end do - end do -! - if(.not. allocated(ak5)) allocate(ak5(lm+1),bk5(lm+1)) - do i=1,lm+1 - ak5(i) = wrt_int_state%ak(i) - bk5(i) = wrt_int_state%bk(i) - enddo - -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat) - do j=jsta,jend - do i=1,im - f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) - end do - end do -! -! GFS does not output PD - pt = ak5(1) - -! GFS may not have model derived radar ref. -! TKE -! cloud amount -!$omp parallel do default(none),private(i,j,l), & -!$omp& shared(lm,jsta,jend,im,spval,ref_10cm,q2,cfr) - do l=1,lm - do j=jsta,jend - do i=1,im - ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL - cfr(i,j,l) = SPVAL - enddo - enddo - enddo - -! 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) - do j=jsta,jend - do i=1,im - qs(i,j) = SPVAL - twbs(i,j) = SPVAL - qwbs(i,j) = SPVAL - ths(i,j) = SPVAL - enddo - enddo - -! GFS set up DT to compute accumulated fields, set it to one - dtq2 = wrt_int_state%dtp - nphs = 2. - dt = dtq2/nphs -! -! GFS does not have convective cloud efficiency -! similated precip -! 10 m theta -! 10 m humidity -! snow free albedo -!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase) - do j=jsta,jend - do i=1,im - cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL - albase(i,j) = SPVAL - enddo - enddo - -! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) - do j=jsta,jend - do i=1,im - cprate(i,j) = 0. - enddo - enddo - -! GFS probably does not use zenith angle, czen, czmean -! inst surface outgoing longwave, radot -! inst cloud fraction for high, middle, and low cloud, -! cfrach -! inst ground heat flux, grnflx -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval), & -!$omp& shared(czen,czmean,radot,cfrach,cfracl,cfracm,grnflx) - do j=jsta,jend - do i=1,im - czen(i,j) = SPVAL - czmean(i,j) = SPVAL - radot(i,j) = SPVAL - cfrach(i,j) = SPVAL - cfracl(i,j) = SPVAL - cfracm(i,j) = SPVAL - grnflx(i,j) = SPVAL - enddo - enddo -! -! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam - sldpth(1) = 0.10 - sldpth(2) = 0.3 - sldpth(3) = 0.6 - sldpth(4) = 1.0 - -! GFS does not output time averaged convective and strat cloud fraction, set acfrcv to spval, n -! cfrcv to 1 -! time averaged cloud fraction, set acfrst to spval, ncfrst to 1 -! UNDERGROUND RUNOFF, bgroff -! inst incoming sfc longwave, rlwin -! inst model top outgoing longwave,rlwtoa -! inst incoming sfc shortwave, rswin -! inst incoming clear sky sfc shortwave, rswinc -! inst outgoing sfc shortwave, rswout -! snow phase change heat flux, snopcx -! GFS does not use total momentum flux,sfcuvx -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval), & -!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rlwin,rlwtoa,rswin,rswinc,rswout,snopcx,sfcuvx) - do j=jsta,jend - do i=1,im - acfrcv(i,j) = spval - ncfrcv(i,j) = 1.0 - acfrst(i,j) = spval - ncfrst(i,j) = 1.0 - bgroff(i,j) = spval - rlwin(i,j) = spval - rlwtoa(i,j) = spval - rswin(i,j) = spval - rswinc(i,j) = spval - rswout(i,j) = spval - snopcx(i,j) = spval - sfcuvx(i,j) = spval - enddo - enddo - -! GFS incoming sfc longwave has been averaged over 6 hr bucket, set ARDLW to 1 - ardlw = 1.0 -! GFS incoming sfc longwave has been averaged, set ARDLW to 1 - ardsw = 1.0 -! GFS surface flux has been averaged, set ASRFC to 1 - asrfc = 1.0 - -! GFS does not have temperature tendency due to long wave radiation -! temperature tendency due to short wave radiation -! temperature tendency due to latent heating from convection -! temperature tendency due to latent heating from grid scale - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l), & -!$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) - do j=jsta_2l,jend_2u - do i=1,im - rlwtt(i,j,l) = spval - rswtt(i,j,l) = spval - tcucn(i,j,l) = spval - tcucns(i,j,l) = spval - train(i,j,l) = spval - enddo - enddo - enddo - -! set avrain to 1 - avrain = 1.0 - avcnvc = 1.0 - theat = 6.0 ! just in case GFS decides to output T tendency - -! GFS does not have temperature tendency due to latent heating from grid scale - train = spval - -! GFS does not have soil moisture availability, smstav -! accumulated surface evaporatio, sfcevp -! averaged accumulated snow, acsnow -! snow melt,acsnom -! humidity at roughness length, qz0 -! u at roughness length, uz0 -! v at roughness length, vz0 -! shelter rh max, maxrhshltr -! shelter rh min, minrhshltr -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & -!$omp& shared(smstav,sfcevp,acsnow,acsnom,qz0,uz0,vz0,maxrhshltr,minrhshltr) - do j=jsta_2l,jend_2u - do i=1,im - smstav(i,j) = spval - sfcevp(i,j) = spval - acsnow(i,j) = spval - acsnom(i,j) = spval - qz0(i,j) = spval - uz0(i,j) = spval - vz0(i,j) = spval - maxrhshltr(i,j) = SPVAL - minrhshltr(i,j) = SPVAL - enddo - enddo - -! GFS does not have mixing length,el_pbl -! exchange coefficient, exch_h - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h) - do j=jsta_2l,jend_2u - do i=1,im - el_pbl(i,j,l) = spval - exch_h(i,j,l) = spval - enddo - enddo - enddo - -! GFS does not have deep convective cloud top and bottom fields -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & -!$omp& shared(htopd,hbotd,htops,hbots,cuppt) - do j=jsta_2l,jend_2u - do i=1,im - htopd(i,j) = SPVAL - hbotd(i,j) = SPVAL - htops(i,j) = SPVAL - hbots(i,j) = SPVAL - cuppt(i,j) = SPVAL - enddo - enddo -! -! get inital date - sdat(1) = wrt_int_state%idate(2) !month - sdat(2) = wrt_int_state%idate(3) !day - sdat(3) = wrt_int_state%idate(1) !year - ihrst = wrt_int_state%idate(4) !hour - - idat(1) = wrt_int_state%fdate(2) - idat(2) = wrt_int_state%fdate(3) - idat(3) = wrt_int_state%fdate(1) - idat(4) = wrt_int_state%fdate(4) - idat(5) = wrt_int_state%fdate(5) -! - if(mype==0) print *,'idat=',idat,'sdat=',sdat,'ihrst=',ihrst -! CALL W3DIFDAT(JDATE,IDATE,0,RINC) -! -! if(mype==0)print *,' rinc=',rinc -! ifhr = nint(rinc(2)+rinc(1)*24.) -! if(mype==0)print *,' ifhr=',ifhr -! ifmin = nint(rinc(3)) -! if(ifhr /= nint(fhour))print*,'find wrong Grib file';stop -! if(mype==0)print*,' in INITPOST ifhr ifmin =',ifhr,ifmin -! - tstart = 0. -! -!** initialize cloud water and ice mixing ratio -!$omp parallel do default(none),private(i,j,l),shared(lm,jsta,jend,im), & -!$omp& shared(qqw,qqr,qqs,qqi) - do l = 1,lm - do j = jsta, jend - do i = 1,im - qqw(i,j,l) = 0. - qqr(i,j,l) = 0. - qqs(i,j,l) = 0. - qqi(i,j,l) = 0. - enddo - enddo - enddo -! -!----------------------------------------------------------------------------- -! get post fields -!----------------------------------------------------------------------------- -! - foundland = .false. - foundice = .false. - get_lsmsk: do ibdl=1, wrt_int_state%FBCount - -! find lans sea mask - found = .false. - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found - if (found) then - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) - !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) - do j=jsta, jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) - enddo - enddo - foundland = .true. - endif - -! find ice fraction - found = .false. - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found - if (found) then - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) - do j=jsta, jend - do i=ista, iend - sice(i,j) = arrayr42d(i,j) - if (sm(i,j) /= spval .and. sm(i,j) == 0.0) sice(i,j) = 0.0 - enddo - enddo - foundice = .true. - endif - - enddo get_lsmsk - if (.not.foundland .or. .not.foundice) then - rc=999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount -! - file_loop_all: do ibdl=1, wrt_int_state%FBCount -! -! get grid dimension count -! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) - allocate(fcstField(ncount_field)) - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field - do n=1, ncount_field -! - call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (index(trim(fieldname),"vector") >0) cycle -! -!** for 2D fields - if (fieldDimCount == 2) then - - if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate( arrayr42d(ista:iend,jsta:jend)) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) - do j=jsta, jend - do i=ista, iend - arrayr42d(i,j) = arrayr82d(i,j) - enddo - enddo - endif - - ! Terrain height (*G later) - if(trim(fieldname)=='hgtsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) - do j=jsta,jend - do i=ista, iend - fis(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! Surface pressure -! if(trim(fieldname)=='pressfc') then -! !$omp parallel do private(i,j) -! do j=jsta,jend -! do i=ista, iend -! pint(i,j,lp1)=arrayr42d(i,j) -! enddo -! enddo -! endif - - ! PBL height using nemsio - if(trim(fieldname)=='hpbl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) - do j=jsta,jend - do i=ista, iend - pblh(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! frictional velocity - if(trim(fieldname)=='fricv') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) - do j=jsta,jend - do i=ista, iend - ustar(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! roughness length - if(trim(fieldname)=='sfcr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) - do j=jsta,jend - do i=ista, iend - z0(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! sfc exchange coeff - if(trim(fieldname)=='sfexc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcexc(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! aerodynamic conductance - if(trim(fieldname)=='acond') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) - do j=jsta,jend - do i=ista, iend - acond(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! surface potential T - if(trim(fieldname)=='tmpsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - ths(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) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) - enddo - enddo - endif - - ! continuous bucket convective precip in m per physics time step - if(trim(fieldname)=='cprat_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) - endif - enddo - enddo - endif - - ! time averaged bucketed precip rate - if(trim(fieldname)=='prateb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) - endif - enddo - enddo - endif - - ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname)=='prate_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) - endif - enddo - enddo - endif - - ! precip rate in m per physics time step - if(trim(fieldname)=='tprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp - endif - enddo - enddo - endif - - ! convective precip rate in m per physics time step - if(trim(fieldname)=='cnvprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp - endif - enddo - enddo - endif - - ! inst snow water eqivalent - if(trim(fieldname)=='weasd') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval - enddo - enddo - endif - - ! ave snow cover - if(trim(fieldname)=='snowc_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval - if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. - enddo - enddo - endif - - ! snow depth in mm - if(trim(fieldname)=='snod') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - si(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval - if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 - enddo - enddo - endif - - ! 2m potential T (computed later) - if(trim(fieldname)=='tmp2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - tshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! surface potential T - if(trim(fieldname)=='spfh2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - qshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! mid day avg albedo in fraction - if(trim(fieldname)=='albdo_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgalbedo(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgalbedo(i,j) = avgalbedo(i,j) * 0.01 - endif - enddo - enddo - endif - - ! time averaged column cloud fraction - if(trim(fieldname)=='tcdc_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgtcdc(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgtcdc(i,j) = avgtcdc(i,j) * 0.01 - endif - enddo - enddo - endif - - ! maximum snow albedo in fraction - if(trim(fieldname)=='snoalb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) - do j=jsta,jend - do i=ista, iend - mxsnal(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - mxsnal(i,j) = mxsnal(i,j) * 0.01 - endif - enddo - enddo - endif - - ! land fraction - if(trim(fieldname)=='lfrac') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,landfrac,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - landfrac(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) landfrac(i,j) = spval - enddo - enddo - endif - - - ! ave high cloud fraction - if(trim(fieldname)=='tcdc_avehcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgcfrach(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgcfrach(i,j) = avgcfrach(i,j) * 0.01 - endif - enddo - enddo - endif - - ! ave low cloud fraction - if(trim(fieldname)=='tcdc_avelcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgcfracl(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgcfracl(i,j) = avgcfracl(i,j) * 0.01 - endif - enddo - enddo - endif - - ! ave middle cloud fraction - if(trim(fieldname)=='tcdc_avemcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgcfracm(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgcfracm(i,j) = avgcfracm(i,j) * 0.01 - endif - enddo - enddo - endif - - ! inst convective cloud fraction - if(trim(fieldname)=='tcdccnvcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) - do j=jsta,jend - do i=ista, iend - cnvcfr(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - cnvcfr(i,j) = cnvcfr(i,j) * 0.01 - endif - enddo - enddo - endif - - ! slope type - if(trim(fieldname)=='sltyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) < spval) then - islope(i,j) = nint(arrayr42d(i,j)) - else - islope(i,j) = 0 - endif - enddo - enddo - endif - - ! time averaged column cloud fraction - if(trim(fieldname)=='cnwat') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - cmc(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001 - if (sm(i,j) /= 0.0) cmc(i,j) = spval - enddo - enddo - endif - - ! frozen precip fraction - if(trim(fieldname)=='cpofp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - !set range within (0,1) - sr(i,j) = min(1.,max(0.,arrayr42d(i,j))) - else - sr(i,j) = spval - endif - enddo - enddo - endif - - ! sea ice skin temperature - if(trim(fieldname)=='tisfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) - do j=jsta,jend - do i=ista,iend - if (arrayr42d(i,j) /= spval) then - ti(i,j) = arrayr42d(i,j) - if (sice(i,j) == spval .or. sice(i,j) == 0.) ti(i,j)=spval - else - ti(i,j) = spval - endif - enddo - enddo - endif - - ! vegetation fraction - if(trim(fieldname)=='veg') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - vegfrc(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - vegfrc(i,j) = vegfrc(i,j) * 0.01 - else - vegfrc(i,j) = 0.0 - endif - if (sm(i,j) /= 0.0) vegfrc(i,j) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,1) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,1) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,2) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,2) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,3) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,3) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,4) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,4) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname)=='soilw1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,1) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,1) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname)=='soilw2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,2) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,2) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname)=='soilw3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,3) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,3) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname)=='soilw4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,4) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,4) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname)=='soilt1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,1) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,1) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname)=='soilt2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,2) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,2) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname)=='soilt3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,3) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,3) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname)=='soilt4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,4) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,4) = spval - enddo - enddo - endif - - ! time averaged incoming sfc longwave - if(trim(fieldname)=='dlwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! inst incoming sfc longwave - if(trim(fieldname)=='dlwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) - do j=jsta,jend - do i=ista, iend - rlwin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname)=='ulwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwout(i,j) = arrayr42d(i,j) - if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j) - enddo - enddo - endif - - ! inst outgoing sfc longwave - if(trim(fieldname)=='ulwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) - do j=jsta,jend - do i=ista, iend - radot(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged outgoing model top longwave - if(trim(fieldname)=='ulwrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwtoa(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged incoming sfc shortwave - if(trim(fieldname)=='dswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! inst incoming sfc shortwave - if(trim(fieldname)=='dswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - rswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged incoming sfc uv-b - if(trim(fieldname)=='duvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) - do j=jsta,jend - do i=ista, iend - auvbin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname)=='cduvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) - do j=jsta,jend - do i=ista, iend - auvbinc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname)=='uswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswout(i,j) = arrayr42d(i,j) - if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j) - enddo - enddo - endif - - ! inst outgoing sfc shortwave - if(trim(fieldname)=='uswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) - do j=jsta,jend - do i=ista, iend - rswout(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged model top incoming shortwave - if(trim(fieldname)=='dswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswintoa(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! ime averaged model top outgoing shortwave - if(trim(fieldname)=='uswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswtoa(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface sensible heat flux, multiplied by -1 because - ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname)=='shtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcshx(i,j) = arrayr42d(i,j) - if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j) - enddo - enddo - endif - - ! inst surface sensible heat flux - if(trim(fieldname)=='shtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) - do j=jsta,jend - do i=ista, iend - twbs(i,j) = arrayr42d(i,j) - if (twbs(i,j) /= spval) twbs(i,j) = -twbs(i,j) - enddo - enddo - endif - - ! time averaged surface latent heat flux, multiplied by -1 because - ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname)=='lhtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfclhx(i,j) = arrayr42d(i,j) - if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j) - enddo - enddo - endif - - ! inst surface latent heat flux - if(trim(fieldname)=='lhtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) - do j=jsta,jend - do i=ista, iend - qwbs(i,j) = arrayr42d(i,j) - if (qwbs(i,j) /= spval) qwbs(i,j) = -qwbs(i,j) - enddo - enddo - endif - - ! time averaged ground heat flux - if(trim(fieldname)=='gflux_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval - enddo - enddo - endif - - ! inst ground heat flux - if(trim(fieldname)=='gflux') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval - enddo - enddo - endif - - ! time averaged zonal momentum flux - if(trim(fieldname)=='uflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcux(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged meridional momentum flux - if(trim(fieldname)=='vflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcvx(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged zonal gravity wave stress - if(trim(fieldname)=='u-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) - do j=jsta,jend - do i=ista, iend - gtaux(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged meridional gravity wave stress - if(trim(fieldname)=='v-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) - do j=jsta,jend - do i=ista, iend - gtauy(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged accumulated potential evaporation - if(trim(fieldname)=='pevpr_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval - enddo - enddo - endif - - ! inst potential evaporation - if(trim(fieldname)=='pevpr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval - enddo - enddo - endif - - ! 10 m u - if(trim(fieldname)=='ugrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) - do j=jsta,jend - do i=ista, iend - u10(i,j) = arrayr42d(i,j) - u10h(i,j) = u10(i,j) - enddo - enddo - endif - - ! 10 m v - if(trim(fieldname)=='vgrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) - do j=jsta,jend - do i=ista, iend - v10(i,j) = arrayr42d(i,j) - v10h(i,j) = v10(i,j) - enddo - enddo - endif - - ! vegetation type - if(trim(fieldname)=='vtype') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) < spval) then - ivgtyp(i,j) = nint(arrayr42d(i,j)) - else - ivgtyp(i,j) = 0 - endif - enddo - enddo - endif - - ! soil type - if(trim(fieldname)=='sotyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) < spval) then - isltyp(i,j) = nint(arrayr42d(i,j)) - else - isltyp(i,j) = 0 - endif - enddo - enddo - endif - - ! inst cloud top pressure - if(trim(fieldname)=='prescnvclt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptop(i,j) = arrayr42d(i,j) - if(ptop(i,j) <= 0.0) ptop(i,j) = spval - enddo - enddo - endif - - ! inst cloud bottom pressure - if(trim(fieldname)=='prescnvclb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) - do j=jsta,jend - do i=ista, iend - pbot(i,j) = arrayr42d(i,j) - if(pbot(i,j) <= 0.0) pbot(i,j) = spval - enddo - enddo - endif - - ! time averaged low cloud top pressure - if(trim(fieldname)=='pres_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptopl(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged low cloud bottom pressure - if(trim(fieldname)=='pres_avelcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) - do j=jsta,jend - do i=ista, iend - pbotl(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged low cloud top temperature - if(trim(fieldname)=='tmp_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) - do j=jsta,jend - do i=ista, iend - ttopl(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged middle cloud top pressure - if(trim(fieldname)=='pres_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptopm(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged middle cloud bottom pressure - if(trim(fieldname)=='pres_avemcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) - do j=jsta,jend - do i=ista, iend - pbotm(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged middle cloud top temperature - if(trim(fieldname)=='tmp_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) - do j=jsta,jend - do i=ista, iend - ttopm(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged high cloud top pressure - if(trim(fieldname)=='pres_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptoph(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged high cloud bottom pressure - if(trim(fieldname)=='pres_avehcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) - do j=jsta,jend - do i=ista, iend - pboth(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged high cloud top temperature - if(trim(fieldname)=='tmp_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) - do j=jsta,jend - do i=ista, iend - ttoph(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged boundary layer cloud cover - if(trim(fieldname)=='tcdc_avebndcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) - do j=jsta,jend - do i=ista, iend - pblcfr(i,j) = arrayr42d(i,j) - if (pblcfr(i,j) < spval) pblcfr(i,j) = pblcfr(i,j) * 0.01 - enddo - enddo - endif - - ! cloud work function - if(trim(fieldname)=='cwork_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) - do j=jsta,jend - do i=ista, iend - cldwork(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! water runoff - if(trim(fieldname)=='watr_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - runoff(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) runoff(i,j) = spval - enddo - enddo - endif - - ! accumulated evaporation of intercepted water - if(trim(fieldname)=='ecan_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,tecan,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - tecan(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) tecan(i,j) = spval - enddo - enddo - endif - - ! accumulated plant transpiration - if(trim(fieldname)=='etran_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,tetran,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - tetran(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) tetran(i,j) = spval - enddo - enddo - endif - - ! accumulated soil surface evaporation - if(trim(fieldname)=='edir_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,tedir,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - tedir(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) tedir(i,j) = spval - enddo - enddo - endif - - ! total water storage in aquifer - if(trim(fieldname)=='wa_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twa,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - twa(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) twa(i,j) = spval - enddo - enddo - endif - - ! shelter max temperature - if(trim(fieldname)=='tmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - maxtshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! shelter min temperature - if(trim(fieldname)=='tmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - mintshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! ice thickness - if(trim(fieldname)=='icetk') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) - do j=jsta,jend - do i=ista, iend - dzice(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! wilting point - if(trim(fieldname)=='wilt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smcwlt(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smcwlt(i,j) = spval - enddo - enddo - endif - - ! sunshine duration - if(trim(fieldname)=='sunsd_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) - do j=jsta,jend - do i=ista, iend - suntime(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! field capacity - if(trim(fieldname)=='fldcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - fieldcapa(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) fieldcapa(i,j) = spval - enddo - enddo - endif - - ! time averaged surface visible beam downward solar flux - if(trim(fieldname)=='vbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - avisbeamswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname)=='vddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - avisdiffswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface near IR beam downward solar flux - if(trim(fieldname)=='nbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - airbeamswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname)=='nddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - airdiffswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky outgoing LW - if(trim(fieldname)=='csulf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwoutc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged TOA clear sky outgoing LW - if(trim(fieldname)=='csulftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwtoac(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky outgoing SW - if(trim(fieldname)=='csusf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswoutc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged TOA clear sky outgoing SW - if(trim(fieldname)=='csusftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswtoac(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky incoming LW - if(trim(fieldname)=='csdlf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwinc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky incoming SW - if(trim(fieldname)=='csdsf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswinc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! shelter max specific humidity - if(trim(fieldname)=='spfhmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - maxqshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! shelter min temperature - if(trim(fieldname)=='spfhmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - minqshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! storm runoffs - if(trim(fieldname)=='ssrun_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - ssroff(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) ssroff(i,j) = spval - enddo - enddo - endif - - ! direct soil evaporation - if(trim(fieldname)=='evbs_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - avgedir(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) avgedir(i,j) = spval - enddo - enddo - endif - - ! canopy water evap - if(trim(fieldname)=='evcw_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - avgecan(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) avgecan(i,j) = spval - enddo - enddo - endif - - ! AVERAGED PRECIP ADVECTED HEAT FLUX - if(trim(fieldname)=='pah_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,paha,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - paha(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) paha(i,j) = spval - enddo - enddo - endif - - ! instantaneous PRECIP ADVECTED HEAT FLUX - if(trim(fieldname)=='pahi') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pahi,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - pahi(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) pahi(i,j) = spval - enddo - enddo - endif - - ! plant transpiration - if(trim(fieldname)=='trans_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - avgetrans(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) avgetrans(i,j) = spval - enddo - enddo - endif - - ! snow sublimation - if(trim(fieldname)=='sbsno_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval - enddo - enddo - endif - - ! total soil moisture - if(trim(fieldname)=='soilm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smstot(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smstot(i,j) = spval - enddo - enddo - endif - - ! snow phase change heat flux - if(trim(fieldname)=='snohf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - snopcx(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) snopcx(i,j) = spval - enddo - enddo - endif - -! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount ==3) then - if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) - arrayr43d = 0. - do k=kstart,kend - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) - do j=jsta,jend - do i=ista,iend - arrayr43d(i,j,k) = arrayr83d(i,j,k) - enddo - enddo - enddo - endif - - ! model level T - if(trim(fieldname)=='tmp') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - t(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - - !! sig4 - !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) - do j=jsta,jend - do i=ista, iend - tlmh = t(i,j,lm) * t(i,j,lm) - sigt4(i,j) = 5.67E-8 * tlmh * tlmh - enddo - enddo - endif - - ! model level spfh - if(trim(fieldname)=='spfh') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - q(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level u wind - if(trim(fieldname)=='ugrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - uh(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level v wind - if(trim(fieldname)=='vgrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - vh(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level pressure thinkness - if(trim(fieldname)=='dpres') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - dpres(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level gh thinkness, model output negative delz - if(trim(fieldname)=='delz') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - zint(i,j,l)=-1.*arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level w - if(trim(fieldname)=='dzdt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - wh(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ozone mixing ratio -#ifdef MULTI_GASES - if(trim(fieldname)=='spo3') then -#else - if(trim(fieldname)=='o3mr') then -#endif - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - o3(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - -! for GFDL MP or Thompson MP - if (imp_physics == 11 .or. imp_physics == 8) then - ! model level cloud water mixing ratio - if(trim(fieldname)=='clwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqw(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ice mixing ratio - if(trim(fieldname)=='icmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqi(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio - if(trim(fieldname)=='rwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqr(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio - if(trim(fieldname)=='snmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqs(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio - if(trim(fieldname)=='grle') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqg(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - if(imp_physics == 8) then - ! model level rain number - if(trim(fieldname)=='ncrain') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnr(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain number - if(trim(fieldname)=='ncice') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqni(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain number - if(trim(fieldname)=='nwfa') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnwfa,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnwfa(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain number - if(trim(fieldname)=='nifa') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnifa,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnifa(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - endif !if(imp_physics == 8) then -!gfdlmp - endif - - ! model level cloud amount - if(trim(fieldname)=='cld_amt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - cfr(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ref3d - if(trim(fieldname)=='ref3D') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - ref_10cm(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo -! print *,'in gfs_post, get ref_10cm=',maxval(ref_10cm), minval(ref_10cm) - endif - - ! model level ref3d - if(trim(fieldname)=='tke') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - q2(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif -!3d fields - endif - -! end loop ncount_field - enddo - - if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & - setvar_atmfile = .true. - if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(2))) > 0) & - setvar_sfcfile = .true. - deallocate(fcstField) - -! end file_loop_all - enddo file_loop_all - -! recompute full layer of zint -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,lp1,spval,zint,fis) - do j=jsta,jend - do i=1,im - if (fis(i,j) /= spval) then - zint(i,j,lp1) = fis(i,j) - fis(i,j) = fis(i,j) * grav - endif - enddo - enddo - - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) - do j=jsta,jend - do i=1,im - omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) - zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) - enddo - enddo - enddo - -! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) - do j=jsta,jend - do i=1,im - pint(i,j,1) = ak5(1) - end do - end do - - do l=2,lp1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) - do j=jsta,jend - do i=1,im - pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) - enddo - enddo - end do - -!compute pmid from averaged two layer pint - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) - do j=jsta,jend - do i=1,im - pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) - enddo - enddo - enddo - -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) - do j=jsta,jend - do i=1,im - pd(i,j) = spval - pint(i,j,1) = pt - end do - end do -! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) - -! compute alpint - do l=lp1,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) - do j=jsta,jend - do i=1,im - alpint(i,j,l)=log(pint(i,j,l)) - end do - end do - end do - -! compute zmid - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) - do j=jsta,jend - do i=1,im - zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & - (log(pmid(i,j,l))-alpint(i,j,l+1))/ & - (alpint(i,j,l)-alpint(i,j,l+1)) - end do - end do - end do -! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & -! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & -! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & -! 'pmid=',maxval(pmid(1:im,jsta:jend,1)),minval(pmid(1:im,jsta:jend,1)), & -! 'alpint=',maxval(alpint(1:im,jsta:jend,2)),minval(alpint(1:im,jsta:jend,2)) -! print *,'in post_gfs,alpint=',maxval(alpint(1:im,jsta:jend,1)), & -! minval(alpint(1:im,jsta:jend,1)) - -! surface potential T, and potential T at roughness length -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,lp1,sm,ths,sst,thz0,pint) - do j=jsta,jend - do i=ista, iend - !assign sst - if (sm(i,j) /= 0.0 .and. ths(i,j) /= spval) then - sst(i,j) = ths(i,j) - else - sst(i,j) = spval - endif - if (ths(i,j) /= spval) then - ths(i,j) = ths(i,j)* (p1000/pint(i,j,lp1))**capa - thz0(i,j) = ths(i,j) - endif - enddo - enddo - -! compute cwm for gfdlmp or Thompson - if( imp_physics == 11 .or. imp_physics == 8) then - do l=1,lm -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) - do j=jsta,jend - do i=ista,iend - cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) - enddo - enddo - enddo - endif - -! estimate 2m pres and convert t2m to theta -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) - do j=jsta,jend - do i=ista, iend - pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA - enddo - enddo - -!htop - do j=jsta,jend - do i=1,im - htop(i,j) = spval - if(ptop(i,j) < spval)then - do l=1,lm - if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j)=l - exit - end if - end do - end if - end do - end do - -! hbot - do j=jsta,jend - do i=1,im - hbot(i,j) = spval - if(pbot(i,j) < spval)then - do l=lm,1,-1 - if(pbot(i,j) >= pmid(i,j,l)) then - hbot(i,j) = l - exit - end if - end do - end if - end do - end do - -! generate look up table for lifted parcel calculations - thl = 210. - plq = 70000. - pt_tbl = 10000. ! this is for 100 hPa added by Moorthi - - call table(ptbl,ttbl,pt_tbl, & - rdq,rdth,rdp,rdthe,pl,thl,qs0,sqs,sthe,the0) - - call tableq(ttblq,rdpq,rdtheq,plq,thl,stheq,the0q) - - if(mype == 0)then - write(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' - write(6,51) (SPL(L),L=1,LSM) - 50 format(14(F4.1,1X)) - 51 format(8(F8.1,1X)) - endif -! -!$omp parallel do default(none) private(l) shared(lsm,alsl,spl) - do l = 1,lsm - alsl(l) = log(spl(l)) - end do -! -! print *,'in gfs_post, end ref_10cm=',maxval(ref_10cm), minval(ref_10cm) -!!! above is fv3 change -! -!more fields need to be computed -! - end subroutine set_postvars_gfs - - - end module post_gfs diff --git a/io/post_nems_routines.F90 b/io/post_nems_routines.F90 index 4d0792284..6430d64f6 100644 --- a/io/post_nems_routines.F90 +++ b/io/post_nems_routines.F90 @@ -3,12 +3,13 @@ !----------------------------------------------------------------------- ! subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & - jts,jte,jtsgrp,jtegrp) + jts,jte,jtsgrp,jtegrp,its,ite,itsgrp,itegrp) +! jts,jte,jtsgrp,jtegrp) ! ! ! revision history: ! Jul 2019 Jun Wang: allocate arrays for post processing -! +! Feb 2022 J. Meng/B. Cui: create interface to run inline post with post_2d_decomp ! !----------------------------------------------------------------------- !*** allocate post variables @@ -23,6 +24,10 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ioform, jsta, jend, jsta_m, jsta_m2, & jend_m, jend_m2, jvend_2u, jsta_2l, jend_2u, iup, idn, & icnt, idsp, mpi_comm_comp, num_servers, & + modelname, numx, ista, iend, ista_m, ista_m2, & + iend_m, iend_m2, ista_2l, iend_2u, & + ileft,iright,ileftb,irightb, & + icnt2, idsp2,isxa,iexa,jsxa,jexa, & num_procs ! !----------------------------------------------------------------------- @@ -37,6 +42,8 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & integer,intent(in) :: lead_write integer,intent(in) :: jts,jte integer,intent(in) :: jtsgrp(nwtlpes),jtegrp(nwtlpes) + integer,intent(in) :: its,ite + integer,intent(in) :: itsgrp(nwtlpes),itegrp(nwtlpes) ! !----------------------------------------------------------------------- !*** LOCAL VARIABLES @@ -44,6 +51,7 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ! integer i,j,l integer last_write_task + integer isumm,isumm2 ! !----------------------------------------------------------------------- !*** get dims from int_state @@ -78,14 +86,28 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & jsta_m2 = jsta jend_m = jend jend_m2 = jend - if ( mype == lead_write ) then + if ( mype<(lead_write+numx) ) then jsta_m = 2 jsta_m2 = 3 end if - if ( mype == last_write_task ) then + if ( mype>(last_write_task-numx) ) then jend_m = jm - 1 jend_m2 = jm - 2 end if + ista = its + iend = ite + ista_m = ista + ista_m2 = ista + iend_m = iend + iend_m2 = iend + if(mod(me,numx)==0)then + ista_m=2 + ista_m2=3 + end if + if(mod(me+1,numx)==0)then + iend_m=im-1 + iend_m2=im-2 + end if !** neighbors iup = mype + 1 - lead_write idn = mype - 1 - lead_write @@ -100,22 +122,69 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ! ! counts, disps for gatherv and scatterv ! + isumm=0 + isumm2=0 + allocate(isxa(0:num_procs-1) ) + allocate(jsxa(0:num_procs-1) ) + allocate(iexa(0:num_procs-1) ) + allocate(jexa(0:num_procs-1) ) + do i = 1, num_procs - icnt(i-1) = (jtegrp(i)-jtsgrp(i)+1)*im - idsp(i-1) = (jtsgrp(i)-1)*im -! if ( mype .eq. lead_write ) then -! print *, ' i, icnt(i),idsp(i) = ',i-1,icnt(i-1),idsp(i-1) -! end if + icnt(i-1) = (jtegrp(i)-jtsgrp(i)+1)*(itegrp(i)-itsgrp(i)+1) + isxa(i-1) = itsgrp(i) + iexa(i-1) = itegrp(i) + jsxa(i-1) = jtsgrp(i) + jexa(i-1) = jtegrp(i) + idsp(i-1) = isumm + isumm=isumm+icnt(i-1) + if(jtsgrp(i)==1 .or. jtegrp(i)==jm) then + icnt2(i-1) = (itegrp(i)-itsgrp(i)+1) + else + icnt2(i-1) = 0 + endif + idsp2(i-1)=isumm2 + if(jtsgrp(i)==1 .or. jtegrp(i)==jm) isumm2=isumm2+(itegrp(i)-itsgrp(i)+1) + enddo +! write(6,'(a25,i4,16i8)') 'JESSE,me,icnt2,idsp2=',me,icnt2(0:num_procs-1),idsp2(0:num_procs-1) ! ! extraction limits -- set to two rows ! jsta_2l = max(jsta - 2, 1 ) jend_2u = min(jend + 2, jm ) + if(modelname=='GFS') then + ista_2l=max(ista-2,0) + iend_2u=min(iend+2,im+1) + else + ista_2l = max(ista - 2, 1 ) + iend_2u = min(iend + 2, im ) + endif ! special for c-grid v jvend_2u = min(jend + 2, jm+1 ) - if(mype==0)print *,'im=',im,'jsta_2l=',jsta_2l,'jend_2u=',jend_2u,'lm=',lm -! +! if(mype==0)print *,'im=',im,'jsta_2l=',jsta_2l,'jend_2u=',jend_2u,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'jsta =',jsta ,'jend =',jend ,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'jsta_m =',jsta_m ,'jend_m =',jend_m ,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'jsta_2l=',jsta_2l,'jend_2u=',jend_2u,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'ista =',ista ,'iend =',iend ,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'ista_m =',ista_m ,'iend_m =',iend_m ,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'ista_2l=',ista_2l,'iend_2u=',iend_2u,'lm=',lm +! 901 format(a15,2i4,4(1x,a8,i4)) +! NEW neighbors + ileft = me - 1 + iright = me + 1 + iup=MPI_PROC_NULL + idn=MPI_PROC_NULL +! if(mod(me,numx) .eq. 0) print *,' LEFT POINT',mype,me +! if(mod(me+1,numx) .eq. 0) print *,' RIGHT POINT',mype,me + if(mod(me,numx) .eq. 0) ileft=MPI_PROC_NULL + if(mod(me,numx) .eq. 0) ileftb=me+numx-1 +! if(mod(me,numx) .eq. 0) print *,' GWVX ILEFTB ',ileftb,mype,me,numx + if(mod(me+1,numx) .eq. 0 .or. me .eq. num_procs-1) iright=MPI_PROC_NULL + if(mod(me+1,numx) .eq. 0 .or. me .eq. num_procs-1) irightb=me-numx+1 +! if(mod(me+1,numx) .eq. 0 .or. me .eq. num_procs-1) print *,' GWVX IRIGHTB',irightb,mype,me,numx + if(me .ge. numx) idn=me-numx + if(me+1 .le. num_procs-numx) iup=me+numx +! write(6,'(a12,6i10)') 'GWVX BOUNDS ',me,ileft,iright,iup,idn,num_procs ! ! SETS UP MESSAGE PASSING INFO @@ -126,7 +195,7 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ! LMV always = LM for sigma-type vert coord do j = jsta_2l, jend_2u - do i = 1, im + do i = ista_2l, iend_2u lmv ( i, j ) = lm lmh ( i, j ) = lm end do @@ -136,7 +205,7 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & do l = 1, lm do j = jsta_2l, jend_2u - do i = 1, im + do i = ista_2l, iend_2u htm ( i, j, l ) = 1.0 vtm ( i, j, l ) = 1.0 end do @@ -153,7 +222,7 @@ subroutine read_postnmlt(kpo,kth,kpv,po,th,pv,nlunit,post_namelist) use ctlblk_mod, only : komax,fileNameD3D,lsm,lsmp1,spl,spldef, & lsmdef,ALSL,me,d3d_on,gocart_on,hyb_sigp,& pthresh,novegtype,ivegsrc,icu_physics, & - isf_surface_physics + isf_surface_physics,modelname,submodelname ! ! revision history: ! Jul 2019 Jun Wang: read post namelist @@ -167,6 +236,7 @@ subroutine read_postnmlt(kpo,kth,kpv,po,th,pv,nlunit,post_namelist) real,dimension(komax) :: po,th,pv namelist/nampgb/kpo,po,kth,th,kpv,pv,popascal,d3d_on,gocart_on, & hyb_sigp + namelist/model_inputs/modelname,submodelname integer l,k,iret !--------------------------------------------------------------------- ! @@ -195,6 +265,7 @@ subroutine read_postnmlt(kpo,kth,kpv,po,th,pv,nlunit,post_namelist) ! read(nlunit) !skip outform ! read(nlunit,'(a19)') DateStr ! read(nlunit) !skil full modelname + read(nlunit,model_inputs,iostat=iret,end=119) read(nlunit,nampgb,iostat=iret,end=119) endif 119 continue diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index b9e6bdd9f..886f23a23 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -1,10 +1,5 @@ -#ifdef __PGI -#define ESMF_ERR_ABORT(rc) \ -if (rc /= ESMF_SUCCESS) write(0,*) 'rc=',rc,__FILE__,__LINE__; call ESMF_Finalize(endflag=ESMF_END_ABORT) -#else #define ESMF_ERR_ABORT(rc) \ if (rc /= ESMF_SUCCESS) write(0,*) 'rc=',rc,__FILE__,__LINE__; if(ESMF_LogFoundError(rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) -#endif !----------------------------------------------------------------------- ! @@ -22,6 +17,7 @@ module module_fcst_grid_comp ! use mpi use esmf + use nuopc use time_manager_mod, only: time_type, set_calendar_type, set_time, & set_date, month_name, & @@ -40,13 +36,13 @@ module module_fcst_grid_comp atmos_data_type, atmos_model_restart, & atmos_model_exchange_phase_1, & atmos_model_exchange_phase_2, & - addLsmask2grid + addLsmask2grid, atmos_model_get_nth_domain_info use constants_mod, only: constants_init use fms_mod, only: error_mesg, fms_init, fms_end, & write_version_number, uppercase - use mpp_mod, only: mpp_init, mpp_pe, mpp_npes, mpp_root_pe, & + use mpp_mod, only: mpp_init, mpp_pe, mpp_npes, mpp_root_pe, mpp_set_current_pelist, & mpp_error, FATAL, WARNING, NOTE use mpp_mod, only: mpp_clock_id, mpp_clock_begin @@ -55,7 +51,7 @@ module module_fcst_grid_comp use mpp_domains_mod, only: mpp_get_compute_domains, domain2D use sat_vapor_pres_mod, only: sat_vapor_pres_init - use diag_manager_mod, only: diag_manager_init, diag_manager_end, & + use diag_manager_mod, only: diag_manager_init, diag_manager_end, & diag_manager_set_time_end use data_override_mod, only: data_override_init @@ -65,14 +61,20 @@ module module_fcst_grid_comp use fms_io_mod, only: field_exist, read_data use atmosphere_mod, only: atmosphere_control_data -! - use module_fv3_io_def, only: num_pes_fcst, num_files, filename_base, nbdlphys, & - iau_offset - use module_fv3_config, only: dt_atmos, calendar, fcst_mpi_comm, fcst_ntasks, & - quilting, calendar_type, & - cplprint_flag, force_date_from_configure, & - restart_endfcst + + use module_fv3_io_def, only: num_pes_fcst, num_files, filename_base, & + nbdlphys, iau_offset + use module_fv3_config, only: dt_atmos, fcst_mpi_comm, fcst_ntasks, & + quilting, calendar, cpl_grid_id, & + cplprint_flag, restart_endfcst + use get_stochy_pattern_mod, only: write_stoch_restart_atm + use module_cplfields, only: nExportFields, exportFields, exportFieldsInfo, & + nImportFields, importFields, importFieldsInfo + use module_cplfields, only: realizeConnectedCplFields + + use atmos_model_mod, only: setup_exportdata + use CCPP_data, only: GFS_control ! !----------------------------------------------------------------------- ! @@ -84,26 +86,16 @@ module module_fcst_grid_comp ! !---- model defined-types ---- - type atmos_internalstate_type - type(atmos_data_type) :: Atm - type(time_type) :: Time_atmos, Time_init, Time_end, & - Time_step_atmos, Time_step_ocean, & - Time_restart, Time_step_restart, & - Time_atstart - integer :: num_atmos_calls, ret, intrm_rst - end type + type(atmos_data_type), save :: Atmos - type atmos_internalstate_wrapper - type(atmos_internalstate_type), pointer :: ptr - end type + type(ESMF_GridComp),dimension(:),allocatable :: fcstGridComp + integer :: ngrids, mygrid - type(atmos_internalstate_type),pointer,save :: atm_int_state - type(atmos_internalstate_wrapper),save :: wrap - type(ESMF_VM),save :: VM - type(ESMF_Grid) :: fcstGrid + integer :: intrm_rst, n_atmsteps !----- coupled model data ----- + integer :: calendar_type = -99 integer :: date_init(6) integer :: numLevels = 0 integer :: numSoilLayers = 0 @@ -113,8 +105,7 @@ module module_fcst_grid_comp ! !----------------------------------------------------------------------- ! - public SetServices, fcstGrid - public numLevels, numSoilLayers, numTracers + public SetServices ! contains ! @@ -130,7 +121,13 @@ subroutine SetServices(fcst_comp, rc) rc = ESMF_SUCCESS call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_INITIALIZE, & - userRoutine=fcst_initialize, rc=rc) + userRoutine=fcst_initialize, phase=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_INITIALIZE, & + userRoutine=fcst_advertise, phase=2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_INITIALIZE, & + userRoutine=fcst_realize, phase=3, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! call ESMF_GridCompSetEntryPoint(fcst_comp, ESMF_METHOD_RUN, & @@ -150,11 +147,331 @@ end subroutine SetServices !----------------------------------------------------------------------- !####################################################################### !----------------------------------------------------------------------- +! + subroutine SetServicesNest(nest, rc) +! + type(ESMF_GridComp) :: nest + integer, intent(out) :: rc + + character(len=80) :: name + type(ESMF_Grid) :: grid + type(ESMF_Info) :: info + integer :: layout(2), tilesize + integer :: tl, nx, ny + integer,dimension(2,6):: decomptile !define delayout for the 6 cubed-sphere tiles + integer,dimension(2) :: regdecomp !define delayout for the nest grid + type(ESMF_Decomp_Flag):: decompflagPTile(2,6) + character(3) :: myGridStr + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: array + + rc = ESMF_SUCCESS + + call ESMF_GridCompSetEntryPoint(nest, ESMF_METHOD_INITIALIZE, userRoutine=init_dyn_fb, phase=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(nest, ESMF_METHOD_INITIALIZE, userRoutine=init_phys_fb, phase=2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(nest, ESMF_METHOD_INITIALIZE, userRoutine=init_advertise, phase=3, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(nest, ESMF_METHOD_INITIALIZE, userRoutine=init_realize, phase=4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompGet(nest, name=name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_InfoGetFromHost(nest, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_InfoGet(info, key="layout", values=layout, rc=rc); ESMF_ERR_ABORT(rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (trim(name)=="global") then + ! global domain + call ESMF_InfoGet(info, key="tilesize", value=tilesize, rc=rc); ESMF_ERR_ABORT(rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do tl=1,6 + decomptile(1,tl) = layout(1) + decomptile(2,tl) = layout(2) + decompflagPTile(:,tl) = (/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/) + enddo + grid = ESMF_GridCreateCubedSphere(tileSize=tilesize, & + coordSys=ESMF_COORDSYS_SPH_RAD, & + regDecompPTile=decomptile, & + decompflagPTile=decompflagPTile, & + name="fcst_grid", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + ! nest domain + call ESMF_InfoGet(info, key="nx", value=nx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGet(info, key="ny", value=ny, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + grid = ESMF_GridCreateNoPeriDim(regDecomp=(/layout(1),layout(2)/), & + minIndex=(/1,1/), & + maxIndex=(/nx,ny/), & + gridAlign=(/-1,-1/), & + coordSys=ESMF_COORDSYS_SPH_RAD, & + decompflag=(/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/), & + name="fcst_grid", & + indexflag=ESMF_INDEX_DELOCAL, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + ! - Create coordinate arrays around allocations held within Atmos data structure and set in Grid + + call ESMF_GridGet(grid, staggerloc=ESMF_STAGGERLOC_CENTER, distgrid=distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + array = ESMF_ArrayCreate(distgrid, farray=Atmos%lon, indexflag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridSetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + array = ESMF_ArrayCreate(distgrid, farray=Atmos%lat, indexflag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridSetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridGet(grid, staggerloc=ESMF_STAGGERLOC_CORNER, distgrid=distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + array = ESMF_ArrayCreate(distgrid, farray=Atmos%lon_bnd, indexflag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridSetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + array = ESMF_ArrayCreate(distgrid, farray=Atmos%lat_bnd, indexflag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridSetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + !TODO: Consider aligning mask treatment with coordinates... especially if it requires updates for moving + call addLsmask2grid(grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! - Add Attributes used by output + + call ESMF_AttributeAdd(grid, 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 + + call ESMF_AttributeSet(grid, 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 + +!test to write out vtk file: +! if( cplprint_flag ) then +! call ESMF_GridWriteVTK(grid, staggerloc=ESMF_STAGGERLOC_CENTER, & +! filename='fv3cap_fv3Grid', rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! endif +! +! Write grid to netcdf file + if( cplprint_flag ) then + write (myGridStr,"(I0)") mygrid + call wrt_fcst_grid(grid, "diagnostic_FV3_fcstGrid"//trim(mygridStr)//".nc", & + regridArea=.TRUE., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + ! - Hold on to the grid by GridComp + + call ESMF_GridCompSet(nest, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine SetServicesNest +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine init_dyn_fb(nest, importState, exportState, clock, rc) +! + type(ESMF_GridComp) :: nest + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer,intent(out) :: rc + + type(ESMF_Grid) :: grid + integer :: itemCount + character(len=ESMF_MAXSTR) :: itemNameList(1) + type(ESMF_FieldBundle) :: fb, fcstFB + + call ESMF_GridCompGet(nest, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(importState, itemCount=itemCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (itemCount /= 1) then + ! error condition, expect exactly one dynamics field bundle + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Expecting exactly one dynamics field bundle.", line=__LINE__, file=__FILE__) + endif + + call ESMF_StateGet(importState, itemNameList=itemNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(importState, itemName=itemNameList(1), fieldbundle=fcstFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + fb = ESMF_FieldBundleCreate(name=itemNameList(1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeCopy(fcstFB, fb, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateAdd(exportState,(/fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call fv_dyn_bundle_setup(Atmos%axes, fb, grid, quilting=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine init_dyn_fb +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine init_phys_fb(nest, importState, exportState, clock, rc) +! + type(ESMF_GridComp) :: nest + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer,intent(out) :: rc + + type(ESMF_Grid) :: grid + integer :: itemCount, i + character(len=ESMF_MAXSTR), allocatable :: itemNameList(:) + type(ESMF_FieldBundle), allocatable :: fbList(:) + type(ESMF_FieldBundle) :: fcstFB + + call ESMF_GridCompGet(nest, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(importState, itemCount=itemCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate(itemNameList(itemCount), fbList(itemCount)) + + call ESMF_StateGet(importState, itemNameList=itemNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do i=1, itemCount + call ESMF_StateGet(importState, itemName=itemNameList(i), fieldbundle=fcstFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + fbList(i) = ESMF_FieldBundleCreate(name=itemNameList(i), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeCopy(fcstFB, fbList(i), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateAdd(exportState, (/fbList(i)/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo + + call fv_phys_bundle_setup(Atmos%diag, Atmos%axes, fbList, grid, quilting=.true., nbdlphys=itemCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine init_phys_fb +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine init_advertise(nest, importState, exportState, clock, rc) +! + type(ESMF_GridComp) :: nest + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer,intent(out) :: rc +! +!*** local variables +! + integer :: i + + rc = ESMF_SUCCESS +! + ! importable fields: + do i = 1, size(importFieldsInfo) + call NUOPC_Advertise(importState, & + StandardName=trim(importFieldsInfo(i)%name), & + SharePolicyField='share', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end do + + ! exportable fields: + do i = 1, size(exportFieldsInfo) + call NUOPC_Advertise(exportState, & + StandardName=trim(exportFieldsInfo(i)%name), & + SharePolicyField='share', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end do + +! +!----------------------------------------------------------------------- +! + end subroutine init_advertise +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine init_realize(nest, importState, exportState, clock, rc) +! + type(ESMF_GridComp) :: nest + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer,intent(out) :: rc +! +!*** local variables +! + type(ESMF_Grid) :: grid + + rc = ESMF_SUCCESS +! + ! access this domain grid + call ESMF_GridCompGet(nest, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! -- realize connected fields in exportState + call realizeConnectedCplFields(exportState, grid, & + 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 + + ! -- initialize export fields if applicable + call setup_exportdata(rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! -- realize connected fields in importState + call realizeConnectedCplFields(importState, grid, & + 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 +! +!----------------------------------------------------------------------- +! + end subroutine init_realize +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- ! subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! !----------------------------------------------------------------------- -!*** INITIALIZE THE WRITE GRIDDED COMPONENT. +!*** INITIALIZE THE FORECAST GRIDDED COMPONENT. !----------------------------------------------------------------------- ! type(esmf_GridComp) :: fcst_comp @@ -162,56 +479,62 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) type(esmf_Clock) :: clock integer,intent(out) :: rc ! -!*** LOCAL VARIABLES +!*** local variables ! - integer :: tl, i, j - integer,dimension(2,6) :: decomptile !define delayout for the 6 cubed-sphere tiles - integer,dimension(2) :: regdecomp !define delayout for the nest grid - type(ESMF_FieldBundle) :: fieldbundle + integer :: i, j ! + type(ESMF_VM) :: VM type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: RunDuration, TimeElapsed type(ESMF_Config) :: cf - integer :: Run_length integer,dimension(6) :: date, date_end ! - character(len=9) :: month - integer :: initClock, unit, nfhour, total_inttime + integer :: initClock, unit, total_inttime integer :: mype - character(3) cfhour character(4) dateSY character(2) dateSM,dateSD,dateSH,dateSN,dateSS character(len=esmf_maxstr) name_FB, name_FB1 character(len=80) :: dateS - real, allocatable, dimension(:,:) :: glon_bnd, glat_bnd character(256) :: gridfile - type(ESMF_FieldBundle),dimension(:), allocatable :: fieldbundlephys - real(8) :: mpi_wtime, timeis + character(8) :: bundle_grid + type(ESMF_FieldBundle),dimension(:), allocatable :: fieldbundle ! dynamics bundles + type(ESMF_FieldBundle),dimension(:,:), allocatable :: fieldbundlephys ! physics bundles + + real(kind=8) :: mpi_wtime, timeis type(ESMF_DELayout) :: delayout type(ESMF_DistGrid) :: distgrid - real(ESMF_KIND_R8),dimension(:,:), pointer :: glatPtr, glonPtr - real(ESMF_KIND_R8),parameter :: dtor = 180.0_ESMF_KIND_R8 / 3.1415926535897931_ESMF_KIND_R8 integer :: jsc, jec, isc, iec, nlev type(domain2D) :: domain - type(time_type) :: iautime - integer :: n, fcstNpes, tmpvar + integer :: n, fcstNpes, tmpvar, k logical :: freq_restart, fexist integer, allocatable, dimension(:) :: isl, iel, jsl, jel integer, allocatable, dimension(:,:,:) :: deBlockList - integer :: tlb(2), tub(2) + integer, allocatable, dimension(:) :: petListNest - type(ESMF_Decomp_Flag) :: decompflagPTile(2,6) - - integer :: TileLayout(2) - integer :: nestRootPet, npes(1), peListSize(1) + integer :: globalTileLayout(2) + integer :: nestRootPet, peListSize(1) integer, allocatable :: petMap(:) + integer :: layout(2), nx, ny + integer, pointer :: pelist(:) => null() + logical :: top_parent_is_global integer :: num_restart_interval, restart_starttime real,dimension(:),allocatable :: restart_interval + + integer :: urc + type(ESMF_State) :: tempState + type(ESMF_Info) :: info + + type(time_type) :: Time_init, Time, Time_step, Time_end, & + Time_restart, Time_step_restart + type(time_type) :: iautime + integer :: io_unit, calendar_type_res, date_res(6), date_init_res(6) + + integer,allocatable :: grid_number_on_all_pets(:) + logical,allocatable :: is_moving_on_all_pets(:), is_moving(:) ! !----------------------------------------------------------------------- !*********************************************************************** @@ -220,71 +543,56 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) timeis = mpi_wtime() rc = ESMF_SUCCESS ! -!----------------------------------------------------------------------- -!*** ALLOCATE THE WRITE COMPONENT'S INTERNAL STATE. -!----------------------------------------------------------------------- -! - allocate(atm_int_state,stat=rc) -! -!----------------------------------------------------------------------- -!*** ATTACH THE INTERNAL STATE TO THE WRITE COMPONENT. -!----------------------------------------------------------------------- -! - wrap%ptr => 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 +601,97 @@ 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) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + 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 + 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, & - 'Run_length=',Run_length + Time_step = set_time (dt_atmos,0) + if (mype == 0) write(*,*)'time_init=', date_init,'time=',date,'time_end=',date_end,'dt_atmos=',dt_atmos ! 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 +703,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 @@ -394,32 +738,26 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! if to write out restart at the end of forecast restart_endfcst = .false. if ( ANY(frestart(:) == total_inttime) ) restart_endfcst = .true. +! frestart only contains intermediate restart + do i=1,size(frestart) + if(frestart(i) == total_inttime) then + frestart(i) = 0 + exit + endif + enddo 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 -! -!----- write time stamps (for start time and end time) ------ +! if there is restart writing during integration + intrm_rst = 0 + if (frestart(1)>0) intrm_rst = 1 - call mpp_open( unit, 'time_stamp.out', nohdrs=.TRUE. ) - month = month_name(date(2)) - if ( mpp_pe() == mpp_root_pe() ) write (unit,20) date, month(1:3) - month = month_name(date_end(2)) - if ( mpp_pe() == mpp_root_pe() ) write (unit,20) date_end, month(1:3) - call mpp_close (unit) - 20 format (6i4,2x,a3) -! !------ 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 +767,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,174 +779,79 @@ 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) - - 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 - - ! 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) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ngrids = Atmos%ngrids + mygrid = Atmos%mygrid + allocate(grid_number_on_all_pets(fcst_ntasks), is_moving_on_all_pets(fcst_ntasks)) + call mpi_allgather(mygrid, 1, MPI_INTEGER, & + grid_number_on_all_pets, 1, MPI_INTEGER, & + fcst_mpi_comm, rc) + call mpi_allgather(Atmos%is_moving_nest, 1, MPI_LOGICAL, & + is_moving_on_all_pets, 1, MPI_LOGICAL, & + fcst_mpi_comm, rc) + allocate(is_moving(ngrids)) + do n=1, fcst_ntasks + is_moving(grid_number_on_all_pets(n)) = is_moving_on_all_pets(n) + enddo + deallocate(grid_number_on_all_pets, is_moving_on_all_pets) + + call ESMF_InfoGetFromHost(exportState, info=info, rc=rc); ESMF_ERR_ABORT(rc) + call ESMF_InfoSet(info, key="is_moving", values=is_moving, rc=rc); ESMF_ERR_ABORT(rc) + deallocate(is_moving) + + allocate (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 - call mpp_error(NOTE, 'after create fcst grid for global-only with INPUT/'//trim(gridfile)) + if (n==1 .and. top_parent_is_global) then - else !! global-nesting or regional-nesting + fcstGridComp(n) = ESMF_GridCompCreate(name="global", petList=pelist, 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="tilesize", value=Atmos%mlon, 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 + else - ! 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 + 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 - ! 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 + fcstGridComp(n) = ESMF_GridCompCreate(name="nest", petList=petListNest, 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_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) - ! create the DELayout that maps DEs to the PETs in the petMap - delayout = ESMF_DELayoutCreate(petMap=petMap, 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 - ! 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 mpp_error(NOTE, 'after create fcst grid with INPUT/'//trim(gridfile)) - - endif - - endif -! - !! FIXME - if ( .not. atm_int_state%Atm%nested ) then !! global only - call addLsmask2grid(fcstGrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! print *,'call addLsmask2grid after fcstGrid, rc=',rc - endif + deallocate(petListNest) -!test to write out vtk file: -! if( cplprint_flag ) then -! call ESMF_GridWriteVTK(fcstGrid, staggerloc=ESMF_STAGGERLOC_CENTER, & -! filename='fv3cap_fv3Grid', rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! endif -! -! Write grid to netcdf file - if( cplprint_flag ) then - call wrt_fcst_grid(fcstGrid, "diagnostic_FV3_fcstGrid.nc", & - regridArea=.TRUE., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif + end if + end do ! Add gridfile Attribute to the exportState call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & @@ -621,15 +862,24 @@ 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 dimension Attributes to Grid - call ESMF_AttributeAdd(fcstGrid, convention="NetCDF", purpose="FV3", & - attrList=(/"ESMF:gridded_dim_labels"/), rc=rc) +! 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(fcstGrid, convention="NetCDF", purpose="FV3", & - name="ESMF:gridded_dim_labels", valueList=(/"grid_xt", "grid_yt"/), rc=rc) + 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 time Attribute to the exportState call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & attrList=(/ "time ", & @@ -653,11 +903,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", & @@ -675,53 +924,96 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) call ESMF_AttributeSet(exportState, convention="NetCDF", purpose="FV3", & name="time:calendar", value=uppercase(trim(calendar)), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + +! Add time_iso Attribute to the exportState + call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & + attrList=(/ "time_iso ", & + "time_iso:long_name ", & + "time_iso:description " /), 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="time_iso", value="yyyy-mm-ddThh:mm:ssZ", 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="time_iso:description", value="ISO 8601 Date String", 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="time_iso:long_name", value="valid time", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! 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 +1021,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,20 +1033,97 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) call get_atmos_model_ungridded_dim(nlev=numLevels, & nsoillev=numSoilLayers, & ntracers=numTracers) + + if (mype == 0) write(*,*)'fcst_initialize total time: ', mpi_wtime() - timeis ! !----------------------------------------------------------------------- ! - IF(rc /= ESMF_SUCCESS) THEN - WRITE(0,*)"FAIL: Fcst_Initialize." -! ELSE -! WRITE(0,*)"PASS: Fcst_Initialize." - ENDIF + end subroutine fcst_initialize ! - if (mype == 0) write(0,*)'in fcst,init total time: ', mpi_wtime() - timeis +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- ! + subroutine fcst_advertise(fcst_comp, importState, exportState, clock, rc) +! +!----------------------------------------------------------------------- +!*** INITIALIZE THE FORECAST GRIDDED COMPONENT. !----------------------------------------------------------------------- ! - end subroutine fcst_initialize + type(esmf_GridComp) :: fcst_comp + type(ESMF_State) :: importState, exportState + type(esmf_Clock) :: clock + integer,intent(out) :: rc +! +!*** local variables + type(ESMF_VM) :: vm + integer :: mype + integer :: n + integer :: urc + +! +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- +! + call ESMF_VMGetCurrent(vm=vm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm=vm, localPet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (mype == 0) write(*,*)'fcst_advertise, cpl_grid_id=',cpl_grid_id + + call ESMF_GridCompInitialize(fcstGridComp(cpl_grid_id), importState=importState, & + exportState=exportState, phase=3, 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 +! +!----------------------------------------------------------------------- +! + end subroutine fcst_advertise +! +!----------------------------------------------------------------------- +!####################################################################### +!----------------------------------------------------------------------- +! + subroutine fcst_realize(fcst_comp, importState, exportState, clock, rc) +! +!----------------------------------------------------------------------- +!*** INITIALIZE THE FORECAST GRIDDED COMPONENT. +!----------------------------------------------------------------------- +! + type(esmf_GridComp) :: fcst_comp + type(ESMF_State) :: importState, exportState + type(esmf_Clock) :: clock + integer,intent(out) :: rc +! +!*** local variables + type(ESMF_VM) :: vm + integer :: mype + integer :: n + integer :: urc + +! +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- +! + call ESMF_VMGetCurrent(vm=vm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm=vm, localPet=mype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (mype == 0) write(*,*)'fcst_realize, cpl_grid_id=',cpl_grid_id + + call ESMF_GridCompInitialize(fcstGridComp(cpl_grid_id), importState=importState, & + exportState=exportState, phase=4, 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 +! +! +!----------------------------------------------------------------------- +! + end subroutine fcst_realize ! !----------------------------------------------------------------------- !####################################################################### @@ -767,65 +1140,45 @@ 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(kind=ESMF_KIND_I8) :: ntimestep_esmf - character(len=64) :: timestamp -! -!----------------------------------------------------------------------- -! - real(kind=8) :: mpi_wtime, tbeg1 + integer :: mype, seconds + 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) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! - call ESMF_ClockGet(clock, advanceCount=NTIMESTEP_ESMF, 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 - na = NTIMESTEP_ESMF + call get_time(Atmos%Time - Atmos%Time_init, seconds) + n_atmsteps = seconds/dt_atmos ! !----------------------------------------------------------------------- ! *** 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(*,'(A,I16,A,F16.6)')'PASS: fcstRUN phase 1, n_atmsteps = ', & + n_atmsteps,' time is ',mpi_wtime()-tbeg1 ! !----------------------------------------------------------------------- ! end subroutine fcst_run_phase_1 ! !----------------------------------------------------------------------- -!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!####################################################################### !----------------------------------------------------------------------- ! subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) @@ -839,78 +1192,71 @@ 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(kind=ESMF_KIND_I8) :: ntimestep_esmf + integer :: mype, date(6), seconds 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) - 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) - call write_stoch_restart_atm('RESTART/'//trim(timestamp)//'.atm_stoch.res.nc') - - call wrt_atmres_timestamp(atm_int_state,timestamp) + !--- intermediate restart + if (intrm_rst>0) then + call get_time(Atmos%Time - Atmos%Time_init, seconds) + if (ANY(frestart(:) == seconds)) then + if (mype == 0) write(*,*)'write out restart at n_atmsteps=',n_atmsteps,' seconds=',seconds, & + 'integration length=',n_atmsteps*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') + + !----- 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 -! -!----------------------------------------------------------------------- -! -! 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(*,'(A,I16,A,F16.6)')'PASS: fcstRUN phase 2, n_atmsteps = ', & + n_atmsteps,' time is ',mpi_wtime()-tbeg1 ! !----------------------------------------------------------------------- ! end subroutine fcst_run_phase_2 ! !----------------------------------------------------------------------- -!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!####################################################################### !----------------------------------------------------------------------- ! subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) @@ -919,48 +1265,37 @@ 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. ) + call mpp_set_current_pelist() if (mpp_pe() == mpp_root_pe())then + call mpp_open( unit, 'RESTART/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)' @@ -968,59 +1303,21 @@ subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) '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 - 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 +1327,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 +1336,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..bb3546772 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,16 @@ 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 ! + integer :: cpl_grid_id 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..8096ddbb4 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 @@ -22,18 +23,15 @@ module stochastic_physics_wrapper_mod real(kind=kind_phys), dimension(:,:), allocatable, save :: vfrac !albedo real(kind=kind_phys), dimension(:,:), allocatable, save :: snoalb - real(kind=kind_phys), dimension(:,:), allocatable, save :: alvsf real(kind=kind_phys), dimension(:,:), allocatable, save :: alnsf - real(kind=kind_phys), dimension(:,:), allocatable, save :: alvwf real(kind=kind_phys), dimension(:,:), allocatable, save :: alnwf - real(kind=kind_phys), dimension(:,:), allocatable, save :: facsf - real(kind=kind_phys), dimension(:,:), allocatable, save :: facwf !emissivity real(kind=kind_phys), dimension(:,:), allocatable, save :: semis !roughness length for land real(kind=kind_phys), dimension(:,:), allocatable, save :: zorll - real(kind=kind_phys), dimension(:,:), allocatable, save :: stype + !real(kind=kind_phys), dimension(:,:), allocatable, save :: stype + integer, dimension(:,:), allocatable, save :: stype ! For cellular automata real(kind=kind_phys), dimension(:,:), allocatable, save :: sst @@ -78,7 +76,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, v logical :: param_update_flag #ifdef _OPENMP @@ -96,7 +94,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 +106,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%spp_stddev_cutoff, 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,29 +123,51 @@ 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%lndp_type == 2 ) then ! this scheme updates through forecast - allocate(sfc_wts(1:nblks,maxblk,1:GFS_Control%n_var_lndp)) + 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 ! save wts, and apply lndp scheme - if (GFS_Control%lsm == GFS_Control%lsm_noah) then + if ( GFS_Control%lndp_type == 2 ) then + allocate(sfc_wts(1:nblks,maxblk,1:GFS_Control%n_var_lndp)) + if ( (GFS_Control%lsm == GFS_Control%lsm_noah) .or. (GFS_Control%lsm == GFS_Control%lsm_noahmp)) then lsoil = GFS_Control%lsoil elseif (GFS_Control%lsm == GFS_Control%lsm_ruc) then lsoil = GFS_Control%lsoil_lsm endif allocate(smc (1:nblks, maxblk, lsoil)) - allocate(slc (1:nblks, maxblk, lsoil)) - allocate(stc (1:nblks, maxblk, lsoil)) - allocate(stype (1:nblks, maxblk)) - allocate(vfrac (1:nblks, maxblk)) - allocate(snoalb(1:nblks, maxblk)) - allocate(alvsf (1:nblks, maxblk)) - allocate(alnsf (1:nblks, maxblk)) - allocate(alvwf (1:nblks, maxblk)) - allocate(alnwf (1:nblks, maxblk)) - allocate(facsf (1:nblks, maxblk)) - allocate(facwf (1:nblks, maxblk)) - allocate(semis (1:nblks, maxblk)) - allocate(zorll (1:nblks, maxblk)) + do v = 1,GFS_Control%n_var_lndp + select case (trim(GFS_Control%lndp_var_list(v))) + case('smc') + allocate(slc (1:nblks, maxblk, lsoil)) + allocate(stype (1:nblks, maxblk)) + case('stc') + allocate(stc (1:nblks, maxblk, lsoil)) + case('vgf') + allocate(vfrac (1:nblks, maxblk)) + case('alb') + allocate(alnsf (1:nblks, maxblk)) + allocate(alnwf (1:nblks, maxblk)) + case('sal') + allocate(snoalb(1:nblks, maxblk)) + case('emi') + allocate(semis (1:nblks, maxblk)) + case('zol') + allocate(zorll (1:nblks, maxblk)) + endselect + enddo endif @@ -154,7 +175,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),:) @@ -163,11 +185,6 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) end if ! Consistency check for cellular automata if(GFS_Control%do_ca)then - ! DH* The current implementation of cellular_automata assumes that all blocksizes are the - ! same - abort if this is not the case, otherwise proceed with Atm_block%blksz(1) below - if (.not. minval(Atm_block%blksz) == maxblk) then - call mpp_error(FATAL, 'Logic errror: cellular_automata not compatible with non-uniform blocksizes') - end if if(GFS_Control%ca_sgs)then allocate(sst (1:nblks, maxblk)) allocate(lmsk (1:nblks, maxblk)) @@ -188,10 +205,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,53 +226,102 @@ 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),:) end do - + do nb=1,nblks - stype(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%stype(:) - vfrac(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%vfrac(:) - snoalb(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%snoalb(:) - alvsf(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%alvsf(:) - alnsf(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%alnsf(:) - alvwf(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%alvwf(:) - alnwf(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%alnwf(:) - facsf(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%facsf(:) - facwf(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%facwf(:) - semis(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Radtend%semis(:) - zorll(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%zorll(:) - end do + do v = 1,GFS_Control%n_var_lndp + ! used to identify locations with land model (=soil) + if ((GFS_Control%lsm == GFS_Control%lsm_ruc) ) then + smc(nb,1:GFS_Control%blksz(nb),1:lsoil) = GFS_Data(nb)%Sfcprop%smois(1:GFS_Control%blksz(nb),1:lsoil) + else ! noah or noah-MP + smc(nb,1:GFS_Control%blksz(nb),1:lsoil) = GFS_Data(nb)%Sfcprop%smc(1:GFS_Control%blksz(nb),1:lsoil) + endif + + select case (trim(GFS_Control%lndp_var_list(v))) + case('smc') + ! stype used to fetch soil params + stype(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%stype(1:GFS_Control%blksz(nb)) + if ((GFS_Control%lsm == GFS_Control%lsm_ruc) ) then + slc(nb,1:GFS_Control%blksz(nb),1:lsoil) = GFS_Data(nb)%Sfcprop%sh2o(1:GFS_Control%blksz(nb),1:lsoil) + else ! noah or noah-MP + slc(nb,1:GFS_Control%blksz(nb),1:lsoil) = GFS_Data(nb)%Sfcprop%slc(1:GFS_Control%blksz(nb),1:lsoil) + endif + case('stc') + if ((GFS_Control%lsm == GFS_Control%lsm_ruc) ) then + stc(nb,1:GFS_Control%blksz(nb),1:lsoil) = GFS_Data(nb)%Sfcprop%tslb(1:GFS_Control%blksz(nb),1:lsoil) + else ! noah or noah-MP + stc(nb,1:GFS_Control%blksz(nb),1:lsoil) = GFS_Data(nb)%Sfcprop%stc(1:GFS_Control%blksz(nb),1:lsoil) + endif + case('vgf') + if ( (GFS_Control%lsm == GFS_Control%lsm_noahmp) ) then + ! assumes iopt_dveg = 4 (will be checked later) + vfrac(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%shdmax(1:GFS_Control%blksz(nb)) + else ! ruc or noah-MP + vfrac(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%vfrac(1:GFS_Control%blksz(nb)) + endif + case('alb') + alnsf(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%alnsf(1:GFS_Control%blksz(nb)) + alnwf(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%alnwf(1:GFS_Control%blksz(nb)) + case('sal') + snoalb(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%snoalb(1:GFS_Control%blksz(nb)) + case('emi') + semis(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Radtend%semis(1:GFS_Control%blksz(nb)) + case('zol') + zorll(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%zorll(1:GFS_Control%blksz(nb)) + endselect + enddo + enddo - if (GFS_Control%lsm == GFS_Control%lsm_noah) then - do nb=1,nblks - smc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%smc(:,:) - slc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%slc(:,:) - stc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%stc(:,:) - end do - elseif (GFS_Control%lsm == GFS_Control%lsm_ruc) then - do nb=1,nblks - smc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%smois(:,:) - slc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%sh2o(:,:) - stc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%tslb(:,:) - end do - endif + param_update_flag = .false. + ! noah and noah-MP treated differently, as global cycle doesn't overwrite shdmax for Noah-MP ! determine whether land paramaters have been over-written to ! trigger applying perturbations (logic copied from GFS_driver), - ! or if perturbations should be applied at every time step - if (mod(GFS_Control%kdt,GFS_Control%nscyc) == 1 ) then - param_update_flag = .true. - else - param_update_flag = .false. + if ( (GFS_Control%lsm == GFS_Control%lsm_noah) .and. GFS_Control%nscyc > 0) then + if (mod(GFS_Control%kdt,GFS_Control%nscyc) == 1 ) then + param_update_flag = .true. + endif endif - - call lndp_apply_perts(GFS_Control%blksz, GFS_Control%lsm, GFS_Control%lsm_noah, GFS_Control%lsm_ruc, lsoil, & - GFS_Control%dtp, GFS_Control%kdt, GFS_Control%lndp_each_step, & + if ( ( GFS_Control%nscyc == 0 .or. GFS_Control%lsm == GFS_Control%lsm_noahmp) .and. GFS_Control%first_time_step ) then + ! call once at start of the forecast. + param_update_flag = .true. + endif + + call lndp_apply_perts(GFS_Control%blksz, GFS_Control%lsm, GFS_Control%lsm_noah, GFS_Control%lsm_ruc, & + GFS_Control%lsm_noahmp, GFS_Control%iopt_dveg, lsoil, GFS_Control%dtp, GFS_Control%kdt, & GFS_Control%n_var_lndp, GFS_Control%lndp_var_list, GFS_Control%lndp_prt_list, & sfc_wts, xlon, xlat, stype, GFS_Control%pores, GFS_Control%resid,param_update_flag, & - smc, slc, stc, vfrac, alvsf, alnsf, alvwf, alnwf, facsf, facwf, snoalb, semis, zorll, ierr) + smc, slc, stc, vfrac, alnsf, alnwf, snoalb, semis, zorll, ierr) if (ierr/=0) then write(6,*) 'call to GFS_apply_lndp failed' @@ -263,34 +329,43 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif do nb=1,nblks - GFS_Data(nb)%Sfcprop%vfrac(:) = vfrac(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Sfcprop%snoalb(:) = snoalb(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Sfcprop%alvsf(:) = alvsf(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Sfcprop%alnsf(:) = alnsf(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Sfcprop%alvwf(:) = alvwf(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Sfcprop%alnwf(:) = alnwf(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Sfcprop%facsf(:) = facsf(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Sfcprop%facwf(:) = facwf(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Radtend%semis(:) = semis(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Sfcprop%zorll(:) = zorll(nb,1:GFS_Control%blksz(nb)) - enddo - - if (GFS_Control%lsm == GFS_Control%lsm_noah) then - do nb=1,nblks - GFS_Data(nb)%Sfcprop%smc(:,:) = smc(nb,1:GFS_Control%blksz(nb),:) - GFS_Data(nb)%Sfcprop%slc(:,:) = slc(nb,1:GFS_Control%blksz(nb),:) - GFS_Data(nb)%Sfcprop%stc(:,:) = stc(nb,1:GFS_Control%blksz(nb),:) - enddo - elseif (GFS_Control%lsm == GFS_Control%lsm_ruc) then - do nb=1,nblks - GFS_Data(nb)%Sfcprop%smois(:,:) = smc(nb,1:GFS_Control%blksz(nb),:) - GFS_Data(nb)%Sfcprop%sh2o(:,:) = slc(nb,1:GFS_Control%blksz(nb),:) - GFS_Data(nb)%Sfcprop%tslb(:,:) = stc(nb,1:GFS_Control%blksz(nb),:) - enddo - endif - + do v = 1,GFS_Control%n_var_lndp + + select case (trim(GFS_Control%lndp_var_list(v))) + case('smc') + if ((GFS_Control%lsm == GFS_Control%lsm_ruc) ) then + GFS_Data(nb)%Sfcprop%smois(1:GFS_Control%blksz(nb),1:lsoil) = smc(nb,1:GFS_Control%blksz(nb),1:lsoil) + GFS_Data(nb)%Sfcprop%sh2o(1:GFS_Control%blksz(nb),1:lsoil) = slc(nb,1:GFS_Control%blksz(nb),1:lsoil) + else ! noah or noah-MP + GFS_Data(nb)%Sfcprop%smc(1:GFS_Control%blksz(nb),1:lsoil) = smc(nb,1:GFS_Control%blksz(nb),1:lsoil) + GFS_Data(nb)%Sfcprop%slc(1:GFS_Control%blksz(nb),1:lsoil) = slc(nb,1:GFS_Control%blksz(nb),1:lsoil) + endif + case('stc') + if ((GFS_Control%lsm == GFS_Control%lsm_ruc) ) then + GFS_Data(nb)%Sfcprop%tslb(1:GFS_Control%blksz(nb),1:lsoil) = stc(nb,1:GFS_Control%blksz(nb),1:lsoil) + else ! noah or noah-MP + GFS_Data(nb)%Sfcprop%stc(1:GFS_Control%blksz(nb),1:lsoil) = stc(nb,1:GFS_Control%blksz(nb),1:lsoil) + endif + case('vgf') + if ( (GFS_Control%lsm == GFS_Control%lsm_noahmp) ) then + GFS_Data(nb)%Sfcprop%shdmax(1:GFS_Control%blksz(nb)) = vfrac(nb,1:GFS_Control%blksz(nb)) + else + GFS_Data(nb)%Sfcprop%vfrac(1:GFS_Control%blksz(nb)) = vfrac(nb,1:GFS_Control%blksz(nb)) + endif + case('alb') + GFS_Data(nb)%Sfcprop%alnsf(1:GFS_Control%blksz(nb)) = alnsf(nb,1:GFS_Control%blksz(nb)) + GFS_Data(nb)%Sfcprop%alnwf(1:GFS_Control%blksz(nb)) = alnwf(nb,1:GFS_Control%blksz(nb)) + case('sal') + GFS_Data(nb)%Sfcprop%snoalb(1:GFS_Control%blksz(nb)) = snoalb(nb,1:GFS_Control%blksz(nb)) + case('emi') + GFS_Data(nb)%Radtend%semis(1:GFS_Control%blksz(nb)) = semis(nb,1:GFS_Control%blksz(nb)) + case('zol') + GFS_Data(nb)%Sfcprop%zorll(1:GFS_Control%blksz(nb)) = zorll(nb,1:GFS_Control%blksz(nb)) + end select + enddo + enddo endif ! lndp block - end if + endif ! if do* block if (GFS_Control%do_ca) then @@ -347,7 +422,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,42 +435,43 @@ 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%lndp_type == 2 ) then ! this scheme updates through forecast + if (GFS_Control%do_spp) then + if (allocated(spp_wts)) deallocate(spp_wts) + end if + if ( GFS_Control%lndp_type == 2 ) then lsoil = -999 if (allocated(sfc_wts)) deallocate(sfc_wts) end if - if (GFS_Control%lndp_type == 2) then ! save wts, and apply lndp scheme + if (GFS_Control%lndp_type == 2) then if (allocated(smc)) deallocate(smc) if (allocated(slc)) deallocate(slc) if (allocated(stc)) deallocate(stc) if (allocated(stype)) deallocate(stype) if (allocated(vfrac)) deallocate(vfrac) if (allocated(snoalb)) deallocate(snoalb) - if (allocated(alvsf)) deallocate(alvsf) if (allocated(alnsf)) deallocate(alnsf) - if (allocated(alvwf)) deallocate(alvwf) if (allocated(alnwf)) deallocate(alnwf) - if (allocated(facsf)) deallocate(facsf) - if (allocated(facwf)) deallocate(facwf) if (allocated(semis)) deallocate(semis) if (allocated(zorll)) deallocate(zorll) endif call finalize_stochastic_physics() endif - if(GFS_Control%ca_sgs)then - deallocate(sst ) - deallocate(lmsk ) - deallocate(lake ) - deallocate(condition ) - deallocate(ca_deep_cpl ) - deallocate(ca_turb_cpl ) - deallocate(ca_shal_cpl ) - endif - if(GFS_Control%ca_global)then - deallocate(ca1_cpl ) - deallocate(ca2_cpl ) - deallocate(ca3_cpl ) - endif + if(GFS_Control%do_ca)then + if(GFS_Control%ca_sgs)then + deallocate(sst ) + deallocate(lmsk ) + deallocate(lake ) + deallocate(condition ) + deallocate(ca_deep_cpl ) + deallocate(ca_turb_cpl ) + deallocate(ca_shal_cpl ) + endif + if(GFS_Control%ca_global)then + deallocate(ca1_cpl ) + deallocate(ca2_cpl ) + deallocate(ca3_cpl ) + endif + endif end subroutine stochastic_physics_wrapper_end end module stochastic_physics_wrapper_mod 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..6b4a79cac 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit c939eae6bacb3c2a93753bba54b8646f32a0a7ab +Subproject commit 6b4a79cac94f0b69654b60cfcc202cdca6e4f740