diff --git a/doc/ChangeLog b/doc/ChangeLog index 472425b915..393a3bc328 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,84 @@ =============================================================== +Tag name: cam6_3_008 +Originator(s): patcal, jedwards, goldy +Date: 2020-01-10 +One-line Summary: Fixes for PIO2 plus nudging I/O update +Github PR URL: https://github.com/ESCOMP/CAM/pull/310 + +Purpose of changes (include the issue number and title text for each +relevant GitHub issue): +#237: Replace deprecated physics grid interfaces in nudging input +#248: scam tests don't work with pio2 +#263: attempt to initialize variable prior to calling intent(out) subroutine +#282: ambiguous dof when writing FV zonal mean values + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: cacraig, fvitt, goldy, nusbaume + +List all files eliminated: NA + +List all files added and what they do: NA + +List all existing files that have been modified, and describe the changes: + +doc/ChangeLog + - This is what has become of my aspiring rap career +src/chemistry/mozart/mo_drydep.F90 + - Pass file_desc_t instead of file handle +src/control/cam_history.F90 + - Add fill value info required by PIO2 + - Explicitly handle conversion to 4-byte reals (req. by PIO2) +src/control/cam_restart.F90 + - Call cam_pio_set_fill for the restart file +src/control/ncdio_atm.F90 + - Return the fill value as an optional output + - Pass file_desc_t instead of file handle +src/dynamics/fv/dyn_grid.F90 + - Make sure that zonal mean grid has no duplicate points +src/dynamics/se/dyn_comp.F90 + - Detect fillvalue in input fields for reset to zero +src/physics/cam/nudging.F90 + - Use infld instead of raw NetCDF for data input + - Code cleanup +src/utils/cam_pio_utils.F90 + - Added interfaces for cam_pio_inq_var_fill and cam_pio_set_fill + These interfaces encapsulate PIO1 / PIO2 fill functionality + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + + FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_007: ERROR BFAIL some baseline files were missing + - This is an expected fail because this test failed to run in cam6_3_007 + (fix is part of this PR). The baseline was verified by running this test + standalone with a compare to cam6_3_006. + +izumi/nag/aux_cam: + + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Known (pre-existing) failure + +izumi/pgi/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers): BFB + +=============================================================== +=============================================================== + Tag name: cam6_3_007 Originator(s): goldy Date: 2020-12-06 @@ -208,7 +287,7 @@ This error should be fixed with PR #241 izumi/nag/aux_cam: FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da -Known (pre-existing) failure + - Known (pre-existing) failure FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae NLCOMP FAIL ERC_D_Ln9.f10_f10_mg37.FHS94.izumi_nag.cam-idphys NLCOMP FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma NLCOMP diff --git a/src/chemistry/mozart/mo_drydep.F90 b/src/chemistry/mozart/mo_drydep.F90 index 60e084d3db..cea4ef67a2 100644 --- a/src/chemistry/mozart/mo_drydep.F90 +++ b/src/chemistry/mozart/mo_drydep.F90 @@ -1,7 +1,7 @@ module mo_drydep !--------------------------------------------------------------------- - ! ... Dry deposition + ! ... Dry deposition !--------------------------------------------------------------------- use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl @@ -80,7 +80,7 @@ module mo_drydep integer, parameter :: n_land_type = 11 integer, allocatable :: spc_ndx(:) ! nddvels - real(r8), public :: crb + real(r8), public :: crb type lnd_dvel_type real(r8), pointer :: dvel(:,:) ! deposition velocity over land (cm/s) @@ -93,7 +93,7 @@ module mo_drydep !--------------------------------------------------------------------------- !--------------------------------------------------------------------------- - subroutine dvel_inti_fromlnd + subroutine dvel_inti_fromlnd use mo_chem_utls, only : get_spc_ndx use cam_abortutils, only : endrun @@ -120,10 +120,10 @@ subroutine dvel_inti_fromlnd !------------------------------------------------------------------------------------- subroutine drydep_update( state, cam_in ) use physics_types, only : physics_state - use camsrfexch, only : cam_in_t + use camsrfexch, only : cam_in_t type(physics_state), intent(in) :: state ! Physics state variables - type(cam_in_t), intent(in) :: cam_in + type(cam_in_t), intent(in) :: cam_in if (nddvels<1) return @@ -137,15 +137,15 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & wind_speed, spec_hum, air_temp, pressure_10m, rain, & snow, solar_flux, dvelocity, dflx, mmr, & tv, ncol, lchnk ) - + !------------------------------------------------------------------------------------- - ! combines the deposition velocities provided by the land model with deposition - ! velocities over ocean and sea ice + ! combines the deposition velocities provided by the land model with deposition + ! velocities over ocean and sea ice !------------------------------------------------------------------------------------- use ppgrid, only : pcols use chem_mods, only : gas_pcnst - + #if (defined OFFLINE_DYN) use metdata, only: get_met_fields #endif @@ -154,8 +154,8 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & ! ... dummy arguments !------------------------------------------------------------------------------------- - real(r8), intent(in) :: icefrac(pcols) - real(r8), intent(in) :: ocnfrac(pcols) + real(r8), intent(in) :: icefrac(pcols) + real(r8), intent(in) :: ocnfrac(pcols) integer, intent(in) :: ncol integer, intent(in) :: lchnk ! chunk number real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K) @@ -164,7 +164,7 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) - real(r8), intent(in) :: rain(pcols) + real(r8), intent(in) :: rain(pcols) real(r8), intent(in) :: snow(pcols) ! snow height (m) real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) real(r8), intent(in) :: tv(pcols) ! potential temperature @@ -180,17 +180,17 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & real(r8), dimension(ncol) :: term ! work array integer :: ispec - real(r8) :: lndfrac(pcols) + real(r8) :: lndfrac(pcols) #if (defined OFFLINE_DYN) real(r8) :: met_ocnfrac(pcols) - real(r8) :: met_icefrac(pcols) + real(r8) :: met_icefrac(pcols) #endif integer :: i lndfrac(:ncol) = 1._r8 - ocnfrac(:ncol) - icefrac(:ncol) - where( lndfrac(:ncol) < 0._r8 ) - lndfrac(:ncol) = 0._r8 + where( lndfrac(:ncol) < 0._r8 ) + lndfrac(:ncol) = 0._r8 endwhere #if (defined OFFLINE_DYN) @@ -201,7 +201,7 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & ! ... initialize !------------------------------------------------------------------------------------- dvelocity(:,:) = 0._r8 - + !------------------------------------------------------------------------------------- ! ... compute the dep velocities over ocean and sea ice ! land type 7 is used for ocean @@ -226,7 +226,7 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & dvelocity(:ncol,spc_ndx(ispec)) = lnd(lchnk)%dvel(:ncol,ispec)*lndfrac(:ncol) & + ocnice_dvel(:ncol,spc_ndx(ispec)) enddo - + !------------------------------------------------------------------------------------- ! ... special adjustments !------------------------------------------------------------------------------------- @@ -249,10 +249,10 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & dvelocity(:ncol,hcooh_ndx) = dvelocity(:ncol,ch3cooh_ndx) end if end if - + !------------------------------------------------------------------------------------- ! ... assign CO tags to CO - ! put this kludge in for now ... + ! put this kludge in for now ... ! -- should be able to set all these via the table mapping in seq_drydep_mod !------------------------------------------------------------------------------------- if( cohc_ndx>0 .and. co_ndx>0 ) then @@ -533,11 +533,11 @@ subroutine get_landuse_and_soilw_from_file() use ncdio_atm, only : infld logical :: readvar - + type(file_desc_t) :: piofile character(len=shr_kind_cl) :: locfn logical :: lexist - + call getfil (drydep_srf_file, locfn, 1, lexist) if(lexist) then call cam_pio_openfile(piofile, locfn, PIO_NOWRITE) @@ -630,10 +630,10 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve if (single_column) then if (scm_cambfb_mode) then piofile => initial_file_get_id() - call shr_scam_getCloseLatLon(piofile%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + call shr_scam_getCloseLatLon(piofile,scmlat,scmlon,closelat,closelon,latidx,lonidx) ploniop=size(loniop) platiop=size(latiop) - else + else latidx=1 lonidx=1 ploniop=1 @@ -697,7 +697,7 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve write(iulog,*) 'interp_map : mapping_ext ',mapping_ext #endif do j = 1,plon+1 - lon1 = lon_edge(j) + lon1 = lon_edge(j) do i = -veg_ext,nlon_veg+veg_ext dx = lon_veg_edge_ext(i ) - lon1 dy = lon_veg_edge_ext(i+1) - lon1 @@ -729,17 +729,17 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve fraction = 0._r8 do jj = ind_lat(j),ind_lat(j+1) y1 = max( lat_edge(j),lat_veg_edge(jj) ) - y2 = min( lat_edge(j+1),lat_veg_edge(jj+1) ) + y2 = min( lat_edge(j+1),lat_veg_edge(jj+1) ) dy = (y2 - y1)/(lat_veg_edge(jj+1) - lat_veg_edge(jj)) do ii =ind_lon(i),ind_lon(i+1) i_ndx = mapping_ext(ii) x1 = max( lon_edge(i),lon_veg_edge_ext(ii) ) - x2 = min( lon_edge(i+1),lon_veg_edge_ext(ii+1) ) + x2 = min( lon_edge(i+1),lon_veg_edge_ext(ii+1) ) dx = (x2 - x1)/(lon_veg_edge_ext(ii+1) - lon_veg_edge_ext(ii)) area = dx * dy total_area = total_area + area !----------------------------------------------------------------- - ! ... special case for ocean grid point + ! ... special case for ocean grid point !----------------------------------------------------------------- if( nint(landmask(i_ndx,jj)) == 0 ) then fraction(npft_veg+1) = fraction(npft_veg+1) + area @@ -790,7 +790,7 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve tmp_frac_lu(i,11, j) = sum(fraction(10:12)) end do lon_loop end do lat_loop - + do lchnk = begchunk, endchunk ncol = get_ncols_p(lchnk) call get_rlat_all_p(lchnk, ncol, rlats(:ncol)) @@ -819,7 +819,7 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve end do end subroutine interp_map - + !------------------------------------------------------------------------------------- !------------------------------------------------------------------------------------- subroutine drydep_xactive( sfc_temp, pressure_sfc, & @@ -860,7 +860,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) - real(r8), intent(in) :: rain(pcols) + real(r8), intent(in) :: rain(pcols) real(r8), intent(in) :: snow(pcols) ! snow height (m) real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) @@ -874,8 +874,8 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & integer, intent(in), optional :: beglandtype integer, intent(in), optional :: endlandtype - real(r8), intent(in), optional :: ocnfrc(pcols) - real(r8), intent(in), optional :: icefrc(pcols) + real(r8), intent(in), optional :: ocnfrc(pcols) + real(r8), intent(in), optional :: icefrc(pcols) !------------------------------------------------------------------------------------- ! ... local variables @@ -952,7 +952,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & logical :: fr_lnduse(ncol,n_land_type) ! wrking array real(r8) :: dewm ! multiplier for rs when dew occurs - real(r8) :: lcl_frc_landuse(ncol,n_land_type) + real(r8) :: lcl_frc_landuse(ncol,n_land_type) integer :: beglt, endlt @@ -966,16 +966,16 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & 0.005_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.075_r8, 0.002_r8 /) if (present( beglandtype)) then - beglt = beglandtype + beglt = beglandtype else beglt = 1 endif if (present( endlandtype)) then - endlt = endlandtype + endlt = endlandtype else endlt = n_land_type endif - + !------------------------------------------------------------------------------------- ! initialize !------------------------------------------------------------------------------------- @@ -1001,7 +1001,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & !------------------------------------------------------------------------------------- ! season index only for ocn and sea ice !------------------------------------------------------------------------------------- - index_season = 4 + index_season = 4 !------------------------------------------------------------------------------------- ! special case for snow covered terrain !------------------------------------------------------------------------------------- @@ -1141,7 +1141,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & !------------------------------------------------------------------------------------- ! revise calculation of friction velocity and z0 over water !------------------------------------------------------------------------------------- - lt = 7 + lt = 7 do i = 1,ncol if( fr_lnduse(i,lt) ) then if( unstable(i) ) then @@ -1386,7 +1386,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & if( lt == 7 ) then where( fr_lnduse(:ncol,lt) ) ! assume no surface resistance for SO2 over water` - wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk)) + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk)) endwhere else where( fr_lnduse(:ncol,lt) ) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index dc38e3f2e2..2a0f42abe8 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -97,15 +97,19 @@ module cam_history type (active_entry), target, allocatable :: restarthistory_tape(:) ! restart history tapes type rvar_id - type(var_desc_t), pointer :: vdesc => null() - integer :: type - integer :: ndims - integer :: dims(4) + type(var_desc_t), pointer :: vdesc => null() + integer :: type + integer :: ndims + integer :: dims(4) character(len=fieldname_lenp2) :: name + logical :: fillset = .false. + integer :: ifill + real(r4) :: rfill + real(r8) :: dfill end type rvar_id type rdim_id - integer :: len - integer :: dimid + integer :: len + integer :: dimid character(len=fieldname_lenp2) :: name end type rdim_id ! @@ -1044,6 +1048,8 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 rvindex = rvindex + 1 restartvars(rvindex)%name = 'numlev' @@ -1051,6 +1057,8 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 rvindex = rvindex + 1 restartvars(rvindex)%name = 'hrestpath' @@ -1065,6 +1073,8 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 rvindex = rvindex + 1 restartvars(rvindex)%name = 'avgflag' @@ -1130,6 +1140,9 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%dfill = 0.0_r8 + rvindex = rvindex + 1 restartvars(rvindex)%name = 'mdims' @@ -1189,6 +1202,8 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 rvindex = rvindex + 1 restartvars(rvindex)%name = 'zonal_complement' @@ -1196,6 +1211,8 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 end subroutine restart_vars_setnames @@ -1268,15 +1285,27 @@ subroutine init_restart_history (File) restartdims(i)%dimid, existOK=.true.) end do - do i=1,restartvarcnt - ndims= restartvars(i)%ndims - do k=1,ndims - dimids(k)=restartdims(restartvars(i)%dims(k))%dimid + do i = 1, restartvarcnt + ndims = restartvars(i)%ndims + do k = 1 ,ndims + dimids(k) = restartdims(restartvars(i)%dims(k))%dimid end do allocate(restartvars(i)%vdesc) ierr = pio_def_var(File, restartvars(i)%name, restartvars(i)%type, dimids(1:ndims), restartvars(i)%vdesc) call cam_pio_handle_error(ierr, 'INIT_RESTART_HISTORY: Error defining '//trim(restartvars(i)%name)) - + if(restartvars(i)%fillset) then + if(restartvars(i)%type == PIO_INT) then + ierr = pio_put_att(File, restartvars(i)%vdesc, "_FillValue", & + restartvars(i)%ifill) + else if(restartvars(i)%type == PIO_REAL) then + ierr = pio_put_att(File, restartvars(i)%vdesc, "_FillValue", & + restartvars(i)%rfill) + else if(restartvars(i)%type == PIO_DOUBLE) then + ierr = pio_put_att(File, restartvars(i)%vdesc, "_FillValue", & + restartvars(i)%dfill) + end if + call cam_pio_handle_error(ierr, 'INIT_RESTART_HISTORY: Error setting fill'//trim(restartvars(i)%name)) + end if end do end if end subroutine init_restart_history @@ -4683,6 +4712,7 @@ subroutine dump_field (f, t, restart) integer :: fdecomp integer :: num_patches integer :: mdimsize ! Total # on-node elements + integer :: bdim3, edim3 logical :: interpolate logical :: patch_output type(history_patch_t), pointer :: patchptr @@ -4760,11 +4790,25 @@ subroutine dump_field (f, t, restart) end if else if (nadims == 2) then ! Special case for 2D field (no levels) due to hbuf structure - call cam_grid_write_dist_array(tape(t)%File, fdecomp, & - adims(1:nadims), fdims(1:frank), tape(t)%hlist(f)%hbuf(:,1,:), varid) + if(tape(t)%hlist(f)%hwrt_prec == 4) Then + call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + adims(1:nadims), fdims(1:frank), & + real(tape(t)%hlist(f)%hbuf(:,1,:), kind=r4), varid) + else + call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + adims(1:nadims), fdims(1:frank), & + tape(t)%hlist(f)%hbuf(:,1,:), varid) + end if else - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & - fdims(1:frank), tape(t)%hlist(f)%hbuf, varid) + if(tape(t)%hlist(f)%hwrt_prec == 4) Then + call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & + fdims(1:frank), & + real(tape(t)%hlist(f)%hbuf, kind=r4), varid) + else + call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & + fdims(1:frank), & + tape(t)%hlist(f)%hbuf, varid) + end if end if end if end do @@ -4774,11 +4818,13 @@ subroutine dump_field (f, t, restart) ! write variance data to restart file for standard deviation calc if (nadims == 2) then ! Special case for 2D field (no levels) due to sbuf structure - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims(1:nadims), & - fdims(1:frank), tape(t)%hlist(f)%sbuf(:,1,:), tape(t)%hlist(f)%sbuf_varid) + call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + adims(1:nadims), fdims(1:frank), & + tape(t)%hlist(f)%sbuf(:,1,:), tape(t)%hlist(f)%sbuf_varid) else - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & - fdims(1:frank), tape(t)%hlist(f)%sbuf, tape(t)%hlist(f)%sbuf_varid) + call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & + fdims(1:frank), tape(t)%hlist(f)%sbuf, & + tape(t)%hlist(f)%sbuf_varid) endif endif !! NACS @@ -4788,11 +4834,14 @@ subroutine dump_field (f, t, restart) nadims = 2 end if call cam_grid_dimensions(fdecomp, fdims(1:2), nacsrank) - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims(1:nadims), & - fdims(1:nacsrank), tape(t)%hlist(f)%nacs, tape(t)%hlist(f)%nacs_varid) + call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + adims(1:nadims), fdims(1:nacsrank), & + tape(t)%hlist(f)%nacs, tape(t)%hlist(f)%nacs_varid) else - ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nacs_varid, & - tape(t)%hlist(f)%nacs(:, tape(t)%hlist(f)%field%begdim3:tape(t)%hlist(f)%field%enddim3)) + bdim3 = tape(t)%hlist(f)%field%begdim3 + edim3 = tape(t)%hlist(f)%field%enddim3 + ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nacs_varid, & + tape(t)%hlist(f)%nacs(:, bdim3:edim3)) end if end if diff --git a/src/control/cam_restart.F90 b/src/control/cam_restart.F90 index 4aefd92c68..124cf3b4b5 100644 --- a/src/control/cam_restart.F90 +++ b/src/control/cam_restart.F90 @@ -6,7 +6,7 @@ module cam_restart use spmd_utils, only: masterproc use cam_control_mod, only: restart_run, caseid use ioFileMod, only: opnfil -use camsrfexch, only: cam_in_t, cam_out_t +use camsrfexch, only: cam_in_t, cam_out_t use dyn_comp, only: dyn_import_t, dyn_export_t use physics_buffer, only: physics_buffer_desc use units, only: getunit, freeunit @@ -53,11 +53,11 @@ subroutine cam_read_restart(cam_in, cam_out, dyn_in, dyn_out, pbuf2d, & character(len=*), parameter :: sub = 'cam_read_restart' !--------------------------------------------------------------------------- - + ! get filehandle pointer to primary restart file fh_ini => initial_file_get_id() - call read_restart_dynamics(fh_ini, dyn_in, dyn_out) + call read_restart_dynamics(fh_ini, dyn_in, dyn_out) call ionosphere_read_restart(fh_ini) call hub2atm_alloc(cam_in) @@ -79,7 +79,7 @@ subroutine cam_write_restart(cam_in, cam_out, dyn_out, pbuf2d, & yr_spec, mon_spec, day_spec, sec_spec ) use filenames, only: interpret_filename_spec - use cam_pio_utils, only: cam_pio_createfile + use cam_pio_utils, only: cam_pio_createfile, cam_pio_set_fill use restart_dynamics, only: write_restart_dynamics, init_restart_dynamics use restart_physics, only: write_restart_physics, init_restart_physics use cam_history, only: write_restart_history, init_restart_history @@ -114,7 +114,7 @@ subroutine cam_write_restart(cam_in, cam_out, dyn_out, pbuf2d, & end if call cam_pio_createfile(fh, trim(fname), 0) - + ierr = cam_pio_set_fill(fh) call init_restart_dynamics(fh, dyn_out) call ionosphere_init_restart(fh) call init_restart_physics(fh, pbuf2d) @@ -142,7 +142,7 @@ subroutine cam_write_restart(cam_in, cam_out, dyn_out, pbuf2d, & ! Close the primary restart file call pio_closefile(fh) - + ! Update the restart pointer file call write_rest_pfile(fname) @@ -161,7 +161,7 @@ subroutine write_rest_pfile(restart_file) integer :: nsds, ierr character(len=*), parameter :: sub='write_rest_pfile' !--------------------------------------------------------------------------- - + if (masterproc) then nsds = getunit() diff --git a/src/control/ncdio_atm.F90 b/src/control/ncdio_atm.F90 index a01305c5cd..fd57906da4 100644 --- a/src/control/ncdio_atm.F90 +++ b/src/control/ncdio_atm.F90 @@ -56,7 +56,8 @@ module ncdio_atm ! ! !INTERFACE: subroutine infld_real_1d_2d(varname, ncid, dimname1, & - dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel) + dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel, & + fillvalue) ! ! !DESCRIPTION: ! Netcdf I/O of initial real field from netCDF file @@ -69,7 +70,7 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & cam_grid_dimensions - use cam_pio_utils, only: cam_pio_check_var + use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill ! ! !ARGUMENTS: @@ -85,6 +86,7 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & logical, intent(out) :: readvar ! true => variable is on initial dataset character(len=*), optional, intent(in) :: gridname ! Name of variable's grid integer, optional, intent(in) :: timelevel + real(r8), optional, intent(out) :: fillvalue ! !EOP ! @@ -94,7 +96,7 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & integer :: i, j ! indices integer :: ierr ! error status type(var_desc_t) :: varid ! variable id - + integer :: no_fill integer :: arraydimsize(2) ! field dimension lengths integer :: ndims ! number of dimensions @@ -220,7 +222,11 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:ndims), & pio_double, iodesc) call pio_read_darray(ncid, varid, iodesc, field, ierr) - end if + if (present(fillvalue)) then + ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) + end if + end if + if (masterproc) write(iulog,*) subname//': read field '//trim(varname) @@ -239,7 +245,8 @@ end subroutine infld_real_1d_2d ! ! !INTERFACE: subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & - dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel) + dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel, & + fillvalue) ! ! !DESCRIPTION: ! Netcdf I/O of initial real field from netCDF file @@ -251,7 +258,8 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id - use cam_pio_utils, only: cam_permute_array, calc_permutation, cam_pio_check_var + use cam_pio_utils, only: cam_permute_array, calc_permutation + use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill ! ! !ARGUMENTS: @@ -268,6 +276,7 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & logical, intent(out) :: readvar ! true => variable is on initial dataset character(len=*), optional, intent(in) :: gridname ! Name of variable's grid integer, optional, intent(in) :: timelevel + real(r8), optional, intent(out) :: fillvalue ! !EOP ! @@ -405,7 +414,7 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & strt(1) = dim1b strt(2) = dim2b cnt = arraydimsize - call shr_scam_getCloseLatLon(ncid%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) if (trim(field_dnames(1)) == 'lon') then strt(1) = lonidx ! First dim always lon for Eulerian dycore else @@ -442,6 +451,9 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & pio_double, iodesc, field_dnames=field_dnames) call pio_read_darray(ncid, varid, iodesc, field, ierr) + if (present(fillvalue)) then + ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) + end if end if if (masterproc) write(iulog,*) subname//': read field '//trim(varname) @@ -463,7 +475,7 @@ end subroutine infld_real_2d_2d ! !INTERFACE: subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & - field, readvar, gridname, timelevel) + field, readvar, gridname, timelevel, fillvalue) ! ! !DESCRIPTION: ! Netcdf I/O of initial real field from netCDF file @@ -476,7 +488,8 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & cam_grid_dimensions - use cam_pio_utils, only: cam_permute_array, calc_permutation, cam_pio_check_var + use cam_pio_utils, only: cam_permute_array, calc_permutation + use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill ! ! !ARGUMENTS: @@ -495,6 +508,7 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & logical, intent(out) :: readvar ! true => variable is on initial dataset character(len=*), optional, intent(in) :: gridname ! Name of variable's grid integer, optional, intent(in) :: timelevel + real(r8), optional, intent(out) :: fillvalue ! !EOP ! @@ -642,9 +656,13 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & call endrun(trim(subname)//': SCAM not supported in this configuration') else ! All distributed array processing - call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & - pio_double, iodesc, field_dnames=field_dnames, file_dnames=file_dnames(1:2)) + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & + pio_double, iodesc, field_dnames=field_dnames, & + file_dnames=file_dnames(1:2)) call pio_read_darray(ncid, varid, iodesc, field, ierr) + if (present(fillvalue)) then + ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) + end if end if if (masterproc) write(iulog,*) subname//': read field '//trim(varname) @@ -665,7 +683,7 @@ end subroutine infld_real_2d_3d ! !INTERFACE: subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & - field, readvar, gridname, timelevel) + field, readvar, gridname, timelevel, fillvalue) ! ! !DESCRIPTION: ! Netcdf I/O of initial real field from netCDF file @@ -677,7 +695,8 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id - use cam_pio_utils, only: cam_permute_array, calc_permutation, cam_pio_check_var + use cam_pio_utils, only: cam_permute_array, calc_permutation + use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill ! ! !ARGUMENTS: @@ -697,6 +716,7 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & logical, intent(out) :: readvar ! true => variable is on initial dataset character(len=*), optional, intent(in) :: gridname ! Name of variable's grid integer, optional, intent(in) :: timelevel + real(r8), optional, intent(out) :: fillvalue ! !EOP ! @@ -850,7 +870,7 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & strt(2) = dim2b strt(3) = dim3b cnt = arraydimsize - call shr_scam_getCloseLatLon(ncid%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) if (trim(field_dnames(1)) == 'lon') then strt(1) = lonidx ! First dim always lon for Eulerian dycore else @@ -889,9 +909,13 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & end if else ! All distributed array processing - call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:pdims), & - pio_double, iodesc, field_dnames=field_dnames, file_dnames=file_dnames(1:3)) + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:pdims), & + pio_double, iodesc, field_dnames=field_dnames, & + file_dnames=file_dnames(1:3)) call pio_read_darray(ncid, varid, iodesc, field, ierr) + if (present(fillvalue)) then + ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) + end if end if ! end of single column if (masterproc) write(iulog,*) subname//': read field '//trim(varname) diff --git a/src/dynamics/fv/dyn_grid.F90 b/src/dynamics/fv/dyn_grid.F90 index 722fd8e6fe..610df45831 100644 --- a/src/dynamics/fv/dyn_grid.F90 +++ b/src/dynamics/fv/dyn_grid.F90 @@ -1113,8 +1113,13 @@ subroutine define_cam_grids() ind = ind + 1 grid_map(1, ind) = 1 grid_map(2, ind) = i - grid_map(3, ind) = 1 - grid_map(4, ind) = i + if (beglonxy == 1) then + grid_map(3, ind) = 1 + grid_map(4, ind) = i + else + grid_map(3, ind) = 0 + grid_map(4, ind) = 0 + end if end do ! We need a special, size-one "longigude" coordinate ! NB: This is never a distributed coordinate so calc even on inactive PEs diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 3ad68a9402..11ad99981e 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -2159,11 +2159,12 @@ subroutine read_dyn_field_2d(fieldname, fh, dimname, buffer) ! Local variables logical :: found + real(r8) :: fillvalue !---------------------------------------------------------------------------- buffer = 0.0_r8 call infld(trim(fieldname), fh, dimname, 1, npsq, 1, nelemd, buffer, & - found, gridname=ini_grid_name) + found, gridname=ini_grid_name, fillvalue=fillvalue) if(.not. found) then call endrun('READ_DYN_FIELD_2D: Could not find '//trim(fieldname)//' field on input datafile') end if @@ -2171,7 +2172,8 @@ subroutine read_dyn_field_2d(fieldname, fh, dimname, buffer) ! This code allows use of compiler option to set uninitialized values ! to NaN. In that case infld can return NaNs where the element GLL points ! are not "unique columns" - where (isnan(buffer)) buffer = 0.0_r8 + ! Set NaNs or fillvalue points to zero + where (isnan(buffer) .or. (buffer==fillvalue)) buffer = 0.0_r8 end subroutine read_dyn_field_2d @@ -2187,11 +2189,12 @@ subroutine read_dyn_field_3d(fieldname, fh, dimname, buffer) ! Local variables logical :: found + real(r8) :: fillvalue !---------------------------------------------------------------------------- buffer = 0.0_r8 - call infld(trim(fieldname), fh, dimname, 'lev', 1, npsq, 1, nlev, & - 1, nelemd, buffer, found, gridname=ini_grid_name) + call infld(trim(fieldname), fh, dimname, 'lev', 1, npsq, 1, nlev, & + 1, nelemd, buffer, found, gridname=ini_grid_name, fillvalue=fillvalue) if(.not. found) then call endrun('READ_DYN_FIELD_3D: Could not find '//trim(fieldname)//' field on input datafile') end if @@ -2199,7 +2202,8 @@ subroutine read_dyn_field_3d(fieldname, fh, dimname, buffer) ! This code allows use of compiler option to set uninitialized values ! to NaN. In that case infld can return NaNs where the element GLL points ! are not "unique columns" - where (isnan(buffer)) buffer = 0.0_r8 + ! Set NaNs or fillvalue points to zero + where (isnan(buffer) .or. (buffer == fillvalue)) buffer = 0.0_r8 end subroutine read_dyn_field_3d diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 20b3789f68..989c49b890 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -2,43 +2,43 @@ module nudging !===================================================================== ! ! Purpose: Implement Nudging of the model state of U,V,T,Q, and/or PS -! toward specified values from analyses. +! toward specified values from analyses. ! ! Author: Patrick Callaghan ! ! Description: -! -! This module assumes that the user has {U,V,T,Q,PS} values from analyses -! which have been preprocessed onto the current model grid and adjusted -! for differences in topography. It is also assumed that these resulting -! values and are stored in individual files which are indexed with respect -! to year, month, day, and second of the day. When the model is inbetween -! the given begining and ending times, a relaxation forcing is added to -! nudge the model toward the analyses values determined from the forcing -! option specified. After the model passes the ending analyses time, the +! +! This module assumes that the user has {U,V,T,Q,PS} values from analyses +! which have been preprocessed onto the current model grid and adjusted +! for differences in topography. It is also assumed that these resulting +! values and are stored in individual files which are indexed with respect +! to year, month, day, and second of the day. When the model is inbetween +! the given begining and ending times, a relaxation forcing is added to +! nudge the model toward the analyses values determined from the forcing +! option specified. After the model passes the ending analyses time, the ! forcing discontinues. ! ! Some analyses products can have gaps in the available data, where values -! are missing for some interval of time. When files are missing, the nudging +! are missing for some interval of time. When files are missing, the nudging ! force is switched off for that interval of time, so we effectively 'coast' -! thru the gap. +! thru the gap. ! ! Currently, the nudging module is set up to accomodate nudging of PS ! values, however that functionality requires forcing that is applied in -! the selected dycore and is not yet implemented. +! the selected dycore and is not yet implemented. ! -! The nudging of the model toward the analyses data is controlled by +! The nudging of the model toward the analyses data is controlled by ! the 'nudging_nl' namelist in 'user_nl_cam'; whose variables control the ! time interval over which nudging is applied, the strength of the nudging -! tendencies, and its spatial distribution. +! tendencies, and its spatial distribution. ! ! FORCING: ! -------- ! Nudging tendencies are applied as a relaxation force between the current ! model state values and target state values derived from the avalilable ! analyses. The form of the target values is selected by the 'Nudge_Force_Opt' -! option, the timescale of the forcing is determined from the given -! 'Nudge_TimeScale_Opt', and the nudging strength Alpha=[0.,1.] for each +! option, the timescale of the forcing is determined from the given +! 'Nudge_TimeScale_Opt', and the nudging strength Alpha=[0.,1.] for each ! variable is specified by the 'Nudge_Xcoef' values. Where X={U,V,T,Q,PS} ! ! F_nudge = Alpha*((Target-Model(t_curr))/TimeScale @@ -46,41 +46,41 @@ module nudging ! ! WINDOWING: ! ---------- -! The region of applied nudging can be limited using Horizontal/Vertical -! window functions that are constructed using a parameterization of the -! Heaviside step function. +! The region of applied nudging can be limited using Horizontal/Vertical +! window functions that are constructed using a parameterization of the +! Heaviside step function. ! -! The Heaviside window function is the product of separate horizonal and vertical +! The Heaviside window function is the product of separate horizonal and vertical ! windows that are controled via 12 parameters: ! -! Nudge_Hwin_lat0: Specify the horizontal center of the window in degrees. -! Nudge_Hwin_lon0: The longitude must be in the range [0,360] and the +! Nudge_Hwin_lat0: Specify the horizontal center of the window in degrees. +! Nudge_Hwin_lon0: The longitude must be in the range [0,360] and the ! latitude should be [-90,+90]. -! Nudge_Hwin_latWidth: Specify the lat and lon widths of the window as positive -! Nudge_Hwin_lonWidth: values in degrees.Setting a width to a large value (e.g. 999) +! Nudge_Hwin_latWidth: Specify the lat and lon widths of the window as positive +! Nudge_Hwin_lonWidth: values in degrees.Setting a width to a large value (e.g. 999) ! renders the window a constant in that direction. -! Nudge_Hwin_latDelta: Controls the sharpness of the window transition with a -! Nudge_Hwin_lonDelta: length in degrees. Small non-zero values yeild a step +! Nudge_Hwin_latDelta: Controls the sharpness of the window transition with a +! Nudge_Hwin_lonDelta: length in degrees. Small non-zero values yeild a step ! function while a large value yeilds a smoother transition. -! Nudge_Hwin_Invert : A logical flag used to invert the horizontal window function +! Nudge_Hwin_Invert : A logical flag used to invert the horizontal window function ! to get its compliment.(e.g. to nudge outside a given window). ! -! Nudge_Vwin_Lindex: In the vertical, the window is specified in terms of model -! Nudge_Vwin_Ldelta: level indcies. The High and Low transition levels should -! Nudge_Vwin_Hindex: range from [0,(NLEV+1)]. The transition lengths are also -! Nudge_Vwin_Hdelta: specified in terms of model indices. For a window function +! Nudge_Vwin_Lindex: In the vertical, the window is specified in terms of model +! Nudge_Vwin_Ldelta: level indcies. The High and Low transition levels should +! Nudge_Vwin_Hindex: range from [0,(NLEV+1)]. The transition lengths are also +! Nudge_Vwin_Hdelta: specified in terms of model indices. For a window function ! constant in the vertical, the Low index should be set to 0, -! the High index should be set to (NLEV+1), and the transition -! lengths should be set to 0.001 -! Nudge_Vwin_Invert : A logical flag used to invert the vertical window function +! the High index should be set to (NLEV+1), and the transition +! lengths should be set to 0.001 +! Nudge_Vwin_Invert : A logical flag used to invert the vertical window function ! to get its compliment. ! -! EXAMPLE: For a channel window function centered at the equator and independent +! EXAMPLE: For a channel window function centered at the equator and independent ! of the vertical (30 levels): ! Nudge_Hwin_lat0 = 0. Nudge_Vwin_Lindex = 0. ! Nudge_Hwin_latWidth = 30. Nudge_Vwin_Ldelta = 0.001 ! Nudge_Hwin_latDelta = 5.0 Nudge_Vwin_Hindex = 31. -! Nudge_Hwin_lon0 = 180. Nudge_Vwin_Hdelta = 0.001 +! Nudge_Hwin_lon0 = 180. Nudge_Vwin_Hdelta = 0.001 ! Nudge_Hwin_lonWidth = 999. Nudge_Vwin_Invert = .false. ! Nudge_Hwin_lonDelta = 1.0 ! Nudge_Hwin_Invert = .false. @@ -89,18 +89,18 @@ module nudging ! not at the equator, the settings would be similar but with: ! Nudge_Hwin_Invert = .true. ! -! A user can preview the window resulting from a given set of namelist values before -! running the model. Lookat_NudgeWindow.ncl is a script avalable in the tools directory +! A user can preview the window resulting from a given set of namelist values before +! running the model. Lookat_NudgeWindow.ncl is a script avalable in the tools directory ! which will read in the values for a given namelist and display the resulting window. ! -! The module is currently configured for only 1 window function. It can readily be +! The module is currently configured for only 1 window function. It can readily be ! extended for multiple windows if the need arises. ! ! ! Input/Output Values: -! Forcing contributions are available for history file output by +! Forcing contributions are available for history file output by ! the names: {'Nudge_U','Nudge_V','Nudge_T',and 'Nudge_Q'} -! The target values that the model state is nudged toward are available for history +! The target values that the model state is nudged toward are available for history ! file output via the variables: {'Target_U','Target_V','Target_T',and 'Target_Q'} ! ! &nudging_nl @@ -120,9 +120,9 @@ module nudging ! 4 --> 6 hourly analyses. ! 8 --> 3 hourly. ! -! Model_Times_Per_Day - INT Number of times to update the model state (used for nudging) -! each day. The value is restricted to be longer than the -! current model timestep and shorter than the analyses +! Model_Times_Per_Day - INT Number of times to update the model state (used for nudging) +! each day. The value is restricted to be longer than the +! current model timestep and shorter than the analyses ! timestep. As this number is increased, the nudging ! force has the form of newtonian cooling. ! 48 --> 1800 Second timestep. @@ -135,8 +135,8 @@ module nudging ! Nudge_End_Month - INT nudging ending month. [1-12] ! Nudge_End_Day - INT nudging ending day. [1-31] ! -! Nudge_Force_Opt - INT Index to select the nudging Target for a relaxation -! forcing of the form: +! Nudge_Force_Opt - INT Index to select the nudging Target for a relaxation +! forcing of the form: ! where (t'==Analysis times ; t==Model Times) ! ! 0 -> NEXT-OBS: Target=Anal(t'_next) [DEFAULT] @@ -144,7 +144,7 @@ module nudging ! F =(t'_next - t_curr )/Tdlt_Anal ! ! Nudge_TimeScale_Opt - INT Index to select the timescale for nudging. -! where (t'==Analysis times ; t==Model Times) +! where (t'==Analysis times ; t==Model Times) ! ! 0 --> TimeScale = 1/Tdlt_Anal [DEFAULT] ! 1 --> TimeScale = 1/(t'_next - t_curr ) @@ -160,15 +160,15 @@ module nudging ! 1 == CONSTANT (Spatially Uniform Nudging) ! 2 == HEAVISIDE WINDOW FUNCTION ! -! Nudge_Ucoef - REAL fractional nudging coeffcient for U. -! Nudge_Vcoef - REAL fractional nudging coeffcient for V. -! Nudge_Tcoef - REAL fractional nudging coeffcient for T. -! Nudge_Qcoef - REAL fractional nudging coeffcient for Q. -! Nudge_PScoef - REAL fractional nudging coeffcient for PS. +! Nudge_Ucoef - REAL fractional nudging coeffcient for U. +! Nudge_Vcoef - REAL fractional nudging coeffcient for V. +! Nudge_Tcoef - REAL fractional nudging coeffcient for T. +! Nudge_Qcoef - REAL fractional nudging coeffcient for Q. +! Nudge_PScoef - REAL fractional nudging coeffcient for PS. ! -! The strength of the nudging is specified as a fractional +! The strength of the nudging is specified as a fractional ! coeffcient between [0,1]. -! +! ! Nudge_Hwin_lat0 - REAL latitudinal center of window in degrees. ! Nudge_Hwin_lon0 - REAL longitudinal center of window in degrees. ! Nudge_Hwin_latWidth - REAL latitudinal width of window in degrees. @@ -179,8 +179,8 @@ module nudging ! TRUE = value=0 inside the specified window, 1 outside ! Nudge_Vwin_Lindex - REAL LO model index of transition ! Nudge_Vwin_Hindex - REAL HI model index of transition -! Nudge_Vwin_Ldelta - REAL LO transition length -! Nudge_Vwin_Hdelta - REAL HI transition length +! Nudge_Vwin_Ldelta - REAL LO transition length +! Nudge_Vwin_Hdelta - REAL HI transition length ! Nudge_Vwin_Invert - LOGICAL FALSE= value=1 inside the specified window, 0 outside ! TRUE = value=0 inside the specified window, 1 outside ! / @@ -190,94 +190,90 @@ module nudging ! TO DO: ! ----------- ! ** Implement Ps Nudging???? -! +! !===================================================================== ! Useful modules !------------------ - use shr_kind_mod, only:r8=>SHR_KIND_R8,cs=>SHR_KIND_CS,cl=>SHR_KIND_CL - use time_manager, only:timemgr_time_ge,timemgr_time_inc,get_curr_date,get_step_size - use phys_grid , only:scatter_field_to_chunk - use cam_abortutils, only:endrun - use spmd_utils , only:masterproc - use cam_logfile , only:iulog -#ifdef SPMD - use mpishorthand -#endif - - ! Set all Global values and routines to private by default + use shr_kind_mod, only: r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL + use time_manager, only: timemgr_time_ge, timemgr_time_inc, get_curr_date + use time_manager, only: get_step_size + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom + use spmd_utils, only: mpi_integer, mpi_real8, mpi_logical, mpi_character + use cam_logfile, only: iulog + + ! Set all Global values and routines to private by default ! and then explicitly set their exposure. !---------------------------------------------------------- implicit none private - public:: Nudge_Model,Nudge_ON - public:: nudging_readnl - public:: nudging_init - public:: nudging_timestep_init - public:: nudging_timestep_tend - private::nudging_update_analyses_se - private::nudging_update_analyses_eul - private::nudging_update_analyses_fv - private::nudging_set_PSprofile - private::nudging_set_profile - private::calc_DryStaticEnergy + public :: Nudge_Model,Nudge_ON + public :: nudging_readnl + public :: nudging_init + public :: nudging_timestep_init + public :: nudging_timestep_tend + private ::nudging_update_analyses + private ::nudging_set_PSprofile + private ::nudging_set_profile + private ::calc_DryStaticEnergy ! Nudging Parameters !-------------------- - logical :: Nudge_Model =.false. - logical :: Nudge_ON =.false. - logical :: Nudge_Initialized =.false. - character(len=cl):: Nudge_Path - character(len=cs):: Nudge_File,Nudge_File_Template - integer :: Nudge_Force_Opt - integer :: Nudge_TimeScale_Opt - integer :: Nudge_TSmode - integer :: Nudge_Times_Per_Day - integer :: Model_Times_Per_Day - real(r8) :: Nudge_Ucoef,Nudge_Vcoef - integer :: Nudge_Uprof,Nudge_Vprof - real(r8) :: Nudge_Qcoef,Nudge_Tcoef - integer :: Nudge_Qprof,Nudge_Tprof - real(r8) :: Nudge_PScoef - integer :: Nudge_PSprof - integer :: Nudge_Beg_Year ,Nudge_Beg_Month - integer :: Nudge_Beg_Day ,Nudge_Beg_Sec - integer :: Nudge_End_Year ,Nudge_End_Month - integer :: Nudge_End_Day ,Nudge_End_Sec - integer :: Nudge_Curr_Year,Nudge_Curr_Month - integer :: Nudge_Curr_Day ,Nudge_Curr_Sec - integer :: Nudge_Next_Year,Nudge_Next_Month - integer :: Nudge_Next_Day ,Nudge_Next_Sec - integer :: Nudge_Step - integer :: Model_Curr_Year,Model_Curr_Month - integer :: Model_Curr_Day ,Model_Curr_Sec - integer :: Model_Next_Year,Model_Next_Month - integer :: Model_Next_Day ,Model_Next_Sec - integer :: Model_Step - real(r8) :: Nudge_Hwin_lat0 - real(r8) :: Nudge_Hwin_latWidth - real(r8) :: Nudge_Hwin_latDelta - real(r8) :: Nudge_Hwin_lon0 - real(r8) :: Nudge_Hwin_lonWidth - real(r8) :: Nudge_Hwin_lonDelta - logical :: Nudge_Hwin_Invert = .false. - real(r8) :: Nudge_Hwin_lo - real(r8) :: Nudge_Hwin_hi - real(r8) :: Nudge_Vwin_Hindex - real(r8) :: Nudge_Vwin_Hdelta - real(r8) :: Nudge_Vwin_Lindex - real(r8) :: Nudge_Vwin_Ldelta - logical :: Nudge_Vwin_Invert =.false. - real(r8) :: Nudge_Vwin_lo - real(r8) :: Nudge_Vwin_hi - real(r8) :: Nudge_Hwin_latWidthH - real(r8) :: Nudge_Hwin_lonWidthH - real(r8) :: Nudge_Hwin_max - real(r8) :: Nudge_Hwin_min + logical :: Nudge_Model =.false. + logical :: Nudge_ON =.false. + logical :: Nudge_Initialized =.false. + character(len=cl) :: Nudge_Path + character(len=cs) :: Nudge_File,Nudge_File_Template + integer :: Nudge_Force_Opt + integer :: Nudge_TimeScale_Opt + integer :: Nudge_TSmode + integer :: Nudge_Times_Per_Day + integer :: Model_Times_Per_Day + real(r8) :: Nudge_Ucoef,Nudge_Vcoef + integer :: Nudge_Uprof,Nudge_Vprof + real(r8) :: Nudge_Qcoef,Nudge_Tcoef + integer :: Nudge_Qprof,Nudge_Tprof + real(r8) :: Nudge_PScoef + integer :: Nudge_PSprof + integer :: Nudge_Beg_Year ,Nudge_Beg_Month + integer :: Nudge_Beg_Day ,Nudge_Beg_Sec + integer :: Nudge_End_Year ,Nudge_End_Month + integer :: Nudge_End_Day ,Nudge_End_Sec + integer :: Nudge_Curr_Year,Nudge_Curr_Month + integer :: Nudge_Curr_Day ,Nudge_Curr_Sec + integer :: Nudge_Next_Year,Nudge_Next_Month + integer :: Nudge_Next_Day ,Nudge_Next_Sec + integer :: Nudge_Step + integer :: Model_Curr_Year,Model_Curr_Month + integer :: Model_Curr_Day ,Model_Curr_Sec + integer :: Model_Next_Year,Model_Next_Month + integer :: Model_Next_Day ,Model_Next_Sec + integer :: Model_Step + real(r8) :: Nudge_Hwin_lat0 + real(r8) :: Nudge_Hwin_latWidth + real(r8) :: Nudge_Hwin_latDelta + real(r8) :: Nudge_Hwin_lon0 + real(r8) :: Nudge_Hwin_lonWidth + real(r8) :: Nudge_Hwin_lonDelta + logical :: Nudge_Hwin_Invert = .false. + real(r8) :: Nudge_Hwin_lo + real(r8) :: Nudge_Hwin_hi + real(r8) :: Nudge_Vwin_Hindex + real(r8) :: Nudge_Vwin_Hdelta + real(r8) :: Nudge_Vwin_Lindex + real(r8) :: Nudge_Vwin_Ldelta + logical :: Nudge_Vwin_Invert =.false. + real(r8) :: Nudge_Vwin_lo + real(r8) :: Nudge_Vwin_hi + real(r8) :: Nudge_Hwin_latWidthH + real(r8) :: Nudge_Hwin_lonWidthH + real(r8) :: Nudge_Hwin_max + real(r8) :: Nudge_Hwin_min ! Nudging State Arrays !----------------------- - integer Nudge_nlon,Nudge_nlat,Nudge_ncol,Nudge_nlev + integer :: Nudge_nlon,Nudge_nlat,Nudge_ncol,Nudge_nlev real(r8),allocatable::Target_U (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable::Target_V (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable::Target_T (:,:,:) !(pcols,pver,begchunk:endchunk) @@ -303,7 +299,7 @@ module nudging ! Nudging Observation Arrays !----------------------------- - integer Nudge_NumObs + integer :: Nudge_NumObs integer,allocatable:: Nudge_ObsInd(:) logical ,allocatable::Nudge_File_Present(:) real(r8),allocatable::Nobs_U (:,:,:,:) !(pcols,pver,begchunk:endchunk,Nudge_NumObs) @@ -315,41 +311,40 @@ module nudging contains !================================================================ subroutine nudging_readnl(nlfile) - ! - ! NUDGING_READNL: Initialize default values controlling the Nudging - ! process. Then read namelist values to override + ! + ! NUDGING_READNL: Initialize default values controlling the Nudging + ! process. Then read namelist values to override ! them. !=============================================================== - use ppgrid ,only: pver - use namelist_utils,only:find_group_name - use units ,only:getunit,freeunit + use ppgrid, only: pver + use namelist_utils, only:find_group_name ! ! Arguments !------------- - character(len=*),intent(in)::nlfile + character(len=*), intent(in) :: nlfile ! ! Local Values !--------------- - integer ierr,unitn - - namelist /nudging_nl/ Nudge_Model,Nudge_Path, & - Nudge_File_Template,Nudge_Force_Opt, & - Nudge_TimeScale_Opt, & - Nudge_Times_Per_Day,Model_Times_Per_Day, & - Nudge_Ucoef ,Nudge_Uprof, & - Nudge_Vcoef ,Nudge_Vprof, & - Nudge_Qcoef ,Nudge_Qprof, & - Nudge_Tcoef ,Nudge_Tprof, & - Nudge_PScoef,Nudge_PSprof, & - Nudge_Beg_Year,Nudge_Beg_Month,Nudge_Beg_Day, & - Nudge_End_Year,Nudge_End_Month,Nudge_End_Day, & - Nudge_Hwin_lat0,Nudge_Hwin_lon0, & - Nudge_Hwin_latWidth,Nudge_Hwin_lonWidth, & - Nudge_Hwin_latDelta,Nudge_Hwin_lonDelta, & - Nudge_Hwin_Invert, & - Nudge_Vwin_Lindex,Nudge_Vwin_Hindex, & - Nudge_Vwin_Ldelta,Nudge_Vwin_Hdelta, & - Nudge_Vwin_Invert + integer :: ierr, unitn + + namelist /nudging_nl/ Nudge_Model, Nudge_Path, & + Nudge_File_Template, Nudge_Force_Opt, & + Nudge_TimeScale_Opt, & + Nudge_Times_Per_Day, Model_Times_Per_Day, & + Nudge_Ucoef , Nudge_Uprof, & + Nudge_Vcoef , Nudge_Vprof, & + Nudge_Qcoef , Nudge_Qprof, & + Nudge_Tcoef , Nudge_Tprof, & + Nudge_PScoef, Nudge_PSprof, & + Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & + Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & + Nudge_Hwin_lat0, Nudge_Hwin_lon0, & + Nudge_Hwin_latWidth, Nudge_Hwin_lonWidth, & + Nudge_Hwin_latDelta, Nudge_Hwin_lonDelta, & + Nudge_Hwin_Invert, & + Nudge_Vwin_Lindex, Nudge_Vwin_Hindex, & + Nudge_Vwin_Ldelta, Nudge_Vwin_Hdelta, & + Nudge_Vwin_Invert ! Nudging is NOT initialized yet, For now ! Nudging will always begin/end at midnight. @@ -405,54 +400,52 @@ subroutine nudging_readnl(nlfile) ! Read in namelist values !------------------------ if(masterproc) then - unitn = getunit() - open(unitn,file=trim(nlfile),status='old') - call find_group_name(unitn,'nudging_nl',status=ierr) - if(ierr.eq.0) then - read(unitn,nudging_nl,iostat=ierr) - if(ierr.ne.0) then - call endrun('nudging_readnl:: ERROR reading namelist') - endif - endif - close(unitn) - call freeunit(unitn) - endif + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'nudging_nl', status=ierr) + if(ierr == 0) then + read(unitn,nudging_nl,iostat=ierr) + if(ierr /= 0) then + call endrun('nudging_readnl:: ERROR reading namelist') + end if + end if + close(unitn) + end if ! Set hi/lo values according to the given '_Invert' parameters !-------------------------------------------------------------- if(Nudge_Hwin_Invert) then - Nudge_Hwin_lo = 1.0_r8 - Nudge_Hwin_hi = 0.0_r8 + Nudge_Hwin_lo = 1.0_r8 + Nudge_Hwin_hi = 0.0_r8 else - Nudge_Hwin_lo = 0.0_r8 - Nudge_Hwin_hi = 1.0_r8 - endif + Nudge_Hwin_lo = 0.0_r8 + Nudge_Hwin_hi = 1.0_r8 + end if if(Nudge_Vwin_Invert) then - Nudge_Vwin_lo = 1.0_r8 - Nudge_Vwin_hi = 0.0_r8 + Nudge_Vwin_lo = 1.0_r8 + Nudge_Vwin_hi = 0.0_r8 else - Nudge_Vwin_lo = 0.0_r8 - Nudge_Vwin_hi = 1.0_r8 - endif + Nudge_Vwin_lo = 0.0_r8 + Nudge_Vwin_hi = 1.0_r8 + end if - ! Check for valid namelist values + ! Check for valid namelist values !---------------------------------- - if((Nudge_Hwin_lat0.lt.-90._r8).or.(Nudge_Hwin_lat0.gt.+90._r8)) then + if((Nudge_Hwin_lat0 < -90._r8) .or. (Nudge_Hwin_lat0 > +90._r8)) then write(iulog,*) 'NUDGING: Window lat0 must be in [-90,+90]' write(iulog,*) 'NUDGING: Nudge_Hwin_lat0=',Nudge_Hwin_lat0 call endrun('nudging_readnl:: ERROR in namelist') endif - if((Nudge_Hwin_lon0.lt.0._r8).or.(Nudge_Hwin_lon0.ge.360._r8)) then + if((Nudge_Hwin_lon0 < 0._r8) .or. (Nudge_Hwin_lon0 >= 360._r8)) then write(iulog,*) 'NUDGING: Window lon0 must be in [0,+360)' write(iulog,*) 'NUDGING: Nudge_Hwin_lon0=',Nudge_Hwin_lon0 call endrun('nudging_readnl:: ERROR in namelist') endif - if((Nudge_Vwin_Lindex.gt.Nudge_Vwin_Hindex) .or. & - (Nudge_Vwin_Hindex.gt.float(pver+1)).or.(Nudge_Vwin_Hindex.lt.0._r8).or. & - (Nudge_Vwin_Lindex.gt.float(pver+1)).or.(Nudge_Vwin_Lindex.lt.0._r8) ) then + if((Nudge_Vwin_Lindex > Nudge_Vwin_Hindex) .or. & + (Nudge_Vwin_Hindex > float(pver+1)) .or. (Nudge_Vwin_Hindex < 0._r8) .or. & + (Nudge_Vwin_Lindex > float(pver+1)) .or. (Nudge_Vwin_Lindex < 0._r8) ) then write(iulog,*) 'NUDGING: Window Lindex must be in [0,pver+1]' write(iulog,*) 'NUDGING: Window Hindex must be in [0,pver+1]' write(iulog,*) 'NUDGING: Lindex must be LE than Hindex' @@ -461,8 +454,8 @@ subroutine nudging_readnl(nlfile) call endrun('nudging_readnl:: ERROR in namelist') endif - if((Nudge_Hwin_latDelta.le.0._r8).or.(Nudge_Hwin_lonDelta.le.0._r8).or. & - (Nudge_Vwin_Hdelta .le.0._r8).or.(Nudge_Vwin_Ldelta .le.0._r8) ) then + if((Nudge_Hwin_latDelta <= 0._r8) .or. (Nudge_Hwin_lonDelta <= 0._r8) .or. & + (Nudge_Vwin_Hdelta <= 0._r8) .or. (Nudge_Vwin_Ldelta <= 0._r8) ) then write(iulog,*) 'NUDGING: Window Deltas must be positive' write(iulog,*) 'NUDGING: Nudge_Hwin_latDelta=',Nudge_Hwin_latDelta write(iulog,*) 'NUDGING: Nudge_Hwin_lonDelta=',Nudge_Hwin_lonDelta @@ -472,7 +465,7 @@ subroutine nudging_readnl(nlfile) endif - if((Nudge_Hwin_latWidth.le.0._r8).or.(Nudge_Hwin_lonWidth.le.0._r8)) then + if((Nudge_Hwin_latWidth <= 0._r8) .or. (Nudge_Hwin_lonWidth <= 0._r8)) then write(iulog,*) 'NUDGING: Window widths must be positive' write(iulog,*) 'NUDGING: Nudge_Hwin_latWidth=',Nudge_Hwin_latWidth write(iulog,*) 'NUDGING: Nudge_Hwin_lonWidth=',Nudge_Hwin_lonWidth @@ -481,63 +474,63 @@ subroutine nudging_readnl(nlfile) ! Broadcast namelist variables !------------------------------ -#ifdef SPMD - call mpibcast(Nudge_Path ,len(Nudge_Path) ,mpichar,0,mpicom) - call mpibcast(Nudge_File_Template,len(Nudge_File_Template),mpichar,0,mpicom) - call mpibcast(Nudge_Model , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_Initialized , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_ON , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_Force_Opt , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_TimeScale_Opt, 1, mpiint, 0, mpicom) - call mpibcast(Nudge_TSmode , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Times_Per_Day, 1, mpiint, 0, mpicom) - call mpibcast(Model_Times_Per_Day, 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Ucoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vcoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Tcoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Qcoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_PScoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Uprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Vprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Tprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Qprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_PSprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Beg_Year , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Beg_Month , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Beg_Day , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Beg_Sec , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_End_Year , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_End_Month , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_End_Day , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_End_Sec , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Hwin_lo , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_hi , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lat0 , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_latWidth, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_latDelta, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lon0 , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lonWidth, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lonDelta, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_Invert, 1, mpilog, 0, mpicom) - call mpibcast(Nudge_Vwin_lo , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_hi , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Hindex , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Hdelta , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Lindex , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Ldelta , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Invert, 1, mpilog, 0, mpicom) -#endif + call MPI_bcast(Nudge_Path , len(Nudge_Path), & + mpi_character, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_File_Template,len(Nudge_File_Template), & + mpi_character, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Model , 1, mpi_logical, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Initialized , 1, mpi_logical, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_ON , 1, mpi_logical, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Force_Opt , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_TimeScale_Opt, 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_TSmode , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Times_Per_Day, 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Model_Times_Per_Day, 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Ucoef , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Vcoef , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Tcoef , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Qcoef , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_PScoef , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Uprof , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Vprof , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Tprof , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Qprof , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_PSprof , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Beg_Year , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Beg_Month , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Beg_Day , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Beg_Sec , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_End_Year , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_End_Month , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_End_Day , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_End_Sec , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_lo , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_hi , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_lat0 , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_latWidth, 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_latDelta, 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_lon0 , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_lonWidth, 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_lonDelta, 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_Invert, 1, mpi_logical, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Vwin_lo , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Vwin_hi , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Vwin_Hindex , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Vwin_Hdelta , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Vwin_Lindex , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Vwin_Ldelta , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Vwin_Invert, 1, mpi_logical, mstrid, mpicom, ierr) ! End Routine !------------ - return - end subroutine ! nudging_readnl + + end subroutine nudging_readnl !================================================================ !================================================================ subroutine nudging_init - ! + ! ! NUDGING_INIT: Allocate space and initialize Nudging values !=============================================================== use ppgrid ,only: pver,pcols,begchunk,endchunk @@ -551,19 +544,20 @@ subroutine nudging_init ! Local values !---------------- - integer Year,Month,Day,Sec - integer YMD1,YMD - logical After_Beg,Before_End - integer istat,lchnk,ncol,icol,ilev - integer hdim1_d,hdim2_d - integer dtime - real(r8) rlat,rlon - real(r8) Wprof(pver) - real(r8) lonp,lon0,lonn,latp,lat0,latn - real(r8) Val1_p,Val2_p,Val3_p,Val4_p - real(r8) Val1_0,Val2_0,Val3_0,Val4_0 - real(r8) Val1_n,Val2_n,Val3_n,Val4_n - integer nn + integer :: Year,Month,Day,Sec + integer :: YMD1,YMD + logical :: After_Beg,Before_End + integer :: istat,lchnk,ncol,icol,ilev + integer :: hdim1_d,hdim2_d + integer :: ierr + integer :: dtime + real(r8) :: rlat,rlon + real(r8) :: Wprof(pver) + real(r8) :: lonp,lon0,lonn,latp,lat0,latn + real(r8) :: Val1_p,Val2_p,Val3_p,Val4_p + real(r8) :: Val1_0,Val2_0,Val3_0,Val4_0 + real(r8) :: Val1_n,Val2_n,Val3_n,Val4_n + integer :: nn ! Get the time step size !------------------------ @@ -597,7 +591,7 @@ subroutine nudging_init allocate(Model_PS(pcols,begchunk:endchunk),stat=istat) call alloc_err(istat,'nudging_init','Model_PS',pcols*((endchunk-begchunk)+1)) - ! Allocate Space for spatial dependence of + ! Allocate Space for spatial dependence of ! Nudging Coefs and Nudging Forcing. !------------------------------------------- allocate(Nudge_Utau(pcols,pver,begchunk:endchunk),stat=istat) @@ -644,14 +638,14 @@ subroutine nudging_init !-------------------------------------------------------- Model_Step=86400/Model_Times_Per_Day Nudge_Step=86400/Nudge_Times_Per_Day - if(Model_Step.lt.dtime) then + if(Model_Step < dtime) then write(iulog,*) ' ' write(iulog,*) 'NUDGING: Model_Step cannot be less than a model timestep' write(iulog,*) 'NUDGING: Setting Model_Step=dtime , dtime=',dtime write(iulog,*) ' ' Model_Step=dtime endif - if(Model_Step.gt.Nudge_Step) then + if(Model_Step > Nudge_Step) then write(iulog,*) ' ' write(iulog,*) 'NUDGING: Model_Step cannot be more than Nudge_Step' write(iulog,*) 'NUDGING: Setting Model_Step=Nudge_Step, Nudge_Step=',Nudge_Step @@ -672,14 +666,14 @@ subroutine nudging_init call get_curr_date(Year,Month,Day,Sec) YMD=(Year*10000) + (Month*100) + Day YMD1=(Nudge_Beg_Year*10000) + (Nudge_Beg_Month*100) + Nudge_Beg_Day - call timemgr_time_ge(YMD1,Nudge_Beg_Sec, & + call timemgr_time_ge(YMD1,Nudge_Beg_Sec, & YMD ,Sec ,After_Beg) YMD1=(Nudge_End_Year*10000) + (Nudge_End_Month*100) + Nudge_End_Day - call timemgr_time_ge(YMD ,Sec , & + call timemgr_time_ge(YMD ,Sec , & YMD1,Nudge_End_Sec,Before_End) - - if((After_Beg).and.(Before_End)) then - ! Set Time indicies so that the next call to + + if((After_Beg) .and. (Before_End)) then + ! Set Time indicies so that the next call to ! timestep_init will initialize the data arrays. !-------------------------------------------- Model_Next_Year =Year @@ -713,7 +707,7 @@ subroutine nudging_init write(iulog,*) ' ' endif - ! Initialize values for window function + ! Initialize values for window function !---------------------------------------- lonp= 180._r8 lon0= 0._r8 @@ -721,7 +715,7 @@ subroutine nudging_init latp= 90._r8-Nudge_Hwin_lat0 lat0= 0._r8 latn= -90._r8-Nudge_Hwin_lat0 - + Nudge_Hwin_lonWidthH=Nudge_Hwin_lonWidth/2._r8 Nudge_Hwin_latWidthH=Nudge_Hwin_latWidth/2._r8 @@ -740,15 +734,15 @@ subroutine nudging_init Val4_n=(1._r8+tanh((Nudge_Hwin_latWidthH-latn)/Nudge_Hwin_latDelta))/2._r8 Nudge_Hwin_max= Val1_0*Val2_0*Val3_0*Val4_0 - Nudge_Hwin_min=min((Val1_p*Val2_p*Val3_n*Val4_n), & - (Val1_p*Val2_p*Val3_p*Val4_p), & - (Val1_n*Val2_n*Val3_n*Val4_n), & + Nudge_Hwin_min=min((Val1_p*Val2_p*Val3_n*Val4_n), & + (Val1_p*Val2_p*Val3_p*Val4_p), & + (Val1_n*Val2_n*Val3_n*Val4_n), & (Val1_n*Val2_n*Val3_p*Val4_p)) ! Initialize number of nudging observation values to keep track of. - ! Allocate and initialize observation indices + ! Allocate and initialize observation indices !----------------------------------------------------------------- - if((Nudge_Force_Opt.ge.0).and.(Nudge_Force_Opt.le.1)) then + if((Nudge_Force_Opt >= 0) .and. (Nudge_Force_Opt <= 1)) then Nudge_NumObs=2 else ! Additional Options may need OBS values at more times. @@ -765,19 +759,11 @@ subroutine nudging_init do nn=1,Nudge_NumObs Nudge_ObsInd(nn) = Nudge_NumObs+1-nn end do - Nudge_File_Present(:)=.false. + Nudge_File_Present(:) = .false. - ! Initialization is done, + ! Initialization is done, !-------------------------- - Nudge_Initialized=.true. - - ! Check that this is a valid DYCORE model - !------------------------------------------ - if((.not.dycore_is('UNSTRUCTURED')).and. & - (.not.dycore_is('EUL') ).and. & - (.not.dycore_is('LR') ) ) then - call endrun('NUDGING IS CURRENTLY ONLY CONFIGURED FOR CAM-SE, FV, or EUL') - endif + Nudge_Initialized = .true. ! Informational Output !--------------------------- @@ -788,8 +774,8 @@ subroutine nudging_init write(iulog,*) 'NUDGING: Nudge_Model=',Nudge_Model write(iulog,*) 'NUDGING: Nudge_Path=',Nudge_Path write(iulog,*) 'NUDGING: Nudge_File_Template =',Nudge_File_Template - write(iulog,*) 'NUDGING: Nudge_Force_Opt=',Nudge_Force_Opt - write(iulog,*) 'NUDGING: Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt + write(iulog,*) 'NUDGING: Nudge_Force_Opt=',Nudge_Force_Opt + write(iulog,*) 'NUDGING: Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt write(iulog,*) 'NUDGING: Nudge_TSmode=',Nudge_TSmode write(iulog,*) 'NUDGING: Nudge_Times_Per_Day=',Nudge_Times_Per_Day write(iulog,*) 'NUDGING: Model_Times_Per_Day=',Model_Times_Per_Day @@ -817,14 +803,14 @@ subroutine nudging_init write(iulog,*) 'NUDGING: Nudge_Hwin_lon0 =',Nudge_Hwin_lon0 write(iulog,*) 'NUDGING: Nudge_Hwin_lonWidth =',Nudge_Hwin_lonWidth write(iulog,*) 'NUDGING: Nudge_Hwin_lonDelta =',Nudge_Hwin_lonDelta - write(iulog,*) 'NUDGING: Nudge_Hwin_Invert =',Nudge_Hwin_Invert + write(iulog,*) 'NUDGING: Nudge_Hwin_Invert =',Nudge_Hwin_Invert write(iulog,*) 'NUDGING: Nudge_Hwin_lo =',Nudge_Hwin_lo write(iulog,*) 'NUDGING: Nudge_Hwin_hi =',Nudge_Hwin_hi write(iulog,*) 'NUDGING: Nudge_Vwin_Hindex =',Nudge_Vwin_Hindex write(iulog,*) 'NUDGING: Nudge_Vwin_Hdelta =',Nudge_Vwin_Hdelta write(iulog,*) 'NUDGING: Nudge_Vwin_Lindex =',Nudge_Vwin_Lindex write(iulog,*) 'NUDGING: Nudge_Vwin_Ldelta =',Nudge_Vwin_Ldelta - write(iulog,*) 'NUDGING: Nudge_Vwin_Invert =',Nudge_Vwin_Invert + write(iulog,*) 'NUDGING: Nudge_Vwin_Invert =',Nudge_Vwin_Invert write(iulog,*) 'NUDGING: Nudge_Vwin_lo =',Nudge_Vwin_lo write(iulog,*) 'NUDGING: Nudge_Vwin_hi =',Nudge_Vwin_hi write(iulog,*) 'NUDGING: Nudge_Hwin_latWidthH=',Nudge_Hwin_latWidthH @@ -840,30 +826,28 @@ subroutine nudging_init ! Broadcast other variables that have changed !--------------------------------------------- -#ifdef SPMD - call mpibcast(Model_Step , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Step , 1, mpir8 , 0, mpicom) - call mpibcast(Model_Next_Year , 1, mpiint, 0, mpicom) - call mpibcast(Model_Next_Month , 1, mpiint, 0, mpicom) - call mpibcast(Model_Next_Day , 1, mpiint, 0, mpicom) - call mpibcast(Model_Next_Sec , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Next_Year , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Next_Month , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Next_Day , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Next_Sec , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Model , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_ON , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_Initialized , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_ncol , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_nlev , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_nlon , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_nlat , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Hwin_max , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_min , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lonWidthH, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_latWidthH, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_NumObs , 1, mpiint, 0, mpicom) -#endif + call MPI_bcast(Model_Step , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Step , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Model_Next_Year , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Model_Next_Month , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Model_Next_Day , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Model_Next_Sec , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Next_Year , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Next_Month , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Next_Day , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Next_Sec , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Model , 1, mpi_logical, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_ON , 1, mpi_logical, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Initialized , 1, mpi_logical, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_ncol , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_nlev , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_nlon , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_nlat , 1, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_max , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_min , 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_lonWidthH, 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_Hwin_latWidthH, 1, mpi_real8 , mstrid, mpicom, ierr) + call MPI_bcast(Nudge_NumObs , 1, mpi_integer, mstrid, mpicom, ierr) ! All non-masterproc processes also need to allocate space ! before the broadcast of Nudge_NumObs dependent data. @@ -874,10 +858,9 @@ subroutine nudging_init allocate(Nudge_File_Present(Nudge_NumObs),stat=istat) call alloc_err(istat,'nudging_init','Nudge_File_Present',Nudge_NumObs) endif -#ifdef SPMD - call mpibcast(Nudge_ObsInd , Nudge_NumObs, mpiint, 0, mpicom) - call mpibcast(Nudge_File_Present , Nudge_NumObs, mpilog, 0, mpicom) -#endif + + call MPI_bcast(Nudge_ObsInd , Nudge_NumObs, mpi_integer, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_File_Present, Nudge_NumObs, mpi_logical, mstrid, mpicom, ierr) ! Allocate Space for Nudging observation arrays, initialize with 0's !--------------------------------------------------------------------- @@ -922,17 +905,11 @@ subroutine nudging_init write(iulog,*) 'NUDGING: Reading analyses:',trim(Nudge_Path)//trim(Nudge_File) endif - ! Rotate Nudge_ObsInd() indices for new data, then update - ! the Nudge observation arrays with analysis data at the + ! Rotate Nudge_ObsInd() indices for new data, then update + ! the Nudge observation arrays with analysis data at the ! NEXT==Nudge_ObsInd(1) time. !---------------------------------------------------------- - if(dycore_is('UNSTRUCTURED')) then - call nudging_update_analyses_se (trim(Nudge_Path)//trim(Nudge_File)) - elseif(dycore_is('EUL')) then - call nudging_update_analyses_eul(trim(Nudge_Path)//trim(Nudge_File)) - else !if(dycore_is('LR')) then - call nudging_update_analyses_fv (trim(Nudge_Path)//trim(Nudge_File)) - endif + call nudging_update_analyses (trim(Nudge_Path)//trim(Nudge_File)) ! Initialize Nudging Coeffcient profiles in local arrays ! Load zeros into nudging arrays @@ -980,16 +957,16 @@ subroutine nudging_init ! End Routine !------------ - return - end subroutine ! nudging_init + + end subroutine nudging_init !================================================================ !================================================================ subroutine nudging_timestep_init(phys_state) - ! - ! NUDGING_TIMESTEP_INIT: - ! Check the current time and update Model/Nudging + ! + ! NUDGING_TIMESTEP_INIT: + ! Check the current time and update Model/Nudging ! arrays when necessary. Toggle the Nudging flag ! when the time is withing the nudging window. !=============================================================== @@ -1007,22 +984,22 @@ subroutine nudging_timestep_init(phys_state) ! Local values !---------------- - integer Year,Month,Day,Sec - integer YMD1,YMD2,YMD - logical Update_Model,Update_Nudge,Sync_Error - logical After_Beg ,Before_End - integer lchnk,ncol,indw - - type(ESMF_Time) Date1,Date2 - type(ESMF_TimeInterval) DateDiff - integer DeltaT - real(r8) Tscale - real(r8) Tfrac - integer rc - integer nn - integer kk - real(r8) Sbar,Qbar,Wsum - integer dtime + integer :: Year,Month,Day,Sec + integer :: YMD1,YMD2,YMD + logical :: Update_Model,Update_Nudge,Sync_Error + logical :: After_Beg ,Before_End + integer :: lchnk,ncol,indw + + type(ESMF_Time) :: Date1,Date2 + type(ESMF_TimeInterval) :: DateDiff + integer :: DeltaT + real(r8) :: Tscale + real(r8) :: Tfrac + integer :: rc + integer :: nn + integer :: kk + real(r8) :: Sbar,Qbar,Wsum + integer :: dtime ! Check if Nudging is initialized !--------------------------------- @@ -1058,7 +1035,7 @@ subroutine nudging_timestep_init(phys_state) call timemgr_time_ge(YMD1,Model_Next_Sec, & YMD ,Sec ,Update_Model) - if((Before_End).and.(Update_Model)) then + if((Before_End) .and. (Update_Model)) then ! Increment the Model times by the current interval !--------------------------------------------------- Model_Curr_Year =Model_Next_Year @@ -1070,7 +1047,7 @@ subroutine nudging_timestep_init(phys_state) YMD2,Model_Next_Sec,Model_Step,0,0) ! Check for Sync Error where NEXT model time after the update - ! is before the current time. If so, reset the next model + ! is before the current time. If so, reset the next model ! time to a Model_Step after the current time. !-------------------------------------------------------------- call timemgr_time_ge(YMD2,Model_Next_Sec, & @@ -1103,14 +1080,14 @@ subroutine nudging_timestep_init(phys_state) ! Load Dry Static Energy values for Model !----------------------------------------- - if(Nudge_TSmode.eq.0) then + if(Nudge_TSmode == 0) then ! DSE tendencies from Temperature only !--------------------------------------- do lchnk=begchunk,endchunk ncol=phys_state(lchnk)%ncol Model_S(:ncol,:pver,lchnk)=cpair*Model_T(:ncol,:pver,lchnk) end do - elseif(Nudge_TSmode.eq.1) then + elseif(Nudge_TSmode == 1) then ! Caluculate DSE tendencies from Temperature, Water Vapor, and Surface Pressure !------------------------------------------------------------------------------ do lchnk=begchunk,endchunk @@ -1119,8 +1096,8 @@ subroutine nudging_timestep_init(phys_state) phys_state(lchnk)%phis, Model_PS(:,lchnk), & Model_S(:,:,lchnk), ncol) end do - endif - endif ! ((Before_End).and.(Update_Model)) then + endif + endif ! ((Before_End) .and. (Update_Model)) then !---------------------------------------------------------------- ! When past the NEXT time, Update Nudging Arrays and time indices @@ -1129,7 +1106,7 @@ subroutine nudging_timestep_init(phys_state) call timemgr_time_ge(YMD1,Nudge_Next_Sec, & YMD ,Sec ,Update_Nudge) - if((Before_End).and.(Update_Nudge)) then + if((Before_End) .and. (Update_Nudge)) then ! Increment the Nudge times by the current interval !--------------------------------------------------- Nudge_Curr_Year =Nudge_Next_Year @@ -1155,32 +1132,26 @@ subroutine nudging_timestep_init(phys_state) write(iulog,*) 'NUDGING: Reading analyses:',trim(Nudge_Path)//trim(Nudge_File) endif - ! Rotate Nudge_ObsInd() indices for new data, then update - ! the Nudge observation arrays with analysis data at the + ! Rotate Nudge_ObsInd() indices for new data, then update + ! the Nudge observation arrays with analysis data at the ! NEXT==Nudge_ObsInd(1) time. !---------------------------------------------------------- - if(dycore_is('UNSTRUCTURED')) then - call nudging_update_analyses_se (trim(Nudge_Path)//trim(Nudge_File)) - elseif(dycore_is('EUL')) then - call nudging_update_analyses_eul(trim(Nudge_Path)//trim(Nudge_File)) - else !if(dycore_is('LR')) then - call nudging_update_analyses_fv (trim(Nudge_Path)//trim(Nudge_File)) - endif - endif ! ((Before_End).and.(Update_Nudge)) then + call nudging_update_analyses (trim(Nudge_Path)//trim(Nudge_File)) + endif ! ((Before_End) .and. (Update_Nudge)) then !---------------------------------------------------------------- - ! Toggle Nudging flag when the time interval is between + ! Toggle Nudging flag when the time interval is between ! beginning and ending times, and all of the analyses files exist. !---------------------------------------------------------------- - if((After_Beg).and.(Before_End)) then - if(Nudge_Force_Opt.eq.0) then + if((After_Beg) .and. (Before_End)) then + if(Nudge_Force_Opt == 0) then ! Verify that the NEXT analyses are available !--------------------------------------------- Nudge_ON=Nudge_File_Present(Nudge_ObsInd(1)) - elseif(Nudge_Force_Opt.eq.1) then + elseif(Nudge_Force_Opt == 1) then ! Verify that the CURR and NEXT analyses are available !----------------------------------------------------- - Nudge_ON=(Nudge_File_Present(Nudge_ObsInd(1)).and. & + Nudge_ON=(Nudge_File_Present(Nudge_ObsInd(1)) .and. & Nudge_File_Present(Nudge_ObsInd(2)) ) else ! Verify that the ALL analyses are available @@ -1208,11 +1179,11 @@ subroutine nudging_timestep_init(phys_state) !--------------------------------------------------- ! If Data arrays have changed update stepping arrays !--------------------------------------------------- - if((Before_End).and.((Update_Nudge).or.(Update_Model))) then + if((Before_End) .and. ((Update_Nudge) .or. (Update_Model))) then ! Now Load the Target values for nudging tendencies !--------------------------------------------------- - if(Nudge_Force_Opt.eq.0) then + if(Nudge_Force_Opt == 0) then ! Target is OBS data at NEXT time !---------------------------------- do lchnk=begchunk,endchunk @@ -1223,8 +1194,8 @@ subroutine nudging_timestep_init(phys_state) Target_Q(:ncol,:pver,lchnk)=Nobs_Q(:ncol,:pver,lchnk,Nudge_ObsInd(1)) Target_PS(:ncol ,lchnk)=Nobs_PS(:ncol ,lchnk,Nudge_ObsInd(1)) end do - elseif(Nudge_Force_Opt.eq.1) then - ! Target is linear interpolation of OBS data CURR<-->NEXT time + elseif(Nudge_Force_Opt == 1) then + ! Target is linear interpolation of OBS data CURR<-->NEXT time !--------------------------------------------------------------- call ESMF_TimeSet(Date1,YY=Year,MM=Month,DD=Day,S=Sec) call ESMF_TimeSet(Date2,YY=Nudge_Next_Year,MM=Nudge_Next_Month, & @@ -1252,14 +1223,14 @@ subroutine nudging_timestep_init(phys_state) ! Now load Dry Static Energy values for Target !--------------------------------------------- - if(Nudge_TSmode.eq.0) then + if(Nudge_TSmode == 0) then ! DSE tendencies from Temperature only !--------------------------------------- do lchnk=begchunk,endchunk ncol=phys_state(lchnk)%ncol Target_S(:ncol,:pver,lchnk)=cpair*Target_T(:ncol,:pver,lchnk) end do - elseif(Nudge_TSmode.eq.1) then + elseif(Nudge_TSmode == 1) then ! Caluculate DSE tendencies from Temperature, Water Vapor, and Surface Pressure !------------------------------------------------------------------------------ do lchnk=begchunk,endchunk @@ -1270,11 +1241,11 @@ subroutine nudging_timestep_init(phys_state) end do endif - ! Set Tscale for the specified Forcing Option + ! Set Tscale for the specified Forcing Option !----------------------------------------------- - if(Nudge_TimeScale_Opt.eq.0) then + if(Nudge_TimeScale_Opt == 0) then Tscale=1._r8 - elseif(Nudge_TimeScale_Opt.eq.1) then + elseif(Nudge_TimeScale_Opt == 1) then call ESMF_TimeSet(Date1,YY=Year,MM=Month,DD=Day,S=Sec) call ESMF_TimeSet(Date2,YY=Nudge_Next_Year,MM=Nudge_Next_Month, & DD=Nudge_Next_Day , S=Nudge_Next_Sec ) @@ -1311,30 +1282,30 @@ subroutine nudging_timestep_init(phys_state) ! DIAG !****************** ! if(masterproc) then -! write(iulog,*) 'PFC: Target_T(1,:pver,begchunk)=',Target_T(1,:pver,begchunk) +! write(iulog,*) 'PFC: Target_T(1,:pver,begchunk)=',Target_T(1,:pver,begchunk) ! write(iulog,*) 'PFC: Model_T(1,:pver,begchunk)=',Model_T(1,:pver,begchunk) -! write(iulog,*) 'PFC: Target_S(1,:pver,begchunk)=',Target_S(1,:pver,begchunk) +! write(iulog,*) 'PFC: Target_S(1,:pver,begchunk)=',Target_S(1,:pver,begchunk) ! write(iulog,*) 'PFC: Model_S(1,:pver,begchunk)=',Model_S(1,:pver,begchunk) -! write(iulog,*) 'PFC: Target_PS(1,begchunk)=',Target_PS(1,begchunk) +! write(iulog,*) 'PFC: Target_PS(1,begchunk)=',Target_PS(1,begchunk) ! write(iulog,*) 'PFC: Model_PS(1,begchunk)=',Model_PS(1,begchunk) ! write(iulog,*) 'PFC: Nudge_Sstep(1,:pver,begchunk)=',Nudge_Sstep(1,:pver,begchunk) ! write(iulog,*) 'PFC: Nudge_Xstep arrays updated:' ! endif - endif ! ((Before_End).and.((Update_Nudge).or.(Update_Model))) then + endif ! ((Before_End) .and. ((Update_Nudge) .or. (Update_Model))) then ! End Routine !------------ - return - end subroutine ! nudging_timestep_init + + end subroutine nudging_timestep_init !================================================================ !================================================================ subroutine nudging_timestep_tend(phys_state,phys_tend) - ! - ! NUDGING_TIMESTEP_TEND: - ! If Nudging is ON, return the Nudging contributions - ! to forcing using the current contents of the Nudge + ! + ! NUDGING_TIMESTEP_TEND: + ! If Nudging is ON, return the Nudging contributions + ! to forcing using the current contents of the Nudge ! arrays. Send output to the cam history module as well. !=============================================================== use physconst ,only: cpair @@ -1350,8 +1321,8 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) ! Local values !-------------------- - integer indw,ncol,lchnk - logical lq(pcnst) + integer :: indw,ncol,lchnk + logical :: lq(pcnst) call cnst_get_ind('Q',indw) lq(:) =.false. @@ -1378,21 +1349,24 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) ! End Routine !------------ - return - end subroutine ! nudging_timestep_tend - !================================================================ + end subroutine nudging_timestep_tend + !================================================================ !================================================================ - subroutine nudging_update_analyses_se(anal_file) - ! - ! NUDGING_UPDATE_ANALYSES_SE: - ! Open the given analyses data file, read in + subroutine nudging_update_analyses(anal_file) + ! + ! NUDGING_UPDATE_ANALYSES: + ! Open the given analyses data file, read in ! U,V,T,Q, and PS values and then distribute ! the values to all of the chunks. !=============================================================== - use ppgrid ,only: pver,begchunk - use netcdf + use ppgrid ,only: pcols,pver,begchunk,endchunk + use cam_pio_utils ,only: cam_pio_openfile + use pio ,only: PIO_BCAST_ERROR,PIO_INTERNAL_ERROR + use pio ,only: pio_closefile,pio_seterrorhandling,file_desc_t + use ncdio_atm ,only: infld + use cam_grid_support,only: cam_grid_id,cam_grid_get_dim_names,DLEN=>max_hcoordname_len ! Arguments !------------- @@ -1400,17 +1374,19 @@ subroutine nudging_update_analyses_se(anal_file) ! Local values !------------- - integer lev - integer ncol,plev,istat - integer ncid,varid - real(r8) Xanal(Nudge_ncol,Nudge_nlev) - real(r8) PSanal(Nudge_ncol) - real(r8) Lat_anal(Nudge_ncol) - real(r8) Lon_anal(Nudge_ncol) - integer nn,Nindex - - ! Rotate Nudge_ObsInd() indices, then check the existence of the analyses - ! file; broadcast the updated indices and file status to all the other MPI nodes. + type(file_desc_t) :: fileID + integer :: nn,Nindex + logical :: VARflag + integer :: grid_id + integer :: ierr + character(len=DLEN):: dim1name,dim2name + integer :: err_handling + + real(r8),allocatable:: Tmp3D(:,:,:) + real(r8),allocatable:: Tmp2D(:,:) + + ! Rotate Nudge_ObsInd() indices, then check the existence of the analyses + ! file; broadcast the updated indices and file status to all the other MPI nodes. ! If the file is not there, then just return. !------------------------------------------------------------------------ if(masterproc) then @@ -1423,659 +1399,93 @@ subroutine nudging_update_analyses_se(anal_file) write(iulog,*)'NUDGING: Nudge_ObsInd=',Nudge_ObsInd write(iulog,*)'NUDGING: Nudge_File_Present=',Nudge_File_Present endif -#ifdef SPMD - call mpibcast(Nudge_File_Present, Nudge_NumObs, mpilog, 0, mpicom) - call mpibcast(Nudge_ObsInd , Nudge_NumObs, mpiint, 0, mpicom) -#endif - if(.not.Nudge_File_Present(Nudge_ObsInd(1))) return - - ! masterporc does all of the work here - !----------------------------------------- - if(masterproc) then - - ! Open the given file - !----------------------- - istat=nf90_open(trim(anal_file),NF90_NOWRITE,ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*)'NF90_OPEN: failed for file ',trim(anal_file) - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - ! Read in Dimensions - !-------------------- - istat=nf90_inq_dimid(ncid,'ncol',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_inquire_dimension(ncid,varid,len=ncol) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - istat=nf90_inq_dimid(ncid,'lev',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_inquire_dimension(ncid,varid,len=plev) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - istat=nf90_inq_varid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Lon_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - istat=nf90_inq_varid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Lat_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - if((Nudge_ncol.ne.ncol).or.(plev.ne.pver)) then - write(iulog,*) 'ERROR: nudging_update_analyses_se: ncol=',ncol,' Nudge_ncol=',Nudge_ncol - write(iulog,*) 'ERROR: nudging_update_analyses_se: plev=',plev,' pver=',pver - call endrun('nudging_update_analyses_se: analyses dimension mismatch') - endif - - ! Read in and scatter data arrays - !---------------------------------- - istat=nf90_inq_varid(ncid,'U',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_ncol,Xanal, & - Nobs_U(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'V',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_ncol,Xanal, & - Nobs_V(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'T',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_ncol,Xanal, & - Nobs_T(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'Q',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_ncol,Xanal, & - Nobs_Q(1,1,begchunk,Nudge_ObsInd(1))) - if(masterproc) then - istat=nf90_inq_varid(ncid,'PS',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,PSanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - ! Close the analyses file - !----------------------- - istat=nf90_close(ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,1,1,Nudge_ncol,PSanal, & - Nobs_PS(1,begchunk,Nudge_ObsInd(1))) + call MPI_bcast(Nudge_File_Present, Nudge_NumObs, mpi_logical, mstrid, mpicom, ierr) + call MPI_bcast(Nudge_ObsInd , Nudge_NumObs, mpi_integer, mstrid, mpicom, ierr) - ! End Routine - !------------ - return - end subroutine ! nudging_update_analyses_se - !================================================================ + if(.not. Nudge_File_Present(Nudge_ObsInd(1))) then + return + end if + ! Open the file and get the fileID. + !------------------------------------- + call cam_pio_openfile(fileID,trim(anal_file),0) + call pio_seterrorhandling(fileID,PIO_BCAST_ERROR,oldmethod=err_handling) + if(masterproc) write(iulog,*)'PIO_OPEN: file=',trim(anal_file) - !================================================================ - subroutine nudging_update_analyses_eul(anal_file) - ! - ! NUDGING_UPDATE_ANALYSES_EUL: - ! Open the given analyses data file, read in - ! U,V,T,Q, and PS values and then distribute - ! the values to all of the chunks. - !=============================================================== - use ppgrid ,only: pver,begchunk - use netcdf + grid_id = cam_grid_id('physgrid') + call cam_grid_get_dim_names(grid_id,dim1name,dim2name) - ! Arguments - !------------- - character(len=*),intent(in):: anal_file + allocate(Tmp3D(pcols,pver,begchunk:endchunk)) + allocate(Tmp2D(pcols,begchunk:endchunk)) - ! Local values - !------------- - integer lev - integer nlon,nlat,plev,istat - integer ncid,varid - integer ilat,ilon,ilev - real(r8) Xanal(Nudge_nlon,Nudge_nlat,Nudge_nlev) - real(r8) PSanal(Nudge_nlon,Nudge_nlat) - real(r8) Lat_anal(Nudge_nlat) - real(r8) Lon_anal(Nudge_nlon) - real(r8) Xtrans(Nudge_nlon,Nudge_nlev,Nudge_nlat) - integer nn,Nindex - - ! Rotate Nudge_ObsInd() indices, then check the existence of the analyses - ! file; broadcast the updated indices and file status to all the other MPI nodes. - ! If the file is not there, then just return. - !------------------------------------------------------------------------ - if(masterproc) then - Nindex=Nudge_ObsInd(Nudge_NumObs) - do nn=Nudge_NumObs,2,-1 - Nudge_ObsInd(nn)=Nudge_ObsInd(nn-1) - end do - Nudge_ObsInd(1)=Nindex - inquire(FILE=trim(anal_file),EXIST=Nudge_File_Present(Nudge_ObsInd(1))) + ! Read in, U,V,T,Q, and PS + !---------------------------------- + call infld('U',fileID,dim1name,'lev',dim2name, & + 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + Nobs_U(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) + else + call endrun('Varibale "U" is missing in '//trim(anal_file)) endif -#ifdef SPMD - call mpibcast(Nudge_File_Present, Nudge_NumObs, mpilog, 0, mpicom) - call mpibcast(Nudge_ObsInd , Nudge_NumObs, mpiint, 0, mpicom) -#endif - if(.not.Nudge_File_Present(Nudge_ObsInd(1))) return - - ! masterporc does all of the work here - !----------------------------------------- - if(masterproc) then - - ! Open the given file - !----------------------- - istat=nf90_open(trim(anal_file),NF90_NOWRITE,ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*)'NF90_OPEN: failed for file ',trim(anal_file) - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - - ! Read in Dimensions - !-------------------- - istat=nf90_inq_dimid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_inquire_dimension(ncid,varid,len=nlon) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - - istat=nf90_inq_dimid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_inquire_dimension(ncid,varid,len=nlat) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - - istat=nf90_inq_dimid(ncid,'lev',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_inquire_dimension(ncid,varid,len=plev) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - - istat=nf90_inq_varid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Lon_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_inq_varid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Lat_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - - if((Nudge_nlon.ne.nlon).or.(Nudge_nlat.ne.nlat).or.(plev.ne.pver)) then - write(iulog,*) 'ERROR: nudging_update_analyses_eul: nlon=',nlon,' Nudge_nlon=',Nudge_nlon - write(iulog,*) 'ERROR: nudging_update_analyses_eul: nlat=',nlat,' Nudge_nlat=',Nudge_nlat - write(iulog,*) 'ERROR: nudging_update_analyses_eul: plev=',plev,' pver=',pver - call endrun('nudging_update_analyses_eul: analyses dimension mismatch') - endif - - ! Read in, transpose lat/lev indices, - ! and scatter data arrays - !---------------------------------- - istat=nf90_inq_varid(ncid,'U',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_U(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'V',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_V(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'T',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_T(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'Q',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_Q(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'PS',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,PSanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - ! Close the analyses file - !----------------------- - istat=nf90_close(ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,1,1,Nudge_nlon,PSanal, & - Nobs_PS(1,begchunk,Nudge_ObsInd(1))) - - ! End Routine - !------------ - return - end subroutine ! nudging_update_analyses_eul - !================================================================ - - - !================================================================ - subroutine nudging_update_analyses_fv(anal_file) - ! - ! NUDGING_UPDATE_ANALYSES_FV: - ! Open the given analyses data file, read in - ! U,V,T,Q, and PS values and then distribute - ! the values to all of the chunks. - !=============================================================== - use ppgrid ,only: pver,begchunk - use netcdf - - ! Arguments - !------------- - character(len=*),intent(in):: anal_file - - ! Local values - !------------- - integer lev - integer nlon,nlat,plev,istat - integer ncid,varid - integer ilat,ilon,ilev - real(r8) Xanal(Nudge_nlon,Nudge_nlat,Nudge_nlev) - real(r8) PSanal(Nudge_nlon,Nudge_nlat) - real(r8) Lat_anal(Nudge_nlat) - real(r8) Lon_anal(Nudge_nlon) - real(r8) Xtrans(Nudge_nlon,Nudge_nlev,Nudge_nlat) - integer nn,Nindex - - ! Rotate Nudge_ObsInd() indices, then check the existence of the analyses - ! file; broadcast the updated indices and file status to all the other MPI nodes. - ! If the file is not there, then just return. - !------------------------------------------------------------------------ - if(masterproc) then - Nindex=Nudge_ObsInd(Nudge_NumObs) - do nn=Nudge_NumObs,2,-1 - Nudge_ObsInd(nn)=Nudge_ObsInd(nn-1) - end do - Nudge_ObsInd(1)=Nindex - inquire(FILE=trim(anal_file),EXIST=Nudge_File_Present(Nudge_ObsInd(1))) - write(iulog,*)'NUDGING: Nudge_ObsInd=',Nudge_ObsInd - write(iulog,*)'NUDGING: Nudge_File_Present=',Nudge_File_Present + call infld('V',fileID,dim1name,'lev',dim2name, & + 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + Nobs_V(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) + else + call endrun('Varibale "V" is missing in '//trim(anal_file)) endif -#ifdef SPMD - call mpibcast(Nudge_File_Present, Nudge_NumObs, mpilog, 0, mpicom) - call mpibcast(Nudge_ObsInd , Nudge_NumObs, mpiint, 0, mpicom) -#endif - if(.not.Nudge_File_Present(Nudge_ObsInd(1))) return - - ! masterporc does all of the work here - !----------------------------------------- - if(masterproc) then - - ! Open the given file - !----------------------- - istat=nf90_open(trim(anal_file),NF90_NOWRITE,ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*)'NF90_OPEN: failed for file ',trim(anal_file) - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - - ! Read in Dimensions - !-------------------- - istat=nf90_inq_dimid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_inquire_dimension(ncid,varid,len=nlon) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_inq_dimid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_inquire_dimension(ncid,varid,len=nlat) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - - istat=nf90_inq_dimid(ncid,'lev',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_inquire_dimension(ncid,varid,len=plev) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - - istat=nf90_inq_varid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Lon_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - - istat=nf90_inq_varid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Lat_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - - if((Nudge_nlon.ne.nlon).or.(Nudge_nlat.ne.nlat).or.(plev.ne.pver)) then - write(iulog,*) 'ERROR: nudging_update_analyses_fv: nlon=',nlon,' Nudge_nlon=',Nudge_nlon - write(iulog,*) 'ERROR: nudging_update_analyses_fv: nlat=',nlat,' Nudge_nlat=',Nudge_nlat - write(iulog,*) 'ERROR: nudging_update_analyses_fv: plev=',plev,' pver=',pver - call endrun('nudging_update_analyses_fv: analyses dimension mismatch') - endif - - ! Read in, transpose lat/lev indices, - ! and scatter data arrays - !---------------------------------- - istat=nf90_inq_varid(ncid,'U',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_U(1,1,begchunk,Nudge_ObsInd(1))) + call infld('T',fileID,dim1name,'lev',dim2name, & + 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + Nobs_T(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) + else + call endrun('Varibale "T" is missing in '//trim(anal_file)) + endif - if(masterproc) then - istat=nf90_inq_varid(ncid,'V',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_V(1,1,begchunk,Nudge_ObsInd(1))) + call infld('Q',fileID,dim1name,'lev',dim2name, & + 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + Nobs_Q(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) + else + call endrun('Varibale "Q" is missing in '//trim(anal_file)) + endif - if(masterproc) then - istat=nf90_inq_varid(ncid,'T',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_T(1,1,begchunk,Nudge_ObsInd(1))) + call infld('PS',fileID,dim1name,dim2name, & + 1,pcols,begchunk,endchunk,Tmp2D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + Nobs_PS(:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp2D(:,begchunk:endchunk) + else + call endrun('Varibale "PS" is missing in '//trim(anal_file)) + endif - if(masterproc) then - istat=nf90_inq_varid(ncid,'Q',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_Q(1,1,begchunk,Nudge_ObsInd(1))) + ! Restore old error handling + !---------------------------- + call pio_seterrorhandling(fileID,err_handling) - if(masterproc) then - istat=nf90_inq_varid(ncid,'PS',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,PSanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - ! Close the analyses file - !----------------------- - istat=nf90_close(ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,1,1,Nudge_nlon,PSanal, & - Nobs_PS(1,begchunk,Nudge_ObsInd(1))) + ! Close the analyses file + !----------------------- + deallocate(Tmp3D) + deallocate(Tmp2D) + call pio_closefile(fileID) ! End Routine !------------ - return - end subroutine ! nudging_update_analyses_fv + + end subroutine nudging_update_analyses !================================================================ !================================================================ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) - ! + ! ! NUDGING_SET_PROFILE: for the given lat,lon, and Nudging_prof, set ! the verical profile of window coeffcients. ! Values range from 0. to 1. to affect spatial @@ -2084,32 +1494,32 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) ! Arguments !-------------- - integer nlev,Nudge_prof - real(r8) rlat,rlon - real(r8) Wprof(nlev) + integer :: nlev,Nudge_prof + real(r8) :: rlat,rlon + real(r8) :: Wprof(nlev) ! Local values !---------------- - integer ilev - real(r8) Hcoef,latx,lonx,Vmax,Vmin - real(r8) lon_lo,lon_hi,lat_lo,lat_hi,lev_lo,lev_hi + integer :: ilev + real(r8) :: Hcoef,latx,lonx,Vmax,Vmin + real(r8) :: lon_lo,lon_hi,lat_lo,lat_hi,lev_lo,lev_hi !--------------- ! set coeffcient !--------------- - if(Nudge_prof.eq.0) then + if(Nudge_prof == 0) then ! No Nudging !------------- Wprof(:)=0.0_r8 - elseif(Nudge_prof.eq.1) then + elseif(Nudge_prof == 1) then ! Uniform Nudging !----------------- Wprof(:)=1.0_r8 - elseif(Nudge_prof.eq.2) then + elseif(Nudge_prof == 2) then ! Localized Nudging with specified Heaviside window function !------------------------------------------------------------ - if(Nudge_Hwin_max.le.Nudge_Hwin_min) then - ! For a constant Horizontal window function, + if(Nudge_Hwin_max <= Nudge_Hwin_min) then + ! For a constant Horizontal window function, ! just set Hcoef to the maximum of Hlo/Hhi. !-------------------------------------------- Hcoef=max(Nudge_Hwin_lo,Nudge_Hwin_hi) @@ -2118,8 +1528,8 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) !------------------------------------------ latx=rlat-Nudge_Hwin_lat0 lonx=rlon-Nudge_Hwin_lon0 - if(lonx.gt. 180._r8) lonx=lonx-360._r8 - if(lonx.le.-180._r8) lonx=lonx+360._r8 + if(lonx > 180._r8) lonx=lonx-360._r8 + if(lonx <= -180._r8) lonx=lonx+360._r8 ! Calcualte RAW window value !------------------------------- @@ -2142,15 +1552,15 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) lev_lo=(float(ilev)-Nudge_Vwin_Lindex)/Nudge_Vwin_Ldelta lev_hi=(Nudge_Vwin_Hindex-float(ilev))/Nudge_Vwin_Hdelta Wprof(ilev)=((1._r8+tanh(lev_lo))/2._r8)*((1._r8+tanh(lev_hi))/2._r8) - end do + end do ! Scale the Window function to span the values between Vlo and Vhi: !----------------------------------------------------------------- Vmax=maxval(Wprof) Vmin=minval(Wprof) - if((Vmax.le.Vmin).or.((Nudge_Vwin_Hindex.ge.(nlev+1)).and. & - (Nudge_Vwin_Lindex.le. 0 ) )) then - ! For a constant Vertical window function, + if((Vmax <= Vmin) .or. ((Nudge_Vwin_Hindex >= (nlev+1)) .and. & + (Nudge_Vwin_Lindex <= 0 ) )) then + ! For a constant Vertical window function, ! load maximum of Vlo/Vhi into Wprof() !-------------------------------------------- Vmax=max(Nudge_Vwin_lo,Nudge_Vwin_hi) @@ -2162,7 +1572,7 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) Wprof(:)=Nudge_Vwin_lo + Wprof(:)*(Nudge_Vwin_hi-Nudge_Vwin_lo) endif - ! The desired result is the product of the vertical profile + ! The desired result is the product of the vertical profile ! and the horizontal window coeffcient. !---------------------------------------------------- Wprof(:)=Hcoef*Wprof(:) @@ -2172,14 +1582,14 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) ! End Routine !------------ - return - end subroutine ! nudging_set_profile + + end subroutine nudging_set_profile !================================================================ !================================================================ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) - ! + ! ! NUDGING_SET_PSPROFILE: for the given lat and lon set the surface ! pressure profile value for the specified index. ! Values range from 0. to 1. to affect spatial @@ -2188,8 +1598,8 @@ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) ! Arguments !-------------- - real(r8) rlat,rlon - integer Nudge_PSprof + real(r8) :: rlat,rlon + integer :: Nudge_PSprof ! Local values !---------------- @@ -2197,11 +1607,11 @@ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) !--------------- ! set coeffcient !--------------- - if(Nudge_PSprof.eq.0) then + if(Nudge_PSprof == 0) then ! No Nudging !------------- nudging_set_PSprofile=0.0_r8 - elseif(Nudge_PSprof.eq.1) then + elseif(Nudge_PSprof == 1) then ! Uniform Nudging !----------------- nudging_set_PSprofile=1.0_r8 @@ -2211,16 +1621,16 @@ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) ! End Routine !------------ - return + end function ! nudging_set_PSprofile !================================================================ !================================================================ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) - ! + ! ! calc_DryStaticEnergy: Given the temperature, specific humidity, surface pressure, - ! and surface geopotential for a chunk containing 'ncol' columns, + ! and surface geopotential for a chunk containing 'ncol' columns, ! calculate and return the corresponding dry static energy values. !-------------------------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 @@ -2234,7 +1644,7 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) integer , intent(in) :: ncol ! Number of columns in chunk real(r8), intent(in) :: t(:,:) ! (pcols,pver) - temperature real(r8), intent(in) :: q(:,:) ! (pcols,pver) - specific humidity - real(r8), intent(in) :: ps(:) ! (pcols) - surface pressure + real(r8), intent(in) :: ps(:) ! (pcols) - surface pressure real(r8), intent(in) :: phis(:) ! (pcols) - surface geopotential real(r8), intent(out):: dse(:,:) ! (pcols,pver) - dry static energy ! @@ -2254,7 +1664,7 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) !------------------- fvdyn = dycore_is ('LR') - ! Load Pressure values and midpoint pressures + ! Load Pressure values and midpoint pressures !---------------------------------------------- do kk=1,pverp do ii=1,ncol @@ -2305,7 +1715,7 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) ! End Routine !----------- - return + end subroutine calc_DryStaticEnergy !================================================================ diff --git a/src/utils/cam_pio_utils.F90 b/src/utils/cam_pio_utils.F90 index 63a4d12b6b..329e3c8564 100644 --- a/src/utils/cam_pio_utils.F90 +++ b/src/utils/cam_pio_utils.F90 @@ -3,7 +3,7 @@ module cam_pio_utils use pio, only: io_desc_t, iosystem_desc_t, file_desc_t, var_desc_t use pio, only: pio_freedecomp, pio_rearr_subset, pio_rearr_box - use shr_kind_mod, only: r8=>shr_kind_r8 + use shr_kind_mod, only: r4 => shr_kind_r4, r8 => shr_kind_r8 use cam_logfile, only: iulog use perf_mod, only: t_startf, t_stopf use spmd_utils, only: masterproc @@ -20,6 +20,8 @@ module cam_pio_utils public :: init_pio_subsystem ! called from cam_comp public :: cam_pio_get_decomp ! Find an existing decomp or create a new one public :: cam_pio_handle_error ! If error, print a custom error message + public :: cam_pio_set_fill ! Set the PIO fill value to PIO_FILL + public :: cam_pio_inq_var_fill ! Return the buffer fill value public :: cam_permute_array public :: calc_permutation @@ -78,6 +80,12 @@ module cam_pio_utils module procedure cam_pio_get_var_3d_r8_perm end interface + interface cam_pio_inq_var_fill + module procedure inq_var_fill_i4 + module procedure inq_var_fill_r4 + module procedure inq_var_fill_r8 + end interface cam_pio_inq_var_fill + interface calc_permutation module procedure calc_permutation_int module procedure calc_permutation_char @@ -554,14 +562,7 @@ subroutine cam_pio_newdecomp(iodesc, dims, dof, dtype) integer(kind=PIO_OFFSET_KIND), intent(in) :: dof(:) integer, intent(in) :: dtype - if(pio_iotype == pio_iotype_pnetcdf) then - pio_rearranger = PIO_REARR_SUBSET - else - pio_rearranger = PIO_REARR_BOX - endif - - call pio_initdecomp(pio_subsystem, dtype, dims, dof, iodesc, & - rearr=pio_rearranger) + call pio_initdecomp(pio_subsystem, dtype, dims, dof, iodesc) end subroutine cam_pio_newdecomp @@ -1178,6 +1179,99 @@ logical function cam_pio_fileexists(fname) end function cam_pio_fileexists + integer function cam_pio_set_fill(File, fillmode, old_mode) result(ierr) +#ifdef PIO2 + use pio, only: PIO_FILL, pio_set_fill +#endif + ! Dummy arguments + type(File_desc_t), intent(in) :: File + integer, optional, intent(in) :: fillmode + integer, optional, intent(out) :: old_mode + ! Local variables + integer :: oldfill + integer :: fillval + +#ifdef PIO2 + if (present(fillmode)) then + fillval = fillmode + else + fillval = PIO_FILL + end if + ierr = pio_set_fill(File, fillval, oldfill) + if (present(old_mode)) then + old_mode = oldfill + end if +#else + ierr = 0 + if (present(old_mode)) then + old_mode = 0 + end if +#endif + end function cam_pio_set_fill + + integer function inq_var_fill_i4(File, vdesc, fillvalue, no_fill) result(ierr) +#ifdef PIO2 + use pio, only: pio_inq_var_fill +#endif + use pio, only: PIO_NOERR + + type(File_desc_t), intent(in) :: File + type(var_desc_t), intent(in) :: vdesc + ! fillvalue needs to not be optional to avoid ambiguity + integer, target, intent(out) :: fillvalue + integer, optional, intent(out) :: no_fill + +#ifdef PIO2 + ierr = pio_inq_var_fill(File, vdesc, no_fill, fillvalue) +#else + ierr = PIO_NOERR + fillvalue = 0 +#endif + + end function inq_var_fill_i4 + + integer function inq_var_fill_r4(File, vdesc, fillvalue, no_fill) result(ierr) +#ifdef PIO2 + use pio, only: pio_inq_var_fill +#endif + use pio, only: PIO_NOERR + + type(File_desc_t), intent(in) :: File + type(var_desc_t), intent(in) :: vdesc + ! fillvalue needs to not be optional to avoid ambiguity + real(r4), target, intent(out) :: fillvalue + integer, optional, intent(out) :: no_fill + +#ifdef PIO2 + ierr = pio_inq_var_fill(File, vdesc, no_fill, fillvalue) +#else + ierr = PIO_NOERR + fillvalue = 0.0_R4 +#endif + + end function inq_var_fill_r4 + + integer function inq_var_fill_r8(File, vdesc, fillvalue, no_fill) result(ierr) +#ifdef PIO2 + use pio, only: pio_inq_var_fill +#endif + use pio, only: PIO_NOERR + + type(File_desc_t), intent(in) :: File + type(var_desc_t), intent(in) :: vdesc + ! fillvalue needs to not be optional to avoid ambiguity + real(r8), target, intent(out) :: fillvalue + integer, optional, intent(out) :: no_fill + +#ifdef PIO2 + ierr = pio_inq_var_fill(File, vdesc, no_fill, fillvalue) +#else + ierr = PIO_NOERR + fillvalue = 0.0_R8 +#endif + + end function inq_var_fill_r8 + subroutine find_dump_filename(fieldname, filename) ! Dummy arguments