diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index a39843f2d4..a491a03b06 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -220,32 +220,70 @@ Default: FALSE - - Full pathname of analyses data to use for nudging. - (e.g. '/$DIN_LOC_ROOT/atm/cam/nudging/') + Full pathname of datapath where Nudge_Filenames are located. Default: none - - Template for Nudging analyses file names. - (e.g. '%y/ERAI_ne30np4_L30.cam2.i.%y-%m-%d-%s.nc') + Filenames of analyses data to use for nudging. Default: none - - Number of analyses files per day. - (e.g. 4 --> 6 hourly analyses) + ESMF mesh file that corresponds to the nudging files Default: none - + First nudging year of data to use (nudging calendar) + Default: none + + + + Last nudging year of data to use (nudging calendar) + Default: none + + + + Model year to align with Nudge_Beg_Year. + Model (simulation) year to align with Nudge_Data_Year_First. + If this is set to Nudge_Beg_Year, then nudging will begin with + the beginning of the dataset. If this is set to some other + year, there will be an offset between the model year and the + year in the nudging data currently being used. + Default: none + + + + Mapping algorithm to map nudge data to model grid. + Default: bilinear + + + + Time extrapolation mode for time interpolation. + Default: limit + + + + Name of vertical variable in Nudge_filenames. + Default: lev + + + Number of time to update model data per day. (e.g. 48 --> 1800 Second timestep) - Default: none + Default: 6 daily analyses. -! 4 --> 6 hourly analyses. -! 8 --> 3 hourly. -! -! Model_Times_Per_Day - INT Number of times to update the model state (used for nudging) +! Nudge_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 +! current model timestep. As this number is increased, the nudging ! force has the form of newtonian cooling. ! 48 --> 1800 Second timestep. ! 96 --> 900 Second timestep. ! -! Nudge_Beg_Year - INT nudging begining year. [1979- ] -! Nudge_Beg_Month - INT nudging begining month. [1-12] -! Nudge_Beg_Day - INT nudging begining day. [1-31] -! Nudge_End_Year - INT nudging ending year. [1979-] -! Nudge_End_Month - INT nudging ending month. [1-12] -! Nudge_End_Day - INT nudging ending day. [1-31] +! Nudge_Beg_Year - INT model time nudging begining year. [1979- ] +! Nudge_Beg_Month - INT model time nudging begining month. [1-12] +! Nudge_Beg_Day - INT model time nudging begining day. [1-31] ! -! Nudge_Force_Opt - INT Index to select the nudging Target for a relaxation -! forcing of the form: -! where (t'==Analysis times ; t==Model Times) +! Nudge_End_Year - INT model time nudging ending year. [1979-] +! Nudge_End_Month - INT model time nudging ending month. [1-12] +! Nudge_End_Day - INT model time nudging ending day. [1-31] +! +! Nudge_Data_Year_First- INT first year of nudging data to use +! Nudge_Data_Year_Last - INT last year of nudging data to use +! Nudge_Data_Year_Align - INT nudging data year corresponding to NUDGE_BEG_YEAR. +! A common usage is to set this to the first year of the model run +! (corresponding to the xml variable RUN_STARTDATE). With this setting, +! the forcing in the first year of the run will be the forcing of year +! yearFirst. +! Another usage is to align the calendar of transient forcing with the +! model calendar. For example, setting yearAlign = yearFirst will lead +! to the forcing calendar being the same as the model calendar. The +! forcing for a given model year would be the forcing of the same +! year. This would be appropriate in transient runs where the model +! calendar is setup to span the same year range as the forcing data. +! If Nudge_Align_Year is not set - then it is set to NUDGE_BEG_YEAR. +! Nudge_Data_Mapalgo - CHAR mapping algorithm to map nudge data to model grid. Default: bilinear +! Nudge_Data_Taxmode - CHAR Time extrapolation mode for time interpolation. Default: limit ! -! 0 -> NEXT-OBS: Target=Anal(t'_next) [DEFAULT] +! 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] ! 1 -> LINEAR: Target=(F*Anal(t'_curr) +(1-F)*Anal(t'_next)) ! 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) -! -! 0 --> TimeScale = 1/Tdlt_Anal [DEFAULT] +! 0 --> TimeScale = 1/Tdlt_Anal [DEFAULT] ! 1 --> TimeScale = 1/(t'_next - t_curr ) ! ! Nudge_Uprof - INT index of profile structure to use for U. [0,1,2] @@ -154,7 +162,6 @@ module nudging ! Nudge_Tprof - INT index of profile structure to use for T. [0,1,2] ! Nudge_Qprof - INT index of profile structure to use for Q. [0,1,2] ! Nudge_PSprof - INT index of profile structure to use for PS. [0,N/A] -! ! The spatial distribution is specified with a profile index. ! Where: 0 == OFF (No Nudging of this variable) ! 1 == CONSTANT (Spatially Uniform Nudging) @@ -165,7 +172,6 @@ module nudging ! 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 ! coeffcient between [0,1]. ! @@ -177,6 +183,7 @@ module nudging ! Nudge_Hwin_lonDelta - REAL longitudinal transition length of window in degrees. ! Nudge_Hwin_Invert - LOGICAL FALSE= value=1 inside the specified window, 0 outside ! 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 @@ -194,14 +201,22 @@ module 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 - use time_manager, only: get_step_size - use cam_abortutils, only: endrun - use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom, mpi_success - use spmd_utils, only: mpi_integer, mpi_real8, mpi_logical, mpi_character - use cam_logfile, only: iulog - use zonal_mean_mod, only: ZonalMean_t + use ESMF , only : ESMF_Time, ESMF_TimeGet,ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_ERROR + use ESMF , only : operator(==), operator(-), operator(+), operator(<=), operator(>=) + use shr_kind_mod , only : r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL + use ppgrid , only : pver + use time_manager , only : get_curr_date, get_step_size + use cam_abortutils , only : endrun, handle_allocate_error + use cam_logfile , only : iulog + use spmd_utils , only : masterproc, masterprocid, mpicom, mpi_success, iam + use spmd_utils , only : mpi_integer, mpi_real8, mpi_logical, mpi_character + use zonal_mean_mod , only : ZonalMean_t + use nuopc_shr_methods , only : chkerr + use dshr_strdata_mod , only : shr_strdata_type + use cam_esmf_mod , only : model_clock, model_mesh + use string_utils , only : int2str ! Set all Global values and routines to private by default ! and then explicitly set their exposure. @@ -209,125 +224,134 @@ module nudging 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 + public :: nudging_final + private :: nudging_set_PSprofile private :: nudging_set_profile private :: calc_DryStaticEnergy - public :: nudging_final + private :: nudging_stream_init ! position datasets for dynamic nudging + private :: nudging_stream_interp ! interpolates between two years of nudging file data + private :: chkrc ! 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 + integer, parameter :: iunset = -999 + ! + logical, public, protected :: Nudge_Model =.false. + logical, public, protected :: Nudge_On = .false. + logical :: Nudge_Initialized = .false. + ! + integer, parameter :: maxfiles = 100 + character(len=cl) :: Nudge_Datapath = 'unset' ! derived + character(len=cl) :: Nudge_Meshfile = 'unset' ! namelist + character(len=cl) :: Nudge_Filenames(maxfiles) = 'unset' ! namelist + integer :: Nudge_Data_Year_First = iunset ! namelist + integer :: Nudge_Data_Year_Last = iunset ! namelist + integer :: Nudge_Data_Year_Align = iunset ! namelist + character(len=cs) :: Nudge_Data_mapalgo = 'bilinear' ! namelist - [bilinear, consf, nn] + character(len=cs) :: Nudge_Data_taxmode = 'limit' ! namelist - [limit, extend] + character(len=cs) :: Nudge_Data_levname = 'lev' ! namelist - default is 'lev' + character(len=cs) :: Nudge_Data_tintalgo ! derived - [linear, upper] + + integer :: Nudge_Beg_year = iunset ! namelist (model time) + integer :: Nudge_Beg_month = iunset ! namelist (model time) + integer :: Nudge_Beg_day = iunset ! namelist (model time) + integer :: Nudge_Beg_sec = 0 ! hard-wired (Nudging always begins at midnight) + type(ESMF_Time) :: Nudge_Beg_time ! derived from above + + integer :: Nudge_End_year = iunset ! namelist (model time) + integer :: Nudge_End_month = iunset ! namelist (model time) + integer :: Nudge_End_day = iunset ! namelist (model time) + integer :: Nudge_End_sec = 0 ! hard-wired (Nudging always ends at midnight) + type(ESMF_Time) :: Nudge_End_time ! derived from above + + integer :: Model_Update_Times_Per_Day = 4 ! namelist + type(ESMF_TimeInterval) :: Model_Update_Interval ! derived + type(ESMF_Time) :: Model_Update_Next_Time ! derived + + integer :: Nudge_Force_Opt = 0 ! namelist + integer :: Nudge_TimeScale_Opt = 0 ! namelist + integer :: Nudge_TSmode = 0 ! hard-wired + + real(r8) :: Nudge_Ucoef = 0._r8 ! namelist + real(r8) :: Nudge_Vcoef = 0._r8 ! namelist + real(r8) :: Nudge_Qcoef = 0._r8 ! namelist + real(r8) :: Nudge_Tcoef = 0._r8 ! namelist + real(r8) :: Nudge_PScoef = 0._r8 ! namelist + + integer :: Nudge_Uprof = 0 ! namelist + integer :: Nudge_Vprof = 0 ! namelist + integer :: Nudge_Qprof = 0 ! namelist + integer :: Nudge_Tprof = 0 ! namelist + integer :: Nudge_PSprof = 0 ! namelist + + real(r8) :: Nudge_Hwin_lat0 = 0._r8 ! namelist + real(r8) :: Nudge_Hwin_lon0 = 180._r8 ! namelist + real(r8) :: Nudge_Hwin_latWidth = 9999._r8 ! namelist + real(r8) :: Nudge_Hwin_lonWidth = 9999._r8 ! namelist + real(r8) :: Nudge_Hwin_latDelta = 1.0_r8 ! namelist + real(r8) :: Nudge_Hwin_lonDelta = 1.0_r8 ! namelist + real(r8) :: Nudge_Hwin_lo = 0._r8 ! namelist + real(r8) :: Nudge_Hwin_hi = 1.0_r8 ! namelist + logical :: Nudge_Hwin_Invert = .false. ! namelist + + real(r8) :: Nudge_Vwin_Hindex = float(pver+1) ! namelist + real(r8) :: Nudge_Vwin_Hdelta = 0.001_r8 ! namelist + real(r8) :: Nudge_Vwin_Lindex = 0.0_r8 ! namelist + real(r8) :: Nudge_Vwin_Ldelta = 0.001_r8 ! namelist + real(r8) :: Nudge_Vwin_lo = 0.0_r8 ! namelist + real(r8) :: Nudge_Vwin_hi = 1.0_r8 ! namelist + logical :: Nudge_Vwin_Invert = .false. ! namelist + + real(r8) :: Nudge_Hwin_latWidthH ! derived + real(r8) :: Nudge_Hwin_lonWidthH ! derived + real(r8) :: Nudge_Hwin_max ! derived + real(r8) :: Nudge_Hwin_min ! derived ! Nudging Zonal Filter variables !--------------------------------- - logical :: Nudge_ZonalFilter =.false. - integer :: Nudge_ZonalNbasis = -1 - type(ZonalMean_t) :: ZM - real(r8),allocatable:: Zonal_Bamp2d(:) - real(r8),allocatable:: Zonal_Bamp3d(:,:) + logical :: Nudge_ZonalFilter =.false. ! namelist + integer :: Nudge_ZonalNbasis = -1 ! namelist + type(ZonalMean_t) :: ZM ! derived + real(r8),allocatable:: Zonal_Bamp2d(:) ! derived + real(r8),allocatable:: Zonal_Bamp3d(:,:) ! derived ! Nudging State Arrays !----------------------- - 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) - real(r8),allocatable:: Target_S (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Target_Q (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Target_PS (:,:) !(pcols,begchunk:endchunk) - real(r8),allocatable:: Model_U (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Model_V (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Model_T (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Model_S (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Model_Q (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Model_PS (:,:) !(pcols,begchunk:endchunk) - real(r8),allocatable:: Nudge_Utau (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Nudge_Vtau (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Nudge_Stau (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Nudge_Qtau (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable:: Nudge_PStau (:,:) !(pcols,begchunk:endchunk) + real(r8),allocatable:: Nudge_Utau0 (:,:,:) !(pcols,pver,begchunk:endchunk) + real(r8),allocatable:: Nudge_Vtau0 (:,:,:) !(pcols,pver,begchunk:endchunk) + real(r8),allocatable:: Nudge_Stau0 (:,:,:) !(pcols,pver,begchunk:endchunk) + real(r8),allocatable:: Nudge_Qtau0 (:,:,:) !(pcols,pver,begchunk:endchunk) + real(r8),allocatable:: Nudge_PStau0(:,:) !(pcols,begchunk:endchunk) + real(r8),allocatable:: Nudge_Ustep (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable:: Nudge_Vstep (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable:: Nudge_Sstep (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable:: Nudge_Qstep (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable:: Nudge_PSstep(:,:) !(pcols,begchunk:endchunk) - ! Nudging Observation Arrays - !----------------------------- - integer :: Nudge_NumObs - integer,allocatable:: Nudge_ObsInd(:) - logical ,allocatable::Nudge_File_Present(:) - real(r8),allocatable::Nobs_U (:,:,:,:) !(pcols,pver,begchunk:endchunk,Nudge_NumObs) - real(r8),allocatable::Nobs_V (:,:,:,:) !(pcols,pver,begchunk:endchunk,Nudge_NumObs) - real(r8),allocatable::Nobs_T (:,:,:,:) !(pcols,pver,begchunk:endchunk,Nudge_NumObs) - real(r8),allocatable::Nobs_Q (:,:,:,:) !(pcols,pver,begchunk:endchunk,Nudge_NumObs) - real(r8),allocatable::Nobs_PS(:,:,:) !(pcols,begchunk:endchunk,Nudge_NumObs) + ! Stream functionality + !----------------------- + type(shr_strdata_type) :: sdat_nudging_multi, sdat_nudging_singl + character(len=2) :: nudge_varlist_multi(4) = (/'U ', 'V ','T ','Q '/) + character(len=2) :: nudge_varlist_singl(1) = (/'PS'/) + + logical :: stream_initialized = .false. + + character(len=*),parameter :: u_FILE_u = __FILE__ contains + !================================================================ subroutine nudging_readnl(nlfile) ! - ! NUDGING_READNL: Initialize default values controlling the Nudging - ! process. Then read namelist values to override - ! them. + ! NUDGING_READNL: Read in namelist values to override default settings !=============================================================== - use ppgrid, only: pver - use namelist_utils, only:find_group_name + use namelist_utils, only: find_group_name ! ! Arguments !------------- @@ -336,81 +360,33 @@ subroutine nudging_readnl(nlfile) ! Local Values !--------------- integer :: ierr, unitn - - character(len=*), parameter :: prefix = 'nudging_readnl: ' - - 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, & + integer :: nfile + + character(len=*), parameter :: subname = 'nudging_readnl: ' + + namelist /nudging_nl/ Nudge_Model, Nudge_Datapath, Nudge_Filenames, Nudge_Meshfile, & + Nudge_Data_Year_First, Nudge_Data_Year_Last, Nudge_Data_Year_Align, & + Nudge_Data_Mapalgo, Nudge_Data_Taxmode, Nudge_Data_Levname, & + Nudge_Force_Opt, Nudge_TimeScale_Opt, & + Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & + Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & + Model_Update_Times_Per_Day, & + Nudge_Ucoef , Nudge_Uprof, & + Nudge_Vcoef , Nudge_Vprof, & + Nudge_Qcoef , Nudge_Qprof, & + Nudge_Tcoef , Nudge_Tprof, & + Nudge_PScoef, Nudge_PSprof, & + 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 ! For Zonal Mean Filtering namelist /nudging_nl/ Nudge_ZonalFilter, Nudge_ZonalNbasis - - ! Nudging is NOT initialized yet, For now - ! Nudging will always begin/end at midnight. - !-------------------------------------------- - Nudge_Initialized =.false. - Nudge_ON =.false. - Nudge_Beg_Sec=0 - Nudge_End_Sec=0 - - ! Set Default Namelist values - !----------------------------- - Nudge_Model = .false. - Nudge_Path = './Data/YOTC_ne30np4_001/' - Nudge_File_Template = 'YOTC_ne30np4_L30.cam2.i.%y-%m-%d-%s.nc' - Nudge_Force_Opt = 0 - Nudge_TimeScale_Opt = 0 - Nudge_TSmode = 0 - Nudge_Times_Per_Day = 4 - Model_Times_Per_Day = 4 - Nudge_Ucoef = 0._r8 - Nudge_Vcoef = 0._r8 - Nudge_Qcoef = 0._r8 - Nudge_Tcoef = 0._r8 - Nudge_PScoef = 0._r8 - Nudge_Uprof = 0 - Nudge_Vprof = 0 - Nudge_Qprof = 0 - Nudge_Tprof = 0 - Nudge_PSprof = 0 - Nudge_Beg_Year = 2008 - Nudge_Beg_Month = 5 - Nudge_Beg_Day = 1 - Nudge_End_Year = 2008 - Nudge_End_Month = 9 - Nudge_End_Day = 1 - Nudge_Hwin_lat0 = 0._r8 - Nudge_Hwin_latWidth = 9999._r8 - Nudge_Hwin_latDelta = 1.0_r8 - Nudge_Hwin_lon0 = 180._r8 - Nudge_Hwin_lonWidth = 9999._r8 - Nudge_Hwin_lonDelta = 1.0_r8 - Nudge_Hwin_Invert = .false. - Nudge_Hwin_lo = 0.0_r8 - Nudge_Hwin_hi = 1.0_r8 - Nudge_Vwin_Hindex = float(pver+1) - Nudge_Vwin_Hdelta = 0.001_r8 - Nudge_Vwin_Lindex = 0.0_r8 - Nudge_Vwin_Ldelta = 0.001_r8 - Nudge_Vwin_Invert = .false. - Nudge_Vwin_lo = 0.0_r8 - Nudge_Vwin_hi = 1.0_r8 + ! ---------------------------------------------------------------------------- ! Read in namelist values !------------------------ @@ -426,166 +402,207 @@ subroutine nudging_readnl(nlfile) 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 - else - 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 - else - Nudge_Vwin_lo = 0.0_r8 - Nudge_Vwin_hi = 1.0_r8 - end if - - ! Check for valid namelist values - !---------------------------------- - 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 < 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 + ! Broadcast namelist variables + !------------------------------ + call MPI_bcast(Nudge_Model, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Model') + + call MPI_bcast(Nudge_Datapath, len(Nudge_Datapath), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Datapath '//trim(Nudge_Datapath)) + call MPI_bcast(Nudge_Filenames(:), len(Nudge_Filenames(1))*maxfiles, mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Filenames') + call MPI_bcast(Nudge_Meshfile, len(Nudge_Meshfile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Meshfile '//trim(Nudge_Meshfile)) + call MPI_bcast(Nudge_Data_Year_First, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Data_Year_First '//int2str(Nudge_Data_Year_First)) + call MPI_bcast(Nudge_Data_Year_Last, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Data_Year_Last '//int2str(Nudge_Data_Year_Last)) + call MPI_bcast(Nudge_Data_Year_Align, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Data_Year_Align '//int2str(Nudge_Data_Year_Align)) + call MPI_bcast(Nudge_Data_Mapalgo, len(Nudge_Data_Mapalgo), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Data_Mapalgo '//trim(Nudge_Data_Mapalgo)) + call MPI_bcast(Nudge_Data_Taxmode, len(Nudge_Data_Taxmode), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Taxmode '//trim(Nudge_Data_TaxMode)) + call MPI_bcast(Nudge_Data_Levname, len(Nudge_Data_Levname), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Taxmode '//trim(Nudge_Data_Levname)) + + call MPI_bcast(Model_Update_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Model_Update_Times_Per_Day '//& + int2str(Model_Update_Times_Per_Day)) + + call MPI_bcast(Nudge_Beg_Year, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Beg_Year '//int2str(Nudge_Beg_Year)) + call MPI_bcast(Nudge_Beg_Month, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Beg_Month'//int2str(Nudge_Beg_Month)) + call MPI_bcast(Nudge_Beg_Day, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Beg_Day '//int2str(Nudge_Beg_Day)) + + call MPI_bcast(Nudge_End_Year, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_End_Year '//int2str(Nudge_End_Year)) + call MPI_bcast(Nudge_End_Month, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_End_Month '//int2str(Nudge_End_Month)) + call MPI_bcast(Nudge_End_Day, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_End_Day '//int2str(Nudge_End_Day)) + + call MPI_bcast(Nudge_Force_Opt, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Force_Opt '//int2str(Nudge_Force_Opt)) + call MPI_bcast(Nudge_TimeScale_Opt, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_TimeScale_Opt '//int2str(Nudge_TimeScale_Opt)) + + call MPI_bcast(Nudge_Ucoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Ucoef') + call MPI_bcast(Nudge_Vcoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Vcoef') + call MPI_bcast(Nudge_Tcoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Tcoef') + call MPI_bcast(Nudge_Qcoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Qcoef') + call MPI_bcast(Nudge_PScoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_PScoef') + + call MPI_bcast(Nudge_Uprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Uprof '//int2str(Nudge_Uprof)) + call MPI_bcast(Nudge_Vprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Vprof '//int2str(Nudge_Vprof)) + call MPI_bcast(Nudge_Tprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Tprof '//int2str(Nudge_Tprof)) + call MPI_bcast(Nudge_Qprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Qprof '//int2str(Nudge_Qprof)) + call MPI_bcast(Nudge_PSprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_PSprof '//int2str(Nudge_PSprof)) + + call MPI_bcast(Nudge_Hwin_lat0, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Hwin_lat0') + call MPI_bcast(Nudge_Hwin_latWidth, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Hwin_latWidth') + call MPI_bcast(Nudge_Hwin_latDelta, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Hwin_latDelta') + call MPI_bcast(Nudge_Hwin_lon0, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Hwin_lon0') + call MPI_bcast(Nudge_Hwin_lonWidth, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Hwin_lonWidth') + call MPI_bcast(Nudge_Hwin_lonDelta, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Hwin_lonDelta') + call MPI_bcast(Nudge_Hwin_Invert, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Hwin_Invert') + + call MPI_bcast(Nudge_Vwin_Hindex, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Vwin_Hindex') + call MPI_bcast(Nudge_Vwin_Hdelta, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Vwin_Hdelta') + call MPI_bcast(Nudge_Vwin_Lindex, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Vwin_Lindex') + call MPI_bcast(Nudge_Vwin_Ldelta, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Vwin_Ldelta') + call MPI_bcast(Nudge_Vwin_Invert, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Vwin_Invert') + + call MPI_bcast(Nudge_ZonalFilter, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_ZonalFilter ') + call MPI_bcast(Nudge_ZonalNbasis, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_ZonalNbasis '//int2str(Nudge_ZonalNbasis)) + + ! Note that this routine is called even if nudging is not on - so need to do the following + ! only if nudging is on + + check_valid: if (Nudge_Model) then + + ! 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 + else + Nudge_Hwin_lo = 0.0_r8 + Nudge_Hwin_hi = 1.0_r8 + end if - 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' - write(iulog,*) 'NUDGING: Nudge_Vwin_Lindex=',Nudge_Vwin_Lindex - write(iulog,*) 'NUDGING: Nudge_Vwin_Hindex=',Nudge_Vwin_Hindex - call endrun('nudging_readnl:: ERROR in namelist') - endif + if(Nudge_Vwin_Invert) then + 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 + end if - 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 - write(iulog,*) 'NUDGING: Nudge_Vwin_Hdelta=',Nudge_Vwin_Hdelta - write(iulog,*) 'NUDGING: Nudge_Vwin_Ldelta=',Nudge_Vwin_Ldelta - call endrun('nudging_readnl:: ERROR in namelist') + ! Check for valid namelist values + !---------------------------------- + if (Nudge_Beg_year == iunset) then + call endrun(trim(subname)//' Nudge_Beg_year '//int2str(Nudge_Beg_year)//' is not a valid value') + end if + if (Nudge_end_year == iunset) then + call endrun(trim(subname)//' Nudge_end_year '//int2str(Nudge_end_year)//' is not a valid value') + end if + if (Nudge_Beg_year > Nudge_end_year) then + call endrun(trim(subname)//' Nudge_Beg_year '//int2str(Nudge_Beg_year)//& + 'cannot be greater than Nudge_end_year '//int2str(Nudge_end_year)) + end if - endif + ! Determine nudge_align_year if not set + if (Nudge_Data_Year_Align == iunset) then + Nudge_Data_Year_Align = Nudge_Beg_year + end if - 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 - call endrun('nudging_readnl:: ERROR in namelist') - endif + ! Determine Nudge_Data_tintalgo + if (Nudge_Force_Opt == 0) then + Nudge_Data_tintalgo = 'upper' + elseif(Nudge_Force_Opt == 1) then + Nudge_Data_tintalgo = 'linear' + else + call endrun('nudging_timestep_init:: ERROR unknown Nudge_Force_Opt '//int2str(Nudge_Force_Opt)) + endif + + if((Nudge_Hwin_lat0 < -90._r8) .or. (Nudge_Hwin_lat0 > +90._r8)) then + if (masterproc) then + write(iulog,*) 'NUDGING: Window lat0 must be in [-90,+90]' + write(iulog,*) 'NUDGING: Nudge_Hwin_lat0=',Nudge_Hwin_lat0 + end if + call endrun(trim(subname)//' ERROR Window lat0 must be in [-90,+90]') + endif - ! Broadcast namelist variables - !------------------------------ - call MPI_bcast(Nudge_Path , len(Nudge_Path), & - mpi_character, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Path ') - call MPI_bcast(Nudge_File_Template,len(Nudge_File_Template), & - mpi_character, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_File_Template') - call MPI_bcast(Nudge_Model , 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Model') - call MPI_bcast(Nudge_Initialized , 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Initialized') - call MPI_bcast(Nudge_ON , 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ON') - call MPI_bcast(Nudge_Force_Opt , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Force_Opt') - call MPI_bcast(Nudge_TimeScale_Opt, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_TimeScale_Opt') - call MPI_bcast(Nudge_TSmode , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_TSmode') - call MPI_bcast(Nudge_Times_Per_Day, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Times_Per_Day') - call MPI_bcast(Model_Times_Per_Day, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Times_Per_Day') - call MPI_bcast(Nudge_Ucoef , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Ucoef') - call MPI_bcast(Nudge_Vcoef , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vcoef') - call MPI_bcast(Nudge_Tcoef , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Tcoef') - call MPI_bcast(Nudge_Qcoef , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Qcoef') - call MPI_bcast(Nudge_PScoef , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_PScoef') - call MPI_bcast(Nudge_Uprof , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Uprof') - call MPI_bcast(Nudge_Vprof , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vprof') - call MPI_bcast(Nudge_Tprof , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Tprof') - call MPI_bcast(Nudge_Qprof , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Qprof') - call MPI_bcast(Nudge_PSprof , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_PSprof') - call MPI_bcast(Nudge_Beg_Year , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Year') - call MPI_bcast(Nudge_Beg_Month , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Month') - call MPI_bcast(Nudge_Beg_Day , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Day') - call MPI_bcast(Nudge_Beg_Sec , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Sec') - call MPI_bcast(Nudge_End_Year , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Year') - call MPI_bcast(Nudge_End_Month , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Month') - call MPI_bcast(Nudge_End_Day , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Day') - call MPI_bcast(Nudge_End_Sec , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Sec') - call MPI_bcast(Nudge_Hwin_lo , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lo') - call MPI_bcast(Nudge_Hwin_hi , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_hi') - call MPI_bcast(Nudge_Hwin_lat0 , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lat0') - call MPI_bcast(Nudge_Hwin_latWidth, 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latWidth') - call MPI_bcast(Nudge_Hwin_latDelta, 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latDelta') - call MPI_bcast(Nudge_Hwin_lon0 , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lon0') - call MPI_bcast(Nudge_Hwin_lonWidth, 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonWidth') - call MPI_bcast(Nudge_Hwin_lonDelta, 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonDelta') - call MPI_bcast(Nudge_Hwin_Invert, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_Invert') - call MPI_bcast(Nudge_Vwin_lo , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_lo') - call MPI_bcast(Nudge_Vwin_hi , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_hi') - call MPI_bcast(Nudge_Vwin_Hindex , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Hindex') - call MPI_bcast(Nudge_Vwin_Hdelta , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Hdelta') - call MPI_bcast(Nudge_Vwin_Lindex , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Lindex') - call MPI_bcast(Nudge_Vwin_Ldelta , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Ldelta') - call MPI_bcast(Nudge_Vwin_Invert, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Invert') - call MPI_bcast(Nudge_ZonalFilter, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ZonalFilter') - call MPI_bcast(Nudge_ZonalNbasis, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ZonalNbasis') + if((Nudge_Hwin_lon0 < 0._r8) .or. (Nudge_Hwin_lon0 >= 360._r8)) then + if (masterproc) then + write(iulog,*) 'NUDGING: Window lon0 must be in [0,+360)' + write(iulog,*) 'NUDGING: Nudge_Hwin_lon0=',Nudge_Hwin_lon0 + end if + call endrun(trim(subname)//' ERROR Windlow lon0 must be in [0,+360)') + endif + + 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 + if (masterproc) 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' + write(iulog,*) 'NUDGING: Nudge_Vwin_Lindex=',Nudge_Vwin_Lindex + write(iulog,*) 'NUDGING: Nudge_Vwin_Hindex=',Nudge_Vwin_Hindex + end if + call endrun(trim(subname)//' ERROR Window Lindex and Window Hindex must be in [0,pver+1]') + endif + + 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 + if (masterproc) 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 + write(iulog,*) 'NUDGING: Nudge_Vwin_Hdelta =',Nudge_Vwin_Hdelta + write(iulog,*) 'NUDGING: Nudge_Vwin_Ldelta =',Nudge_Vwin_Ldelta + end if + call endrun(trim(subname)//' ERROR Window Deltas must be positive') + endif + + if ((Nudge_Hwin_latWidth <= 0._r8) .or. (Nudge_Hwin_lonWidth <= 0._r8)) then + if (masterproc) 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 + end if + call endrun(trim(subname)//' ERROR Window widths must be positive') + endif - ! End Routine - !------------ + end if check_valid end subroutine nudging_readnl !================================================================ @@ -599,87 +616,58 @@ subroutine nudging_init use ppgrid ,only: pver,pcols,begchunk,endchunk use error_messages,only: alloc_err use dycore ,only: dycore_is - use dyn_grid ,only: get_horiz_grid_dim_d use phys_grid ,only: get_rlat_p,get_rlon_p,get_ncols_p use cam_history ,only: addfld use shr_const_mod ,only: SHR_CONST_PI - use filenames ,only: interpret_filename_spec ! 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 :: 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 - - character(len=*), parameter :: prefix = 'nudging_init: ' - - ! Get the time step size - !------------------------ - dtime = get_step_size() + type(ESMF_Time) :: curr_time + type(ESMF_Time) :: Model_Update_Current_Time + integer :: Year,Month,Day,Sec + logical :: After_Beg,Before_End + integer :: Model_Update_Step + integer :: lchnk,ncol,icol,ilev + integer :: istat, ierr, rc + 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, nf + integer :: size2d, size3d + character(len=*), parameter :: subname = "nudging_init: " + !---------------------------------------------------------- - ! Allocate Space for Nudging data arrays + ! Allocate Space !----------------------------------------- - allocate(Target_U(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Target_U',pcols*pver*((endchunk-begchunk)+1)) - allocate(Target_V(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Target_V',pcols*pver*((endchunk-begchunk)+1)) - allocate(Target_T(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Target_T',pcols*pver*((endchunk-begchunk)+1)) - allocate(Target_S(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Target_S',pcols*pver*((endchunk-begchunk)+1)) - allocate(Target_Q(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Target_Q',pcols*pver*((endchunk-begchunk)+1)) - allocate(Target_PS(pcols,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Target_PS',pcols*((endchunk-begchunk)+1)) - - allocate(Model_U(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Model_U',pcols*pver*((endchunk-begchunk)+1)) - allocate(Model_V(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Model_V',pcols*pver*((endchunk-begchunk)+1)) - allocate(Model_T(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Model_T',pcols*pver*((endchunk-begchunk)+1)) - allocate(Model_S(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Model_S',pcols*pver*((endchunk-begchunk)+1)) - allocate(Model_Q(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Model_Q',pcols*pver*((endchunk-begchunk)+1)) - 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 - ! Nudging Coefs and Nudging Forcing. - !------------------------------------------- - allocate(Nudge_Utau(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Utau',pcols*pver*((endchunk-begchunk)+1)) - allocate(Nudge_Vtau(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Vtau',pcols*pver*((endchunk-begchunk)+1)) - allocate(Nudge_Stau(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Stau',pcols*pver*((endchunk-begchunk)+1)) - allocate(Nudge_Qtau(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Qtau',pcols*pver*((endchunk-begchunk)+1)) - allocate(Nudge_PStau(pcols,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_PStau',pcols*((endchunk-begchunk)+1)) + + size3d = pcols*pver*((endchunk-begchunk)+1) + size2d = pcols*((endchunk-begchunk)+1) + + allocate(Nudge_Utau0(pcols,pver,begchunk:endchunk),stat=istat) + call alloc_err(istat,subname,'Nudge_Utau',size3d) + allocate(Nudge_Vtau0(pcols,pver,begchunk:endchunk),stat=istat) + call alloc_err(istat,subname,'Nudge_Vtau',size3d) + allocate(Nudge_Stau0(pcols,pver,begchunk:endchunk),stat=istat) + call alloc_err(istat,subname,'Nudge_Stau',size3d) + allocate(Nudge_Qtau0(pcols,pver,begchunk:endchunk),stat=istat) + call alloc_err(istat,subname,'Nudge_Qtau',size3d) + allocate(Nudge_PStau0(pcols,begchunk:endchunk),stat=istat) + call alloc_err(istat,subname,'Nudge_PStau0',size2d) allocate(Nudge_Ustep(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Ustep',pcols*pver*((endchunk-begchunk)+1)) + call alloc_err(istat,subname,'Nudge_Ustep',size3d) allocate(Nudge_Vstep(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Vstep',pcols*pver*((endchunk-begchunk)+1)) + call alloc_err(istat,subname,'Nudge_Vstep',size3d) allocate(Nudge_Sstep(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Sstep',pcols*pver*((endchunk-begchunk)+1)) + call alloc_err(istat,subname,'Nudge_Sstep',size3d) allocate(Nudge_Qstep(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Qstep',pcols*pver*((endchunk-begchunk)+1)) + call alloc_err(istat,subname,'Nudge_Qstep',size3d) allocate(Nudge_PSstep(pcols,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_PSstep',pcols*((endchunk-begchunk)+1)) + call alloc_err(istat,subname,'Nudge_PSstep',size2d) ! Register output fields with the cam history module !----------------------------------------------------- @@ -692,143 +680,111 @@ subroutine nudging_init call addfld('Target_T',(/ 'lev' /),'A','K' ,'T Nudging Target' ) call addfld('Target_Q',(/ 'lev' /),'A','kg/kg' ,'Q Nudging Target ') - !----------------------------------------- - ! Values initialized only by masterproc - !----------------------------------------- - if(masterproc) then + ! Set the Stepping intervals for Model and Nudging values + !-------------------------------------------------------- - ! Set the Stepping intervals for Model and Nudging values - ! Ensure that the Model_Step is not smaller then one timestep - ! and not larger then the Nudge_Step. - !-------------------------------------------------------- - Model_Step=86400/Model_Times_Per_Day - Nudge_Step=86400/Nudge_Times_Per_Day - 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 > 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 - write(iulog,*) ' ' - Model_Step=Nudge_Step - endif + ! Get the CAM time step size + dtime = get_step_size() + Model_Update_Step = 86400/Model_Update_Times_Per_Day + + if(Model_Update_Step < dtime) then + write(iulog,*) ' ' + write(iulog,*) 'NUDGING: Model_Update_Step cannot be less than a model timestep' + write(iulog,*) 'NUDGING: Setting Model_Update_Step=dtime , dtime=',dtime + write(iulog,*) ' ' + Model_Update_Step = dtime + endif - ! Initialize column and level dimensions - !-------------------------------------------------------- - call get_horiz_grid_dim_d(hdim1_d,hdim2_d) - Nudge_nlon=hdim1_d - Nudge_nlat=hdim2_d - Nudge_ncol=hdim1_d*hdim2_d - Nudge_nlev=pver - - ! Check the time relative to the nudging window - !------------------------------------------------ - 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, & - YMD ,Sec ,After_Beg) - YMD1=(Nudge_End_Year*10000) + (Nudge_End_Month*100) + Nudge_End_Day - 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 - ! timestep_init will initialize the data arrays. - !-------------------------------------------- - Model_Next_Year =Year - Model_Next_Month=Month - Model_Next_Day =Day - Model_Next_Sec =(Sec/Model_Step)*Model_Step - Nudge_Next_Year =Year - Nudge_Next_Month=Month - Nudge_Next_Day =Day - Nudge_Next_Sec =(Sec/Nudge_Step)*Nudge_Step - elseif(.not.After_Beg) then - ! Set Time indicies to Nudging start, - ! timestep_init will initialize the data arrays. - !-------------------------------------------- - Model_Next_Year =Nudge_Beg_Year - Model_Next_Month=Nudge_Beg_Month - Model_Next_Day =Nudge_Beg_Day - Model_Next_Sec =Nudge_Beg_Sec - Nudge_Next_Year =Nudge_Beg_Year - Nudge_Next_Month=Nudge_Beg_Month - Nudge_Next_Day =Nudge_Beg_Day - Nudge_Next_Sec =Nudge_Beg_Sec - elseif(.not.Before_End) then - ! Nudging will never occur, so switch it off - !-------------------------------------------- - Nudge_Model=.false. - Nudge_ON =.false. - write(iulog,*) ' ' - write(iulog,*) 'NUDGING: WARNING - Nudging has been requested by it will' - write(iulog,*) 'NUDGING: never occur for the given time values' - write(iulog,*) ' ' - endif + ! Set module time and time interval variables + !------------------------------------------------ + + call get_curr_date(Year, Month, Day, Sec) + call ESMF_TimeSet(curr_time, yy=Year, mm=Month, dd=Day, s=Sec, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + call ESMF_TimeSet(Nudge_beg_time, & + yy=Nudge_Beg_Year, mm=Nudge_Beg_Month, dd=Nudge_Beg_Day, s=Nudge_Beg_Sec, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + call ESMF_TimeSet(Nudge_end_time, & + yy=Nudge_End_Year, mm=Nudge_End_Month, dd=Nudge_End_Day, s=Nudge_End_Sec, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + call ESMF_TimeIntervalSet(Model_Update_Interval, s=Model_Update_Step, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + ! Initialize the time relative to the nudging window + !------------------------------------------------ + + After_Beg = (curr_time >= Nudge_beg_time) + Before_End = (curr_time <= Nudge_end_time) - ! Initialize values for window function - !---------------------------------------- - lonp= 180._r8 - lon0= 0._r8 - lonn=-180._r8 - 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 - - Val1_p=(1._r8+tanh((Nudge_Hwin_lonWidthH+lonp)/Nudge_Hwin_lonDelta))/2._r8 - Val2_p=(1._r8+tanh((Nudge_Hwin_lonWidthH-lonp)/Nudge_Hwin_lonDelta))/2._r8 - Val3_p=(1._r8+tanh((Nudge_Hwin_latWidthH+latp)/Nudge_Hwin_latDelta))/2._r8 - Val4_p=(1._r8+tanh((Nudge_Hwin_latWidthH-latp)/Nudge_Hwin_latDelta))/2_r8 - Val1_0=(1._r8+tanh((Nudge_Hwin_lonWidthH+lon0)/Nudge_Hwin_lonDelta))/2._r8 - Val2_0=(1._r8+tanh((Nudge_Hwin_lonWidthH-lon0)/Nudge_Hwin_lonDelta))/2._r8 - Val3_0=(1._r8+tanh((Nudge_Hwin_latWidthH+lat0)/Nudge_Hwin_latDelta))/2._r8 - Val4_0=(1._r8+tanh((Nudge_Hwin_latWidthH-lat0)/Nudge_Hwin_latDelta))/2._r8 - - Val1_n=(1._r8+tanh((Nudge_Hwin_lonWidthH+lonn)/Nudge_Hwin_lonDelta))/2._r8 - Val2_n=(1._r8+tanh((Nudge_Hwin_lonWidthH-lonn)/Nudge_Hwin_lonDelta))/2._r8 - Val3_n=(1._r8+tanh((Nudge_Hwin_latWidthH+latn)/Nudge_Hwin_latDelta))/2._r8 - 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), & + if ((After_Beg) .and. (Before_End)) then + + ! Set Time indicies so that the next call to timestep_init will initialize the Model_Update_Next_time + call ESMF_TimeSet(Model_Update_next_time, & + yy=Year, mm=Month, dd=Day, s=(Sec/Model_Update_Step)*Model_Update_Step, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + elseif (.not.After_Beg) then + + ! Set Time indicies to Nudging start so next call to timestep_init will initialize the Model_Update_Next_time + call ESMF_TimeSet(Model_Update_next_time, & + yy=Nudge_Beg_Year, mm=Nudge_Beg_Month, dd=Nudge_Beg_Day, s=Nudge_Beg_Sec, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + ! Still need to have nudge on so that streams can be initialized - but then it will be turned off + ! in nudging_timestep_init + + elseif (.not.Before_End) then + + ! Nudging will never occur, so switch it off + Nudge_Model = .false. + write(iulog,*) ' ' + write(iulog,*) 'NUDGING: WARNING - Nudging has been requested but it will' + write(iulog,*) 'NUDGING: never occur for the given time values' + write(iulog,*) ' ' + return + + endif + + ! Initialize values for window function + !---------------------------------------- + lonp = 180._r8 + lon0 = 0._r8 + lonn = -180._r8 + 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 + + Val1_p = (1._r8+tanh((Nudge_Hwin_lonWidthH+lonp)/Nudge_Hwin_lonDelta))/2._r8 + Val2_p = (1._r8+tanh((Nudge_Hwin_lonWidthH-lonp)/Nudge_Hwin_lonDelta))/2._r8 + Val3_p = (1._r8+tanh((Nudge_Hwin_latWidthH+latp)/Nudge_Hwin_latDelta))/2._r8 + Val4_p = (1._r8+tanh((Nudge_Hwin_latWidthH-latp)/Nudge_Hwin_latDelta))/2_r8 + + Val1_0 = (1._r8+tanh((Nudge_Hwin_lonWidthH+lon0)/Nudge_Hwin_lonDelta))/2._r8 + Val2_0 = (1._r8+tanh((Nudge_Hwin_lonWidthH-lon0)/Nudge_Hwin_lonDelta))/2._r8 + Val3_0 = (1._r8+tanh((Nudge_Hwin_latWidthH+lat0)/Nudge_Hwin_latDelta))/2._r8 + Val4_0 = (1._r8+tanh((Nudge_Hwin_latWidthH-lat0)/Nudge_Hwin_latDelta))/2._r8 + + Val1_n = (1._r8+tanh((Nudge_Hwin_lonWidthH+lonn)/Nudge_Hwin_lonDelta))/2._r8 + Val2_n = (1._r8+tanh((Nudge_Hwin_lonWidthH-lonn)/Nudge_Hwin_lonDelta))/2._r8 + Val3_n = (1._r8+tanh((Nudge_Hwin_latWidthH+latn)/Nudge_Hwin_latDelta))/2._r8 + 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), & (Val1_n*Val2_n*Val3_p*Val4_p)) - ! Initialize number of nudging observation values to keep track of. - ! Allocate and initialize observation indices - !----------------------------------------------------------------- - if((Nudge_Force_Opt >= 0) .and. (Nudge_Force_Opt <= 1)) then - Nudge_NumObs=2 - else - ! Additional Options may need OBS values at more times. - !------------------------------------------------------ - Nudge_NumObs=2 - write(iulog,*) 'NUDGING: Setting Nudge_NumObs=2' - write(iulog,*) 'NUDGING: WARNING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt - call endrun('NUDGING: Unknown Forcing Option') - endif - allocate(Nudge_ObsInd(Nudge_NumObs),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_ObsInd',Nudge_NumObs) - allocate(Nudge_File_Present(Nudge_NumObs),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_File_Present',Nudge_NumObs) - do nn=1,Nudge_NumObs - Nudge_ObsInd(nn) = Nudge_NumObs+1-nn - end do - Nudge_File_Present(:) = .false. + ! Initialization is done, + !-------------------------- + Nudge_Initialized = .true. - ! Initialization is done, - !-------------------------- - Nudge_Initialized = .true. + if (masterproc) then ! Informational Output !--------------------------- @@ -836,229 +792,105 @@ subroutine nudging_init write(iulog,*) '---------------------------------------------------------' write(iulog,*) ' MODEL NUDGING INITIALIZED WITH THE FOLLOWING SETTINGS: ' write(iulog,*) '---------------------------------------------------------' - 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_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 - write(iulog,*) 'NUDGING: Nudge_Step=',Nudge_Step - write(iulog,*) 'NUDGING: Model_Step=',Model_Step - write(iulog,*) 'NUDGING: Nudge_ZonalFilter=',Nudge_ZonalFilter - write(iulog,*) 'NUDGING: Nudge_ZonalNbasis=',Nudge_ZonalNbasis - write(iulog,*) 'NUDGING: Nudge_Ucoef =',Nudge_Ucoef - write(iulog,*) 'NUDGING: Nudge_Vcoef =',Nudge_Vcoef - write(iulog,*) 'NUDGING: Nudge_Qcoef =',Nudge_Qcoef - write(iulog,*) 'NUDGING: Nudge_Tcoef =',Nudge_Tcoef - write(iulog,*) 'NUDGING: Nudge_PScoef =',Nudge_PScoef - write(iulog,*) 'NUDGING: Nudge_Uprof =',Nudge_Uprof - write(iulog,*) 'NUDGING: Nudge_Vprof =',Nudge_Vprof - write(iulog,*) 'NUDGING: Nudge_Qprof =',Nudge_Qprof - write(iulog,*) 'NUDGING: Nudge_Tprof =',Nudge_Tprof - write(iulog,*) 'NUDGING: Nudge_PSprof =',Nudge_PSprof - write(iulog,*) 'NUDGING: Nudge_Beg_Year =',Nudge_Beg_Year - write(iulog,*) 'NUDGING: Nudge_Beg_Month=',Nudge_Beg_Month - write(iulog,*) 'NUDGING: Nudge_Beg_Day =',Nudge_Beg_Day - write(iulog,*) 'NUDGING: Nudge_End_Year =',Nudge_End_Year - write(iulog,*) 'NUDGING: Nudge_End_Month=',Nudge_End_Month - write(iulog,*) 'NUDGING: Nudge_End_Day =',Nudge_End_Day - write(iulog,*) 'NUDGING: Nudge_Hwin_lat0 =',Nudge_Hwin_lat0 - write(iulog,*) 'NUDGING: Nudge_Hwin_latWidth =',Nudge_Hwin_latWidth - write(iulog,*) 'NUDGING: Nudge_Hwin_latDelta =',Nudge_Hwin_latDelta - 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_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_lo =',Nudge_Vwin_lo - write(iulog,*) 'NUDGING: Nudge_Vwin_hi =',Nudge_Vwin_hi - write(iulog,*) 'NUDGING: Nudge_Hwin_latWidthH=',Nudge_Hwin_latWidthH - write(iulog,*) 'NUDGING: Nudge_Hwin_lonWidthH=',Nudge_Hwin_lonWidthH - write(iulog,*) 'NUDGING: Nudge_Hwin_max =',Nudge_Hwin_max - write(iulog,*) 'NUDGING: Nudge_Hwin_min =',Nudge_Hwin_min - write(iulog,*) 'NUDGING: Nudge_Initialized =',Nudge_Initialized - write(iulog,*) ' ' - write(iulog,*) 'NUDGING: Nudge_NumObs=',Nudge_NumObs + write(iulog,'(a,l4)') 'NUDGING: Nudge_Model = ',Nudge_Model + write(iulog,'(2a)' ) 'NUDGING: Nudge_Datapath = ',trim(Nudge_Datapath) + write(iulog,'(2a)' ) 'NUDGING: Nudge_Meshfile = ',trim(Nudge_Meshfile) + write(iulog,'(a,i8)') 'NUDGING: Nudge_Data_Year_First = ',Nudge_Data_Year_First + write(iulog,'(a,i8)') 'NUDGING: Nudge_Data_Year_Last = ',Nudge_Data_Year_Last + write(iulog,'(a,i8)') 'NUDGING: Nudge_Data_Year_Align = ',Nudge_Data_Year_Align + write(iulog,'(2a)' ) 'NUDGING: Nudge_Data_Mapalgo = ',trim(Nudge_Data_Mapalgo) + write(iulog,'(2a)' ) 'NUDGING: Nudge_Data_Tintalgo = ',trim(Nudge_Data_Tintalgo) + write(iulog,'(2a)' ) 'NUDGING: Nudge_Data_Taxmode = ',trim(Nudge_Data_Taxmode) + write(iulog,'(2a)' ) 'NUDGING: Nudge_Levname = ',trim(Nudge_Data_Levname) + do nf = 1,maxfiles + if (trim(Nudge_Filenames(nf)) /= 'unset') then + write(iulog,'(a,a)')'NUDGING: Nudge_Datapath = ',trim(Nudge_Datapath) + end if + end do + ! Model time + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_Beg_Year = ',Nudge_Beg_Year + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_Beg_Month = ',Nudge_Beg_Month + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_Beg_Day = ',Nudge_Beg_Day + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_End_Year = ',Nudge_End_Year + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_End_Month = ',Nudge_End_Month + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_End_Day = ',Nudge_End_Day + write(iulog,'(a,i8)' ) 'NUDGING: Model_Update_Times_Per_Day = ',Model_Update_Times_Per_Day + write(iulog,'(a,i8)' ) 'NUDGING: Model_Update_Step = ',Model_Update_Step + ! + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_PSprof = ',Nudge_PSprof + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_Force_Opt = ',Nudge_Force_Opt + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_TimeScale_Opt = ',Nudge_TimeScale_Opt + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_TSmode = ',Nudge_TSmode + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_ZonalFilter = ',Nudge_ZonalFilter + write(iulog,'(a,i8)' ) 'NUDGING: Nudge_ZonalNbasis = ',Nudge_ZonalNbasis + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Ucoef = ',Nudge_Ucoef + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Vcoef = ',Nudge_Vcoef + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Qcoef = ',Nudge_Qcoef + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Tcoef = ',Nudge_Tcoef + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_PScoef = ',Nudge_PScoef + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Uprof = ',Nudge_Uprof + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Vprof = ',Nudge_Vprof + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Qprof = ',Nudge_Qprof + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Tprof = ',Nudge_Tprof + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_lat0 = ',Nudge_Hwin_lat0 + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_latWidth = ',Nudge_Hwin_latWidth + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_latDelta = ',Nudge_Hwin_latDelta + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_lon0 = ',Nudge_Hwin_lon0 + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_lonWidth = ',Nudge_Hwin_lonWidth + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_lonDelta = ',Nudge_Hwin_lonDelta + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_Invert = ',Nudge_Hwin_Invert + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_lo = ',Nudge_Hwin_lo + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_hi = ',Nudge_Hwin_hi + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Vwin_Hindex = ',Nudge_Vwin_Hindex + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Vwin_Hdelta = ',Nudge_Vwin_Hdelta + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Vwin_Lindex = ',Nudge_Vwin_Lindex + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Vwin_Ldelta = ',Nudge_Vwin_Ldelta + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Vwin_Invert = ',Nudge_Vwin_Invert + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Vwin_lo = ',Nudge_Vwin_lo + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Vwin_hi = ',Nudge_Vwin_hi + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_latWidthH = ',Nudge_Hwin_latWidthH + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_lonWidthH = ',Nudge_Hwin_lonWidthH + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_max = ',Nudge_Hwin_max + write(iulog,'(a,f13.5)' ) 'NUDGING: Nudge_Hwin_min = ',Nudge_Hwin_min + write(iulog,'(a,l4)' ) 'NUDGING: Nudge_Initialized = ',Nudge_Initialized write(iulog,*) ' ' endif ! (masterproc) then - ! Broadcast other variables that have changed - !--------------------------------------------- - call MPI_bcast(Model_Step , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Step') - call MPI_bcast(Nudge_Step , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Step') - call MPI_bcast(Model_Next_Year , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Next_Year') - call MPI_bcast(Model_Next_Month , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Next_Month') - call MPI_bcast(Model_Next_Day , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Next_Day') - call MPI_bcast(Model_Next_Sec , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Next_Sec') - call MPI_bcast(Nudge_Next_Year , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Next_Year') - call MPI_bcast(Nudge_Next_Month , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Next_Month') - call MPI_bcast(Nudge_Next_Day , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Next_Day') - call MPI_bcast(Nudge_Next_Sec , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Next_Sec') - call MPI_bcast(Nudge_Model , 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Model') - call MPI_bcast(Nudge_ON , 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ON') - call MPI_bcast(Nudge_Initialized , 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Initialized') - call MPI_bcast(Nudge_ncol , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ncol') - call MPI_bcast(Nudge_nlev , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_nlev') - call MPI_bcast(Nudge_nlon , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_nlon') - call MPI_bcast(Nudge_nlat , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_nlat') - call MPI_bcast(Nudge_Hwin_max , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_max') - call MPI_bcast(Nudge_Hwin_min , 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_min') - call MPI_bcast(Nudge_Hwin_lonWidthH, 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonWidthH') - call MPI_bcast(Nudge_Hwin_latWidthH, 1, mpi_real8 , mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latWidthH') - call MPI_bcast(Nudge_NumObs , 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_NumObs') - - ! All non-masterproc processes also need to allocate space - ! before the broadcast of Nudge_NumObs dependent data. - !------------------------------------------------------------ - if(.not.masterproc) then - allocate(Nudge_ObsInd(Nudge_NumObs),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_ObsInd',Nudge_NumObs) - allocate(Nudge_File_Present(Nudge_NumObs),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_File_Present',Nudge_NumObs) - endif - - call MPI_bcast(Nudge_ObsInd , Nudge_NumObs, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: ') - call MPI_bcast(Nudge_File_Present, Nudge_NumObs, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: ') - - ! Allocate Space for Nudging observation arrays, initialize with 0's - !--------------------------------------------------------------------- - allocate(Nobs_U(pcols,pver,begchunk:endchunk,Nudge_NumObs),stat=istat) - call alloc_err(istat,'nudging_init','Nobs_U',pcols*pver*((endchunk-begchunk)+1)*Nudge_NumObs) - allocate(Nobs_V(pcols,pver,begchunk:endchunk,Nudge_NumObs),stat=istat) - call alloc_err(istat,'nudging_init','Nobs_V',pcols*pver*((endchunk-begchunk)+1)*Nudge_NumObs) - allocate(Nobs_T(pcols,pver,begchunk:endchunk,Nudge_NumObs),stat=istat) - call alloc_err(istat,'nudging_init','Nobs_T',pcols*pver*((endchunk-begchunk)+1)*Nudge_NumObs) - allocate(Nobs_Q(pcols,pver,begchunk:endchunk,Nudge_NumObs),stat=istat) - call alloc_err(istat,'nudging_init','Nobs_Q',pcols*pver*((endchunk-begchunk)+1)*Nudge_NumObs) - allocate(Nobs_PS(pcols,begchunk:endchunk,Nudge_NumObs),stat=istat) - call alloc_err(istat,'nudging_init','Nobs_PS',pcols*((endchunk-begchunk)+1)*Nudge_NumObs) - - Nobs_U(:pcols,:pver,begchunk:endchunk,:Nudge_NumObs)=0._r8 - Nobs_V(:pcols,:pver,begchunk:endchunk,:Nudge_NumObs)=0._r8 - Nobs_T(:pcols,:pver,begchunk:endchunk,:Nudge_NumObs)=0._r8 - Nobs_Q(:pcols,:pver,begchunk:endchunk,:Nudge_NumObs)=0._r8 - Nobs_PS(:pcols ,begchunk:endchunk,:Nudge_NumObs)=0._r8 - -!!DIAG - if(masterproc) then - write(iulog,*) 'NUDGING: nudging_init() OBS arrays allocated and initialized' - write(iulog,*) 'NUDGING: nudging_init() SIZE#',(9*pcols*pver*((endchunk-begchunk)+1)*Nudge_NumObs) - write(iulog,*) 'NUDGING: nudging_init() MB:',float(8*9*pcols*pver*((endchunk-begchunk)+1)*Nudge_NumObs)/(1024._r8*1024._r8) - write(iulog,*) 'NUDGING: nudging_init() pcols=',pcols,' pver=',pver - write(iulog,*) 'NUDGING: nudging_init() begchunk:',begchunk,' endchunk=',endchunk - write(iulog,*) 'NUDGING: nudging_init() chunk:',(endchunk-begchunk+1),' Nudge_NumObs=',Nudge_NumObs - write(iulog,*) 'NUDGING: nudging_init() Nudge_ObsInd=',Nudge_ObsInd - write(iulog,*) 'NUDGING: nudging_init() Nudge_File_Present=',Nudge_File_Present - endif -!!DIAG - ! Initialize the Zonal Mean type if needed !------------------------------------------ - if(Nudge_ZonalFilter) then + if (Nudge_ZonalFilter) then call ZM%init(Nudge_ZonalNbasis) + allocate(Zonal_Bamp2d(Nudge_ZonalNbasis),stat=istat) - call alloc_err(istat,'nudging_init','Zonal_Bamp2d',Nudge_ZonalNbasis) - allocate(Zonal_Bamp3d(Nudge_ZonalNbasis,pver),stat=istat) - call alloc_err(istat,'nudging_init','Zonal_Bamp3d',Nudge_ZonalNbasis*pver) - endif + call alloc_err(istat,subname,'Zonal_Bamp2d',Nudge_ZonalNbasis) - ! Initialize the analysis filename at the NEXT time for startup. - !--------------------------------------------------------------- - Nudge_File=interpret_filename_spec(Nudge_File_Template , & - yr_spec=Nudge_Next_Year , & - mon_spec=Nudge_Next_Month, & - day_spec=Nudge_Next_Day , & - sec_spec=Nudge_Next_Sec ) - if(masterproc) then - write(iulog,*) 'NUDGING: Reading analyses:',trim(Nudge_Path)//trim(Nudge_File) + allocate(Zonal_Bamp3d(Nudge_ZonalNbasis,pver),stat=istat) + call alloc_err(istat,subname,'Zonal_Bamp3d',Nudge_ZonalNbasis*pver) endif - ! Rotate Nudge_ObsInd() indices for new data, then update - ! the Nudge observation arrays with analysis data at the - ! NEXT==Nudge_ObsInd(1) time. - !---------------------------------------------------------- - call nudging_update_analyses (trim(Nudge_Path)//trim(Nudge_File)) - ! Initialize Nudging Coeffcient profiles in local arrays ! Load zeros into nudging arrays !------------------------------------------------------ - do lchnk=begchunk,endchunk - ncol=get_ncols_p(lchnk) - do icol=1,ncol - rlat=get_rlat_p(lchnk,icol)*180._r8/SHR_CONST_PI - rlon=get_rlon_p(lchnk,icol)*180._r8/SHR_CONST_PI - - call nudging_set_profile(rlat,rlon,Nudge_Uprof,Wprof,pver) - Nudge_Utau(icol,:,lchnk)=Wprof(:) - call nudging_set_profile(rlat,rlon,Nudge_Vprof,Wprof,pver) - Nudge_Vtau(icol,:,lchnk)=Wprof(:) - call nudging_set_profile(rlat,rlon,Nudge_Tprof,Wprof,pver) - Nudge_Stau(icol,:,lchnk)=Wprof(:) - call nudging_set_profile(rlat,rlon,Nudge_Qprof,Wprof,pver) - Nudge_Qtau(icol,:,lchnk)=Wprof(:) - - Nudge_PStau(icol,lchnk)=nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) + do lchnk = begchunk,endchunk + + ncol = get_ncols_p(lchnk) + do icol = 1,ncol + rlat = get_rlat_p(lchnk,icol)*180._r8/SHR_CONST_PI + rlon = get_rlon_p(lchnk,icol)*180._r8/SHR_CONST_PI + + call nudging_set_profile(rlat, rlon, Nudge_Uprof, Wprof, pver) + Nudge_Utau0(icol,:,lchnk) = Wprof(:) + call nudging_set_profile(rlat, rlon, Nudge_Vprof, Wprof, pver) + Nudge_Vtau0(icol,:,lchnk) = Wprof(:) + call nudging_set_profile(rlat, rlon, Nudge_Tprof, Wprof, pver) + Nudge_Stau0(icol,:,lchnk) = Wprof(:) + call nudging_set_profile(rlat, rlon, Nudge_Qprof, Wprof, pver) + Nudge_Qtau0(icol,:,lchnk) = Wprof(:) + Nudge_PStau0(icol,lchnk) = nudging_set_PSprofile(rlat, rlon, Nudge_PSprof) end do - Nudge_Utau(:ncol,:pver,lchnk) = & - Nudge_Utau(:ncol,:pver,lchnk) * Nudge_Ucoef/float(Nudge_Step) - Nudge_Vtau(:ncol,:pver,lchnk) = & - Nudge_Vtau(:ncol,:pver,lchnk) * Nudge_Vcoef/float(Nudge_Step) - Nudge_Stau(:ncol,:pver,lchnk) = & - Nudge_Stau(:ncol,:pver,lchnk) * Nudge_Tcoef/float(Nudge_Step) - Nudge_Qtau(:ncol,:pver,lchnk) = & - Nudge_Qtau(:ncol,:pver,lchnk) * Nudge_Qcoef/float(Nudge_Step) - Nudge_PStau(:ncol,lchnk)= & - Nudge_PStau(:ncol,lchnk)* Nudge_PScoef/float(Nudge_Step) - - Nudge_Ustep(:pcols,:pver,lchnk)=0._r8 - Nudge_Vstep(:pcols,:pver,lchnk)=0._r8 - Nudge_Sstep(:pcols,:pver,lchnk)=0._r8 - Nudge_Qstep(:pcols,:pver,lchnk)=0._r8 - Nudge_PSstep(:pcols,lchnk)=0._r8 - Target_U(:pcols,:pver,lchnk)=0._r8 - Target_V(:pcols,:pver,lchnk)=0._r8 - Target_T(:pcols,:pver,lchnk)=0._r8 - Target_S(:pcols,:pver,lchnk)=0._r8 - Target_Q(:pcols,:pver,lchnk)=0._r8 - Target_PS(:pcols,lchnk)=0._r8 end do - ! End Routine - !------------ - end subroutine nudging_init !================================================================ @@ -1067,357 +899,261 @@ end subroutine nudging_init subroutine nudging_timestep_init(phys_state) ! ! 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. + ! Check the current time and update Model/Nudging + ! arrays when necessary. Toggle the Nudging flag + ! when the time is withing the nudging window. !=============================================================== + use physconst ,only: cpair use physics_types,only: physics_state use constituents ,only: cnst_get_ind - use dycore ,only: dycore_is use ppgrid ,only: pver,pcols,begchunk,endchunk - use filenames ,only: interpret_filename_spec - use ESMF + use cam_history ,only: outfld + use shr_cal_mod ,only: shr_cal_timeSet ! Arguments !----------- - type(physics_state),intent(in):: phys_state(begchunk:endchunk) + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) ! 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 :: Year, Month, Day, Sec + logical :: Update_Model, Sync_Error + logical :: After_Beg, Before_End + integer :: lchnk,ncol,indw + type(ESMF_Time) :: curr_time + type(ESMF_Time) :: time_data_LB ! data lb time + type(ESMF_Time) :: time_data_ub ! data ub time + type(ESMF_Time) :: time_model ! will have same calendar as input data + type(ESMF_TimeInterval) :: timeint_file ! time_data_ub - time_data_lb + type(ESMF_TimeInterval) :: timeint_nudge ! time_data_ub - time_model + real(r8) :: inv_nudge_file_step + real(r8) :: Model_U(pcols,pver,begchunk:endchunk) + real(r8) :: Model_V(pcols,pver,begchunk:endchunk) + real(r8) :: Model_T(pcols,pver,begchunk:endchunk) + real(r8) :: Model_S(pcols,pver,begchunk:endchunk) + real(r8) :: Model_Q(pcols,pver,begchunk:endchunk) + real(r8) :: Model_PS(pcols,begchunk:endchunk) + real(r8) :: Nudge_Utau(pcols,pver,begchunk:endchunk) + real(r8) :: Nudge_Vtau(pcols,pver,begchunk:endchunk) + real(r8) :: Nudge_Stau(pcols,pver,begchunk:endchunk) + real(r8) :: Nudge_Qtau(pcols,pver,begchunk:endchunk) + real(r8) :: Nudge_PStau(pcols,begchunk:endchunk) + real(r8) :: Target_U(pcols,pver,begchunk:endchunk) + real(r8) :: Target_V(pcols,pver,begchunk:endchunk) + real(r8) :: Target_T(pcols,pver,begchunk:endchunk) + real(r8) :: Target_S(pcols,pver,begchunk:endchunk) + real(r8) :: Target_Q(pcols,pver,begchunk:endchunk) + real(r8) :: Target_PS(pcols,begchunk:endchunk) + character(CS) :: calendar ! calendar name + integer :: mcdate ! current model date (yyyymmdd) + integer :: Nudge_File_Step integer :: DeltaT real(r8) :: Tscale - real(r8) :: Tfrac integer :: rc - integer :: nn - integer :: kk - real(r8) :: Sbar,Qbar,Wsum - integer :: dtime + character(len=*), parameter :: sub = "(nudging_timestep_init) " + !-------------------------------------------------------------- ! Check if Nudging is initialized !--------------------------------- - if(.not.Nudge_Initialized) then + if (.not.Nudge_Initialized) then call endrun('nudging_timestep_init:: Nudging NOT Initialized') endif - ! Get time step size - !-------------------- - dtime = get_step_size() - - ! Get Current time - !-------------------- - call get_curr_date(Year,Month,Day,Sec) - YMD=(Year*10000) + (Month*100) + Day - !------------------------------------------------------- - ! Determine if the current time is AFTER the begining time - ! and if it is BEFORE the ending time. - !------------------------------------------------------- - YMD1=(Nudge_Beg_Year*10000) + (Nudge_Beg_Month*100) + Nudge_Beg_Day - 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, & - YMD1,Nudge_End_Sec,Before_End) + ! Determine if the current CAM time is AFTER the begining nudging time + ! and if it is BEFORE the ending nudging time. + ! Toggle Nudging flag when the time interval is between + ! beginning and ending times, and all of the analyses files exist. + ! When past the NEXT nudge time, update model + !---------------------------------------------------------------- - !-------------------------------------------------------------- - ! When past the NEXT time, Update Model Arrays and time indices - !-------------------------------------------------------------- - YMD1=(Model_Next_Year*10000) + (Model_Next_Month*100) + Model_Next_Day - call timemgr_time_ge(YMD1,Model_Next_Sec, & - YMD ,Sec ,Update_Model) + ! Get Current CAM time + call get_curr_date(Year,Month,Day,Sec) + mcdate = year*10000 + month*100 + day + call ESMF_TimeSet(curr_time, yy=Year, mm=Month, dd=Day, s=Sec, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + After_Beg = (curr_time >= Nudge_beg_time) + Before_End = (curr_time <= Nudge_end_time) + Nudge_On = (After_Beg .and. Before_End) + Update_Model = (Nudge_on .and. (curr_time >= Model_Update_Next_Time)) + if (masterproc) then + write(iulog,'(a,4(i6,2x),l8)')' Nudge Status: year, month, day, sec, update_model = ',& + year, month, day, sec, update_model + end if - if((Before_End) .and. (Update_Model)) then - ! Increment the Model times by the current interval - !--------------------------------------------------- - Model_Curr_Year =Model_Next_Year - Model_Curr_Month=Model_Next_Month - Model_Curr_Day =Model_Next_Day - Model_Curr_Sec =Model_Next_Sec - YMD1=(Model_Curr_Year*10000) + (Model_Curr_Month*100) + Model_Curr_Day - call timemgr_time_inc(YMD1,Model_Curr_Sec, & - YMD2,Model_Next_Sec,Model_Step,0,0) + if (Update_Model) then - ! Check for Sync Error where NEXT model time after the update - ! 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, & - YMD ,Sec ,Sync_Error) - if(Sync_Error) then - Model_Curr_Year =Year - Model_Curr_Month=Month - Model_Curr_Day =Day - Model_Curr_Sec =Sec - call timemgr_time_inc(YMD ,Model_Curr_Sec, & - YMD2,Model_Next_Sec,Model_Step,0,0) - write(iulog,*) 'NUDGING: WARNING - Model_Time Sync ERROR... CORRECTED' - endif - Model_Next_Year =(YMD2/10000) - YMD2 = YMD2-(Model_Next_Year*10000) - Model_Next_Month=(YMD2/100) - Model_Next_Day = YMD2-(Model_Next_Month*100) + ! Initialize nudging stream data type + ! NOTE: this must be done once the ESMF mesh for the model is + ! actually created - so it cannot be called out of nudging_init + ! since that occurs before the creation of the model mesh + !---------------------------------------------------------- + if (.not. stream_initialized) then + call nudging_stream_init() + end if ! Load values at Current into the Model arrays !----------------------------------------------- call cnst_get_ind('Q',indw) - do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol - Model_U(:ncol,:pver,lchnk)=phys_state(lchnk)%u(:ncol,:pver) - Model_V(:ncol,:pver,lchnk)=phys_state(lchnk)%v(:ncol,:pver) - Model_T(:ncol,:pver,lchnk)=phys_state(lchnk)%t(:ncol,:pver) - Model_Q(:ncol,:pver,lchnk)=phys_state(lchnk)%q(:ncol,:pver,indw) - Model_PS(:ncol,lchnk)=phys_state(lchnk)%ps(:ncol) + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + Model_U(:ncol,:pver,lchnk) = phys_state(lchnk)%u(:ncol,:pver) + Model_V(:ncol,:pver,lchnk) = phys_state(lchnk)%v(:ncol,:pver) + Model_T(:ncol,:pver,lchnk) = phys_state(lchnk)%t(:ncol,:pver) + Model_Q(:ncol,:pver,lchnk) = phys_state(lchnk)%q(:ncol,:pver,indw) + Model_PS(:ncol,lchnk) = phys_state(lchnk)%ps(:ncol) end do ! Load Dry Static Energy values for Model !----------------------------------------- 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) + ! Calculate DSE 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 == 1) then - ! Caluculate DSE tendencies from Temperature, Water Vapor, and Surface Pressure - !------------------------------------------------------------------------------ - do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol + ! Calculate DSE from Temperature, Water Vapor, and Surface Pressure + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol call calc_DryStaticEnergy(Model_T(:,:,lchnk) , Model_Q(:,:,lchnk), & - phys_state(lchnk)%phis, Model_PS(:,lchnk), & - Model_S(:,:,lchnk), ncol) + phys_state(lchnk)%phis, Model_PS(:,lchnk), Model_S(:,:,lchnk), ncol) end do endif ! Optionally: Apply Zonal Filtering to Model state data !------------------------------------------------------- - if(Nudge_ZonalFilter) then - call ZM%calc_amps(Model_U,Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d,Model_U) + if (Nudge_ZonalFilter) then + call ZM%calc_amps(Model_U,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_U) - call ZM%calc_amps(Model_V,Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d,Model_V) + call ZM%calc_amps(Model_V,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_V) - call ZM%calc_amps(Model_T,Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d,Model_T) + call ZM%calc_amps(Model_T,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_T) - call ZM%calc_amps(Model_S,Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d,Model_S) + call ZM%calc_amps(Model_S,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_S) - call ZM%calc_amps(Model_Q,Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d,Model_Q) + call ZM%calc_amps(Model_Q,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_Q) - call ZM%calc_amps(Model_PS,Zonal_Bamp2d) - call ZM%eval_grid(Zonal_Bamp2d,Model_PS) + call ZM%calc_amps(Model_PS,Zonal_Bamp2d) + call ZM%eval_grid(Zonal_Bamp2d,Model_PS) endif - endif ! ((Before_End) .and. (Update_Model)) then - !---------------------------------------------------------------- - ! When past the NEXT time, Update Nudging Arrays and time indices - !---------------------------------------------------------------- - YMD1=(Nudge_Next_Year*10000) + (Nudge_Next_Month*100) + Nudge_Next_Day - call timemgr_time_ge(YMD1,Nudge_Next_Sec, & - YMD ,Sec ,Update_Nudge) + !------------------------------------------------------- + ! HERE Implement time dependence of Nudging Coefs HERE + !------------------------------------------------------- - if((Before_End) .and. (Update_Nudge)) then - ! Increment the Nudge times by the current interval + ! Using CDEPS: + ! Read new nudging data and interpolate to model grid and Model_Update_Time !--------------------------------------------------- - Nudge_Curr_Year =Nudge_Next_Year - Nudge_Curr_Month=Nudge_Next_Month - Nudge_Curr_Day =Nudge_Next_Day - Nudge_Curr_Sec =Nudge_Next_Sec - YMD1=(Nudge_Curr_Year*10000) + (Nudge_Curr_Month*100) + Nudge_Curr_Day - call timemgr_time_inc(YMD1,Nudge_Curr_Sec, & - YMD2,Nudge_Next_Sec,Nudge_Step,0,0) - Nudge_Next_Year =(YMD2/10000) - YMD2 = YMD2-(Nudge_Next_Year*10000) - Nudge_Next_Month=(YMD2/100) - Nudge_Next_Day = YMD2-(Nudge_Next_Month*100) - - ! Set the analysis filename at the NEXT time. - !--------------------------------------------------------------- - Nudge_File=interpret_filename_spec(Nudge_File_Template , & - yr_spec=Nudge_Next_Year , & - mon_spec=Nudge_Next_Month, & - day_spec=Nudge_Next_Day , & - sec_spec=Nudge_Next_Sec ) - if(masterproc) then - 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 - ! NEXT==Nudge_ObsInd(1) time. - !---------------------------------------------------------- - 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 - ! beginning and ending times, and all of the analyses files exist. - !---------------------------------------------------------------- - 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 == 1) then - ! Verify that the CURR and NEXT analyses are available - !----------------------------------------------------- - Nudge_ON=(Nudge_File_Present(Nudge_ObsInd(1)) .and. & - Nudge_File_Present(Nudge_ObsInd(2)) ) - else - ! Verify that the ALL analyses are available - !--------------------------------------------- - Nudge_ON=.true. - do nn=1,Nudge_NumObs - if(.not.Nudge_File_Present(nn)) Nudge_ON=.false. - end do - endif - if(.not.Nudge_ON) then - if(masterproc) then - write(iulog,*) 'NUDGING: WARNING - analyses file NOT FOUND. Switching ' - write(iulog,*) 'NUDGING: nudging OFF to coast thru the gap. ' - endif - endif - else - Nudge_ON=.false. - endif - - !------------------------------------------------------- - ! HERE Implement time dependence of Nudging Coefs HERE - !------------------------------------------------------- + call nudging_stream_interp(Target_U, Target_V, Target_T, Target_Q, Target_PS) - - !--------------------------------------------------- - ! If Data arrays have changed update stepping arrays - !--------------------------------------------------- - if((Before_End) .and. ((Update_Nudge) .or. (Update_Model))) then - - ! Now Load the Target values for nudging tendencies - !--------------------------------------------------- - if(Nudge_Force_Opt == 0) then - ! Target is OBS data at NEXT time - !---------------------------------- - do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol - Target_U(:ncol,:pver,lchnk)=Nobs_U(:ncol,:pver,lchnk,Nudge_ObsInd(1)) - Target_V(:ncol,:pver,lchnk)=Nobs_V(:ncol,:pver,lchnk,Nudge_ObsInd(1)) - Target_T(:ncol,:pver,lchnk)=Nobs_T(:ncol,:pver,lchnk,Nudge_ObsInd(1)) - 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 == 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, & - DD=Nudge_Next_Day , S=Nudge_Next_Sec ) - DateDiff =Date2-Date1 - call ESMF_TimeIntervalGet(DateDiff,S=DeltaT,rc=rc) - Tfrac= float(DeltaT)/float(Nudge_Step) - do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol - Target_U(:ncol,:pver,lchnk)=(1._r8-Tfrac)*Nobs_U(:ncol,:pver,lchnk,Nudge_ObsInd(1)) & - +Tfrac *Nobs_U(:ncol,:pver,lchnk,Nudge_ObsInd(2)) - Target_V(:ncol,:pver,lchnk)=(1._r8-Tfrac)*Nobs_V(:ncol,:pver,lchnk,Nudge_ObsInd(1)) & - +Tfrac *Nobs_V(:ncol,:pver,lchnk,Nudge_ObsInd(2)) - Target_T(:ncol,:pver,lchnk)=(1._r8-Tfrac)*Nobs_T(:ncol,:pver,lchnk,Nudge_ObsInd(1)) & - +Tfrac *Nobs_T(:ncol,:pver,lchnk,Nudge_ObsInd(2)) - Target_Q(:ncol,:pver,lchnk)=(1._r8-Tfrac)*Nobs_Q(:ncol,:pver,lchnk,Nudge_ObsInd(1)) & - +Tfrac *Nobs_Q(:ncol,:pver,lchnk,Nudge_ObsInd(2)) - Target_PS(:ncol ,lchnk)=(1._r8-Tfrac)*Nobs_PS(:ncol ,lchnk,Nudge_ObsInd(1)) & - +Tfrac *Nobs_PS(:ncol ,lchnk,Nudge_ObsInd(2)) - end do - else - write(iulog,*) 'NUDGING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt - call endrun('nudging_timestep_init:: ERROR unknown Nudging_Force_Opt') - endif + do lchnk = begchunk,endchunk + call outfld('Target_U',Target_U(:,:,lchnk),pcols,lchnk) + call outfld('Target_V',Target_V(:,:,lchnk),pcols,lchnk) + call outfld('Target_T',Target_T(:,:,lchnk),pcols,lchnk) + call outfld('Target_Q',Target_Q(:,:,lchnk),pcols,lchnk) + end do ! Now load Dry Static Energy values for Target !--------------------------------------------- - 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 == 1) then - ! Caluculate DSE tendencies from Temperature, Water Vapor, and Surface Pressure - !------------------------------------------------------------------------------ - do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol - call calc_DryStaticEnergy(Target_T(:,:,lchnk), Target_Q(:,:,lchnk), & - phys_state(lchnk)%phis, Target_PS(:,lchnk), & - Target_S(:,:,lchnk), ncol) + if (Nudge_TSmode == 0) then + ! Calculate DSE 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 + else if(Nudge_TSmode == 1) then + ! Calculate DSE from Temperature, Water Vapor, and Surface Pressure + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + call calc_DryStaticEnergy(Target_T(:,:,lchnk), Target_Q(:,:,lchnk), & + phys_state(lchnk)%phis, Target_PS(:,lchnk), Target_S(:,:,lchnk), ncol) + end do endif + ! Determine Nudge_File_Step + call get_calendar(sdat_nudging_multi, year, month, day, calendar) + call shr_cal_timeSet(time_data_lb, & + sdat_nudging_multi%pstrm(1)%ymdLB, sdat_nudging_multi%pstrm(1)%todLB, calendar, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + call shr_cal_timeSet(time_data_ub, & + sdat_nudging_multi%pstrm(1)%ymdUB, sdat_nudging_multi%pstrm(1)%todUB, calendar, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + timeint_file = time_data_ub - time_data_lb + call ESMF_TimeIntervalGet(timeint_file, s=Nudge_File_Step) + call chkrc(rc,__LINE__,u_FILE_u) + + ! Determine deltaT + call shr_cal_timeset(time_model, mcdate, sec, calendar, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + timeint_nudge = time_data_ub - time_model + call ESMF_TimeIntervalGet(timeint_nudge, s=DeltaT) + call chkrc(rc,__LINE__,u_FILE_u) + + if (masterproc) then + write(iulog,*)'Nudging: sdat%ymdLB, sdat%todLB ',& + sdat_nudging_multi%pstrm(1)%ymdLB,sdat_nudging_multi%pstrm(1)%todLB + write(iulog,*)'Nudging: sdat%ymdUB, sdat%todUB ',& + sdat_nudging_multi%pstrm(1)%ymdUB,sdat_nudging_multi%pstrm(1)%todUB + end if + ! Set Tscale for the specified Forcing Option !----------------------------------------------- if(Nudge_TimeScale_Opt == 0) then Tscale=1._r8 - 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 ) - DateDiff =Date2-Date1 - call ESMF_TimeIntervalGet(DateDiff,S=DeltaT,rc=rc) - Tscale=float(Nudge_Step)/float(DeltaT) + elseif (Nudge_TimeScale_Opt == 1) then + Tscale = real(Nudge_File_Step,r8)/real(DeltaT, r8) else - write(iulog,*) 'NUDGING: Unknown Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt + if (masterproc) then + write(iulog,*) 'NUDGING: Unknown Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt + end if call endrun('nudging_timestep_init:: ERROR unknown Nudging_TimeScale_Opt') endif ! Update the nudging tendencies !-------------------------------- do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol - Nudge_Ustep(:ncol,:pver,lchnk)=( Target_U(:ncol,:pver,lchnk) & - -Model_U(:ncol,:pver,lchnk)) & - *Tscale*Nudge_Utau(:ncol,:pver,lchnk) - Nudge_Vstep(:ncol,:pver,lchnk)=( Target_V(:ncol,:pver,lchnk) & - -Model_V(:ncol,:pver,lchnk)) & - *Tscale*Nudge_Vtau(:ncol,:pver,lchnk) - Nudge_Sstep(:ncol,:pver,lchnk)=( Target_S(:ncol,:pver,lchnk) & - -Model_S(:ncol,:pver,lchnk)) & - *Tscale*Nudge_Stau(:ncol,:pver,lchnk) - Nudge_Qstep(:ncol,:pver,lchnk)=( Target_Q(:ncol,:pver,lchnk) & - -Model_Q(:ncol,:pver,lchnk)) & - *Tscale*Nudge_Qtau(:ncol,:pver,lchnk) - Nudge_PSstep(:ncol, lchnk)=( Target_PS(:ncol,lchnk) & - -Model_PS(:ncol,lchnk)) & - *Tscale*Nudge_PStau(:ncol,lchnk) + ncol = phys_state(lchnk)%ncol + + inv_nudge_file_step = 1.0_r8 / real(Nudge_file_Step, r8) + Nudge_Utau(:ncol,:pver,lchnk) = Nudge_Utau0(:ncol,:pver,lchnk) * Nudge_Ucoef * inv_nudge_file_step + Nudge_Vtau(:ncol,:pver,lchnk) = Nudge_Vtau0(:ncol,:pver,lchnk) * Nudge_Vcoef * inv_nudge_file_step + Nudge_Stau(:ncol,:pver,lchnk) = Nudge_Stau0(:ncol,:pver,lchnk) * Nudge_Tcoef * inv_nudge_file_step + Nudge_Qtau(:ncol,:pver,lchnk) = Nudge_Qtau0(:ncol,:pver,lchnk) * Nudge_Qcoef * inv_nudge_file_step + Nudge_PStau(:ncol,lchnk) = Nudge_PStau0(:ncol,lchnk) * Nudge_PScoef * inv_nudge_file_step + + Nudge_Ustep(:ncol,:pver,lchnk) = & + (Target_U(:ncol,:pver,lchnk) - Model_U(:ncol,:pver,lchnk))*Tscale*Nudge_Utau(:ncol,:pver,lchnk) + Nudge_Vstep(:ncol,:pver,lchnk) = & + (Target_V(:ncol,:pver,lchnk) - Model_V(:ncol,:pver,lchnk))*Tscale*Nudge_Vtau(:ncol,:pver,lchnk) + Nudge_Sstep(:ncol,:pver,lchnk) = & + (Target_S(:ncol,:pver,lchnk) - Model_S(:ncol,:pver,lchnk))*Tscale*Nudge_Stau(:ncol,:pver,lchnk) + Nudge_Qstep(:ncol,:pver,lchnk) = & + (Target_Q(:ncol,:pver,lchnk) - Model_Q(:ncol,:pver,lchnk))*Tscale*Nudge_Qtau(:ncol,:pver,lchnk) + Nudge_PSstep(:ncol,lchnk) = & + (Target_PS(:ncol,lchnk) - Model_PS(:ncol,lchnk))*Tscale*Nudge_PStau(:ncol,lchnk) end do - !****************** - ! DIAG - !****************** -! if(masterproc) then -! 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: Model_S(1,:pver,begchunk)=',Model_S(1,:pver,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 + ! Increment the Model times by the current interval + Model_Update_next_time = model_update_next_time + Model_Update_Interval - ! End Routine - !------------ + ! Check for Sync Error where NEXT model time after the update + ! is before the current time. If so, reset the next model + ! time to a Model_Update_Step after the current time. + Sync_Error = (curr_time >= Model_Update_next_time) + if (Sync_Error) then + Model_Update_next_time = curr_time + Model_Update_Interval + write(iulog,*) 'NUDGING: WARNING - Model_Update_Time Sync ERROR... CORRECTED' + endif + + endif ! (Update_Model) end subroutine nudging_timestep_init !================================================================ @@ -1427,10 +1163,11 @@ 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 - ! arrays. Send output to the cam history module as well. + ! 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 use physics_types,only: physics_state,physics_ptend,physics_ptend_init use constituents ,only: cnst_get_ind,pcnst @@ -1442,212 +1179,53 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) type(physics_state), intent(in) :: phys_state type(physics_ptend), intent(out):: phys_tend - ! Local values + ! Local variables !-------------------- integer :: indw,ncol,lchnk logical :: lq(pcnst) call cnst_get_ind('Q',indw) - lq(:) =.false. - lq(indw)=.true. + lq(:) = .false. + lq(indw) = .true. call physics_ptend_init(phys_tend,phys_state%psetcols,'nudging',lu=.true.,lv=.true.,ls=.true.,lq=lq) - if(Nudge_ON) then - lchnk=phys_state%lchnk - ncol =phys_state%ncol - phys_tend%u(:ncol,:pver) =Nudge_Ustep(:ncol,:pver,lchnk) - phys_tend%v(:ncol,:pver) =Nudge_Vstep(:ncol,:pver,lchnk) - phys_tend%s(:ncol,:pver) =Nudge_Sstep(:ncol,:pver,lchnk) - phys_tend%q(:ncol,:pver,indw)=Nudge_Qstep(:ncol,:pver,lchnk) - - call outfld( 'Nudge_U',phys_tend%u ,pcols,lchnk) - call outfld( 'Nudge_V',phys_tend%v ,pcols,lchnk) - call outfld( 'Nudge_T',phys_tend%s/cpair ,pcols,lchnk) - call outfld( 'Nudge_Q',phys_tend%q(1,1,indw) ,pcols,lchnk) - call outfld('Target_U',Target_U(:,:,lchnk),pcols,lchnk) - call outfld('Target_V',Target_V(:,:,lchnk),pcols,lchnk) - call outfld('Target_T',Target_T(:,:,lchnk),pcols,lchnk) - call outfld('Target_Q',Target_Q(:,:,lchnk),pcols,lchnk) - endif - - ! End Routine - !------------ - - end subroutine nudging_timestep_tend - !================================================================ - - !================================================================ - 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: 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 - !------------- - character(len=*),intent(in):: anal_file - - ! Local values - !------------- - 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(:,:) - - character(len=*), parameter :: prefix = 'nudging_update_analyses: ' - - ! 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 - endif - - call MPI_bcast(Nudge_File_Present, Nudge_NumObs, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_File_Present') - call MPI_bcast(Nudge_ObsInd , Nudge_NumObs, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ObsInd') - - if(.not. Nudge_File_Present(Nudge_ObsInd(1))) then - return + if (Nudge_ON) then + lchnk = phys_state%lchnk + ncol = phys_state%ncol + Phys_tend%u(:ncol,:pver) = Nudge_Ustep(:ncol,:pver,lchnk) + phys_tend%v(:ncol,:pver) = Nudge_Vstep(:ncol,:pver,lchnk) + phys_tend%s(:ncol,:pver) = Nudge_Sstep(:ncol,:pver,lchnk) + phys_tend%q(:ncol,:pver,indw) = Nudge_Qstep(:ncol,:pver,lchnk) + + call outfld( 'Nudge_U',phys_tend%u ,pcols,lchnk) + call outfld( 'Nudge_V',phys_tend%v ,pcols,lchnk) + call outfld( 'Nudge_T',phys_tend%s/cpair ,pcols,lchnk) + call outfld( 'Nudge_Q',phys_tend%q(:,:,indw),pcols,lchnk) 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) - - grid_id = cam_grid_id('physgrid') - call cam_grid_get_dim_names(grid_id,dim1name,dim2name) - - allocate(Tmp3D(pcols,pver,begchunk:endchunk)) - allocate(Tmp2D(pcols,begchunk:endchunk)) - - ! 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 - if(Nudge_ZonalFilter) then - call ZM%calc_amps(Tmp3D,Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d,Tmp3D) - endif - Nobs_U(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) - else - call endrun('Variable "U" is missing in '//trim(anal_file)) - endif - - call infld('V',fileID,dim1name,'lev',dim2name, & - 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & - VARflag,gridname='physgrid',timelevel=1 ) - if(VARflag) then - if(Nudge_ZonalFilter) then - call ZM%calc_amps(Tmp3D,Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d,Tmp3D) - endif - Nobs_V(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) - else - call endrun('Variable "V" is missing in '//trim(anal_file)) - endif - - call infld('T',fileID,dim1name,'lev',dim2name, & - 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & - VARflag,gridname='physgrid',timelevel=1 ) - if(VARflag) then - if(Nudge_ZonalFilter) then - call ZM%calc_amps(Tmp3D,Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d,Tmp3D) - endif - Nobs_T(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) - else - call endrun('Variable "T" is missing in '//trim(anal_file)) - endif - - call infld('Q',fileID,dim1name,'lev',dim2name, & - 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & - VARflag,gridname='physgrid',timelevel=1 ) - if(VARflag) then - if(Nudge_ZonalFilter) then - call ZM%calc_amps(Tmp3D,Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d,Tmp3D) - endif - Nobs_Q(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) - else - call endrun('Variable "Q" is missing in '//trim(anal_file)) - endif - - call infld('PS',fileID,dim1name,dim2name, & - 1,pcols,begchunk,endchunk,Tmp2D, & - VARflag,gridname='physgrid',timelevel=1 ) - if(VARflag) then - if(Nudge_ZonalFilter) then - call ZM%calc_amps(Tmp2D,Zonal_Bamp2d) - call ZM%eval_grid(Zonal_Bamp2d,Tmp2D) - endif - Nobs_PS(:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp2D(:,begchunk:endchunk) - else - call endrun('Variable "PS" is missing in '//trim(anal_file)) - endif - - ! Restore old error handling - !---------------------------- - call pio_seterrorhandling(fileID,err_handling) - - ! Close the analyses file - !----------------------- - deallocate(Tmp3D) - deallocate(Tmp2D) - call pio_closefile(fileID) - - ! End Routine - !------------ - - end subroutine nudging_update_analyses + end subroutine nudging_timestep_tend !================================================================ !================================================================ - subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) + 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 - ! variations on nudging strength. - !=============================================================== + ! 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 variations on nudging strength. + ! =============================================================== ! Arguments !-------------- - integer :: nlev,Nudge_prof - real(r8) :: rlat,rlon - real(r8) :: Wprof(nlev) + integer, intent(in) :: nlev + integer, intent(in) :: Nudge_prof + real(r8), intent(in) :: rlat, rlon + real(r8), intent(out) :: Wprof(nlev) - ! Local values + ! Local variables !---------------- - integer :: ilev + integer :: ilev real(r8) :: Hcoef,latx,lonx,Vmax,Vmin real(r8) :: lon_lo,lon_hi,lat_lo,lat_hi,lev_lo,lev_hi @@ -1655,31 +1233,33 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) ! set coeffcient !--------------- if(Nudge_prof == 0) then + ! No Nudging - !------------- Wprof(:)=0.0_r8 + elseif(Nudge_prof == 1) then + ! Uniform Nudging - !----------------- Wprof(:)=1.0_r8 + elseif(Nudge_prof == 2) then + ! Localized Nudging with specified Heaviside 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) + else + ! get lat/lon relative to window center - !------------------------------------------ latx=rlat-Nudge_Hwin_lat0 lonx=rlon-Nudge_Hwin_lon0 if(lonx > 180._r8) lonx=lonx-360._r8 if(lonx <= -180._r8) lonx=lonx+360._r8 ! Calcualte RAW window value - !------------------------------- lon_lo=(Nudge_Hwin_lonWidthH+lonx)/Nudge_Hwin_lonDelta lon_hi=(Nudge_Hwin_lonWidthH-lonx)/Nudge_Hwin_lonDelta lat_lo=(Nudge_Hwin_latWidthH+latx)/Nudge_Hwin_latDelta @@ -1688,13 +1268,12 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) *((1._r8+tanh(lat_lo))/2._r8)*((1._r8+tanh(lat_hi))/2._r8) ! Scale the horizontal window coef for specfied range of values. - !-------------------------------------------------------- Hcoef=(Hcoef-Nudge_Hwin_min)/(Nudge_Hwin_max-Nudge_Hwin_min) Hcoef=(1._r8-Hcoef)*Nudge_Hwin_lo + Hcoef*Nudge_Hwin_hi + endif ! Load the RAW vertical window - !------------------------------ do ilev=1,nlev lev_lo=(float(ilev)-Nudge_Vwin_Lindex)/Nudge_Vwin_Ldelta lev_hi=(Nudge_Vwin_Hindex-float(ilev))/Nudge_Vwin_Hdelta @@ -1702,78 +1281,60 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) end do ! Scale the Window function to span the values between Vlo and Vhi: - !----------------------------------------------------------------- Vmax=maxval(Wprof) Vmin=minval(Wprof) if((Vmax <= Vmin) .or. ((Nudge_Vwin_Hindex >= (nlev+1)) .and. & - (Nudge_Vwin_Lindex <= 0 ) )) then + (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) Wprof(:)=Vmax + else + ! Scale the RAW vertical window for specfied range of values. - !-------------------------------------------------------- Wprof(:)=(Wprof(:)-Vmin)/(Vmax-Vmin) Wprof(:)=Nudge_Vwin_lo + Wprof(:)*(Nudge_Vwin_hi-Nudge_Vwin_lo) + endif ! The desired result is the product of the vertical profile ! and the horizontal window coeffcient. - !---------------------------------------------------- Wprof(:)=Hcoef*Wprof(:) + else call endrun('nudging_set_profile:: Unknown Nudge_prof value') endif - ! End Routine - !------------ - end subroutine nudging_set_profile !================================================================ + !================================================================ subroutine nudging_final - if (allocated(Target_U)) deallocate(Target_U) - if (allocated(Target_V)) deallocate(Target_V) - if (allocated(Target_T)) deallocate(Target_T) - if (allocated(Target_S)) deallocate(Target_S) - if (allocated(Target_Q)) deallocate(Target_Q) - if (allocated(Target_PS)) deallocate(Target_PS) - if (allocated(Model_U)) deallocate(Model_U) - if (allocated(Model_V)) deallocate(Model_V) - if (allocated(Model_T)) deallocate(Model_T) - if (allocated(Model_S)) deallocate(Model_S) - if (allocated(Model_Q)) deallocate(Model_Q) - if (allocated(Model_PS)) deallocate(Model_PS) - if (allocated(Nudge_Utau)) deallocate(Nudge_Utau) - if (allocated(Nudge_Vtau)) deallocate(Nudge_Vtau) - if (allocated(Nudge_Stau)) deallocate(Nudge_Stau) - if (allocated(Nudge_Qtau)) deallocate(Nudge_Qtau) - if (allocated(Nudge_PStau)) deallocate(Nudge_PStau) + if (allocated(Zonal_Bamp2d)) deallocate(Zonal_Bamp2d) + if (allocated(Zonal_Bamp3d)) deallocate(Zonal_Bamp3d) + + if (allocated(Nudge_Utau0)) deallocate(Nudge_Utau0) + if (allocated(Nudge_Vtau0)) deallocate(Nudge_Vtau0) + if (allocated(Nudge_Stau0)) deallocate(Nudge_Stau0) + if (allocated(Nudge_Qtau0)) deallocate(Nudge_Qtau0) + if (allocated(Nudge_PStau0)) deallocate(Nudge_PStau0) + if (allocated(Nudge_Ustep)) deallocate(Nudge_Ustep) if (allocated(Nudge_Vstep)) deallocate(Nudge_Vstep) if (allocated(Nudge_Sstep)) deallocate(Nudge_Sstep) if (allocated(Nudge_Qstep)) deallocate(Nudge_Qstep) if (allocated(Nudge_PSstep)) deallocate(Nudge_PSstep) - if (allocated(Nudge_ObsInd)) deallocate(Nudge_ObsInd) - if (allocated(Nudge_File_Present)) deallocate(Nudge_File_Present) - if (allocated(Nobs_U)) deallocate(Nobs_U) - if (allocated(Nobs_V)) deallocate(Nobs_V) - if (allocated(Nobs_T)) deallocate(Nobs_T) - if (allocated(Nobs_Q)) deallocate(Nobs_Q) - if (allocated(Nobs_PS)) deallocate(Nobs_PS) - if (allocated(Zonal_Bamp2d)) deallocate(Zonal_Bamp2d) - if (allocated(Zonal_Bamp3d)) deallocate(Zonal_Bamp3d) - call ZM%final() end subroutine nudging_final !================================================================ + !================================================================ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) ! @@ -1785,8 +1346,8 @@ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) ! Arguments !-------------- - real(r8) :: rlat,rlon - integer :: Nudge_PSprof + real(r8), intent(in) :: rlat, rlon + integer , intent(in) :: Nudge_PSprof ! Local values !---------------- @@ -1820,7 +1381,6 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) ! 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 use ppgrid, only: pver, pverp use dycore, only: dycore_is use hycoef, only: hyai, hybi, ps0, hyam, hybm @@ -1837,7 +1397,6 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) ! ! Local variables !------------------ - logical :: fvdyn ! finite volume dynamics integer :: ii,kk ! Lon, level, level indices real(r8) :: tvfac ! Virtual temperature factor real(r8) :: hkk(ncol) ! diagonal element of hydrostatic matrix @@ -1847,10 +1406,6 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) real(r8) :: zi(ncol,pverp) ! Height above surface at interfaces real(r8) :: zm(ncol,pver ) ! Geopotential height at mid level - ! Set dynamics flag - !------------------- - fvdyn = dycore_is ('LR') - ! Load Pressure values and midpoint pressures !---------------------------------------------- do kk=1,pverp @@ -1877,7 +1432,7 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) ! First set hydrostatic elements consistent with dynamics !-------------------------------------------------------- - if(fvdyn) then + if (dycore_is ('LR')) then do ii=1,ncol hkl(ii)=log(pint(ii,kk+1))-log(pint(ii,kk)) hkk(ii)=1._r8-(hkl(ii)*pint(ii,kk)/(pint(ii,kk+1)-pint(ii,kk))) @@ -1900,10 +1455,305 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) end do ! kk=pver,1,-1 - ! End Routine - !----------- - end subroutine calc_DryStaticEnergy !================================================================ + + !================================================================ + subroutine nudging_stream_init() + + use dshr_strdata_mod, only: shr_strdata_init_from_inline + + ! local variables + integer :: rc + integer :: nfile + character(*), parameter :: sub = "('nudging_stream_init')" + !---------------------------------------------------------------- + + ! Write output log info + if (masterproc) then + write(iulog,'(a)' ) ' ' + write(iulog,'(a)' ) 'stream nudging settings:' + write(iulog,'(2a)' ) ' nudge varlist = ','U,V,T,Q,PS' + write(iulog,'(a,i8)') ' nudge year first = ',nudge_data_year_first + write(iulog,'(a,i8)') ' nudge year last = ',nudge_data_year_last + write(iulog,'(a,i8)') ' nudge year align = ',nudge_data_year_align + write(iulog,'(2a)' ) ' nudge mapalgo = ',trim(nudge_data_mapalgo) + write(iulog,'(2a)' ) ' nudge tintalgo = ',trim(nudge_data_tintalgo) + write(iulog,'(2a)' ) ' nudge taxmode = ',trim(nudge_data_taxmode) + write(iulog,'(2a)' ) ' nudge levname = ',trim(nudge_data_levname) + write(iulog,'(2a)' ) ' nudge meshfile = ',trim(nudge_meshfile) + write(iulog,'(2a)' ) ' nudge datapath = ',trim(nudge_datapath) + do nfile = 1,size(nudge_filenames) + if (trim(nudge_filenames(nfile)) /= 'unset') then + write(iulog,'(a,i0,2a)' ) ' nudge files(, ',nfile,') = ',trim(nudge_filenames(nfile)) + end if + end do + write(iulog,'(a)' ) ' ' + endif + + ! Add datapath to filenames + do nfile = 1,size(nudge_filenames) + if (trim(nudge_filenames(nfile)) /= 'unset') then + nudge_filenames(nfile) = trim(nudge_datapath)//'/'//trim(nudge_filenames(nfile)) + end if + end do + + ! Create module stream data type sdat_nudging + + call shr_strdata_init_from_inline(sdat_nudging_multi, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = model_clock, & + model_mesh = model_mesh, & + stream_meshfile = trim(nudge_meshfile), & + stream_filenames = nudge_filenames, & + stream_yearFirst = nudge_data_year_first, & + stream_yearLast = nudge_data_year_last, & + stream_yearAlign = nudge_data_year_align, & + stream_fldlistFile = nudge_varlist_multi, & + stream_fldListModel = nudge_varlist_multi, & + stream_lev_dimname = trim(nudge_data_levname), & + stream_mapalgo = trim(nudge_data_mapalgo), & + stream_offset = 0, & + stream_taxmode = trim(nudge_data_taxmode), & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = nudge_data_tintalgo, & + stream_name = 'NUDGING forcing data ', & + rc = rc) + call chkrc(rc,__LINE__,u_FILE_u) + + call shr_strdata_init_from_inline(sdat_nudging_singl, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = model_clock, & + model_mesh = model_mesh, & + stream_meshfile = trim(nudge_meshfile), & + stream_filenames = nudge_filenames, & + stream_yearFirst = nudge_data_year_first, & + stream_yearLast = nudge_data_year_last, & + stream_yearAlign = nudge_data_year_align, & + stream_fldlistFile = nudge_varlist_singl, & + stream_fldListModel = nudge_varlist_singl, & + stream_lev_dimname = 'null', & + stream_mapalgo = trim(nudge_data_mapalgo), & + stream_offset = 0, & + stream_taxmode = trim(nudge_data_taxmode), & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = nudge_data_tintalgo, & + stream_name = 'NUDGING forcing data ', & + rc = rc) + call chkrc(rc,__LINE__,u_FILE_u) + + stream_initialized = .true. + + end subroutine nudging_stream_init + !================================================================ + + + !================================================================ + subroutine nudging_stream_interp(Target_U, Target_V, Target_T, Target_Q, Target_PS) + + ! Caculate Target_T, Target_U, Target_V, Target_Q and Target_PS + + use dshr_strdata_mod , only : shr_strdata_advance + use dshr_methods_mod , only : dshr_fldbun_getfldptr + use ppgrid , only : pcols, pver, begchunk, endchunk + use phys_grid , only : get_ncols_p + + ! Arguments + real(r8), intent(out) :: Target_U(pcols,pver,begchunk:endchunk) + real(r8), intent(out) :: Target_V(pcols,pver,begchunk:endchunk) + real(r8), intent(out) :: Target_T(pcols,pver,begchunk:endchunk) + real(r8), intent(out) :: Target_Q(pcols,pver,begchunk:endchunk) + real(r8), intent(out) :: Target_PS(pcols,begchunk:endchunk) + + ! Local variables + integer :: rc ! ESMF error return + integer :: nvar ! variable index + integer :: klev ! level index + integer :: icol ! column index + integer :: ncol ! number of columns in chunk + integer :: lchnk ! chunk index + integer :: gidx ! counter index + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! current model date (yyyymmdd) + real(r8), pointer :: dataptr2d(:,:) ! first dimension is level, second is data on that level + real(r8), pointer :: dataptr1d(:) + real(r8) :: Tmp3D(pcols,pver,begchunk:endchunk) + real(r8) :: Tmp2D(pcols,begchunk:endchunk) + character(len=*), parameter :: sub = "(nudging_stream_interp) " + !----------------------------------------------------------------------- + + ! Extract YMD from model_update_next_time + call ESMF_TimeGet(Model_Update_Next_Time, yy=year, mm=mon, dd=day, s=sec, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + mcdate = year*10000 + mon*100 + day + if (masterproc) then + write(iulog,'(a,4(i6,2x))')' nudging_stream_interp: interpolating nudge to ',year,mon,day,sec + end if + + ! Advance sdat streams + call shr_strdata_advance(sdat_nudging_multi, ymd=mcdate, tod=sec, logunit=iulog, istr='nudging', rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + call shr_strdata_advance(sdat_nudging_singl, ymd=mcdate, tod=sec, logunit=iulog, istr='nudging', rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + ! Get pointer for stream data that is time and spatially interpolated to model time and grid + ! Obtain Target_U, Target_V, Target_T and Target_Q + + do nvar = 1,4 + if ( trim(nudge_varlist_multi(nvar)) == 'U' .or. & + trim(nudge_varlist_multi(nvar)) == 'V' .or. & + trim(nudge_varlist_multi(nvar)) == 'T' .or. & + trim(nudge_varlist_multi(nvar)) == 'Q' ) then + + call dshr_fldbun_getFldPtr(sdat_nudging_multi%pstrm(1)%fldbun_model, & + nudge_varlist_multi(nvar), fldptr2=dataptr2d, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + ! Obtain TMP3d + do klev = 1, pver + gidx = 1 + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + do icol = 1,ncol + Tmp3d(icol,klev,lchnk) = dataptr2d(klev,gidx) + gidx = gidx + 1 + end do + end do + end do + + ! Apply zonal mean filtering + if (Nudge_ZonalFilter) then + call ZM%calc_amps(Tmp3D, Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d, Tmp3D) + endif + + ! Determine output variables + if (trim(nudge_varlist_multi(nvar)) == 'U') then + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + Target_U(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) + end do + else if (trim(nudge_varlist_multi(nvar)) == 'V') then + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + Target_V(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) + end do + else if (trim(nudge_varlist_multi(nvar)) == 'T') then + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + Target_T(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) + end do + else if (trim(nudge_varlist_multi(nvar)) == 'Q') then + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + Target_Q(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) + end do + end if + end if + end do + + ! Obtain Target_PS + + call dshr_fldbun_getFldPtr(sdat_nudging_singl%pstrm(1)%fldbun_model, 'PS', fldptr1=dataptr1d, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + gidx = 1 + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + do icol = 1,ncol + Tmp2d(icol,lchnk) = dataptr1d(gidx) + gidx = gidx + 1 + end do + end do + + if (Nudge_ZonalFilter) then + call ZM%calc_amps(Tmp2D,Zonal_Bamp2d) + call ZM%eval_grid(Zonal_Bamp2d,Tmp2D) + endif + + do lchnk=begchunk,endchunk + ncol = get_ncols_p(lchnk) + Target_PS(:ncol,lchnk)= Tmp2d(:ncol,lchnk) + end do + + end subroutine nudging_stream_interp + !================================================================ + + + !================================================================ + subroutine get_calendar(sdat, model_year, model_month, model_day, calendar) + + use shr_cal_mod, only : shr_cal_noleap, shr_cal_gregorian + use shr_cal_mod, only : shr_cal_date2ymd, shr_cal_leapyear + + ! Arguments + type(shr_strdata_type), intent(in) :: sdat + integer, intent(in) :: model_year ! model year + integer, intent(in) :: model_month ! model month + integer, intent(in) :: model_day ! model day + character(len=*), intent(out) :: calendar + + ! Local Variables + integer :: data_year, data_month, data_day ! data date year month day + !----------------------------------------------------------------------- + + call shr_cal_date2ymd(sdat%pstrm(1)%ymdUB, data_year, data_month, data_day) + + calendar = trim(sdat%stream(1)%calendar) + if (trim(sdat%model_calendar) /= trim(sdat%stream(1)%calendar)) then + if (( trim(sdat%model_calendar) == trim(shr_cal_gregorian)) .and. & + (trim(sdat%stream(1)%calendar) == trim(shr_cal_noleap))) then + ! set feb 29 = feb 28 + if (model_month == 2 .and. model_day == 29) then + calendar = shr_cal_noleap + end if + elseif ((trim(sdat%model_calendar) == trim(shr_cal_noleap)) .and. & + (trim(sdat%stream(1)%calendar) == trim(shr_cal_gregorian))) then + ! feb 29 input data will be skipped automatically + if (data_month==3 .and. data_day==1 .and. model_month==2 .and. model_day==28) then + calendar = shr_cal_noleap + endif + endif + else ! calendars are the same + if (trim(sdat%model_calendar) == trim(shr_cal_gregorian)) then + ! Both are in gregorian - but it's possible that there is a mismatch + ! such that the model is in leapyear but the data is not + if (model_month == 2 .and. model_day >= 28) then + if (shr_cal_leapyear(model_year) .and. .not. shr_cal_leapyear(data_year)) then + ! model is in leap year but data is not + calendar = shr_cal_noleap + endif + else + calendar = sdat%model_calendar + endif + else + calendar = sdat%model_calendar + endif + endif + + end subroutine get_calendar + !================================================================ + + + !================================================================ + subroutine chkrc(rc, line, file) + integer , intent(in) :: rc + integer , intent(in) :: line + character(len=*) , intent(in) :: file + + if ( rc /= ESMF_SUCCESS ) then + call ESMF_LogWrite('ERROR:', ESMF_LOGMSG_ERROR, line=line, file=file) + call endrun('chkrc: see ESMF log file(s)') + end if + end subroutine chkrc + end module nudging