From 85adf34e3e124e8af183d88ec667c41eb03f2a1a Mon Sep 17 00:00:00 2001 From: mvertens Date: Sun, 26 Oct 2025 16:41:48 +0100 Subject: [PATCH 01/25] first pass at refactoring the nudging code --- src/cpl/nuopc/atm_stream_nudging.F90 | 292 +++++ src/physics/cam/nudging.F90 | 1647 ++++++++++---------------- 2 files changed, 929 insertions(+), 1010 deletions(-) create mode 100644 src/cpl/nuopc/atm_stream_nudging.F90 diff --git a/src/cpl/nuopc/atm_stream_nudging.F90 b/src/cpl/nuopc/atm_stream_nudging.F90 new file mode 100644 index 0000000000..c57464eb08 --- /dev/null +++ b/src/cpl/nuopc/atm_stream_nudging.F90 @@ -0,0 +1,292 @@ +module atm_stream_nudging + + !----------------------------------------------------------------------- + ! Contains methods for reading in nitrogen deposition data file + ! Also includes functions for dynamic nudging file handling and + ! interpolation. + !----------------------------------------------------------------------- + ! + use ESMF , only : ESMF_Clock, ESMF_Mesh + use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_Finalize, ESMF_LogFoundError + use ESMF , only : ESMF_Time, ESMF_Time_Interval, ESMF_Time_Get + use nuopc_shr_methods , only : chkerr + use dshr_strdata_mod , only : shr_strdata_type + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmd_utils , only : masterproc, iam + use cam_logfile , only : iulog + use cam_abortutils , only : endrun + + implicit none + private + + public :: stream_nudging_init ! position datasets for dynamic nudging + public :: stream_nudging_interp ! interpolates between two years of nudging file data + + type(shr_strdata_type) :: sdat_nudging + + character(len=CL) :: stream_nudging_data_filename + character(len=CL) :: stream_nudging_mesh_filename + integer :: stream_nudging_year_first ! first year in stream to use + integer :: stream_nudging_year_last ! last year in stream to use + integer :: stream_nudging_year_align ! align stream_year_firstnudging with + + character(len=2) :: stream_varlist_nudging(5) = (/'U ', 'V ','T ','Q ','PS'/) + type(ESMF_Clock) :: nudging_clock + + character(*),parameter :: u_FILE_u = __FILE__ + +!============================================================================== +contains +!============================================================================== + + subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, nudge_beg_time, nudge_end_time, nudge_force_opt, & + nudge_model_step) + + use dshr_strdata_mod, only: shr_strdata_init_from_inline + + character(len=*) , intent(in) :: nudge_path + character(len=*) , intent(in) :: nudge_files(:) + character(len=*) , intent(in) :: nudge_mesh + type(ESMF_Time) , intent(in) :: nudge_beg_time + type(ESMF_Time) , intent(in) :: nudge_end_time + integer , intent(in) :: nudge_force_opt + integer , intent(in) :: nudge_model_step + + ! local variables + character(*), parameter :: sub = "('stream_nudging_init')" + !---------------------------------------------------------------- + + ! Create a Model_Clock for nudging - this is different than the CAM clock - it's time step is from the input + ! nudging information + + call ESMF_TimeIntervalSet(step_size, s=nudge_model_step, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + call ESMF_TimeGet(nudge_beg_time, year=stream_nudging_year_first, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + call ESMF_TimeGet(nudge_end_time, year=stream_nudging_year_last, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ! TODO: should this be initialized with a gregorian calendar + ! the only use of the model clock in CDEPS is to extract the calendar + + nudging_clock = ESMF_ClockCreate(name="Nudging Model Clock", & + nudge_model_step, nudge_beg_time, stop_time=nudge_end_time, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ! Output info + + if (masterproc) then + write(iulog,'(a)' ) ' ' + write(iulog,'(a,i8)') 'stream nudging settings:' + write(iulog,'(a,a)' ) ' stream_nudging_mesh_filename = ',trim(nudge_mesh) + write(iulog,'(a,a,a)') ' stream_varlist_nudging = ','U,V,T,Q,PS' + write(iulog,'(a,i8)') ' stream_nudging_year_first = ',nudge_year_first + write(iulog,'(a,i8)') ' stream_nudging_year_last = ',nudge_year_last + write(iulog,'(a,i8)') ' stream_nudging_year_align = ',nudge_year_align + do nfile = 1,size(stream_nudging_data_filenames) + write(iulog,'(a,i8,a)' ) ' stream_nudging_data_filename = ',nfile,trim(stream_nudging_data_filename(nfile)) + end do + write(iulog,'(a)' ) ' ' + endif + + ! Create stream data type sdat_nudging + + if (Nudge_Force_Opt == 0) then + tintalgo = 'upper' + elseif(Nudge_Force_Opt == 1) then + tintalgo = 'linear' + else + write(iulog,*) 'NUDGING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt + call endrun('nudging_timestep_init:: ERROR unknown Nudging_Force_Opt') + endif + + ! Initialize the cdeps data type sdat_nudging + call shr_strdata_init_from_inline(sdat_nudging, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = nudging_clock, & + model_mesh = nudging_mesh, & + stream_meshfile = trim(stream_nudging_mesh_filename), & + stream_filenames = stream_nudging_data_filenames, & + stream_yearFirst = stream_nudging_year_first, & + stream_yearLast = stream_nudging_year_last, & + stream_yearAlign = stream_nudging_year_align, & + stream_fldlistFile = stream_varlist_nudging, & + stream_fldListModel = stream_varlist_nudging, & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'limit', & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = tintalgo, & + stream_name = 'NUDGING forcing data ', & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + end subroutine stream_nudging_init + + !================================================================ + + subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, Target_Q, Target_PS, & + Nudge_zonal_filter) + + use dshr_methods_mod , only : dshr_fldbun_getfldptr + use dshr_strdata_mod , only : shr_strdata_advance + use ppgrid , only : pcols, pver, begchunk,endchunk + use ppgrid , only : begchunk, endchunk + use time_manager , only : get_curr_date + use phys_grid , only : get_ncols_p + use zonal_mean_mod , only : ZonalMean_t + use cam_abortutils , only : endrun, handle_allocate_error + + ! input/output variables + type(ESMF_Time) , intent(in) :: model_nudge_time + real(r8) , intent(in) :: Target_U(pcols,pver,begchunk:endchunk) + real(r8) , intent(in) :: Target_V(pcols,pver,begchunk:endchunk) + real(r8) , intent(in) :: Target_T(pcols,pver,begchunk:endchunk) + real(r8) , intent(in) :: Target_Q(pcols,pver,begchunk:endchunk) + logical , intent(in) :: Nudge_ZonalFilter + type(ZonalMean_t) , intent(in) :: ZM + real(r8) , intent(in) :: Zonal_Bamp2d(:) + real(r8) , intent(in) :: Zonal_Bamp3d(:,:) + + ! local variables + integer :: rc ! ESMF error return + integer :: istat ! allocate return + integer :: nvar ! variable index + integer :: ilev ! level index + integer :: icol ! column index + integer :: ichnk ! chunk index + integer :: g ! 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),allocatable :: Tmp3D(:,:,:) + real(r8),allocatable :: Tmp2D(:,:) + character(len=*), parameter :: sub = "(stream_nudging_interp) " + !----------------------------------------------------------------------- + + ! Extract YMD from model_nudge_time + call ESMF_TimeGet(model_nudge_time, year=year, month=month, day=day, sec=sec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + mcdate = year*10000 + mon*100 + day + + ! Advance sdat stream + call shr_strdata_advance(sdat_nudging, ymd=mcdate, tod=sec, logunit=iulog, istr='nudging', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ! Get pointer for stream data that is time and spatially interpolated to model time and grid + allocate(Tmp3D(pcols,pver,begchunk:endchunk), stat=istta) + call handle_allocate_error(istat, sub, 'TMP3d') + + allocate(Tmp2D(pcols,begchunk:endchunk)) + call handle_allocate_error(istat, sub, 'TM23d') + + ! Determine 3d nudging fields + do nvar = 1,4 + + if ( trim(stream_varlist_nudging(nvar)) == 'U' .or. & + trim(stream_varlist_nudging(nvar)) == 'V' .or. & + trim(stream_varlist_nudging(nvar)) == 'T' .or. & + trim(stream_varlist_nudging(nvar)) == 'Q' ) then + + call dshr_fldbun_getFldPtr(sdat_nudging%pstrm(1)%fldbun_model, stream_varlist_nudging(nvar), fldptr2=dataptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ! Obtain TMP3d + g = 1 + do ichnk = begchunk,endchunk + do ilev = 1, plev + do icol = 1,get_ncols_p(c) + Tmp3d(icol,ilev,ichnk) = dataptr2d(ilev,g) + g = g + 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(stream_varlist_nudging(nvar) == 'U')) then + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + Target_U(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) + end do + else if (trim(stream_varlist_nudging(nvar) == 'V')) then + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + Target_V(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) + end do + else if (trim(stream_varlist_nudging(nvar) == 'T')) then + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + Target_T(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) + end do + else if (trim(stream_varlist_nudging(nvar) == 'Q')) then + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + Target_Q(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) + end do + end if + + else if (trim(stream_varlist_nudging(nvar)) == 'PS') then + + call dshr_fldbun_getFldPtr(sdat_nudging%pstrm(1)%fldbun_model, stream_varlist_nudging(nvar), fldptr2=dataptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + g = 1 + do ichnk = begchunk,endchunk + do icol = 1,get_ncols_p(c) + Tmp2d(icol, ichnk) = dataptr2d(g) + g = g + 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=phys_state(lchnk)%ncol + Target_PS(:ncol,lchnk)= Tmp3d(:ncol,lchnk) + end do + + end if ! + + end do + + end subroutine stream_nudging_interp + +end module atm_stream_nudging diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index ced2ef57d2..cba45f6a4b 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -4,7 +4,8 @@ module nudging ! Purpose: Implement Nudging of the model state of U,V,T,Q, and/or PS ! toward specified values from analyses. ! -! Author: Patrick Callaghan +! Authors: Patrick Callaghan (original) +! Mariana Vertenstein (2025) refactored for CDEPS capability ! ! Description: ! @@ -111,19 +112,11 @@ module nudging ! Nudge_Path - CHAR path to the analyses files. ! (e.g. '/glade/scratch/USER/inputdata/nudging/ERAI-Data/') ! -! Nudge_File_Template - CHAR Analyses filename with year, month, day, and second -! values replaced by %y, %m, %d, and %s respectively. -! (e.g. '%y/ERAI_ne30np4_L30.cam2.i.%y-%m-%d-%s.nc') +! Nudge_Filenames - CHAR array of analysis files ! -! Nudge_Times_Per_Day - INT Number of analyses files available per day. -! 1 --> 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. @@ -131,22 +124,22 @@ module nudging ! 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_Force_Opt - INT Index to select the nudging Target for a relaxation -! forcing of the form: +! Nudge_Force_Opt - INT Index to select the nudging Target for a relaxation forcing of the form: ! where (t'==Analysis times ; t==Model Times) ! -! 0 -> NEXT-OBS: Target=Anal(t'_next) [DEFAULT] +! 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] @@ -177,6 +170,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,11 +188,11 @@ module nudging !===================================================================== ! Useful modules !------------------ + use ESMF 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 time_manager, only: get_curr_date, get_step_size use cam_abortutils, only: endrun - use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom, mpi_success + use spmd_utils, only: masterproc, 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 @@ -214,64 +208,61 @@ module nudging public :: nudging_init public :: nudging_timestep_init public :: nudging_timestep_tend - private :: nudging_update_analyses + private :: nudging_set_PSprofile private :: nudging_set_profile private :: calc_DryStaticEnergy + public :: nudging_final ! Nudging Parameters !-------------------- - logical :: Nudge_Model =.false. - logical :: Nudge_ON =.false. - logical :: Nudge_Initialized =.false. - character(len=cl) :: Nudge_Path - character(len=cs) :: Nudge_File,Nudge_File_Template - integer :: Nudge_Force_Opt - integer :: Nudge_TimeScale_Opt - integer :: Nudge_TSmode - integer :: Nudge_Times_Per_Day - integer :: Model_Times_Per_Day - real(r8) :: Nudge_Ucoef,Nudge_Vcoef - integer :: Nudge_Uprof,Nudge_Vprof - real(r8) :: Nudge_Qcoef,Nudge_Tcoef - integer :: Nudge_Qprof,Nudge_Tprof - real(r8) :: Nudge_PScoef - integer :: Nudge_PSprof - integer :: Nudge_Beg_Year ,Nudge_Beg_Month - integer :: Nudge_Beg_Day ,Nudge_Beg_Sec - integer :: Nudge_End_Year ,Nudge_End_Month - integer :: Nudge_End_Day ,Nudge_End_Sec - integer :: Nudge_Curr_Year,Nudge_Curr_Month - integer :: Nudge_Curr_Day ,Nudge_Curr_Sec - integer :: Nudge_Next_Year,Nudge_Next_Month - integer :: Nudge_Next_Day ,Nudge_Next_Sec - integer :: Nudge_Step - integer :: Model_Curr_Year,Model_Curr_Month - integer :: Model_Curr_Day ,Model_Curr_Sec - integer :: Model_Next_Year,Model_Next_Month - integer :: Model_Next_Day ,Model_Next_Sec - integer :: Model_Step - real(r8) :: Nudge_Hwin_lat0 - real(r8) :: Nudge_Hwin_latWidth - real(r8) :: Nudge_Hwin_latDelta - real(r8) :: Nudge_Hwin_lon0 - real(r8) :: Nudge_Hwin_lonWidth - real(r8) :: Nudge_Hwin_lonDelta - logical :: Nudge_Hwin_Invert = .false. - real(r8) :: Nudge_Hwin_lo - real(r8) :: Nudge_Hwin_hi - real(r8) :: Nudge_Vwin_Hindex - real(r8) :: Nudge_Vwin_Hdelta - real(r8) :: Nudge_Vwin_Lindex - real(r8) :: Nudge_Vwin_Ldelta - logical :: Nudge_Vwin_Invert =.false. - real(r8) :: Nudge_Vwin_lo - real(r8) :: Nudge_Vwin_hi - real(r8) :: Nudge_Hwin_latWidthH - real(r8) :: Nudge_Hwin_lonWidthH - real(r8) :: Nudge_Hwin_max - real(r8) :: Nudge_Hwin_min + logical :: Nudge_Model =.false. + logical :: Nudge_ON =.false. + logical :: Nudge_Initialized =.false. + character(len=cl) :: Nudge_Path + type(ESMF_Mesh) :: Mudge_Mesh + integer :: Nudge_Step + integer :: Model_Step + type(ESMF_Time) :: Model_curr_time + type(ESMF_Time) :: Model_next_time + type(ESMF_Time) :: Nudge_Beg_time + type(ESMF_Time) :: Nudge_End_time + type(ESMF_Time) :: Nudge_curr_time + type(ESMF_Time) :: Nudge_next_time + integer :: Model_Times_Per_Day + type(ESMF_Time_Interval) :: Model_delta + integer :: Nudge_File_Times_Per_Day + type(ESMF_Time_Interval) :: Nudge_File_delta + integer :: Nudge_Force_Opt + integer :: Nudge_TimeScale_Opt + integer :: Nudge_TSmode + 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 + real(r8) :: Nudge_Hwin_lat0 + real(r8) :: Nudge_Hwin_latWidth + real(r8) :: Nudge_Hwin_latDelta + real(r8) :: Nudge_Hwin_lon0 + real(r8) :: Nudge_Hwin_lonWidth + real(r8) :: Nudge_Hwin_lonDelta + logical :: Nudge_Hwin_Invert = .false. + real(r8) :: Nudge_Hwin_lo + real(r8) :: Nudge_Hwin_hi + real(r8) :: Nudge_Vwin_Hindex + real(r8) :: Nudge_Vwin_Hdelta + real(r8) :: Nudge_Vwin_Lindex + real(r8) :: Nudge_Vwin_Ldelta + logical :: Nudge_Vwin_Invert =.false. + real(r8) :: Nudge_Vwin_lo + real(r8) :: Nudge_Vwin_hi + real(r8) :: Nudge_Hwin_latWidthH + real(r8) :: Nudge_Hwin_lonWidthH + real(r8) :: Nudge_Hwin_max + real(r8) :: Nudge_Hwin_min ! Nudging Zonal Filter variables !--------------------------------- @@ -283,42 +274,37 @@ module nudging ! 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_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) + integer, parameter :: maxfiles = 1000 + character(len=CL) :: nudge_filenames(maxfiles) contains + !================================================================ subroutine nudging_readnl(nlfile) ! @@ -336,81 +322,86 @@ subroutine nudging_readnl(nlfile) ! Local Values !--------------- integer :: ierr, unitn + integer :: nfile 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, & + namelist /nudging_nl/ Nudge_Model, Nudge_Path, Nudge_Filenames, Nudge_Mesh, & + 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_Times_Per_Day, & + Nudge_File_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 + 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 + Nudge_Model = .false. + Model_Times_Per_Day = 4 + Nudge_File_Times_per_Day = 4 + Nudge_Path = './Data/YOTC_ne30np4_001/' + Nudge_Filenames(:) = ' ' + Nudge_Mesh = ' ' + 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_Force_Opt = 0 + Nudge_TimeScale_Opt = 0 + Nudge_TSmode = 0 + + 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_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_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,6 +417,132 @@ subroutine nudging_readnl(nlfile) close(unitn) end if + ! Broadcast namelist variables + !------------------------------ + call MPI_bcast(Nudge_Path, len(Nudge_Path), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Model') + + do nfile = 1,maxfiles + if (Nudge_filename(nfile) /= ' ') then + call MPI_bcast(Nudge_Filename(nfile), len(Nudge_Filename), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Filename') + end if + end do + + call MPI_bcast(Model_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Times_Per_Day') + + call MPI_bcast(Nudge_File_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Times_Per_Day') + + call MPI_bcast(Nudge_Beg_Year, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Year') + + call MPI_bcast(Nudge_Beg_Month, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Month') + + call MPI_bcast(Nudge_Beg_Day, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Day') + + call MPI_bcast(Nudge_Beg_Sec, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Sec') + + call MPI_bcast(Nudge_End_Year, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Year') + + call MPI_bcast(Nudge_End_Month, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Month') + + call MPI_bcast(Nudge_End_Day, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Day') + + call MPI_bcast(Nudge_End_Sec, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Sec') + + call MPI_bcast(Nudge_Initialized, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Initialized') + + call MPI_bcast(Nudge_Force_Opt, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Force_Opt') + + call MPI_bcast(Nudge_TimeScale_Opt, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_TimeScale_Opt') + + call MPI_bcast(Nudge_TSmode, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_TSmode') + + call MPI_bcast(Nudge_Ucoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Ucoef') + + call MPI_bcast(Nudge_Vcoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vcoef') + + call MPI_bcast(Nudge_Tcoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Tcoef') + + call MPI_bcast(Nudge_Qcoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Qcoef') + + call MPI_bcast(Nudge_PScoef, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_PScoef') + + call MPI_bcast(Nudge_Uprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Uprof') + + call MPI_bcast(Nudge_Vprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vprof') + + call MPI_bcast(Nudge_Tprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Tprof') + + call MPI_bcast(Nudge_Qprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Qprof') + + call MPI_bcast(Nudge_PSprof, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_PSprof') + + call MPI_bcast(Nudge_Hwin_lat0, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lat0') + + call MPI_bcast(Nudge_Hwin_latWidth, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latWidth') + + call MPI_bcast(Nudge_Hwin_latDelta, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latDelta') + + call MPI_bcast(Nudge_Hwin_lon0, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lon0') + + call MPI_bcast(Nudge_Hwin_lonWidth, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonWidth') + + call MPI_bcast(Nudge_Hwin_lonDelta, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonDelta') + + call MPI_bcast(Nudge_Hwin_Invert, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_Invert') + + call MPI_bcast(Nudge_Vwin_Hindex, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Hindex') + + call MPI_bcast(Nudge_Vwin_Hdelta, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Hdelta') + + call MPI_bcast(Nudge_Vwin_Lindex, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Lindex') + + call MPI_bcast(Nudge_Vwin_Ldelta, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Ldelta') + + call MPI_bcast(Nudge_Vwin_Invert, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Invert') + + call MPI_bcast(Nudge_ZonalFilter, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ZonalFilter') + + call MPI_bcast(Nudge_ZonalNbasis, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ZonalNbasis') + ! Set hi/lo values according to the given '_Invert' parameters !-------------------------------------------------------------- if(Nudge_Hwin_Invert) then @@ -487,103 +604,7 @@ subroutine nudging_readnl(nlfile) call endrun('nudging_readnl:: ERROR in namelist') 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') - + ! End Routine !------------ @@ -607,26 +628,21 @@ subroutine nudging_init ! Local values !---------------- - integer :: Year,Month,Day,Sec - integer :: YMD1,YMD - logical :: After_Beg,Before_End - integer :: istat,lchnk,ncol,icol,ilev - integer :: hdim1_d,hdim2_d - integer :: 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 - + type(ESMF_Time) :: curr_time + integer :: Year,Month,Day,Sec + logical :: After_Beg,Before_End + integer :: istat,lchnk,ncol,icol,ilev + 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() + character(len=*), parameter :: sub = "(nudging_init) " ! Allocate Space for Nudging data arrays !----------------------------------------- @@ -692,368 +708,241 @@ 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 - ! 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 + ! 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. + !-------------------------------------------------------- + + ! Get the CAM time step size + dtime = get_step_size() + Model_Step = 86400/Model_Times_Per_Day + Nudge_File_Step=86400/Nudge_File_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_File_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_File_Step + 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, year=Year, month=Month, day=Day, sec=Sec, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_currtime') - ! 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)) + call ESMF_TimeSet(Nudge_beg_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_beg_time') - ! 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. + call ESMF_TimeSet(Nudge_end_time, year=Nudge_End_Year, month=Nudge_End_Month, day=Nudge_End_Day, sec=Nudge_End_Sec, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_end_time') - ! Initialization is done, - !-------------------------- - Nudge_Initialized = .true. + call ESMF_Time_Interval_Set(Model_delta, sec=Model_Step, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Model_step') + call ESMF_TimeIntervalSet(Nudge_File_delta, s=Nudge_File_Step, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Nudge_step') + + ! Initialize the time relative to the nudging window + !------------------------------------------------ + + After_Beg = (Model_curr_time >= Nudge_beg_time) + Before_End = (Nudge_end_time >= Model_curr_time) + + if ((After_Beg) .and. (Before_End)) then + + ! Set Time indicies so that the next call to timestep_init will initialize the Model_curr_time + call ESMF_TimeSet(Model_next_time, year=Year, month=Month, day=Day, sec=(Sec/Model_Step)*Model_Step) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_next_time') + call ESMF_TimeSet(Nudge_next_time, year=Year, month=Month, day=Day, sec=(Sec/Nudge_Step)*Nudge_Step) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_next_time') + + elseif (.not.After_Beg) then + + ! Set Time indicies to Nudging start so next call to timestep_init will initialize the Model_curr_time + call ESMF_TimeSet(Model_next_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_next_time') + call ESMF_TimeSet(Nudge_next_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_next_time') + + 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 + + ! 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)) + + ! Initialization is done, + !-------------------------- + Nudge_Initialized = .true. + + if (masterproc) then + ! Informational Output !--------------------------- write(iulog,*) ' ' 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,*) 'NUDGING: Nudge_Model =',Nudge_Model + write(iulog,*) 'NUDGING: Nudge_Path =',Nudge_Path + 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: Model_Times_Per_Day =',Model_Times_Per_Day + write(iulog,*) 'NUDGING: Nudge_File_Times_Per_Day =',Model_Times_Per_Day + write(iulog,*) 'NUDGING: Nudge_File_Step =',Nudge_File_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,*) ' ' 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 - ! 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) - endif - - ! Rotate Nudge_ObsInd() indices for new data, then update - ! the Nudge observation arrays with analysis data at the - ! NEXT==Nudge_ObsInd(1) time. + ! Initialize nudging stream data type !---------------------------------------------------------- - call nudging_update_analyses (trim(Nudge_Path)//trim(Nudge_File)) + call stream_nudging_init(Nudge_Path, Nudge_files, Nudge_Mesh, Nudge_Beg_Time, Nudge_End_time, Nudge_Force_Opt, & + Nudge_Model_Step) ! 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 + 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(:) + Nudge_Utau(icol,:,lchnk) = Wprof(:) + call nudging_set_profile(rlat,rlon,Nudge_Vprof,Wprof,pver) - Nudge_Vtau(icol,:,lchnk)=Wprof(:) + Nudge_Vtau(icol,:,lchnk) = Wprof(:) + call nudging_set_profile(rlat,rlon,Nudge_Tprof,Wprof,pver) - Nudge_Stau(icol,:,lchnk)=Wprof(:) + Nudge_Stau(icol,:,lchnk) = Wprof(:) + call nudging_set_profile(rlat,rlon,Nudge_Qprof,Wprof,pver) - Nudge_Qtau(icol,:,lchnk)=Wprof(:) + Nudge_Qtau(icol,:,lchnk) = Wprof(:) - Nudge_PStau(icol,lchnk)=nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) + Nudge_PStau(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 + + 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 @@ -1067,17 +956,14 @@ 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 ! Arguments !----------- @@ -1085,22 +971,21 @@ subroutine nudging_timestep_init(phys_state) ! Local values !---------------- - integer :: Year,Month,Day,Sec - integer :: YMD1,YMD2,YMD - logical :: Update_Model,Update_Nudge,Sync_Error - logical :: After_Beg ,Before_End - integer :: lchnk,ncol,indw - - type(ESMF_Time) :: Date1,Date2 - type(ESMF_TimeInterval) :: DateDiff - integer :: DeltaT - real(r8) :: Tscale - real(r8) :: Tfrac - integer :: rc - integer :: nn - integer :: kk - real(r8) :: Sbar,Qbar,Wsum - integer :: dtime + integer :: Year,Month,Day,Sec + logical :: Update_Model, Sync_Error + logical :: After_Beg, Before_End + integer :: lchnk,ncol,indw + type(ESMF_Time) :: Date1,Date2 + type(ESMF_TimeInterval) :: DateDiff + type(ESMF_Time) :: curr_time + type(ESMF_Time_Interval) :: date_diff + integer :: DeltaT + real(r8) :: Tscale + real(r8) :: Tfrac + integer :: rc + real(r8) :: Sbar,Qbar,Wsum + character(len=*), parameter :: sub = "(nudging_timestep_init) " + !-------------------------------------------------------------- ! Check if Nudging is initialized !--------------------------------- @@ -1108,94 +993,69 @@ subroutine nudging_timestep_init(phys_state) 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. + ! Determine if the current model time is AFTER the begining nudging time + ! and if it is BEFORE the ending nudging 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) + ! Get Current model time + call get_curr_date(Year,Month,Day,Sec) + + call ESMF_TimeSet(curr_time, year=Year, month=Month, day=Day, sec=Sec) + call chkrc(rc, sub//': error return from ESMF_TimeSet for curr_time') + + After_Beg = (curr_time >= Nudge_beg_time) + Before_End = (curr_time <= Nudge_end_time) !-------------------------------------------------------------- ! 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) - if((Before_End) .and. (Update_Model)) then + Update_Model = (curr_time >= Model_next_time) + + 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) + Model_curr_time = Model_next_time + Model_next_time = Model_next_time + Model_delta ! 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) + Sync_Error = (Model_curr_time >= Model_next_time) 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) + Model_curr_time = curr_time + Model_next_time = curr_time + Model_delta 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) ! 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) 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(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 @@ -1222,199 +1082,108 @@ subroutine nudging_timestep_init(phys_state) 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) - - if((Before_End) .and. (Update_Nudge)) then - ! Increment the Nudge times by the current interval - !--------------------------------------------------- - 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 + if ((After_Beg) .and. (Before_End)) then + Nudge_ON = .true. else - Nudge_ON=.false. + Nudge_ON = .false. endif !------------------------------------------------------- ! HERE Implement time dependence of Nudging Coefs HERE !------------------------------------------------------- - !--------------------------------------------------- ! If Data arrays have changed update stepping arrays !--------------------------------------------------- - if((Before_End) .and. ((Update_Nudge) .or. (Update_Model))) then + if ((Before_End) .and. Update_Model) then - ! Now Load the Target values for nudging tendencies + ! Using cdeps: + ! Read new nudging data and interpolate to model grid and + ! Model_Curr_Year, Model_Curr_Month, Model_Curr_Day, Model_Curr_Sec !--------------------------------------------------- - 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 + call stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, Target_Q, Target_PS, & + Nudge_zonal_filter, ZM, Zonal_Bamp2d, ZonalBamp3d) ! Now load Dry Static Energy values for Target !--------------------------------------------- - if(Nudge_TSmode == 0) then + if (Nudge_TSmode == 0) then ! DSE tendencies from Temperature only - !--------------------------------------- - do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol - Target_S(:ncol,:pver,lchnk)=cpair*Target_T(:ncol,:pver,lchnk) - end do - elseif(Nudge_TSmode == 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) + 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 + ! 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) + end do endif ! 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) + + elseif (Nudge_TimeScale_Opt == 1) then + + Update_Nudge = (curr_time >= Nudge_next_time) + if ((Before_End) .and. (Update_Nudge)) then + ! Increment the Nudge times by the current interval + Nudge_curr_time = Nudge_next_time + Nudge_next_time = Nudge_curr_time + Nudge_delta + endif + date_diff = Nudge_next_time - curr_time + call ESMF_TimeIntervalGet(date_diff, S=DeltaT, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') Tscale=float(Nudge_Step)/float(DeltaT) + 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)) & + 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)) & + 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)) & + 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)) & + 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)) & + 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 + ! 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_Model) ! End Routine !------------ @@ -1453,17 +1222,18 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) 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) + 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) @@ -1476,159 +1246,6 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) 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 - 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 - !================================================================ - !================================================================ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) @@ -1655,31 +1272,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 +1307,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,27 +1320,28 @@ 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 @@ -1736,38 +1355,37 @@ 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(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(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(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) + 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() @@ -1906,4 +1524,13 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) end subroutine calc_DryStaticEnergy !================================================================ + !================================================================ + subroutine chkrc(rc, mes) + integer, intent(in) :: rc ! return code from time management library + character(len=*), intent(in) :: mes ! error message + if ( rc == ESMF_SUCCESS ) return + write(iulog,*) mes + call endrun ('CHKRC') + end subroutine chkrc + end module nudging From 17770d2b449032a78f256868b0bf128ae4971a26 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 27 Oct 2025 09:38:37 +0100 Subject: [PATCH 02/25] fixed compiler issues --- src/cpl/nuopc/atm_stream_nudging.F90 | 105 ++++++++++++++------------- src/physics/cam/nudging.F90 | 79 +++++++++++--------- 2 files changed, 96 insertions(+), 88 deletions(-) diff --git a/src/cpl/nuopc/atm_stream_nudging.F90 b/src/cpl/nuopc/atm_stream_nudging.F90 index c57464eb08..6b5459c206 100644 --- a/src/cpl/nuopc/atm_stream_nudging.F90 +++ b/src/cpl/nuopc/atm_stream_nudging.F90 @@ -9,7 +9,8 @@ module atm_stream_nudging use ESMF , only : ESMF_Clock, ESMF_Mesh use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT use ESMF , only : ESMF_Finalize, ESMF_LogFoundError - use ESMF , only : ESMF_Time, ESMF_Time_Interval, ESMF_Time_Get + use ESMF , only : ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_TimeGet, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet use nuopc_shr_methods , only : chkerr use dshr_strdata_mod , only : shr_strdata_type use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs @@ -26,14 +27,7 @@ module atm_stream_nudging type(shr_strdata_type) :: sdat_nudging - character(len=CL) :: stream_nudging_data_filename - character(len=CL) :: stream_nudging_mesh_filename - integer :: stream_nudging_year_first ! first year in stream to use - integer :: stream_nudging_year_last ! last year in stream to use - integer :: stream_nudging_year_align ! align stream_year_firstnudging with - - character(len=2) :: stream_varlist_nudging(5) = (/'U ', 'V ','T ','Q ','PS'/) - type(ESMF_Clock) :: nudging_clock + character(len=2) :: nudging_varlist(5) = (/'U ', 'V ','T ','Q ','PS'/) character(*),parameter :: u_FILE_u = __FILE__ @@ -46,32 +40,39 @@ subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, nudge_beg_ti use dshr_strdata_mod, only: shr_strdata_init_from_inline + ! input/output arguments character(len=*) , intent(in) :: nudge_path character(len=*) , intent(in) :: nudge_files(:) character(len=*) , intent(in) :: nudge_mesh type(ESMF_Time) , intent(in) :: nudge_beg_time type(ESMF_Time) , intent(in) :: nudge_end_time integer , intent(in) :: nudge_force_opt - integer , intent(in) :: nudge_model_step + integer , intent(in) :: nudge_model_step ! local variables + integer :: rc + integer :: nfile + integer :: nudge_year_first + integer :: nudge_year_last + type(ESMf_TimeInterval) :: nudge_step + type(ESMF_Clock) :: nudging_clock character(*), parameter :: sub = "('stream_nudging_init')" !---------------------------------------------------------------- ! Create a Model_Clock for nudging - this is different than the CAM clock - it's time step is from the input ! nudging information - call ESMF_TimeIntervalSet(step_size, s=nudge_model_step, rc=rc) + call ESMF_TimeIntervalSet(nudge_step, s=nudge_model_step, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if - call ESMF_TimeGet(nudge_beg_time, year=stream_nudging_year_first, rc=rc) + call ESMF_TimeGet(nudge_beg_time, year=nudge_year_first, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if - call ESMF_TimeGet(nudge_end_time, year=stream_nudging_year_last, rc=rc) + call ESMF_TimeGet(nudge_end_time, year=nudge_year_last, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if @@ -80,7 +81,7 @@ subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, nudge_beg_ti ! the only use of the model clock in CDEPS is to extract the calendar nudging_clock = ESMF_ClockCreate(name="Nudging Model Clock", & - nudge_model_step, nudge_beg_time, stop_time=nudge_end_time, rc=rc) + nudge_step, nudge_beg_time, stop_time=nudge_end_time, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if @@ -90,13 +91,13 @@ subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, nudge_beg_ti if (masterproc) then write(iulog,'(a)' ) ' ' write(iulog,'(a,i8)') 'stream nudging settings:' - write(iulog,'(a,a)' ) ' stream_nudging_mesh_filename = ',trim(nudge_mesh) - write(iulog,'(a,a,a)') ' stream_varlist_nudging = ','U,V,T,Q,PS' - write(iulog,'(a,i8)') ' stream_nudging_year_first = ',nudge_year_first - write(iulog,'(a,i8)') ' stream_nudging_year_last = ',nudge_year_last - write(iulog,'(a,i8)') ' stream_nudging_year_align = ',nudge_year_align - do nfile = 1,size(stream_nudging_data_filenames) - write(iulog,'(a,i8,a)' ) ' stream_nudging_data_filename = ',nfile,trim(stream_nudging_data_filename(nfile)) + write(iulog,'(a,a)' ) ' nudge_mesh = ',trim(nudge_mesh) + write(iulog,'(a,a,a)') ' nudge_varlist = ','U,V,T,Q,PS' + write(iulog,'(a,i8)') ' nudge_year_first = ',nudge_year_first + write(iulog,'(a,i8)') ' nudge_year_last = ',nudge_year_last + write(iulog,'(a,i8)') ' nudge_year_align = ',nudge_year_first + do nfile = 1,size(nudge_files) + write(iulog,'(a,i8,a)' ) ' nudge_files = ',nfile,trim(nudge_files(nfile)) end do write(iulog,'(a)' ) ' ' endif @@ -109,30 +110,30 @@ subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, nudge_beg_ti tintalgo = 'linear' else write(iulog,*) 'NUDGING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt - call endrun('nudging_timestep_init:: ERROR unknown Nudging_Force_Opt') + call endrun('nudging_timestep_init:: ERROR unknown Nudge_Force_Opt') endif ! Initialize the cdeps data type sdat_nudging - call shr_strdata_init_from_inline(sdat_nudging, & - my_task = iam, & - logunit = iulog, & - compname = 'ATM', & - model_clock = nudging_clock, & - model_mesh = nudging_mesh, & - stream_meshfile = trim(stream_nudging_mesh_filename), & - stream_filenames = stream_nudging_data_filenames, & - stream_yearFirst = stream_nudging_year_first, & - stream_yearLast = stream_nudging_year_last, & - stream_yearAlign = stream_nudging_year_align, & - stream_fldlistFile = stream_varlist_nudging, & - stream_fldListModel = stream_varlist_nudging, & - stream_lev_dimname = 'null', & - stream_mapalgo = 'bilinear', & - stream_offset = 0, & - stream_taxmode = 'limit', & - stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = tintalgo, & - stream_name = 'NUDGING forcing data ', & + call shr_strdata_init_from_inline(sdat_nudging, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = nudge_clock, & + model_mesh = nudge_mesh, & + stream_meshfile = trim(nudge_mesh_filename), & + stream_filenames = nudge_data_filenames, & + stream_yearFirst = nudge_year_first, & + stream_yearLast = nudge_year_last, & + stream_yearAlign = nudge_year_align, & + stream_fldlistFile = nudge_varlist, & + stream_fldListModel = nudge_varlist, & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'limit', & + stream_dtlimit = 1.0e30_r8, & ! change dtlimit to be twice the step size + stream_tintalgo = tintalgo, & + stream_name = 'NUDGING forcing data ', & rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) @@ -143,7 +144,7 @@ end subroutine stream_nudging_init !================================================================ subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, Target_Q, Target_PS, & - Nudge_zonal_filter) + Nudge_ZonalFilter, ZM, Zonal_Bamp2d, Zonal_Bamp3d) use dshr_methods_mod , only : dshr_fldbun_getfldptr use dshr_strdata_mod , only : shr_strdata_advance @@ -165,7 +166,7 @@ subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, real(r8) , intent(in) :: Zonal_Bamp2d(:) real(r8) , intent(in) :: Zonal_Bamp3d(:,:) - ! local variables + ! Local variables integer :: rc ! ESMF error return integer :: istat ! allocate return integer :: nvar ! variable index @@ -179,7 +180,7 @@ subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, 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), pointer :: dataptr1d(:) real(r8),allocatable :: Tmp3D(:,:,:) real(r8),allocatable :: Tmp2D(:,:) character(len=*), parameter :: sub = "(stream_nudging_interp) " @@ -229,29 +230,29 @@ subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, end do end do - ! Apply zonal mean filtering + ! 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(stream_varlist_nudging(nvar) == 'U')) then + if (trim(stream_varlist_nudging(nvar) == 'U')) then do lchnk = begchunk,endchunk ncol = phys_state(lchnk)%ncol Target_U(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) end do - else if (trim(stream_varlist_nudging(nvar) == 'V')) then + else if (trim(stream_varlist_nudging(nvar) == 'V')) then do lchnk = begchunk,endchunk ncol = phys_state(lchnk)%ncol Target_V(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) end do - else if (trim(stream_varlist_nudging(nvar) == 'T')) then + else if (trim(stream_varlist_nudging(nvar) == 'T')) then do lchnk = begchunk,endchunk ncol = phys_state(lchnk)%ncol Target_T(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) end do - else if (trim(stream_varlist_nudging(nvar) == 'Q')) then + else if (trim(stream_varlist_nudging(nvar) == 'Q')) then do lchnk = begchunk,endchunk ncol = phys_state(lchnk)%ncol Target_Q(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) @@ -259,7 +260,7 @@ subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, end if else if (trim(stream_varlist_nudging(nvar)) == 'PS') then - + call dshr_fldbun_getFldPtr(sdat_nudging%pstrm(1)%fldbun_model, stream_varlist_nudging(nvar), fldptr2=dataptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) @@ -289,4 +290,4 @@ subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, end subroutine stream_nudging_interp -end module atm_stream_nudging +end module atm_stream_nudging diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index cba45f6a4b..3608aa256f 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -5,7 +5,7 @@ module nudging ! toward specified values from analyses. ! ! Authors: Patrick Callaghan (original) -! Mariana Vertenstein (2025) refactored for CDEPS capability +! Mariana Vertenstein (2025) refactored for CDEPS capability ! ! Description: ! @@ -196,6 +196,7 @@ module nudging 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 atm_stream_nudging, only : stream_nudging_init, stream_nudging_interp ! Set all Global values and routines to private by default ! and then explicitly set their exposure. @@ -221,17 +222,25 @@ module nudging logical :: Nudge_ON =.false. logical :: Nudge_Initialized =.false. character(len=cl) :: Nudge_Path - type(ESMF_Mesh) :: Mudge_Mesh + type(ESMF_Mesh) :: Nudge_Mesh integer :: Nudge_Step integer :: Model_Step - type(ESMF_Time) :: Model_curr_time - type(ESMF_Time) :: Model_next_time + type(ESMF_Time) :: Nudge_Beg_year + type(ESMF_Time) :: Nudge_Beg_month + type(ESMF_Time) :: Nudge_Beg_day + type(ESMF_Time) :: Nudge_Beg_sec + type(ESMF_Time) :: Nudge_End_year + type(ESMF_Time) :: Nudge_End_month + type(ESMF_Time) :: Nudge_End_day + type(ESMF_Time) :: Nudge_End_sec type(ESMF_Time) :: Nudge_Beg_time type(ESMF_Time) :: Nudge_End_time + type(ESMF_Time) :: Model_curr_time + type(ESMF_Time) :: Model_next_time type(ESMF_Time) :: Nudge_curr_time type(ESMF_Time) :: Nudge_next_time integer :: Model_Times_Per_Day - type(ESMF_Time_Interval) :: Model_delta + type(ESMF_TimeInterval) :: Model_delta integer :: Nudge_File_Times_Per_Day type(ESMF_Time_Interval) :: Nudge_File_delta integer :: Nudge_Force_Opt @@ -300,7 +309,7 @@ module nudging real(r8),allocatable:: Nudge_Qstep (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable:: Nudge_PSstep(:,:) !(pcols,begchunk:endchunk) - integer, parameter :: maxfiles = 1000 + integer, parameter :: maxfiles = 1000 character(len=CL) :: nudge_filenames(maxfiles) contains @@ -364,7 +373,7 @@ subroutine nudging_readnl(nlfile) Nudge_File_Times_per_Day = 4 Nudge_Path = './Data/YOTC_ne30np4_001/' Nudge_Filenames(:) = ' ' - Nudge_Mesh = ' ' + Nudge_Mesh = ' ' Nudge_Beg_Year = 2008 Nudge_Beg_Month = 5 Nudge_Beg_Day = 1 @@ -604,7 +613,7 @@ subroutine nudging_readnl(nlfile) call endrun('nudging_readnl:: ERROR in namelist') endif - + ! End Routine !------------ @@ -713,7 +722,7 @@ subroutine nudging_init ! Ensure that the Model_Step is not smaller then one timestep ! and not larger then the Nudge_Step. !-------------------------------------------------------- - + ! Get the CAM time step size dtime = get_step_size() Model_Step = 86400/Model_Times_Per_Day @@ -736,7 +745,7 @@ subroutine nudging_init ! Set module time and time interval variables !------------------------------------------------ - + call get_curr_date(Year, Month, Day, Sec) call ESMF_TimeSet(curr_time, year=Year, month=Month, day=Day, sec=Sec, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_currtime') @@ -747,7 +756,7 @@ subroutine nudging_init call ESMF_TimeSet(Nudge_end_time, year=Nudge_End_Year, month=Nudge_End_Month, day=Nudge_End_Day, sec=Nudge_End_Sec, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_end_time') - call ESMF_Time_Interval_Set(Model_delta, sec=Model_Step, rc=rc) + call ESMF_Time_Interval_Set(Model_delta, sec=Model_Step, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Model_step') call ESMF_TimeIntervalSet(Nudge_File_delta, s=Nudge_File_Step, rc=rc) @@ -755,7 +764,7 @@ subroutine nudging_init ! Initialize the time relative to the nudging window !------------------------------------------------ - + After_Beg = (Model_curr_time >= Nudge_beg_time) Before_End = (Nudge_end_time >= Model_curr_time) @@ -825,7 +834,7 @@ subroutine nudging_init Nudge_Initialized = .true. if (masterproc) then - + ! Informational Output !--------------------------- write(iulog,*) ' ' @@ -898,7 +907,7 @@ subroutine nudging_init ! Initialize nudging stream data type !---------------------------------------------------------- - call stream_nudging_init(Nudge_Path, Nudge_files, Nudge_Mesh, Nudge_Beg_Time, Nudge_End_time, Nudge_Force_Opt, & + call stream_nudging_init(Nudge_Path, Nudge_files, Nudge_Mesh, Nudge_Beg_Time, Nudge_End_time, Nudge_Force_Opt, & Nudge_Model_Step) ! Initialize Nudging Coeffcient profiles in local arrays @@ -971,19 +980,18 @@ subroutine nudging_timestep_init(phys_state) ! Local values !---------------- - integer :: Year,Month,Day,Sec - logical :: Update_Model, Sync_Error - logical :: After_Beg, Before_End - integer :: lchnk,ncol,indw - type(ESMF_Time) :: Date1,Date2 - type(ESMF_TimeInterval) :: DateDiff - type(ESMF_Time) :: curr_time - type(ESMF_Time_Interval) :: date_diff - integer :: DeltaT - real(r8) :: Tscale - real(r8) :: Tfrac - integer :: rc - real(r8) :: Sbar,Qbar,Wsum + integer :: Year,Month,Day,Sec + logical :: Update_Model, Sync_Error + logical :: After_Beg, Before_End + integer :: lchnk,ncol,indw + type(ESMF_TimeInterval) :: DateDiff + type(ESMF_Time) :: curr_time + type(ESMF_TimeInterval) :: date_diff + integer :: DeltaT + real(r8) :: Tscale + real(r8) :: Tfrac + real(r8) :: Sbar,Qbar,Wsum + integer :: rc character(len=*), parameter :: sub = "(nudging_timestep_init) " !-------------------------------------------------------------- @@ -993,13 +1001,12 @@ subroutine nudging_timestep_init(phys_state) call endrun('nudging_timestep_init:: Nudging NOT Initialized') endif - !------------------------------------------------------- - ! Determine if the current model time is AFTER the begining nudging time + ! Determine if the current CAM time is AFTER the begining nudging time ! and if it is BEFORE the ending nudging time. !------------------------------------------------------- - ! Get Current model time + ! Get Current CAM time call get_curr_date(Year,Month,Day,Sec) call ESMF_TimeSet(curr_time, year=Year, month=Month, day=Day, sec=Sec) @@ -1017,13 +1024,13 @@ subroutine nudging_timestep_init(phys_state) if ((Before_End) .and. (Update_Model)) then ! Increment the Model times by the current interval - Model_curr_time = Model_next_time + Model_curr_time = Model_next_time Model_next_time = Model_next_time + Model_delta ! 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. - Sync_Error = (Model_curr_time >= Model_next_time) + Sync_Error = (Model_curr_time >= Model_next_time) if(Sync_Error) then Model_curr_time = curr_time Model_next_time = curr_time + Model_delta @@ -1136,17 +1143,17 @@ subroutine nudging_timestep_init(phys_state) Update_Nudge = (curr_time >= Nudge_next_time) if ((Before_End) .and. (Update_Nudge)) then ! Increment the Nudge times by the current interval - Nudge_curr_time = Nudge_next_time + Nudge_curr_time = Nudge_next_time Nudge_next_time = Nudge_curr_time + Nudge_delta endif - date_diff = Nudge_next_time - curr_time + date_diff = Nudge_next_time - curr_time call ESMF_TimeIntervalGet(date_diff, S=DeltaT, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') Tscale=float(Nudge_Step)/float(DeltaT) else - if (masterproc) then + 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') @@ -1183,7 +1190,7 @@ subroutine nudging_timestep_init(phys_state) ! write(iulog,*) 'PFC: Nudge_Xstep arrays updated:' ! endif - endif ! ((Before_End) .and. Update_Model) + endif ! ((Before_End) .and. Update_Model) ! End Routine !------------ From e7f5409ad57e357a84e8c3f82611be6e13c6eb5e Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 27 Oct 2025 10:59:06 +0100 Subject: [PATCH 03/25] more refactor of code --- src/cpl/nuopc/atm_comp_nuopc.F90 | 2 +- src/cpl/nuopc/atm_shr.F90 | 10 ++ src/cpl/nuopc/atm_stream_nudging.F90 | 94 ++++++----- src/physics/cam/nudging.F90 | 234 +++++++++++++-------------- 4 files changed, 168 insertions(+), 172 deletions(-) create mode 100644 src/cpl/nuopc/atm_shr.F90 diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 10150e4dc2..606b463338 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -69,6 +69,7 @@ module atm_comp_nuopc use pio , only : pio_noerr, pio_bcast_error, pio_internal_error, pio_seterrorhandling use pio , only : pio_def_var, pio_get_var, pio_put_var, PIO_INT use ioFileMod + use atm_shr , only : model_mesh !$use omp_lib , only : omp_set_num_threads implicit none @@ -129,7 +130,6 @@ module atm_comp_nuopc real(R8) , parameter :: grid_tol = 1.e-2_r8 ! tolerance for calculated lat/lon vs read in - type(ESMF_Mesh) :: model_mesh ! model_mesh type(ESMF_Clock) :: model_clock ! model_clock !=============================================================================== diff --git a/src/cpl/nuopc/atm_shr.F90 b/src/cpl/nuopc/atm_shr.F90 new file mode 100644 index 0000000000..84a4c40f15 --- /dev/null +++ b/src/cpl/nuopc/atm_shr.F90 @@ -0,0 +1,10 @@ +module atm_shr + + use ESMF, only : ESMF_Mesh + + implicit none + public + + type(ESMF_Mesh) :: model_mesh ! model_mesh + +end module atm_shr diff --git a/src/cpl/nuopc/atm_stream_nudging.F90 b/src/cpl/nuopc/atm_stream_nudging.F90 index 6b5459c206..31a87cdd65 100644 --- a/src/cpl/nuopc/atm_stream_nudging.F90 +++ b/src/cpl/nuopc/atm_stream_nudging.F90 @@ -18,6 +18,7 @@ module atm_stream_nudging use spmd_utils , only : masterproc, iam use cam_logfile , only : iulog use cam_abortutils , only : endrun + use atm_shr , only : model_mesh implicit none private @@ -35,38 +36,32 @@ module atm_stream_nudging contains !============================================================================== - subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, nudge_beg_time, nudge_end_time, nudge_force_opt, & - nudge_model_step) + subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, & + nudge_beg_time, nudge_end_time, model_update_interval, nudge_force_opt) use dshr_strdata_mod, only: shr_strdata_init_from_inline ! input/output arguments - character(len=*) , intent(in) :: nudge_path - character(len=*) , intent(in) :: nudge_files(:) - character(len=*) , intent(in) :: nudge_mesh - type(ESMF_Time) , intent(in) :: nudge_beg_time - type(ESMF_Time) , intent(in) :: nudge_end_time - integer , intent(in) :: nudge_force_opt - integer , intent(in) :: nudge_model_step + character(len=*) , intent(in) :: nudge_path + character(len=*) , intent(in) :: nudge_files(:) + character(len=*) , intent(in) :: nudge_mesh + type(ESMF_Time) , intent(in) :: nudge_beg_time + type(ESMF_Time) , intent(in) :: nudge_end_time + type(ESMF_TimeInterval) , intent(in :: model_udpate_interval + integer , intent(in) :: nudge_force_opt ! local variables integer :: rc integer :: nfile integer :: nudge_year_first integer :: nudge_year_last - type(ESMf_TimeInterval) :: nudge_step type(ESMF_Clock) :: nudging_clock character(*), parameter :: sub = "('stream_nudging_init')" !---------------------------------------------------------------- - ! Create a Model_Clock for nudging - this is different than the CAM clock - it's time step is from the input + ! Create a nudging_clock for nudging - this is different than the CAM clock - it's time step is from the input ! nudging information - call ESMF_TimeIntervalSet(nudge_step, s=nudge_model_step, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - call ESMF_TimeGet(nudge_beg_time, year=nudge_year_first, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) @@ -81,7 +76,7 @@ subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, nudge_beg_ti ! the only use of the model clock in CDEPS is to extract the calendar nudging_clock = ESMF_ClockCreate(name="Nudging Model Clock", & - nudge_step, nudge_beg_time, stop_time=nudge_end_time, rc=rc) + model_update_interval, nudge_beg_time, stop_time=nudge_end_time, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if @@ -114,26 +109,26 @@ subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, nudge_beg_ti endif ! Initialize the cdeps data type sdat_nudging - call shr_strdata_init_from_inline(sdat_nudging, & - my_task = iam, & - logunit = iulog, & - compname = 'ATM', & - model_clock = nudge_clock, & - model_mesh = nudge_mesh, & - stream_meshfile = trim(nudge_mesh_filename), & - stream_filenames = nudge_data_filenames, & - stream_yearFirst = nudge_year_first, & - stream_yearLast = nudge_year_last, & - stream_yearAlign = nudge_year_align, & - stream_fldlistFile = nudge_varlist, & - stream_fldListModel = nudge_varlist, & - stream_lev_dimname = 'null', & - stream_mapalgo = 'bilinear', & - stream_offset = 0, & - stream_taxmode = 'limit', & - stream_dtlimit = 1.0e30_r8, & ! change dtlimit to be twice the step size - stream_tintalgo = tintalgo, & - stream_name = 'NUDGING forcing data ', & + call shr_strdata_init_from_inline(sdat_nudging, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = nudge_clock, & + model_mesh = model_mesh, & + stream_meshfile = trim(nudge_mesh), & + stream_filenames = nudge_files, & + stream_yearFirst = nudge_year_first, & + stream_yearLast = nudge_year_last, & + stream_yearAlign = nudge_year_align, & + stream_fldlistFile = nudge_varlist, & + stream_fldListModel = nudge_varlist, & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'limit', & + stream_dtlimit = 1.0e30_r8, & ! change dtlimit to be twice the step size + stream_tintalgo = tintalgo, & + stream_name = 'NUDGING forcing data ', & rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) @@ -143,8 +138,9 @@ end subroutine stream_nudging_init !================================================================ - subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, Target_Q, Target_PS, & - Nudge_ZonalFilter, ZM, Zonal_Bamp2d, Zonal_Bamp3d) + subroutine stream_nudging_interp(Model_Update_Time, & + Nudge_ZonalFilter, ZM, Zonal_Bamp2d, Zonal_Bamp3d, & + Target_U, Target_V, Target_T, Target_Q, Target_PS) use dshr_methods_mod , only : dshr_fldbun_getfldptr use dshr_strdata_mod , only : shr_strdata_advance @@ -156,15 +152,15 @@ subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, use cam_abortutils , only : endrun, handle_allocate_error ! input/output variables - type(ESMF_Time) , intent(in) :: model_nudge_time - real(r8) , intent(in) :: Target_U(pcols,pver,begchunk:endchunk) - real(r8) , intent(in) :: Target_V(pcols,pver,begchunk:endchunk) - real(r8) , intent(in) :: Target_T(pcols,pver,begchunk:endchunk) - real(r8) , intent(in) :: Target_Q(pcols,pver,begchunk:endchunk) - logical , intent(in) :: Nudge_ZonalFilter - type(ZonalMean_t) , intent(in) :: ZM - real(r8) , intent(in) :: Zonal_Bamp2d(:) - real(r8) , intent(in) :: Zonal_Bamp3d(:,:) + type(ESMF_Time) , intent(in) :: Model_Update_Time + logical , intent(in) :: Nudge_ZonalFilter + type(ZonalMean_t) , intent(in) :: ZM + real(r8) , intent(in) :: Zonal_Bamp2d(:) + real(r8) , intent(in) :: Zonal_Bamp3d(:,:) + 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) ! Local variables integer :: rc ! ESMF error return @@ -187,7 +183,7 @@ subroutine stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, !----------------------------------------------------------------------- ! Extract YMD from model_nudge_time - call ESMF_TimeGet(model_nudge_time, year=year, month=month, day=day, sec=sec, rc=rc) + call ESMF_TimeGet(Model_Update_Time, year=year, month=month, day=day, sec=sec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 3608aa256f..acd3d8f22e 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -223,8 +223,10 @@ module nudging logical :: Nudge_Initialized =.false. character(len=cl) :: Nudge_Path type(ESMF_Mesh) :: Nudge_Mesh + integer :: Nudge_File_Step + integer :: Nudge_Times_Per_Day integer :: Nudge_Step - integer :: Model_Step + type(ESMF_TimeInterval) :: Nudge_delta type(ESMF_Time) :: Nudge_Beg_year type(ESMF_Time) :: Nudge_Beg_month type(ESMF_Time) :: Nudge_Beg_day @@ -237,10 +239,7 @@ module nudging type(ESMF_Time) :: Nudge_End_time type(ESMF_Time) :: Model_curr_time type(ESMF_Time) :: Model_next_time - type(ESMF_Time) :: Nudge_curr_time - type(ESMF_Time) :: Nudge_next_time - integer :: Model_Times_Per_Day - type(ESMF_TimeInterval) :: Model_delta + type(ESMF_Time) :: Nudge_file_next_time integer :: Nudge_File_Times_Per_Day type(ESMF_Time_Interval) :: Nudge_File_delta integer :: Nudge_Force_Opt @@ -339,7 +338,7 @@ subroutine nudging_readnl(nlfile) 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_Times_Per_Day, & + Model_Update_Times_Per_Day, & Nudge_File_Times_Per_Day, & Nudge_Ucoef , Nudge_Uprof, & Nudge_Vcoef , Nudge_Vprof, & @@ -369,7 +368,7 @@ subroutine nudging_readnl(nlfile) ! Set Default Namelist values !----------------------------- Nudge_Model = .false. - Model_Times_Per_Day = 4 + Model_Update_Times_Per_Day = 4 Nudge_File_Times_per_Day = 4 Nudge_Path = './Data/YOTC_ne30np4_001/' Nudge_Filenames(:) = ' ' @@ -438,11 +437,11 @@ subroutine nudging_readnl(nlfile) end if end do - call MPI_bcast(Model_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Times_Per_Day') - call MPI_bcast(Nudge_File_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Times_Per_Day') + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_File_Times_Per_Day') + + call MPI_bcast(Model_Update_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Update_Times_Per_Day') call MPI_bcast(Nudge_Beg_Year, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Year') @@ -719,28 +718,28 @@ subroutine nudging_init ! 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. + ! Ensure that the Model_Update_Step is not smaller then one timestep + ! and not larger then the Nudge_File_Step. !-------------------------------------------------------- ! Get the CAM time step size dtime = get_step_size() - Model_Step = 86400/Model_Times_Per_Day + Model_Update_Step = 86400/Model_Update_Times_Per_Day Nudge_File_Step=86400/Nudge_File_Times_Per_Day - if(Model_Step < dtime) then + if(Model_Update_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,*) 'NUDGING: Model_Update_Step cannot be less than a model timestep' + write(iulog,*) 'NUDGING: Setting Model_Update_Step=dtime , dtime=',dtime write(iulog,*) ' ' - Model_Step = dtime + Model_Update_Step = dtime endif - if(Model_Step > Nudge_File_Step) then + if(Model_Update_Step > Nudge_File_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,*) 'NUDGING: Model_Update_Step cannot be more than Nudge_Step' + write(iulog,*) 'NUDGING: Setting Model_Update_Step=Nudge_Step, Nudge_Step=',Nudge_Step write(iulog,*) ' ' - Model_Step = Nudge_File_Step + Model_Update_Step = Nudge_File_Step endif ! Set module time and time interval variables @@ -748,7 +747,7 @@ subroutine nudging_init call get_curr_date(Year, Month, Day, Sec) call ESMF_TimeSet(curr_time, year=Year, month=Month, day=Day, sec=Sec, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_currtime') + call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_Update_currtime') call ESMF_TimeSet(Nudge_beg_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_beg_time') @@ -756,8 +755,8 @@ subroutine nudging_init call ESMF_TimeSet(Nudge_end_time, year=Nudge_End_Year, month=Nudge_End_Month, day=Nudge_End_Day, sec=Nudge_End_Sec, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_end_time') - call ESMF_Time_Interval_Set(Model_delta, sec=Model_Step, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Model_step') + call ESMF_Time_Interval_Set(Model_Update_Interval, sec=Model_Update_Step, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Model_Update_step') call ESMF_TimeIntervalSet(Nudge_File_delta, s=Nudge_File_Step, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Nudge_step') @@ -765,22 +764,22 @@ subroutine nudging_init ! Initialize the time relative to the nudging window !------------------------------------------------ - After_Beg = (Model_curr_time >= Nudge_beg_time) - Before_End = (Nudge_end_time >= Model_curr_time) + After_Beg = (curr_time >= Nudge_beg_time) + Before_End = (curr_time <= Nudge_end_time) if ((After_Beg) .and. (Before_End)) then - ! Set Time indicies so that the next call to timestep_init will initialize the Model_curr_time - call ESMF_TimeSet(Model_next_time, year=Year, month=Month, day=Day, sec=(Sec/Model_Step)*Model_Step) - call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_next_time') + ! Set Time indicies so that the next call to timestep_init will initialize the Model_Update_curr_time + call ESMF_TimeSet(Model_Update_next_time, year=Year, month=Month, day=Day, sec=(Sec/Model_Update_Step)*Model_Update_Step) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_Update_next_time') call ESMF_TimeSet(Nudge_next_time, year=Year, month=Month, day=Day, sec=(Sec/Nudge_Step)*Nudge_Step) call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_next_time') elseif (.not.After_Beg) then - ! Set Time indicies to Nudging start so next call to timestep_init will initialize the Model_curr_time - call ESMF_TimeSet(Model_next_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec) - call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_next_time') + ! Set Time indicies to Nudging start so next call to timestep_init will initialize the Model_Update_curr_time + call ESMF_TimeSet(Model_Update_next_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_Update_next_time') call ESMF_TimeSet(Nudge_next_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec) call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_next_time') @@ -841,54 +840,54 @@ 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_Force_Opt =',Nudge_Force_Opt - write(iulog,*) 'NUDGING: Nudge_TimeScale_Opt =',Nudge_TimeScale_Opt - write(iulog,*) 'NUDGING: Nudge_TSmode =',Nudge_TSmode - write(iulog,*) 'NUDGING: Model_Times_Per_Day =',Model_Times_Per_Day - write(iulog,*) 'NUDGING: Nudge_File_Times_Per_Day =',Model_Times_Per_Day - write(iulog,*) 'NUDGING: Nudge_File_Step =',Nudge_File_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,*) 'NUDGING: Nudge_Model =',Nudge_Model + write(iulog,*) 'NUDGING: Nudge_Path =',Nudge_Path + 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: Model_Update_Times_Per_Day =',Model_Update_Times_Per_Day + write(iulog,*) 'NUDGING: Model_Update_Step =',Model_Update_Step + write(iulog,*) 'NUDGING: Nudge_File_Times_Per_Day =',Nudge_File_Times_Per_Day + write(iulog,*) 'NUDGING: Nudge_File_Step =',Nudge_File_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,*) ' ' endif ! (masterproc) then @@ -907,8 +906,8 @@ subroutine nudging_init ! Initialize nudging stream data type !---------------------------------------------------------- - call stream_nudging_init(Nudge_Path, Nudge_files, Nudge_Mesh, Nudge_Beg_Time, Nudge_End_time, Nudge_Force_Opt, & - Nudge_Model_Step) + call stream_nudging_init(Nudge_Path, Nudge_files, Nudge_Mesh, & + Nudge_Beg_Time, Nudge_End_time, Model_Update_Step, Nudge_Force_Opt) ! Initialize Nudging Coeffcient profiles in local arrays ! Load zeros into nudging arrays @@ -984,7 +983,6 @@ subroutine nudging_timestep_init(phys_state) logical :: Update_Model, Sync_Error logical :: After_Beg, Before_End integer :: lchnk,ncol,indw - type(ESMF_TimeInterval) :: DateDiff type(ESMF_Time) :: curr_time type(ESMF_TimeInterval) :: date_diff integer :: DeltaT @@ -1015,26 +1013,36 @@ subroutine nudging_timestep_init(phys_state) After_Beg = (curr_time >= Nudge_beg_time) Before_End = (curr_time <= Nudge_end_time) + !---------------------------------------------------------------- + ! 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 + Nudge_ON = .true. + else + Nudge_ON = .false. + endif + !-------------------------------------------------------------- ! When past the NEXT time, Update Model Arrays and time indices !-------------------------------------------------------------- - Update_Model = (curr_time >= Model_next_time) + Update_Model = (curr_time >= Model_Update_next_time) if ((Before_End) .and. (Update_Model)) then ! Increment the Model times by the current interval - Model_curr_time = Model_next_time - Model_next_time = Model_next_time + Model_delta + Model_Update_curr_time = Model_Update_next_time + Model_Update_next_time = Model_Update_next_time + Model_Update_Interval ! 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. - Sync_Error = (Model_curr_time >= Model_next_time) + ! time to a Model_Update_Step after the current time. + Sync_Error = (Model_Update_curr_time >= Model_Update_next_time) if(Sync_Error) then - Model_curr_time = curr_time - Model_next_time = curr_time + Model_delta - write(iulog,*) 'NUDGING: WARNING - Model_Time Sync ERROR... CORRECTED' + Model_Update_curr_time = curr_time + Model_Update_next_time = curr_time + Model_Update_Interval + write(iulog,*) 'NUDGING: WARNING - Model_Update_Time Sync ERROR... CORRECTED' endif ! Load values at Current into the Model arrays @@ -1087,33 +1095,17 @@ subroutine nudging_timestep_init(phys_state) call ZM%calc_amps(Model_PS,Zonal_Bamp2d) call ZM%eval_grid(Zonal_Bamp2d,Model_PS) endif - endif ! ((Before_End) .and. (Update_Model)) 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 - Nudge_ON = .true. - else - Nudge_ON = .false. - endif - - !------------------------------------------------------- - ! HERE Implement time dependence of Nudging Coefs HERE - !------------------------------------------------------- - - !--------------------------------------------------- - ! If Data arrays have changed update stepping arrays - !--------------------------------------------------- - if ((Before_End) .and. Update_Model) then + !------------------------------------------------------- + ! HERE Implement time dependence of Nudging Coefs HERE + !------------------------------------------------------- - ! Using cdeps: - ! Read new nudging data and interpolate to model grid and - ! Model_Curr_Year, Model_Curr_Month, Model_Curr_Day, Model_Curr_Sec + ! Using CDEPS: + ! Read new nudging data and interpolate to model grid and Model_Update_Time !--------------------------------------------------- - call stream_nudging_interp(Model_nudge_time, Target_U, Target_V, Target_T, Target_Q, Target_PS, & - Nudge_zonal_filter, ZM, Zonal_Bamp2d, ZonalBamp3d) + call stream_nudging_interp(Model_Update_Nudge_Time, & + Nudge_zonal_filter, ZM, Zonal_Bamp2d, ZonalBamp3d, & + Target_U, Target_V, Target_T, Target_Q, Target_PS) ! Now load Dry Static Energy values for Target !--------------------------------------------- @@ -1140,13 +1132,12 @@ subroutine nudging_timestep_init(phys_state) elseif (Nudge_TimeScale_Opt == 1) then - Update_Nudge = (curr_time >= Nudge_next_time) + Update_Nudge = (curr_time >= Nudge_file_next_time) if ((Before_End) .and. (Update_Nudge)) then ! Increment the Nudge times by the current interval - Nudge_curr_time = Nudge_next_time - Nudge_next_time = Nudge_curr_time + Nudge_delta + Nudge_file_next_time = Nudge_file_next_time + Nudge_file_delta endif - date_diff = Nudge_next_time - curr_time + date_diff = Nudge_file_next_time - curr_time call ESMF_TimeIntervalGet(date_diff, S=DeltaT, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') Tscale=float(Nudge_Step)/float(DeltaT) @@ -1228,7 +1219,7 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) 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 + if (Nudge_ON) then lchnk = phys_state%lchnk ncol = phys_state%ncol Phys_tend%u(:ncol,:pver) = Nudge_Ustep(:ncol,:pver,lchnk) @@ -1385,7 +1376,6 @@ subroutine nudging_final 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) From 3e6c6bd93d09c25e447feada43d43eb0b5857be0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 29 Oct 2025 22:22:03 +0100 Subject: [PATCH 04/25] migrated atm_stream_nuding.F90 code into nudging.F90 and added atm_shr.F90 for model_mesh and model_clock --- bld/namelist_files/namelist_definition.xml | 20 +- src/cpl/nuopc/atm_comp_nuopc.F90 | 18 +- src/cpl/nuopc/atm_import_export.F90 | 7 +- src/cpl/nuopc/atm_shr.F90 | 5 +- src/cpl/nuopc/atm_stream_ndep.F90 | 14 +- src/cpl/nuopc/atm_stream_nudging.F90 | 289 ------------ src/physics/cam/nudging.F90 | 522 ++++++++++++++------- 7 files changed, 394 insertions(+), 481 deletions(-) delete mode 100644 src/cpl/nuopc/atm_stream_nudging.F90 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index a3ce04d21c..8b9b828bff 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -220,32 +220,30 @@ Default: FALSE - - Full pathname of analyses data to use for nudging. - (e.g. '/$DIN_LOC_ROOT/atm/cam/nudging/') + Full pathnames of analyses data to use for nudging. Default: none - - Template for Nudging analyses file names. - (e.g. '%y/ERAI_ne30np4_L30.cam2.i.%y-%m-%d-%s.nc') + ESMF mesh file that corresponds to the nudging files Default: none - - Number of analyses files per day. + Number of analysis times per day in nudging filename(s). (e.g. 4 --> 6 hourly analyses) - Default: none + Default: 6 - Number of time to update model data per day. (e.g. 48 --> 1800 Second timestep) - Default: none + Default: 6 shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs - use shr_log_mod , only : errMsg => shr_log_errMsg - use spmd_utils , only : masterproc, iam - use cam_logfile , only : iulog - use cam_abortutils , only : endrun - use atm_shr , only : model_mesh - - implicit none - private - - public :: stream_nudging_init ! position datasets for dynamic nudging - public :: stream_nudging_interp ! interpolates between two years of nudging file data - - type(shr_strdata_type) :: sdat_nudging - - character(len=2) :: nudging_varlist(5) = (/'U ', 'V ','T ','Q ','PS'/) - - character(*),parameter :: u_FILE_u = __FILE__ - -!============================================================================== -contains -!============================================================================== - - subroutine stream_nudging_init(nudge_path, nudge_files, nudge_mesh, & - nudge_beg_time, nudge_end_time, model_update_interval, nudge_force_opt) - - use dshr_strdata_mod, only: shr_strdata_init_from_inline - - ! input/output arguments - character(len=*) , intent(in) :: nudge_path - character(len=*) , intent(in) :: nudge_files(:) - character(len=*) , intent(in) :: nudge_mesh - type(ESMF_Time) , intent(in) :: nudge_beg_time - type(ESMF_Time) , intent(in) :: nudge_end_time - type(ESMF_TimeInterval) , intent(in :: model_udpate_interval - integer , intent(in) :: nudge_force_opt - - ! local variables - integer :: rc - integer :: nfile - integer :: nudge_year_first - integer :: nudge_year_last - type(ESMF_Clock) :: nudging_clock - character(*), parameter :: sub = "('stream_nudging_init')" - !---------------------------------------------------------------- - - ! Create a nudging_clock for nudging - this is different than the CAM clock - it's time step is from the input - ! nudging information - - call ESMF_TimeGet(nudge_beg_time, year=nudge_year_first, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - call ESMF_TimeGet(nudge_end_time, year=nudge_year_last, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - ! TODO: should this be initialized with a gregorian calendar - ! the only use of the model clock in CDEPS is to extract the calendar - - nudging_clock = ESMF_ClockCreate(name="Nudging Model Clock", & - model_update_interval, nudge_beg_time, stop_time=nudge_end_time, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - ! Output info - - if (masterproc) then - write(iulog,'(a)' ) ' ' - write(iulog,'(a,i8)') 'stream nudging settings:' - write(iulog,'(a,a)' ) ' nudge_mesh = ',trim(nudge_mesh) - write(iulog,'(a,a,a)') ' nudge_varlist = ','U,V,T,Q,PS' - write(iulog,'(a,i8)') ' nudge_year_first = ',nudge_year_first - write(iulog,'(a,i8)') ' nudge_year_last = ',nudge_year_last - write(iulog,'(a,i8)') ' nudge_year_align = ',nudge_year_first - do nfile = 1,size(nudge_files) - write(iulog,'(a,i8,a)' ) ' nudge_files = ',nfile,trim(nudge_files(nfile)) - end do - write(iulog,'(a)' ) ' ' - endif - - ! Create stream data type sdat_nudging - - if (Nudge_Force_Opt == 0) then - tintalgo = 'upper' - elseif(Nudge_Force_Opt == 1) then - tintalgo = 'linear' - else - write(iulog,*) 'NUDGING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt - call endrun('nudging_timestep_init:: ERROR unknown Nudge_Force_Opt') - endif - - ! Initialize the cdeps data type sdat_nudging - call shr_strdata_init_from_inline(sdat_nudging, & - my_task = iam, & - logunit = iulog, & - compname = 'ATM', & - model_clock = nudge_clock, & - model_mesh = model_mesh, & - stream_meshfile = trim(nudge_mesh), & - stream_filenames = nudge_files, & - stream_yearFirst = nudge_year_first, & - stream_yearLast = nudge_year_last, & - stream_yearAlign = nudge_year_align, & - stream_fldlistFile = nudge_varlist, & - stream_fldListModel = nudge_varlist, & - stream_lev_dimname = 'null', & - stream_mapalgo = 'bilinear', & - stream_offset = 0, & - stream_taxmode = 'limit', & - stream_dtlimit = 1.0e30_r8, & ! change dtlimit to be twice the step size - stream_tintalgo = tintalgo, & - stream_name = 'NUDGING forcing data ', & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - end subroutine stream_nudging_init - - !================================================================ - - subroutine stream_nudging_interp(Model_Update_Time, & - Nudge_ZonalFilter, ZM, Zonal_Bamp2d, Zonal_Bamp3d, & - Target_U, Target_V, Target_T, Target_Q, Target_PS) - - use dshr_methods_mod , only : dshr_fldbun_getfldptr - use dshr_strdata_mod , only : shr_strdata_advance - use ppgrid , only : pcols, pver, begchunk,endchunk - use ppgrid , only : begchunk, endchunk - use time_manager , only : get_curr_date - use phys_grid , only : get_ncols_p - use zonal_mean_mod , only : ZonalMean_t - use cam_abortutils , only : endrun, handle_allocate_error - - ! input/output variables - type(ESMF_Time) , intent(in) :: Model_Update_Time - logical , intent(in) :: Nudge_ZonalFilter - type(ZonalMean_t) , intent(in) :: ZM - real(r8) , intent(in) :: Zonal_Bamp2d(:) - real(r8) , intent(in) :: Zonal_Bamp3d(:,:) - 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) - - ! Local variables - integer :: rc ! ESMF error return - integer :: istat ! allocate return - integer :: nvar ! variable index - integer :: ilev ! level index - integer :: icol ! column index - integer :: ichnk ! chunk index - integer :: g ! 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),allocatable :: Tmp3D(:,:,:) - real(r8),allocatable :: Tmp2D(:,:) - character(len=*), parameter :: sub = "(stream_nudging_interp) " - !----------------------------------------------------------------------- - - ! Extract YMD from model_nudge_time - call ESMF_TimeGet(Model_Update_Time, year=year, month=month, day=day, sec=sec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - mcdate = year*10000 + mon*100 + day - - ! Advance sdat stream - call shr_strdata_advance(sdat_nudging, ymd=mcdate, tod=sec, logunit=iulog, istr='nudging', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - ! Get pointer for stream data that is time and spatially interpolated to model time and grid - allocate(Tmp3D(pcols,pver,begchunk:endchunk), stat=istta) - call handle_allocate_error(istat, sub, 'TMP3d') - - allocate(Tmp2D(pcols,begchunk:endchunk)) - call handle_allocate_error(istat, sub, 'TM23d') - - ! Determine 3d nudging fields - do nvar = 1,4 - - if ( trim(stream_varlist_nudging(nvar)) == 'U' .or. & - trim(stream_varlist_nudging(nvar)) == 'V' .or. & - trim(stream_varlist_nudging(nvar)) == 'T' .or. & - trim(stream_varlist_nudging(nvar)) == 'Q' ) then - - call dshr_fldbun_getFldPtr(sdat_nudging%pstrm(1)%fldbun_model, stream_varlist_nudging(nvar), fldptr2=dataptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - ! Obtain TMP3d - g = 1 - do ichnk = begchunk,endchunk - do ilev = 1, plev - do icol = 1,get_ncols_p(c) - Tmp3d(icol,ilev,ichnk) = dataptr2d(ilev,g) - g = g + 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(stream_varlist_nudging(nvar) == 'U')) then - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - Target_U(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) - end do - else if (trim(stream_varlist_nudging(nvar) == 'V')) then - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - Target_V(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) - end do - else if (trim(stream_varlist_nudging(nvar) == 'T')) then - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - Target_T(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) - end do - else if (trim(stream_varlist_nudging(nvar) == 'Q')) then - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - Target_Q(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) - end do - end if - - else if (trim(stream_varlist_nudging(nvar)) == 'PS') then - - call dshr_fldbun_getFldPtr(sdat_nudging%pstrm(1)%fldbun_model, stream_varlist_nudging(nvar), fldptr2=dataptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - g = 1 - do ichnk = begchunk,endchunk - do icol = 1,get_ncols_p(c) - Tmp2d(icol, ichnk) = dataptr2d(g) - g = g + 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=phys_state(lchnk)%ncol - Target_PS(:ncol,lchnk)= Tmp3d(:ncol,lchnk) - end do - - end if ! - - end do - - end subroutine stream_nudging_interp - -end module atm_stream_nudging diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index acd3d8f22e..ec5523a276 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -189,14 +189,16 @@ module nudging ! Useful modules !------------------ use ESMF - use shr_kind_mod, only: r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL - use time_manager, only: get_curr_date, get_step_size - use cam_abortutils, only: endrun - use spmd_utils, only: masterproc, 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 atm_stream_nudging, only : stream_nudging_init, stream_nudging_interp + use shr_kind_mod , only : r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL + 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 atm_shr , only : model_clock, model_mesh ! Set all Global values and routines to private by default ! and then explicitly set their exposure. @@ -204,73 +206,84 @@ module nudging implicit none private - public :: Nudge_Model,Nudge_ON + public :: Nudge_Model public :: nudging_readnl public :: nudging_init public :: nudging_timestep_init public :: nudging_timestep_tend + public :: nudging_final private :: nudging_set_PSprofile private :: nudging_set_profile private :: calc_DryStaticEnergy + private :: nudging_stream_init ! position datasets for dynamic nudging + private :: nudging_stream_interp ! interpolates between two years of nudging file data - public :: nudging_final + integer, parameter :: maxfiles = 1000 + + logical, public :: Nudge_On = .false. ! Nudging Parameters !-------------------- - logical :: Nudge_Model =.false. - logical :: Nudge_ON =.false. - logical :: Nudge_Initialized =.false. - character(len=cl) :: Nudge_Path - type(ESMF_Mesh) :: Nudge_Mesh - integer :: Nudge_File_Step - integer :: Nudge_Times_Per_Day - integer :: Nudge_Step - type(ESMF_TimeInterval) :: Nudge_delta - type(ESMF_Time) :: Nudge_Beg_year - type(ESMF_Time) :: Nudge_Beg_month - type(ESMF_Time) :: Nudge_Beg_day - type(ESMF_Time) :: Nudge_Beg_sec - type(ESMF_Time) :: Nudge_End_year - type(ESMF_Time) :: Nudge_End_month - type(ESMF_Time) :: Nudge_End_day - type(ESMF_Time) :: Nudge_End_sec - type(ESMF_Time) :: Nudge_Beg_time - type(ESMF_Time) :: Nudge_End_time - type(ESMF_Time) :: Model_curr_time - type(ESMF_Time) :: Model_next_time - type(ESMF_Time) :: Nudge_file_next_time - integer :: Nudge_File_Times_Per_Day - type(ESMF_Time_Interval) :: Nudge_File_delta - integer :: Nudge_Force_Opt - integer :: Nudge_TimeScale_Opt - integer :: Nudge_TSmode - 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 - real(r8) :: Nudge_Hwin_lat0 - real(r8) :: Nudge_Hwin_latWidth - real(r8) :: Nudge_Hwin_latDelta - real(r8) :: Nudge_Hwin_lon0 - real(r8) :: Nudge_Hwin_lonWidth - real(r8) :: Nudge_Hwin_lonDelta - logical :: Nudge_Hwin_Invert = .false. - real(r8) :: Nudge_Hwin_lo - real(r8) :: Nudge_Hwin_hi - real(r8) :: Nudge_Vwin_Hindex - real(r8) :: Nudge_Vwin_Hdelta - real(r8) :: Nudge_Vwin_Lindex - real(r8) :: Nudge_Vwin_Ldelta - logical :: Nudge_Vwin_Invert =.false. - real(r8) :: Nudge_Vwin_lo - real(r8) :: Nudge_Vwin_hi - real(r8) :: Nudge_Hwin_latWidthH - real(r8) :: Nudge_Hwin_lonWidthH - real(r8) :: Nudge_Hwin_max - real(r8) :: Nudge_Hwin_min + logical :: Nudge_Model =.false. + logical :: Nudge_Initialized =.false. + character(len=cl) :: Nudge_Meshfile + character(len=cl) :: Nudge_Filenames(maxfiles) + + integer :: Nudge_Beg_year + integer :: Nudge_Beg_month + integer :: Nudge_Beg_day + integer :: Nudge_Beg_sec + type(ESMF_Time) :: Nudge_Beg_time + + integer :: Nudge_End_year + integer :: Nudge_End_month + integer :: Nudge_End_day + integer :: Nudge_End_sec + type(ESMF_Time) :: Nudge_End_time + + integer :: Model_Update_Times_Per_Day + type(ESMF_TimeInterval) :: Model_Update_Interval + type(ESMF_Time) :: Model_Update_Next_Time + + integer :: Nudge_File_Times_Per_Day + type(ESMF_Time) :: Nudge_File_Next_Time + type(ESMF_TimeInterval) :: Nudge_File_Delta + integer :: Nudge_File_Step + + integer :: Nudge_Force_Opt + integer :: Nudge_TimeScale_Opt + integer :: Nudge_TSmode + + 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 + + real(r8) :: Nudge_Hwin_lat0 + real(r8) :: Nudge_Hwin_latWidth + real(r8) :: Nudge_Hwin_latDelta + real(r8) :: Nudge_Hwin_lon0 + real(r8) :: Nudge_Hwin_lonWidth + real(r8) :: Nudge_Hwin_lonDelta + logical :: Nudge_Hwin_Invert = .false. + real(r8) :: Nudge_Hwin_lo + real(r8) :: Nudge_Hwin_hi + + real(r8) :: Nudge_Vwin_Hindex + real(r8) :: Nudge_Vwin_Hdelta + real(r8) :: Nudge_Vwin_Lindex + real(r8) :: Nudge_Vwin_Ldelta + logical :: Nudge_Vwin_Invert =.false. + real(r8) :: Nudge_Vwin_lo + real(r8) :: Nudge_Vwin_hi + + real(r8) :: Nudge_Hwin_latWidthH + real(r8) :: Nudge_Hwin_lonWidthH + real(r8) :: Nudge_Hwin_max + real(r8) :: Nudge_Hwin_min ! Nudging Zonal Filter variables !--------------------------------- @@ -308,8 +321,10 @@ module nudging real(r8),allocatable:: Nudge_Qstep (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable:: Nudge_PSstep(:,:) !(pcols,begchunk:endchunk) - integer, parameter :: maxfiles = 1000 - character(len=CL) :: nudge_filenames(maxfiles) + ! Stream functionality + !----------------------- + type(shr_strdata_type) :: sdat_nudging + character(len=2) :: nudge_varlist(5) = (/'U ', 'V ','T ','Q ','PS'/) contains @@ -321,7 +336,7 @@ subroutine nudging_readnl(nlfile) ! them. !=============================================================== use ppgrid, only: pver - use namelist_utils, only:find_group_name + use namelist_utils, only: find_group_name ! ! Arguments !------------- @@ -334,7 +349,7 @@ subroutine nudging_readnl(nlfile) character(len=*), parameter :: prefix = 'nudging_readnl: ' - namelist /nudging_nl/ Nudge_Model, Nudge_Path, Nudge_Filenames, Nudge_Mesh, & + namelist /nudging_nl/ Nudge_Model, Nudge_Filenames, Nudge_Meshfile, & Nudge_Force_Opt, Nudge_TimeScale_Opt, & Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & @@ -361,7 +376,6 @@ subroutine nudging_readnl(nlfile) ! Nudging will always begin/end at midnight. !-------------------------------------------- Nudge_Initialized =.false. - Nudge_ON =.false. Nudge_Beg_Sec = 0 Nudge_End_Sec = 0 @@ -370,9 +384,8 @@ subroutine nudging_readnl(nlfile) Nudge_Model = .false. Model_Update_Times_Per_Day = 4 Nudge_File_Times_per_Day = 4 - Nudge_Path = './Data/YOTC_ne30np4_001/' Nudge_Filenames(:) = ' ' - Nudge_Mesh = ' ' + Nudge_Meshfile = ' ' Nudge_Beg_Year = 2008 Nudge_Beg_Month = 5 Nudge_Beg_Day = 1 @@ -427,15 +440,14 @@ subroutine nudging_readnl(nlfile) ! Broadcast namelist variables !------------------------------ - call MPI_bcast(Nudge_Path, len(Nudge_Path), mpi_character, masterprocid, mpicom, ierr) + call MPI_bcast(Nudge_Model, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Model') - do nfile = 1,maxfiles - if (Nudge_filename(nfile) /= ' ') then - call MPI_bcast(Nudge_Filename(nfile), len(Nudge_Filename), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Filename') - end if - end do + call MPI_bcast(Nudge_Filenames(:), len(Nudge_Filenames(1))*maxfiles, mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Filenames') + + call MPI_bcast(Nudge_Meshfile, len(Nudge_Meshfile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Meshfile') call MPI_bcast(Nudge_File_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_File_Times_Per_Day') @@ -611,8 +623,6 @@ subroutine nudging_readnl(nlfile) write(iulog,*) 'NUDGING: Nudge_Hwin_lonWidth=',Nudge_Hwin_lonWidth call endrun('nudging_readnl:: ERROR in namelist') endif - - ! End Routine !------------ @@ -637,10 +647,12 @@ subroutine nudging_init ! Local values !---------------- type(ESMF_Time) :: curr_time + type(ESMF_Time) :: Model_Update_Current_Time integer :: Year,Month,Day,Sec logical :: After_Beg,Before_End - integer :: istat,lchnk,ncol,icol,ilev - integer :: ierr + integer :: Model_Update_Step + integer :: lchnk,ncol,icol,ilev + integer :: istat, ierr, rc integer :: dtime real(r8) :: rlat,rlon real(r8) :: Wprof(pver) @@ -716,7 +728,6 @@ subroutine nudging_init call addfld('Target_T',(/ 'lev' /),'A','K' ,'T Nudging Target' ) call addfld('Target_Q',(/ 'lev' /),'A','kg/kg' ,'Q Nudging Target ') - ! Set the Stepping intervals for Model and Nudging values ! Ensure that the Model_Update_Step is not smaller then one timestep ! and not larger then the Nudge_File_Step. @@ -736,8 +747,8 @@ subroutine nudging_init endif if(Model_Update_Step > Nudge_File_Step) then write(iulog,*) ' ' - write(iulog,*) 'NUDGING: Model_Update_Step cannot be more than Nudge_Step' - write(iulog,*) 'NUDGING: Setting Model_Update_Step=Nudge_Step, Nudge_Step=',Nudge_Step + write(iulog,*) 'NUDGING: Model_Update_Step cannot be more than Nudge_File_Step' + write(iulog,*) 'NUDGING: Setting Model_Update_Step=Nudge_File_Step, Nudge_File_Step=',Nudge_File_Step write(iulog,*) ' ' Model_Update_Step = Nudge_File_Step endif @@ -746,20 +757,22 @@ subroutine nudging_init !------------------------------------------------ call get_curr_date(Year, Month, Day, Sec) - call ESMF_TimeSet(curr_time, year=Year, month=Month, day=Day, sec=Sec, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_Update_currtime') + call ESMF_TimeSet(curr_time, yy=Year, mm=Month, dd=Day, s=Sec, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet for curr_time') - call ESMF_TimeSet(Nudge_beg_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec, rc=rc) + 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, sub//': error return from ESMF_TimeSet for Nudge_beg_time') - call ESMF_TimeSet(Nudge_end_time, year=Nudge_End_Year, month=Nudge_End_Month, day=Nudge_End_Day, sec=Nudge_End_Sec, rc=rc) + 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, sub//': error return from ESMF_TimeSet for Nudge_end_time') - call ESMF_Time_Interval_Set(Model_Update_Interval, sec=Model_Update_Step, rc=rc) + call ESMF_TimeIntervalSet(Model_Update_Interval, s=Model_Update_Step, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Model_Update_step') - call ESMF_TimeIntervalSet(Nudge_File_delta, s=Nudge_File_Step, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Nudge_step') + call ESMF_TimeIntervalSet(Nudge_File_Delta, s=Nudge_File_Step, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Nudge_File_delta') ! Initialize the time relative to the nudging window !------------------------------------------------ @@ -769,25 +782,30 @@ subroutine nudging_init if ((After_Beg) .and. (Before_End)) then - ! Set Time indicies so that the next call to timestep_init will initialize the Model_Update_curr_time - call ESMF_TimeSet(Model_Update_next_time, year=Year, month=Month, day=Day, sec=(Sec/Model_Update_Step)*Model_Update_Step) + ! 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, sub//': error return from ESMF_TimeSet for Model_Update_next_time') - call ESMF_TimeSet(Nudge_next_time, year=Year, month=Month, day=Day, sec=(Sec/Nudge_Step)*Nudge_Step) + call ESMF_TimeSet(Nudge_File_next_time, & + yy=Year, mm=Month, dd=Day, s=(Sec/Nudge_File_Step)*Nudge_File_Step, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_next_time') elseif (.not.After_Beg) then - ! Set Time indicies to Nudging start so next call to timestep_init will initialize the Model_Update_curr_time - call ESMF_TimeSet(Model_Update_next_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec) + ! 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, sub//': error return from ESMF_TimeSet for Model_Update_next_time') - call ESMF_TimeSet(Nudge_next_time, year=Nudge_Beg_Year, month=Nudge_Beg_Month, day=Nudge_Beg_Day, sec=Nudge_Beg_Sec) - call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_next_time') + call ESMF_TimeSet(Nudge_File_next_time, & + yy=Nudge_Beg_Year, mm=Nudge_Beg_Month, dd=Nudge_Beg_Day, s=Nudge_Beg_Sec, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_File_next_time') + ! 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. - 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' @@ -841,7 +859,6 @@ subroutine nudging_init 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_Force_Opt =',Nudge_Force_Opt write(iulog,*) 'NUDGING: Nudge_TimeScale_Opt =',Nudge_TimeScale_Opt write(iulog,*) 'NUDGING: Nudge_TSmode =',Nudge_TSmode @@ -904,11 +921,6 @@ subroutine nudging_init call alloc_err(istat,'nudging_init','Zonal_Bamp3d',Nudge_ZonalNbasis*pver) endif - ! Initialize nudging stream data type - !---------------------------------------------------------- - call stream_nudging_init(Nudge_Path, Nudge_files, Nudge_Mesh, & - Nudge_Beg_Time, Nudge_End_time, Model_Update_Step, Nudge_Force_Opt) - ! Initialize Nudging Coeffcient profiles in local arrays ! Load zeros into nudging arrays !------------------------------------------------------ @@ -933,11 +945,11 @@ subroutine nudging_init Nudge_PStau(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_Utau(:ncol,:pver,lchnk) = Nudge_Utau(:ncol,:pver,lchnk) * Nudge_Ucoef/float(Nudge_File_Step) + Nudge_Vtau(:ncol,:pver,lchnk) = Nudge_Vtau(:ncol,:pver,lchnk) * Nudge_Vcoef/float(Nudge_File_Step) + Nudge_Stau(:ncol,:pver,lchnk) = Nudge_Stau(:ncol,:pver,lchnk) * Nudge_Tcoef/float(Nudge_File_Step) + Nudge_Qtau(:ncol,:pver,lchnk) = Nudge_Qtau(:ncol,:pver,lchnk) * Nudge_Qcoef/float(Nudge_File_Step) + Nudge_PStau(:ncol,lchnk) = Nudge_PStau(:ncol,lchnk) * Nudge_PScoef/float(Nudge_File_Step) Nudge_Ustep(:pcols,:pver,lchnk) = 0._r8 Nudge_Vstep(:pcols,:pver,lchnk) = 0._r8 @@ -975,21 +987,21 @@ subroutine nudging_timestep_init(phys_state) ! 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 logical :: Update_Model, Sync_Error + logical :: Update_Nudge logical :: After_Beg, Before_End integer :: lchnk,ncol,indw type(ESMF_Time) :: curr_time type(ESMF_TimeInterval) :: date_diff integer :: DeltaT real(r8) :: Tscale - real(r8) :: Tfrac - real(r8) :: Sbar,Qbar,Wsum integer :: rc + logical :: first_call = .true. character(len=*), parameter :: sub = "(nudging_timestep_init) " !-------------------------------------------------------------- @@ -1007,7 +1019,7 @@ subroutine nudging_timestep_init(phys_state) ! Get Current CAM time call get_curr_date(Year,Month,Day,Sec) - call ESMF_TimeSet(curr_time, year=Year, month=Month, day=Day, sec=Sec) + call ESMF_TimeSet(curr_time, yy=Year, mm=Month, dd=Day, s=Sec, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeSet for curr_time') After_Beg = (curr_time >= Nudge_beg_time) @@ -1024,23 +1036,31 @@ subroutine nudging_timestep_init(phys_state) endif !-------------------------------------------------------------- - ! When past the NEXT time, Update Model Arrays and time indices + ! When past the NEXT nudge time, update model !-------------------------------------------------------------- - Update_Model = (curr_time >= Model_Update_next_time) + Update_Model = (curr_time >= Model_Update_Next_Time) if ((Before_End) .and. (Update_Model)) then + ! 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 (first_call) then + call nudging_stream_init() + first_call = .false. + end if + ! Increment the Model times by the current interval - Model_Update_curr_time = Model_Update_next_time Model_Update_next_time = Model_Update_next_time + Model_Update_Interval ! 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 = (Model_Update_curr_time >= Model_Update_next_time) - if(Sync_Error) then - Model_Update_curr_time = curr_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 @@ -1060,15 +1080,15 @@ subroutine nudging_timestep_init(phys_state) ! 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) end do @@ -1103,22 +1123,20 @@ subroutine nudging_timestep_init(phys_state) ! Using CDEPS: ! Read new nudging data and interpolate to model grid and Model_Update_Time !--------------------------------------------------- - call stream_nudging_interp(Model_Update_Nudge_Time, & - Nudge_zonal_filter, ZM, Zonal_Bamp2d, ZonalBamp3d, & - Target_U, Target_V, Target_T, Target_Q, Target_PS) + call nudging_stream_interp() ! Now load Dry Static Energy values for Target !--------------------------------------------- if (Nudge_TSmode == 0) then - ! DSE tendencies from Temperature only + ! 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 - ! 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(Target_T(:,:,lchnk), Target_Q(:,:,lchnk), & phys_state(lchnk)%phis, Target_PS(:,lchnk), Target_S(:,:,lchnk), ncol) end do @@ -1135,12 +1153,12 @@ subroutine nudging_timestep_init(phys_state) Update_Nudge = (curr_time >= Nudge_file_next_time) if ((Before_End) .and. (Update_Nudge)) then ! Increment the Nudge times by the current interval - Nudge_file_next_time = Nudge_file_next_time + Nudge_file_delta + Nudge_File_Next_Time = Nudge_File_Next_Time + Nudge_File_Delta endif date_diff = Nudge_file_next_time - curr_time call ESMF_TimeIntervalGet(date_diff, S=DeltaT, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') - Tscale=float(Nudge_Step)/float(DeltaT) + Tscale = float(Nudge_File_Step)/float(DeltaT) else @@ -1154,7 +1172,7 @@ subroutine nudging_timestep_init(phys_state) ! Update the nudging tendencies !-------------------------------- do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol + 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)) & @@ -1167,20 +1185,6 @@ subroutine nudging_timestep_init(phys_state) *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_Model) ! End Routine @@ -1375,12 +1379,6 @@ subroutine nudging_final 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(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) @@ -1521,6 +1519,216 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) end subroutine calc_DryStaticEnergy !================================================================ + + !================================================================ + subroutine nudging_stream_init() + + use dshr_strdata_mod, only: shr_strdata_init_from_inline + + ! local variables + integer :: rc + integer :: nfile + integer :: nudge_year_first + integer :: nudge_year_last + character(len=CS) :: tintalgo + character(*), parameter :: sub = "('nudging_stream_init')" + !---------------------------------------------------------------- + + ! Determine nudge_year_first, nudge_year_last and tintalgo + + call ESMF_TimeGet(nudge_beg_time, yy=nudge_year_first, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet for nudge_beg_time') + + call ESMF_TimeGet(nudge_end_time, yy=nudge_year_last, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet for nudge_end_time') + + if (Nudge_Force_Opt == 0) then + tintalgo = 'upper' + elseif(Nudge_Force_Opt == 1) then + tintalgo = 'linear' + else + write(iulog,*) 'NUDGING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt + call endrun('nudging_timestep_init:: ERROR unknown Nudge_Force_Opt') + endif + + ! Write output log info + + if (masterproc) then + write(iulog,'(a)' ) ' ' + write(iulog,'(a,i8)') 'stream nudging settings:' + write(iulog,'(a,a,a)') ' nudge varlist = ','U,V,T,Q,PS' + write(iulog,'(a,i8)') ' nudge year first = ',nudge_year_first + write(iulog,'(a,i8)') ' nudge year last = ',nudge_year_last + write(iulog,'(a,i8)') ' nudge year align = ',nudge_year_first + write(iulog,'(a,a)') ' nudge tintalgo = ',trim(tintalgo) + write(iulog,'(a,a)' ) ' nudge meshfile = ',trim(nudge_meshfile) + do nfile = 1,size(nudge_filenames) + if (trim(nudge_filenames(nfile)) /= ' ') then + write(iulog,'(a,i8,2x,a)' ) ' nudge files = ',nfile,trim(nudge_filenames(nfile)) + end if + end do + write(iulog,'(a)' ) ' ' + endif + + ! Create module stream data type sdat_nudging + ! TODO: change dtlimit to be twice the step size + + call shr_strdata_init_from_inline(sdat_nudging, & + 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_year_first, & + stream_yearLast = nudge_year_last, & + stream_yearAlign = nudge_year_first, & + stream_fldlistFile = nudge_varlist, & + stream_fldListModel = nudge_varlist, & + stream_lev_dimname = 'lev', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'limit', & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = tintalgo, & + stream_name = 'NUDGING forcing data ', & + rc = rc) + call chkrc(rc, sub//': error return from shr_strdata_init_from_inline') + + end subroutine nudging_stream_init + !================================================================ + + + !================================================================ + subroutine nudging_stream_interp() + + use dshr_methods_mod , only : dshr_fldbun_getfldptr + use dshr_strdata_mod , only : shr_strdata_advance + use ppgrid , only : pcols, pver, begchunk, endchunk + use phys_grid , only : get_ncols_p + + ! Local variables + integer :: rc ! ESMF error return + integer :: istat ! allocate 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 :: g ! 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), allocatable :: Tmp3D(:,:,:) + real(r8), allocatable :: Tmp2D(:,:) + 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, sub//': error return from ESMF_TimeSet for Model_Update_Time') + mcdate = year*10000 + mon*100 + day + + ! Advance sdat stream + call shr_strdata_advance(sdat_nudging, ymd=mcdate, tod=sec, logunit=iulog, istr='nudging', rc=rc) + call chkrc(rc, sub//': error return from shr_strdata_advance') + + ! Get pointer for stream data that is time and spatially interpolated to model time and grid + allocate(Tmp3D(pcols,pver,begchunk:endchunk), stat=istat) + call handle_allocate_error(istat, sub, 'TMP3d') + + allocate(Tmp2D(pcols,begchunk:endchunk), stat=istat) + call handle_allocate_error(istat, sub, 'TM23d') + + ! Determine 3d nudging fields + do nvar = 1,4 + + if ( trim(nudge_varlist(nvar)) == 'U' .or. & + trim(nudge_varlist(nvar)) == 'V' .or. & + trim(nudge_varlist(nvar)) == 'T' .or. & + trim(nudge_varlist(nvar)) == 'Q' ) then + + call dshr_fldbun_getFldPtr(sdat_nudging%pstrm(1)%fldbun_model, nudge_varlist(nvar), fldptr2=dataptr2d, rc=rc) + call chkrc(rc, sub//': error return from shr_strdata_advance') + + ! Obtain TMP3d + g = 1 + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + do klev = 1, pver + do icol = 1,ncol + Tmp3d(icol,klev,lchnk) = dataptr2d(klev,g) + g = g + 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(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(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(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(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 + + else if (trim(nudge_varlist(nvar)) == 'PS') then + + call dshr_fldbun_getFldPtr(sdat_nudging%pstrm(1)%fldbun_model, nudge_varlist(nvar), fldptr1=dataptr1d, rc=rc) + call chkrc(rc, sub//': error return from dshr_fldbun_getFldPtr') + + g = 1 + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + do icol = 1,ncol + Tmp2d(icol,lchnk) = dataptr1d(g) + g = g + 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 if ! + + end do + + end subroutine nudging_stream_interp + !================================================================ + + !================================================================ subroutine chkrc(rc, mes) integer, intent(in) :: rc ! return code from time management library From 8bb45f1af595e9849588b59ebfb6665b20c5f5a8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 30 Oct 2025 10:45:24 +0100 Subject: [PATCH 05/25] fixes to nudging for running --- src/physics/cam/nudging.F90 | 152 +++++++++++++++++++++--------------- 1 file changed, 90 insertions(+), 62 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index ec5523a276..f277b60fea 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -323,8 +323,9 @@ module nudging ! Stream functionality !----------------------- - type(shr_strdata_type) :: sdat_nudging - character(len=2) :: nudge_varlist(5) = (/'U ', 'V ','T ','Q ','PS'/) + 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'/) contains @@ -1573,26 +1574,49 @@ subroutine nudging_stream_init() ! Create module stream data type sdat_nudging ! TODO: change dtlimit to be twice the step size - call shr_strdata_init_from_inline(sdat_nudging, & - 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_year_first, & - stream_yearLast = nudge_year_last, & - stream_yearAlign = nudge_year_first, & - stream_fldlistFile = nudge_varlist, & - stream_fldListModel = nudge_varlist, & - stream_lev_dimname = 'lev', & - stream_mapalgo = 'bilinear', & - stream_offset = 0, & - stream_taxmode = 'limit', & - stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = tintalgo, & - stream_name = 'NUDGING forcing data ', & + 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_year_first, & + stream_yearLast = nudge_year_last, & + stream_yearAlign = nudge_year_first, & + stream_fldlistFile = nudge_varlist_multi, & + stream_fldListModel = nudge_varlist_multi, & + stream_lev_dimname = 'lev', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'limit', & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = tintalgo, & + stream_name = 'NUDGING forcing data ', & + rc = rc) + call chkrc(rc, sub//': error return from shr_strdata_init_from_inline') + + 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_year_first, & + stream_yearLast = nudge_year_last, & + stream_yearAlign = nudge_year_first, & + stream_fldlistFile = nudge_varlist_singl, & + stream_fldListModel = nudge_varlist_singl, & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'limit', & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = tintalgo, & + stream_name = 'NUDGING forcing data ', & rc = rc) call chkrc(rc, sub//': error return from shr_strdata_init_from_inline') @@ -1603,8 +1627,10 @@ end subroutine nudging_stream_init !================================================================ subroutine nudging_stream_interp() - use dshr_methods_mod , only : dshr_fldbun_getfldptr + ! 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 @@ -1634,8 +1660,11 @@ subroutine nudging_stream_interp() call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_Update_Time') mcdate = year*10000 + mon*100 + day - ! Advance sdat stream - call shr_strdata_advance(sdat_nudging, ymd=mcdate, tod=sec, logunit=iulog, istr='nudging', rc=rc) + ! Advance sdat streams + call shr_strdata_advance(sdat_nudging_multi, ymd=mcdate, tod=sec, logunit=iulog, istr='nudging', rc=rc) + call chkrc(rc, sub//': error return from shr_strdata_advance') + + call shr_strdata_advance(sdat_nudging_singl, ymd=mcdate, tod=sec, logunit=iulog, istr='nudging', rc=rc) call chkrc(rc, sub//': error return from shr_strdata_advance') ! Get pointer for stream data that is time and spatially interpolated to model time and grid @@ -1645,22 +1674,23 @@ subroutine nudging_stream_interp() allocate(Tmp2D(pcols,begchunk:endchunk), stat=istat) call handle_allocate_error(istat, sub, 'TM23d') - ! Determine 3d nudging fields - do nvar = 1,4 + ! Obtain Target_U, Target_V, Target_T and Target_Q - if ( trim(nudge_varlist(nvar)) == 'U' .or. & - trim(nudge_varlist(nvar)) == 'V' .or. & - trim(nudge_varlist(nvar)) == 'T' .or. & - trim(nudge_varlist(nvar)) == 'Q' ) then + 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%pstrm(1)%fldbun_model, nudge_varlist(nvar), fldptr2=dataptr2d, rc=rc) + call dshr_fldbun_getFldPtr(sdat_nudging_multi%pstrm(1)%fldbun_model, & + nudge_varlist_multi(nvar), fldptr2=dataptr2d, rc=rc) call chkrc(rc, sub//': error return from shr_strdata_advance') ! Obtain TMP3d - g = 1 - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - do klev = 1, pver + do klev = 1, pver + g = 1 + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) do icol = 1,ncol Tmp3d(icol,klev,lchnk) = dataptr2d(klev,g) g = g + 1 @@ -1675,54 +1705,52 @@ subroutine nudging_stream_interp() endif ! Determine output variables - if (trim(nudge_varlist(nvar)) == 'U') then + 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(nvar)) == 'V') then + 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(nvar)) == 'T') then + 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(nvar)) == 'Q') then + 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 - else if (trim(nudge_varlist(nvar)) == 'PS') then - - call dshr_fldbun_getFldPtr(sdat_nudging%pstrm(1)%fldbun_model, nudge_varlist(nvar), fldptr1=dataptr1d, rc=rc) - call chkrc(rc, sub//': error return from dshr_fldbun_getFldPtr') - - g = 1 - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - do icol = 1,ncol - Tmp2d(icol,lchnk) = dataptr1d(g) - g = g + 1 - end do - end do + ! Obtain Target_PS - if (Nudge_ZonalFilter) then - call ZM%calc_amps(Tmp2D,Zonal_Bamp2d) - call ZM%eval_grid(Zonal_Bamp2d,Tmp2D) - endif + call dshr_fldbun_getFldPtr(sdat_nudging_singl%pstrm(1)%fldbun_model, 'PS', fldptr1=dataptr1d, rc=rc) + call chkrc(rc, sub//': error return from dshr_fldbun_getFldPtr') - do lchnk=begchunk,endchunk - ncol = get_ncols_p(lchnk) - Target_PS(:ncol,lchnk)= Tmp2d(:ncol,lchnk) - end do + g = 1 + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + do icol = 1,ncol + Tmp2d(icol,lchnk) = dataptr1d(g) + g = g + 1 + end do + end do - end if ! + 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 From a10e8a5e535d486c36f78544439b886c6a388c87 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 30 Oct 2025 19:12:00 +0100 Subject: [PATCH 06/25] introduced cam_esmf_mod in src/control to have access to the model_mesh and model_clock from outside the nuopc cap --- src/control/cam_esmf_mod.F90 | 21 +++++++++++++++++++++ src/cpl/nuopc/atm_comp_nuopc.F90 | 7 ++++++- src/cpl/nuopc/atm_shr.F90 | 11 ----------- src/cpl/nuopc/atm_stream_ndep.F90 | 2 +- src/physics/cam/nudging.F90 | 2 +- 5 files changed, 29 insertions(+), 14 deletions(-) create mode 100644 src/control/cam_esmf_mod.F90 delete mode 100644 src/cpl/nuopc/atm_shr.F90 diff --git a/src/control/cam_esmf_mod.F90 b/src/control/cam_esmf_mod.F90 new file mode 100644 index 0000000000..330903936f --- /dev/null +++ b/src/control/cam_esmf_mod.F90 @@ -0,0 +1,21 @@ +module cam_esmf_mod + + use ESMF, only : ESMF_Mesh, ESMF_Clock + + implicit none + public + + type(ESMF_Mesh) , protected :: model_mesh ! model mesh + type(ESMF_Clock), protected :: model_clock ! model clock + +contains + + subroutine cam_esmf_set_mesh_and_clock(model_mesh_in, model_clock_in) + type(ESMF_Mesh) , intent(in) :: model_mesh_in + type(ESMF_Clock), intent(in) :: model_clock_in + + model_mesh = model_mesh_in + model_clock = model_clock_in + end subroutine cam_esmf_set_mesh_and_clock + +end module cam_esmf_mod diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 41262c3924..8db1bfe81c 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -70,7 +70,7 @@ module atm_comp_nuopc use pio , only : pio_noerr, pio_bcast_error, pio_internal_error, pio_seterrorhandling use pio , only : pio_def_var, pio_get_var, pio_put_var, PIO_INT use ioFileMod - use atm_shr , only : model_mesh, model_clock + use cam_esmf_mod , only : cam_esmf_set_mesh_and_clock !$use omp_lib , only : omp_set_num_threads implicit none @@ -334,6 +334,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables + type(ESMF_Mesh) :: model_mesh + type(ESMF_Clock) :: model_clock type(ESMF_VM) :: vm type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time @@ -784,6 +786,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if ! end of mediator_present if-block + ! Set module variables in atm_shr_nuopc + call cam_esmf_set_mesh_and_clock(model_mesh_in=model_mesh, model_clock_in=model_clock) + call shr_log_setLogUnit (shrlogunit) #if (defined _MEMTRACE) diff --git a/src/cpl/nuopc/atm_shr.F90 b/src/cpl/nuopc/atm_shr.F90 deleted file mode 100644 index 8e842d5ea2..0000000000 --- a/src/cpl/nuopc/atm_shr.F90 +++ /dev/null @@ -1,11 +0,0 @@ -module atm_shr - - use ESMF, only : ESMF_Mesh, ESMF_Clock - - implicit none - public - - type(ESMF_Mesh) :: model_mesh ! model mesh - type(ESMF_Clock) :: model_clock ! model clock - -end module atm_shr diff --git a/src/cpl/nuopc/atm_stream_ndep.F90 b/src/cpl/nuopc/atm_stream_ndep.F90 index b8d766d41d..b9ec64a5e9 100644 --- a/src/cpl/nuopc/atm_stream_ndep.F90 +++ b/src/cpl/nuopc/atm_stream_ndep.F90 @@ -17,7 +17,7 @@ module atm_stream_ndep use spmd_utils , only : mpi_character, mpi_integer use cam_logfile , only : iulog use cam_abortutils , only : endrun - use atm_shr , only : model_clock, model_mesh + use cam_esmf_mod , only : model_clock, model_mesh implicit none private diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index f277b60fea..76e1755685 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -198,7 +198,7 @@ module nudging use zonal_mean_mod , only : ZonalMean_t use nuopc_shr_methods , only : chkerr use dshr_strdata_mod , only : shr_strdata_type - use atm_shr , only : model_clock, model_mesh + use cam_esmf_mod , only : model_clock, model_mesh ! Set all Global values and routines to private by default ! and then explicitly set their exposure. From bb36e8edc3618696853d9909304d4107f74ac63b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 5 Nov 2025 14:22:14 +0100 Subject: [PATCH 07/25] introduced nudgeing datapath --- bld/namelist_files/namelist_definition.xml | 8 +++++++- src/cpl/nuopc/atm_comp_nuopc.F90 | 12 ++++++------ src/physics/cam/nudging.F90 | 17 +++++++++++++++-- 3 files changed, 28 insertions(+), 9 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 8b9b828bff..9cd38ffffd 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -222,7 +222,13 @@ - Full pathnames of analyses data to use for nudging. + Filenames of analyses data to use for nudging. + Default: none + + + + Full pathname of datapath where Nudge_Filenames are located. Default: none diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 8db1bfe81c..09693b5b43 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -624,6 +624,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) end if + ! Create model_clock as a variable in atm_shr.F90 - needed for generating streams + model_clock = ESMF_ClockCreate(clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Initialize module orbital values and update orbital call cam_orbital_init(gcomp, iulog, masterproc, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -762,9 +766,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call realize_fields(gcomp, model_mesh, flds_scalar_name, flds_scalar_num, single_column, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Create model_clock as a variable in atm_shr.F90 - needed for generating streams - model_clock = ESMF_ClockCreate(clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set module variables in src/control/cam_esmf_mod.F90 (must be done before call to export_fields) + call cam_esmf_set_mesh_and_clock(model_mesh_in=model_mesh, model_clock_in=model_clock) ! Create cam export array and set the state scalars call export_fields( gcomp, cam_out, rc=rc ) @@ -786,9 +789,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if ! end of mediator_present if-block - ! Set module variables in atm_shr_nuopc - call cam_esmf_set_mesh_and_clock(model_mesh_in=model_mesh, model_clock_in=model_clock) - call shr_log_setLogUnit (shrlogunit) #if (defined _MEMTRACE) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 76e1755685..f97a085e3a 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -229,6 +229,7 @@ module nudging logical :: Nudge_Initialized =.false. character(len=cl) :: Nudge_Meshfile character(len=cl) :: Nudge_Filenames(maxfiles) + character(len=cl) :: Nudge_Datapath integer :: Nudge_Beg_year integer :: Nudge_Beg_month @@ -350,7 +351,7 @@ subroutine nudging_readnl(nlfile) character(len=*), parameter :: prefix = 'nudging_readnl: ' - namelist /nudging_nl/ Nudge_Model, Nudge_Filenames, Nudge_Meshfile, & + namelist /nudging_nl/ Nudge_Model, Nudge_datapath, Nudge_Filenames, Nudge_Meshfile, & Nudge_Force_Opt, Nudge_TimeScale_Opt, & Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & @@ -386,7 +387,8 @@ subroutine nudging_readnl(nlfile) Model_Update_Times_Per_Day = 4 Nudge_File_Times_per_Day = 4 Nudge_Filenames(:) = ' ' - Nudge_Meshfile = ' ' + Nudge_Datapath = ' ' + Nudge_Meshfile = ' ' Nudge_Beg_Year = 2008 Nudge_Beg_Month = 5 Nudge_Beg_Day = 1 @@ -447,6 +449,9 @@ subroutine nudging_readnl(nlfile) call MPI_bcast(Nudge_Filenames(:), len(Nudge_Filenames(1))*maxfiles, mpi_character, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Filenames') + call MPI_bcast(Nudge_Datapath, len(Nudge_Datapath), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Datapath') + call MPI_bcast(Nudge_Meshfile, len(Nudge_Meshfile), mpi_character, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Meshfile') @@ -1563,6 +1568,7 @@ subroutine nudging_stream_init() write(iulog,'(a,i8)') ' nudge year align = ',nudge_year_first write(iulog,'(a,a)') ' nudge tintalgo = ',trim(tintalgo) write(iulog,'(a,a)' ) ' nudge meshfile = ',trim(nudge_meshfile) + write(iulog,'(a,a)' ) ' nudge datapath = ',trim(nudge_datapath) do nfile = 1,size(nudge_filenames) if (trim(nudge_filenames(nfile)) /= ' ') then write(iulog,'(a,i8,2x,a)' ) ' nudge files = ',nfile,trim(nudge_filenames(nfile)) @@ -1571,6 +1577,13 @@ subroutine nudging_stream_init() write(iulog,'(a)' ) ' ' endif + do nfile = 1,size(nudge_filenames) + if (trim(nudge_filenames(nfile)) /= ' ') then + nudge_filenames(nfile) = trim(nudge_datapath)//trim(nudge_filenames(nfile)) + end if + end do + + ! Create module stream data type sdat_nudging ! TODO: change dtlimit to be twice the step size From bf6eac365dac2746dcb8e5e61d99af0645a6c9a2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 18 Nov 2025 11:37:03 +0100 Subject: [PATCH 08/25] fixed problem in having nudging be one time step too far ahead --- src/physics/cam/nudging.F90 | 43 ++++++++++++++++++++++++++----------- 1 file changed, 31 insertions(+), 12 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index f97a085e3a..a89cb6894e 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -795,6 +795,9 @@ subroutine nudging_init call ESMF_TimeSet(Nudge_File_next_time, & yy=Year, mm=Month, dd=Day, s=(Sec/Nudge_File_Step)*Nudge_File_Step, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_next_time') + if (masterproc) then + write(iulog,*)'DEBUG: initial model update next time = ',year,month,day,(Sec/Model_Update_Step)*Model_Update_Step + end if elseif (.not.After_Beg) then @@ -1002,6 +1005,7 @@ subroutine nudging_timestep_init(phys_state) logical :: Update_Nudge logical :: After_Beg, Before_End integer :: lchnk,ncol,indw + type(ESMF_Time) :: model_curr_time type(ESMF_Time) :: curr_time type(ESMF_TimeInterval) :: date_diff integer :: DeltaT @@ -1024,12 +1028,18 @@ subroutine nudging_timestep_init(phys_state) ! Get Current CAM time call get_curr_date(Year,Month,Day,Sec) + if (masterproc) then + write(iulog,*)'DEBUG: model curr date = ',year,month,day,sec + end if call ESMF_TimeSet(curr_time, yy=Year, mm=Month, dd=Day, s=Sec, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeSet for curr_time') After_Beg = (curr_time >= Nudge_beg_time) Before_End = (curr_time <= Nudge_end_time) + if (masterproc) then + write(iulog,*)'DEBUG: after_beg, before_end = ',after_beg,before_end + end if !---------------------------------------------------------------- ! Toggle Nudging flag when the time interval is between @@ -1046,6 +1056,9 @@ subroutine nudging_timestep_init(phys_state) !-------------------------------------------------------------- Update_Model = (curr_time >= Model_Update_Next_Time) + if (masterproc) then + write(iulog,*)'DEBUG: update_model = ',update_model + end if if ((Before_End) .and. (Update_Model)) then @@ -1055,22 +1068,13 @@ subroutine nudging_timestep_init(phys_state) ! since that occurs before the creation of the model mesh !---------------------------------------------------------- if (first_call) then + if (masterproc) then + write(iulog,*)'DEBUG: calling nuding_stream_init' + end if call nudging_stream_init() first_call = .false. end if - ! Increment the Model times by the current interval - Model_Update_next_time = Model_Update_next_time + Model_Update_Interval - - ! 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 - ! Load values at Current into the Model arrays !----------------------------------------------- call cnst_get_ind('Q',indw) @@ -1191,6 +1195,18 @@ subroutine nudging_timestep_init(phys_state) *Tscale*Nudge_PStau(:ncol,lchnk) end do + ! Increment the Model times by the current interval + Model_Update_next_time = model_update_next_time + Model_Update_Interval + + ! 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 ! ((Before_End) .and. Update_Model) ! End Routine @@ -1672,6 +1688,9 @@ subroutine nudging_stream_interp() call ESMF_TimeGet(Model_Update_Next_Time, yy=year, mm=mon, dd=day, s=sec, rc=rc) call chkrc(rc, sub//': error return from ESMF_TimeSet for Model_Update_Time') mcdate = year*10000 + mon*100 + day + if (masterproc) then + write(iulog,*)'DEBUG: 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) From 45bb12422e45c4460ae319d8a709002308f31167 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 22 Nov 2025 23:29:55 +0100 Subject: [PATCH 09/25] more refactor of nudging code base --- src/physics/cam/nudging.F90 | 542 +++++++++++++++++------------------- 1 file changed, 257 insertions(+), 285 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index a89cb6894e..0de15ac2f7 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -221,7 +221,7 @@ module nudging integer, parameter :: maxfiles = 1000 - logical, public :: Nudge_On = .false. + logical, public :: Nudge_On = .false. ! Nudging Parameters !-------------------- @@ -247,11 +247,6 @@ module nudging type(ESMF_TimeInterval) :: Model_Update_Interval type(ESMF_Time) :: Model_Update_Next_Time - integer :: Nudge_File_Times_Per_Day - type(ESMF_Time) :: Nudge_File_Next_Time - type(ESMF_TimeInterval) :: Nudge_File_Delta - integer :: Nudge_File_Step - integer :: Nudge_Force_Opt integer :: Nudge_TimeScale_Opt integer :: Nudge_TSmode @@ -296,25 +291,11 @@ module nudging ! Nudging State Arrays !----------------------- - 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) @@ -328,6 +309,8 @@ module nudging character(len=2) :: nudge_varlist_multi(4) = (/'U ', 'V ','T ','Q '/) character(len=2) :: nudge_varlist_singl(1) = (/'PS'/) + character(*),parameter :: u_FILE_u = __FILE__ + contains !================================================================ @@ -356,7 +339,6 @@ subroutine nudging_readnl(nlfile) Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & Model_Update_Times_Per_Day, & - Nudge_File_Times_Per_Day, & Nudge_Ucoef , Nudge_Uprof, & Nudge_Vcoef , Nudge_Vprof, & Nudge_Qcoef , Nudge_Qprof, & @@ -385,7 +367,6 @@ subroutine nudging_readnl(nlfile) !----------------------------- Nudge_Model = .false. Model_Update_Times_Per_Day = 4 - Nudge_File_Times_per_Day = 4 Nudge_Filenames(:) = ' ' Nudge_Datapath = ' ' Nudge_Meshfile = ' ' @@ -455,9 +436,6 @@ subroutine nudging_readnl(nlfile) call MPI_bcast(Nudge_Meshfile, len(Nudge_Meshfile), mpi_character, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Meshfile') - call MPI_bcast(Nudge_File_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_File_Times_Per_Day') - call MPI_bcast(Model_Update_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Update_Times_Per_Day') @@ -644,11 +622,9 @@ 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 !---------------- @@ -667,61 +643,38 @@ subroutine nudging_init real(r8) :: Val1_0,Val2_0,Val3_0,Val4_0 real(r8) :: Val1_n,Val2_n,Val3_n,Val4_n integer :: nn + integer :: size2d, size3d character(len=*), parameter :: prefix = 'nudging_init: ' character(len=*), parameter :: sub = "(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,'nudging_init','Nudge_Utau',size3d) + allocate(Nudge_Vtau0(pcols,pver,begchunk:endchunk),stat=istat) + call alloc_err(istat,'nudging_init','Nudge_Vtau',size3d) + allocate(Nudge_Stau0(pcols,pver,begchunk:endchunk),stat=istat) + call alloc_err(istat,'nudging_init','Nudge_Stau',size3d) + allocate(Nudge_Qtau0(pcols,pver,begchunk:endchunk),stat=istat) + call alloc_err(istat,'nudging_init','Nudge_Qtau',size3d) + allocate(Nudge_PStau0(pcols,begchunk:endchunk),stat=istat) + call alloc_err(istat,'nudging_init','Nudge_PStau',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,'nudging_init','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,'nudging_init','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,'nudging_init','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,'nudging_init','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,'nudging_init','Nudge_PSstep',size2d) ! Register output fields with the cam history module !----------------------------------------------------- @@ -735,14 +688,11 @@ subroutine nudging_init call addfld('Target_Q',(/ 'lev' /),'A','kg/kg' ,'Q Nudging Target ') ! Set the Stepping intervals for Model and Nudging values - ! Ensure that the Model_Update_Step is not smaller then one timestep - ! and not larger then the Nudge_File_Step. !-------------------------------------------------------- ! Get the CAM time step size dtime = get_step_size() Model_Update_Step = 86400/Model_Update_Times_Per_Day - Nudge_File_Step=86400/Nudge_File_Times_Per_Day if(Model_Update_Step < dtime) then write(iulog,*) ' ' @@ -751,34 +701,24 @@ subroutine nudging_init write(iulog,*) ' ' Model_Update_Step = dtime endif - if(Model_Update_Step > Nudge_File_Step) then - write(iulog,*) ' ' - write(iulog,*) 'NUDGING: Model_Update_Step cannot be more than Nudge_File_Step' - write(iulog,*) 'NUDGING: Setting Model_Update_Step=Nudge_File_Step, Nudge_File_Step=',Nudge_File_Step - write(iulog,*) ' ' - Model_Update_Step = Nudge_File_Step - 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, sub//': error return from ESMF_TimeSet for curr_time') + 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, sub//': error return from ESMF_TimeSet for Nudge_beg_time') + 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, sub//': error return from ESMF_TimeSet for Nudge_end_time') + call chkrc(rc,__LINE__,u_FILE_u) call ESMF_TimeIntervalSet(Model_Update_Interval, s=Model_Update_Step, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Model_Update_step') - - call ESMF_TimeIntervalSet(Nudge_File_Delta, s=Nudge_File_Step, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeInterval_Set for Nudge_File_delta') + call chkrc(rc,__LINE__,u_FILE_u) ! Initialize the time relative to the nudging window !------------------------------------------------ @@ -791,10 +731,7 @@ subroutine nudging_init ! 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, sub//': error return from ESMF_TimeSet for Model_Update_next_time') - call ESMF_TimeSet(Nudge_File_next_time, & - yy=Year, mm=Month, dd=Day, s=(Sec/Nudge_File_Step)*Nudge_File_Step, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_next_time') + call chkrc(rc,__LINE__,u_FILE_u) if (masterproc) then write(iulog,*)'DEBUG: initial model update next time = ',year,month,day,(Sec/Model_Update_Step)*Model_Update_Step end if @@ -804,10 +741,7 @@ subroutine nudging_init ! 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, sub//': error return from ESMF_TimeSet for Model_Update_next_time') - call ESMF_TimeSet(Nudge_File_next_time, & - yy=Nudge_Beg_Year, mm=Nudge_Beg_Month, dd=Nudge_Beg_Day, s=Nudge_Beg_Sec, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeSet for Nudge_File_next_time') + 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 @@ -873,8 +807,6 @@ subroutine nudging_init write(iulog,*) 'NUDGING: Nudge_TSmode =',Nudge_TSmode write(iulog,*) 'NUDGING: Model_Update_Times_Per_Day =',Model_Update_Times_Per_Day write(iulog,*) 'NUDGING: Model_Update_Step =',Model_Update_Step - write(iulog,*) 'NUDGING: Nudge_File_Times_Per_Day =',Nudge_File_Times_Per_Day - write(iulog,*) 'NUDGING: Nudge_File_Step =',Nudge_File_Step write(iulog,*) 'NUDGING: Nudge_ZonalFilter =',Nudge_ZonalFilter write(iulog,*) 'NUDGING: Nudge_ZonalNbasis =',Nudge_ZonalNbasis write(iulog,*) 'NUDGING: Nudge_Ucoef =',Nudge_Ucoef @@ -934,44 +866,22 @@ subroutine nudging_init ! 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(:) - + Nudge_Utau0(icol,:,lchnk) = Wprof(:) call nudging_set_profile(rlat,rlon,Nudge_Vprof,Wprof,pver) - Nudge_Vtau(icol,:,lchnk) = Wprof(:) - + Nudge_Vtau0(icol,:,lchnk) = Wprof(:) call nudging_set_profile(rlat,rlon,Nudge_Tprof,Wprof,pver) - Nudge_Stau(icol,:,lchnk) = Wprof(:) - + Nudge_Stau0(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) + 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_File_Step) - Nudge_Vtau(:ncol,:pver,lchnk) = Nudge_Vtau(:ncol,:pver,lchnk) * Nudge_Vcoef/float(Nudge_File_Step) - Nudge_Stau(:ncol,:pver,lchnk) = Nudge_Stau(:ncol,:pver,lchnk) * Nudge_Tcoef/float(Nudge_File_Step) - Nudge_Qtau(:ncol,:pver,lchnk) = Nudge_Qtau(:ncol,:pver,lchnk) * Nudge_Qcoef/float(Nudge_File_Step) - Nudge_PStau(:ncol,lchnk) = Nudge_PStau(:ncol,lchnk) * Nudge_PScoef/float(Nudge_File_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 @@ -993,6 +903,9 @@ subroutine nudging_timestep_init(phys_state) use physics_types,only: physics_state use constituents ,only: cnst_get_ind use ppgrid ,only: pver,pcols,begchunk,endchunk + use phys_grid ,only: get_ncols_p + use cam_history ,only: outfld + use shr_cal_mod ,only: shr_cal_timeSet ! Arguments !----------- @@ -1004,10 +917,35 @@ subroutine nudging_timestep_init(phys_state) logical :: Update_Model, Sync_Error logical :: Update_Nudge logical :: After_Beg, Before_End - integer :: lchnk,ncol,indw + integer :: lchnk,ncol,icol,indw type(ESMF_Time) :: model_curr_time type(ESMF_Time) :: curr_time type(ESMF_TimeInterval) :: date_diff + 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) :: 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 integer :: rc @@ -1024,43 +962,27 @@ subroutine nudging_timestep_init(phys_state) !------------------------------------------------------- ! 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 + !---------------------------------------------------------------- ! Get Current CAM time call get_curr_date(Year,Month,Day,Sec) - if (masterproc) then - write(iulog,*)'DEBUG: model curr date = ',year,month,day,sec - end if - + mcdate = year*10000 + month*100 + day call ESMF_TimeSet(curr_time, yy=Year, mm=Month, dd=Day, s=Sec, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeSet for curr_time') + 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,*)'DEBUG: after_beg, before_end = ',after_beg,before_end - end if - - !---------------------------------------------------------------- - ! 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 - Nudge_ON = .true. - else - Nudge_ON = .false. - endif - - !-------------------------------------------------------------- - ! When past the NEXT nudge time, update model - !-------------------------------------------------------------- - - Update_Model = (curr_time >= Model_Update_Next_Time) - if (masterproc) then - write(iulog,*)'DEBUG: update_model = ',update_model + 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 + if (Update_Model) then ! Initialize nudging stream data type ! NOTE: this must be done once the ESMF mesh for the model is @@ -1068,9 +990,6 @@ subroutine nudging_timestep_init(phys_state) ! since that occurs before the creation of the model mesh !---------------------------------------------------------- if (first_call) then - if (masterproc) then - write(iulog,*)'DEBUG: calling nuding_stream_init' - end if call nudging_stream_init() first_call = .false. end if @@ -1106,24 +1025,24 @@ subroutine nudging_timestep_init(phys_state) ! 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 !------------------------------------------------------- @@ -1133,7 +1052,14 @@ subroutine nudging_timestep_init(phys_state) ! Using CDEPS: ! Read new nudging data and interpolate to model grid and Model_Update_Time !--------------------------------------------------- - call nudging_stream_interp() + call nudging_stream_interp(Target_U, Target_V, Target_T, Target_Q, Target_PS) + + 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 !--------------------------------------------- @@ -1152,47 +1078,66 @@ subroutine nudging_timestep_init(phys_state) 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,*)'DEBUG: sdat%ymdLB, sdat%todLB ',sdat_nudging_multi%pstrm(1)%ymdLB,sdat_nudging_multi%pstrm(1)%todLB + write(iulog,*)'DEBUG: sdat%ymdUB, sdat%todUB ',sdat_nudging_multi%pstrm(1)%ymdUB,sdat_nudging_multi%pstrm(1)%todUB + write(iulog,'(a,i8)')' Nudge deltaT = ',DeltaT + write(iulog,'(a,i8)')' Nudge_file_step = ',Nudge_File_Step + end if + ! Set Tscale for the specified Forcing Option !----------------------------------------------- if(Nudge_TimeScale_Opt == 0) then - Tscale=1._r8 - elseif (Nudge_TimeScale_Opt == 1) then - - Update_Nudge = (curr_time >= Nudge_file_next_time) - if ((Before_End) .and. (Update_Nudge)) then - ! Increment the Nudge times by the current interval - Nudge_File_Next_Time = Nudge_File_Next_Time + Nudge_File_Delta - endif - date_diff = Nudge_file_next_time - curr_time - call ESMF_TimeIntervalGet(date_diff, S=DeltaT, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') Tscale = float(Nudge_File_Step)/float(DeltaT) - else - 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 + + Nudge_Utau(:ncol,:pver,lchnk) = Nudge_Utau0(:ncol,:pver,lchnk) * Nudge_Ucoef/float(Nudge_File_Step) + Nudge_Vtau(:ncol,:pver,lchnk) = Nudge_Vtau0(:ncol,:pver,lchnk) * Nudge_Vcoef/float(Nudge_File_Step) + Nudge_Stau(:ncol,:pver,lchnk) = Nudge_Stau0(:ncol,:pver,lchnk) * Nudge_Tcoef/float(Nudge_File_Step) + Nudge_Qtau(:ncol,:pver,lchnk) = Nudge_Qtau0(:ncol,:pver,lchnk) * Nudge_Qcoef/float(Nudge_File_Step) + Nudge_PStau(:ncol,lchnk) = Nudge_PStau0(:ncol,lchnk) * Nudge_PScoef/float(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 ! Increment the Model times by the current interval @@ -1207,7 +1152,7 @@ subroutine nudging_timestep_init(phys_state) write(iulog,*) 'NUDGING: WARNING - Model_Update_Time Sync ERROR... CORRECTED' endif - endif ! ((Before_End) .and. Update_Model) + endif ! (Update_Model) ! End Routine !------------ @@ -1224,6 +1169,7 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) ! 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 @@ -1235,34 +1181,29 @@ 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 + 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) + end if ! End Routine !------------ @@ -1274,15 +1215,15 @@ end subroutine nudging_timestep_tend !================================================================ 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 + integer :: nlev,Nudge_prof real(r8) :: rlat,rlon real(r8) :: Wprof(nlev) @@ -1379,28 +1320,6 @@ 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(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(Zonal_Bamp2d)) deallocate(Zonal_Bamp2d) if (allocated(Zonal_Bamp3d)) deallocate(Zonal_Bamp3d) @@ -1455,7 +1374,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 @@ -1472,7 +1390,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 @@ -1482,10 +1399,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 @@ -1512,7 +1425,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))) @@ -1559,10 +1472,10 @@ subroutine nudging_stream_init() ! Determine nudge_year_first, nudge_year_last and tintalgo call ESMF_TimeGet(nudge_beg_time, yy=nudge_year_first, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeGet for nudge_beg_time') + call chkrc(rc,__LINE__,u_FILE_u) call ESMF_TimeGet(nudge_end_time, yy=nudge_year_last, rc=rc) - call chkrc(rc, sub//': error return from ESMF_TimeGet for nudge_end_time') + call chkrc(rc,__LINE__,u_FILE_u) if (Nudge_Force_Opt == 0) then tintalgo = 'upper' @@ -1595,7 +1508,7 @@ subroutine nudging_stream_init() do nfile = 1,size(nudge_filenames) if (trim(nudge_filenames(nfile)) /= ' ') then - nudge_filenames(nfile) = trim(nudge_datapath)//trim(nudge_filenames(nfile)) + nudge_filenames(nfile) = trim(nudge_datapath)//'/'//trim(nudge_filenames(nfile)) end if end do @@ -1624,7 +1537,7 @@ subroutine nudging_stream_init() stream_tintalgo = tintalgo, & stream_name = 'NUDGING forcing data ', & rc = rc) - call chkrc(rc, sub//': error return from shr_strdata_init_from_inline') + call chkrc(rc,__LINE__,u_FILE_u) call shr_strdata_init_from_inline(sdat_nudging_singl, & my_task = iam, & @@ -1647,14 +1560,14 @@ subroutine nudging_stream_init() stream_tintalgo = tintalgo, & stream_name = 'NUDGING forcing data ', & rc = rc) - call chkrc(rc, sub//': error return from shr_strdata_init_from_inline') + call chkrc(rc,__LINE__,u_FILE_u) end subroutine nudging_stream_init !================================================================ !================================================================ - subroutine nudging_stream_interp() + 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 @@ -1663,6 +1576,13 @@ subroutine nudging_stream_interp() 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 :: istat ! allocate return @@ -1677,16 +1597,16 @@ subroutine nudging_stream_interp() 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), allocatable :: Tmp3D(:,:,:) - real(r8), allocatable :: Tmp2D(:,:) + 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, sub//': error return from ESMF_TimeSet for Model_Update_Time') + call chkrc(rc,__LINE__,u_FILE_u) mcdate = year*10000 + mon*100 + day if (masterproc) then write(iulog,*)'DEBUG: nudging_stream_interp: interpolating nudge to ',year,mon,day,sec @@ -1694,18 +1614,12 @@ subroutine nudging_stream_interp() ! Advance sdat streams call shr_strdata_advance(sdat_nudging_multi, ymd=mcdate, tod=sec, logunit=iulog, istr='nudging', rc=rc) - call chkrc(rc, sub//': error return from shr_strdata_advance') + 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, sub//': error return from shr_strdata_advance') + call chkrc(rc,__LINE__,u_FILE_u) ! Get pointer for stream data that is time and spatially interpolated to model time and grid - allocate(Tmp3D(pcols,pver,begchunk:endchunk), stat=istat) - call handle_allocate_error(istat, sub, 'TMP3d') - - allocate(Tmp2D(pcols,begchunk:endchunk), stat=istat) - call handle_allocate_error(istat, sub, 'TM23d') - ! Obtain Target_U, Target_V, Target_T and Target_Q do nvar = 1,4 @@ -1716,7 +1630,7 @@ subroutine nudging_stream_interp() call dshr_fldbun_getFldPtr(sdat_nudging_multi%pstrm(1)%fldbun_model, & nudge_varlist_multi(nvar), fldptr2=dataptr2d, rc=rc) - call chkrc(rc, sub//': error return from shr_strdata_advance') + call chkrc(rc,__LINE__,u_FILE_u) ! Obtain TMP3d do klev = 1, pver @@ -1764,7 +1678,7 @@ subroutine nudging_stream_interp() ! Obtain Target_PS call dshr_fldbun_getFldPtr(sdat_nudging_singl%pstrm(1)%fldbun_model, 'PS', fldptr1=dataptr1d, rc=rc) - call chkrc(rc, sub//': error return from dshr_fldbun_getFldPtr') + call chkrc(rc,__LINE__,u_FILE_u) g = 1 do lchnk = begchunk,endchunk @@ -1790,12 +1704,70 @@ end subroutine nudging_stream_interp !================================================================ - subroutine chkrc(rc, mes) - integer, intent(in) :: rc ! return code from time management library - character(len=*), intent(in) :: mes ! error message - if ( rc == ESMF_SUCCESS ) return - write(iulog,*) mes - call endrun ('CHKRC') + 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') + end if end subroutine chkrc end module nudging From 7ab3db06d8153e635e0b2ee5977e17295525d8a8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Nov 2025 14:59:53 +0100 Subject: [PATCH 10/25] more fixes to refactor of nudging --- src/physics/cam/nudging.F90 | 46 +++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 17 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 0de15ac2f7..892ecea16b 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -1098,10 +1098,10 @@ subroutine nudging_timestep_init(phys_state) call chkrc(rc,__LINE__,u_FILE_u) if (masterproc) then - write(iulog,*)'DEBUG: sdat%ymdLB, sdat%todLB ',sdat_nudging_multi%pstrm(1)%ymdLB,sdat_nudging_multi%pstrm(1)%todLB - write(iulog,*)'DEBUG: sdat%ymdUB, sdat%todUB ',sdat_nudging_multi%pstrm(1)%ymdUB,sdat_nudging_multi%pstrm(1)%todUB - write(iulog,'(a,i8)')' Nudge deltaT = ',DeltaT - write(iulog,'(a,i8)')' Nudge_file_step = ',Nudge_File_Step + 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 @@ -1148,8 +1148,8 @@ subroutine nudging_timestep_init(phys_state) ! 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' + Model_Update_next_time = curr_time + Model_Update_Interval + write(iulog,*) 'NUDGING: WARNING - Model_Update_Time Sync ERROR... CORRECTED' endif endif ! (Update_Model) @@ -1165,9 +1165,9 @@ 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 @@ -1213,12 +1213,12 @@ 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. + ! 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 @@ -1227,9 +1227,9 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) real(r8) :: rlat,rlon real(r8) :: 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 @@ -1320,8 +1320,20 @@ end subroutine nudging_set_profile !================================================================ subroutine nudging_final - if (allocated(Zonal_Bamp2d)) deallocate(Zonal_Bamp2d) - if (allocated(Zonal_Bamp3d)) deallocate(Zonal_Bamp3d) + 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) call ZM%final() From afa5c2bc4cc2989e8a0c6a9de8d346e257042361 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 Dec 2025 19:46:01 +0100 Subject: [PATCH 11/25] mapalgo and tintalgo are now namelist input --- bld/namelist_files/namelist_definition.xml | 39 +++- src/physics/cam/nudging.F90 | 213 ++++++++++++--------- 2 files changed, 156 insertions(+), 96 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 9cd38ffffd..49d470b982 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -220,15 +220,15 @@ Default: FALSE - - Filenames of analyses data to use for nudging. + Full pathname of datapath where Nudge_Filenames are located. Default: none - - Full pathname of datapath where Nudge_Filenames are located. + Filenames of analyses data to use for nudging. Default: none @@ -238,11 +238,10 @@ Default: none - - Number of analysis times per day in nudging filename(s). - (e.g. 4 --> 6 hourly analyses) - Default: 6 + Name of vertical dimension in file. + Default: none + + Model year to align with Nudge_Beg_Year. + Default: none + + Select the form of nudging forcing, where (t'==Analysis times ; t==Model Times) @@ -305,6 +310,24 @@ Default: 0 + + 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: bilinear + + Profile index for U nudging. diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 892ecea16b..563ff509c4 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -219,9 +219,9 @@ module nudging private :: nudging_stream_init ! position datasets for dynamic nudging private :: nudging_stream_interp ! interpolates between two years of nudging file data - integer, parameter :: maxfiles = 1000 + integer, parameter :: maxfiles = 100 - logical, public :: Nudge_On = .false. + logical, public :: Nudge_On = .false. ! Nudging Parameters !-------------------- @@ -243,6 +243,12 @@ module nudging integer :: Nudge_End_sec type(ESMF_Time) :: Nudge_End_time + integer :: Nudge_Align_year + character(len=cs) :: Nudge_mapalgo ! [bilinear, consf, nn] + character(len=cs) :: Nudge_tintalgo ! [linear, upper] + character(len=cs) :: Nudge_taxmode ! [limit, extend] + character(len=cs) :: Nudge_levname + integer :: Model_Update_Times_Per_Day type(ESMF_TimeInterval) :: Model_Update_Interval type(ESMF_Time) :: Model_Update_Next_Time @@ -338,6 +344,8 @@ subroutine nudging_readnl(nlfile) Nudge_Force_Opt, Nudge_TimeScale_Opt, & Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & + Nudge_Align_Year, Nudge_Mapalgo, Nudge_Taxmode, & + Nudge_Levname, & Model_Update_Times_Per_Day, & Nudge_Ucoef , Nudge_Uprof, & Nudge_Vcoef , Nudge_Vprof, & @@ -360,22 +368,32 @@ subroutine nudging_readnl(nlfile) ! Nudging will always begin/end at midnight. !-------------------------------------------- Nudge_Initialized =.false. - Nudge_Beg_Sec = 0 Nudge_End_Sec = 0 + Nudge_Beg_Sec = 0 ! Set Default Namelist values !----------------------------- Nudge_Model = .false. Model_Update_Times_Per_Day = 4 - Nudge_Filenames(:) = ' ' + Nudge_Datapath = ' ' + Nudge_Filenames(:) = ' ' Nudge_Meshfile = ' ' + 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_Align_Year = 2008 + + Nudge_Mapalgo = 'bilinear' + Nudge_taxmode = 'limit' + Nudge_levname = 'lev' + Nudge_Force_Opt = 0 Nudge_TimeScale_Opt = 0 Nudge_TSmode = 0 @@ -427,15 +445,18 @@ subroutine nudging_readnl(nlfile) call MPI_bcast(Nudge_Model, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Model') - call MPI_bcast(Nudge_Filenames(:), len(Nudge_Filenames(1))*maxfiles, mpi_character, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Filenames') - call MPI_bcast(Nudge_Datapath, len(Nudge_Datapath), mpi_character, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Datapath') + call MPI_bcast(Nudge_Filenames(:), len(Nudge_Filenames(1))*maxfiles, mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Filenames') + call MPI_bcast(Nudge_Meshfile, len(Nudge_Meshfile), mpi_character, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Meshfile') + call MPI_bcast(Nudge_Levname, len(Nudge_Taxmode), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Taxmode') + call MPI_bcast(Model_Update_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Update_Times_Per_Day') @@ -463,6 +484,15 @@ subroutine nudging_readnl(nlfile) call MPI_bcast(Nudge_End_Sec, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Sec') + call MPI_bcast(Nudge_Align_Year, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Align_Year') + + call MPI_bcast(Nudge_Mapalgo, len(Nudge_Mapalgo), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Mapalgo') + + call MPI_bcast(Nudge_Taxmode, len(Nudge_Taxmode), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Taxmode') + call MPI_bcast(Nudge_Initialized, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Initialized') @@ -642,7 +672,7 @@ subroutine nudging_init real(r8) :: Val1_p,Val2_p,Val3_p,Val4_p real(r8) :: Val1_0,Val2_0,Val3_0,Val4_0 real(r8) :: Val1_n,Val2_n,Val3_n,Val4_n - integer :: nn + integer :: nn, nf integer :: size2d, size3d character(len=*), parameter :: prefix = 'nudging_init: ' character(len=*), parameter :: sub = "(nudging_init) " @@ -732,9 +762,6 @@ subroutine nudging_init 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) - if (masterproc) then - write(iulog,*)'DEBUG: initial model update next time = ',year,month,day,(Sec/Model_Update_Step)*Model_Update_Step - end if elseif (.not.After_Beg) then @@ -789,6 +816,16 @@ subroutine nudging_init (Val1_n*Val2_n*Val3_n*Val4_n), & (Val1_n*Val2_n*Val3_p*Val4_p)) + ! Determine Nudge_tintalgo + if (Nudge_Force_Opt == 0) then + Nudge_tintalgo = 'upper' + elseif(Nudge_Force_Opt == 1) then + Nudge_tintalgo = 'linear' + else + write(iulog,*) 'NUDGING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt + call endrun('nudging_timestep_init:: ERROR unknown Nudge_Force_Opt') + endif + ! Initialization is done, !-------------------------- Nudge_Initialized = .true. @@ -801,51 +838,63 @@ 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_Force_Opt =',Nudge_Force_Opt - write(iulog,*) 'NUDGING: Nudge_TimeScale_Opt =',Nudge_TimeScale_Opt - write(iulog,*) 'NUDGING: Nudge_TSmode =',Nudge_TSmode - write(iulog,*) 'NUDGING: Model_Update_Times_Per_Day =',Model_Update_Times_Per_Day - write(iulog,*) 'NUDGING: Model_Update_Step =',Model_Update_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,'(a,l4)')'NUDGING: Nudge_Model = ',Nudge_Model + write(iulog,'(a,a)' )'NUDGING: Nudge_Datapath = ',len_trim(Nudge_Datapath) + write(iulog,'(a,a)' )'NUDGING: Nudge_Meshfile = ',len_trim(Nudge_Meshfile) + write(iulog,'(a,a)' )'NUDGING: Nudge_Levname = ',len_trim(Nudge_Levname) + do nf = 1,maxfiles + if (trim(Nudge_Filenames(nf)) /= ' ') then + write(iulog,'(a,a)')'NUDGING: Nudge_Datapath = ',len_trim(Nudge_Datapath) + end if + end do + 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_Align_Year = ',Nudge_Align_Year + write(iulog,*) 'NUDGING: Nudge_Mapalgo = ',len_trim(Nudge_Mapalgo) + write(iulog,*) 'NUDGING: Nudge_Tintalgo = ',len_trim(Nudge_Tintalgo) + write(iulog,*) 'NUDGING: Nudge_Taxmode = ',len_trim(Nudge_Taxmode) + write(iulog,*) 'NUDGING: Model_Update_Times_Per_Day = ',Model_Update_Times_Per_Day + write(iulog,*) 'NUDGING: Model_Update_Step = ',Model_Update_Step + write(iulog,*) 'NUDGING: Nudge_PSprof = ',Nudge_PSprof + 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_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_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,*) ' ' endif ! (masterproc) then @@ -872,15 +921,15 @@ subroutine nudging_init 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) + 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) + 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) + 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) + 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) + Nudge_PStau0(icol,lchnk) = nudging_set_PSprofile(rlat, rlon, Nudge_PSprof) end do end do @@ -899,6 +948,7 @@ subroutine nudging_timestep_init(phys_state) ! 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 @@ -913,7 +963,7 @@ subroutine nudging_timestep_init(phys_state) ! Local values !---------------- - integer :: Year,Month,Day,Sec + integer :: Year, Month, Day, Sec logical :: Update_Model, Sync_Error logical :: Update_Nudge logical :: After_Beg, Before_End @@ -1477,28 +1527,17 @@ subroutine nudging_stream_init() integer :: nfile integer :: nudge_year_first integer :: nudge_year_last - character(len=CS) :: tintalgo + integer :: nudge_year_align character(*), parameter :: sub = "('nudging_stream_init')" !---------------------------------------------------------------- - ! Determine nudge_year_first, nudge_year_last and tintalgo + ! Write output log info call ESMF_TimeGet(nudge_beg_time, yy=nudge_year_first, rc=rc) call chkrc(rc,__LINE__,u_FILE_u) - call ESMF_TimeGet(nudge_end_time, yy=nudge_year_last, rc=rc) call chkrc(rc,__LINE__,u_FILE_u) - - if (Nudge_Force_Opt == 0) then - tintalgo = 'upper' - elseif(Nudge_Force_Opt == 1) then - tintalgo = 'linear' - else - write(iulog,*) 'NUDGING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt - call endrun('nudging_timestep_init:: ERROR unknown Nudge_Force_Opt') - endif - - ! Write output log info + nudge_year_align = nudge_align_year if (masterproc) then write(iulog,'(a)' ) ' ' @@ -1506,8 +1545,8 @@ subroutine nudging_stream_init() write(iulog,'(a,a,a)') ' nudge varlist = ','U,V,T,Q,PS' write(iulog,'(a,i8)') ' nudge year first = ',nudge_year_first write(iulog,'(a,i8)') ' nudge year last = ',nudge_year_last - write(iulog,'(a,i8)') ' nudge year align = ',nudge_year_first - write(iulog,'(a,a)') ' nudge tintalgo = ',trim(tintalgo) + write(iulog,'(a,i8)') ' nudge year align = ',nudge_year_align + write(iulog,'(a,a)') ' nudge tintalgo = ',trim(nudge_tintalgo) write(iulog,'(a,a)' ) ' nudge meshfile = ',trim(nudge_meshfile) write(iulog,'(a,a)' ) ' nudge datapath = ',trim(nudge_datapath) do nfile = 1,size(nudge_filenames) @@ -1524,9 +1563,7 @@ subroutine nudging_stream_init() end if end do - ! Create module stream data type sdat_nudging - ! TODO: change dtlimit to be twice the step size call shr_strdata_init_from_inline(sdat_nudging_multi, & my_task = iam, & @@ -1538,15 +1575,15 @@ subroutine nudging_stream_init() stream_filenames = nudge_filenames, & stream_yearFirst = nudge_year_first, & stream_yearLast = nudge_year_last, & - stream_yearAlign = nudge_year_first, & + stream_yearAlign = nudge_year_align, & stream_fldlistFile = nudge_varlist_multi, & stream_fldListModel = nudge_varlist_multi, & - stream_lev_dimname = 'lev', & - stream_mapalgo = 'bilinear', & + stream_lev_dimname = trim(nudge_levname), & + stream_mapalgo = trim(nudge_mapalgo), & stream_offset = 0, & - stream_taxmode = 'limit', & + stream_taxmode = trim(nudge_taxmode), & stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = tintalgo, & + stream_tintalgo = nudge_tintalgo, & stream_name = 'NUDGING forcing data ', & rc = rc) call chkrc(rc,__LINE__,u_FILE_u) @@ -1565,11 +1602,11 @@ subroutine nudging_stream_init() stream_fldlistFile = nudge_varlist_singl, & stream_fldListModel = nudge_varlist_singl, & stream_lev_dimname = 'null', & - stream_mapalgo = 'bilinear', & + stream_mapalgo = trim(nudge_mapalgo), & stream_offset = 0, & - stream_taxmode = 'limit', & + stream_taxmode = trim(nudge_taxmode), & stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = tintalgo, & + stream_tintalgo = nudge_tintalgo, & stream_name = 'NUDGING forcing data ', & rc = rc) call chkrc(rc,__LINE__,u_FILE_u) From a50100a6464e262f1843b1a70d9b4d3474f6890a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 11 Dec 2025 10:23:51 +0100 Subject: [PATCH 12/25] new default settings for namelists - particularly nudging_align_year --- src/physics/cam/nudging.F90 | 389 ++++++++++++++++++------------------ 1 file changed, 200 insertions(+), 189 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 563ff509c4..e65d56deb8 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -129,6 +129,19 @@ module nudging ! Nudge_End_Month - INT nudging ending month. [1-12] ! Nudge_End_Day - INT nudging ending day. [1-31] ! +! Nudge_Align_Year - INT simulation 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_Force_Opt - INT Index to select the nudging Target for a relaxation forcing of the form: ! where (t'==Analysis times ; t==Model Times) ! @@ -199,6 +212,7 @@ module nudging 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. @@ -315,6 +329,9 @@ module nudging character(len=2) :: nudge_varlist_multi(4) = (/'U ', 'V ','T ','Q '/) character(len=2) :: nudge_varlist_singl(1) = (/'PS'/) + integer :: iunset = -999 + logical :: stream_initialized = .false. + character(*),parameter :: u_FILE_u = __FILE__ contains @@ -338,7 +355,7 @@ subroutine nudging_readnl(nlfile) integer :: ierr, unitn integer :: nfile - character(len=*), parameter :: prefix = 'nudging_readnl: ' + character(len=*), parameter :: subname = 'nudging_readnl: ' namelist /nudging_nl/ Nudge_Model, Nudge_datapath, Nudge_Filenames, Nudge_Meshfile, & Nudge_Force_Opt, Nudge_TimeScale_Opt, & @@ -376,19 +393,17 @@ subroutine nudging_readnl(nlfile) Nudge_Model = .false. Model_Update_Times_Per_Day = 4 - Nudge_Datapath = ' ' - Nudge_Filenames(:) = ' ' - Nudge_Meshfile = ' ' - - 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_Datapath = 'unset' + Nudge_Filenames(:) = 'unset' + Nudge_Meshfile = 'unset' - Nudge_Align_Year = 2008 + Nudge_Beg_Year = iunset + Nudge_Beg_Month = iunset + Nudge_Beg_Day = iunset + Nudge_End_Year = iunset + Nudge_End_Month = iunset + Nudge_End_Day = iunset + Nudge_Align_Year = iunset Nudge_Mapalgo = 'bilinear' Nudge_taxmode = 'limit' @@ -443,139 +458,110 @@ subroutine nudging_readnl(nlfile) ! Broadcast namelist variables !------------------------------ call MPI_bcast(Nudge_Model, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Model') + 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(prefix//'FATAL: mpi_bcast: Nudge_Datapath') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Filenames') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Meshfile') + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Meshfile '//trim(Nudge_Meshfile)) call MPI_bcast(Nudge_Levname, len(Nudge_Taxmode), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Taxmode') + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Taxmode '//trim(Nudge_Taxmode)) call MPI_bcast(Model_Update_Times_Per_Day, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Update_Times_Per_Day') + 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(prefix//'FATAL: mpi_bcast: Nudge_Beg_Year') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Beg_Month') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Beg_Day') - + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Beg_Day '//int2str(Nudge_Beg_Day)) call MPI_bcast(Nudge_Beg_Sec, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Sec') + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Beg_Sec '//int2str(Nudge_Beg_Sec)) call MPI_bcast(Nudge_End_Year, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Year') - + 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(prefix//'FATAL: mpi_bcast: Nudge_End_Month') - + 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(prefix//'FATAL: mpi_bcast: Nudge_End_Day') - + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_End_Day '//int2str(Nudge_End_Day)) call MPI_bcast(Nudge_End_Sec, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Sec') + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_End_Sec '//int2str(Nudge_End_Sec)) call MPI_bcast(Nudge_Align_Year, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Align_Year') + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Align_Year '//int2str(Nudge_Align_Year)) call MPI_bcast(Nudge_Mapalgo, len(Nudge_Mapalgo), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Mapalgo') - + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Mapalgo '//trim(Nudge_Mapalgo)) call MPI_bcast(Nudge_Taxmode, len(Nudge_Taxmode), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Taxmode') + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Taxmode '//trim(Nudge_TaxMode)) call MPI_bcast(Nudge_Initialized, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Initialized') + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Initialized') call MPI_bcast(Nudge_Force_Opt, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Force_Opt') - + 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(prefix//'FATAL: mpi_bcast: Nudge_TimeScale_Opt') - + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_TimeScale_Opt '//int2str(Nudge_TimeScale_Opt)) call MPI_bcast(Nudge_TSmode, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_TSmode') + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_TSmode '//int2str(Nudge_TSmode)) call MPI_bcast(Nudge_Ucoef, 1, mpi_real8, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Ucoef') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Vcoef') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Tcoef') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Qcoef') - + 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(prefix//'FATAL: mpi_bcast: Nudge_PScoef') + 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(prefix//'FATAL: mpi_bcast: Nudge_Uprof') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Vprof') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Tprof') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Qprof') - + 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(prefix//'FATAL: mpi_bcast: Nudge_PSprof') + 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(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lat0') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latWidth') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latDelta') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lon0') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonWidth') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonDelta') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Hwin_Invert') + 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(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Hindex') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Hdelta') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Lindex') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Ldelta') - + 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(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Invert') - - call MPI_bcast(Nudge_ZonalFilter, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ZonalFilter') + if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Vwin_Invert') - call MPI_bcast(Nudge_ZonalNbasis, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ZonalNbasis') + 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)) ! Set hi/lo values according to the given '_Invert' parameters !-------------------------------------------------------------- @@ -597,45 +583,80 @@ subroutine nudging_readnl(nlfile) ! Check for valid namelist values !---------------------------------- + if (Nudge_Beg_year == iunset) then + call endrun('nudging_readnl:: Nudge_Beg_year '//int2str(Nudge_Beg_year)//' is not a valid value') + end if + if (Nudge_end_year == iunset) then + call endrun('nudging_readnl:: Nudge_end_year '//int2str(Nudge_end_year)//' is not a valid value') + end if + if (Nudge_Beg_year > Nudge_end_year) then + call endrun('nudging_readnl:: Nudge_Beg_year '//int2str(Nudge_Beg_year)//& + 'cannot be greater than Nudge_end_year '//int2str(Nudge_end_year)) + end if + + ! Determine nudge_align_year if not set + if (Nudge_align_year == iunset) then + Nudge_align_year = Nudge_Beg_year + end if + + ! Determine Nudge_tintalgo + if (Nudge_Force_Opt == 0) then + Nudge_tintalgo = 'upper' + elseif(Nudge_Force_Opt == 1) then + Nudge_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 - write(iulog,*) 'NUDGING: Window lat0 must be in [-90,+90]' - write(iulog,*) 'NUDGING: Nudge_Hwin_lat0=',Nudge_Hwin_lat0 + 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('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 + 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('nudging_readnl:: ERROR in namelist') 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 - 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 + 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('nudging_readnl:: ERROR in namelist') 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 - 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 + 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('nudging_readnl:: ERROR in namelist') endif - 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') + 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('nudging_readnl:: ERROR in namelist for Nudge_Hwin_LonWidgth') endif ! End Routine !------------ @@ -674,8 +695,7 @@ subroutine nudging_init real(r8) :: Val1_n,Val2_n,Val3_n,Val4_n integer :: nn, nf integer :: size2d, size3d - character(len=*), parameter :: prefix = 'nudging_init: ' - character(len=*), parameter :: sub = "(nudging_init) " + character(len=*), parameter :: subname = "nudging_init: " !---------------------------------------------------------- ! Allocate Space @@ -685,26 +705,26 @@ subroutine nudging_init size2d = pcols*((endchunk-begchunk)+1) allocate(Nudge_Utau0(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Utau',size3d) + call alloc_err(istat,subname,'Nudge_Utau',size3d) allocate(Nudge_Vtau0(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Vtau',size3d) + call alloc_err(istat,subname,'Nudge_Vtau',size3d) allocate(Nudge_Stau0(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Stau',size3d) + call alloc_err(istat,subname,'Nudge_Stau',size3d) allocate(Nudge_Qtau0(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Qtau',size3d) + call alloc_err(istat,subname,'Nudge_Qtau',size3d) allocate(Nudge_PStau0(pcols,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_PStau',size2d) + call alloc_err(istat,subname,'Nudge_PStau',size2d) allocate(Nudge_Ustep(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_Ustep',size3d) + 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',size3d) + 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',size3d) + 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',size3d) + call alloc_err(istat,subname,'Nudge_Qstep',size3d) allocate(Nudge_PSstep(pcols,begchunk:endchunk),stat=istat) - call alloc_err(istat,'nudging_init','Nudge_PSstep',size2d) + call alloc_err(istat,subname,'Nudge_PSstep',size2d) ! Register output fields with the cam history module !----------------------------------------------------- @@ -816,16 +836,6 @@ subroutine nudging_init (Val1_n*Val2_n*Val3_n*Val4_n), & (Val1_n*Val2_n*Val3_p*Val4_p)) - ! Determine Nudge_tintalgo - if (Nudge_Force_Opt == 0) then - Nudge_tintalgo = 'upper' - elseif(Nudge_Force_Opt == 1) then - Nudge_tintalgo = 'linear' - else - write(iulog,*) 'NUDGING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt - call endrun('nudging_timestep_init:: ERROR unknown Nudge_Force_Opt') - endif - ! Initialization is done, !-------------------------- Nudge_Initialized = .true. @@ -838,63 +848,63 @@ subroutine nudging_init write(iulog,*) '---------------------------------------------------------' write(iulog,*) ' MODEL NUDGING INITIALIZED WITH THE FOLLOWING SETTINGS: ' write(iulog,*) '---------------------------------------------------------' - write(iulog,'(a,l4)')'NUDGING: Nudge_Model = ',Nudge_Model - write(iulog,'(a,a)' )'NUDGING: Nudge_Datapath = ',len_trim(Nudge_Datapath) - write(iulog,'(a,a)' )'NUDGING: Nudge_Meshfile = ',len_trim(Nudge_Meshfile) - write(iulog,'(a,a)' )'NUDGING: Nudge_Levname = ',len_trim(Nudge_Levname) + 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,'(2a)' ) 'NUDGING: Nudge_Levname = ',trim(Nudge_Levname) do nf = 1,maxfiles if (trim(Nudge_Filenames(nf)) /= ' ') then write(iulog,'(a,a)')'NUDGING: Nudge_Datapath = ',len_trim(Nudge_Datapath) end if end do - 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_Align_Year = ',Nudge_Align_Year - write(iulog,*) 'NUDGING: Nudge_Mapalgo = ',len_trim(Nudge_Mapalgo) - write(iulog,*) 'NUDGING: Nudge_Tintalgo = ',len_trim(Nudge_Tintalgo) - write(iulog,*) 'NUDGING: Nudge_Taxmode = ',len_trim(Nudge_Taxmode) - write(iulog,*) 'NUDGING: Model_Update_Times_Per_Day = ',Model_Update_Times_Per_Day - write(iulog,*) 'NUDGING: Model_Update_Step = ',Model_Update_Step - write(iulog,*) 'NUDGING: Nudge_PSprof = ',Nudge_PSprof - 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_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_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,'(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: Nudge_Align_Year = ',Nudge_Align_Year + write(iulog,'(2a)' ) 'NUDGING: Nudge_Mapalgo = ',trim(Nudge_Mapalgo) + write(iulog,'(2a)' ) 'NUDGING: Nudge_Tintalgo = ',trim(Nudge_Tintalgo) + write(iulog,'(2a)' ) 'NUDGING: Nudge_Taxmode = ',trim(Nudge_Taxmode) + 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 @@ -905,10 +915,10 @@ subroutine nudging_init call ZM%init(Nudge_ZonalNbasis) allocate(Zonal_Bamp2d(Nudge_ZonalNbasis),stat=istat) - call alloc_err(istat,'nudging_init','Zonal_Bamp2d',Nudge_ZonalNbasis) + call alloc_err(istat,subname,'Zonal_Bamp2d',Nudge_ZonalNbasis) allocate(Zonal_Bamp3d(Nudge_ZonalNbasis,pver),stat=istat) - call alloc_err(istat,'nudging_init','Zonal_Bamp3d',Nudge_ZonalNbasis*pver) + call alloc_err(istat,subname,'Zonal_Bamp3d',Nudge_ZonalNbasis*pver) endif ! Initialize Nudging Coeffcient profiles in local arrays @@ -1005,7 +1015,7 @@ subroutine nudging_timestep_init(phys_state) ! Check if Nudging is initialized !--------------------------------- - if(.not.Nudge_Initialized) then + if (.not.Nudge_Initialized) then call endrun('nudging_timestep_init:: Nudging NOT Initialized') endif @@ -1039,9 +1049,8 @@ subroutine nudging_timestep_init(phys_state) ! actually created - so it cannot be called out of nudging_init ! since that occurs before the creation of the model mesh !---------------------------------------------------------- - if (first_call) then + if (.not. stream_initialized) then call nudging_stream_init() - first_call = .false. end if ! Load values at Current into the Model arrays @@ -1611,6 +1620,8 @@ subroutine nudging_stream_init() rc = rc) call chkrc(rc,__LINE__,u_FILE_u) + stream_initialized = .true. + end subroutine nudging_stream_init !================================================================ @@ -1658,7 +1669,7 @@ subroutine nudging_stream_interp(Target_U, Target_V, Target_T, Target_Q, Target_ call chkrc(rc,__LINE__,u_FILE_u) mcdate = year*10000 + mon*100 + day if (masterproc) then - write(iulog,*)'DEBUG: nudging_stream_interp: interpolating nudge to ',year,mon,day,sec + write(iulog,'(a,4(i6,2x))')' nudging_stream_interp: interpolating nudge to ',year,mon,day,sec end if ! Advance sdat streams From 93e6f46b77a482ee845804483765a4efc38b2811 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 12 Dec 2025 09:45:20 +0100 Subject: [PATCH 13/25] fixed namelist checking to work only if nudge_model is on --- src/physics/cam/nudging.F90 | 185 +++++++++++++++++++----------------- 1 file changed, 96 insertions(+), 89 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index e65d56deb8..9b882ebd3c 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -232,13 +232,13 @@ module nudging private :: calc_DryStaticEnergy private :: nudging_stream_init ! position datasets for dynamic nudging private :: nudging_stream_interp ! interpolates between two years of nudging file data + private :: chkrc - integer, parameter :: maxfiles = 100 - - logical, public :: Nudge_On = .false. + logical, public, protected :: Nudge_On = .false. ! Nudging Parameters !-------------------- + integer, parameter :: maxfiles = 100 logical :: Nudge_Model =.false. logical :: Nudge_Initialized =.false. character(len=cl) :: Nudge_Meshfile @@ -563,101 +563,108 @@ subroutine nudging_readnl(nlfile) 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)) - ! 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 + ! Note that this routine is called even if nudging is not on - so need to do the following + ! only if nudging is on - ! Check for valid namelist values - !---------------------------------- - if (Nudge_Beg_year == iunset) then - call endrun('nudging_readnl:: Nudge_Beg_year '//int2str(Nudge_Beg_year)//' is not a valid value') - end if - if (Nudge_end_year == iunset) then - call endrun('nudging_readnl:: Nudge_end_year '//int2str(Nudge_end_year)//' is not a valid value') - end if - if (Nudge_Beg_year > Nudge_end_year) then - call endrun('nudging_readnl:: Nudge_Beg_year '//int2str(Nudge_Beg_year)//& - 'cannot be greater than Nudge_end_year '//int2str(Nudge_end_year)) - end if + check_valid: if (Nudge_Model) then - ! Determine nudge_align_year if not set - if (Nudge_align_year == iunset) then - Nudge_align_year = Nudge_Beg_year - 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 - ! Determine Nudge_tintalgo - if (Nudge_Force_Opt == 0) then - Nudge_tintalgo = 'upper' - elseif(Nudge_Force_Opt == 1) then - Nudge_tintalgo = 'linear' - else - call endrun('nudging_timestep_init:: ERROR unknown Nudge_Force_Opt '//int2str(Nudge_Force_Opt)) - 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_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('nudging_readnl:: ERROR in namelist') - endif + ! 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 - 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('nudging_readnl:: ERROR in namelist') - endif + ! Determine nudge_align_year if not set + if (Nudge_align_year == iunset) then + Nudge_align_year = Nudge_Beg_year + 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 - 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('nudging_readnl:: ERROR in namelist') - endif + ! Determine Nudge_tintalgo + if (Nudge_Force_Opt == 0) then + Nudge_tintalgo = 'upper' + elseif(Nudge_Force_Opt == 1) then + Nudge_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 - 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('nudging_readnl:: ERROR in namelist') + 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 - endif + end if check_valid - 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('nudging_readnl:: ERROR in namelist for Nudge_Hwin_LonWidgth') - endif ! End Routine !------------ From 9493bdb8754c774851736261ea6b3986f2faa135 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 18 Dec 2025 10:23:59 +0100 Subject: [PATCH 14/25] fixed standard out issues from nudging --- src/physics/cam/nudging.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 9b882ebd3c..3d2131c638 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -858,12 +858,12 @@ subroutine nudging_init 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,'(2a)' ) 'NUDGING: Nudge_Levname = ',trim(Nudge_Levname) do nf = 1,maxfiles if (trim(Nudge_Filenames(nf)) /= ' ') then - write(iulog,'(a,a)')'NUDGING: Nudge_Datapath = ',len_trim(Nudge_Datapath) + write(iulog,'(a,a)' )'NUDGING: Nudge_Filename = ',len_trim(Nudge_Filenames(nf)) end if end do + write(iulog,'(2a)' ) 'NUDGING: Nudge_Levname = ',trim(Nudge_Levname) 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 @@ -1566,8 +1566,8 @@ subroutine nudging_stream_init() write(iulog,'(a,a)' ) ' nudge meshfile = ',trim(nudge_meshfile) write(iulog,'(a,a)' ) ' nudge datapath = ',trim(nudge_datapath) do nfile = 1,size(nudge_filenames) - if (trim(nudge_filenames(nfile)) /= ' ') then - write(iulog,'(a,i8,2x,a)' ) ' nudge files = ',nfile,trim(nudge_filenames(nfile)) + if (trim(nudge_filenames(nfile)) /= 'unset') then + write(iulog,'(a,i8,2x,a)' ) ' nudge file = ',nfile,trim(nudge_filenames(nfile)) end if end do write(iulog,'(a)' ) ' ' From d0ae46339838f63cf2d67a975882555bbcc0d8af Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 19 Dec 2025 15:12:50 +0100 Subject: [PATCH 15/25] fixed log output --- src/physics/cam/nudging.F90 | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 3d2131c638..043df027e0 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -859,7 +859,7 @@ subroutine nudging_init write(iulog,'(2a)' ) 'NUDGING: Nudge_Datapath = ',trim(Nudge_Datapath) write(iulog,'(2a)' ) 'NUDGING: Nudge_Meshfile = ',trim(Nudge_Meshfile) do nf = 1,maxfiles - if (trim(Nudge_Filenames(nf)) /= ' ') then + if (trim(Nudge_Filenames(nf)) /= 'unset') then write(iulog,'(a,a)' )'NUDGING: Nudge_Filename = ',len_trim(Nudge_Filenames(nf)) end if end do @@ -1164,9 +1164,9 @@ subroutine nudging_timestep_init(phys_state) call chkrc(rc,__LINE__,u_FILE_u) if (masterproc) then - write(iulog,*)'Nudging: sdat%ymdLB, sdat%todLB ',& + write(iulog,'(a,2x,2(i8,2x))')'Nudge Status: sdat%ymdLB, sdat%todLB ',& sdat_nudging_multi%pstrm(1)%ymdLB,sdat_nudging_multi%pstrm(1)%todLB - write(iulog,*)'Nudging: sdat%ymdUB, sdat%todUB ',& + write(iulog,'(a,2x,2(i8,2x))')'Nudge Status: sdat%ymdUB, sdat%todUB ',& sdat_nudging_multi%pstrm(1)%ymdUB,sdat_nudging_multi%pstrm(1)%todUB end if @@ -1573,12 +1573,6 @@ subroutine nudging_stream_init() write(iulog,'(a)' ) ' ' endif - do nfile = 1,size(nudge_filenames) - if (trim(nudge_filenames(nfile)) /= ' ') 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, & From 5c81892fe6f80c2a6a38b6dc930b12722be8bc8f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 19 Dec 2025 19:16:02 +0100 Subject: [PATCH 16/25] fixed standard output --- src/physics/cam/nudging.F90 | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 043df027e0..9cc2399ddf 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -858,12 +858,12 @@ subroutine nudging_init 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,'(2a)' ) 'NUDGING: Nudge_Levname = ',trim(Nudge_Levname) do nf = 1,maxfiles if (trim(Nudge_Filenames(nf)) /= 'unset') then - write(iulog,'(a,a)' )'NUDGING: Nudge_Filename = ',len_trim(Nudge_Filenames(nf)) + write(iulog,'(a,a)')'NUDGING: Nudge_Datapath = ',len_trim(Nudge_Datapath) end if end do - write(iulog,'(2a)' ) 'NUDGING: Nudge_Levname = ',trim(Nudge_Levname) 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 @@ -1164,9 +1164,9 @@ subroutine nudging_timestep_init(phys_state) call chkrc(rc,__LINE__,u_FILE_u) if (masterproc) then - write(iulog,'(a,2x,2(i8,2x))')'Nudge Status: sdat%ymdLB, sdat%todLB ',& + write(iulog,*)'Nudging: sdat%ymdLB, sdat%todLB ',& sdat_nudging_multi%pstrm(1)%ymdLB,sdat_nudging_multi%pstrm(1)%todLB - write(iulog,'(a,2x,2(i8,2x))')'Nudge Status: sdat%ymdUB, sdat%todUB ',& + write(iulog,*)'Nudging: sdat%ymdUB, sdat%todUB ',& sdat_nudging_multi%pstrm(1)%ymdUB,sdat_nudging_multi%pstrm(1)%todUB end if @@ -1547,14 +1547,14 @@ subroutine nudging_stream_init() character(*), parameter :: sub = "('nudging_stream_init')" !---------------------------------------------------------------- - ! Write output log info - + ! Set nudge_year_first, nudge_year_last and nudge_year_align call ESMF_TimeGet(nudge_beg_time, yy=nudge_year_first, rc=rc) call chkrc(rc,__LINE__,u_FILE_u) call ESMF_TimeGet(nudge_end_time, yy=nudge_year_last, rc=rc) call chkrc(rc,__LINE__,u_FILE_u) nudge_year_align = nudge_align_year + ! Write output log info if (masterproc) then write(iulog,'(a)' ) ' ' write(iulog,'(a,i8)') 'stream nudging settings:' @@ -1562,17 +1562,27 @@ subroutine nudging_stream_init() write(iulog,'(a,i8)') ' nudge year first = ',nudge_year_first write(iulog,'(a,i8)') ' nudge year last = ',nudge_year_last write(iulog,'(a,i8)') ' nudge year align = ',nudge_year_align - write(iulog,'(a,a)') ' nudge tintalgo = ',trim(nudge_tintalgo) - write(iulog,'(a,a)' ) ' nudge meshfile = ',trim(nudge_meshfile) - write(iulog,'(a,a)' ) ' nudge datapath = ',trim(nudge_datapath) + write(iulog,'(2a)' ) ' nudge mapalgo = ',trim(nudge_mapalgo) + write(iulog,'(2a)' ) ' nudge tintalgo = ',trim(nudge_tintalgo) + write(iulog,'(2a)' ) ' nudge taxmode = ',trim(nudge_taxmode) + write(iulog,'(2a)' ) ' nudge levname = ',trim(nudge_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,i8,2x,a)' ) ' nudge file = ',nfile,trim(nudge_filenames(nfile)) + write(iulog,'(a,i8,2x,a)' ) ' 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, & From f2d10a2c20b6170e5edd8f28a4d670248878fbd2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 5 Feb 2026 11:55:53 +0100 Subject: [PATCH 17/25] fixed bug in stream_yearAlign for PS --- src/physics/cam/nudging.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 9cc2399ddf..03e5526eee 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -1618,7 +1618,7 @@ subroutine nudging_stream_init() stream_filenames = nudge_filenames, & stream_yearFirst = nudge_year_first, & stream_yearLast = nudge_year_last, & - stream_yearAlign = nudge_year_first, & + stream_yearAlign = nudge_year_align, & stream_fldlistFile = nudge_varlist_singl, & stream_fldListModel = nudge_varlist_singl, & stream_lev_dimname = 'null', & From af7c31187182306a91320cb1ed799663e82711b2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 10 Feb 2026 14:10:45 +0100 Subject: [PATCH 18/25] addressed most of the issues raised in the PR review --- bld/namelist_files/namelist_definition.xml | 6 -- src/cpl/nuopc/atm_comp_nuopc.F90 | 1 - src/physics/cam/nudging.F90 | 85 ++++++++++------------ 3 files changed, 38 insertions(+), 54 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 131d1919f3..4d52456439 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -238,12 +238,6 @@ Default: none - - Name of vertical dimension in file. - Default: none - - Number of time to update model data per day. diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 0b37d927a2..b75e187e45 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -11,7 +11,6 @@ module atm_comp_nuopc use ESMF , only : ESMF_DistGrid, ESMF_DistGridCreate use ESMF , only : ESMF_Mesh, ESMF_MeshCreate, ESMF_MeshGet, ESMF_FILEFORMAT_ESMFMESH use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockGetNextTime, ESMF_ClockAdvance - use ESMF , only : ESMF_CLockCreate use ESMF , only : ESMF_Time, ESMF_TimeGet use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmRingerOff, ESMF_AlarmIsRinging use ESMF , only : ESMF_ClockGetAlarmList, ESMF_ALARMLIST_ALL, ESMF_AlarmSet diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 03e5526eee..1b7674e3b5 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -201,7 +201,9 @@ module nudging !===================================================================== ! Useful modules !------------------ - use ESMF + use ESMF , only : ESMF_Time, ESMF_TimeGet,ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, EMSF_TimeIntervalGet, ESMF_TimeIntervalSet + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_ERROR use shr_kind_mod , only : r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL use time_manager , only : get_curr_date, get_step_size use cam_abortutils , only : endrun, handle_allocate_error @@ -220,7 +222,7 @@ module nudging implicit none private - public :: Nudge_Model + public, protected :: Nudge_Model public :: nudging_readnl public :: nudging_init public :: nudging_timestep_init @@ -329,10 +331,10 @@ module nudging character(len=2) :: nudge_varlist_multi(4) = (/'U ', 'V ','T ','Q '/) character(len=2) :: nudge_varlist_singl(1) = (/'PS'/) - integer :: iunset = -999 + integer, parameter :: iunset = -999 logical :: stream_initialized = .false. - character(*),parameter :: u_FILE_u = __FILE__ + character(len=*),parameter :: u_FILE_u = __FILE__ contains @@ -357,7 +359,7 @@ subroutine nudging_readnl(nlfile) character(len=*), parameter :: subname = 'nudging_readnl: ' - namelist /nudging_nl/ Nudge_Model, Nudge_datapath, Nudge_Filenames, Nudge_Meshfile, & + namelist /nudging_nl/ Nudge_Model, Nudge_Datapath, Nudge_Filenames, Nudge_Meshfile, & Nudge_Force_Opt, Nudge_TimeScale_Opt, & Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & @@ -480,8 +482,6 @@ subroutine nudging_readnl(nlfile) 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_Beg_Sec, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Beg_Sec '//int2str(Nudge_Beg_Sec)) 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)) @@ -489,8 +489,6 @@ subroutine nudging_readnl(nlfile) 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_End_Sec, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_End_Sec '//int2str(Nudge_End_Sec)) call MPI_bcast(Nudge_Align_Year, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Align_Year '//int2str(Nudge_Align_Year)) @@ -500,15 +498,10 @@ subroutine nudging_readnl(nlfile) call MPI_bcast(Nudge_Taxmode, len(Nudge_Taxmode), mpi_character, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Taxmode '//trim(Nudge_TaxMode)) - call MPI_bcast(Nudge_Initialized, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Initialized') - 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_TSmode, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_TSmode '//int2str(Nudge_TSmode)) call MPI_bcast(Nudge_Ucoef, 1, mpi_real8, masterprocid, mpicom, ierr) if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Ucoef') @@ -720,7 +713,7 @@ subroutine nudging_init 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_PStau',size2d) + call alloc_err(istat,subname,'Nudge_PStau0',size2d) allocate(Nudge_Ustep(pcols,pver,begchunk:endchunk),stat=istat) call alloc_err(istat,subname,'Nudge_Ustep',size3d) @@ -804,9 +797,10 @@ subroutine nudging_init ! Nudging will never occur, so switch it off Nudge_Model = .false. write(iulog,*) ' ' - write(iulog,*) 'NUDGING: WARNING - Nudging has been requested by it will' + 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 @@ -861,7 +855,7 @@ subroutine nudging_init write(iulog,'(2a)' ) 'NUDGING: Nudge_Levname = ',trim(Nudge_Levname) do nf = 1,maxfiles if (trim(Nudge_Filenames(nf)) /= 'unset') then - write(iulog,'(a,a)')'NUDGING: Nudge_Datapath = ',len_trim(Nudge_Datapath) + write(iulog,'(a,a)')'NUDGING: Nudge_Datapath = ',trim(Nudge_Datapath) end if end do write(iulog,'(a,i8)' ) 'NUDGING: Nudge_Beg_Year = ',Nudge_Beg_Year @@ -970,7 +964,6 @@ subroutine nudging_timestep_init(phys_state) use physics_types,only: physics_state use constituents ,only: cnst_get_ind use ppgrid ,only: pver,pcols,begchunk,endchunk - use phys_grid ,only: get_ncols_p use cam_history ,only: outfld use shr_cal_mod ,only: shr_cal_timeSet @@ -982,17 +975,15 @@ subroutine nudging_timestep_init(phys_state) !---------------- integer :: Year, Month, Day, Sec logical :: Update_Model, Sync_Error - logical :: Update_Nudge logical :: After_Beg, Before_End - integer :: lchnk,ncol,icol,indw - type(ESMF_Time) :: model_curr_time + integer :: lchnk,ncol,indw type(ESMF_Time) :: curr_time - type(ESMF_TimeInterval) :: date_diff 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) @@ -1016,7 +1007,6 @@ subroutine nudging_timestep_init(phys_state) integer :: DeltaT real(r8) :: Tscale integer :: rc - logical :: first_call = .true. character(len=*), parameter :: sub = "(nudging_timestep_init) " !-------------------------------------------------------------- @@ -1175,7 +1165,7 @@ subroutine nudging_timestep_init(phys_state) if(Nudge_TimeScale_Opt == 0) then Tscale=1._r8 elseif (Nudge_TimeScale_Opt == 1) then - Tscale = float(Nudge_File_Step)/float(DeltaT) + Tscale = real(Nudge_File_Step,r8)/real(DeltaT, r8) else if (masterproc) then write(iulog,*) 'NUDGING: Unknown Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt @@ -1188,11 +1178,12 @@ subroutine nudging_timestep_init(phys_state) do lchnk=begchunk,endchunk ncol = phys_state(lchnk)%ncol - Nudge_Utau(:ncol,:pver,lchnk) = Nudge_Utau0(:ncol,:pver,lchnk) * Nudge_Ucoef/float(Nudge_File_Step) - Nudge_Vtau(:ncol,:pver,lchnk) = Nudge_Vtau0(:ncol,:pver,lchnk) * Nudge_Vcoef/float(Nudge_File_Step) - Nudge_Stau(:ncol,:pver,lchnk) = Nudge_Stau0(:ncol,:pver,lchnk) * Nudge_Tcoef/float(Nudge_File_Step) - Nudge_Qtau(:ncol,:pver,lchnk) = Nudge_Qtau0(:ncol,:pver,lchnk) * Nudge_Qcoef/float(Nudge_File_Step) - Nudge_PStau(:ncol,lchnk) = Nudge_PStau0(:ncol,lchnk) * Nudge_PScoef/float(Nudge_File_Step) + 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) @@ -1268,7 +1259,7 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) 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( 'Nudge_Q',phys_tend%q(:,:,indw),pcols,lchnk) end if ! End Routine @@ -1289,9 +1280,10 @@ subroutine nudging_set_profile(rlat, rlon, Nudge_prof, Wprof, nlev) ! 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 variables !---------------- @@ -1417,8 +1409,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 !---------------- @@ -1557,8 +1549,8 @@ subroutine nudging_stream_init() ! Write output log info if (masterproc) then write(iulog,'(a)' ) ' ' - write(iulog,'(a,i8)') 'stream nudging settings:' - write(iulog,'(a,a,a)') ' nudge varlist = ','U,V,T,Q,PS' + write(iulog,'(a)' ) 'stream nudging settings:' + write(iulog,'(2a)' ) ' nudge varlist = ','U,V,T,Q,PS' write(iulog,'(a,i8)') ' nudge year first = ',nudge_year_first write(iulog,'(a,i8)') ' nudge year last = ',nudge_year_last write(iulog,'(a,i8)') ' nudge year align = ',nudge_year_align @@ -1570,7 +1562,7 @@ subroutine nudging_stream_init() write(iulog,'(2a)' ) ' nudge datapath = ',trim(nudge_datapath) do nfile = 1,size(nudge_filenames) if (trim(nudge_filenames(nfile)) /= 'unset') then - write(iulog,'(a,i8,2x,a)' ) ' nudge files = ',nfile,trim(nudge_filenames(nfile)) + write(iulog,'(a,i0,2a)' ) ' nudge files(, ',nfile,') = ',trim(nudge_filenames(nfile) end if end do write(iulog,'(a)' ) ' ' @@ -1656,13 +1648,12 @@ subroutine nudging_stream_interp(Target_U, Target_V, Target_T, Target_Q, Target_ ! Local variables integer :: rc ! ESMF error return - integer :: istat ! allocate 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 :: g ! counter 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 @@ -1705,12 +1696,12 @@ subroutine nudging_stream_interp(Target_U, Target_V, Target_T, Target_Q, Target_ ! Obtain TMP3d do klev = 1, pver - g = 1 + gidx = 1 do lchnk = begchunk,endchunk ncol = get_ncols_p(lchnk) do icol = 1,ncol - Tmp3d(icol,klev,lchnk) = dataptr2d(klev,g) - g = g + 1 + Tmp3d(icol,klev,lchnk) = dataptr2d(klev,gidx) + gidx = gidx + 1 end do end do end do @@ -1751,12 +1742,12 @@ subroutine nudging_stream_interp(Target_U, Target_V, Target_T, Target_Q, Target_ call dshr_fldbun_getFldPtr(sdat_nudging_singl%pstrm(1)%fldbun_model, 'PS', fldptr1=dataptr1d, rc=rc) call chkrc(rc,__LINE__,u_FILE_u) - g = 1 + gidx = 1 do lchnk = begchunk,endchunk ncol = get_ncols_p(lchnk) do icol = 1,ncol - Tmp2d(icol,lchnk) = dataptr1d(g) - g = g + 1 + Tmp2d(icol,lchnk) = dataptr1d(gidx) + gidx = gidx + 1 end do end do @@ -1837,7 +1828,7 @@ subroutine chkrc(rc, line, file) if ( rc /= ESMF_SUCCESS ) then call ESMF_LogWrite('ERROR:', ESMF_LOGMSG_ERROR, line=line, file=file) - call endrun('chkrc') + call endrun('chkrc: see ESMF log file(s)') end if end subroutine chkrc From e07c38e8f0fa6dd0aa8c5d1868c10e959b97d22f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 12 Feb 2026 11:20:20 +0100 Subject: [PATCH 19/25] added new namelists Nudge_Data_Year_First, Nudge_Data_Year_Last and Nudge_Data_Year_Align --- bld/namelist_files/namelist_definition.xml | 60 ++++--- src/physics/cam/nudging.F90 | 192 ++++++++++----------- 2 files changed, 131 insertions(+), 121 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 4d52456439..d1535998b5 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -238,6 +238,42 @@ 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_Data_Year_First. + 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. @@ -281,12 +317,6 @@ Default: none - - Model year to align with Nudge_Beg_Year. - Default: none - - Select the form of nudging forcing, where (t'==Analysis times ; t==Model Times) @@ -304,24 +334,6 @@ Default: 0 - - 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: bilinear - - Profile index for U nudging. diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 1b7674e3b5..bc82989e3f 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -202,8 +202,9 @@ module nudging ! Useful modules !------------------ use ESMF , only : ESMF_Time, ESMF_TimeGet,ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, EMSF_TimeIntervalGet, ESMF_TimeIntervalSet + 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 time_manager , only : get_curr_date, get_step_size use cam_abortutils , only : endrun, handle_allocate_error @@ -222,7 +223,10 @@ module nudging implicit none private - public, protected :: Nudge_Model + ! public variables + logical, public, protected :: Nudge_Model =.false. + logical, public, protected :: Nudge_On = .false. + public :: nudging_readnl public :: nudging_init public :: nudging_timestep_init @@ -236,34 +240,32 @@ module nudging private :: nudging_stream_interp ! interpolates between two years of nudging file data private :: chkrc - logical, public, protected :: Nudge_On = .false. - ! Nudging Parameters !-------------------- integer, parameter :: maxfiles = 100 - logical :: Nudge_Model =.false. logical :: Nudge_Initialized =.false. character(len=cl) :: Nudge_Meshfile character(len=cl) :: Nudge_Filenames(maxfiles) character(len=cl) :: Nudge_Datapath - - integer :: Nudge_Beg_year - integer :: Nudge_Beg_month - integer :: Nudge_Beg_day - integer :: Nudge_Beg_sec - type(ESMF_Time) :: Nudge_Beg_time - - integer :: Nudge_End_year - integer :: Nudge_End_month - integer :: Nudge_End_day - integer :: Nudge_End_sec - type(ESMF_Time) :: Nudge_End_time - - integer :: Nudge_Align_year - character(len=cs) :: Nudge_mapalgo ! [bilinear, consf, nn] - character(len=cs) :: Nudge_tintalgo ! [linear, upper] - character(len=cs) :: Nudge_taxmode ! [limit, extend] - character(len=cs) :: Nudge_levname + integer :: Nudge_Data_Year_First ! namelist - relative to nudging data dates + integer :: Nudge_Data_Year_Last ! namelist - relative to nudging data dates + integer :: Nudge_Data_Year_Align ! namelist - align year for nudging + character(len=cs) :: Nudge_Data_mapalgo ! namelist - [bilinear, consf, nn] + character(len=cs) :: Nudge_Data_tintalgo ! namelist - [linear, upper] + character(len=cs) :: Nudge_Data_taxmode ! namelist - [limit, extend] + character(len=cs) :: Nudge_Data_levname ! namelist + + integer :: Nudge_Beg_year ! namelist (model time) + integer :: Nudge_Beg_month ! namelist (model time) + integer :: Nudge_Beg_day ! namelist (model time) + integer :: Nudge_Beg_sec ! hard-wired to 0 + type(ESMF_Time) :: Nudge_Beg_time ! derived + + integer :: Nudge_End_year ! namelist (model time) + integer :: Nudge_End_month ! namelist (model time) + integer :: Nudge_End_day ! namelist (model time) + integer :: Nudge_End_sec ! hard-wired to 0 + type(ESMF_Time) :: Nudge_End_time ! derived integer :: Model_Update_Times_Per_Day type(ESMF_TimeInterval) :: Model_Update_Interval @@ -360,23 +362,23 @@ subroutine nudging_readnl(nlfile) character(len=*), parameter :: subname = 'nudging_readnl: ' namelist /nudging_nl/ Nudge_Model, Nudge_Datapath, Nudge_Filenames, Nudge_Meshfile, & - Nudge_Force_Opt, Nudge_TimeScale_Opt, & - Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & - Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & - Nudge_Align_Year, Nudge_Mapalgo, Nudge_Taxmode, & - Nudge_Levname, & - 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_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 @@ -398,6 +400,12 @@ subroutine nudging_readnl(nlfile) Nudge_Datapath = 'unset' Nudge_Filenames(:) = 'unset' Nudge_Meshfile = 'unset' + Nudge_Data_Year_Align = iunset + Nudge_Data_Year_First = iunset + Nudge_Data_Year_Last = iunset + Nudge_Data_Mapalgo = 'bilinear' + Nudge_Data_taxmode = 'limit' + Nudge_Data_levname = 'lev' Nudge_Beg_Year = iunset Nudge_Beg_Month = iunset @@ -405,11 +413,6 @@ subroutine nudging_readnl(nlfile) Nudge_End_Year = iunset Nudge_End_Month = iunset Nudge_End_Day = iunset - Nudge_Align_Year = iunset - - Nudge_Mapalgo = 'bilinear' - Nudge_taxmode = 'limit' - Nudge_levname = 'lev' Nudge_Force_Opt = 0 Nudge_TimeScale_Opt = 0 @@ -468,9 +471,18 @@ subroutine nudging_readnl(nlfile) 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_Levname, len(Nudge_Taxmode), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Taxmode '//trim(Nudge_Taxmode)) + 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 '//& @@ -490,14 +502,6 @@ subroutine nudging_readnl(nlfile) 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_Align_Year, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Align_Year '//int2str(Nudge_Align_Year)) - - call MPI_bcast(Nudge_Mapalgo, len(Nudge_Mapalgo), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Mapalgo '//trim(Nudge_Mapalgo)) - call MPI_bcast(Nudge_Taxmode, len(Nudge_Taxmode), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= mpi_success) call endrun(subname//'FATAL: mpi_bcast: Nudge_Taxmode '//trim(Nudge_TaxMode)) - 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) @@ -593,15 +597,15 @@ subroutine nudging_readnl(nlfile) end if ! Determine nudge_align_year if not set - if (Nudge_align_year == iunset) then - Nudge_align_year = Nudge_Beg_year + if (Nudge_Data_Year_Align == iunset) then + Nudge_Data_Year_Align = Nudge_Beg_year end if - ! Determine Nudge_tintalgo + ! Determine Nudge_Data_tintalgo if (Nudge_Force_Opt == 0) then - Nudge_tintalgo = 'upper' + Nudge_Data_tintalgo = 'upper' elseif(Nudge_Force_Opt == 1) then - Nudge_tintalgo = 'linear' + Nudge_Data_tintalgo = 'linear' else call endrun('nudging_timestep_init:: ERROR unknown Nudge_Force_Opt '//int2str(Nudge_Force_Opt)) endif @@ -852,24 +856,28 @@ subroutine nudging_init 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,'(2a)' ) 'NUDGING: Nudge_Levname = ',trim(Nudge_Levname) + 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: Nudge_Align_Year = ',Nudge_Align_Year - write(iulog,'(2a)' ) 'NUDGING: Nudge_Mapalgo = ',trim(Nudge_Mapalgo) - write(iulog,'(2a)' ) 'NUDGING: Nudge_Tintalgo = ',trim(Nudge_Tintalgo) - write(iulog,'(2a)' ) 'NUDGING: Nudge_Taxmode = ',trim(Nudge_Taxmode) 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 @@ -1533,36 +1541,26 @@ subroutine nudging_stream_init() ! local variables integer :: rc integer :: nfile - integer :: nudge_year_first - integer :: nudge_year_last - integer :: nudge_year_align character(*), parameter :: sub = "('nudging_stream_init')" !---------------------------------------------------------------- - ! Set nudge_year_first, nudge_year_last and nudge_year_align - call ESMF_TimeGet(nudge_beg_time, yy=nudge_year_first, rc=rc) - call chkrc(rc,__LINE__,u_FILE_u) - call ESMF_TimeGet(nudge_end_time, yy=nudge_year_last, rc=rc) - call chkrc(rc,__LINE__,u_FILE_u) - nudge_year_align = nudge_align_year - ! 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_year_first - write(iulog,'(a,i8)') ' nudge year last = ',nudge_year_last - write(iulog,'(a,i8)') ' nudge year align = ',nudge_year_align - write(iulog,'(2a)' ) ' nudge mapalgo = ',trim(nudge_mapalgo) - write(iulog,'(2a)' ) ' nudge tintalgo = ',trim(nudge_tintalgo) - write(iulog,'(2a)' ) ' nudge taxmode = ',trim(nudge_taxmode) - write(iulog,'(2a)' ) ' nudge levname = ',trim(nudge_levname) + 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) + write(iulog,'(a,i0,2a)' ) ' nudge files(, ',nfile,') = ',trim(nudge_filenames(nfile)) end if end do write(iulog,'(a)' ) ' ' @@ -1585,17 +1583,17 @@ subroutine nudging_stream_init() model_mesh = model_mesh, & stream_meshfile = trim(nudge_meshfile), & stream_filenames = nudge_filenames, & - stream_yearFirst = nudge_year_first, & - stream_yearLast = nudge_year_last, & - stream_yearAlign = nudge_year_align, & + 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_levname), & - stream_mapalgo = trim(nudge_mapalgo), & + stream_lev_dimname = trim(nudge_data_levname), & + stream_mapalgo = trim(nudge_data_mapalgo), & stream_offset = 0, & - stream_taxmode = trim(nudge_taxmode), & + stream_taxmode = trim(nudge_data_taxmode), & stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = nudge_tintalgo, & + stream_tintalgo = nudge_data_tintalgo, & stream_name = 'NUDGING forcing data ', & rc = rc) call chkrc(rc,__LINE__,u_FILE_u) @@ -1608,17 +1606,17 @@ subroutine nudging_stream_init() model_mesh = model_mesh, & stream_meshfile = trim(nudge_meshfile), & stream_filenames = nudge_filenames, & - stream_yearFirst = nudge_year_first, & - stream_yearLast = nudge_year_last, & - stream_yearAlign = nudge_year_align, & + 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_mapalgo), & + stream_mapalgo = trim(nudge_data_mapalgo), & stream_offset = 0, & - stream_taxmode = trim(nudge_taxmode), & + stream_taxmode = trim(nudge_data_taxmode), & stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = nudge_tintalgo, & + stream_tintalgo = nudge_data_tintalgo, & stream_name = 'NUDGING forcing data ', & rc = rc) call chkrc(rc,__LINE__,u_FILE_u) From 4647c0ecf3735e3b515a24cd8f21941e98a6000a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 12 Feb 2026 13:01:34 +0100 Subject: [PATCH 20/25] cleaner initialization of namelist defaults and more comments --- bld/namelist_files/namelist_definition.xml | 7 +- src/physics/cam/nudging.F90 | 258 ++++++++------------- 2 files changed, 98 insertions(+), 167 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index d1535998b5..a491a03b06 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -252,7 +252,12 @@ - Model year to align with Nudge_Data_Year_First. + 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 diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index bc82989e3f..4db6f8f334 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -121,15 +121,17 @@ module nudging ! 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_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_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_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_Align_Year - INT simulation year corresponding to NUDGE_BEG_YEAR. +! 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 @@ -141,17 +143,17 @@ module nudging ! 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 ! -! Nudge_Force_Opt - INT Index to select the nudging Target for a relaxation forcing of the form: +! Nudge_Force_Opt - INT Index to select the nudging Target for a relaxation forcing of the form: ! where (t'==Analysis times ; t==Model Times) -! ! 0 -> NEXT-OBS: Target=Anal(t'_next) [DEFAULT] ! 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] ! 1 --> TimeScale = 1/(t'_next - t_curr ) ! @@ -160,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) @@ -171,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]. ! @@ -206,6 +206,7 @@ module nudging 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 @@ -223,10 +224,6 @@ module nudging implicit none private - ! public variables - logical, public, protected :: Nudge_Model =.false. - logical, public, protected :: Nudge_On = .false. - public :: nudging_readnl public :: nudging_init public :: nudging_timestep_init @@ -242,76 +239,86 @@ module nudging ! Nudging Parameters !-------------------- + integer, parameter :: iunset = -999 + ! + logical, public, protected :: Nudge_Model =.false. + logical, public, protected :: Nudge_On = .false. + logical :: Nudge_Initialized = .false. + ! integer, parameter :: maxfiles = 100 - logical :: Nudge_Initialized =.false. - character(len=cl) :: Nudge_Meshfile - character(len=cl) :: Nudge_Filenames(maxfiles) - character(len=cl) :: Nudge_Datapath - integer :: Nudge_Data_Year_First ! namelist - relative to nudging data dates - integer :: Nudge_Data_Year_Last ! namelist - relative to nudging data dates - integer :: Nudge_Data_Year_Align ! namelist - align year for nudging - character(len=cs) :: Nudge_Data_mapalgo ! namelist - [bilinear, consf, nn] - character(len=cs) :: Nudge_Data_tintalgo ! namelist - [linear, upper] - character(len=cs) :: Nudge_Data_taxmode ! namelist - [limit, extend] - character(len=cs) :: Nudge_Data_levname ! namelist - - integer :: Nudge_Beg_year ! namelist (model time) - integer :: Nudge_Beg_month ! namelist (model time) - integer :: Nudge_Beg_day ! namelist (model time) - integer :: Nudge_Beg_sec ! hard-wired to 0 - type(ESMF_Time) :: Nudge_Beg_time ! derived - - integer :: Nudge_End_year ! namelist (model time) - integer :: Nudge_End_month ! namelist (model time) - integer :: Nudge_End_day ! namelist (model time) - integer :: Nudge_End_sec ! hard-wired to 0 - type(ESMF_Time) :: Nudge_End_time ! derived - - integer :: Model_Update_Times_Per_Day - type(ESMF_TimeInterval) :: Model_Update_Interval - type(ESMF_Time) :: Model_Update_Next_Time - - integer :: Nudge_Force_Opt - integer :: Nudge_TimeScale_Opt - integer :: Nudge_TSmode - - 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 - - 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 + 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 !----------------------- @@ -333,7 +340,6 @@ module nudging character(len=2) :: nudge_varlist_multi(4) = (/'U ', 'V ','T ','Q '/) character(len=2) :: nudge_varlist_singl(1) = (/'PS'/) - integer, parameter :: iunset = -999 logical :: stream_initialized = .false. character(len=*),parameter :: u_FILE_u = __FILE__ @@ -343,11 +349,8 @@ module nudging !================================================================ 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 ! ! Arguments @@ -385,67 +388,6 @@ subroutine nudging_readnl(nlfile) 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_End_Sec = 0 - Nudge_Beg_Sec = 0 - - ! Set Default Namelist values - !----------------------------- - Nudge_Model = .false. - Model_Update_Times_Per_Day = 4 - - Nudge_Datapath = 'unset' - Nudge_Filenames(:) = 'unset' - Nudge_Meshfile = 'unset' - Nudge_Data_Year_Align = iunset - Nudge_Data_Year_First = iunset - Nudge_Data_Year_Last = iunset - Nudge_Data_Mapalgo = 'bilinear' - Nudge_Data_taxmode = 'limit' - Nudge_Data_levname = 'lev' - - Nudge_Beg_Year = iunset - Nudge_Beg_Month = iunset - Nudge_Beg_Day = iunset - Nudge_End_Year = iunset - Nudge_End_Month = iunset - Nudge_End_Day = iunset - - Nudge_Force_Opt = 0 - Nudge_TimeScale_Opt = 0 - Nudge_TSmode = 0 - - 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_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_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 !------------------------ if(masterproc) then @@ -662,9 +604,6 @@ subroutine nudging_readnl(nlfile) end if check_valid - ! End Routine - !------------ - end subroutine nudging_readnl !================================================================ @@ -952,9 +891,6 @@ subroutine nudging_init end do end do - ! End Routine - !------------ - end subroutine nudging_init !================================================================ @@ -1219,9 +1155,6 @@ subroutine nudging_timestep_init(phys_state) endif ! (Update_Model) - ! End Routine - !------------ - end subroutine nudging_timestep_init !================================================================ @@ -1270,9 +1203,6 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) call outfld( 'Nudge_Q',phys_tend%q(:,:,indw),pcols,lchnk) end if - ! End Routine - !------------ - end subroutine nudging_timestep_tend !================================================================ @@ -1377,12 +1307,10 @@ subroutine nudging_set_profile(rlat, rlon, Nudge_prof, Wprof, nlev) call endrun('nudging_set_profile:: Unknown Nudge_prof value') endif - ! End Routine - !------------ - end subroutine nudging_set_profile !================================================================ + !================================================================ subroutine nudging_final @@ -1406,6 +1334,7 @@ subroutine nudging_final end subroutine nudging_final !================================================================ + !================================================================ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) ! @@ -1526,9 +1455,6 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) end do ! kk=pver,1,-1 - ! End Routine - !----------- - end subroutine calc_DryStaticEnergy !================================================================ From 319c38dda3ac063c34abae2733b44688042de6ee Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 14 Feb 2026 22:07:42 +0100 Subject: [PATCH 21/25] update explanations for nudging data --- bld/namelist_files/namelist_definition.xml | 21 +++++++---------- src/physics/cam/nudging.F90 | 26 +++++++++------------- 2 files changed, 18 insertions(+), 29 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index a491a03b06..8b40366d5c 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -240,24 +240,19 @@ - First nudging year of data to use (nudging calendar) + First year of nudging data to use. Default: none - Last nudging year of data to use (nudging calendar) + Last year of nudging data to use. 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 @@ -288,37 +283,37 @@ - Year at which Nudging Begins. + Model year at which nudging begins. Default: none - Month at which Nudging Begins. + Model month at which nudging begins. Default: none - Day at which Nudging Begins. + Model day at which nudging begins. Default: none - Year at which Nudging Ends. + Model year at which nudging ends. Default: none - Month at which Nudging Ends. + Model month at which nudging ends. Default: none - Day at which Nudging Ends. + Model day at which nudging ends. Default: none diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 4db6f8f334..9f269b35dd 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -129,22 +129,12 @@ module nudging ! 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 +! 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 model (simulation) year to align with Nudge_Data_Year_First. +! If Nudge_Data_Year_Align 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 ! ! Nudge_Force_Opt - INT Index to select the nudging Target for a relaxation forcing of the form: ! where (t'==Analysis times ; t==Model Times) @@ -1692,6 +1682,10 @@ end subroutine nudging_stream_interp !================================================================ subroutine get_calendar(sdat, model_year, model_month, model_day, calendar) + ! Determine calendar to use for nudging (used in calling shr_cal_timeSet) + ! The model calendar is determined based on the model ESMF clock + ! The stream calendar is determined from the input stream data 'time' calendar attribute + use shr_cal_mod, only : shr_cal_noleap, shr_cal_gregorian use shr_cal_mod, only : shr_cal_date2ymd, shr_cal_leapyear From 5bad1a174bf19631b5f837c94f8e723e9c8a1718 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 7 Mar 2026 11:24:42 +0100 Subject: [PATCH 22/25] addressed more issues raised in PR review --- src/physics/cam/nudging.F90 | 211 ++++++++++++++++++------------------ 1 file changed, 107 insertions(+), 104 deletions(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 9f269b35dd..4d84d7ea82 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -236,7 +236,7 @@ module nudging logical :: Nudge_Initialized = .false. ! integer, parameter :: maxfiles = 100 - character(len=cl) :: Nudge_Datapath = 'unset' ! derived + character(len=cl) :: Nudge_Datapath = 'unset' ! namelist character(len=cl) :: Nudge_Meshfile = 'unset' ! namelist character(len=cl) :: Nudge_Filenames(maxfiles) = 'unset' ! namelist integer :: Nudge_Data_Year_First = iunset ! namelist @@ -544,16 +544,16 @@ subroutine nudging_readnl(nlfile) 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 + write(iulog,'(2a)') subname,'NUDGING: Window lat0 must be in [-90,+90]' + write(iulog,'(2a,d13.5)') subname,'NUDGING: Nudge_Hwin_lat0=',Nudge_Hwin_lat0 end if call endrun(trim(subname)//' ERROR Window lat0 must be in [-90,+90]') endif 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 + write(iulog,'(2a)') subname,'NUDGING: Window lon0 must be in [0,+360)' + write(iulog,'(2a,d13.5)') subname,'NUDGING: Nudge_Hwin_lon0=',Nudge_Hwin_lon0 end if call endrun(trim(subname)//' ERROR Windlow lon0 must be in [0,+360)') endif @@ -562,11 +562,11 @@ subroutine nudging_readnl(nlfile) (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 + write(iulog,'(2a)') subname,'NUDGING: Window Lindex must be in [0,pver+1]' + write(iulog,'(2a)') subname,'NUDGING: Window Hindex must be in [0,pver+1]' + write(iulog,'(2a)') subname,'NUDGING: Lindex must be LE than Hindex' + write(iulog,'(2a,d13.5 )') subname,'NUDGING: Nudge_Vwin_Lindex=',Nudge_Vwin_Lindex + write(iulog,'(2a,d13.5 )') subname,'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 @@ -574,20 +574,20 @@ subroutine nudging_readnl(nlfile) 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 + write(iulog,'(2a)') subname,'NUDGING: Window Deltas must be positive' + write(iulog,'(2a,d13.5)') subname,'NUDGING: Nudge_Hwin_latDelta=',Nudge_Hwin_latDelta + write(iulog,'(2a,d13.5)') subname,'NUDGING: Nudge_Hwin_lonDelta=',Nudge_Hwin_lonDelta + write(iulog,'(2a,d13.5)') subname,'NUDGING: Nudge_Vwin_Hdelta =',Nudge_Vwin_Hdelta + write(iulog,'(2a,d13.5)') subname,'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 + write(iulog,'(2a)') subname,'NUDGING: Window widths must be positive' + write(iulog,'(2a,d13.5)') subname,'NUDGING: Nudge_Hwin_latWidth=',Nudge_Hwin_latWidth + write(iulog,'(2a,d13.5)') subname,'NUDGING: Nudge_Hwin_lonWidth=',Nudge_Hwin_lonWidth end if call endrun(trim(subname)//' ERROR Window widths must be positive') endif @@ -638,13 +638,13 @@ subroutine nudging_init size2d = pcols*((endchunk-begchunk)+1) allocate(Nudge_Utau0(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,subname,'Nudge_Utau',size3d) + call alloc_err(istat,subname,'Nudge_Utau0',size3d) allocate(Nudge_Vtau0(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,subname,'Nudge_Vtau',size3d) + call alloc_err(istat,subname,'Nudge_Vtau0',size3d) allocate(Nudge_Stau0(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,subname,'Nudge_Stau',size3d) + call alloc_err(istat,subname,'Nudge_Stau0',size3d) allocate(Nudge_Qtau0(pcols,pver,begchunk:endchunk),stat=istat) - call alloc_err(istat,subname,'Nudge_Qtau',size3d) + call alloc_err(istat,subname,'Nudge_Qtau0',size3d) allocate(Nudge_PStau0(pcols,begchunk:endchunk),stat=istat) call alloc_err(istat,subname,'Nudge_PStau0',size2d) @@ -782,67 +782,67 @@ subroutine nudging_init write(iulog,*) '---------------------------------------------------------' write(iulog,*) ' MODEL NUDGING INITIALIZED WITH THE FOLLOWING SETTINGS: ' write(iulog,*) '---------------------------------------------------------' - 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) + write(iulog,'(2a,l4)') subname,'NUDGING: Nudge_Model = ',Nudge_Model + write(iulog,'(3a)' ) subname,'NUDGING: Nudge_Datapath = ',trim(Nudge_Datapath) + write(iulog,'(3a)' ) subname,'NUDGING: Nudge_Meshfile = ',trim(Nudge_Meshfile) + write(iulog,'(2a,i8)') subname,'NUDGING: Nudge_Data_Year_First = ',Nudge_Data_Year_First + write(iulog,'(2a,i8)') subname,'NUDGING: Nudge_Data_Year_Last = ',Nudge_Data_Year_Last + write(iulog,'(2a,i8)') subname,'NUDGING: Nudge_Data_Year_Align = ',Nudge_Data_Year_Align + write(iulog,'(3a)' ) subname,'NUDGING: Nudge_Data_Mapalgo = ',trim(Nudge_Data_Mapalgo) + write(iulog,'(3a)' ) subname,'NUDGING: Nudge_Data_Tintalgo = ',trim(Nudge_Data_Tintalgo) + write(iulog,'(3a)' ) subname,'NUDGING: Nudge_Data_Taxmode = ',trim(Nudge_Data_Taxmode) + write(iulog,'(3a)' ) subname,'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) + write(iulog,'(3a)') subname,'NUDGING: Nudge_Filename = ',trim(Nudge_Filenames(nf)) 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,'(2a,i8)' ) subname,'NUDGING: Nudge_Beg_Year = ',Nudge_Beg_Year + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_Beg_Month = ',Nudge_Beg_Month + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_Beg_Day = ',Nudge_Beg_Day + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_End_Year = ',Nudge_End_Year + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_End_Month = ',Nudge_End_Month + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_End_Day = ',Nudge_End_Day + write(iulog,'(2a,i8)' ) subname,'NUDGING: Model_Update_Times_Per_Day = ',Model_Update_Times_Per_Day + write(iulog,'(2a,i8)' ) subname,'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,'(2a,i8)' ) subname,'NUDGING: Nudge_PSprof = ',Nudge_PSprof + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_Force_Opt = ',Nudge_Force_Opt + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_TimeScale_Opt = ',Nudge_TimeScale_Opt + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_TSmode = ',Nudge_TSmode + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_ZonalFilter = ',Nudge_ZonalFilter + write(iulog,'(2a,i8)' ) subname,'NUDGING: Nudge_ZonalNbasis = ',Nudge_ZonalNbasis + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Ucoef = ',Nudge_Ucoef + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Vcoef = ',Nudge_Vcoef + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Qcoef = ',Nudge_Qcoef + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Tcoef = ',Nudge_Tcoef + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_PScoef = ',Nudge_PScoef + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Uprof = ',Nudge_Uprof + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Vprof = ',Nudge_Vprof + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Qprof = ',Nudge_Qprof + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Tprof = ',Nudge_Tprof + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_lat0 = ',Nudge_Hwin_lat0 + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_latWidth = ',Nudge_Hwin_latWidth + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_latDelta = ',Nudge_Hwin_latDelta + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_lon0 = ',Nudge_Hwin_lon0 + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_lonWidth = ',Nudge_Hwin_lonWidth + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_lonDelta = ',Nudge_Hwin_lonDelta + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_Invert = ',Nudge_Hwin_Invert + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_lo = ',Nudge_Hwin_lo + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_hi = ',Nudge_Hwin_hi + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Vwin_Hindex = ',Nudge_Vwin_Hindex + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Vwin_Hdelta = ',Nudge_Vwin_Hdelta + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Vwin_Lindex = ',Nudge_Vwin_Lindex + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Vwin_Ldelta = ',Nudge_Vwin_Ldelta + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Vwin_Invert = ',Nudge_Vwin_Invert + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Vwin_lo = ',Nudge_Vwin_lo + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Vwin_hi = ',Nudge_Vwin_hi + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_latWidthH = ',Nudge_Hwin_latWidthH + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_lonWidthH = ',Nudge_Hwin_lonWidthH + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_max = ',Nudge_Hwin_max + write(iulog,'(2a,f13.5)' ) subname,'NUDGING: Nudge_Hwin_min = ',Nudge_Hwin_min + write(iulog,'(2a,l4)' ) subname,'NUDGING: Nudge_Initialized = ',Nudge_Initialized write(iulog,*) ' ' endif ! (masterproc) then @@ -941,7 +941,7 @@ subroutine nudging_timestep_init(phys_state) integer :: DeltaT real(r8) :: Tscale integer :: rc - character(len=*), parameter :: sub = "(nudging_timestep_init) " + character(len=*), parameter :: subname = "(nudging_timestep_init) " !-------------------------------------------------------------- ! Check if Nudging is initialized @@ -969,7 +969,7 @@ subroutine nudging_timestep_init(phys_state) 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 = ',& + write(iulog,'(2a,4(i6,2x),l8)') subname,' Nudge Status: year, month, day, sec, update_model = ',& year, month, day, sec, update_model end if @@ -1088,9 +1088,9 @@ subroutine nudging_timestep_init(phys_state) call chkrc(rc,__LINE__,u_FILE_u) if (masterproc) then - write(iulog,*)'Nudging: sdat%ymdLB, sdat%todLB ',& + write(iulog,'(2a,2x,i0)') subname,'Nudging: sdat%ymdLB, sdat%todLB ',& sdat_nudging_multi%pstrm(1)%ymdLB,sdat_nudging_multi%pstrm(1)%todLB - write(iulog,*)'Nudging: sdat%ymdUB, sdat%todUB ',& + write(iulog,'(2a,2x,i0)') subname,'Nudging: sdat%ymdUB, sdat%todUB ',& sdat_nudging_multi%pstrm(1)%ymdUB,sdat_nudging_multi%pstrm(1)%todUB end if @@ -1102,7 +1102,7 @@ subroutine nudging_timestep_init(phys_state) Tscale = real(Nudge_File_Step,r8)/real(DeltaT, r8) else if (masterproc) then - write(iulog,*) 'NUDGING: Unknown Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt + write(iulog,'(2a,2x,i0)') subname,'NUDGING: Unknown Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt end if call endrun('nudging_timestep_init:: ERROR unknown Nudging_TimeScale_Opt') endif @@ -1140,7 +1140,7 @@ subroutine nudging_timestep_init(phys_state) 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' + write(iulog,'(2a)') subname,'NUDGING: WARNING - Model_Update_Time Sync ERROR... CORRECTED' endif endif ! (Update_Model) @@ -1457,26 +1457,26 @@ subroutine nudging_stream_init() ! local variables integer :: rc integer :: nfile - character(*), parameter :: sub = "('nudging_stream_init')" + character(len=*), parameter :: subname = "('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) + write(iulog,'(a)' ) ' ' + write(iulog,'(2a)' ) subname,'stream nudging settings:' + write(iulog,'(3a)' ) subname,' nudge varlist = ','U,V,T,Q,PS' + write(iulog,'(2a,i8)') subname,' nudge year first = ',nudge_data_year_first + write(iulog,'(2a,i8)') subname,' nudge year last = ',nudge_data_year_last + write(iulog,'(2a,i8)') subname,' nudge year align = ',nudge_data_year_align + write(iulog,'(3a)' ) subname,' nudge mapalgo = ',trim(nudge_data_mapalgo) + write(iulog,'(3a)' ) subname,' nudge tintalgo = ',trim(nudge_data_tintalgo) + write(iulog,'(3a)' ) subname,' nudge taxmode = ',trim(nudge_data_taxmode) + write(iulog,'(3a)' ) subname,' nudge levname = ',trim(nudge_data_levname) + write(iulog,'(3a)' ) subname,' nudge meshfile = ',trim(nudge_meshfile) + write(iulog,'(3a)' ) subname,' 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)) + write(iulog,'(2a,i0,2a)' ) subname,' nudge files(, ',nfile,') = ',trim(nudge_filenames(nfile)) end if end do write(iulog,'(a)' ) ' ' @@ -1577,7 +1577,7 @@ subroutine nudging_stream_interp(Target_U, Target_V, Target_T, Target_Q, Target_ real(r8), pointer :: dataptr1d(:) real(r8) :: Tmp3D(pcols,pver,begchunk:endchunk) real(r8) :: Tmp2D(pcols,begchunk:endchunk) - character(len=*), parameter :: sub = "(nudging_stream_interp) " + character(len=*), parameter :: subname = "(nudging_stream_interp) " !----------------------------------------------------------------------- ! Extract YMD from model_update_next_time @@ -1585,7 +1585,7 @@ subroutine nudging_stream_interp(Target_U, Target_V, Target_T, Target_Q, Target_ 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 + write(iulog,'(2a,4(i0,2x))') subname,' nudging_stream_interp: interpolating nudge to ',year,mon,day,sec end if ! Advance sdat streams @@ -1702,14 +1702,21 @@ subroutine get_calendar(sdat, model_year, model_month, model_day, calendar) call shr_cal_date2ymd(sdat%pstrm(1)%ymdUB, data_year, data_month, data_day) + ! By default return stream calendar calendar = trim(sdat%stream(1)%calendar) + + ! If model calendar not equal to stream calendar if (trim(sdat%model_calendar) /= trim(sdat%stream(1)%calendar)) then + ! If model calendar is gregorian and stream calendar is nolep then + ! return no leap calendar for February 29 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 + ! If model calendar is noleap and stream calendar is gregorian + ! then return no leap calendar 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 @@ -1726,12 +1733,8 @@ subroutine get_calendar(sdat, model_year, model_month, model_day, calendar) ! 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 + end if endif end subroutine get_calendar From f3dfc768e758f93eac391d8c4cd3fb538063123e Mon Sep 17 00:00:00 2001 From: Ove Haugvaldstad Date: Thu, 23 Apr 2026 11:56:21 +0200 Subject: [PATCH 23/25] clean up unused nudging tests and add test for the refactored nudging --- cime_config/testdefs/testlist_cam.xml | 10 +++ .../testmods_dirs/cam/nudging/shell_commands | 3 +- .../testmods_dirs/cam/nudging/user_nl_cam | 80 +++++++++---------- .../outfrq3s_nudging_f10_L26/shell_commands | 2 - .../cam/outfrq3s_nudging_f10_L26/user_nl_cam | 45 ----------- .../cam/outfrq3s_nudging_f10_L26/user_nl_cpl | 2 - .../outfrq3s_nudging_ne5_L26/shell_commands | 2 - .../cam/outfrq3s_nudging_ne5_L26/user_nl_cam | 45 ----------- .../cam/outfrq3s_nudging_ne5_L26/user_nl_cpl | 2 - .../cam/outfrq3s_zmean_nudging/shell_commands | 2 - .../cam/outfrq3s_zmean_nudging/user_nl_cam | 10 --- .../cam/outfrq3s_zmean_nudging/user_nl_cpl | 2 - 12 files changed, 50 insertions(+), 155 deletions(-) delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/shell_commands delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cam delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cpl delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/shell_commands delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cam delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cpl delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/shell_commands delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cam delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cpl diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 2797498960..970d7b9e9e 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -116,6 +116,16 @@ + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/cam/nudging/shell_commands b/cime_config/testdefs/testmods_dirs/cam/nudging/shell_commands index 6ff097dbf6..0beb245c97 100644 --- a/cime_config/testdefs/testmods_dirs/cam/nudging/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/nudging/shell_commands @@ -3,4 +3,5 @@ if [ "$driver" = "nuopc" ]; then ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL fi -./xmlchange RUN_STARTDATE=2009-01-01 +./xmlchange RUN_STARTDATE=0001-01-01 +./xmlchange CALENDAR=GREGORIAN diff --git a/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam index ce798ca005..a680b5be13 100644 --- a/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam @@ -1,52 +1,48 @@ ! Users should add all user specific namelist changes below in the form of ! namelist_var = new_namelist_value - &cam_inparm - fincl1='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q' - fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q' - fincl3='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q','Target_U','Target_V','Target_T','Target_Q' + fincl1='U','V','T','Q','PS','Nudge_U','Nudge_V' + fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V' + fincl3='U','V','T','Q','PS','Nudge_U','Nudge_V','Target_U','Target_V' nhtfrq=0,-6,1 mfilt =1,4,48 - write_nstep0 = .true. + interpolate_nlat = 96, 96, 96 + interpolate_nlon = 144, 144, 144 + interpolate_output = .true., .true., .true. - ncdata='$DIN_LOC_ROOT/atm/cam/nudging/ERAI_fv09_BILIN/ERAI_fv09_DART2.cam2.i.2009-01-01-00000.nc' / + &nudging_nl - Nudge_Model =.true. - Nudge_Path ='$DIN_LOC_ROOT/atm/cam/nudging/ERAI_fv09_BILIN/' - Nudge_File_Template='ERAI_fv09_DART2.cam2.i.%y-%m-%d-%s.nc' - Nudge_Force_Opt = 1 - Nudge_TimeScale_Opt = 0 - Nudge_Times_Per_Day=4 - Model_Times_Per_Day=48 - Nudge_Uprof =1 - Nudge_Ucoef =1.00 - Nudge_Vprof =1 - Nudge_Vcoef =1.00 - Nudge_Tprof =1 - Nudge_Tcoef =1.00 - Nudge_Qprof =0 - Nudge_Qcoef =0.00 - Nudge_PSprof =0 - Nudge_PScoef =0.00 - Nudge_Beg_Year =2008 - Nudge_Beg_Month=12 - Nudge_Beg_Day =16 - Nudge_End_Year =2009 - Nudge_End_Month=4 - Nudge_End_Day =5 - Nudge_Hwin_lat0 =46.0 - Nudge_Hwin_latWidth=20.0 - Nudge_Hwin_latDelta=2.0 - Nudge_Hwin_lon0 =180. - Nudge_Hwin_lonWidth=30. - Nudge_Hwin_lonDelta=5. - Nudge_Hwin_Invert =.false. - Nudge_Vwin_Hindex =22. - Nudge_Vwin_Hdelta =1.0 - Nudge_Vwin_Lindex =5. - Nudge_Vwin_Ldelta =1.0 - Nudge_Vwin_Invert =.false. + Nudge_Model = .true. + Nudge_Filenames = 'era5_UVPS_58levels_201801.nc', + 'era5_UVPS_58levels_201802.nc', + 'era5_UVPS_58levels_201803.nc' + + Nudge_Datapath = '$DIN_LOC_ROOT/noresm-only/inputForNudging/era5_UVPS_58levels_2018-2020/' + Nudge_Meshfile = '$DIN_LOC_ROOT/noresm-only/inputForNudging/era5_UVPS_ESMF_Mesh_cdf5.nc' + Nudge_Data_Taxmode = 'limit' + Nudge_Beg_Year = 1 + Nudge_Beg_Month = 1 + Nudge_Beg_Day = 1 + Nudge_End_Day = 31 + Nudge_End_Month = 12 + Nudge_End_Year = 2 + Nudge_Data_Year_Align = 1 + Nudge_Data_Year_First = 2018 + Nudge_Data_Year_Last = 2018 + Model_Update_Times_Per_Day = 48 + Nudge_Force_Opt = 1 + Nudge_Uprof = 1 + Nudge_Ucoef = 1.0 + Nudge_Vprof = 1 + Nudge_Vcoef = 1.0 + Nudge_Tprof = 0 + Nudge_Tcoef = 0.0 + Nudge_PSprof = 0 + Nudge_PScoef = 0.0 + Nudge_Qprof = 0 + Nudge_Qcoef = 0.0 / - + + \ No newline at end of file diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/shell_commands deleted file mode 100644 index eb40ad83e0..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/shell_commands +++ /dev/null @@ -1,2 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cam deleted file mode 100644 index 05a64cd2a2..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cam +++ /dev/null @@ -1,45 +0,0 @@ -! Users should add all user specific namelist changes below in the form of -! namelist_var = new_namelist_value - - fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q','Target_U','Target_V','Target_T','Target_Q' - nhtfrq=3,3,3,3,3,3,3,3,3,3 - mfilt =1,1,1,1,1,1,1,1,1,1 - ndens =1,1,1,1,1,1,1,1,1,1 - - Nudge_Model =.true. - Nudge_Path ='$DIN_LOC_ROOT/atm/cam/nudging/test_f10/' - Nudge_File_Template='QPC4_f10_met_data_gen01.cam.h1.%y-%m-%d-%s.nc' - Nudge_Force_Opt = 1 - Nudge_TimeScale_Opt = 0 - Nudge_Times_Per_Day=4 - Model_Times_Per_Day=48 - Nudge_Uprof =1 - Nudge_Ucoef =1.00 - Nudge_Vprof =1 - Nudge_Vcoef =1.00 - Nudge_Tprof =1 - Nudge_Tcoef =1.00 - Nudge_Qprof =1 - Nudge_Qcoef =1.00 - Nudge_PSprof =1 - Nudge_PScoef =1.00 - Nudge_Beg_Year =0001 - Nudge_Beg_Month=01 - Nudge_Beg_Day =01 - Nudge_End_Year =0001 - Nudge_End_Month=01 - Nudge_End_Day =02 - Nudge_Hwin_lat0 =0.0 - Nudge_Hwin_latWidth=9999. - Nudge_Hwin_latDelta=1.0 - Nudge_Hwin_lon0 =180. - Nudge_Hwin_lonWidth=9999. - Nudge_Hwin_lonDelta=1. - Nudge_Hwin_Invert =.false. - Nudge_Vwin_Hindex =27. - Nudge_Vwin_Hdelta =0.001 - Nudge_Vwin_Lindex =0. - Nudge_Vwin_Ldelta =0.1 - Nudge_Vwin_Invert =.false. - Nudge_ZonalFilter = .true. - Nudge_ZonalNbasis = 10 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cpl deleted file mode 100644 index 398535cf65..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cpl +++ /dev/null @@ -1,2 +0,0 @@ -reprosum_diffmax=1.0e-14 -reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/shell_commands deleted file mode 100644 index eb40ad83e0..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/shell_commands +++ /dev/null @@ -1,2 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cam deleted file mode 100644 index 4b17143322..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cam +++ /dev/null @@ -1,45 +0,0 @@ -! Users should add all user specific namelist changes below in the form of -! namelist_var = new_namelist_value - - fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q','Target_U','Target_V','Target_T','Target_Q' - nhtfrq=3,3,3,3,3,3,3,3,3,3 - mfilt =1,1,1,1,1,1,1,1,1,1 - ndens =1,1,1,1,1,1,1,1,1,1 - - Nudge_Model =.true. - Nudge_Path ='$DIN_LOC_ROOT/atm/cam/nudging/test_ne5/' - Nudge_File_Template='QPC4_ne5_met_data_gen01.cam.h1.%y-%m-%d-%s.nc' - Nudge_Force_Opt = 1 - Nudge_TimeScale_Opt = 0 - Nudge_Times_Per_Day=4 - Model_Times_Per_Day=48 - Nudge_Uprof =1 - Nudge_Ucoef =1.00 - Nudge_Vprof =1 - Nudge_Vcoef =1.00 - Nudge_Tprof =1 - Nudge_Tcoef =1.00 - Nudge_Qprof =1 - Nudge_Qcoef =1.00 - Nudge_PSprof =1 - Nudge_PScoef =1.00 - Nudge_Beg_Year =0001 - Nudge_Beg_Month=01 - Nudge_Beg_Day =01 - Nudge_End_Year =0001 - Nudge_End_Month=01 - Nudge_End_Day =02 - Nudge_Hwin_lat0 =0.0 - Nudge_Hwin_latWidth=9999. - Nudge_Hwin_latDelta=1.0 - Nudge_Hwin_lon0 =180. - Nudge_Hwin_lonWidth=9999. - Nudge_Hwin_lonDelta=1. - Nudge_Hwin_Invert =.false. - Nudge_Vwin_Hindex =27. - Nudge_Vwin_Hdelta =0.001 - Nudge_Vwin_Lindex =0. - Nudge_Vwin_Ldelta =0.1 - Nudge_Vwin_Invert =.false. - Nudge_ZonalFilter = .true. - Nudge_ZonalNbasis = 10 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cpl deleted file mode 100644 index 398535cf65..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cpl +++ /dev/null @@ -1,2 +0,0 @@ -reprosum_diffmax=1.0e-14 -reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/shell_commands deleted file mode 100644 index eb40ad83e0..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/shell_commands +++ /dev/null @@ -1,2 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cam deleted file mode 100644 index 0f8ab5afe8..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cam +++ /dev/null @@ -1,10 +0,0 @@ -! Users should add all user specific namelist changes below in the form of -! namelist_var = new_namelist_value - - fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q','Target_U','Target_V','Target_T','Target_Q' - nhtfrq=3,3,3,3,3,3,3,3,3,3 - mfilt =1,1,1,1,1,1,1,1,1,1 - ndens =1,1,1,1,1,1,1,1,1,1 - - Nudge_ZonalFilter = .true. - Nudge_ZonalNbasis = 64 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cpl deleted file mode 100644 index 398535cf65..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cpl +++ /dev/null @@ -1,2 +0,0 @@ -reprosum_diffmax=1.0e-14 -reprosum_recompute=.true. From 1f1fe296e2a5de0f33bb7ce39ee82c063b342e73 Mon Sep 17 00:00:00 2001 From: Ove Date: Thu, 23 Apr 2026 14:28:15 +0200 Subject: [PATCH 24/25] Clean up nudging test configuration namelist and revert accedental changes in test definitions --- cime_config/testdefs/testlist_cam.xml | 30 ++------ .../testmods_dirs/cam/nudging/user_nl_cam | 72 ++++++++----------- 2 files changed, 34 insertions(+), 68 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index fa80ca4e7c..4f6cee3c21 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -131,6 +131,7 @@ + @@ -143,37 +144,14 @@ - - - - - - + + - - - - - - - - - - - - - - - - - - - - + diff --git a/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam index a680b5be13..2d424f6b22 100644 --- a/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam @@ -1,48 +1,36 @@ ! Users should add all user specific namelist changes below in the form of ! namelist_var = new_namelist_value -&cam_inparm - fincl1='U','V','T','Q','PS','Nudge_U','Nudge_V' - fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V' - fincl3='U','V','T','Q','PS','Nudge_U','Nudge_V','Target_U','Target_V' - nhtfrq=0,-6,1 - mfilt =1,4,48 - interpolate_nlat = 96, 96, 96 - interpolate_nlon = 144, 144, 144 - interpolate_output = .true., .true., .true. +fincl1='U','V','T','Q','PS','Nudge_U','Nudge_V' +fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V' +fincl3='U','V','T','Q','PS','Nudge_U','Nudge_V','Target_U','Target_V' +nhtfrq=0,-6,1 +mfilt =1,4,48 +interpolate_nlat = 96, 96, 96 +interpolate_nlon = 144, 144, 144 +interpolate_output = .true., .true., .true. -/ +Nudge_Model = .true. +Nudge_Filenames = 'era5_UVPS_58levels_201801.nc', + 'era5_UVPS_58levels_201802.nc', + 'era5_UVPS_58levels_201803.nc' - -&nudging_nl - Nudge_Model = .true. - Nudge_Filenames = 'era5_UVPS_58levels_201801.nc', - 'era5_UVPS_58levels_201802.nc', - 'era5_UVPS_58levels_201803.nc' - - Nudge_Datapath = '$DIN_LOC_ROOT/noresm-only/inputForNudging/era5_UVPS_58levels_2018-2020/' - Nudge_Meshfile = '$DIN_LOC_ROOT/noresm-only/inputForNudging/era5_UVPS_ESMF_Mesh_cdf5.nc' - Nudge_Data_Taxmode = 'limit' - Nudge_Beg_Year = 1 - Nudge_Beg_Month = 1 - Nudge_Beg_Day = 1 - Nudge_End_Day = 31 - Nudge_End_Month = 12 - Nudge_End_Year = 2 - Nudge_Data_Year_Align = 1 - Nudge_Data_Year_First = 2018 - Nudge_Data_Year_Last = 2018 - Model_Update_Times_Per_Day = 48 - Nudge_Force_Opt = 1 - Nudge_Uprof = 1 - Nudge_Ucoef = 1.0 - Nudge_Vprof = 1 - Nudge_Vcoef = 1.0 - Nudge_Tprof = 0 - Nudge_Tcoef = 0.0 - Nudge_PSprof = 0 - Nudge_PScoef = 0.0 - Nudge_Qprof = 0 - Nudge_Qcoef = 0.0 -/ +Nudge_Datapath = '$DIN_LOC_ROOT/noresm-only/inputForNudging/era5_UVPS_58levels_2018-2020/' +Nudge_Meshfile = '$DIN_LOC_ROOT/noresm-only/inputForNudging/era5_UVPS_ESMF_Mesh_cdf5.nc' +Nudge_Data_Taxmode = 'limit' +Nudge_Beg_Year = 1 +Nudge_Beg_Month = 1 +Nudge_Beg_Day = 1 +Nudge_End_Day = 31 +Nudge_End_Month = 12 +Nudge_End_Year = 2 +Nudge_Data_Year_Align = 1 +Nudge_Data_Year_First = 2018 +Nudge_Data_Year_Last = 2018 +Model_Update_Times_Per_Day = 48 +Nudge_Force_Opt = 1 +Nudge_Uprof = 1 +Nudge_Ucoef = 1.0 +Nudge_Vprof = 1 +Nudge_Vcoef = 1.0 \ No newline at end of file From 06dcd89626a68ba070d7221180bdb9c9f9e92762 Mon Sep 17 00:00:00 2001 From: goldy <1588651+gold2718@users.noreply.github.com> Date: Thu, 23 Apr 2026 15:10:13 +0200 Subject: [PATCH 25/25] Apply suggestions from code review Co-authored-by: goldy <1588651+gold2718@users.noreply.github.com> --- src/physics/cam/nudging.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 4d84d7ea82..b503ceab9f 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -1707,7 +1707,7 @@ subroutine get_calendar(sdat, model_year, model_month, model_day, calendar) ! If model calendar not equal to stream calendar if (trim(sdat%model_calendar) /= trim(sdat%stream(1)%calendar)) then - ! If model calendar is gregorian and stream calendar is nolep then + ! If model calendar is gregorian and stream calendar is noleap then ! return no leap calendar for February 29 if (( trim(sdat%model_calendar) == trim(shr_cal_gregorian)) .and. & (trim(sdat%stream(1)%calendar) == trim(shr_cal_noleap))) then