From f3cc48ce697f71e9ebc1cd99c67f960cb707b62d Mon Sep 17 00:00:00 2001 From: mvertens Date: Sun, 26 Oct 2025 16:41:48 +0100 Subject: [PATCH 01/31] 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 601ecd36c9b1eb4e4c460dbf9fea16ffa3f5b22b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 27 Oct 2025 09:38:37 +0100 Subject: [PATCH 02/31] 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 99b98fa61365f651429456efcca4305979ad4e14 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 27 Oct 2025 10:59:06 +0100 Subject: [PATCH 03/31] 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 e48da5b262b3e68a97ecec36707241eb9f299780 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 29 Oct 2025 22:22:03 +0100 Subject: [PATCH 04/31] 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 3eaa0106cc..f2d913babb 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 d9b8012ee7ae9a5bba98171935359c1f6a41e06e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 30 Oct 2025 10:45:24 +0100 Subject: [PATCH 05/31] 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 46c91143715e3391c07b374670e08f0f7ade60d1 Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 30 Oct 2025 18:06:58 +0100 Subject: [PATCH 06/31] refactor of co2_cycle and co2_data_flux to use cdeps streams --- src/physics/cam/co2_cycle.F90 | 132 ++++++++++++++++-------- src/physics/cam/co2_data_flux.F90 | 163 +++++++++++++++--------------- 2 files changed, 168 insertions(+), 127 deletions(-) diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 index d3b4ee5e7e..dd0c3db774 100644 --- a/src/physics/cam/co2_cycle.F90 +++ b/src/physics/cam/co2_cycle.F90 @@ -16,7 +16,6 @@ module co2_cycle use srf_field_check, only: active_Faoo_fco2_ocn implicit none - private ! Public interfaces @@ -30,31 +29,23 @@ module co2_cycle public co2_time_interp_fuel ! time interpolate co2 flux public co2_cycle_set_ptend ! set tendency from aircraft emissions - ! Public data - public data_flux_ocn ! data read in for co2 flux from ocn - public data_flux_fuel ! data read in for co2 flux from fuel - - type(co2_data_flux_type) :: data_flux_ocn - type(co2_data_flux_type) :: data_flux_fuel + ! Module data + type(co2_data_flux_type), public, protected :: data_flux_ocn ! data read in for co2 flux from ocn + type(co2_data_flux_type), public, protected :: data_flux_fuel ! data read in for co2 flux from fuel - public c_i ! global index for new constituents - public co2_readFlux_ocn ! read ocn co2 flux from data file - public co2_readFlux_fuel ! read fuel co2 flux from data file + integer, parameter :: ncnst=4 ! number of constituents implemented + integer, public, protected :: c_i(ncnst) ! global index for new constituents ! Namelist variables - logical :: co2_flag = .false. ! true => turn on co2 code, namelist variable - logical :: co2_readFlux_ocn = .false. ! true => read ocn co2 flux from date file, namelist variable - logical :: co2_readFlux_fuel = .false. ! true => read fuel co2 flux from date file, namelist variable - logical :: co2_readFlux_aircraft = .false. ! true => read aircraft co2 flux from date file, namelist variable - character(len=cl) :: co2flux_ocn_file = 'unset' ! co2 flux from ocn - character(len=cl) :: co2flux_fuel_file = 'unset' ! co2 flux from fossil fuel + logical :: co2_flag = .false. ! true => turn on co2 code, namelist variable + logical, public, protected :: co2_readFlux_ocn = .false. ! true => read ocn co2 flux from date file, namelist variable + logical, public, protected :: co2_readFlux_fuel = .false. ! true => read fuel co2 flux from date file, namelist variable + logical :: co2_readFlux_aircraft = .false. ! true => read aircraft co2 flux from date file, namelist variable !------------------------------------------------------------------------------- ! new constituents !------------------------------------------------------------------------------- - integer, parameter :: ncnst=4 ! number of constituents implemented - character(len=7), dimension(ncnst), parameter :: & ! constituent names c_names = (/'CO2_OCN', 'CO2_FFF', 'CO2_LND', 'CO2 '/) @@ -63,8 +54,6 @@ module co2_cycle integer :: co2_lnd_glo_ind ! global index of 'CO2_LND' integer :: co2_glo_ind ! global index of 'CO2' - integer, dimension(ncnst) :: c_i ! global index - !=============================================================================== contains !=============================================================================== @@ -78,7 +67,7 @@ subroutine co2_cycle_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit use spmd_utils, only: masterproc - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_character + use spmd_utils, only: mpicom, masterprocid, mpi_logical, mpi_character use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -86,17 +75,47 @@ subroutine co2_cycle_readnl(nlfile) character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables - integer :: unitn, ierr + character(len=cl) :: co2flux_ocn_file = 'unset' ! co2 flux from ocn + character(len=cl) :: co2flux_ocn_mesh = 'unset' ! ESMF mesh corresponding to co2flux_ocn_file + integer :: co2flux_ocn_year_first = -999 ! first year in stream to use + integer :: co2flux_ocn_year_last = -999 ! last year in stream to use + integer :: co2flux_ocn_year_align = -999 ! align stream_year_first + integer :: co2flux_ocn_tintmode = 'linear' ! time interpolation [lower, upper, nearest, linear or coszen] + integer :: co2flux_ocn_taxmode = 'limit' ! time extraploation [cycle, extend or limit] + character(len=cl) :: co2flux_fuel_file = 'unset' ! co2 flux from fossil fuel + character(len=cl) :: co2flux_fuel_mesh = 'unset' ! ESMF mesh corresponding to co2flux_fuel_file + integer :: co2flux_fuel_year_first = -999 ! first year in stream to use + integer :: co2flux_fuel_year_last = -999 ! last year in stream to use + integer :: co2flux_fuel_year_align = -999 ! align stream_year_first + integer :: co2flux_fuel_tintmode = 'linear' ! time interpolation [lower, upper, nearest, linear or coszen] + integer :: co2flux_fuel_taxmode = 'limit' ! time extraploation [cycle, extend or limit] + integer :: unitn, ierr character(len=256) :: msg character(len=*), parameter :: subname = 'co2_cycle_readnl' - namelist /co2_cycle_nl/ co2_flag, co2_readFlux_ocn, co2_readFlux_fuel, co2_readFlux_aircraft, & - co2flux_ocn_file, co2flux_fuel_file + namelist /co2_cycle_nl/ & + co2_flag, & + co2_readFlux_aircraft, & ! if true, read aircraft data + co2_readFlux_ocn, & ! if true, read ocn data + co2flux_ocn_file, & ! input ocn dataset + co2flux_ocn_mesh, & ! ESMF mesh file for input dataset + co2flux_ocn_year_first, & ! first year in stream to use + co2flux_ocn_year_last, & ! last year in stream to use + co2flux_ocn_year_align, & ! align stream_year_first + co2flux_ocn_tintalgo, & ! time interpolation [lower, upper, nearest, linear or coszen] + co2flux_ocn_taxmode, & ! time extraploation [cycle, extend or limit] + co2_readFlux_fuel, & ! if true, read fuel data + co2flux_fuel_file, & ! input fuel dataset + co2flux_fuel_mesh, & ! ESMF mesh file for input dataset + co2flux_fuel_year_first, & ! first year in stream to use + co2flux_fuel_year_last, & ! last year in stream to use + co2flux_fuel_year_align, & ! align stream_year_first + co2flux_fuel_tintalgo, & ! time interpolation [lower, upper, nearest, linear or coszen] + co2flux_fuel_taxmode & ! time extraploation [cycle, extend or limit] !---------------------------------------------------------------------------- if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'co2_cycle_nl', status=ierr) if (ierr == 0) then read(unitn, co2_cycle_nl, iostat=ierr) @@ -105,28 +124,58 @@ subroutine co2_cycle_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if ! Broadcast namelist variables - call mpi_bcast(co2_flag, 1, mpi_logical, mstrid, mpicom, ierr) + call mpi_bcast(co2_flag, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_flag") - call mpi_bcast(co2_readFlux_ocn, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_ocn") - call mpi_bcast(co2_readFlux_fuel, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_fuel") - call mpi_bcast(co2_readFlux_aircraft, 1, mpi_logical, mstrid, mpicom, ierr) + + call mpi_bcast(co2_readFlux_aircraft, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_aircraft") - call mpi_bcast(co2flux_ocn_file, len(co2flux_ocn_file), mpi_character, mstrid, mpicom, ierr) + + call mpi_bcast(co2_readFlux_ocn, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_ocn") + call mpi_bcast(co2flux_ocn_file, len(co2flux_ocn_file), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_file") - call mpi_bcast(co2flux_fuel_file, len(co2flux_fuel_file), mpi_character, mstrid, mpicom, ierr) + call mpi_bcast(co2flux_ocn_file, len(co2flux_ocn_file), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_file") + call mpi_bcast(co2flux_ocn_mesh, len(co2flux_ocn_mesh), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_mesh") + call mpi_bcast(co2flux_ocn_year_first, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_year_first") + call mpi_bcast(co2flux_ocn_year_last, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_year_last") + call mpi_bcast(co2flux_ocn_year_align, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_year_align") + call mpi_bcast(co2flux_ocn_tintalgo, len(co2flux_ocn_tintalgo), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_tintalgo") + call mpi_bcast(co2flux_ocn_taxmode, len(co2flux_ocn_taxmode), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_taxmode") + + call mpi_bcast(co2_readFlux_fuel, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_fuel") + call mpi_bcast(co2flux_fuel_file, len(co2flux_fuel_file), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_file") + call mpi_bcast(co2flux_fuel_mesh, len(co2flux_fuel_mesh), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_mesh") + call mpi_bcast(co2flux_fuel_year_first, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_first") + call mpi_bcast(co2flux_fuel_year_last, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_last") + call mpi_bcast(co2flux_fuel_year_align, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_align") + call mpi_bcast(co2flux_fuel_tintalgo, len(co2flux_fuel_tintalgo), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_tintalgo") + call mpi_bcast(co2flux_fuel_taxmode, len(co2flux_fuel_taxmode), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode") ! Consistency check if (co2_readFlux_ocn .and. active_Faoo_fco2_ocn) then msg = subname//': ERROR: reading ocn flux dataset is enabled, but coupler is setting'& //' the ocn co2 flux. Cannot do both.' - write(iulog,*) trim(msg) + if (masterproc) then + write(iulog,*) trim(msg) + end if call endrun(trim(msg)) end if @@ -278,7 +327,6 @@ subroutine co2_init_cnst(name, latvals, lonvals, mask, q) end subroutine co2_init_cnst !=============================================================================== - subroutine co2_init !------------------------------------------------------------------------------- @@ -317,17 +365,18 @@ subroutine co2_init ! Read flux data if (co2_readFlux_ocn) then - call co2_data_flux_init ( co2flux_ocn_file, 'CO2_flux', data_flux_ocn ) + call co2_data_flux_init (co2flux_ocn_file, co2flux_ocn_mesh, & + 'CO2_flux', co2flux_ocn_year_first, co2flux_ocn_year_last, co2flux_ocn_year_align, xin) end if if (co2_readFlux_fuel) then - call co2_data_flux_init ( co2flux_fuel_file, 'CO2_flux', data_flux_fuel ) + call co2_data_flux_init (co2flux_fuel_file, co2flux_fuel_mesh, & + 'CO2_flux', co2flux_fuel_year_first, co2flux_fuel_year_last, co2flux_fuel_year_align, xin) end if end subroutine co2_init !=============================================================================== - subroutine co2_time_interp_ocn !------------------------------------------------------------------------------- @@ -337,7 +386,6 @@ subroutine co2_time_interp_ocn use time_manager, only: is_first_step use co2_data_flux, only: co2_data_flux_advance - !---------------------------------------------------------------------------- if (.not. co2_flag) return @@ -371,7 +419,6 @@ subroutine co2_time_interp_fuel end subroutine co2_time_interp_fuel !=============================================================================== - subroutine co2_cycle_set_ptend(state, pbuf, ptend) !------------------------------------------------------------------------------- @@ -394,7 +441,6 @@ subroutine co2_cycle_set_ptend(state, pbuf, ptend) logical :: lq(pcnst) integer :: ifld, ncol, k real(r8), pointer :: ac_CO2(:,:) - !---------------------------------------------------------------------------- if (.not. co2_flag .or. .not. co2_readFlux_aircraft) then diff --git a/src/physics/cam/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 index 5e12525766..021dd4f466 100644 --- a/src/physics/cam/co2_data_flux.F90 +++ b/src/physics/cam/co2_data_flux.F90 @@ -5,12 +5,10 @@ module co2_data_flux !------------------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl - use input_data_utils, only: time_coordinate use cam_abortutils, only: endrun implicit none private - save ! Public interfaces public co2_data_flux_type @@ -18,15 +16,9 @@ module co2_data_flux public co2_data_flux_init public co2_data_flux_advance -!------------------------------------------------------------------------------- - type :: co2_data_flux_type - character(len=cl) :: filename - character(len=cl) :: varname - logical :: initialized - type(time_coordinate) :: time_coord - real(r8), pointer :: co2bdy(:,:,:) ! bracketing data (pcols,begchunk:endchunk,2) - real(r8), pointer :: co2flx(:,:) ! Interpolated output (pcols,begchunk:endchunk) + type(shr_strdata_type) :: sdat_co2 + real(r8), pointer :: co2flx(:,:) ! Interpolated output (pcols,begchunk:endchunk) end type co2_data_flux_type ! dimension names for physics grid (physgrid) @@ -37,22 +29,30 @@ module co2_data_flux contains !=============================================================================== -subroutine co2_data_flux_init (input_file, varname, xin) + subroutine co2_data_flux_init (input_file, input_mesh, & + varname, year_first, year_last, year_align, tintalgo, taxmode, xin) !------------------------------------------------------------------------------- ! Initialize co2_data_flux_type instance ! including initial read of input and interpolation to the current timestep !------------------------------------------------------------------------------- - use ioFileMod, only: getfil + use ESMF, only: ESMF_Mesh use ppgrid, only: begchunk, endchunk, pcols use cam_grid_support, only: cam_grid_id, cam_grid_check use cam_grid_support, only: cam_grid_get_dim_names + use atm_shr , only: model_mesh, model_clock ! Arguments - character(len=*), intent(in) :: input_file - character(len=*), intent(in) :: varname - type(co2_data_flux_type), intent(inout) :: xin + character(len=*), intent(in) :: input_file + type(ESMF_Mesh) , intent(in) :: input_mesh + character(len=*), intent(in) :: varname + integer, intent(in) :: year_first + integer, intent(in) :: year_last + integer, intent(in) :: year_align + character(len=*), intent(in) :: tintalgo + character(len=*), intent(in) :: taxalgo + type(co2_data_flux_type), intent(inout) :: xin ! Local variables integer :: grid_id @@ -69,95 +69,90 @@ subroutine co2_data_flux_init (input_file, varname, xin) dimnames_set = .true. end if - call getfil(input_file, xin%filename) - xin%varname = varname - xin%initialized = .false. - - dtime = 1.0_r8 - 200.0_r8 / 86400.0_r8 - call xin%time_coord%initialize(input_file, delta_days=dtime) - - allocate( xin%co2bdy(pcols,begchunk:endchunk,2), & - xin%co2flx(pcols,begchunk:endchunk) ) + call shr_strdata_init_from_inline(xin%sdat_co2, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = model_clock, & + model_mesh = model_mesh, & + stream_meshfile = trim(input_mesh), & + stream_filenames = (/input_file/), & + stream_yearFirst = year_first, & + stream_yearLast = year_last, & + stream_yearAlign = year_first, & + stream_fldlistFile = (/varname/), & + stream_fldListModel = (/varname/), & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = trim(taxmode), & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = trim(tintalgo), & + stream_name = 'CO2 forcing data ', & + rc = rc) + call chkrc(rc, sub//': error return from shr_strdata_init_from_inline') + + allocate( xin%co2flx(pcols,begchunk:endchunk) ) call co2_data_flux_advance(xin) - xin%initialized = .true. - end subroutine co2_data_flux_init !=============================================================================== - subroutine co2_data_flux_advance (xin) !------------------------------------------------------------------------------- -! Advance the contents of a co2_data_flux_type instance -! including reading new data, if necessary +! Advance the contents of a co2_data_flux_type sdat (map and interpolate in time) !------------------------------------------------------------------------------- - use cam_pio_utils, only: cam_pio_openfile - use ncdio_atm, only: infld - use pio, only: file_desc_t, pio_nowrite, pio_closefile - use ppgrid, only: begchunk, endchunk, pcols + use dshr_methods_mod , only : dshr_fldbun_getfldptr + use dshr_strdata_mod , only : shr_strdata_advance + use ppgrid , only : begchunk, endchunk + use phys_grid , only : get_ncols_p + use time_manager , only : get_curr_date ! Arguments type(co2_data_flux_type), intent(inout) :: xin ! Local variables + integer :: icol,lchnk,g + 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 :: dataptr1d(:) character(len=*), parameter :: subname = 'co2_data_flux_advance' - logical :: read_data - integer :: indx2_pre_adv - type(file_desc_t) :: fh_co2_data_flux - logical :: found - !---------------------------------------------------------------------------- - read_data = xin%time_coord%read_more() .or. .not. xin%initialized - - indx2_pre_adv = xin%time_coord%indxs(2) - - call xin%time_coord%advance() - - if ( read_data ) then - - call cam_pio_openfile(fh_co2_data_flux, trim(xin%filename), PIO_NOWRITE) - - ! read time-level 1 - ! skip the read if the needed vals are present in time-level 2 - if (xin%initialized .and. xin%time_coord%indxs(1) == indx2_pre_adv) then - xin%co2bdy(:,:,1) = xin%co2bdy(:,:,2) - else - call infld(trim(xin%varname), fh_co2_data_flux, dim1name, dim2name, & - 1, pcols, begchunk, endchunk, xin%co2bdy(:,:,1), found, & - gridname='physgrid', timelevel=xin%time_coord%indxs(1)) - if (.not. found) then - call endrun(subname // ': ERROR: ' // trim(xin%varname) // ' not found') - endif - endif - - ! read time-level 2 - call infld(trim(xin%varname), fh_co2_data_flux, dim1name, dim2name, & - 1, pcols, begchunk, endchunk, xin%co2bdy(:,:,2), found, & - gridname='physgrid', timelevel=xin%time_coord%indxs(2)) - if (.not. found) then - call endrun(subname // ': ERROR: ' // trim(xin%varname) // ' not found') - endif - - call pio_closefile(fh_co2_data_flux) - endif - - ! interpolate between time-levels - ! If time:bounds is in the dataset, and the dataset calendar is compatible with CAM's, - ! then the time_coordinate class will produce time_coord%wghts(2) == 0.0, - ! generating fluxes that are piecewise constant in time. - - if (xin%time_coord%wghts(2) == 0.0_r8) then - xin%co2flx(:,:) = xin%co2bdy(:,:,1) - else - xin%co2flx(:,:) = xin%co2bdy(:,:,1) + & - xin%time_coord%wghts(2) * (xin%co2bdy(:,:,2) - xin%co2bdy(:,:,1)) - endif -end subroutine co2_data_flux_advance + ! Advance sdat stream + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + call shr_strdata_advance(sdat_ndep, ymd=mcdate, tod=sec, logunit=iulog, istr='ndepdyn', 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 + call dshr_fldbun_getFldPtr(sdat_ndep%pstrm(1)%fldbun_model, stream_varlist_ndep(1), fldptr1=dataptr1d_nhx, 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 dshr_fldbun_getFldPtr(sdat_ndep%pstrm(1)%fldbun_model, stream_varlist_ndep(2), fldptr1=dataptr1d_noy, 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 lchnk = begchunk,endchunk + do icol = 1,get_ncols_p(lchnk) + xin%co2flx(icol,lchnk) = dataptr1d(g) + g = g + 1 + end do + end do + + end subroutine co2_data_flux_advance !=============================================================================== From 1f3d7d922bba3a490b88311cb1ec02fd8fd2d7bc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 4 Nov 2025 15:06:22 +0100 Subject: [PATCH 07/31] first pass at the validation --- bld/namelist_files/namelist_definition.xml | 58 +++++ src/physics/cam/co2_cycle.F90 | 85 +++---- src/physics/cam/co2_data_flux.F90 | 260 ++++++++++----------- 3 files changed, 228 insertions(+), 175 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index f2d913babb..4739f6099c 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1799,12 +1799,70 @@ Default: set by build-namelist Filepath for dataset containing CO2 flux from ocn. Default: none + +Filepath for ESMF Mesh corresponding to co2flux_ocn_file File. +Default: none + + +Year first to use in co2flux_ocn_file. +Default: 0 + +Year last to use in co2flux_ocn_file. +Default: 0 + + +Year align to use in co2flux_ocn_file. +Default: 0 + + +Time interpolation algorithm to use for co2flux_ocn_file. +Default: linear + + +Time extrapolation algorithm to use for co2flux_ocn_file. +Default: cycle + Filepath for dataset containing CO2 flux from fossil fuel. Default: none + +Filepath for ESMF Mesh corresponding to co2flux_fuel_file File. +Default: none + + +Year first to use in co2flux_fuel_file. +Default: 0 + +Year last to use in co2flux_fuel_file. +Default: 0 + + +Year align to use in co2flux_fuel_file. +Default: 0 + + +Time interpolation algorithm to use for co2flux_fuel_file. +Default: linear + + +Time extrapolation algorithm to use for co2flux_fuel_file. +Default: cycle + diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 index dd0c3db774..34dab18048 100644 --- a/src/physics/cam/co2_cycle.F90 +++ b/src/physics/cam/co2_cycle.F90 @@ -4,14 +4,15 @@ module co2_cycle ! ! Purpose: ! Provides distributions of CO2_LND, CO2_OCN, CO2_FF, CO2 -! Surface flux from CO2_LND and CO2_OCN can be provided by the flux coupler. +! Surface flux from CO2_LND and CO2_OCN provided by the mediator. ! Surface flux from CO2_FFF and CO2_OCN can be read from a file. ! ! Author: Jeff Lee, Keith Lindsay +! Mariana Vertenstein, Refactored for NUOPC Stream functionality ! !------------------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use co2_data_flux, only: co2_data_flux_type use srf_field_check, only: active_Faoo_fco2_ocn @@ -33,8 +34,6 @@ module co2_cycle type(co2_data_flux_type), public, protected :: data_flux_ocn ! data read in for co2 flux from ocn type(co2_data_flux_type), public, protected :: data_flux_fuel ! data read in for co2 flux from fuel - integer, parameter :: ncnst=4 ! number of constituents implemented - integer, public, protected :: c_i(ncnst) ! global index for new constituents ! Namelist variables logical :: co2_flag = .false. ! true => turn on co2 code, namelist variable @@ -42,10 +41,29 @@ module co2_cycle logical, public, protected :: co2_readFlux_fuel = .false. ! true => read fuel co2 flux from date file, namelist variable logical :: co2_readFlux_aircraft = .false. ! true => read aircraft co2 flux from date file, namelist variable + character(len=cl) :: co2flux_ocn_file = 'unset' ! co2 flux from ocn + character(len=cl) :: co2flux_ocn_mesh = 'unset' ! ESMF mesh corresponding to co2flux_ocn_file + integer :: co2flux_ocn_year_first = -999 ! first year in stream to use + integer :: co2flux_ocn_year_last = -999 ! last year in stream to use + integer :: co2flux_ocn_year_align = -999 ! align stream_year_first + character(len=cs) :: co2flux_ocn_tintalgo = 'linear' ! time interpolation [lower, upper, nearest, linear or coszen] + character(len=cs) :: co2flux_ocn_taxmode = 'extend' ! time extraploation [cycle, extend or limit] + + character(len=cl) :: co2flux_fuel_file = 'unset' ! co2 flux from fossil fuel + character(len=cl) :: co2flux_fuel_mesh = 'unset' ! ESMF mesh corresponding to co2flux_fuel_file + integer :: co2flux_fuel_year_first = -999 ! first year in stream to use + integer :: co2flux_fuel_year_last = -999 ! last year in stream to use + integer :: co2flux_fuel_year_align = -999 ! align stream_year_first + character(len=cs) :: co2flux_fuel_tintalgo = 'linear' ! time interpolation [lower, upper, nearest, linear or coszen] + character(len=cs) :: co2flux_fuel_taxmode = 'extend' ! time extraploation [cycle, extend or limit] + !------------------------------------------------------------------------------- ! new constituents !------------------------------------------------------------------------------- + integer, parameter :: ncnst=4 ! number of constituents implemented + integer, public, protected :: c_i(ncnst) ! global index for new constituents + character(len=7), dimension(ncnst), parameter :: & ! constituent names c_names = (/'CO2_OCN', 'CO2_FFF', 'CO2_LND', 'CO2 '/) @@ -65,9 +83,8 @@ subroutine co2_cycle_readnl(nlfile) !------------------------------------------------------------------------------- use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: masterproc - use spmd_utils, only: mpicom, masterprocid, mpi_logical, mpi_character + use spmd_utils, only: masterproc, mpicom, masterprocid + use spmd_utils, only: mpi_logical, mpi_character, mpi_integer use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -75,20 +92,6 @@ subroutine co2_cycle_readnl(nlfile) character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables - character(len=cl) :: co2flux_ocn_file = 'unset' ! co2 flux from ocn - character(len=cl) :: co2flux_ocn_mesh = 'unset' ! ESMF mesh corresponding to co2flux_ocn_file - integer :: co2flux_ocn_year_first = -999 ! first year in stream to use - integer :: co2flux_ocn_year_last = -999 ! last year in stream to use - integer :: co2flux_ocn_year_align = -999 ! align stream_year_first - integer :: co2flux_ocn_tintmode = 'linear' ! time interpolation [lower, upper, nearest, linear or coszen] - integer :: co2flux_ocn_taxmode = 'limit' ! time extraploation [cycle, extend or limit] - character(len=cl) :: co2flux_fuel_file = 'unset' ! co2 flux from fossil fuel - character(len=cl) :: co2flux_fuel_mesh = 'unset' ! ESMF mesh corresponding to co2flux_fuel_file - integer :: co2flux_fuel_year_first = -999 ! first year in stream to use - integer :: co2flux_fuel_year_last = -999 ! last year in stream to use - integer :: co2flux_fuel_year_align = -999 ! align stream_year_first - integer :: co2flux_fuel_tintmode = 'linear' ! time interpolation [lower, upper, nearest, linear or coszen] - integer :: co2flux_fuel_taxmode = 'limit' ! time extraploation [cycle, extend or limit] integer :: unitn, ierr character(len=256) :: msg character(len=*), parameter :: subname = 'co2_cycle_readnl' @@ -111,7 +114,7 @@ subroutine co2_cycle_readnl(nlfile) co2flux_fuel_year_last, & ! last year in stream to use co2flux_fuel_year_align, & ! align stream_year_first co2flux_fuel_tintalgo, & ! time interpolation [lower, upper, nearest, linear or coszen] - co2flux_fuel_taxmode & ! time extraploation [cycle, extend or limit] + co2flux_fuel_taxmode ! time extraploation [cycle, extend or limit] !---------------------------------------------------------------------------- if (masterproc) then @@ -171,7 +174,7 @@ subroutine co2_cycle_readnl(nlfile) ! Consistency check if (co2_readFlux_ocn .and. active_Faoo_fco2_ocn) then - msg = subname//': ERROR: reading ocn flux dataset is enabled, but coupler is setting'& + msg = subname//': ERROR: reading ocn flux dataset is enabled, but mediator is setting'& //' the ocn co2 flux. Cannot do both.' if (masterproc) then write(iulog,*) trim(msg) @@ -193,7 +196,7 @@ subroutine co2_register use constituents, only: cnst_add ! Local variables - real(r8), dimension(ncnst) :: & + real(r8), dimension(ncnst) :: & c_mw, &! molecular weights c_cp, &! heat capacities c_qmin ! minimum mmr @@ -337,12 +340,10 @@ subroutine co2_init !------------------------------------------------------------------------------- use cam_history, only: addfld, add_default, horiz_only - use co2_data_flux, only: co2_data_flux_init use constituents, only: cnst_name, cnst_longname, sflxnam ! Local variables integer :: m, mm - !---------------------------------------------------------------------------- if (.not. co2_flag) return @@ -363,17 +364,6 @@ subroutine co2_init call add_default('TM'//trim(cnst_name(mm)), 1, ' ') end do - ! Read flux data - if (co2_readFlux_ocn) then - call co2_data_flux_init (co2flux_ocn_file, co2flux_ocn_mesh, & - 'CO2_flux', co2flux_ocn_year_first, co2flux_ocn_year_last, co2flux_ocn_year_align, xin) - end if - - if (co2_readFlux_fuel) then - call co2_data_flux_init (co2flux_fuel_file, co2flux_fuel_mesh, & - 'CO2_flux', co2flux_fuel_year_first, co2flux_fuel_year_last, co2flux_fuel_year_align, xin) - end if - end subroutine co2_init !=============================================================================== @@ -385,12 +375,21 @@ subroutine co2_time_interp_ocn !------------------------------------------------------------------------------- use time_manager, only: is_first_step - use co2_data_flux, only: co2_data_flux_advance + use co2_data_flux, only: co2_data_flux_init, co2_data_flux_advance + + logical :: first_time = .true. !---------------------------------------------------------------------------- if (.not. co2_flag) return if (co2_readFlux_ocn) then + if (first_time) then + ! Initialize and read flux data + call co2_data_flux_init (co2flux_ocn_file, co2flux_ocn_mesh, & + 'CO2_flux', co2flux_ocn_year_first, co2flux_ocn_year_last, co2flux_ocn_year_align, & + co2flux_ocn_tintalgo, co2flux_ocn_taxmode, data_flux_ocn) + first_time = .false. + end if call co2_data_flux_advance ( data_flux_ocn ) endif @@ -406,13 +405,21 @@ subroutine co2_time_interp_fuel !------------------------------------------------------------------------------- use time_manager, only: is_first_step - use co2_data_flux, only: co2_data_flux_advance + use co2_data_flux, only: co2_data_flux_init, co2_data_flux_advance + logical :: first_time = .true. !---------------------------------------------------------------------------- if (.not. co2_flag) return if (co2_readFlux_fuel) then + if (first_time) then + ! Initialize and read flux data + call co2_data_flux_init (co2flux_fuel_file, co2flux_fuel_mesh, & + 'CO2_flux', co2flux_fuel_year_first, co2flux_fuel_year_last, co2flux_fuel_year_align, & + co2flux_fuel_tintalgo, co2flux_fuel_taxmode, data_flux_fuel) + first_time = .false. + end if call co2_data_flux_advance ( data_flux_fuel ) endif diff --git a/src/physics/cam/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 index 021dd4f466..2438f45516 100644 --- a/src/physics/cam/co2_data_flux.F90 +++ b/src/physics/cam/co2_data_flux.F90 @@ -1,159 +1,147 @@ module co2_data_flux -!------------------------------------------------------------------------------- -! utilities for reading and interpolating co2 surface fluxes -!------------------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + !------------------------------------------------------------------------------- + ! read and interpolate co2 surface fluxes + !------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl, cs=> shr_kind_cs + use ESMF, only: ESMF_Mesh, ESMF_Finalize, ESMF_LogFoundError + use ESMF, only: ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use cam_logfile, only: iulog use cam_abortutils, only: endrun + use spmd_utils, only: iam + use dshr_strdata_mod, only: shr_strdata_type implicit none private ! Public interfaces public co2_data_flux_type - public co2_data_flux_init public co2_data_flux_advance type :: co2_data_flux_type type(shr_strdata_type) :: sdat_co2 + character(len=cs) :: varname real(r8), pointer :: co2flx(:,:) ! Interpolated output (pcols,begchunk:endchunk) end type co2_data_flux_type - ! dimension names for physics grid (physgrid) - logical :: dimnames_set = .false. - character(len=8) :: dim1name, dim2name - !=============================================================================== contains !=============================================================================== - subroutine co2_data_flux_init (input_file, input_mesh, & - varname, year_first, year_last, year_align, tintalgo, taxmode, xin) - -!------------------------------------------------------------------------------- -! Initialize co2_data_flux_type instance -! including initial read of input and interpolation to the current timestep -!------------------------------------------------------------------------------- - - use ESMF, only: ESMF_Mesh - use ppgrid, only: begchunk, endchunk, pcols - use cam_grid_support, only: cam_grid_id, cam_grid_check - use cam_grid_support, only: cam_grid_get_dim_names - use atm_shr , only: model_mesh, model_clock - - ! Arguments - character(len=*), intent(in) :: input_file - type(ESMF_Mesh) , intent(in) :: input_mesh - character(len=*), intent(in) :: varname - integer, intent(in) :: year_first - integer, intent(in) :: year_last - integer, intent(in) :: year_align - character(len=*), intent(in) :: tintalgo - character(len=*), intent(in) :: taxalgo - type(co2_data_flux_type), intent(inout) :: xin - - ! Local variables - integer :: grid_id - real(r8) :: dtime - character(len=*), parameter :: subname = 'co2_data_flux_init' - !---------------------------------------------------------------------------- - - if (.not. dimnames_set) then - grid_id = cam_grid_id('physgrid') - if (.not. cam_grid_check(grid_id)) then - call endrun(subname // ': ERROR: no "physgrid" grid') - endif - call cam_grid_get_dim_names(grid_id, dim1name, dim2name) - dimnames_set = .true. - end if - - call shr_strdata_init_from_inline(xin%sdat_co2, & - my_task = iam, & - logunit = iulog, & - compname = 'ATM', & - model_clock = model_clock, & - model_mesh = model_mesh, & - stream_meshfile = trim(input_mesh), & - stream_filenames = (/input_file/), & - stream_yearFirst = year_first, & - stream_yearLast = year_last, & - stream_yearAlign = year_first, & - stream_fldlistFile = (/varname/), & - stream_fldListModel = (/varname/), & - stream_lev_dimname = 'null', & - stream_mapalgo = 'bilinear', & - stream_offset = 0, & - stream_taxmode = trim(taxmode), & - stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = trim(tintalgo), & - stream_name = 'CO2 forcing data ', & - rc = rc) - call chkrc(rc, sub//': error return from shr_strdata_init_from_inline') - - allocate( xin%co2flx(pcols,begchunk:endchunk) ) - - call co2_data_flux_advance(xin) - -end subroutine co2_data_flux_init - -!=============================================================================== -subroutine co2_data_flux_advance (xin) - -!------------------------------------------------------------------------------- -! Advance the contents of a co2_data_flux_type sdat (map and interpolate in time) -!------------------------------------------------------------------------------- - - use dshr_methods_mod , only : dshr_fldbun_getfldptr - use dshr_strdata_mod , only : shr_strdata_advance - use ppgrid , only : begchunk, endchunk - use phys_grid , only : get_ncols_p - use time_manager , only : get_curr_date - - ! Arguments - type(co2_data_flux_type), intent(inout) :: xin - - ! Local variables - integer :: icol,lchnk,g - 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 :: dataptr1d(:) - character(len=*), parameter :: subname = 'co2_data_flux_advance' - !---------------------------------------------------------------------------- - - - ! Advance sdat stream - call get_curr_date(year, mon, day, sec) - mcdate = year*10000 + mon*100 + day - call shr_strdata_advance(sdat_ndep, ymd=mcdate, tod=sec, logunit=iulog, istr='ndepdyn', 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 - call dshr_fldbun_getFldPtr(sdat_ndep%pstrm(1)%fldbun_model, stream_varlist_ndep(1), fldptr1=dataptr1d_nhx, 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 dshr_fldbun_getFldPtr(sdat_ndep%pstrm(1)%fldbun_model, stream_varlist_ndep(2), fldptr1=dataptr1d_noy, 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 lchnk = begchunk,endchunk - do icol = 1,get_ncols_p(lchnk) - xin%co2flx(icol,lchnk) = dataptr1d(g) - g = g + 1 - end do - end do - - end subroutine co2_data_flux_advance - -!=============================================================================== + subroutine co2_data_flux_init (input_file, input_meshfile, & + varname, year_first, year_last, year_align, tintalgo, taxmode, data_flux) + + !------------------------------------------------------------------------------- + ! Initialize co2_data_flux_type instance + ! including initial read of input and interpolation to the current timestep + !------------------------------------------------------------------------------- + + use ppgrid, only: begchunk, endchunk, pcols + use atm_shr, only: model_mesh, model_clock + use dshr_strdata_mod, only: shr_strdata_init_from_inline + + ! Arguments + character(len=*), intent(in) :: input_file ! assumes only one input file + character(len=*), intent(in) :: input_meshfile + character(len=*), intent(in) :: varname ! assume only one varname for sdat + integer, intent(in) :: year_first + integer, intent(in) :: year_last + integer, intent(in) :: year_align + character(len=*), intent(in) :: tintalgo + character(len=*), intent(in) :: taxmode + type(co2_data_flux_type), intent(inout) :: data_flux + + ! Local variables + integer :: rc + character(len=*), parameter :: subname = 'co2_data_flux_init' + !---------------------------------------------------------------------------- + + ! Initialize data_flux%sdat_co2 + call shr_strdata_init_from_inline(data_flux%sdat_co2, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = model_clock, & + model_mesh = model_mesh, & + stream_meshfile = trim(input_meshfile), & + stream_filenames = (/input_file/), & + stream_yearFirst = year_first, & + stream_yearLast = year_last, & + stream_yearAlign = year_align, & + stream_fldlistFile = (/varname/), & + stream_fldListModel = (/varname/), & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = trim(taxmode), & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = trim(tintalgo), & + stream_name = 'CO2 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 + + ! Initialize data_flux%varname + data_flux%varname = trim(varname) + + ! Initialize data_flux%co2flx + allocate( data_flux%co2flx(pcols,begchunk:endchunk) ) + + end subroutine co2_data_flux_init + + !=============================================================================== + subroutine co2_data_flux_advance (data_flux) + + !------------------------------------------------------------------------------- + ! Advance the contents of a co2_data_flux_type sdat (map and interpolate in time) + !------------------------------------------------------------------------------- + + use dshr_methods_mod , only : dshr_fldbun_getfldptr + use dshr_strdata_mod , only : shr_strdata_advance + use ppgrid , only : begchunk, endchunk + use phys_grid , only : get_ncols_p + use time_manager , only : get_curr_date + + ! Arguments + type(co2_data_flux_type), intent(inout) :: data_flux + + ! Local variables + integer :: icol,lchnk,g + 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) + integer :: rc + real(r8), pointer :: dataptr1d(:) + character(len=*), parameter :: subname = 'co2_data_flux_advance' + !---------------------------------------------------------------------------- + + ! Advance sdat stream + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + call shr_strdata_advance(data_flux%sdat_co2, ymd=mcdate, tod=sec, logunit=iulog, istr='co2_advance', 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 + call dshr_fldbun_getFldPtr(data_flux%sdat_co2%pstrm(1)%fldbun_model, data_flux%varname, fldptr1=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 lchnk = begchunk,endchunk + do icol = 1,get_ncols_p(lchnk) + data_flux%co2flx(icol,lchnk) = dataptr1d(g) + g = g + 1 + end do + end do + + end subroutine co2_data_flux_advance end module co2_data_flux From 8a8c1fbb108af461d8ea58de5982e1e16cbb859b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Nov 2025 22:32:24 +0100 Subject: [PATCH 08/31] addressed issues in the PR --- bld/namelist_files/namelist_definition.xml | 4 +- src/control/cam_esmf_mod.F90 | 133 ++ src/cpl/nuopc/atm_comp_nuopc.F90 | 13 +- src/cpl/nuopc/atm_import_export.F90 | 6 +- src/cpl/nuopc/atm_shr.F90 | 11 - src/cpl/nuopc/atm_stream_ndep.F90 | 2 +- src/physics/cam/nudging.F90 | 1966 +++++++++++--------- 7 files changed, 1203 insertions(+), 932 deletions(-) create mode 100644 src/control/cam_esmf_mod.F90 delete mode 100644 src/cpl/nuopc/atm_shr.F90 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 4739f6099c..c0888554b8 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1823,7 +1823,7 @@ Default: 0 Time interpolation algorithm to use for co2flux_ocn_file. Default: linear - Time extrapolation algorithm to use for co2flux_ocn_file. Default: cycle @@ -1858,7 +1858,7 @@ Default: 0 Time interpolation algorithm to use for co2flux_fuel_file. Default: linear - Time extrapolation algorithm to use for co2flux_fuel_file. Default: cycle diff --git a/src/control/cam_esmf_mod.F90 b/src/control/cam_esmf_mod.F90 new file mode 100644 index 0000000000..138ade6f4e --- /dev/null +++ b/src/control/cam_esmf_mod.F90 @@ -0,0 +1,133 @@ +module cam_esmf_mod + + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use ESMF , only : ESMF_Mesh, ESMF_Clock + use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_VMGetCurrent + use ESMF , only : ESMF_SUCCESS, ESMF_REDUCE_SUM + use nuopc_shr_methods , only : chkerr + use cam_abortutils , only : endrun + use error_messages , only : alloc_err + use cam_logfile , only : iulog + + implicit none + public + + type(ESMF_Mesh) , protected :: model_mesh ! model mesh + type(ESMF_Clock), protected :: model_clock ! model clock + + real(r8), allocatable, protected :: model_areas(:) + real(r8), allocatable, protected :: mesh_areas(:) + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!===================================================================== +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 + + !===================================================================== + subroutine cam_esmf_set_areas(model_areas_in, mesh_areas_in, rc) + + ! Arguments + real(r8), intent(in) :: model_areas_in(:) + real(r8), intent(in) :: mesh_areas_in(:) + integer , intent(out) :: rc + + ! Local variables + type(ESMF_VM) :: vm + integer :: locsize + integer :: ng + integer :: istat + real(r8) :: global_mesh_area(1) + real(r8) :: global_model_area(1) + real(r8) :: local_mesh_area(1) + real(r8) :: local_model_area(1) + !--------------------------------------- + + rc = ESMF_SUCCESS + + locsize = size(model_areas_in) + + allocate(model_areas(locsize), stat=istat) + call alloc_err(istat,'cam_esmf_set_areas','model_areas',locsize) + model_areas(:) = model_areas_in(:) + + allocate(mesh_areas(locsize), stat=istat) + call alloc_err(istat,'cam_esmf_set_areas','mesh_areas',locsize) + mesh_areas(:) = mesh_areas_in(:) + + ! Compare global sum of model_areas and mesh_areas + local_model_area(1) = 0._r8 + local_mesh_area(1) = 0._r8 + do ng = 1,locsize + local_model_area(1) = local_model_area(1) + model_areas(ng) + local_mesh_area(1) = local_mesh_area(1) + mesh_areas(ng) + end do + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMAllreduce(vm, senddata=local_model_area, recvdata=global_model_area, & + count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMAllreduce(vm, senddata=local_mesh_area, recvdata=global_mesh_area, & + count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + write(iulog,'(a,d13.5)') ' global mesh area = ',global_mesh_area(1) + write(iulog,'(a,d13.5)') ' global model area = ',global_model_area(1) + + end subroutine cam_esmf_set_areas + + !===================================================================== + subroutine cam_esmf_global_sum(fldname, flddata, rc) + + ! Arguments + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: flddata(:) + integer , intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + integer :: ng + real(r8) :: local_sum_model(1) + real(r8) :: global_sum_model(1) + real(r8) :: local_sum_mesh(1) + real(r8) :: global_sum_mesh(1) + !--------------------------------------- + + rc = ESMF_SUCCESS + + local_sum_model(1) = 0._r8 + local_sum_mesh(1) = 0._r8 + do ng=1,size(flddata) + local_sum_model(1) = local_sum_model(1) + flddata(ng) * model_areas(ng) + local_sum_mesh(1) = local_sum_mesh(1) + flddata(ng) * mesh_areas(ng) + end do + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_sum_model, recvdata=global_sum_model, & + count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_sum_mesh, recvdata=global_sum_mesh, & + count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + write(iulog,'(a)') 'Global sum for forcing field '//trim(fldname) + write(iulog,'(a,d13.5)') ' global sum with model areas = ',global_sum_model(1) + write(iulog,'(a,d13.5)') ' global sum with mesh areas = ',global_sum_mesh(1) + + end subroutine cam_esmf_global_sum + +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..3f15f92afa 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 @@ -622,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 cam_esmf_mod.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 @@ -760,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 ) diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index 0712fe40f6..2c26cda8e0 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -13,7 +13,7 @@ module atm_import_export use shr_mpi_mod , only : shr_mpi_min, shr_mpi_max use nuopc_shr_methods , only : chkerr use cam_logfile , only : iulog - use cam_history , only: outfld + use cam_history , only : outfld use spmd_utils , only : masterproc, mpicom use srf_field_check , only : set_active_Sl_ram1 use srf_field_check , only : set_active_Sl_fv @@ -27,6 +27,7 @@ module atm_import_export use atm_stream_ndep , only : ndep_stream_active use chemistry , only : chem_has_ndep_flx use cam_control_mod , only : aqua_planet, simple_phys + use cam_esmf_mod , only : cam_esmf_set_areas implicit none private ! except @@ -497,6 +498,9 @@ subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, singl end do deallocate(area) + call cam_esmf_set_areas(model_areas, mesh_areas, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine flux correction factors (module variables) do n = 1,numOwnedElements mod2med_areacor(n) = model_areas(n) / mesh_areas(n) 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..ced2ef57d2 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -4,8 +4,7 @@ module nudging ! Purpose: Implement Nudging of the model state of U,V,T,Q, and/or PS ! toward specified values from analyses. ! -! Authors: Patrick Callaghan (original) -! Mariana Vertenstein (2025) refactored for CDEPS capability +! Author: Patrick Callaghan ! ! Description: ! @@ -112,11 +111,19 @@ module nudging ! Nudge_Path - CHAR path to the analyses files. ! (e.g. '/glade/scratch/USER/inputdata/nudging/ERAI-Data/') ! -! Nudge_Filenames - CHAR array of analysis files +! 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_Times_Per_Day - INT Number of times to update the model state (used for nudging) +! 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) ! each day. The value is restricted to be longer than the -! current model timestep. As this number is increased, the nudging +! current model timestep and shorter than the analyses +! timestep. As this number is increased, the nudging ! force has the form of newtonian cooling. ! 48 --> 1800 Second timestep. ! 96 --> 900 Second timestep. @@ -124,22 +131,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] @@ -170,7 +177,6 @@ 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 @@ -188,17 +194,14 @@ 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, 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 + use shr_kind_mod, only: r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL + use time_manager, only: timemgr_time_ge, timemgr_time_inc, get_curr_date + use time_manager, only: get_step_size + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom, mpi_success + use spmd_utils, only: mpi_integer, mpi_real8, mpi_logical, mpi_character + use cam_logfile, only: iulog + use zonal_mean_mod, only: ZonalMean_t ! Set all Global values and routines to private by default ! and then explicitly set their exposure. @@ -206,84 +209,69 @@ module nudging implicit none private - public :: Nudge_Model + public :: Nudge_Model,Nudge_ON public :: nudging_readnl public :: nudging_init public :: nudging_timestep_init public :: nudging_timestep_tend - public :: nudging_final - + private :: nudging_update_analyses 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 - - integer, parameter :: maxfiles = 1000 - - logical, public :: Nudge_On = .false. + public :: nudging_final ! Nudging Parameters !-------------------- - 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 + logical :: Nudge_Model =.false. + logical :: Nudge_ON =.false. + logical :: Nudge_Initialized =.false. + character(len=cl) :: Nudge_Path + character(len=cs) :: Nudge_File,Nudge_File_Template + integer :: Nudge_Force_Opt + integer :: Nudge_TimeScale_Opt + integer :: Nudge_TSmode + integer :: Nudge_Times_Per_Day + integer :: Model_Times_Per_Day + real(r8) :: Nudge_Ucoef,Nudge_Vcoef + integer :: Nudge_Uprof,Nudge_Vprof + real(r8) :: Nudge_Qcoef,Nudge_Tcoef + integer :: Nudge_Qprof,Nudge_Tprof + real(r8) :: Nudge_PScoef + integer :: Nudge_PSprof + integer :: Nudge_Beg_Year ,Nudge_Beg_Month + integer :: Nudge_Beg_Day ,Nudge_Beg_Sec + integer :: Nudge_End_Year ,Nudge_End_Month + integer :: Nudge_End_Day ,Nudge_End_Sec + integer :: Nudge_Curr_Year,Nudge_Curr_Month + integer :: Nudge_Curr_Day ,Nudge_Curr_Sec + integer :: Nudge_Next_Year,Nudge_Next_Month + integer :: Nudge_Next_Day ,Nudge_Next_Sec + integer :: Nudge_Step + integer :: Model_Curr_Year,Model_Curr_Month + integer :: Model_Curr_Day ,Model_Curr_Sec + integer :: Model_Next_Year,Model_Next_Month + integer :: Model_Next_Day ,Model_Next_Sec + integer :: Model_Step + real(r8) :: Nudge_Hwin_lat0 + real(r8) :: Nudge_Hwin_latWidth + real(r8) :: Nudge_Hwin_latDelta + real(r8) :: Nudge_Hwin_lon0 + real(r8) :: Nudge_Hwin_lonWidth + real(r8) :: Nudge_Hwin_lonDelta + logical :: Nudge_Hwin_Invert = .false. + real(r8) :: Nudge_Hwin_lo + real(r8) :: Nudge_Hwin_hi + real(r8) :: Nudge_Vwin_Hindex + real(r8) :: Nudge_Vwin_Hdelta + real(r8) :: Nudge_Vwin_Lindex + real(r8) :: Nudge_Vwin_Ldelta + logical :: Nudge_Vwin_Invert =.false. + real(r8) :: Nudge_Vwin_lo + real(r8) :: Nudge_Vwin_hi + real(r8) :: Nudge_Hwin_latWidthH + real(r8) :: Nudge_Hwin_lonWidthH + real(r8) :: Nudge_Hwin_max + real(r8) :: Nudge_Hwin_min ! Nudging Zonal Filter variables !--------------------------------- @@ -295,40 +283,42 @@ 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) - ! Stream functionality - !----------------------- - type(shr_strdata_type) :: sdat_nudging_multi, sdat_nudging_singl - character(len=2) :: nudge_varlist_multi(4) = (/'U ', 'V ','T ','Q '/) - character(len=2) :: nudge_varlist_singl(1) = (/'PS'/) + ! 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) contains - !================================================================ subroutine nudging_readnl(nlfile) ! @@ -337,7 +327,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 !------------- @@ -346,84 +336,81 @@ subroutine nudging_readnl(nlfile) ! Local Values !--------------- integer :: ierr, unitn - integer :: nfile character(len=*), parameter :: prefix = 'nudging_readnl: ' - 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, & - Model_Update_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, & + namelist /nudging_nl/ Nudge_Model, Nudge_Path, & + Nudge_File_Template, Nudge_Force_Opt, & + Nudge_TimeScale_Opt, & + Nudge_Times_Per_Day, Model_Times_Per_Day, & + Nudge_Ucoef , Nudge_Uprof, & + Nudge_Vcoef , Nudge_Vprof, & + Nudge_Qcoef , Nudge_Qprof, & + Nudge_Tcoef , Nudge_Tprof, & + Nudge_PScoef, Nudge_PSprof, & + Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & + Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & + Nudge_Hwin_lat0, Nudge_Hwin_lon0, & + Nudge_Hwin_latWidth, Nudge_Hwin_lonWidth, & + Nudge_Hwin_latDelta, Nudge_Hwin_lonDelta, & + Nudge_Hwin_Invert, & + Nudge_Vwin_Lindex, Nudge_Vwin_Hindex, & + Nudge_Vwin_Ldelta, Nudge_Vwin_Hdelta, & Nudge_Vwin_Invert ! 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_Beg_Sec = 0 - Nudge_End_Sec = 0 + Nudge_ON =.false. + Nudge_Beg_Sec=0 + Nudge_End_Sec=0 ! Set Default Namelist values !----------------------------- - Nudge_Model = .false. - Model_Update_Times_Per_Day = 4 - Nudge_File_Times_per_Day = 4 - 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_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 + Nudge_Model = .false. + Nudge_Path = './Data/YOTC_ne30np4_001/' + Nudge_File_Template = 'YOTC_ne30np4_L30.cam2.i.%y-%m-%d-%s.nc' + Nudge_Force_Opt = 0 + Nudge_TimeScale_Opt = 0 + Nudge_TSmode = 0 + Nudge_Times_Per_Day = 4 + Model_Times_Per_Day = 4 + Nudge_Ucoef = 0._r8 + Nudge_Vcoef = 0._r8 + Nudge_Qcoef = 0._r8 + Nudge_Tcoef = 0._r8 + Nudge_PScoef = 0._r8 + Nudge_Uprof = 0 + Nudge_Vprof = 0 + Nudge_Qprof = 0 + Nudge_Tprof = 0 + Nudge_PSprof = 0 + Nudge_Beg_Year = 2008 + Nudge_Beg_Month = 5 + Nudge_Beg_Day = 1 + Nudge_End_Year = 2008 + Nudge_End_Month = 9 + Nudge_End_Day = 1 + Nudge_Hwin_lat0 = 0._r8 + Nudge_Hwin_latWidth = 9999._r8 + Nudge_Hwin_latDelta = 1.0_r8 + Nudge_Hwin_lon0 = 180._r8 + Nudge_Hwin_lonWidth = 9999._r8 + Nudge_Hwin_lonDelta = 1.0_r8 + Nudge_Hwin_Invert = .false. + Nudge_Hwin_lo = 0.0_r8 + Nudge_Hwin_hi = 1.0_r8 + Nudge_Vwin_Hindex = float(pver+1) + Nudge_Vwin_Hdelta = 0.001_r8 + Nudge_Vwin_Lindex = 0.0_r8 + Nudge_Vwin_Ldelta = 0.001_r8 + Nudge_Vwin_Invert = .false. + Nudge_Vwin_lo = 0.0_r8 + Nudge_Vwin_hi = 1.0_r8 ! Read in namelist values !------------------------ @@ -439,131 +426,6 @@ subroutine nudging_readnl(nlfile) close(unitn) end if - ! 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') - - 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') - - 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') - - 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 @@ -624,6 +486,104 @@ subroutine nudging_readnl(nlfile) write(iulog,*) 'NUDGING: Nudge_Hwin_lonWidth=',Nudge_Hwin_lonWidth 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 !------------ @@ -647,23 +607,26 @@ 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 :: Model_Update_Step - integer :: lchnk,ncol,icol,ilev - integer :: istat, ierr, rc - integer :: dtime - real(r8) :: rlat,rlon - real(r8) :: Wprof(pver) - real(r8) :: lonp,lon0,lonn,latp,lat0,latn - real(r8) :: Val1_p,Val2_p,Val3_p,Val4_p - real(r8) :: Val1_0,Val2_0,Val3_0,Val4_0 - real(r8) :: Val1_n,Val2_n,Val3_n,Val4_n - integer :: nn + integer :: Year,Month,Day,Sec + integer :: YMD1,YMD + logical :: After_Beg,Before_End + integer :: istat,lchnk,ncol,icol,ilev + integer :: hdim1_d,hdim2_d + integer :: ierr + integer :: dtime + real(r8) :: rlat,rlon + real(r8) :: Wprof(pver) + real(r8) :: lonp,lon0,lonn,latp,lat0,latn + real(r8) :: Val1_p,Val2_p,Val3_p,Val4_p + real(r8) :: Val1_0,Val2_0,Val3_0,Val4_0 + real(r8) :: Val1_n,Val2_n,Val3_n,Val4_n + integer :: nn + character(len=*), parameter :: prefix = 'nudging_init: ' - character(len=*), parameter :: sub = "(nudging_init) " + + ! Get the time step size + !------------------------ + dtime = get_step_size() ! Allocate Space for Nudging data arrays !----------------------------------------- @@ -729,129 +692,143 @@ 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. - !-------------------------------------------------------- - - ! 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,*) ' ' - write(iulog,*) 'NUDGING: Model_Update_Step cannot be less than a model timestep' - write(iulog,*) 'NUDGING: Setting Model_Update_Step=dtime , dtime=',dtime - write(iulog,*) ' ' - Model_Update_Step = dtime - endif - 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 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, & - 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_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') - - ! Initialize the time relative to the nudging window - !------------------------------------------------ - - 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_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') - - elseif (.not.After_Beg) then - - ! Set Time indicies to Nudging start so next call to timestep_init will initialize the Model_Update_Next_time - call ESMF_TimeSet(Model_Update_next_time, & - yy=Nudge_Beg_Year, mm=Nudge_Beg_Month, dd=Nudge_Beg_Day, s=Nudge_Beg_Sec, rc=rc) - call chkrc(rc, 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') - ! 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 + !----------------------------------------- + ! Values initialized only by masterproc + !----------------------------------------- + if(masterproc) then - ! 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: never occur for the given time values' - write(iulog,*) ' ' + ! 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 - 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 - ! 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), & + ! 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. + ! 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. - if (masterproc) then + ! Initialization is done, + !-------------------------- + Nudge_Initialized = .true. ! Informational Output !--------------------------- @@ -859,111 +836,224 @@ 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_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,*) '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,*) ' ' 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. + !---------------------------------------------------------- + call nudging_update_analyses (trim(Nudge_Path)//trim(Nudge_File)) + ! Initialize Nudging Coeffcient profiles in local arrays ! Load zeros into nudging arrays !------------------------------------------------------ - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - do icol = 1,ncol - rlat = get_rlat_p(lchnk,icol)*180._r8/SHR_CONST_PI - rlon = get_rlon_p(lchnk,icol)*180._r8/SHR_CONST_PI + 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_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 + 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 @@ -977,34 +1067,40 @@ 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 !----------- - 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 :: 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 - logical :: first_call = .true. - character(len=*), parameter :: sub = "(nudging_timestep_init) " - !-------------------------------------------------------------- + integer :: nn + integer :: kk + real(r8) :: Sbar,Qbar,Wsum + integer :: dtime ! Check if Nudging is initialized !--------------------------------- @@ -1012,86 +1108,94 @@ subroutine nudging_timestep_init(phys_state) call endrun('nudging_timestep_init:: Nudging NOT Initialized') endif - !------------------------------------------------------- - ! Determine if the current CAM time is AFTER the begining nudging time - ! and if it is BEFORE the ending nudging time. - !------------------------------------------------------- + ! Get time step size + !-------------------- + dtime = get_step_size() - ! Get Current CAM time + ! Get Current time + !-------------------- call get_curr_date(Year,Month,Day,Sec) + YMD=(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') - - After_Beg = (curr_time >= Nudge_beg_time) - Before_End = (curr_time <= Nudge_end_time) + !------------------------------------------------------- + ! Determine if the current time is AFTER the begining time + ! and if it is BEFORE the ending time. + !------------------------------------------------------- + YMD1=(Nudge_Beg_Year*10000) + (Nudge_Beg_Month*100) + Nudge_Beg_Day + call timemgr_time_ge(YMD1,Nudge_Beg_Sec, & + YMD ,Sec ,After_Beg) - !---------------------------------------------------------------- - ! 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 + YMD1=(Nudge_End_Year*10000) + (Nudge_End_Month*100) + Nudge_End_Day + call timemgr_time_ge(YMD ,Sec, & + YMD1,Nudge_End_Sec,Before_End) !-------------------------------------------------------------- - ! When past the NEXT nudge time, update model + ! When past the NEXT time, Update Model Arrays and time indices !-------------------------------------------------------------- + YMD1=(Model_Next_Year*10000) + (Model_Next_Month*100) + Model_Next_Day + call timemgr_time_ge(YMD1,Model_Next_Sec, & + YMD ,Sec ,Update_Model) - 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 - + if((Before_End) .and. (Update_Model)) then ! Increment the Model times by the current interval - Model_Update_next_time = Model_Update_next_time + Model_Update_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) ! 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' + ! time to a Model_Step after the current time. + !-------------------------------------------------------------- + call timemgr_time_ge(YMD2,Model_Next_Sec, & + YMD ,Sec ,Sync_Error) + if(Sync_Error) then + Model_Curr_Year =Year + Model_Curr_Month=Month + Model_Curr_Day =Day + Model_Curr_Sec =Sec + call timemgr_time_inc(YMD ,Model_Curr_Sec, & + YMD2,Model_Next_Sec,Model_Step,0,0) + write(iulog,*) 'NUDGING: WARNING - Model_Time Sync ERROR... CORRECTED' endif + Model_Next_Year =(YMD2/10000) + YMD2 = YMD2-(Model_Next_Year*10000) + Model_Next_Month=(YMD2/100) + Model_Next_Day = YMD2-(Model_Next_Month*100) ! 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 - ! 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) + ! 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 - ! Calculate DSE from Temperature, Water Vapor, and Surface Pressure - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol + ! 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 @@ -1116,77 +1220,201 @@ 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 - !------------------------------------------------------- - ! HERE Implement time dependence of Nudging Coefs HERE - !------------------------------------------------------- + !---------------------------------------------------------------- + ! 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) - ! Using CDEPS: - ! Read new nudging data and interpolate to model grid and Model_Update_Time + if((Before_End) .and. (Update_Nudge)) then + ! Increment the Nudge times by the current interval !--------------------------------------------------- - call nudging_stream_interp() + Nudge_Curr_Year =Nudge_Next_Year + Nudge_Curr_Month=Nudge_Next_Month + Nudge_Curr_Day =Nudge_Next_Day + Nudge_Curr_Sec =Nudge_Next_Sec + YMD1=(Nudge_Curr_Year*10000) + (Nudge_Curr_Month*100) + Nudge_Curr_Day + call timemgr_time_inc(YMD1,Nudge_Curr_Sec, & + YMD2,Nudge_Next_Sec,Nudge_Step,0,0) + Nudge_Next_Year =(YMD2/10000) + YMD2 = YMD2-(Nudge_Next_Year*10000) + Nudge_Next_Month=(YMD2/100) + Nudge_Next_Day = YMD2-(Nudge_Next_Month*100) + + ! Set the analysis filename at the NEXT time. + !--------------------------------------------------------------- + Nudge_File=interpret_filename_spec(Nudge_File_Template , & + yr_spec=Nudge_Next_Year , & + mon_spec=Nudge_Next_Month, & + day_spec=Nudge_Next_Day , & + sec_spec=Nudge_Next_Sec ) + if(masterproc) then + write(iulog,*) 'NUDGING: Reading analyses:',trim(Nudge_Path)//trim(Nudge_File) + endif + + ! Rotate Nudge_ObsInd() indices for new data, then update + ! the Nudge observation arrays with analysis data at the + ! NEXT==Nudge_ObsInd(1) time. + !---------------------------------------------------------- + call nudging_update_analyses (trim(Nudge_Path)//trim(Nudge_File)) + endif ! ((Before_End) .and. (Update_Nudge)) then + + !---------------------------------------------------------------- + ! Toggle Nudging flag when the time interval is between + ! beginning and ending times, and all of the analyses files exist. + !---------------------------------------------------------------- + if((After_Beg) .and. (Before_End)) then + if(Nudge_Force_Opt == 0) then + ! Verify that the NEXT analyses are available + !--------------------------------------------- + Nudge_ON=Nudge_File_Present(Nudge_ObsInd(1)) + elseif(Nudge_Force_Opt == 1) then + ! Verify that the CURR and NEXT analyses are available + !----------------------------------------------------- + Nudge_ON=(Nudge_File_Present(Nudge_ObsInd(1)) .and. & + Nudge_File_Present(Nudge_ObsInd(2)) ) + else + ! Verify that the ALL analyses are available + !--------------------------------------------- + Nudge_ON=.true. + do nn=1,Nudge_NumObs + if(.not.Nudge_File_Present(nn)) Nudge_ON=.false. + end do + endif + if(.not.Nudge_ON) then + if(masterproc) then + write(iulog,*) 'NUDGING: WARNING - analyses file NOT FOUND. Switching ' + write(iulog,*) 'NUDGING: nudging OFF to coast thru the gap. ' + endif + endif + else + Nudge_ON=.false. + endif + + !------------------------------------------------------- + ! HERE Implement time dependence of Nudging Coefs HERE + !------------------------------------------------------- + + + !--------------------------------------------------- + ! If Data arrays have changed update stepping arrays + !--------------------------------------------------- + if((Before_End) .and. ((Update_Nudge) .or. (Update_Model))) then + + ! Now Load the Target values for nudging tendencies + !--------------------------------------------------- + if(Nudge_Force_Opt == 0) then + ! Target is OBS data at NEXT time + !---------------------------------- + do lchnk=begchunk,endchunk + ncol=phys_state(lchnk)%ncol + Target_U(:ncol,:pver,lchnk)=Nobs_U(:ncol,:pver,lchnk,Nudge_ObsInd(1)) + Target_V(:ncol,:pver,lchnk)=Nobs_V(:ncol,:pver,lchnk,Nudge_ObsInd(1)) + Target_T(:ncol,:pver,lchnk)=Nobs_T(:ncol,:pver,lchnk,Nudge_ObsInd(1)) + Target_Q(:ncol,:pver,lchnk)=Nobs_Q(:ncol,:pver,lchnk,Nudge_ObsInd(1)) + Target_PS(:ncol ,lchnk)=Nobs_PS(:ncol ,lchnk,Nudge_ObsInd(1)) + end do + elseif(Nudge_Force_Opt == 1) then + ! Target is linear interpolation of OBS data CURR<-->NEXT time + !--------------------------------------------------------------- + call ESMF_TimeSet(Date1,YY=Year,MM=Month,DD=Day,S=Sec) + call ESMF_TimeSet(Date2,YY=Nudge_Next_Year,MM=Nudge_Next_Month, & + DD=Nudge_Next_Day , S=Nudge_Next_Sec ) + DateDiff =Date2-Date1 + call ESMF_TimeIntervalGet(DateDiff,S=DeltaT,rc=rc) + Tfrac= float(DeltaT)/float(Nudge_Step) + do lchnk=begchunk,endchunk + ncol=phys_state(lchnk)%ncol + Target_U(:ncol,:pver,lchnk)=(1._r8-Tfrac)*Nobs_U(:ncol,:pver,lchnk,Nudge_ObsInd(1)) & + +Tfrac *Nobs_U(:ncol,:pver,lchnk,Nudge_ObsInd(2)) + Target_V(:ncol,:pver,lchnk)=(1._r8-Tfrac)*Nobs_V(:ncol,:pver,lchnk,Nudge_ObsInd(1)) & + +Tfrac *Nobs_V(:ncol,:pver,lchnk,Nudge_ObsInd(2)) + Target_T(:ncol,:pver,lchnk)=(1._r8-Tfrac)*Nobs_T(:ncol,:pver,lchnk,Nudge_ObsInd(1)) & + +Tfrac *Nobs_T(:ncol,:pver,lchnk,Nudge_ObsInd(2)) + Target_Q(:ncol,:pver,lchnk)=(1._r8-Tfrac)*Nobs_Q(:ncol,:pver,lchnk,Nudge_ObsInd(1)) & + +Tfrac *Nobs_Q(:ncol,:pver,lchnk,Nudge_ObsInd(2)) + Target_PS(:ncol ,lchnk)=(1._r8-Tfrac)*Nobs_PS(:ncol ,lchnk,Nudge_ObsInd(1)) & + +Tfrac *Nobs_PS(:ncol ,lchnk,Nudge_ObsInd(2)) + end do + else + write(iulog,*) 'NUDGING: Unknown Nudge_Force_Opt=',Nudge_Force_Opt + call endrun('nudging_timestep_init:: ERROR unknown Nudging_Force_Opt') + endif ! Now load Dry Static Energy values for Target !--------------------------------------------- - if (Nudge_TSmode == 0) then - ! Calculate DSE from Temperature only - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - Target_S(:ncol,:pver,lchnk) = cpair*Target_T(:ncol,:pver,lchnk) + 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) end do - else if(Nudge_TSmode == 1) then - ! Calculate DSE from Temperature, Water Vapor, and Surface Pressure - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - call calc_DryStaticEnergy(Target_T(:,:,lchnk), Target_Q(:,:,lchnk), & - phys_state(lchnk)%phis, Target_PS(:,lchnk), Target_S(:,:,lchnk), ncol) - end do endif ! 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) - + elseif(Nudge_TimeScale_Opt == 1) then + call ESMF_TimeSet(Date1,YY=Year,MM=Month,DD=Day,S=Sec) + call ESMF_TimeSet(Date2,YY=Nudge_Next_Year,MM=Nudge_Next_Month, & + DD=Nudge_Next_Day , S=Nudge_Next_Sec ) + DateDiff =Date2-Date1 + call ESMF_TimeIntervalGet(DateDiff,S=DeltaT,rc=rc) + Tscale=float(Nudge_Step)/float(DeltaT) else - - if (masterproc) then - write(iulog,*) 'NUDGING: Unknown Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt - end if + write(iulog,*) 'NUDGING: Unknown Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt 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)) & + 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)) & + 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 - endif ! ((Before_End) .and. Update_Model) + !****************** + ! 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 ! End Routine !------------ @@ -1224,19 +1452,18 @@ 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 - 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) - + 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) @@ -1249,6 +1476,159 @@ 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) @@ -1275,33 +1655,31 @@ 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 @@ -1310,12 +1688,13 @@ 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 @@ -1323,28 +1702,27 @@ 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 @@ -1358,30 +1736,38 @@ 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) + 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) call ZM%final() @@ -1520,250 +1906,4 @@ 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_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') - - end subroutine nudging_stream_init - !================================================================ - - - !================================================================ - subroutine nudging_stream_interp() - - ! 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 - - ! 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 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 - 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 - if ( trim(nudge_varlist_multi(nvar)) == 'U' .or. & - trim(nudge_varlist_multi(nvar)) == 'V' .or. & - trim(nudge_varlist_multi(nvar)) == 'T' .or. & - trim(nudge_varlist_multi(nvar)) == 'Q' ) then - - call dshr_fldbun_getFldPtr(sdat_nudging_multi%pstrm(1)%fldbun_model, & - nudge_varlist_multi(nvar), fldptr2=dataptr2d, rc=rc) - call chkrc(rc, sub//': error return from shr_strdata_advance') - - ! Obtain TMP3d - 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 - end do - end do - end do - - ! Apply zonal mean filtering - if (Nudge_ZonalFilter) then - call ZM%calc_amps(Tmp3D, Zonal_Bamp3d) - call ZM%eval_grid(Zonal_Bamp3d, Tmp3D) - endif - - ! Determine output variables - if (trim(nudge_varlist_multi(nvar)) == 'U') then - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - Target_U(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) - end do - else if (trim(nudge_varlist_multi(nvar)) == 'V') then - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - Target_V(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) - end do - else if (trim(nudge_varlist_multi(nvar)) == 'T') then - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - Target_T(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) - end do - else if (trim(nudge_varlist_multi(nvar)) == 'Q') then - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - Target_Q(:ncol,:pver,lchnk) = Tmp3d(:ncol,:pver,lchnk) - end do - end if - end if - end do - - ! Obtain Target_PS - - call dshr_fldbun_getFldPtr(sdat_nudging_singl%pstrm(1)%fldbun_model, 'PS', fldptr1=dataptr1d, rc=rc) - call chkrc(rc, 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 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') - end subroutine chkrc - end module nudging From 3c642b528a81e1a901a2b84345b0d5bf2e6cf6a1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Nov 2025 22:35:44 +0100 Subject: [PATCH 09/31] more updates --- src/physics/cam/co2_data_flux.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 index 2438f45516..7bc2546c31 100644 --- a/src/physics/cam/co2_data_flux.F90 +++ b/src/physics/cam/co2_data_flux.F90 @@ -26,6 +26,8 @@ module co2_data_flux real(r8), pointer :: co2flx(:,:) ! Interpolated output (pcols,begchunk:endchunk) end type co2_data_flux_type + logical :: debug = .false. + !=============================================================================== contains !=============================================================================== @@ -39,7 +41,7 @@ subroutine co2_data_flux_init (input_file, input_meshfile, & !------------------------------------------------------------------------------- use ppgrid, only: begchunk, endchunk, pcols - use atm_shr, only: model_mesh, model_clock + use cam_esmf_mod, only: model_mesh, model_clock use dshr_strdata_mod, only: shr_strdata_init_from_inline ! Arguments @@ -73,7 +75,7 @@ subroutine co2_data_flux_init (input_file, input_meshfile, & stream_fldlistFile = (/varname/), & stream_fldListModel = (/varname/), & stream_lev_dimname = 'null', & - stream_mapalgo = 'bilinear', & + stream_mapalgo = 'consf', & stream_offset = 0, & stream_taxmode = trim(taxmode), & stream_dtlimit = 1.0e30_r8, & @@ -104,6 +106,7 @@ subroutine co2_data_flux_advance (data_flux) use ppgrid , only : begchunk, endchunk use phys_grid , only : get_ncols_p use time_manager , only : get_curr_date + use cam_esmf_mod , only : cam_esmf_global_sum ! Arguments type(co2_data_flux_type), intent(inout) :: data_flux @@ -134,6 +137,13 @@ subroutine co2_data_flux_advance (data_flux) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if + if (debug) then + call cam_esmf_global_sum(trim(data_flux%varname), dataptr1d, 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 if + g = 1 do lchnk = begchunk,endchunk do icol = 1,get_ncols_p(lchnk) From 2fc073474fcb626e12000d6c7c55beb596a7c012 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 26 Nov 2025 09:57:22 +0100 Subject: [PATCH 10/31] added aircraft emissions to this PR and also addressed more issues raised in the PR review --- bld/namelist_files/namelist_defaults_cam.xml | 72 +- bld/namelist_files/namelist_definition.xml | 99 +- src/chemistry/utils/aircraft_emit.F90 | 1060 ++++++++++-------- src/chemistry/utils/tracer_data.F90 | 118 +- src/control/cam_esmf_mod.F90 | 57 +- src/cpl/nuopc/atm_comp_nuopc.F90 | 6 +- src/physics/cam/co2_cycle.F90 | 8 +- src/utils/ioFileMod.F90 | 60 +- 8 files changed, 887 insertions(+), 593 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 75983f00d8..803d844a30 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -659,31 +659,56 @@ atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc +linear +extend +2000 +2000 +1 +1850 +1850 +1 +1850 +2015 +1850 +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc - -ac_CO2_filelist_175001-201512_fv_0.9x1.25_c20181011.txt -ac_CO2_filelist_175001-201512_fv_1.9x2.5_c20181011.txt -ac_CO2_filelist_175001-201512_fv_0.9x1.25_c20181011.txt -ac_CO2_filelist_175001-201512_fv_0.9x1.25_c20181011.txt -ac_CO2_filelist_175001-201512_fv_0.9x1.25_c20181011.txt -ac_CO2_filelist_175001-201512_fv_1.9x2.5_c20181011.txt -ac_CO2_filelist_175001-201512_fv_1.9x2.5_c20181011.txt -atm/cam/ggas -SERIAL - -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc + + +linear +extend +2000 +2000 +1 +1850 +1850 +1 +1850 +2015 +1850 + + +2000 +2000 +1 +1850 +1850 +1 +1850 +2015 +1850 +atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc atm/cam/ggas/noaamisc.r8.nc @@ -2026,7 +2051,6 @@ share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc - lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc lnd/clm2/ndepdata/fndep_clm_WACCM6_CMIP6piControl001_y21-50avg_1850monthly_0.95x1.25_c180802.nc diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index c0888554b8..f605f29732 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -6992,35 +6992,98 @@ Full pathname of dataset of O2 and 03 column densities above the model for look- Default: set by build-namelist. - -Filename of file that contains aircraft input file lists. The filenames in the files are relative -to the directory specified by {{ hilight }}aircraft_datapath{{ closehilight }}. +Field name on the aircraft_datafile (default is ac_CO2). Default: set by build-namelist. - - -Full pathname of the directory that contains the files specified in -{{ hilight }}aircraft_specifier{{ closehilight }}. +Full pathname of the data file containing ac_CO2 (by default). Default: set by build-namelist. - - -Type of time interpolation for data in aircraft aerosol files. -Default: 'CYCLICAL_LIST' + +Full pathname of the ESMF mesh file corresponding to aircraft_datafile. +Default: set by build-namelist + + +First year of the aircraft_datafile to use. +Default: set by build-namelist + + +Last year of the aircraft_datafile to use. +Default: set by build-namelist + + +Model year that aligns with aircraft_year_first. +Default: set by build-namelist - -Full pathname of the ac_CO2 file specified in the filelist in -{{ hilight }}aircraft_specifier{{ closehilight }}. This is only to -get this name into the cam.input_data_list for the CESM scripts. + +Field name on the aircraft_datafile (default is ac_H2O). Default: set by build-namelist. + +Full pathname of the data file containing ac_H2O (by default). +Default: set by build-namelist. + + +Full pathname of the ESMF mesh file corresponding to aircraft_datafile. +Default: set by build-namelist + + +First year of the aircraft_datafile to use. +Default: set by build-namelist + + +Last year of the aircraft_datafile to use. +Default: set by build-namelist + + +Model year that aligns with aircraft_year_first. +Default: set by build-namelist + - + +Field name on the aircraft_datafile (default is ac_SLANT_DIST). +Default: set by build-namelist. + + +Full pathname of the data file containing ac_SLANT_DIST (by default). +Default: set by build-namelist. + + +Full pathname of the ESMF mesh file corresponding to aircraft_datafile. +Default: set by build-namelist + + +First year of the aircraft_datafile to use. +Default: set by build-namelist + + +Last year of the aircraft_datafile to use. +Default: set by build-namelist + + +Model year that aligns with aircraft_year_first. +Default: set by build-namelist + diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index f2a242aa63..b51058ddb3 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -1,458 +1,632 @@ module aircraft_emit -!----------------------------------------------------------------------- -! -! Purpose: -! Manages reading and interpolation of aircraft aerosols -! -! Authors: Chih-Chieh (Jack) Chen and Cheryl Craig -- February 2010 -! -!----------------------------------------------------------------------- - use perf_mod, only : t_startf, t_stopf - - use shr_kind_mod, only : r8 => shr_kind_r8 - use cam_abortutils, only : endrun - use spmd_utils, only : masterproc - use tracer_data, only : trfld, trfile - use cam_logfile, only : iulog - - implicit none - private - save - - public :: aircraft_emit_init - public :: aircraft_emit_adv - public :: aircraft_emit_register - public :: aircraft_emit_readnl - public :: get_aircraft - - type :: forcing_air - real(r8) :: mw - character(len=256) :: filelist - character(len=256) :: filename - real(r8), pointer :: times(:) - real(r8), pointer :: levi(:) - character(len=11) :: species - character(len=8) :: units - integer :: nsectors - character(len=32),pointer :: sectors(:) - type(trfld),pointer :: fields(:) - type(trfile) :: file - end type forcing_air - - type(forcing_air),allocatable :: forcings_air(:) - - integer, parameter :: N_AERO = 13 - character(len=13) :: aero_names(N_AERO) = (/'ac_SLANT_DIST','ac_TRACK_DIST','ac_HC ','ac_NOX ','ac_PMNV ',& - 'ac_PMSO ','ac_PMFO ','ac_FUELBURN ','ac_CO2 ','ac_H2O ',& - 'ac_SOX ','ac_CO ','ac_BC '/) - - real(r8), parameter :: molmass(N_AERO) = 1._r8 - - logical :: advective_tracer(N_AERO) = .false. - character(len=3) :: mixtype(N_AERO) = 'wet' - - real(r8) :: cptmp = 666.0_r8 - real(r8) :: qmin = 0.0_r8 - logical :: cam_outfld = .false. - - integer :: index_map(N_AERO) - character(len=256) :: air_specifier(N_AERO)='' - character(len=256) :: air_datapath='' - character(len=24) :: air_type = 'CYCLICAL_LIST' ! 'CYCLICAL_LIST' - - logical :: rmv_file = .false. - - integer :: number_flds - - integer :: aircraft_cnt = 0 - character(len=16) :: spc_name_list(N_AERO) - character(len=256) :: spc_flist(N_AERO),spc_fname(N_AERO) - logical :: dist(N_AERO) - + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Manages reading and interpolation of aircraft aerosols + ! + ! Authors: Chih-Chieh (Jack) Chen and Cheryl Craig -- February 2010 + ! Refactored for CDEPS in line functionality -- November 2025 + ! + !----------------------------------------------------------------------- + + use perf_mod, only : t_startf, t_stopf + use shr_kind_mod, only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use cam_abortutils, only : endrun, handle_allocate_error + use cam_logfile, only : iulog + use spmd_utils, only : mpicom, masterprocid + use spmd_utils, only : mpi_integer, mpi_logical, mpi_character + use spmd_utils, only : masterproc, iam + use dshr_strdata_mod, only : shr_strdata_type + + implicit none + private + + public :: aircraft_emit_init + public :: aircraft_emit_adv + public :: aircraft_emit_register + public :: aircraft_emit_readnl + public :: get_aircraft + + integer, parameter :: N_AERO = 3 + character(len=13) :: aero_names(N_AERO) = & + (/'ac_CO2 ','ac_H2O ','ac_SLANT_DIST'/) + + type :: forcing_type + type(shr_strdata_type) :: sdat + character(len=cs) :: fldname = ' ' + character(len=cs) :: fldunits = 'units' + integer :: index_map = -1 + character(len=cl) :: datafile = ' ' + character(len=cl) :: meshfile = ' ' + character(len=cs) :: mapalgo = 'bilinear' + character(len=cs) :: tintalgo = 'lower' + integer :: year_first = -999 + integer :: year_last = -999 + integer :: year_align = -999 + integer :: nilev = -1 + real(r8), pointer :: altitude_int(:) + integer :: nlev = -1 + real(r8), pointer :: altitude_lev(:) + integer :: pbuf_index = -1 + end type forcing_type + type(forcing_type) :: forcing(N_AERO) + + real(r8), parameter :: molmass(N_AERO) = 1._r8 + character(*),parameter :: u_FILE_u = __FILE__ + +!============================================================================ contains - - subroutine get_aircraft(cnt, spc_name_list_out) - integer, intent(out) :: cnt - character(len=16), optional, intent(out) :: spc_name_list_out(N_AERO) - integer :: i - - spc_name_list_out = '' - - cnt = aircraft_cnt - if( cnt>0 ) then - do i=1,cnt - spc_name_list_out(i) = spc_name_list(i) - end do - end if - - end subroutine get_aircraft - - subroutine aircraft_emit_register() - -!------------------------------------------------------------------ -! **** Add the aircraft aerosol data to the physics buffer **** -!------------------------------------------------------------------ - use ppgrid, only: pver,pcols - use physics_buffer, only : pbuf_add_field, dtype_r8 - use tracer_data, only: incr_filename - use constituents, only: cnst_add - - integer :: i,idx, mm, ind, n - character(len=16) :: spc_name - character(len=256) :: filelist, curr_filename - character(len=128) :: long_name - logical :: has_fixed_ubc=.false. - logical :: read_iv=.false. - - !------------------------------------------------------------------ - ! Return if air_specifier is blank (no aircraft data to process) - !------------------------------------------------------------------ - dist(:) = .false. - aircraft_cnt = 0 - if (air_specifier(1) == "") return - -! count aircraft emission species used in the simulation - count_emis: do n=1,N_AERO - - if( len_trim(air_specifier(n) ) == 0 ) then - exit count_emis - endif - - i = scan(air_specifier(n),'->') - spc_name = trim(adjustl(air_specifier(n)(:i-1))) - filelist = trim(adjustl(air_specifier(n)(i+2:))) - - mm = get_aircraft_ndx(spc_name) - if( mm < 1 ) then - call endrun('aircraft_emit_register: '//trim(spc_name)//' is not in the aircraft emission dataset') - endif - - if (trim(spc_name) == 'ac_SLANT_DIST'.or. trim(spc_name) == 'ac_TRACK_DIST') dist(n) = .true. - - aircraft_cnt = aircraft_cnt + 1 - call pbuf_add_field(aero_names(mm),'physpkg',dtype_r8,(/pcols,pver/),idx) - - spc_flist(aircraft_cnt) = filelist - spc_name_list(aircraft_cnt) = spc_name - index_map(aircraft_cnt) = mm - - curr_filename='' - spc_fname(aircraft_cnt) = incr_filename( curr_filename, filenames_list=spc_flist(aircraft_cnt), & - datapath=air_datapath) - - if( advective_tracer(mm) ) then - long_name = 'aircraft_'//trim(spc_name) - call cnst_add(aero_names(mm),molmass(mm),cptmp,qmin,ind,longname=long_name,readiv=read_iv, & - mixtype=mixtype(mm),cam_outfld=cam_outfld,fixed_ubc=has_fixed_ubc) - endif - - enddo count_emis -! count aircraft emission species used in the simulation - - endsubroutine aircraft_emit_register - - subroutine aircraft_emit_init() -!------------------------------------------------------------------- -! **** Initialize the aircraft aerosol data handling **** -!------------------------------------------------------------------- - use cam_history, only: addfld, add_default - use tracer_data, only: trcdata_init - use phys_control, only: phys_getopts - - implicit none - - character(len=16) :: spc_name - - integer :: astat, m - - logical :: history_chemistry - - call phys_getopts(history_chemistry_out=history_chemistry) - - !------------------------------------------------------------------ - ! Return if aircraft_cnt is zero (no aircraft data to process) - !------------------------------------------------------------------ - if (aircraft_cnt == 0 ) return - - if (masterproc) write(iulog,*) ' ' - - !----------------------------------------------------------------------- - ! allocate forcings type array - !----------------------------------------------------------------------- - allocate( forcings_air(aircraft_cnt), stat=astat ) - if( astat/= 0 ) then - write(iulog,*) 'aircraft_emit_init: failed to allocate forcings_air array; error = ',astat - call endrun - end if - - !----------------------------------------------------------------------- - ! setup the forcings_air type array - !----------------------------------------------------------------------- - species_loop : do m = 1,aircraft_cnt - - allocate( forcings_air(m)%sectors(1), stat=astat ) - if( astat/= 0 ) then - write(iulog,*) 'aircraft_emit_init: failed to allocate forcings_air%sectors array; error = ',astat - call endrun - end if - - allocate( forcings_air(m)%fields(1), stat=astat ) - if( astat/= 0 ) then - write(iulog,*) 'aircraft_emit_init: failed to allocate forcings_air%fields array; error = ',astat - call endrun - end if - - spc_name = spc_name_list(m) - !----------------------------------------------------------------------- - ! default settings - !----------------------------------------------------------------------- - forcings_air(m)%file%stepTime = .true. ! Aircraft data is not to be interpolated in time - forcings_air(m)%file%cyclical_list = .true. ! Aircraft data cycles over the filename list - forcings_air(m)%file%weight_by_lat = .true. ! Aircraft data - interpolated with latitude weighting - forcings_air(m)%file%conserve_column = .true. ! Aircraft data - vertically interpolated to conserve the total column - forcings_air(m)%file%dist = dist(m) - forcings_air(m)%species = spc_name - forcings_air(m)%sectors = spc_name ! Only one species per file for aircraft data - forcings_air(m)%nsectors = 1 - forcings_air(m)%filelist = spc_flist(m) -! forcings_air(m)%file%curr_filename = spc_fname(m) - forcings_air(m)%filename = spc_fname(m) - end do species_loop - - if (masterproc) then - !----------------------------------------------------------------------- - ! diagnostics - !----------------------------------------------------------------------- - write(iulog,*) ' ' - write(iulog,*) 'aircraft_emit_init: diagnostics' - write(iulog,*) ' ' - write(iulog,*) 'aircraft_emit timing specs' - write(iulog,*) 'type = ',air_type - write(iulog,*) ' ' - write(iulog,*) 'there are ',aircraft_cnt,' species of aircraft emission' - do m = 1,aircraft_cnt - write(iulog,*) ' ' - write(iulog,*) 'forcing type ',m - write(iulog,*) 'species = ',trim(forcings_air(m)%species) - write(iulog,*) 'filelist= ',trim(forcings_air(m)%filelist) - end do - write(iulog,*) ' ' - endif - - !------------------------------------------------------------------ - ! Initialize the aircraft file processing - !------------------------------------------------------------------ - do m=1,aircraft_cnt - - allocate (forcings_air(m)%file%in_pbuf(size(forcings_air(m)%sectors))) - forcings_air(m)%file%in_pbuf(:) = .true. - call trcdata_init( forcings_air(m)%sectors, forcings_air(m)%filename, forcings_air(m)%filelist, air_datapath, & - forcings_air(m)%fields, forcings_air(m)%file, rmv_file, 0, 0, 0, air_type) - - - number_flds = 0 - if (associated(forcings_air(m)%fields)) number_flds = size( forcings_air(m)%fields ) - - if( number_flds < 1 ) then - if ( masterproc ) then - write(iulog,*) 'There are no aircraft aerosols' - write(iulog,*) ' ' - call endrun - endif - end if - - spc_name = spc_name_list(m) - call addfld( trim(spc_name), (/ 'lev' /), 'A', forcings_air(m)%fields(1)%units, & - 'aircraft emission '//trim(spc_name) ) - if (history_chemistry) then - call add_default( trim(spc_name), 1, ' ' ) - end if - end do - - - end subroutine aircraft_emit_init - - - - subroutine aircraft_emit_adv( state, pbuf2d) -!------------------------------------------------------------------- -! **** Advance to the next aircraft data **** -!------------------------------------------------------------------- - - use tracer_data, only : advance_trcdata - use physics_types,only : physics_state - use ppgrid, only : begchunk, endchunk - use ppgrid, only : pcols, pver - use string_utils, only : to_lower, GLC - use cam_history, only : outfld - use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole - use physconst, only : boltz ! J/K/molecule -! C.-C. Chen -! use physconst, only : gravit, rearth - use phys_grid, only : get_wght_all_p - - use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk - - implicit none - - type(physics_state), intent(in) :: state(begchunk:endchunk) - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - type(physics_buffer_desc), pointer :: pbuf_chnk(:) - integer :: ind,c,ncol,i,caseid,m,n - real(r8) :: to_mmr(pcols,pver) - real(r8),pointer :: tmpptr(:,:) - -! C.-C. Chen - real(r8) :: wght(pcols) - - !------------------------------------------------------------------ - ! Return if aircraft_cnt is zero (no aircraft data to process) - !------------------------------------------------------------------ - if (aircraft_cnt == 0 ) return - call t_startf('All_aircraft_emit_adv') - - !------------------------------------------------------------------- - ! For each field, read more data if needed and interpolate it to the current model time - !------------------------------------------------------------------- - do m = 1, aircraft_cnt - call advance_trcdata( forcings_air(m)%fields, forcings_air(m)%file, state, pbuf2d) - - !------------------------------------------------------------------- - ! set the tracer fields with the correct units - !------------------------------------------------------------------- - do i = 1,number_flds - -! C.-C. Chen, adding case 4 for kg/sec - select case ( to_lower(trim(forcings_air(m)%fields(i)%units(:GLC(forcings_air(m)%fields(i)%units)))) ) - case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") - caseid = 1 - case ('kg/kg','mmr') - caseid = 2 - case ('mol/mol','mole/mole','vmr','fraction') - caseid = 3 - case ('kg/kg/sec') - caseid = 4 - case ('kg m-2 s-1') - caseid = 5 - case ('m/sec' ) - caseid = 6 - case default - print*, 'aircraft_emit_adv: units = ',trim(forcings_air(m)%fields(i)%units) ,' are not recognized' - call endrun('aircraft_emit_adv: units are not recognized') - end select - - ind = index_map(i) - -!$OMP PARALLEL DO PRIVATE (C, NCOL, TO_MMR, tmpptr, pbuf_chnk) - do c = begchunk,endchunk - ncol = state(c)%ncol - -! C.-C. Chen, turning emission data to mixing ratio - call get_wght_all_p(c,ncol,wght(:ncol)) - - if (caseid == 1) then - to_mmr(:ncol,:) = (molmass(ind)*1.e6_r8*boltz*state(c)%t(:ncol,:))/(mwdry*state(c)%pmiddry(:ncol,:)) - elseif (caseid == 2) then - to_mmr(:ncol,:) = 1._r8 - elseif (caseid == 4) then -! do n=1,ncol -! to_mmr(n,:) = 1.0_r8/(rearth*rearth*wght(n)*state(c)%pdel(n,:)/gravit) -! end do - to_mmr(:ncol,:) = 1.0_r8 - elseif (caseid == 5) then - to_mmr(:ncol,:) = 1.0_r8 - elseif (caseid == 6) then - to_mmr(:ncol,:) = 1.0_r8 - else - to_mmr(:ncol,:) = molmass(ind)/mwdry - endif - pbuf_chnk => pbuf_get_chunk(pbuf2d, c) - call pbuf_get_field(pbuf_chnk, forcings_air(m)%fields(i)%pbuf_ndx, tmpptr ) - - tmpptr(:ncol,:) = tmpptr(:ncol,:)*to_mmr(:ncol,:) - - call outfld( forcings_air(m)%fields(i)%fldnam, & - tmpptr(:ncol,:), ncol, state(c)%lchnk ) - - enddo - enddo - enddo - - call t_stopf('All_aircraft_emit_adv') - end subroutine aircraft_emit_adv - - subroutine aircraft_emit_readnl(nlfile) -!------------------------------------------------------------------- -! **** Read in the aircraft_emit namelist ***** -!------------------------------------------------------------------- - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'aircraft_emit_readnl' - - character(len=256) :: aircraft_specifier(N_AERO) - character(len=256) :: aircraft_datapath - character(len=24) :: aircraft_type - - namelist /aircraft_emit_nl/ aircraft_specifier, aircraft_datapath, aircraft_type - !----------------------------------------------------------------------------- - - ! Initialize namelist variables from local module variables. - aircraft_specifier= air_specifier - aircraft_datapath = air_datapath - aircraft_type = air_type - - ! Read namelist - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'aircraft_emit_nl', status=ierr) - if (ierr == 0) then - read(unitn, aircraft_emit_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') +!============================================================================ + + subroutine aircraft_emit_readnl(nlfile) + + !------------------------------------------------------------------- + ! **** Read in the aircraft_emit namelist ***** + !------------------------------------------------------------------- + + use namelist_utils, only: find_group_name + + ! Arguments + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: nf, ni + integer :: index + integer :: unitn, ierr + character(len=cs) :: aircraft_co2_fldname = '' + character(len=cl) :: aircraft_co2_datafile = '' + character(len=cl) :: aircraft_co2_meshfile = '' + integer :: aircraft_co2_year_first = -999 + integer :: aircraft_co2_year_last = -999 + integer :: aircraft_co2_year_align = -999 + character(len=cs) :: aircraft_h2o_fldname = '' + character(len=cl) :: aircraft_h2o_datafile = '' + character(len=cl) :: aircraft_h2o_meshfile = '' + integer :: aircraft_h2o_year_first = -999 + integer :: aircraft_h2o_year_last = -999 + integer :: aircraft_h2o_year_align = -999 + character(len=cs) :: aircraft_slant_dist_fldname = '' + character(len=cl) :: aircraft_slant_dist_datafile = '' + character(len=cl) :: aircraft_slant_dist_meshfile = '' + integer :: aircraft_slant_dist_year_first = -999 + integer :: aircraft_slant_dist_year_last = -999 + integer :: aircraft_slant_dist_year_align = -999 + character(len=*), parameter :: subname = 'aircraft_emit_readnl' + + namelist /aircraft_emit_nl/ & + aircraft_co2_fldname, aircraft_co2_datafile, aircraft_co2_meshfile, & + aircraft_co2_year_first, aircraft_co2_year_last, aircraft_co2_year_align, & + aircraft_h2o_fldname, aircraft_h2o_datafile, aircraft_h2o_meshfile, & + aircraft_h2o_year_first, aircraft_h2o_year_last, aircraft_h2o_year_align, & + aircraft_slant_dist_fldname, aircraft_slant_dist_datafile, aircraft_slant_dist_meshfile, & + aircraft_slant_dist_year_first, aircraft_slant_dist_year_last, aircraft_slant_dist_year_align + !----------------------------------------------------------------------------- + + ! Read namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aircraft_emit_nl', status=ierr) + if (ierr == 0) then + read(unitn, aircraft_emit_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if end if + close(unitn) + + forcing(1)%fldname = aircraft_co2_fldname + forcing(1)%datafile = aircraft_co2_datafile + forcing(1)%meshfile = aircraft_co2_meshfile + forcing(1)%year_first = aircraft_co2_year_first + forcing(1)%year_last = aircraft_co2_year_last + forcing(1)%year_align = aircraft_co2_year_align + + forcing(2)%fldname = aircraft_h2o_fldname + forcing(2)%datafile = aircraft_h2o_datafile + forcing(2)%meshfile = aircraft_h2o_meshfile + forcing(2)%year_first = aircraft_h2o_year_first + forcing(2)%year_last = aircraft_h2o_year_last + forcing(2)%year_align = aircraft_h2o_year_align + + forcing(3)%fldname = aircraft_slant_dist_fldname + forcing(3)%datafile = aircraft_slant_dist_datafile + forcing(3)%meshfile = aircraft_slant_dist_meshfile + forcing(3)%year_first = aircraft_slant_dist_year_first + forcing(3)%year_last = aircraft_slant_dist_year_last + forcing(3)%year_align = aircraft_slant_dist_year_align end if - close(unitn) - call freeunit(unitn) - end if -#ifdef SPMD - ! Broadcast namelist variables - call mpibcast(aircraft_specifier,len(aircraft_specifier(1))*N_AERO, mpichar, 0, mpicom) - call mpibcast(aircraft_datapath, len(aircraft_datapath), mpichar, 0, mpicom) - call mpibcast(aircraft_type, len(aircraft_type), mpichar, 0, mpicom) -#endif + n_aero_loop: do nf = 1,N_AERO + ! Broadcast namelist variables + call mpi_bcast(forcing(nf)%fldname,len(forcing(nf)%fldname), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%fldname") + + if (forcing(nf)%fldname /= ' ') then + call mpi_bcast(forcing(nf)%datafile, len(forcing(nf)%datafile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%datapath") + call mpi_bcast(forcing(nf)%meshfile, len(forcing(nf)%meshfile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%meshfile") + call mpi_bcast(forcing(nf)%year_first, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_first") + call mpi_bcast(forcing(nf)%year_last, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_last") + call mpi_bcast(forcing(nf)%year_align, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") + + ! fill in forcing data type + if ( trim(forcing(nf)%fldname) == 'ac_SLANT_DIST') then + forcing(nf)%mapalgo = 'nn' + else + forcing(nf)%mapalgo = 'bilinear' + end if + forcing(nf)%tintalgo = 'lower' + + ! obtain index in aero_names module array + index = 0 + do ni = 1,size(aero_names) + if (trim(forcing(nf)%fldname) == trim(aero_names(ni))) then + index = ni + exit + endif + end do + if ( index < 1 ) then + call endrun('aircraft_emit_register: '//trim(forcing(nf)%fldname)//& + ' is not a supported aircraft emission field name') + endif + forcing(nf)%index_map = index + + ! diagnostics + if (masterproc) then + if (masterproc) write(iulog,*) ' ' + write(iulog,*) ' ' + write(iulog,'(a)' ) ' aircraft init settings for: '//trim(forcing(nf)%fldname) + write(iulog,'(a,a)') ' aircraft datafile = ',trim(forcing(nf)%datafile) + write(iulog,'(a,a)') ' aircraft meshfile = ',trim(forcing(nf)%meshfile) + write(iulog,'(a,a)') ' aircraft mapalgo = ',trim(forcing(nf)%mapalgo) + write(iulog,'(a,a)') ' aircraft tintalgo = ',trim(forcing(nf)%tintalgo) + write(iulog,'(a,i8)')' aircraft year_first = ',forcing(nf)%year_first + write(iulog,'(a,i8)')' aircraft year_last = ',forcing(nf)%year_last + write(iulog,'(a,i8)')' aircraft year_align = ',forcing(nf)%year_align + write(iulog,'(a,i8)')' aircraft index_map for '//trim(forcing(nf)%fldname)//' = ',forcing(nf)%index_map + write(iulog,*) ' ' + end if + end if + end do n_aero_loop + + end subroutine aircraft_emit_readnl + + !========================================================================= + subroutine aircraft_emit_register() + + !------------------------------------------------------------------ + ! **** Add the aircraft aerosol data to the physics buffer **** + !------------------------------------------------------------------ + use ppgrid, only: pver, pcols + use physics_buffer, only: pbuf_add_field, dtype_r8 + use constituents, only: cnst_add + + ! Local variables + integer :: i,idx, mm, ind, nf + integer :: ierr + !-------------------------------------------- + + do nf = 1,N_AERO + if (forcing(nf)%fldname /= ' ') then + ! Add fldname to pbuf and obtain pbuf_index + call pbuf_add_field(forcing(nf)%fldname, 'physpkg', dtype_r8, (/pcols,pver/), & + forcing(nf)%pbuf_index) + end if + end do + + end subroutine aircraft_emit_register + + !========================================================================= + subroutine aircraft_emit_init() + + !------------------------------------------------------------------- + ! **** Initialize the aircraft aerosol data handling **** + !------------------------------------------------------------------- + use cam_history, only: addfld, add_default + use phys_control, only: phys_getopts + use physics_buffer, only: pbuf_get_chunk, pbuf_get_index + use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile + use pio, only: file_desc_t, var_desc_t + use pio, only: pio_inq_varid, pio_get_att + use pio, only: PIO_NOERR, PIO_NOWRITE + + ! Local variables + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + integer :: ierr, rc + integer :: klev + integer :: nf + logical :: history_chemistry + character(len=3) :: mixtype(N_AERO) = 'wet' + character(len=*), parameter :: subname = 'aircraft_emit_init' + !----------------------------------------------- + + loop_n_aero: do nf = 1,N_AERO + if (forcing(nf)%fldname /= ' ') then + + ! Open file + if (masterproc) then + end if + call cam_pio_openfile( pioid, forcing(nf)%datafile, PIO_NOWRITE) + + ! Determine units + ierr = pio_inq_varid( pioid, forcing(nf)%fldname, varid ) + if (ierr/=pio_noerr) then + call endrun(trim(subname)//' Cannot find variable '//trim(forcing(nf)%fldname)// & + ' in file '//trim(forcing(nf)%datafile)) + endif + ierr = pio_get_att( pioid, varid, 'units', forcing(nf)%fldunits) + if (ierr/=pio_noerr) then + call endrun(trim(subname)//' Cannot get attribute units from '//trim(forcing(nf)%fldname)// & + ' in file '//trim(forcing(nf)%datafile)) + endif + + ! Determine vertical levels - altitude_int and altitude_lev + call get_vertical_dimension(fid=pioid, dname='altitude_int', dsize=forcing(nf)%nilev, data=forcing(nf)%altitude_int) + call get_vertical_dimension(fid=pioid, dname='altitude' , dsize=forcing(nf)%nlev , data=forcing(nf)%altitude_lev) + + ! Write out info to log file + if (masterproc) then + write(iulog,'(a)') trim(subname)// ' file: ',trim(forcing(nf)%datafile) + write(iulog,'(a)')' variable '//trim(forcing(nf)%fldname) + write(iulog,'(a)')' units '//trim(forcing(nf)%fldunits) + write(iulog,'(a)')' altitude levels ' + do klev=1,size(forcing(nf)%altitude_lev) + write(iulog,*)' ',klev,forcing(nf)%altitude_lev(klev) + end do + write(iulog,'(a)')' altitude interfaces ' + do klev=1,size(forcing(nf)%altitude_int) + write(iulog,*)' ',klev,forcing(nf)%altitude_int(klev) + end do + end if + + ! Close file + call cam_pio_closefile(pioid) + + ! Add field to cam history output + call addfld(trim(forcing(nf)%fldname), (/ 'lev' /), 'A', trim(forcing(nf)%fldunits), & + 'aircraft emission '//trim(forcing(nf)%fldname)) + call phys_getopts(history_chemistry_out=history_chemistry) + if (history_chemistry) then + call add_default( trim(forcing(nf)%fldname), 1, ' ' ) + end if + + ! Get index in pbuf + forcing(nf)%pbuf_index = pbuf_get_index(forcing(nf)%fldname) + + end if + end do loop_n_aero + + end subroutine aircraft_emit_init + + !========================================================================= + subroutine aircraft_emit_adv( state, pbuf2d ) + + !------------------------------------------------------------------- + ! **** Advance to the aircraft data **** + !------------------------------------------------------------------- + + use dshr_methods_mod , only : dshr_fldbun_getfldptr + use dshr_strdata_mod , only : shr_strdata_init_from_inline, shr_strdata_advance + use cam_esmf_mod, only : model_mesh, model_clock + use physics_types, only : physics_state + use ppgrid, only : begchunk, endchunk, pcols, pver, pverp + use string_utils, only : to_lower, GLC + use cam_history, only : outfld + use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole + use physconst, only : boltz ! J/K/molecule + use phys_grid, only : get_wght_all_p, get_ncols_p + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + use physics_buffer, only : pbuf_get_chunk, pbuf_get_index + use time_manager, only : get_curr_date + + ! Arguments + type(physics_state), intent(in) :: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! Local variables + integer :: gcell, ind, nf + integer :: lchnk, icol, klev, ncol + integer :: caseid + integer :: year, mon, day, sec + integer :: mcdate + real(r8) :: to_mmr(pcols,pver) + real(r8) :: wght(pcols) + real(r8), pointer :: tmpptr(:,:) + real(r8), pointer :: data_out(:,:) + real(r8), pointer :: dataptr2d(:,:) + real(r8) :: datain3d(pcols,pver,begchunk:endchunk) + real(r8) :: data_col(pver) + real(r8) :: model_z(pverp) + character(len=cs) :: units + integer :: index + integer :: rc + logical :: first_time = .true. + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + real(r8), parameter :: m2km = 1.e-3_r8 + character(len=*), parameter :: subname = 'aircraft_emit_adv' + !------------------------------------------------------------------ + + call t_startf('All_aircraft_emit_adv') + + !------------------------------------------------------------------ + ! The stream initialization must be called after the cam initailization + !------------------------------------------------------------------ + n_aero_loop: do nf = 1,N_AERO + non_empty_fldname: if (forcing(nf)%fldname /= ' ') then + first_call: if (first_time) then + + ! Initialize forcing%sdat + call shr_strdata_init_from_inline(forcing(nf)%sdat, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = model_clock, & + model_mesh = model_mesh, & + stream_meshfile = trim(forcing(nf)%meshfile), & + stream_filenames = (/forcing(nf)%datafile/), & + stream_yearFirst = forcing(nf)%year_first, & + stream_yearLast = forcing(nf)%year_last, & + stream_yearAlign = forcing(nf)%year_align, & + stream_fldlistFile = (/forcing(nf)%fldname/), & + stream_fldListModel = (/forcing(nf)%fldname/), & + stream_lev_dimname = 'altitude', & + stream_mapalgo = trim(forcing(nf)%mapalgo), & + stream_offset = 0, & + stream_taxmode = 'extend', & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = trim(forcing(nf)%tintalgo), & + stream_name = 'Aircraft forcing data ', & + rc = rc) + call chkrc(rc,__LINE__,u_FILE_u) + + first_time = .false. + end if first_call + + !------------------------------------------------------------------- + ! For each field, interpolate data in time and to model horizontal grid + !------------------------------------------------------------------- + + ! Extract YMD from model_update_next_time + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + ! Advance sdat streams + call shr_strdata_advance(forcing(nf)%sdat, ymd=mcdate, tod=sec, logunit=iulog, & + istr='aircraft_stream', rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + ! Get pointer to horizontally interpolated data + call dshr_fldbun_getFldPtr(forcing(nf)%sdat%pstrm(1)%fldbun_model, trim(forcing(nf)%fldname), & + fldptr2=dataptr2d, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) + + ! Obtain datain on model horizontal grid but the same vertical levels as the forcing dataset + do klev = 1, forcing(nf)%nlev !nlev is the number of levels in the forcing data + gcell = 1 + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + do icol = 1,ncol + datain3d(icol,klev,lchnk) = dataptr2d(klev,gcell) + gcell = gcell + 1 + end do + end do + end do + + ! Do vertical interpolation - aircraft data is vertically + ! interpolated to conserve the total column + do lchnk = begchunk,endchunk + call pbuf_get_field(pbuf2d, lchnk, forcing(nf)%pbuf_index, data_out) + ncol = get_ncols_p(lchnk) + do icol = 1,ncol + model_z(1:pverp) = m2km * state(lchnk)%zi(icol,pverp:1:-1) + call interpz_conserve( forcing(nf)%nlev, pver, forcing(nf)%altitude_int, model_z, & + datain3d(icol,:,lchnk), data_col(:) ) + data_out(icol,:) = data_col(pver:1:-1) + end do + end do + + !------------------------------------------------------------------- + ! set the tracer fields with the correct units + !------------------------------------------------------------------- + + ! GLC IS position of last significant character in string. + units = to_lower(trim(forcing(nf)%fldunits(:GLC(forcing(nf)%fldunits)))) + select case (trim(units)) + case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") + caseid = 1 + case ('kg/kg','mmr') + caseid = 2 + case ('mol/mol','mole/mole','vmr','fraction') + caseid = 3 + case ('kg/kg/sec') + caseid = 4 + case ('kg m-2 s-1') + caseid = 5 + case ('m/sec' ) + caseid = 6 + case default + if (masterproc) then + write(iulog,*)'aircraft_emit_adv: units = '//trim(units)//' are not recognized' + end if + call endrun('aircraft_emit_adv: units are not recognized') + end select + + index = forcing(nf)%index_map + + !$OMP PARALLEL DO PRIVATE (lchnk, ncol, index, to_mmr, tmpptr, pbuf_chnk, wght) + do lchnk = begchunk,endchunk + ncol = state(lchnk)%ncol + + ! Turn emission data to mixing ratio + call get_wght_all_p(lchnk, ncol, wght(:ncol)) + + if (caseid == 1) then + to_mmr(:ncol,:) = (molmass(index)*1.e6_r8*boltz*state(lchnk)%t(:ncol,:)) & + /(mwdry*state(lchnk)%pmiddry(:ncol,:)) + elseif (caseid == 2) then + to_mmr(:ncol,:) = 1._r8 + elseif (caseid == 4) then + to_mmr(:ncol,:) = 1.0_r8 + elseif (caseid == 5) then + to_mmr(:ncol,:) = 1.0_r8 + elseif (caseid == 6) then + to_mmr(:ncol,:) = 1.0_r8 + else + to_mmr(:ncol,:) = molmass(index)/mwdry + endif + + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + call pbuf_get_field(pbuf_chnk, forcing(nf)%pbuf_index, tmpptr) + tmpptr(:ncol,:) = tmpptr(:ncol,:)*to_mmr(:ncol,:) + call outfld( forcing(nf)%fldname, tmpptr(:ncol,:), ncol, state(lchnk)%lchnk ) + enddo + + end if non_empty_fldname + end do n_aero_loop + + call t_stopf('All_aircraft_emit_adv') + + end subroutine aircraft_emit_adv + + !========================================================================= + subroutine interpz_conserve( nsrc, ndst, src_x, dst_x, src, dst) + + ! Arguments + integer, intent(in) :: nsrc ! dimension source array + integer, intent(in) :: ndst ! dimension target array + real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates + real(r8), intent(in) :: dst_x(ndst+1) ! target coordinates + real(r8), intent(in) :: src(nsrc) ! source array + real(r8), intent(out) :: dst(ndst) ! target array + + ! local variables + integer :: i, j + integer :: isrc + real(r8) :: y + real(r8) :: bot, top + !--------------------------------------------------------------- + + do i = 1, ndst + if ( (dst_x(i)src_x(1)) ) then + do isrc = 1,nsrc + if ( (dst_x(i)-src_x(isrc))*(dst_x(i)-src_x(isrc+1))<=0.0_r8 ) then + exit + end if + end do + + if ( dst_x(i)src_x(j+1) ) then + y = y+(src_x(j+1)-bot)*src(j)/(src_x(j+1)-src_x(j)) + bot = src_x(j+1) + else + y = y+(top-bot)*src(j)/(src_x(j+1)-src_x(j)) + exit + endif + enddo + dst(i) = y + else + dst(i) = 0.0_r8 + end if + end do + + if ( dst_x(1)>src_x(1) ) then + top = dst_x(1) + bot = src_x(1) + y = 0.0_r8 + do j = 1, nsrc + if ( top>src_x(j+1) ) then + y = y+(src_x(j+1)-bot)*src(j)/(src_x(j+1)-src_x(j)) + bot = src_x(j+1) + else + y = y+(top-bot)*src(j)/(src_x(j+1)-src_x(j)) + exit + endif + end do + dst(1) = dst(1)+y + end if - ! Update module variables with user settings. - air_specifier = aircraft_specifier - air_datapath = aircraft_datapath - air_type = aircraft_type + end subroutine interpz_conserve - end subroutine aircraft_emit_readnl + !========================================================================= + subroutine get_aircraft(cnt, spc_name_list_out) - integer function get_aircraft_ndx( name ) + ! Arguments + integer, intent(out) :: cnt + character(len=*), intent(out) :: spc_name_list_out(:) - implicit none - character(len=*), intent(in) :: name + ! Local variables + integer :: nf + !------------------------------------------------------------------ - integer :: i + cnt = 0 + spc_name_list_out(:) = '' - get_aircraft_ndx = 0 - do i = 1,N_AERO - if ( trim(name) == trim(aero_names(i)) ) then - get_aircraft_ndx = i - return + do nf = 1,N_AERO + if (forcing(nf)%fldname /= ' ') then + cnt = cnt + 1 + spc_name_list_out(nf) = trim(forcing(nf)%fldname) + end if + end do + + end subroutine get_aircraft + + !========================================================================= + subroutine get_vertical_dimension( fid, dname, dsize, data ) + + use pio, only : file_desc_t, pio_seterrorhandling + use pio, only : pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_get_var + use pio, only : PIO_BCAST_ERROR, PIO_NOERR + + ! Arguments + type(file_desc_t), intent(inout) :: fid + character(*), intent(in) :: dname + integer, intent(out) :: dsize + real(r8), pointer :: data(:) + + ! Local variables + integer :: vid, ierr, id + integer :: err_handling + !------------------------------------------------------------------ + + call pio_seterrorhandling( fid, PIO_BCAST_ERROR, oldmethod=err_handling) + ierr = pio_inq_dimid( fid, dname, id ) + call pio_seterrorhandling( fid, err_handling) + if ( ierr == PIO_NOERR ) then + ierr = pio_inq_dimlen( fid, id, dsize ) + allocate( data(dsize), stat=ierr ) + if ( ierr /= 0 ) then + write(iulog,*) 'get_dimension: data allocation error = ',ierr + call endrun('get_dimension: failed to allocate data array') + end if + ierr = pio_inq_varid( fid, dname, vid ) + ierr = pio_get_var( fid, vid, data ) endif - enddo - end function get_aircraft_ndx + end subroutine get_vertical_dimension + + !================================================================ + subroutine chkrc(rc, line, file) + use ESMF, only: ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_LogWrite + + ! Arguments + 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 aircraft_emit diff --git a/src/chemistry/utils/tracer_data.F90 b/src/chemistry/utils/tracer_data.F90 index ce6843eafa..74ca0405ae 100644 --- a/src/chemistry/utils/tracer_data.F90 +++ b/src/chemistry/utils/tracer_data.F90 @@ -237,8 +237,8 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & file%cyc_yr = data_cycle_yr case( 'SERIAL' ) case default - write(iulog,*) 'trcdata_init: invalid data type: '//trim(data_type)//' file: '//trim(filename) - write(iulog,*) 'trcdata_init: valid data types: SERIAL | CYCLICAL | CYCLICAL_LIST | FIXED | INTERP_MISSING_MONTHS ' + write(iulog,'(a)') 'trcdata_init: invalid data type: '//trim(data_type)//' file: '//trim(filename) + write(iulog,'(a)') 'trcdata_init: valid data types: SERIAL | CYCLICAL | CYCLICAL_LIST | FIXED | INTERP_MISSING_MONTHS ' call endrun('trcdata_init: invalid data type: '//trim(data_type)//' file: '//trim(filename)) endselect @@ -254,7 +254,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & end if if (masterproc) then - write(iulog,*) 'trcdata_init: data type: '//trim(data_type)//' file: '//trim(filename) + write(iulog,'(a)') 'trcdata_init: data type: '//trim(data_type)//' file: '//trim(filename) endif ! if there is no list of files (len_trim(file%filenames_list)<1) then @@ -376,7 +376,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & endif if (masterproc) then - write(iulog,*) 'trcdata_init: file%has_ps = ' , file%has_ps + write(iulog,'(a,l4)') 'trcdata_init: file%has_ps = ' , file%has_ps endif ! masterproc if (file%alt_data) then @@ -397,13 +397,13 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( file%hyam(file%nlev), file%hybm(file%nlev), stat=astat ) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%hyam,file%hybm allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%hyam,file%hybm allocation error = ',astat call endrun('trcdata_init: failed to allocate file%hyam and file%hybm arrays') end if allocate( file%hyai(file%nlev+1), file%hybi(file%nlev+1), stat=astat ) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%hyai,file%hybi allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%hyai,file%hybi allocation error = ',astat call endrun('trcdata_init: failed to allocate file%hyai and file%hybi arrays') end if @@ -429,23 +429,23 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( file%ps_in(1)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(1)%data array; error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: failed to allocate file%ps_in(1)%data array; error = ',astat call endrun end if allocate( file%ps_in(2)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(2)%data array; error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: failed to allocate file%ps_in(2)%data array; error = ',astat call endrun end if if( file%fill_in_months ) then allocate( file%ps_in(3)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(3)%data array; error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: failed to allocate file%ps_in(3)%data array; error = ',astat call endrun end if allocate( file%ps_in(4)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(4)%data array; error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: failed to allocate file%ps_in(4)%data array; error = ',astat call endrun end if end if @@ -482,7 +482,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( flds(f)%data(pcols,pver,begchunk:endchunk), stat=astat ) endif if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate flds(f)%data array; error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%data array; error = ',astat call endrun end if else @@ -495,7 +495,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( flds(f)%input(1)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) endif if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate flds(f)%input(1)%data array; error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%input(1)%data array; error = ',astat call endrun end if if (flds(f)%srf_fld) then @@ -504,7 +504,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( flds(f)%input(2)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) endif if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate flds(f)%input(2)%data array; error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%input(2)%data array; error = ',astat call endrun end if @@ -515,7 +515,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( flds(f)%input(3)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) endif if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate flds(f)%input(3)%data array; error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%input(3)%data array; error = ',astat call endrun end if if (flds(f)%srf_fld) then @@ -524,7 +524,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( flds(f)%input(4)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) endif if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate flds(f)%input(4)%data array; error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%input(4)%data array; error = ',astat call endrun end if endif @@ -628,32 +628,32 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & ! weight_x & weight_y are weighting function for x & y interpolation allocate(file%weight_x(plon,file%nlon), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%weight_x allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%weight_x allocation error = ',astat call endrun('trcdata_init: failed to allocate weight_x array') end if allocate(file%weight_y(plat,file%nlat), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%weight_y allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%weight_y allocation error = ',astat call endrun('trcdata_init: failed to allocate weight_y array') end if allocate(file%count_x(plon), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%count_x allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%count_x allocation error = ',astat call endrun('trcdata_init: failed to allocate count_x array') end if allocate(file%count_y(plat), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%count_y allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%count_y allocation error = ',astat call endrun('trcdata_init: failed to allocate count_y array') end if allocate(file%index_x(plon,file%nlon), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%index_x allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%index_x allocation error = ',astat call endrun('trcdata_init: failed to allocate index_x array') end if allocate(file%index_y(plat,file%nlat), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%index_y allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%index_y allocation error = ',astat call endrun('trcdata_init: failed to allocate index_y array') end if file%weight_x(:,:) = 0.0_r8 @@ -666,32 +666,32 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & if( file%dist ) then allocate(file%weight0_x(plon,file%nlon), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%weight0_x allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%weight0_x allocation error = ',astat call endrun('trcdata_init: failed to allocate weight0_x array') end if allocate(file%weight0_y(plat,file%nlat), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%weight0_y allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%weight0_y allocation error = ',astat call endrun('trcdata_init: failed to allocate weight0_y array') end if allocate(file%count0_x(plon), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%count0_x allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%count0_x allocation error = ',astat call endrun('trcdata_init: failed to allocate count0_x array') end if allocate(file%count0_y(plat), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%count0_y allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%count0_y allocation error = ',astat call endrun('trcdata_init: failed to allocate count0_y array') end if allocate(file%index0_x(plon,file%nlon), stat=astat) - if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%index0_x allocation error = ',astat + if( astat /= '(a,i8)' ) then + write(iulog,'(a,i8)') 'trcdata_init: file%index0_x allocation error = ',astat call endrun('trcdata_init: failed to allocate index0_x array') end if allocate(file%index0_y(plat,file%nlat), stat=astat) if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%index0_y allocation error = ',astat + write(iulog,'(a,i8)') 'trcdata_init: file%index0_y allocation error = ',astat call endrun('trcdata_init: failed to allocate index0_y array') end if file%weight0_x(:,:) = 0.0_r8 @@ -1034,7 +1034,7 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ !----------------------------------------------------------------------- pos = len_trim( filename ) fn_new = filename(:pos) - if ( masterproc ) write(iulog,*) 'incr_flnm: old filename = ',trim(fn_new) + if ( masterproc ) write(iulog,'(a)') 'incr_flnm: old filename = '//trim(fn_new) if( fn_new(pos-2:) == '.nc' ) then pos = pos - 3 end if @@ -1050,8 +1050,8 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ !------------------------------------------------------------------- ! ... open filenames_list !------------------------------------------------------------------- - if ( masterproc ) write(iulog,*) 'incr_flnm: old filename = ',trim(filename) - if ( masterproc ) write(iulog,*) 'incr_flnm: open filenames_list : ',trim(filenames_list) + if ( masterproc ) write(iulog,'(a)') 'incr_flnm: old filename = '//trim(filename) + if ( masterproc ) write(iulog,'(a)') 'incr_flnm: open filenames_list : '//trim(filenames_list) unitnumber = shr_file_getUnit() if ( present(datapath) ) then filepath = trim(datapath) //'/'// trim(filenames_list) @@ -1149,7 +1149,7 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ ! return the current filename !--------------------------------------------------------------------------------- incr_filename = trim(fn_new) - if ( masterproc ) write(iulog,*) 'incr_flnm: new filename = ',trim(incr_filename) + if ( masterproc ) write(iulog,'(a)') 'incr_flnm: new filename = '//trim(incr_filename) end function incr_filename @@ -1238,7 +1238,7 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found if ( .not. times_found ) then if (masterproc) then write(iulog,*)'FIND_TIMES: Failed to find dates bracketing desired time =', time - write(iulog,*) 'filename = '//trim(file%curr_filename) + write(iulog,'(a)') 'filename = '//trim(file%curr_filename) write(iulog,*)' datatimem = ',file%datatimem write(iulog,*)' datatimep = ',file%datatimep endif @@ -1247,7 +1247,7 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found deallocate( all_data_times, stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'find_times: failed to deallocate all_data_times array; error = ',astat + write(iulog,'(a,i8)') 'find_times: failed to deallocate all_data_times array; error = ',astat call endrun end if @@ -1476,14 +1476,14 @@ subroutine read_2d_trc( fid, vid, loc_arr, strt, cnt, file, order ) nullify(wrk2d_in) allocate( wrk2d(cnt(1),cnt(2)), stat=ierr ) if( ierr /= 0 ) then - write(iulog,*) 'read_2d_trc: wrk2d allocation error = ',ierr + write(iulog,'(a,i8)') 'read_2d_trc: wrk2d allocation error = ',ierr call endrun end if if(order(1)/=1 .or. order(2)/=2 .or. cnt(1)/=file%nlon .or. cnt(2)/=file%nlat) then allocate( wrk2d_in(file%nlon, file%nlat), stat=ierr ) if( ierr /= 0 ) then - write(iulog,*) 'read_2d_trc: wrk2d_in allocation error = ',ierr + write(iulog,'(a,i8)') 'read_2d_trc: wrk2d_in allocation error = ',ierr call endrun end if end if @@ -1591,14 +1591,14 @@ subroutine read_za_trc( fid, vid, loc_arr, strt, cnt, file, order ) nullify(wrk2d_in) allocate( wrk2d(cnt(1),cnt(2)), stat=ierr ) if( ierr /= 0 ) then - write(iulog,*) 'read_2d_trc: wrk2d allocation error = ',ierr + write(iulog,'(a,i8)') 'read_2d_trc: wrk2d allocation error = ',ierr call endrun end if if(order(1)/=1 .or. order(2)/=2 .or. cnt(1)/=file%nlat .or. cnt(2)/=file%nlev) then allocate( wrk2d_in(file%nlat, file%nlev), stat=ierr ) if( ierr /= 0 ) then - write(iulog,*) 'read_2d_trc: wrk2d_in allocation error = ',ierr + write(iulog,'(a,i8)') 'read_2d_trc: wrk2d_in allocation error = ',ierr call endrun end if end if @@ -1731,7 +1731,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) nullify(wrk3d_in) allocate(wrk3d(cnt(1),cnt(2),cnt(3)), stat=ierr) if( ierr /= 0 ) then - write(iulog,*) 'read_3d_trc: wrk3d allocation error = ',ierr + write(iulog,'(a,i8)') 'read_3d_trc: wrk3d allocation error = ',ierr call endrun end if @@ -1741,7 +1741,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) cnt(1)/=file%nlon.or.cnt(2)/=file%nlat.or.cnt(3)/=file%nlev) then allocate(wrk3d_in(file%nlon,file%nlat,file%nlev),stat=ierr) if( ierr /= 0 ) then - write(iulog,*) 'read_3d_trc: wrk3d allocation error = ',ierr + write(iulog,'(a,i8)') 'read_3d_trc: wrk3d allocation error = ',ierr call endrun end if wrk3d_in = reshape( wrk3d(:,:,:),(/file%nlon,file%nlat,file%nlev/), order=order ) @@ -1802,7 +1802,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) deallocate( wrk3d_in, stat=astat ) end if if( astat/= 0 ) then - write(iulog,*) 'read_3d_trc: failed to deallocate wrk3d array; error = ',astat + write(iulog,'(a,i8)') 'read_3d_trc: failed to deallocate wrk3d array; error = ',astat call endrun endif if(dycore_is('LR')) call polar_average(file%nlev, loc_arr) @@ -2024,13 +2024,13 @@ subroutine get_dimension( fid, dname, dsize, dimid, data ) if ( associated(data) ) then deallocate(data, stat=ierr) if( ierr /= 0 ) then - write(iulog,*) 'get_dimension: data deallocation error = ',ierr + write(iulog,'(a,i8)') 'get_dimension: data deallocation error = ',ierr call endrun('get_dimension: failed to deallocate data array') end if endif allocate( data(dsize), stat=ierr ) if( ierr /= 0 ) then - write(iulog,*) 'get_dimension: data allocation error = ',ierr + write(iulog,'(a,i8)') 'get_dimension: data allocation error = ',ierr call endrun('get_dimension: failed to allocate data array') end if @@ -2129,31 +2129,31 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ ! call getfil( filepath, filen, 0 ) call cam_pio_openfile( piofile, filen, PIO_NOWRITE) - if(masterproc) write(iulog,*)'open_trc_datafile: ',trim(filen) + if(masterproc) write(iulog,'(a)')'open_trc_datafile: '//trim(filen) call get_dimension(piofile, 'time', timesize) if ( associated(times) ) then deallocate(times, stat=ierr) if( ierr /= 0 ) then - write(iulog,*) 'open_trc_datafile: data deallocation error = ',ierr + write(iulog,'(a,i8)') 'open_trc_datafile: data deallocation error = ',ierr call endrun('open_trc_datafile: failed to deallocate data array') end if endif allocate( times(timesize), stat=ierr ) if( ierr /= 0 ) then - write(iulog,*) 'open_trc_datafile: data allocation error = ',ierr + write(iulog,'(a,i8)') 'open_trc_datafile: data allocation error = ',ierr call endrun('open_trc_datafile: failed to allocate data array') end if allocate( dates(timesize), stat=astat ) if( astat/= 0 ) then - if(masterproc) write(iulog,*) 'open_trc_datafile: failed to allocate dates array; error = ',astat + if(masterproc) write(iulog,'(a,i8)') 'open_trc_datafile: failed to allocate dates array; error = ',astat call endrun end if allocate( datesecs(timesize), stat=astat ) if( astat/= 0 ) then - if(masterproc) write(iulog,*) 'open_trc_datafile: failed to allocate datesec array; error = ',astat + if(masterproc) write(iulog,'(a,i8)') 'open_trc_datafile: failed to allocate datesec array; error = ',astat call endrun end if @@ -2191,18 +2191,18 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ deallocate( dates, stat=astat ) if( astat/= 0 ) then - if(masterproc) write(iulog,*) 'open_trc_datafile: failed to deallocate dates array; error = ',astat + if(masterproc) write(iulog,'(a,i8)') 'open_trc_datafile: failed to deallocate dates array; error = ',astat call endrun end if deallocate( datesecs, stat=astat ) if( astat/= 0 ) then - if(masterproc) write(iulog,*) 'open_trc_datafile: failed to deallocate datesec array; error = ',astat + if(masterproc) write(iulog,'(a,i8)') 'open_trc_datafile: failed to deallocate datesec array; error = ',astat call endrun end if if ( present(cyc_yr) .and. present(cyc_ndx_beg) ) then if (cyc_ndx_beg < 0) then - write(iulog,*) 'open_trc_datafile: cycle year not found : ' , cyc_yr + write(iulog,'(a,i8)') 'open_trc_datafile: cycle year not found : ' , cyc_yr call endrun('open_trc_datafile: cycle year not found '//trim(filepath)) endif endif @@ -2228,7 +2228,7 @@ subroutine specify_fields( specifier, fields ) allocate(fld_name(nflds), src_name(nflds), stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'specify_fields: failed to allocate fld_name, src_name arrays; error = ',astat + write(iulog,'(a,i8)') 'specify_fields: failed to allocate fld_name, src_name arrays; error = ',astat call endrun end if @@ -2266,7 +2266,7 @@ subroutine specify_fields( specifier, fields ) !----------------------------------------------------------------------- allocate( fields(fld_cnt), stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'specify_fields: failed to allocate fields array; error = ',astat + write(iulog,'(a,i8)') 'specify_fields: failed to allocate fields array; error = ',astat call endrun end if @@ -2804,10 +2804,10 @@ subroutine advance_file(file) !----------------------------------------------------------------------- if( file%remove_trc_file ) then call getfil( file%curr_filename, loc_fname, 0 ) - write(iulog,*) 'advance_file: removing file = ',trim(loc_fname) + write(iulog,'(a)') 'advance_file: removing file = ',trim(loc_fname) ctmp = 'rm -f ' // trim(loc_fname) - write(iulog,*) 'advance_file: fsystem issuing command - ' - write(iulog,*) trim(ctmp) + write(iulog,'(a)') 'advance_file: fsystem issuing command - ' + write(iulog,'(a)') trim(ctmp) call shr_sys_system( ctmp, istat ) end if @@ -2822,12 +2822,12 @@ subroutine advance_file(file) !----------------------------------------------------------------------- deallocate( file%curr_data_times, stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'advance_file: failed to deallocate file%curr_data_times array; error = ',astat + write(iulog,'(a,i8)') 'advance_file: failed to deallocate file%curr_data_times array; error = ',astat call endrun end if allocate( file%curr_data_times( size( file%next_data_times ) ), stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'advance_file: failed to allocate file%curr_data_times array; error = ',astat + write(iulog,'(a,i8)') 'advance_file: failed to allocate file%curr_data_times array; error = ',astat call endrun end if file%curr_data_times(:) = file%next_data_times(:) @@ -2839,7 +2839,7 @@ subroutine advance_file(file) deallocate( file%next_data_times, stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'advance_file: failed to deallocate file%next_data_times array; error = ',astat + write(iulog,'(a,i8)') 'advance_file: failed to deallocate file%next_data_times array; error = ',astat call endrun end if nullify( file%next_data_times ) diff --git a/src/control/cam_esmf_mod.F90 b/src/control/cam_esmf_mod.F90 index 138ade6f4e..5813637a79 100644 --- a/src/control/cam_esmf_mod.F90 +++ b/src/control/cam_esmf_mod.F90 @@ -4,19 +4,30 @@ module cam_esmf_mod use ESMF , only : ESMF_Mesh, ESMF_Clock use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_VMGetCurrent use ESMF , only : ESMF_SUCCESS, ESMF_REDUCE_SUM - use nuopc_shr_methods , only : chkerr + use shr_sys_mod , only : shr_sys_abort use cam_abortutils , only : endrun + use nuopc_shr_methods , only : chkerr use error_messages , only : alloc_err use cam_logfile , only : iulog implicit none - public + private + + public :: cam_esmf_set_clock + public :: cam_esmf_set_mesh + public :: cam_esmf_set_areas + public :: cam_esmf_global_sum + + private :: cam_set_mesh_for_single_column - type(ESMF_Mesh) , protected :: model_mesh ! model mesh - type(ESMF_Clock), protected :: model_clock ! model clock + type(ESMF_Mesh) , public, protected :: model_mesh ! model mesh + type(ESMF_Clock), public, protected :: model_clock ! model clock - real(r8), allocatable, protected :: model_areas(:) - real(r8), allocatable, protected :: mesh_areas(:) + real(r8), allocatable, public, protected :: model_areas(:) + real(r8), allocatable, public, protected :: mesh_areas(:) + + logical :: model_clock_initialized = .false. + logical :: model_mesh_initialized = .false. character(*), parameter :: u_FILE_u = & __FILE__ @@ -25,14 +36,36 @@ module cam_esmf_mod 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 + subroutine cam_esmf_set_clock(clock_in, rc) + use ESMF, only : ESMF_Clock - model_mesh = model_mesh_in - model_clock = model_clock_in + type(ESMF_Clock), intent(in) :: clock_in + + rc = ESMF_SUCCESS + + model_clock = ESMF_ClockCreate(clock_in, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (model_clock_initialized) then + call shr_sys_abort('initialize_model_clock: model clock already initialized') + else + model_clock = model_clock_in + model_clock_initialized = .true. + end if + + end subroutine cam_esmf_set_clock + + !===================================================================== + subroutine cam_esmf_set_mesh(model_mesh_in) + type(ESMF_Mesh) , intent(in) :: model_mesh_in - end subroutine cam_esmf_set_mesh_and_clock + if (model_mesh_initialized) then + call shr_sys_abort('initialize_model_mesh: model mesh already initialized') + else + model_mesh = model_mesh_in + model_mesh_initialized = .true. + end if + end subroutine cam_esmf_set_mesh !===================================================================== subroutine cam_esmf_set_areas(model_areas_in, mesh_areas_in, rc) diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 3f15f92afa..0b37d927a2 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 cam_esmf_mod , only : cam_esmf_set_mesh_and_clock + use cam_esmf_mod , only : cam_esmf_set_clock, cam_esmf_set_mesh !$use omp_lib , only : omp_set_num_threads implicit none @@ -625,7 +625,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if ! Create model_clock as a variable in cam_esmf_mod.F90 - needed for generating streams - model_clock = ESMF_ClockCreate(clock, rc=rc) + call cam_esmf_set_clock(clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Initialize module orbital values and update orbital @@ -767,7 +767,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, 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) + call cam_esmf_set_mesh(model_mesh) ! Create cam export array and set the state scalars call export_fields( gcomp, cam_out, rc=rc ) diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 index 34dab18048..3a464d61e6 100644 --- a/src/physics/cam/co2_cycle.F90 +++ b/src/physics/cam/co2_cycle.F90 @@ -46,16 +46,16 @@ module co2_cycle integer :: co2flux_ocn_year_first = -999 ! first year in stream to use integer :: co2flux_ocn_year_last = -999 ! last year in stream to use integer :: co2flux_ocn_year_align = -999 ! align stream_year_first - character(len=cs) :: co2flux_ocn_tintalgo = 'linear' ! time interpolation [lower, upper, nearest, linear or coszen] - character(len=cs) :: co2flux_ocn_taxmode = 'extend' ! time extraploation [cycle, extend or limit] + character(len=cs) :: co2flux_ocn_tintalgo = 'unset' ! time interpolation [lower, upper, nearest, linear or coszen] + character(len=cs) :: co2flux_ocn_taxmode = 'unset' ! time extraploation [cycle, extend or limit] character(len=cl) :: co2flux_fuel_file = 'unset' ! co2 flux from fossil fuel character(len=cl) :: co2flux_fuel_mesh = 'unset' ! ESMF mesh corresponding to co2flux_fuel_file integer :: co2flux_fuel_year_first = -999 ! first year in stream to use integer :: co2flux_fuel_year_last = -999 ! last year in stream to use integer :: co2flux_fuel_year_align = -999 ! align stream_year_first - character(len=cs) :: co2flux_fuel_tintalgo = 'linear' ! time interpolation [lower, upper, nearest, linear or coszen] - character(len=cs) :: co2flux_fuel_taxmode = 'extend' ! time extraploation [cycle, extend or limit] + character(len=cs) :: co2flux_fuel_tintalgo = 'unset' ! time interpolation [lower, upper, nearest, linear or coszen] + character(len=cs) :: co2flux_fuel_taxmode = 'unset' ! time extraploation [cycle, extend or limit] !------------------------------------------------------------------------------- ! new constituents diff --git a/src/utils/ioFileMod.F90 b/src/utils/ioFileMod.F90 index c013d8aa7f..4a9969eb25 100644 --- a/src/utils/ioFileMod.F90 +++ b/src/utils/ioFileMod.F90 @@ -9,7 +9,7 @@ module ioFileMod ! Author: Mariana Vertenstein ! !--------------------------------------------------------------------- - + use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun use spmd_utils, only: masterproc @@ -33,9 +33,9 @@ module ioFileMod !======================================================================= contains !======================================================================= - + subroutine getfil(fulpath, locfn, iflag, lexist) - + ! -------------------------------------------------------------------- ! Determine whether file is on local disk. ! . first check current working directory @@ -44,7 +44,7 @@ subroutine getfil(fulpath, locfn, iflag, lexist) ! to 1 overrides this behavior, and in that case the optional lexist ! arg is used to return status of whether the file was found or not. ! -------------------------------------------------------------------- - + ! ------------------------ arguments ----------------------------------- character(len=*), intent(in) :: fulpath ! full pathname on local disk character(len=*), intent(out) :: locfn ! local file name if found in working directory, @@ -54,7 +54,7 @@ subroutine getfil(fulpath, locfn, iflag, lexist) logical, optional, intent(out) :: lexist ! When iflag=1 then getfil will return whether the ! file is found or not. This flag is set .true. ! if the file is found, otherwise .false. - + ! ------------------------ local variables --------------------------- integer :: i ! loop index integer :: klen ! length of fulpath character string @@ -63,7 +63,7 @@ subroutine getfil(fulpath, locfn, iflag, lexist) logical :: lexist_in ! true if local file exists logical :: abort_on_failure ! -------------------------------------------------------------------- - + abort_on_failure = .true. if (present(iflag)) then if (iflag==1) abort_on_failure = .false. @@ -73,7 +73,7 @@ subroutine getfil(fulpath, locfn, iflag, lexist) ! first check if file is in current working directory. ! get local file name from full name: start at end. look for first "/" - + klen = len_trim(fulpath) i = index(fulpath, '/', back=.true.) @@ -81,7 +81,7 @@ subroutine getfil(fulpath, locfn, iflag, lexist) if (abort_on_failure) then call endrun('(GETFIL): local filename variable is too short for path length') else - if (masterproc) write(iulog,*) '(GETFIL): local filename variable is too short for path length',klen-i,maxlen + if (masterproc) write(iulog,'(a,i8,i8)') '(GETFIL): local filename variable is too short for path length',klen-i,maxlen if (present(lexist)) lexist = .false. return end if @@ -91,23 +91,23 @@ subroutine getfil(fulpath, locfn, iflag, lexist) if (len_trim(locfn) == 0) then call endrun ('(GETFIL): local filename has zero length') else if (masterproc) then - write(iulog,*)'(GETFIL): attempting to find local file ', trim(locfn) + write(iulog,'(a)')'(GETFIL): attempting to find local file '//trim(locfn) end if - + inquire(file=locfn, exist=lexist_in) if (present(lexist)) lexist = lexist_in if (lexist_in) then - if (masterproc) write(iulog,*) '(GETFIL): using ',trim(locfn), ' in current working directory' + if (masterproc) write(iulog,'(a)') '(GETFIL): using '//trim(locfn)//' in current working directory' return end if - + ! second check for full pathname on disk - + if (klen > maxlen) then if (abort_on_failure) then call endrun('(GETFIL): local filename variable is too short for path length') else - if (masterproc) write(iulog,*) '(GETFIL): local filename variable is too short for path length',klen,maxlen + if (masterproc) write(iulog,'(a,i8,i8)') '(GETFIL): local filename variable is too short for path length',klen,maxlen if (present(lexist)) lexist = .false. return end if @@ -117,10 +117,10 @@ subroutine getfil(fulpath, locfn, iflag, lexist) inquire(file=locfn, exist=lexist_in) if (present(lexist)) lexist = lexist_in if (lexist_in) then - if (masterproc) write(iulog,*)'(GETFIL): using ',trim(fulpath) + if (masterproc) write(iulog,'(a)')'(GETFIL): using '//trim(fulpath) return else - if (masterproc) write(iulog,*)'(GETFIL): all tries to get file have been unsuccessful: ',trim(fulpath) + if (masterproc) write(iulog,'(a)')'(GETFIL): all tries to get file have been unsuccessful: '//trim(fulpath) if (abort_on_failure) then call endrun ('GETFIL: FAILED to get '//trim(fulpath)) else @@ -129,29 +129,29 @@ subroutine getfil(fulpath, locfn, iflag, lexist) endif end subroutine getfil - + !======================================================================= - - + + subroutine opnfil (locfn, iun, form, status) - + !----------------------------------------------------------------------- ! open file locfn in unformatted or formatted form on unit iun !----------------------------------------------------------------------- - + ! ------------------------ input variables --------------------------- character(len=*), intent(in):: locfn !file name integer, intent(in):: iun !fortran unit number character(len=1), intent(in):: form !file format: u = unformatted. f = formatted character(len=*), optional, intent(in):: status !file status ! -------------------------------------------------------------------- - + ! ------------------------ local variables --------------------------- integer ioe !error return from fortran open character(len=11) ft !format type: formatted. unformatted character(len=11) st !file status: old or unknown ! -------------------------------------------------------------------- - + if (len_trim(locfn) == 0) then call endrun ('(OPNFIL): local filename has zero length') endif @@ -167,16 +167,16 @@ subroutine opnfil (locfn, iun, form, status) end if open (unit=iun,file=locfn,status=st, form=ft,iostat=ioe) if (ioe /= 0) then - if(masterproc) write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn), ' on unit ',iun,' ierr=',ioe - call endrun ('opnfil') + if(masterproc) write(iulog,'(a,i8,a,i8)')'(OPNFIL): failed to open file '//trim(locfn)//' on unit ',iun,' ierr=',ioe + call endrun ('opnfil') else - if(masterproc) write(iulog,*)'(OPNFIL): Successfully opened file ',trim(locfn), ' on unit= ',iun + if(masterproc) write(iulog,'(a,i8)')'(OPNFIL): Successfully opened file '//trim(locfn)//' on unit= ',iun end if - + return end subroutine opnfil - + !======================================================================= - - + + end module ioFileMod From 089444c6c763a36e4161174868a4ef1a0ed68b6d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 26 Nov 2025 10:12:02 +0100 Subject: [PATCH 11/31] fixed compilation problem --- src/control/cam_esmf_mod.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/control/cam_esmf_mod.F90 b/src/control/cam_esmf_mod.F90 index 5813637a79..66af8f9c11 100644 --- a/src/control/cam_esmf_mod.F90 +++ b/src/control/cam_esmf_mod.F90 @@ -18,8 +18,6 @@ module cam_esmf_mod public :: cam_esmf_set_areas public :: cam_esmf_global_sum - private :: cam_set_mesh_for_single_column - type(ESMF_Mesh) , public, protected :: model_mesh ! model mesh type(ESMF_Clock), public, protected :: model_clock ! model clock @@ -37,9 +35,12 @@ module cam_esmf_mod !===================================================================== subroutine cam_esmf_set_clock(clock_in, rc) - use ESMF, only : ESMF_Clock + use ESMF, only : ESMF_Clock, ESMF_ClockCreate - type(ESMF_Clock), intent(in) :: clock_in + ! Arguments + type(ESMF_Clock), intent(in) :: clock_in + integer , intent(out) :: rc + !--------------------------------------- rc = ESMF_SUCCESS @@ -49,20 +50,20 @@ subroutine cam_esmf_set_clock(clock_in, rc) if (model_clock_initialized) then call shr_sys_abort('initialize_model_clock: model clock already initialized') else - model_clock = model_clock_in + model_clock = clock_in model_clock_initialized = .true. end if end subroutine cam_esmf_set_clock !===================================================================== - subroutine cam_esmf_set_mesh(model_mesh_in) - type(ESMF_Mesh) , intent(in) :: model_mesh_in + subroutine cam_esmf_set_mesh(mesh_in) + type(ESMF_Mesh) , intent(in) :: mesh_in if (model_mesh_initialized) then call shr_sys_abort('initialize_model_mesh: model mesh already initialized') else - model_mesh = model_mesh_in + model_mesh = mesh_in model_mesh_initialized = .true. end if end subroutine cam_esmf_set_mesh From ebd61ba0bb92d9938becc00c67336816b7184576 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 27 Nov 2025 09:43:34 +0100 Subject: [PATCH 12/31] updates for default namelists --- bld/build-namelist | 25 +++--- bld/namelist_files/namelist_defaults_cam.xml | 44 +--------- bld/namelist_files/namelist_definition.xml | 38 ++++----- src/physics/cam/co2_cycle.F90 | 90 ++++++++++---------- 4 files changed, 81 insertions(+), 116 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 99e0b2d390..1ab665a27c 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -824,7 +824,13 @@ if ($co2_cycle) { # Check whether user has explicitly turned off reading the fossil fuel dataset. # (user specification has higher precedence than the true value set above) if ($nl->get_value('co2_readflux_fuel') =~ /$TRUE/io) { - add_default($nl, 'co2flux_fuel_file', 'sim_year'=>$sim_year); + add_default($nl, 'co2flux_fuel_tintalgo'); + add_default($nl, 'co2flux_fuel_taxmode'); + add_default($nl, 'co2flux_fuel_meshfile'); + add_default($nl, 'co2flux_fuel_datafile'); + add_default($nl, 'co2flux_fuel_year_start', 'sim_year'=>$sim_year); + add_default($nl, 'co2flux_fuel_year_end', 'sim_year'=>$sim_year); + add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year); } add_default($nl, 'co2_readflux_aircraft', 'val'=>'.true.'); @@ -833,16 +839,13 @@ if ($co2_cycle) { # (user specification has higher precedence than the true value set above) if ($nl->get_value('co2_readflux_aircraft') =~ /$TRUE/io) { - my $rel_filepath = get_default_value('ac_CO2_emis'); - my $emisval = quote_string('ac_CO2 -> ' . $rel_filepath); - add_default($nl, 'aircraft_specifier', 'val'=>$emisval); - - add_default($nl, 'aircraft_datapath'); - add_default($nl, 'aircraft_type'); - # This should be the same file as the one in the aircraft_specifier file. - # This is a workaround to get this filepath into the cam.input_data_list file - # to allow the CESM scripts to obtain all required data for a run. - add_default($nl, 'aircraft_co2_file'); + add_default($nl, 'aircraft_co2_tintalgo'); + add_default($nl, 'aircraft_co2_taxmode'); + add_default($nl, 'aircraft_co2_meshfile'); + add_default($nl, 'aircraft_co2_datafile'); + add_default($nl, 'aircraft_co2_year_start', 'sim_year'=>$sim_year); + add_default($nl, 'aircraft_co2_year_end', 'sim_year'=>$sim_year); + add_default($nl, 'aircraft_co2_year_align', 'sim_year'=>$sim_year); } } } diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 803d844a30..8ded898436 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -262,12 +262,6 @@ atm/cam/topo/USGS-gtopo30_4x5_remap_c050520.nc atm/cam/topo/fv_10x15_nc0540_Nsw042_Nrs008_Co060_Fi001_20171220.nc -atm/cam/topo/fv3_C24_nc3000_Co180_Fi001_MulG_PF_nullRR_Nsw127_c200625.nc -atm/cam/topo/fv3_C48_nc3000_Co120_Fi001_MulG_PF_nullRR_Nsw085_c200625.nc -atm/cam/topo/fv3_C96_nc3000_Co060_Fi001_MulG_PF_nullRR_Nsw042_c200625.nc -atm/cam/topo/fv3_C192_nc3000_Co030_Fi001_MulG_PF_Nsw021_c200625.nc -atm/cam/topo/fv3_C384_nc3000_Co015_Fi001_MulG_PF_nullRR_Nsw011_c200625.nc - atm/cam/topo/se/ne5np4_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170515.nc atm/cam/topo/se/ne16np4_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc atm/cam/topo/se/ne30np4_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171020.nc @@ -670,27 +664,8 @@ 1850 2015 1850 -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc - - -linear -extend -2000 -2000 -1 -1850 -1850 -1 -1850 -2015 -1850 +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc +share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc 2000 @@ -702,13 +677,8 @@ 1850 2015 1850 -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc +share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc atm/cam/ggas/noaamisc.r8.nc @@ -2006,12 +1976,6 @@ atm/cam/chem/trop_mam/atmsrf_ne30x4_ARCTIC_191011.nc atm/cam/chem/trop_mam/atmsrf_ne30x8_ARCTICGRIS_191212.nc -atm/cam/chem/trop_mam/atmsrf_C24_c200625.nc -atm/cam/chem/trop_mam/atmsrf_C48_c200625.nc -atm/cam/chem/trop_mam/atmsrf_C96_c200625.nc -atm/cam/chem/trop_mam/atmsrf_C192_c200625.nc -atm/cam/chem/trop_mam/atmsrf_C384_c200625.nc - atm/cam/chem/trop_mam/atmsrf_mpasa120_c090720.nc atm/cam/chem/trop_mam/atmsrf_mpasa480_c090720.nc diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index f605f29732..8c1a664dd5 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1794,73 +1794,73 @@ If TRUE read co2 aircraft flux from file. Default: set by build-namelist - Filepath for dataset containing CO2 flux from ocn. Default: none - -Filepath for ESMF Mesh corresponding to co2flux_ocn_file File. +Filepath for ESMF Mesh corresponding to co2flux_ocn_datafile File. Default: none -Year first to use in co2flux_ocn_file. +Year first to use in co2flux_ocn_datafile. Default: 0 -Year last to use in co2flux_ocn_file. +Year last to use in co2flux_ocn_datafile. Default: 0 -Year align to use in co2flux_ocn_file. +Year align to use in co2flux_ocn_datafile. Default: 0 -Time interpolation algorithm to use for co2flux_ocn_file. +Time interpolation algorithm to use for co2flux_ocn_datafile. Default: linear -Time extrapolation algorithm to use for co2flux_ocn_file. +Time extrapolation algorithm to use for co2flux_ocn_datafile. Default: cycle - Filepath for dataset containing CO2 flux from fossil fuel. Default: none - -Filepath for ESMF Mesh corresponding to co2flux_fuel_file File. +Filepath for ESMF Mesh corresponding to co2flux_fuel_datafile File. Default: none -Year first to use in co2flux_fuel_file. +Year first to use in co2flux_fuel_datafile. Default: 0 -Year last to use in co2flux_fuel_file. +Year last to use in co2flux_fuel_datafile. Default: 0 -Year align to use in co2flux_fuel_file. +Year align to use in co2flux_fuel_datafile. Default: 0 -Time interpolation algorithm to use for co2flux_fuel_file. +Time interpolation algorithm to use for co2flux_fuel_datafile. Default: linear -Time extrapolation algorithm to use for co2flux_fuel_file. +Time extrapolation algorithm to use for co2flux_fuel_datafile. Default: cycle @@ -7002,7 +7002,7 @@ Default: set by build-namelist. Full pathname of the data file containing ac_CO2 (by default). Default: set by build-namelist. - Full pathname of the ESMF mesh file corresponding to aircraft_datafile. Default: set by build-namelist @@ -7033,7 +7033,7 @@ Default: set by build-namelist. Full pathname of the data file containing ac_H2O (by default). Default: set by build-namelist. - Full pathname of the ESMF mesh file corresponding to aircraft_datafile. Default: set by build-namelist @@ -7064,7 +7064,7 @@ Default: set by build-namelist. Full pathname of the data file containing ac_SLANT_DIST (by default). Default: set by build-namelist. - Full pathname of the ESMF mesh file corresponding to aircraft_datafile. Default: set by build-namelist diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 index 3a464d61e6..ea40345e55 100644 --- a/src/physics/cam/co2_cycle.F90 +++ b/src/physics/cam/co2_cycle.F90 @@ -41,21 +41,21 @@ module co2_cycle logical, public, protected :: co2_readFlux_fuel = .false. ! true => read fuel co2 flux from date file, namelist variable logical :: co2_readFlux_aircraft = .false. ! true => read aircraft co2 flux from date file, namelist variable - character(len=cl) :: co2flux_ocn_file = 'unset' ! co2 flux from ocn - character(len=cl) :: co2flux_ocn_mesh = 'unset' ! ESMF mesh corresponding to co2flux_ocn_file - integer :: co2flux_ocn_year_first = -999 ! first year in stream to use - integer :: co2flux_ocn_year_last = -999 ! last year in stream to use - integer :: co2flux_ocn_year_align = -999 ! align stream_year_first - character(len=cs) :: co2flux_ocn_tintalgo = 'unset' ! time interpolation [lower, upper, nearest, linear or coszen] - character(len=cs) :: co2flux_ocn_taxmode = 'unset' ! time extraploation [cycle, extend or limit] - - character(len=cl) :: co2flux_fuel_file = 'unset' ! co2 flux from fossil fuel - character(len=cl) :: co2flux_fuel_mesh = 'unset' ! ESMF mesh corresponding to co2flux_fuel_file - integer :: co2flux_fuel_year_first = -999 ! first year in stream to use - integer :: co2flux_fuel_year_last = -999 ! last year in stream to use - integer :: co2flux_fuel_year_align = -999 ! align stream_year_first - character(len=cs) :: co2flux_fuel_tintalgo = 'unset' ! time interpolation [lower, upper, nearest, linear or coszen] - character(len=cs) :: co2flux_fuel_taxmode = 'unset' ! time extraploation [cycle, extend or limit] + character(len=cl) :: co2flux_ocn_datafile = 'unset' ! co2 flux from ocn + character(len=cl) :: co2flux_ocn_meshfile = 'unset' ! ESMF mesh corresponding to co2flux_ocn_datafile + integer :: co2flux_ocn_year_first = -999 ! first year in stream to use + integer :: co2flux_ocn_year_last = -999 ! last year in stream to use + integer :: co2flux_ocn_year_align = -999 ! align stream_year_first + character(len=cs) :: co2flux_ocn_tintalgo = 'unset' ! time interpolation [lower, upper, nearest, linear or coszen] + character(len=cs) :: co2flux_ocn_taxmode = 'unset' ! time extraploation [cycle, extend or limit] + + character(len=cl) :: co2flux_fuel_datafile = 'unset' ! co2 flux from fossil fuel + character(len=cl) :: co2flux_fuel_meshfile = 'unset' ! ESMF mesh corresponding to co2flux_fuel_datafile + integer :: co2flux_fuel_year_first = -999 ! first year in stream to use + integer :: co2flux_fuel_year_last = -999 ! last year in stream to use + integer :: co2flux_fuel_year_align = -999 ! align stream_year_first + character(len=cs) :: co2flux_fuel_tintalgo = 'unset' ! time interpolation [lower, upper, nearest, linear or coszen] + character(len=cs) :: co2flux_fuel_taxmode = 'unset' ! time extraploation [cycle, extend or limit] !------------------------------------------------------------------------------- ! new constituents @@ -96,25 +96,25 @@ subroutine co2_cycle_readnl(nlfile) character(len=256) :: msg character(len=*), parameter :: subname = 'co2_cycle_readnl' - namelist /co2_cycle_nl/ & - co2_flag, & - co2_readFlux_aircraft, & ! if true, read aircraft data - co2_readFlux_ocn, & ! if true, read ocn data - co2flux_ocn_file, & ! input ocn dataset - co2flux_ocn_mesh, & ! ESMF mesh file for input dataset - co2flux_ocn_year_first, & ! first year in stream to use - co2flux_ocn_year_last, & ! last year in stream to use - co2flux_ocn_year_align, & ! align stream_year_first - co2flux_ocn_tintalgo, & ! time interpolation [lower, upper, nearest, linear or coszen] - co2flux_ocn_taxmode, & ! time extraploation [cycle, extend or limit] - co2_readFlux_fuel, & ! if true, read fuel data - co2flux_fuel_file, & ! input fuel dataset - co2flux_fuel_mesh, & ! ESMF mesh file for input dataset - co2flux_fuel_year_first, & ! first year in stream to use - co2flux_fuel_year_last, & ! last year in stream to use - co2flux_fuel_year_align, & ! align stream_year_first - co2flux_fuel_tintalgo, & ! time interpolation [lower, upper, nearest, linear or coszen] - co2flux_fuel_taxmode ! time extraploation [cycle, extend or limit] + namelist /co2_cycle_nl/ & + co2_flag, & + co2_readFlux_aircraft, & ! if true, read aircraft data + co2_readFlux_ocn, & ! if true, read ocn data + co2flux_ocn_datafile, & ! input ocn dataset + co2flux_ocn_meshfile, & ! ESMF mesh file for input dataset + co2flux_ocn_year_first, & ! first year in stream to use + co2flux_ocn_year_last, & ! last year in stream to use + co2flux_ocn_year_align, & ! align stream_year_first + co2flux_ocn_tintalgo, & ! time interpolation [lower, upper, nearest, linear or coszen] + co2flux_ocn_taxmode, & ! time extraploation [cycle, extend or limit] + co2_readFlux_fuel, & ! if true, read fuel data + co2flux_fuel_datafile, & ! input fuel dataset + co2flux_fuel_meshfile, & ! ESMF mesh file for input dataset + co2flux_fuel_year_first, & ! first year in stream to use + co2flux_fuel_year_last, & ! last year in stream to use + co2flux_fuel_year_align, & ! align stream_year_first + co2flux_fuel_tintalgo, & ! time interpolation [lower, upper, nearest, linear or coszen] + co2flux_fuel_taxmode ! time extraploation [cycle, extend or limit] !---------------------------------------------------------------------------- if (masterproc) then @@ -138,12 +138,10 @@ subroutine co2_cycle_readnl(nlfile) call mpi_bcast(co2_readFlux_ocn, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_ocn") - call mpi_bcast(co2flux_ocn_file, len(co2flux_ocn_file), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_file") - call mpi_bcast(co2flux_ocn_file, len(co2flux_ocn_file), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_file") - call mpi_bcast(co2flux_ocn_mesh, len(co2flux_ocn_mesh), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_mesh") + call mpi_bcast(co2flux_ocn_datafile, len(co2flux_ocn_datafile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_datafile") + call mpi_bcast(co2flux_ocn_meshfile, len(co2flux_ocn_meshfile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_meshfile") call mpi_bcast(co2flux_ocn_year_first, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_year_first") call mpi_bcast(co2flux_ocn_year_last, 1, mpi_integer, masterprocid, mpicom, ierr) @@ -157,10 +155,10 @@ subroutine co2_cycle_readnl(nlfile) call mpi_bcast(co2_readFlux_fuel, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_fuel") - call mpi_bcast(co2flux_fuel_file, len(co2flux_fuel_file), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_file") - call mpi_bcast(co2flux_fuel_mesh, len(co2flux_fuel_mesh), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_mesh") + call mpi_bcast(co2flux_fuel_datafile, len(co2flux_fuel_datafile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_datafile") + call mpi_bcast(co2flux_fuel_meshfile, len(co2flux_fuel_meshfile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_meshfile") call mpi_bcast(co2flux_fuel_year_first, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_first") call mpi_bcast(co2flux_fuel_year_last, 1, mpi_integer, masterprocid, mpicom, ierr) @@ -385,7 +383,7 @@ subroutine co2_time_interp_ocn if (co2_readFlux_ocn) then if (first_time) then ! Initialize and read flux data - call co2_data_flux_init (co2flux_ocn_file, co2flux_ocn_mesh, & + call co2_data_flux_init (co2flux_ocn_datafile, co2flux_ocn_meshfile, & 'CO2_flux', co2flux_ocn_year_first, co2flux_ocn_year_last, co2flux_ocn_year_align, & co2flux_ocn_tintalgo, co2flux_ocn_taxmode, data_flux_ocn) first_time = .false. @@ -415,7 +413,7 @@ subroutine co2_time_interp_fuel if (co2_readFlux_fuel) then if (first_time) then ! Initialize and read flux data - call co2_data_flux_init (co2flux_fuel_file, co2flux_fuel_mesh, & + call co2_data_flux_init (co2flux_fuel_datafile, co2flux_fuel_meshfile, & 'CO2_flux', co2flux_fuel_year_first, co2flux_fuel_year_last, co2flux_fuel_year_align, & co2flux_fuel_tintalgo, co2flux_fuel_taxmode, data_flux_fuel) first_time = .false. From 42f8e97e5935dc40d07542302d5496b1446daaa1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 1 Dec 2025 10:16:28 +0100 Subject: [PATCH 13/31] removed co2_readFlux_ocn --- bld/namelist_files/namelist_definition.xml | 47 +--------------- src/cpl/nuopc/atm_import_export.F90 | 14 +---- src/physics/cam/co2_cycle.F90 | 65 ---------------------- 3 files changed, 4 insertions(+), 122 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 8c1a664dd5..13c5b392b9 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1776,57 +1776,16 @@ If TRUE turn on CO2 code. Default: set by build-namelist - -If TRUE read co2 fuel flux from file. -Default: set by build-namelist - - - -If TRUE read co2 ocn flux from file. -Default: FALSE - - If TRUE read co2 aircraft flux from file. Default: set by build-namelist - -Filepath for dataset containing CO2 flux from ocn. -Default: none - - -Filepath for ESMF Mesh corresponding to co2flux_ocn_datafile File. -Default: none - - -Year first to use in co2flux_ocn_datafile. -Default: 0 - -Year last to use in co2flux_ocn_datafile. -Default: 0 - - -Year align to use in co2flux_ocn_datafile. -Default: 0 - - -Time interpolation algorithm to use for co2flux_ocn_datafile. -Default: linear - - -Time extrapolation algorithm to use for co2flux_ocn_datafile. -Default: cycle +If TRUE read co2 fuel flux from file. +Default: set by build-namelist turn on co2 code, namelist variable - logical, public, protected :: co2_readFlux_ocn = .false. ! true => read ocn co2 flux from date file, namelist variable logical, public, protected :: co2_readFlux_fuel = .false. ! true => read fuel co2 flux from date file, namelist variable logical :: co2_readFlux_aircraft = .false. ! true => read aircraft co2 flux from date file, namelist variable @@ -99,14 +98,6 @@ subroutine co2_cycle_readnl(nlfile) namelist /co2_cycle_nl/ & co2_flag, & co2_readFlux_aircraft, & ! if true, read aircraft data - co2_readFlux_ocn, & ! if true, read ocn data - co2flux_ocn_datafile, & ! input ocn dataset - co2flux_ocn_meshfile, & ! ESMF mesh file for input dataset - co2flux_ocn_year_first, & ! first year in stream to use - co2flux_ocn_year_last, & ! last year in stream to use - co2flux_ocn_year_align, & ! align stream_year_first - co2flux_ocn_tintalgo, & ! time interpolation [lower, upper, nearest, linear or coszen] - co2flux_ocn_taxmode, & ! time extraploation [cycle, extend or limit] co2_readFlux_fuel, & ! if true, read fuel data co2flux_fuel_datafile, & ! input fuel dataset co2flux_fuel_meshfile, & ! ESMF mesh file for input dataset @@ -136,23 +127,6 @@ subroutine co2_cycle_readnl(nlfile) call mpi_bcast(co2_readFlux_aircraft, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_aircraft") - call mpi_bcast(co2_readFlux_ocn, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_ocn") - call mpi_bcast(co2flux_ocn_datafile, len(co2flux_ocn_datafile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_datafile") - call mpi_bcast(co2flux_ocn_meshfile, len(co2flux_ocn_meshfile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_meshfile") - call mpi_bcast(co2flux_ocn_year_first, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_year_first") - call mpi_bcast(co2flux_ocn_year_last, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_year_last") - call mpi_bcast(co2flux_ocn_year_align, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_year_align") - call mpi_bcast(co2flux_ocn_tintalgo, len(co2flux_ocn_tintalgo), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_tintalgo") - call mpi_bcast(co2flux_ocn_taxmode, len(co2flux_ocn_taxmode), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_ocn_taxmode") - call mpi_bcast(co2_readFlux_fuel, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_fuel") call mpi_bcast(co2flux_fuel_datafile, len(co2flux_fuel_datafile), mpi_character, masterprocid, mpicom, ierr) @@ -170,16 +144,6 @@ subroutine co2_cycle_readnl(nlfile) call mpi_bcast(co2flux_fuel_taxmode, len(co2flux_fuel_taxmode), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode") - ! Consistency check - if (co2_readFlux_ocn .and. active_Faoo_fco2_ocn) then - msg = subname//': ERROR: reading ocn flux dataset is enabled, but mediator is setting'& - //' the ocn co2 flux. Cannot do both.' - if (masterproc) then - write(iulog,*) trim(msg) - end if - call endrun(trim(msg)) - end if - end subroutine co2_cycle_readnl !=============================================================================== @@ -364,35 +328,6 @@ subroutine co2_init end subroutine co2_init -!=============================================================================== -subroutine co2_time_interp_ocn - -!------------------------------------------------------------------------------- -! Purpose: Time interpolate co2 flux to current time. -! Read in new monthly data if necessary -!------------------------------------------------------------------------------- - - use time_manager, only: is_first_step - use co2_data_flux, only: co2_data_flux_init, co2_data_flux_advance - - logical :: first_time = .true. - !---------------------------------------------------------------------------- - - if (.not. co2_flag) return - - if (co2_readFlux_ocn) then - if (first_time) then - ! Initialize and read flux data - call co2_data_flux_init (co2flux_ocn_datafile, co2flux_ocn_meshfile, & - 'CO2_flux', co2flux_ocn_year_first, co2flux_ocn_year_last, co2flux_ocn_year_align, & - co2flux_ocn_tintalgo, co2flux_ocn_taxmode, data_flux_ocn) - first_time = .false. - end if - call co2_data_flux_advance ( data_flux_ocn ) - endif - -end subroutine co2_time_interp_ocn - !=============================================================================== subroutine co2_time_interp_fuel From d4323c91cfbdeda13a82d92dccd963f8d133a1d5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 3 Dec 2025 12:56:11 +0100 Subject: [PATCH 14/31] updates for namelist in aircraft_emit.F90 and removal of ocean read CO2 from file --- bld/build-namelist | 30 +-- bld/namelist_files/namelist_defaults_cam.xml | 22 +- bld/namelist_files/namelist_definition.xml | 188 +++++++++-------- src/chemistry/utils/aircraft_emit.F90 | 202 +++++++++++-------- src/cpl/nuopc/atm_import_export.F90 | 8 +- src/physics/cam/co2_cycle.F90 | 65 +++--- src/physics/cam/co2_data_flux.F90 | 5 +- 7 files changed, 281 insertions(+), 239 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 1ab665a27c..b05d872823 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -814,22 +814,24 @@ if ($co2_cycle) { # co2_flag turns on the co2_cycle code in CAM add_default($nl, 'co2_flag', 'val'=>'.true.'); - - # Supply a fossil fuel dataset if the co2_cycle is active and it's a - # transient run ... - if ($sim_year =~ /(\d+)-(\d+)/) { + # Supply a fossil fuel dataset and aircraft emissions datasets if + # the co2_cycle is active and it's a transient run ... + if ($sim_year =~ /(\d+)-(\d+)/ || $sim_year =~ /(\d+)/) { add_default($nl, 'co2_readflux_fuel', 'val'=>'.true.'); # Check whether user has explicitly turned off reading the fossil fuel dataset. # (user specification has higher precedence than the true value set above) if ($nl->get_value('co2_readflux_fuel') =~ /$TRUE/io) { - add_default($nl, 'co2flux_fuel_tintalgo'); - add_default($nl, 'co2flux_fuel_taxmode'); + if ($sim_year =~ /(\d+)-(\d+)/) { + add_default($nl, 'co2flux_fuel_taxmode', 'val'=>'limit' ); + } else { + add_default($nl, 'co2flux_fuel_taxmode', 'val'=>'cycle' ); + } add_default($nl, 'co2flux_fuel_meshfile'); add_default($nl, 'co2flux_fuel_datafile'); - add_default($nl, 'co2flux_fuel_year_start', 'sim_year'=>$sim_year); - add_default($nl, 'co2flux_fuel_year_end', 'sim_year'=>$sim_year); + add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year); + add_default($nl, 'co2flux_fuel_year_last' , 'sim_year'=>$sim_year); add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year); } @@ -838,13 +840,15 @@ if ($co2_cycle) { # Check whether user has explicitly turned off reading the aircraft CO2 dataset. # (user specification has higher precedence than the true value set above) if ($nl->get_value('co2_readflux_aircraft') =~ /$TRUE/io) { - - add_default($nl, 'aircraft_co2_tintalgo'); - add_default($nl, 'aircraft_co2_taxmode'); + if ($sim_year =~ /(\d+)-(\d+)/) { + add_default($nl, 'aircraft_co2_taxmode', 'val'=>'limit' ); + } else { + add_default($nl, 'aircraft_co2_taxmode', 'val'=>'cycle' ); + } add_default($nl, 'aircraft_co2_meshfile'); add_default($nl, 'aircraft_co2_datafile'); - add_default($nl, 'aircraft_co2_year_start', 'sim_year'=>$sim_year); - add_default($nl, 'aircraft_co2_year_end', 'sim_year'=>$sim_year); + add_default($nl, 'aircraft_co2_year_first', 'sim_year'=>$sim_year); + add_default($nl, 'aircraft_co2_year_last' , 'sim_year'=>$sim_year); add_default($nl, 'aircraft_co2_year_align', 'sim_year'=>$sim_year); } } diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 8ded898436..92e7dba64f 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -653,32 +653,30 @@ atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc -linear -extend -2000 +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc +share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc +2000 2000 1 -1850 +1850 1850 1 -1850 +1850 2015 1850 -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc -2000 +atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc +share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc +2000 2000 1 -1850 +1850 1850 1 -1850 +1850 2015 1850 -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc atm/cam/ggas/noaamisc.r8.nc diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 13c5b392b9..475f5050af 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -220,30 +220,32 @@ Default: FALSE - - Full pathnames of analyses data to use for nudging. + Full pathname of analyses data to use for nudging. + (e.g. '/$DIN_LOC_ROOT/atm/cam/nudging/') Default: none - - ESMF mesh file that corresponds to the nudging files + Template for Nudging analyses file names. + (e.g. '%y/ERAI_ne30np4_L30.cam2.i.%y-%m-%d-%s.nc') Default: none - - Number of analysis times per day in nudging filename(s). + Number of analyses files per day. (e.g. 4 --> 6 hourly analyses) - Default: 6 + Default: none - Number of time to update model data per day. (e.g. 48 --> 1800 Second timestep) - Default: 6 + Default: none -If TRUE read co2 aircraft flux from file. +If TRUE read co2 aircraft flux from file and use all the settings for +aircraft_co2_xxx namelist variables. Default: set by build-namelist -If TRUE read co2 fuel flux from file. +If TRUE read co2 fuel flux from file and use all the settings for +co2flux_fuel_xxx namelist variables. Default: set by build-namelist + + -Filepath for dataset containing CO2 flux from fossil fuel. + group="co2_ffuel_nl" valid_values="" > +Full filepath for dataset containing CO2 flux from fossil fuel. Default: none + -Filepath for ESMF Mesh corresponding to co2flux_fuel_datafile File. + group="co2_ffuel_nl" valid_values="" > +Full filepath for ESMF Mesh corresponding to co2flux_fuel_datafile File. Default: none + + group="co2_ffuel_nl" valid_values="" > Year first to use in co2flux_fuel_datafile. Default: 0 + + group="co2_ffuel_nl" valid_values="" > Year last to use in co2flux_fuel_datafile. Default: 0 + + group="co2_ffuel_nl" valid_values="" > Year align to use in co2flux_fuel_datafile. Default: 0 - -Time interpolation algorithm to use for co2flux_fuel_datafile. -Default: linear - - + + Time extrapolation algorithm to use for co2flux_fuel_datafile. Default: cycle + + + +Full pathname of the data file containing aircraft co2 emissions. +Default: set by build-namelist. + + + +Full pathname of the ESMF mesh file corresponding to aircraft_co2_datafile. +Default: set by build-namelist. + + + +First year of the aircraft_co2_datafile to use. +Default: set by build-namelist. + + + +Last year of the aircraft_co2_datafile to use. +Default: set by build-namelist. + + + +Model year that aligns with aircraft_co2_year_first. +Default: set by build-namelist. + + + +Time extrapolation algorithm to use for aircraft_co2_datafile. +Default: cycle + + - -Field name on the aircraft_datafile (default is ac_CO2). -Default: set by build-namelist. - - -Full pathname of the data file containing ac_CO2 (by default). -Default: set by build-namelist. - - -Full pathname of the ESMF mesh file corresponding to aircraft_datafile. -Default: set by build-namelist - - -First year of the aircraft_datafile to use. -Default: set by build-namelist - - -Last year of the aircraft_datafile to use. -Default: set by build-namelist - - -Model year that aligns with aircraft_year_first. -Default: set by build-namelist - + - -Field name on the aircraft_datafile (default is ac_H2O). -Default: set by build-namelist. - -Full pathname of the data file containing ac_H2O (by default). -Default: set by build-namelist. +Full pathname of the data file containing aircraft h2o emissions. + -Full pathname of the ESMF mesh file corresponding to aircraft_datafile. -Default: set by build-namelist +Full pathname of the ESMF mesh file corresponding to aircraft_h2o_datafile. + -First year of the aircraft_datafile to use. -Default: set by build-namelist +First year of the aircraft_h2o_datafile to use. + -Last year of the aircraft_datafile to use. -Default: set by build-namelist +Last year of the aircraft_h2o_datafile to use. + -Model year that aligns with aircraft_year_first. -Default: set by build-namelist +Model year that aligns with aircraft_h2o_year_first. - -Field name on the aircraft_datafile (default is ac_SLANT_DIST). -Default: set by build-namelist. + +Time extrapolation algorithm to use for aircraft_h2o_datafile. + + + Full pathname of the data file containing ac_SLANT_DIST (by default). -Default: set by build-namelist. + -Full pathname of the ESMF mesh file corresponding to aircraft_datafile. -Default: set by build-namelist +Full pathname of the ESMF mesh file corresponding to aircraft_slant_dist. + + + +Full pathname of the ESMF mesh file corresponding to aircraft_slant_dist. + -First year of the aircraft_datafile to use. -Default: set by build-namelist +First year of the aircraft_slant_dist to use. + -Last year of the aircraft_datafile to use. -Default: set by build-namelist +Last year of the aircraft_slant_dist to use. + Model year that aligns with aircraft_year_first. -Default: set by build-namelist + +Time extrapolation algorithm to use for aircraft_slant_dist. + + + + Full pathname of the directory that contains the files specified in @@ -7102,7 +7124,7 @@ if {{ hilight }}gcr_ionization_type{{ closehilight }} is 'FIXED'. Default: 0 seconds - + diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index b51058ddb3..10e4df9c1a 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -4,17 +4,16 @@ module aircraft_emit ! Purpose: ! Manages reading and interpolation of aircraft aerosols ! - ! Authors: Chih-Chieh (Jack) Chen and Cheryl Craig -- February 2010 - ! Refactored for CDEPS in line functionality -- November 2025 + ! Authors: + ! Chih-Chieh (Jack) Chen and Cheryl Craig -- February 2010 + ! Mariana Vertenstein (Refactored using CDEPS in-line functionality) -- November 2025 ! !----------------------------------------------------------------------- use perf_mod, only : t_startf, t_stopf use shr_kind_mod, only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use cam_abortutils, only : endrun, handle_allocate_error + use cam_abortutils, only : endrun use cam_logfile, only : iulog - use spmd_utils, only : mpicom, masterprocid - use spmd_utils, only : mpi_integer, mpi_logical, mpi_character use spmd_utils, only : masterproc, iam use dshr_strdata_mod, only : shr_strdata_type @@ -33,21 +32,22 @@ module aircraft_emit type :: forcing_type type(shr_strdata_type) :: sdat - character(len=cs) :: fldname = ' ' - character(len=cs) :: fldunits = 'units' - integer :: index_map = -1 - character(len=cl) :: datafile = ' ' - character(len=cl) :: meshfile = ' ' - character(len=cs) :: mapalgo = 'bilinear' - character(len=cs) :: tintalgo = 'lower' - integer :: year_first = -999 - integer :: year_last = -999 - integer :: year_align = -999 - integer :: nilev = -1 + character(len=cs) :: fldname = 'unset ' + character(len=cs) :: fldunits = 'unset' + character(len=cl) :: datafile = 'unset' + character(len=cl) :: meshfile = 'unset' + character(len=cs) :: mapalgo = 'consf' + character(len=cs) :: tintalgo = 'lower' + character(len=cs) :: taxmode = 'unset' + integer :: year_first = -999 + integer :: year_last = -999 + integer :: year_align = -999 + integer :: nilev = -1 + integer :: nlev = -1 + integer :: pbuf_index = -1 + integer :: index_map = -1 real(r8), pointer :: altitude_int(:) - integer :: nlev = -1 real(r8), pointer :: altitude_lev(:) - integer :: pbuf_index = -1 end type forcing_type type(forcing_type) :: forcing(N_AERO) @@ -65,6 +65,8 @@ subroutine aircraft_emit_readnl(nlfile) !------------------------------------------------------------------- use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, masterprocid + use spmd_utils, only: mpi_integer, mpi_logical, mpi_character ! Arguments character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -73,37 +75,48 @@ subroutine aircraft_emit_readnl(nlfile) integer :: nf, ni integer :: index integer :: unitn, ierr - character(len=cs) :: aircraft_co2_fldname = '' - character(len=cl) :: aircraft_co2_datafile = '' - character(len=cl) :: aircraft_co2_meshfile = '' - integer :: aircraft_co2_year_first = -999 - integer :: aircraft_co2_year_last = -999 - integer :: aircraft_co2_year_align = -999 - character(len=cs) :: aircraft_h2o_fldname = '' - character(len=cl) :: aircraft_h2o_datafile = '' - character(len=cl) :: aircraft_h2o_meshfile = '' - integer :: aircraft_h2o_year_first = -999 - integer :: aircraft_h2o_year_last = -999 - integer :: aircraft_h2o_year_align = -999 - character(len=cs) :: aircraft_slant_dist_fldname = '' - character(len=cl) :: aircraft_slant_dist_datafile = '' - character(len=cl) :: aircraft_slant_dist_meshfile = '' - integer :: aircraft_slant_dist_year_first = -999 - integer :: aircraft_slant_dist_year_last = -999 - integer :: aircraft_slant_dist_year_align = -999 + + character(len=cs) :: aircraft_co2_fldname = 'ac_CO2' + character(len=cl) :: aircraft_co2_datafile = 'unset' + character(len=cl) :: aircraft_co2_meshfile = 'unset' + character(len=cs) :: aircraft_co2_taxmode = 'unset' + integer :: aircraft_co2_year_first = -999 + integer :: aircraft_co2_year_last = -999 + integer :: aircraft_co2_year_align = -999 + + character(len=cs) :: aircraft_h2o_fldname = 'ac_H2O' + character(len=cl) :: aircraft_h2o_datafile = 'unset' + character(len=cl) :: aircraft_h2o_meshfile = 'unset' + character(len=cs) :: aircraft_h2o_taxmode = 'unset' + integer :: aircraft_h2o_year_first = -999 + integer :: aircraft_h2o_year_last = -999 + integer :: aircraft_h2o_year_align = -999 + + character(len=cs) :: aircraft_slant_dist_fldname = 'ac_SLANT_DIST' + character(len=cl) :: aircraft_slant_dist_datafile = 'unset' + character(len=cl) :: aircraft_slant_dist_meshfile = 'unset' + character(len=cs) :: aircraft_slant_dist_taxmode = 'unset' + integer :: aircraft_slant_dist_year_first= -999 + integer :: aircraft_slant_dist_year_last = -999 + integer :: aircraft_slant_dist_year_align= -999 + character(len=*), parameter :: subname = 'aircraft_emit_readnl' namelist /aircraft_emit_nl/ & - aircraft_co2_fldname, aircraft_co2_datafile, aircraft_co2_meshfile, & + aircraft_co2_datafile, aircraft_co2_meshfile, & aircraft_co2_year_first, aircraft_co2_year_last, aircraft_co2_year_align, & - aircraft_h2o_fldname, aircraft_h2o_datafile, aircraft_h2o_meshfile, & + aircraft_co2_taxmode, & + aircraft_h2o_datafile, aircraft_h2o_meshfile, & aircraft_h2o_year_first, aircraft_h2o_year_last, aircraft_h2o_year_align, & - aircraft_slant_dist_fldname, aircraft_slant_dist_datafile, aircraft_slant_dist_meshfile, & - aircraft_slant_dist_year_first, aircraft_slant_dist_year_last, aircraft_slant_dist_year_align + aircraft_h2o_taxmode, & + aircraft_slant_dist_datafile, aircraft_slant_dist_meshfile, & + aircraft_slant_dist_year_first, aircraft_slant_dist_year_last, aircraft_slant_dist_year_align, & + aircraft_slant_dist_taxmode !----------------------------------------------------------------------------- ! Read namelist if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'aircraft_emit_nl', status=ierr) if (ierr == 0) then @@ -114,52 +127,62 @@ subroutine aircraft_emit_readnl(nlfile) end if close(unitn) - forcing(1)%fldname = aircraft_co2_fldname - forcing(1)%datafile = aircraft_co2_datafile - forcing(1)%meshfile = aircraft_co2_meshfile - forcing(1)%year_first = aircraft_co2_year_first - forcing(1)%year_last = aircraft_co2_year_last - forcing(1)%year_align = aircraft_co2_year_align - - forcing(2)%fldname = aircraft_h2o_fldname - forcing(2)%datafile = aircraft_h2o_datafile - forcing(2)%meshfile = aircraft_h2o_meshfile - forcing(2)%year_first = aircraft_h2o_year_first - forcing(2)%year_last = aircraft_h2o_year_last - forcing(2)%year_align = aircraft_h2o_year_align - - forcing(3)%fldname = aircraft_slant_dist_fldname - forcing(3)%datafile = aircraft_slant_dist_datafile - forcing(3)%meshfile = aircraft_slant_dist_meshfile - forcing(3)%year_first = aircraft_slant_dist_year_first - forcing(3)%year_last = aircraft_slant_dist_year_last - forcing(3)%year_align = aircraft_slant_dist_year_align + if (trim(aircraft_co2_datafile) /= 'unset') then + nf = 1 + forcing(nf)%fldname = aircraft_co2_fldname + forcing(nf)%datafile = aircraft_co2_datafile + forcing(nf)%meshfile = aircraft_co2_meshfile + forcing(nf)%year_first = aircraft_co2_year_first + forcing(nf)%year_last = aircraft_co2_year_last + forcing(nf)%year_align = aircraft_co2_year_align + forcing(nf)%taxmode = aircraft_co2_taxmode + end if + if (trim(aircraft_h2o_datafile) /= 'unset') then + nf = 2 + forcing(nf)%datafile = aircraft_h2o_datafile + forcing(nf)%fldname = aircraft_h2o_fldname + forcing(nf)%meshfile = aircraft_h2o_meshfile + forcing(nf)%year_first = aircraft_h2o_year_first + forcing(nf)%year_last = aircraft_h2o_year_last + forcing(nf)%year_align = aircraft_h2o_year_align + forcing(nf)%taxmode = aircraft_h2o_taxmode + end if + if (trim(aircraft_slant_dist_datafile) /= 'unset') then + nf = 3 + forcing(nf)%datafile = aircraft_slant_dist_datafile + forcing(nf)%fldname = aircraft_slant_dist_fldname + forcing(nf)%meshfile = aircraft_slant_dist_meshfile + forcing(nf)%year_first = aircraft_slant_dist_year_first + forcing(nf)%year_last = aircraft_slant_dist_year_last + forcing(nf)%year_align = aircraft_slant_dist_year_align + forcing(nf)%taxmode = aircraft_slant_dist_taxmode + end if + end if n_aero_loop: do nf = 1,N_AERO + ! Broadcast namelist variables + call mpi_bcast(forcing(nf)%datafile, len(forcing(nf)%datafile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%datapath") call mpi_bcast(forcing(nf)%fldname,len(forcing(nf)%fldname), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%fldname") - - if (forcing(nf)%fldname /= ' ') then - call mpi_bcast(forcing(nf)%datafile, len(forcing(nf)%datafile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%datapath") - call mpi_bcast(forcing(nf)%meshfile, len(forcing(nf)%meshfile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%meshfile") - call mpi_bcast(forcing(nf)%year_first, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_first") - call mpi_bcast(forcing(nf)%year_last, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_last") - call mpi_bcast(forcing(nf)%year_align, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") - - ! fill in forcing data type + call mpi_bcast(forcing(nf)%meshfile, len(forcing(nf)%meshfile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%meshfile") + call mpi_bcast(forcing(nf)%year_first, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_first") + call mpi_bcast(forcing(nf)%year_last, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_last") + call mpi_bcast(forcing(nf)%year_align, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") + call mpi_bcast(forcing(nf)%taxmode, len(forcing(nf)%taxmode), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") + + datafile_isnot_unset: if (trim(forcing(nf)%datafile) /= 'unset') then + ! overwrite mapalgo for ac_SLANT_DIST if ( trim(forcing(nf)%fldname) == 'ac_SLANT_DIST') then forcing(nf)%mapalgo = 'nn' - else - forcing(nf)%mapalgo = 'bilinear' end if - forcing(nf)%tintalgo = 'lower' ! obtain index in aero_names module array index = 0 @@ -177,7 +200,6 @@ subroutine aircraft_emit_readnl(nlfile) ! diagnostics if (masterproc) then - if (masterproc) write(iulog,*) ' ' write(iulog,*) ' ' write(iulog,'(a)' ) ' aircraft init settings for: '//trim(forcing(nf)%fldname) write(iulog,'(a,a)') ' aircraft datafile = ',trim(forcing(nf)%datafile) @@ -187,10 +209,12 @@ subroutine aircraft_emit_readnl(nlfile) write(iulog,'(a,i8)')' aircraft year_first = ',forcing(nf)%year_first write(iulog,'(a,i8)')' aircraft year_last = ',forcing(nf)%year_last write(iulog,'(a,i8)')' aircraft year_align = ',forcing(nf)%year_align - write(iulog,'(a,i8)')' aircraft index_map for '//trim(forcing(nf)%fldname)//' = ',forcing(nf)%index_map + write(iulog,'(a,i8)')' aircraft index_map for '//trim(forcing(nf)%fldname)//' = ',& + forcing(nf)%index_map write(iulog,*) ' ' end if - end if + end if datafile_isnot_unset + end do n_aero_loop end subroutine aircraft_emit_readnl @@ -211,7 +235,7 @@ subroutine aircraft_emit_register() !-------------------------------------------- do nf = 1,N_AERO - if (forcing(nf)%fldname /= ' ') then + if (trim(forcing(nf)%datafile) /= 'unset') then ! Add fldname to pbuf and obtain pbuf_index call pbuf_add_field(forcing(nf)%fldname, 'physpkg', dtype_r8, (/pcols,pver/), & forcing(nf)%pbuf_index) @@ -246,7 +270,7 @@ subroutine aircraft_emit_init() !----------------------------------------------- loop_n_aero: do nf = 1,N_AERO - if (forcing(nf)%fldname /= ' ') then + if (trim(forcing(nf)%datafile) /= 'unset') then ! Open file if (masterproc) then @@ -266,8 +290,10 @@ subroutine aircraft_emit_init() endif ! Determine vertical levels - altitude_int and altitude_lev - call get_vertical_dimension(fid=pioid, dname='altitude_int', dsize=forcing(nf)%nilev, data=forcing(nf)%altitude_int) - call get_vertical_dimension(fid=pioid, dname='altitude' , dsize=forcing(nf)%nlev , data=forcing(nf)%altitude_lev) + call get_vertical_dimension(fid=pioid, dname='altitude_int', dsize=forcing(nf)%nilev, & + data=forcing(nf)%altitude_int) + call get_vertical_dimension(fid=pioid, dname='altitude' , dsize=forcing(nf)%nlev , & + data=forcing(nf)%altitude_lev) ! Write out info to log file if (masterproc) then @@ -357,9 +383,9 @@ subroutine aircraft_emit_adv( state, pbuf2d ) ! The stream initialization must be called after the cam initailization !------------------------------------------------------------------ n_aero_loop: do nf = 1,N_AERO - non_empty_fldname: if (forcing(nf)%fldname /= ' ') then - first_call: if (first_time) then + unset_file: if (trim(forcing(nf)%datafile) /= 'unset') then + first_call: if (first_time) then ! Initialize forcing%sdat call shr_strdata_init_from_inline(forcing(nf)%sdat, & my_task = iam, & @@ -377,7 +403,7 @@ subroutine aircraft_emit_adv( state, pbuf2d ) stream_lev_dimname = 'altitude', & stream_mapalgo = trim(forcing(nf)%mapalgo), & stream_offset = 0, & - stream_taxmode = 'extend', & + stream_taxmode = trim(forcing(nf)%taxmode), & stream_dtlimit = 1.0e30_r8, & stream_tintalgo = trim(forcing(nf)%tintalgo), & stream_name = 'Aircraft forcing data ', & @@ -486,7 +512,7 @@ subroutine aircraft_emit_adv( state, pbuf2d ) call outfld( forcing(nf)%fldname, tmpptr(:ncol,:), ncol, state(lchnk)%lchnk ) enddo - end if non_empty_fldname + end if unset_file end do n_aero_loop call t_stopf('All_aircraft_emit_adv') diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index e05bd8254f..a3f850b0ea 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -545,8 +545,8 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) use ppgrid , only : begchunk, endchunk use shr_const_mod , only : shr_const_stebol use co2_cycle , only : c_i, co2_readFlux_fuel - use co2_cycle , only : co2_transport, co2_time_interp_ocn, co2_time_interp_fuel - use co2_cycle , only : data_flux_ocn, data_flux_fuel + use co2_cycle , only : co2_transport, co2_time_interp_fuel + use co2_cycle , only : data_flux_fuel use physconst , only : mwco2 use time_manager , only : is_first_step, get_nstep @@ -953,9 +953,9 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) call co2_time_interp_fuel end if - ! from ocn : data read in or from coupler or zero ! from fuel: data read in or zero - ! from lnd : through coupler or zero + ! from ocn : from mediator or zero + ! from lnd : from mediator or zero ! all co2 fluxes in unit kgCO2/m2/s do c=begchunk,endchunk diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 index f10d297bd5..a93f0d6cf4 100644 --- a/src/physics/cam/co2_cycle.F90 +++ b/src/physics/cam/co2_cycle.F90 @@ -5,7 +5,7 @@ module co2_cycle ! Purpose: ! Provides distributions of CO2_LND, CO2_OCN, CO2_FF, CO2 ! Surface flux from CO2_LND and CO2_OCN provided by the mediator. -! Surface flux from CO2_FFF and CO2_OCN can be read from a file. +! Surface flux from CO2_FFF can be read from a file. ! ! Author: Jeff Lee, Keith Lindsay ! Mariana Vertenstein, Refactored for NUOPC Stream functionality @@ -14,7 +14,6 @@ module co2_cycle use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use co2_data_flux, only: co2_data_flux_type - use srf_field_check, only: active_Faoo_fco2_ocn implicit none private @@ -26,12 +25,10 @@ module co2_cycle public co2_implements_cnst ! returns true if consituent is implemented by this package public co2_init_cnst ! initialize mixing ratios if not read from initial file public co2_init ! initialize (history) variables - public co2_time_interp_ocn ! time interpolate co2 flux public co2_time_interp_fuel ! time interpolate co2 flux public co2_cycle_set_ptend ! set tendency from aircraft emissions ! Module data - type(co2_data_flux_type), public, protected :: data_flux_ocn ! data read in for co2 flux from ocn type(co2_data_flux_type), public, protected :: data_flux_fuel ! data read in for co2 flux from fuel @@ -40,20 +37,11 @@ module co2_cycle logical, public, protected :: co2_readFlux_fuel = .false. ! true => read fuel co2 flux from date file, namelist variable logical :: co2_readFlux_aircraft = .false. ! true => read aircraft co2 flux from date file, namelist variable - character(len=cl) :: co2flux_ocn_datafile = 'unset' ! co2 flux from ocn - character(len=cl) :: co2flux_ocn_meshfile = 'unset' ! ESMF mesh corresponding to co2flux_ocn_datafile - integer :: co2flux_ocn_year_first = -999 ! first year in stream to use - integer :: co2flux_ocn_year_last = -999 ! last year in stream to use - integer :: co2flux_ocn_year_align = -999 ! align stream_year_first - character(len=cs) :: co2flux_ocn_tintalgo = 'unset' ! time interpolation [lower, upper, nearest, linear or coszen] - character(len=cs) :: co2flux_ocn_taxmode = 'unset' ! time extraploation [cycle, extend or limit] - character(len=cl) :: co2flux_fuel_datafile = 'unset' ! co2 flux from fossil fuel character(len=cl) :: co2flux_fuel_meshfile = 'unset' ! ESMF mesh corresponding to co2flux_fuel_datafile integer :: co2flux_fuel_year_first = -999 ! first year in stream to use integer :: co2flux_fuel_year_last = -999 ! last year in stream to use integer :: co2flux_fuel_year_align = -999 ! align stream_year_first - character(len=cs) :: co2flux_fuel_tintalgo = 'unset' ! time interpolation [lower, upper, nearest, linear or coszen] character(len=cs) :: co2flux_fuel_taxmode = 'unset' ! time extraploation [cycle, extend or limit] !------------------------------------------------------------------------------- @@ -98,13 +86,14 @@ subroutine co2_cycle_readnl(nlfile) namelist /co2_cycle_nl/ & co2_flag, & co2_readFlux_aircraft, & ! if true, read aircraft data - co2_readFlux_fuel, & ! if true, read fuel data + co2_readFlux_fuel ! if true, read fuel data + + namelist /co2_ffuel_nl/ & co2flux_fuel_datafile, & ! input fuel dataset co2flux_fuel_meshfile, & ! ESMF mesh file for input dataset co2flux_fuel_year_first, & ! first year in stream to use co2flux_fuel_year_last, & ! last year in stream to use co2flux_fuel_year_align, & ! align stream_year_first - co2flux_fuel_tintalgo, & ! time interpolation [lower, upper, nearest, linear or coszen] co2flux_fuel_taxmode ! time extraploation [cycle, extend or limit] !---------------------------------------------------------------------------- @@ -114,21 +103,31 @@ subroutine co2_cycle_readnl(nlfile) if (ierr == 0) then read(unitn, co2_cycle_nl, iostat=ierr) if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') + call endrun(subname // ':: ERROR reading co2_cycle_nl namelist') end if end if close(unitn) end if - ! Broadcast namelist variables call mpi_bcast(co2_flag, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_flag") - call mpi_bcast(co2_readFlux_aircraft, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_aircraft") - call mpi_bcast(co2_readFlux_fuel, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_fuel") + + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'co2_ffuel_nl', status=ierr) + if (ierr == 0) then + read(unitn, co2_ffuel_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading co2_ffuel_nl namelist') + end if + end if + close(unitn) + end if + call mpi_bcast(co2flux_fuel_datafile, len(co2flux_fuel_datafile), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_datafile") call mpi_bcast(co2flux_fuel_meshfile, len(co2flux_fuel_meshfile), mpi_character, masterprocid, mpicom, ierr) @@ -139,8 +138,6 @@ subroutine co2_cycle_readnl(nlfile) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_last") call mpi_bcast(co2flux_fuel_year_align, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_align") - call mpi_bcast(co2flux_fuel_tintalgo, len(co2flux_fuel_tintalgo), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_tintalgo") call mpi_bcast(co2flux_fuel_taxmode, len(co2flux_fuel_taxmode), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode") @@ -163,8 +160,7 @@ subroutine co2_register c_cp, &! heat capacities c_qmin ! minimum mmr - integer :: i - + integer :: icnst !---------------------------------------------------------------------------- if (.not. co2_flag) return @@ -175,18 +171,19 @@ subroutine co2_register ! register CO2 constiuents as dry tracers, set indices - do i = 1, ncnst - call cnst_add(c_names(i), c_mw(i), c_cp(i), c_qmin(i), c_i(i), longname=c_names(i), mixtype='dry') + do icnst = 1, ncnst + call cnst_add(c_names(icnst), c_mw(icnst), c_cp(icnst), c_qmin(icnst), c_i(icnst), & + longname=c_names(icnst), mixtype='dry') - select case (trim(c_names(i))) + select case (trim(c_names(icnst))) case ('CO2_OCN') - co2_ocn_glo_ind = c_i(i) + co2_ocn_glo_ind = c_i(icnst) case ('CO2_FFF') - co2_fff_glo_ind = c_i(i) + co2_fff_glo_ind = c_i(icnst) case ('CO2_LND') - co2_lnd_glo_ind = c_i(i) + co2_lnd_glo_ind = c_i(icnst) case ('CO2') - co2_glo_ind = c_i(i) + co2_glo_ind = c_i(icnst) end select end do @@ -225,7 +222,6 @@ function co2_implements_cnst(name) ! Local variables integer :: m - !---------------------------------------------------------------------------- co2_implements_cnst = .false. @@ -263,7 +259,6 @@ subroutine co2_init_cnst(name, latvals, lonvals, mask, q) ! Local variables integer :: k - !---------------------------------------------------------------------------- if (.not. co2_flag) return @@ -297,8 +292,7 @@ subroutine co2_init !------------------------------------------------------------------------------- ! Purpose: initialize co2, ! declare history variables, -! read co2 flux form ocn, as data_flux_ocn -! read co2 flux form fule, as data_flux_fuel +! read co2 flux form fuel, as data_flux_fuel !------------------------------------------------------------------------------- use cam_history, only: addfld, add_default, horiz_only @@ -337,7 +331,6 @@ subroutine co2_time_interp_fuel ! Read in new monthly data if necessary !------------------------------------------------------------------------------- - use time_manager, only: is_first_step use co2_data_flux, only: co2_data_flux_init, co2_data_flux_advance logical :: first_time = .true. @@ -350,7 +343,7 @@ subroutine co2_time_interp_fuel ! Initialize and read flux data call co2_data_flux_init (co2flux_fuel_datafile, co2flux_fuel_meshfile, & 'CO2_flux', co2flux_fuel_year_first, co2flux_fuel_year_last, co2flux_fuel_year_align, & - co2flux_fuel_tintalgo, co2flux_fuel_taxmode, data_flux_fuel) + co2flux_fuel_taxmode, data_flux_fuel) first_time = .false. end if call co2_data_flux_advance ( data_flux_fuel ) diff --git a/src/physics/cam/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 index 7bc2546c31..70ff041ef1 100644 --- a/src/physics/cam/co2_data_flux.F90 +++ b/src/physics/cam/co2_data_flux.F90 @@ -33,7 +33,7 @@ module co2_data_flux !=============================================================================== subroutine co2_data_flux_init (input_file, input_meshfile, & - varname, year_first, year_last, year_align, tintalgo, taxmode, data_flux) + varname, year_first, year_last, year_align, taxmode, data_flux) !------------------------------------------------------------------------------- ! Initialize co2_data_flux_type instance @@ -51,7 +51,6 @@ subroutine co2_data_flux_init (input_file, input_meshfile, & integer, intent(in) :: year_first integer, intent(in) :: year_last integer, intent(in) :: year_align - character(len=*), intent(in) :: tintalgo character(len=*), intent(in) :: taxmode type(co2_data_flux_type), intent(inout) :: data_flux @@ -79,7 +78,7 @@ subroutine co2_data_flux_init (input_file, input_meshfile, & stream_offset = 0, & stream_taxmode = trim(taxmode), & stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = trim(tintalgo), & + stream_tintalgo = 'linear', & stream_name = 'CO2 forcing data ', & rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then From ad01c9160ce7654fdfb4a38974cb08b02c338e6f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 3 Dec 2025 22:52:46 +0100 Subject: [PATCH 15/31] cleanup of co2_data_flux.F90 --- src/cpl/nuopc/atm_import_export.F90 | 6 +- src/physics/cam/co2_cycle.F90 | 585 ++++++++++++---------------- src/physics/cam/co2_data_flux.F90 | 211 ++++++---- 3 files changed, 400 insertions(+), 402 deletions(-) diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index a3f850b0ea..59ab67d4b0 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -545,8 +545,8 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) use ppgrid , only : begchunk, endchunk use shr_const_mod , only : shr_const_stebol use co2_cycle , only : c_i, co2_readFlux_fuel - use co2_cycle , only : co2_transport, co2_time_interp_fuel - use co2_cycle , only : data_flux_fuel + use co2_cycle , only : co2_transport + use co2_data_flux , only : data_flux_fuel, co2_data_flux_advance use physconst , only : mwco2 use time_manager , only : is_first_step, get_nstep @@ -950,7 +950,7 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) ! Interpolate in time for flux data read in if (co2_readFlux_fuel) then - call co2_time_interp_fuel + call co2_data_flux_advance() end if ! from fuel: data read in or zero diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 index a93f0d6cf4..668c377b1c 100644 --- a/src/physics/cam/co2_cycle.F90 +++ b/src/physics/cam/co2_cycle.F90 @@ -1,19 +1,18 @@ module co2_cycle -!------------------------------------------------------------------------------- -! -! Purpose: -! Provides distributions of CO2_LND, CO2_OCN, CO2_FF, CO2 -! Surface flux from CO2_LND and CO2_OCN provided by the mediator. -! Surface flux from CO2_FFF can be read from a file. -! -! Author: Jeff Lee, Keith Lindsay -! Mariana Vertenstein, Refactored for NUOPC Stream functionality -! -!------------------------------------------------------------------------------- - - use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use co2_data_flux, only: co2_data_flux_type + !------------------------------------------------------------------------------- + ! + ! Purpose: + ! Provides distributions of CO2_LND, CO2_OCN, CO2_FF, CO2 + ! Surface flux from CO2_LND and CO2_OCN provided by the mediator. + ! Surface flux from CO2_FFF can be read from a file. + ! + ! Author: Jeff Lee, Keith Lindsay + ! Mariana Vertenstein, Refactored for NUOPC Stream functionality + ! + !------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs implicit none private @@ -25,25 +24,13 @@ module co2_cycle public co2_implements_cnst ! returns true if consituent is implemented by this package public co2_init_cnst ! initialize mixing ratios if not read from initial file public co2_init ! initialize (history) variables - public co2_time_interp_fuel ! time interpolate co2 flux public co2_cycle_set_ptend ! set tendency from aircraft emissions - ! Module data - type(co2_data_flux_type), public, protected :: data_flux_fuel ! data read in for co2 flux from fuel - - ! Namelist variables logical :: co2_flag = .false. ! true => turn on co2 code, namelist variable logical, public, protected :: co2_readFlux_fuel = .false. ! true => read fuel co2 flux from date file, namelist variable logical :: co2_readFlux_aircraft = .false. ! true => read aircraft co2 flux from date file, namelist variable - character(len=cl) :: co2flux_fuel_datafile = 'unset' ! co2 flux from fossil fuel - character(len=cl) :: co2flux_fuel_meshfile = 'unset' ! ESMF mesh corresponding to co2flux_fuel_datafile - integer :: co2flux_fuel_year_first = -999 ! first year in stream to use - integer :: co2flux_fuel_year_last = -999 ! last year in stream to use - integer :: co2flux_fuel_year_align = -999 ! align stream_year_first - character(len=cs) :: co2flux_fuel_taxmode = 'unset' ! time extraploation [cycle, extend or limit] - !------------------------------------------------------------------------------- ! new constituents !------------------------------------------------------------------------------- @@ -52,7 +39,7 @@ module co2_cycle integer, public, protected :: c_i(ncnst) ! global index for new constituents character(len=7), dimension(ncnst), parameter :: & ! constituent names - c_names = (/'CO2_OCN', 'CO2_FFF', 'CO2_LND', 'CO2 '/) + c_names = (/'CO2_OCN', 'CO2_FFF', 'CO2_LND', 'CO2 '/) integer :: co2_ocn_glo_ind ! global index of 'CO2_OCN' integer :: co2_fff_glo_ind ! global index of 'CO2_FFF' @@ -63,344 +50,286 @@ module co2_cycle contains !=============================================================================== -subroutine co2_cycle_readnl(nlfile) - -!------------------------------------------------------------------------------- -! Purpose: Read co2_cycle_nl namelist group. -!------------------------------------------------------------------------------- - - use namelist_utils, only: find_group_name - use spmd_utils, only: masterproc, mpicom, masterprocid - use spmd_utils, only: mpi_logical, mpi_character, mpi_integer - use cam_logfile, only: iulog - use cam_abortutils, only: endrun - - ! Arguments - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=256) :: msg - character(len=*), parameter :: subname = 'co2_cycle_readnl' - - namelist /co2_cycle_nl/ & - co2_flag, & - co2_readFlux_aircraft, & ! if true, read aircraft data - co2_readFlux_fuel ! if true, read fuel data - - namelist /co2_ffuel_nl/ & - co2flux_fuel_datafile, & ! input fuel dataset - co2flux_fuel_meshfile, & ! ESMF mesh file for input dataset - co2flux_fuel_year_first, & ! first year in stream to use - co2flux_fuel_year_last, & ! last year in stream to use - co2flux_fuel_year_align, & ! align stream_year_first - co2flux_fuel_taxmode ! time extraploation [cycle, extend or limit] - !---------------------------------------------------------------------------- - - if (masterproc) then - open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'co2_cycle_nl', status=ierr) - if (ierr == 0) then - read(unitn, co2_cycle_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading co2_cycle_nl namelist') - end if - end if - close(unitn) - end if - - call mpi_bcast(co2_flag, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_flag") - call mpi_bcast(co2_readFlux_aircraft, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_aircraft") - call mpi_bcast(co2_readFlux_fuel, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_fuel") - - if (masterproc) then - open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'co2_ffuel_nl', status=ierr) - if (ierr == 0) then - read(unitn, co2_ffuel_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading co2_ffuel_nl namelist') + subroutine co2_cycle_readnl(nlfile) + + !-------------------------------------------- + ! Purpose: Read co2_cycle_nl namelist group. + !-------------------------------------------- + + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, mpicom, masterprocid + use spmd_utils, only: mpi_logical, mpi_character, mpi_integer + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use co2_data_flux, only: co2_data_flux_readnl + + ! Arguments + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=256) :: msg + character(len=*), parameter :: subname = 'co2_cycle_readnl' + + namelist /co2_cycle_nl/ & + co2_flag, & + co2_readFlux_aircraft, & ! if true, read aircraft data + co2_readFlux_fuel ! if true, read fuel data + !---------------------------------------------------------------------------- + + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'co2_cycle_nl', status=ierr) + if (ierr == 0) then + read(unitn, co2_cycle_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading co2_cycle_nl namelist') + end if end if + close(unitn) end if - close(unitn) - end if - - call mpi_bcast(co2flux_fuel_datafile, len(co2flux_fuel_datafile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_datafile") - call mpi_bcast(co2flux_fuel_meshfile, len(co2flux_fuel_meshfile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_meshfile") - call mpi_bcast(co2flux_fuel_year_first, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_first") - call mpi_bcast(co2flux_fuel_year_last, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_last") - call mpi_bcast(co2flux_fuel_year_align, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_align") - call mpi_bcast(co2flux_fuel_taxmode, len(co2flux_fuel_taxmode), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode") - -end subroutine co2_cycle_readnl - -!=============================================================================== - -subroutine co2_register - -!------------------------------------------------------------------------------- -! Purpose: register advected constituents -!------------------------------------------------------------------------------- - - use physconst, only: mwco2, cpair - use constituents, only: cnst_add - - ! Local variables - real(r8), dimension(ncnst) :: & - c_mw, &! molecular weights - c_cp, &! heat capacities - c_qmin ! minimum mmr - - integer :: icnst - !---------------------------------------------------------------------------- - - if (.not. co2_flag) return - - c_mw = (/ mwco2, mwco2, mwco2, mwco2 /) - c_cp = (/ cpair, cpair, cpair, cpair /) - c_qmin = (/ 1.e-20_r8, 1.e-20_r8, 1.e-20_r8, 1.e-20_r8 /) - - ! register CO2 constiuents as dry tracers, set indices - - do icnst = 1, ncnst - call cnst_add(c_names(icnst), c_mw(icnst), c_cp(icnst), c_qmin(icnst), c_i(icnst), & - longname=c_names(icnst), mixtype='dry') - select case (trim(c_names(icnst))) - case ('CO2_OCN') - co2_ocn_glo_ind = c_i(icnst) - case ('CO2_FFF') - co2_fff_glo_ind = c_i(icnst) - case ('CO2_LND') - co2_lnd_glo_ind = c_i(icnst) - case ('CO2') - co2_glo_ind = c_i(icnst) - end select - end do + call mpi_bcast(co2_flag, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_flag") + call mpi_bcast(co2_readFlux_aircraft, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_aircraft") + call mpi_bcast(co2_readFlux_fuel, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_fuel") -end subroutine co2_register - -!=============================================================================== - -function co2_transport() + if (co2_readFlux_fuel) then + call co2_data_flux_readnl(nlfile) + end if -!------------------------------------------------------------------------------- -! Purpose: return true if this package is active -!------------------------------------------------------------------------------- + end subroutine co2_cycle_readnl - ! Return value - logical :: co2_transport + !=============================================================================== - !---------------------------------------------------------------------------- + subroutine co2_register - co2_transport = co2_flag + !------------------------------------------------------------------------------- + ! Purpose: register advected constituents + !------------------------------------------------------------------------------- -end function co2_transport + use physconst, only: mwco2, cpair + use constituents, only: cnst_add -!=============================================================================== + ! Local variables + real(r8), dimension(ncnst) :: & + c_mw, &! molecular weights + c_cp, &! heat capacities + c_qmin ! minimum mmr -function co2_implements_cnst(name) + integer :: icnst + !---------------------------------------------------------------------------- -!------------------------------------------------------------------------------- -! Purpose: return true if specified constituent is implemented by this package -!------------------------------------------------------------------------------- + if (.not. co2_flag) return - ! Return value - logical :: co2_implements_cnst + c_mw = (/ mwco2, mwco2, mwco2, mwco2 /) + c_cp = (/ cpair, cpair, cpair, cpair /) + c_qmin = (/ 1.e-20_r8, 1.e-20_r8, 1.e-20_r8, 1.e-20_r8 /) - ! Arguments - character(len=*), intent(in) :: name ! constituent name + ! register CO2 constiuents as dry tracers, set indices - ! Local variables - integer :: m - !---------------------------------------------------------------------------- + do icnst = 1, ncnst + call cnst_add(c_names(icnst), c_mw(icnst), c_cp(icnst), c_qmin(icnst), c_i(icnst), & + longname=c_names(icnst), mixtype='dry') - co2_implements_cnst = .false. + select case (trim(c_names(icnst))) + case ('CO2_OCN') + co2_ocn_glo_ind = c_i(icnst) + case ('CO2_FFF') + co2_fff_glo_ind = c_i(icnst) + case ('CO2_LND') + co2_lnd_glo_ind = c_i(icnst) + case ('CO2') + co2_glo_ind = c_i(icnst) + end select + end do - if (.not. co2_flag) return + end subroutine co2_register - do m = 1, ncnst - if (name == c_names(m)) then - co2_implements_cnst = .true. - return - end if - end do + !=============================================================================== -end function co2_implements_cnst + function co2_transport() -!=============================================================================== + !------------------------------------------------------------------------------- + ! Purpose: return true if this package is active + !------------------------------------------------------------------------------- -subroutine co2_init_cnst(name, latvals, lonvals, mask, q) - -!------------------------------------------------------------------------------- -! Purpose: -! Set initial values of CO2_OCN, CO2_FFF, CO2_LND, CO2 -! Need to be called from process_inidat in inidat.F90 -! (or, initialize co2 in co2_timestep_init) -!------------------------------------------------------------------------------- - - use chem_surfvals, only: chem_surfvals_get - - ! Arguments - character(len=*), intent(in) :: name ! constituent name - real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) - real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) - logical, intent(in) :: mask(:) ! Only initialize where .true. - real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev) - - ! Local variables - integer :: k - !---------------------------------------------------------------------------- - - if (.not. co2_flag) return - - do k = 1, size(q, 2) - select case (name) - case ('CO2_OCN') - where(mask) - q(:, k) = chem_surfvals_get('CO2MMR') - end where - case ('CO2_FFF') - where(mask) - q(:, k) = chem_surfvals_get('CO2MMR') - end where - case ('CO2_LND') - where(mask) - q(:, k) = chem_surfvals_get('CO2MMR') - end where - case ('CO2') - where(mask) - q(:, k) = chem_surfvals_get('CO2MMR') - end where - end select - end do - -end subroutine co2_init_cnst + ! Return value + logical :: co2_transport -!=============================================================================== -subroutine co2_init + !---------------------------------------------------------------------------- -!------------------------------------------------------------------------------- -! Purpose: initialize co2, -! declare history variables, -! read co2 flux form fuel, as data_flux_fuel -!------------------------------------------------------------------------------- + co2_transport = co2_flag - use cam_history, only: addfld, add_default, horiz_only - use constituents, only: cnst_name, cnst_longname, sflxnam + end function co2_transport - ! Local variables - integer :: m, mm - !---------------------------------------------------------------------------- + !=============================================================================== - if (.not. co2_flag) return + function co2_implements_cnst(name) - ! Add constituents and fluxes to history file - do m = 1, ncnst - mm = c_i(m) + !------------------------------------------------------------------------------- + ! Purpose: return true if specified constituent is implemented by this package + !------------------------------------------------------------------------------- - call addfld(trim(cnst_name(mm))//'_BOT', horiz_only, 'A', 'kg/kg', trim(cnst_longname(mm))//', Bottom Layer') - call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm)) - call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux') + ! Return value + logical :: co2_implements_cnst - call add_default(cnst_name(mm), 1, ' ') - call add_default(sflxnam(mm), 1, ' ') + ! Arguments + character(len=*), intent(in) :: name ! constituent name - ! The addfld call for the 'TM*' fields are made by default in the - ! constituent_burden module. - call add_default('TM'//trim(cnst_name(mm)), 1, ' ') - end do + ! Local variables + integer :: m + !---------------------------------------------------------------------------- -end subroutine co2_init + co2_implements_cnst = .false. -!=============================================================================== + if (.not. co2_flag) return -subroutine co2_time_interp_fuel - -!------------------------------------------------------------------------------- -! Purpose: Time interpolate co2 flux to current time. -! Read in new monthly data if necessary -!------------------------------------------------------------------------------- - - use co2_data_flux, only: co2_data_flux_init, co2_data_flux_advance - - logical :: first_time = .true. - !---------------------------------------------------------------------------- + do m = 1, ncnst + if (name == c_names(m)) then + co2_implements_cnst = .true. + return + end if + end do + + end function co2_implements_cnst + + !=============================================================================== + + subroutine co2_init_cnst(name, latvals, lonvals, mask, q) + + !------------------------------------------------------------------------------- + ! Purpose: + ! Set initial values of CO2_OCN, CO2_FFF, CO2_LND, CO2 + ! Need to be called from process_inidat in inidat.F90 + ! (or, initialize co2 in co2_timestep_init) + !------------------------------------------------------------------------------- + + use chem_surfvals, only: chem_surfvals_get + + ! Arguments + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev) + + ! Local variables + integer :: k + !---------------------------------------------------------------------------- + + if (.not. co2_flag) return + + do k = 1, size(q, 2) + select case (name) + case ('CO2_OCN') + where(mask) + q(:, k) = chem_surfvals_get('CO2MMR') + end where + case ('CO2_FFF') + where(mask) + q(:, k) = chem_surfvals_get('CO2MMR') + end where + case ('CO2_LND') + where(mask) + q(:, k) = chem_surfvals_get('CO2MMR') + end where + case ('CO2') + where(mask) + q(:, k) = chem_surfvals_get('CO2MMR') + end where + end select + end do + + end subroutine co2_init_cnst + + !=============================================================================== + + subroutine co2_init + + !------------------------------------------------------------------------------- + ! Purpose: initialize co2, + ! declare history variables, + ! read co2 flux form fuel, as data_flux_fuel + !------------------------------------------------------------------------------- + + use cam_history, only: addfld, add_default, horiz_only + use constituents, only: cnst_name, cnst_longname, sflxnam + + ! Local variables + integer :: m, mm + !---------------------------------------------------------------------------- + + if (.not. co2_flag) return + + ! Add constituents and fluxes to history file + do m = 1, ncnst + mm = c_i(m) + + call addfld(trim(cnst_name(mm))//'_BOT', horiz_only, 'A', 'kg/kg', trim(cnst_longname(mm))//', Bottom Layer') + call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm)) + call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux') + + call add_default(cnst_name(mm), 1, ' ') + call add_default(sflxnam(mm), 1, ' ') + + ! The addfld call for the 'TM*' fields are made by default in the + ! constituent_burden module. + call add_default('TM'//trim(cnst_name(mm)), 1, ' ') + end do + + end subroutine co2_init + + !=============================================================================== + subroutine co2_cycle_set_ptend(state, pbuf, ptend) + + !------------------------------------------------------------------------------- + ! Purpose: + ! Set ptend, using aircraft CO2 emissions in ac_CO2 from pbuf + !------------------------------------------------------------------------------- + + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field + use constituents, only: pcnst + use ppgrid, only: pver + use physconst, only: gravit + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + + ! Local variables + logical :: lq(pcnst) + integer :: ifld, ncol, k + real(r8), pointer :: ac_CO2(:,:) + !---------------------------------------------------------------------------- + + if (.not. co2_flag .or. .not. co2_readFlux_aircraft) then + call physics_ptend_init(ptend, state%psetcols, 'none') + return + end if - if (.not. co2_flag) return + ! aircraft fluxes are added to 'CO2_FFF' and 'CO2' tendencies + lq(:) = .false. + lq(co2_fff_glo_ind) = .true. + lq(co2_glo_ind) = .true. - if (co2_readFlux_fuel) then - if (first_time) then - ! Initialize and read flux data - call co2_data_flux_init (co2flux_fuel_datafile, co2flux_fuel_meshfile, & - 'CO2_flux', co2flux_fuel_year_first, co2flux_fuel_year_last, co2flux_fuel_year_align, & - co2flux_fuel_taxmode, data_flux_fuel) - first_time = .false. - end if - call co2_data_flux_advance ( data_flux_fuel ) - endif + call physics_ptend_init(ptend, state%psetcols, 'co2_cycle_ac', lq=lq) -end subroutine co2_time_interp_fuel + ifld = pbuf_get_index('ac_CO2') + call pbuf_get_field(pbuf, ifld, ac_CO2) -!=============================================================================== -subroutine co2_cycle_set_ptend(state, pbuf, ptend) - -!------------------------------------------------------------------------------- -! Purpose: -! Set ptend, using aircraft CO2 emissions in ac_CO2 from pbuf -!------------------------------------------------------------------------------- - - use physics_types, only: physics_state, physics_ptend, physics_ptend_init - use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field - use constituents, only: pcnst - use ppgrid, only: pver - use physconst, only: gravit - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies - - ! Local variables - logical :: lq(pcnst) - integer :: ifld, ncol, k - real(r8), pointer :: ac_CO2(:,:) - !---------------------------------------------------------------------------- - - if (.not. co2_flag .or. .not. co2_readFlux_aircraft) then - call physics_ptend_init(ptend, state%psetcols, 'none') - return - end if - - ! aircraft fluxes are added to 'CO2_FFF' and 'CO2' tendencies - lq(:) = .false. - lq(co2_fff_glo_ind) = .true. - lq(co2_glo_ind) = .true. - - call physics_ptend_init(ptend, state%psetcols, 'co2_cycle_ac', lq=lq) - - ifld = pbuf_get_index('ac_CO2') - call pbuf_get_field(pbuf, ifld, ac_CO2) - - ! [ac_CO2] = 'kg m-2 s-1' - ! [ptend%q] = 'kg kg-1 s-1' - ncol = state%ncol - do k = 1, pver - ptend%q(:ncol,k,co2_fff_glo_ind) = gravit * state%rpdeldry(:ncol,k) * ac_CO2(:ncol,k) - ptend%q(:ncol,k,co2_glo_ind) = gravit * state%rpdeldry(:ncol,k) * ac_CO2(:ncol,k) - end do - -end subroutine co2_cycle_set_ptend + ! [ac_CO2] = 'kg m-2 s-1' + ! [ptend%q] = 'kg kg-1 s-1' + ncol = state%ncol + do k = 1, pver + ptend%q(:ncol,k,co2_fff_glo_ind) = gravit * state%rpdeldry(:ncol,k) * ac_CO2(:ncol,k) + ptend%q(:ncol,k,co2_glo_ind) = gravit * state%rpdeldry(:ncol,k) * ac_CO2(:ncol,k) + end do -!=============================================================================== + end subroutine co2_cycle_set_ptend end module co2_cycle diff --git a/src/physics/cam/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 index 70ff041ef1..1ea1998b1d 100644 --- a/src/physics/cam/co2_data_flux.F90 +++ b/src/physics/cam/co2_data_flux.F90 @@ -1,7 +1,7 @@ module co2_data_flux !------------------------------------------------------------------------------- - ! read and interpolate co2 surface fluxes + ! read and interpolate co2 fossil fuel surface flux !------------------------------------------------------------------------------- use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl, cs=> shr_kind_cs @@ -16,85 +16,141 @@ module co2_data_flux private ! Public interfaces - public co2_data_flux_type - public co2_data_flux_init - public co2_data_flux_advance + public :: co2_data_flux_readnl + public :: co2_data_flux_advance + + ! Private interfaces + private :: co2_data_flux_init type :: co2_data_flux_type - type(shr_strdata_type) :: sdat_co2 - character(len=cs) :: varname - real(r8), pointer :: co2flx(:,:) ! Interpolated output (pcols,begchunk:endchunk) + character(len=cs) :: varname = "CO2_flux" + real(r8), pointer :: co2flx(:,:) ! Interpolated output (pcols,begchunk:endchunk) end type co2_data_flux_type + type(co2_data_flux_type), public :: data_flux_fuel + + type(shr_strdata_type) :: sdat_co2 + + character(len=cl) :: co2flux_fuel_datafile = 'unset' ! co2 flux from fossil fuel + character(len=cl) :: co2flux_fuel_meshfile = 'unset' ! ESMF mesh corresponding to co2flux_fuel_datafile + integer :: co2flux_fuel_year_first = -999 ! first year in stream to use + integer :: co2flux_fuel_year_last = -999 ! last year in stream to use + integer :: co2flux_fuel_year_align = -999 ! align stream_year_first + character(len=cs) :: co2flux_fuel_taxmode = 'unset' ! time extraploation [cycle, extend or limit] logical :: debug = .false. + character(*),parameter :: u_FILE_u = __FILE__ + !=============================================================================== contains !=============================================================================== - subroutine co2_data_flux_init (input_file, input_meshfile, & - varname, year_first, year_last, year_align, taxmode, data_flux) + subroutine co2_data_flux_readnl(nlfile) - !------------------------------------------------------------------------------- + !-------------------------------------------- + ! Purpose: Read co2_ffuel_nl namelist group. + !-------------------------------------------- + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, mpicom, masterprocid + use spmd_utils, only: mpi_logical, mpi_character, mpi_integer + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + + ! Arguments + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=256) :: msg + character(len=*), parameter :: subname = 'co2_cycle_readnl' + + namelist /co2_ffuel_nl/ & + co2flux_fuel_datafile, & ! input fuel dataset + co2flux_fuel_meshfile, & ! ESMF mesh file for input dataset + co2flux_fuel_year_first, & ! first year in stream to use + co2flux_fuel_year_last, & ! last year in stream to use + co2flux_fuel_year_align, & ! align stream_year_first + co2flux_fuel_taxmode ! time extraploation [cycle, extend or limit] + !-------------------------------------------- + + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'co2_ffuel_nl', status=ierr) + if (ierr == 0) then + read(unitn, co2_ffuel_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading co2_ffuel_nl namelist') + end if + end if + close(unitn) + end if + + call mpi_bcast(co2flux_fuel_datafile, len(co2flux_fuel_datafile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_datafile") + call mpi_bcast(co2flux_fuel_meshfile, len(co2flux_fuel_meshfile), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_meshfile") + call mpi_bcast(co2flux_fuel_year_first, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_first") + call mpi_bcast(co2flux_fuel_year_last, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_last") + call mpi_bcast(co2flux_fuel_year_align, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_align") + call mpi_bcast(co2flux_fuel_taxmode, len(co2flux_fuel_taxmode), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode") + + end subroutine co2_data_flux_readnl + + !=============================================================================== + subroutine co2_data_flux_init () + + !-------------------------------------------- ! Initialize co2_data_flux_type instance ! including initial read of input and interpolation to the current timestep - !------------------------------------------------------------------------------- + !-------------------------------------------- use ppgrid, only: begchunk, endchunk, pcols use cam_esmf_mod, only: model_mesh, model_clock + use error_messages, only: alloc_err use dshr_strdata_mod, only: shr_strdata_init_from_inline - ! Arguments - character(len=*), intent(in) :: input_file ! assumes only one input file - character(len=*), intent(in) :: input_meshfile - character(len=*), intent(in) :: varname ! assume only one varname for sdat - integer, intent(in) :: year_first - integer, intent(in) :: year_last - integer, intent(in) :: year_align - character(len=*), intent(in) :: taxmode - type(co2_data_flux_type), intent(inout) :: data_flux - ! Local variables - integer :: rc + integer :: istat + integer :: rc character(len=*), parameter :: subname = 'co2_data_flux_init' - !---------------------------------------------------------------------------- - - ! Initialize data_flux%sdat_co2 - call shr_strdata_init_from_inline(data_flux%sdat_co2, & - my_task = iam, & - logunit = iulog, & - compname = 'ATM', & - model_clock = model_clock, & - model_mesh = model_mesh, & - stream_meshfile = trim(input_meshfile), & - stream_filenames = (/input_file/), & - stream_yearFirst = year_first, & - stream_yearLast = year_last, & - stream_yearAlign = year_align, & - stream_fldlistFile = (/varname/), & - stream_fldListModel = (/varname/), & - stream_lev_dimname = 'null', & - stream_mapalgo = 'consf', & - stream_offset = 0, & - stream_taxmode = trim(taxmode), & - stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = 'linear', & - stream_name = 'CO2 forcing data ', & + !-------------------------------------------- + + ! Allocate data_flux_fuel%co2flx + allocate( data_flux_fuel%co2flx(pcols,begchunk:endchunk), stat=istat) + call alloc_err(istat, subname, 'data_flux_fuel%co2flx', pcols*(endchunk-begchunk+1)) + + ! Initialize sdat_co2 + call shr_strdata_init_from_inline(sdat_co2, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = model_clock, & + model_mesh = model_mesh, & + stream_meshfile = trim(co2flux_fuel_meshfile), & + stream_filenames = (/co2flux_fuel_datafile/), & + stream_yearFirst = co2flux_fuel_year_first, & + stream_yearLast = co2flux_fuel_year_last, & + stream_yearAlign = co2flux_fuel_year_align, & + stream_fldlistFile = (/data_flux_fuel%varname/), & + stream_fldListModel = (/data_flux_fuel%varname/), & + stream_lev_dimname = 'null', & + stream_mapalgo = 'consf', & + stream_offset = 0, & + stream_taxmode = trim(co2flux_fuel_taxmode), & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = 'linear', & + stream_name = 'CO2 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 - - ! Initialize data_flux%varname - data_flux%varname = trim(varname) - - ! Initialize data_flux%co2flx - allocate( data_flux%co2flx(pcols,begchunk:endchunk) ) + call chkrc(rc,__LINE__,u_FILE_u) end subroutine co2_data_flux_init !=============================================================================== - subroutine co2_data_flux_advance (data_flux) + subroutine co2_data_flux_advance() !------------------------------------------------------------------------------- ! Advance the contents of a co2_data_flux_type sdat (map and interpolate in time) @@ -107,9 +163,6 @@ subroutine co2_data_flux_advance (data_flux) use time_manager , only : get_curr_date use cam_esmf_mod , only : cam_esmf_global_sum - ! Arguments - type(co2_data_flux_type), intent(inout) :: data_flux - ! Local variables integer :: icol,lchnk,g integer :: year ! year (0, ...) for nstep+1 @@ -118,39 +171,55 @@ subroutine co2_data_flux_advance (data_flux) integer :: sec ! seconds into current date for nstep+1 integer :: mcdate ! Current model date (yyyymmdd) integer :: rc + logical :: first_time = .true. real(r8), pointer :: dataptr1d(:) character(len=*), parameter :: subname = 'co2_data_flux_advance' !---------------------------------------------------------------------------- + ! Initialize stream data type for fossil fuel read + if (first_time) then + call co2_data_flux_init() + first_time = .false. + end if + ! Advance sdat stream call get_curr_date(year, mon, day, sec) mcdate = year*10000 + mon*100 + day - call shr_strdata_advance(data_flux%sdat_co2, ymd=mcdate, tod=sec, logunit=iulog, istr='co2_advance', 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 shr_strdata_advance(sdat_co2, ymd=mcdate, tod=sec, logunit=iulog, istr='co2_advance', rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) ! Get pointer for stream data that is time and spatially interpolated to model time and grid - call dshr_fldbun_getFldPtr(data_flux%sdat_co2%pstrm(1)%fldbun_model, data_flux%varname, fldptr1=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 + call dshr_fldbun_getFldPtr(sdat_co2%pstrm(1)%fldbun_model, data_flux_fuel%varname, fldptr1=dataptr1d, rc=rc) + call chkrc(rc,__LINE__,u_FILE_u) if (debug) then - call cam_esmf_global_sum(trim(data_flux%varname), dataptr1d, 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 cam_esmf_global_sum(trim(data_flux_fuel%varname), dataptr1d, rc) + call chkrc(rc,__LINE__,u_FILE_u) end if g = 1 do lchnk = begchunk,endchunk do icol = 1,get_ncols_p(lchnk) - data_flux%co2flx(icol,lchnk) = dataptr1d(g) + data_flux_fuel%co2flx(icol,lchnk) = dataptr1d(g) g = g + 1 end do end do end subroutine co2_data_flux_advance + !================================================================ + subroutine chkrc(rc, line, file) + use ESMF, only: ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_LogWrite + + ! Arguments + 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 co2_data_flux From e482086e5e09c246b66f9f73d7da135c1b1c321b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 7 Dec 2025 00:17:47 +0100 Subject: [PATCH 16/31] co2_readflux_aircraft namelist in co2_cycle.F90 is now recognoized in aircraft_emit.F90 --- src/chemistry/utils/aircraft_emit.F90 | 26 +++++++++++++++++--------- src/physics/cam/co2_cycle.F90 | 2 +- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index 10e4df9c1a..6dc55bfc1a 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -67,6 +67,7 @@ subroutine aircraft_emit_readnl(nlfile) use namelist_utils, only: find_group_name use spmd_utils, only: mpicom, masterprocid use spmd_utils, only: mpi_integer, mpi_logical, mpi_character + use co2_cycle, only: co2_readflux_aircraft ! Arguments character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -127,15 +128,22 @@ subroutine aircraft_emit_readnl(nlfile) end if close(unitn) - if (trim(aircraft_co2_datafile) /= 'unset') then - nf = 1 - forcing(nf)%fldname = aircraft_co2_fldname - forcing(nf)%datafile = aircraft_co2_datafile - forcing(nf)%meshfile = aircraft_co2_meshfile - forcing(nf)%year_first = aircraft_co2_year_first - forcing(nf)%year_last = aircraft_co2_year_last - forcing(nf)%year_align = aircraft_co2_year_align - forcing(nf)%taxmode = aircraft_co2_taxmode + ! Note - the following call assumes that co2_readflux_aircraft is + ! set in co2_cycle_readnl and this is called before this routine in + ! runtime_opts.F90. If co2_readflux_aircraft is .false. then, the + ! forcing(nf)%datafile = 'unset' and this logic will be triggered + ! in the other routines in this module + if (co2_readflux_aircraft) then + if (trim(aircraft_co2_datafile) /= 'unset') then + nf = 1 + forcing(nf)%fldname = aircraft_co2_fldname + forcing(nf)%datafile = aircraft_co2_datafile + forcing(nf)%meshfile = aircraft_co2_meshfile + forcing(nf)%year_first = aircraft_co2_year_first + forcing(nf)%year_last = aircraft_co2_year_last + forcing(nf)%year_align = aircraft_co2_year_align + forcing(nf)%taxmode = aircraft_co2_taxmode + end if end if if (trim(aircraft_h2o_datafile) /= 'unset') then nf = 2 diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 index 668c377b1c..7c058e3297 100644 --- a/src/physics/cam/co2_cycle.F90 +++ b/src/physics/cam/co2_cycle.F90 @@ -29,7 +29,7 @@ module co2_cycle ! Namelist variables logical :: co2_flag = .false. ! true => turn on co2 code, namelist variable logical, public, protected :: co2_readFlux_fuel = .false. ! true => read fuel co2 flux from date file, namelist variable - logical :: co2_readFlux_aircraft = .false. ! true => read aircraft co2 flux from date file, namelist variable + logical, public, protected :: co2_readFlux_aircraft = .false. ! true => read aircraft co2 flux from date file, namelist variable !------------------------------------------------------------------------------- ! new constituents From 1422b774c8a973bbf63702972abd1e8e0459786d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 Dec 2025 09:54:36 +0100 Subject: [PATCH 17/31] made tintalgo a namelist variable --- bld/build-namelist | 2 ++ bld/namelist_files/namelist_defaults_cam.xml | 2 ++ bld/namelist_files/namelist_definition.xml | 12 ++++++++++++ src/chemistry/utils/aircraft_emit.F90 | 14 +++++++++++--- src/control/cam_esmf_mod.F90 | 17 +++++++++-------- src/physics/cam/co2_data_flux.F90 | 19 ++++++++++++++++--- 6 files changed, 52 insertions(+), 14 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index b05d872823..d9263c0269 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -828,6 +828,7 @@ if ($co2_cycle) { } else { add_default($nl, 'co2flux_fuel_taxmode', 'val'=>'cycle' ); } + add_default($nl, 'co2flux_fuel_tintalgo'); add_default($nl, 'co2flux_fuel_meshfile'); add_default($nl, 'co2flux_fuel_datafile'); add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year); @@ -845,6 +846,7 @@ if ($co2_cycle) { } else { add_default($nl, 'aircraft_co2_taxmode', 'val'=>'cycle' ); } + add_default($nl, 'aircraft_co2_tintalgo'); add_default($nl, 'aircraft_co2_meshfile'); add_default($nl, 'aircraft_co2_datafile'); add_default($nl, 'aircraft_co2_year_first', 'sim_year'=>$sim_year); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 92e7dba64f..78b31a59df 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -655,6 +655,7 @@ atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc +linear 2000 2000 1 @@ -668,6 +669,7 @@ atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc +linear 2000 2000 1 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 475f5050af..6be3bc7701 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1823,6 +1823,12 @@ Year align to use in co2flux_fuel_datafile. Default: 0 + +Time interpolation algorithm to use for co2flux_fuel_datafile. +Default: linear + + Time extrapolation algorithm to use for co2flux_fuel_datafile. @@ -1861,6 +1867,12 @@ Model year that aligns with aircraft_co2_year_first. Default: set by build-namelist. + +Time interpolation algorithm to use for aircraft_co2_datafile. +Default: linear + + Time extrapolation algorithm to use for aircraft_co2_datafile. diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index 6dc55bfc1a..eaeabfd8b1 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -81,6 +81,7 @@ subroutine aircraft_emit_readnl(nlfile) character(len=cl) :: aircraft_co2_datafile = 'unset' character(len=cl) :: aircraft_co2_meshfile = 'unset' character(len=cs) :: aircraft_co2_taxmode = 'unset' + character(len=cs) :: aircraft_co2_tintalgo = 'unset' integer :: aircraft_co2_year_first = -999 integer :: aircraft_co2_year_last = -999 integer :: aircraft_co2_year_align = -999 @@ -89,6 +90,7 @@ subroutine aircraft_emit_readnl(nlfile) character(len=cl) :: aircraft_h2o_datafile = 'unset' character(len=cl) :: aircraft_h2o_meshfile = 'unset' character(len=cs) :: aircraft_h2o_taxmode = 'unset' + character(len=cs) :: aircraft_h2o_tintalgo = 'unset' integer :: aircraft_h2o_year_first = -999 integer :: aircraft_h2o_year_last = -999 integer :: aircraft_h2o_year_align = -999 @@ -96,6 +98,7 @@ subroutine aircraft_emit_readnl(nlfile) character(len=cs) :: aircraft_slant_dist_fldname = 'ac_SLANT_DIST' character(len=cl) :: aircraft_slant_dist_datafile = 'unset' character(len=cl) :: aircraft_slant_dist_meshfile = 'unset' + character(len=cs) :: aircraft_slant_dist_tintalgo = 'unset' character(len=cs) :: aircraft_slant_dist_taxmode = 'unset' integer :: aircraft_slant_dist_year_first= -999 integer :: aircraft_slant_dist_year_last = -999 @@ -106,13 +109,13 @@ subroutine aircraft_emit_readnl(nlfile) namelist /aircraft_emit_nl/ & aircraft_co2_datafile, aircraft_co2_meshfile, & aircraft_co2_year_first, aircraft_co2_year_last, aircraft_co2_year_align, & - aircraft_co2_taxmode, & + aircraft_co2_taxmode, aircraft_co2_tintalgo, & aircraft_h2o_datafile, aircraft_h2o_meshfile, & aircraft_h2o_year_first, aircraft_h2o_year_last, aircraft_h2o_year_align, & - aircraft_h2o_taxmode, & + aircraft_h2o_taxmode, aircraft_h2o_tintalgo, & aircraft_slant_dist_datafile, aircraft_slant_dist_meshfile, & aircraft_slant_dist_year_first, aircraft_slant_dist_year_last, aircraft_slant_dist_year_align, & - aircraft_slant_dist_taxmode + aircraft_slant_dist_taxmode, aircraft_slant_dist_tintalgo !----------------------------------------------------------------------------- ! Read namelist @@ -143,6 +146,7 @@ subroutine aircraft_emit_readnl(nlfile) forcing(nf)%year_last = aircraft_co2_year_last forcing(nf)%year_align = aircraft_co2_year_align forcing(nf)%taxmode = aircraft_co2_taxmode + forcing(nf)%tintalgo = aircraft_co2_tintalgo end if end if if (trim(aircraft_h2o_datafile) /= 'unset') then @@ -154,6 +158,7 @@ subroutine aircraft_emit_readnl(nlfile) forcing(nf)%year_last = aircraft_h2o_year_last forcing(nf)%year_align = aircraft_h2o_year_align forcing(nf)%taxmode = aircraft_h2o_taxmode + forcing(nf)%tintalgo = aircraft_h2o_tintalgo end if if (trim(aircraft_slant_dist_datafile) /= 'unset') then nf = 3 @@ -164,6 +169,7 @@ subroutine aircraft_emit_readnl(nlfile) forcing(nf)%year_last = aircraft_slant_dist_year_last forcing(nf)%year_align = aircraft_slant_dist_year_align forcing(nf)%taxmode = aircraft_slant_dist_taxmode + forcing(nf)%tintalgo = aircraft_slant_dist_tintalgo end if end if @@ -183,6 +189,8 @@ subroutine aircraft_emit_readnl(nlfile) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_last") call mpi_bcast(forcing(nf)%year_align, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") + call mpi_bcast(forcing(nf)%tintalgo, len(forcing(nf)%tintalgo), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") call mpi_bcast(forcing(nf)%taxmode, len(forcing(nf)%taxmode), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") diff --git a/src/control/cam_esmf_mod.F90 b/src/control/cam_esmf_mod.F90 index 66af8f9c11..b77585788b 100644 --- a/src/control/cam_esmf_mod.F90 +++ b/src/control/cam_esmf_mod.F90 @@ -124,20 +124,22 @@ subroutine cam_esmf_set_areas(model_areas_in, mesh_areas_in, rc) end subroutine cam_esmf_set_areas !===================================================================== - subroutine cam_esmf_global_sum(fldname, flddata, rc) + subroutine cam_esmf_global_sum(fldname, flddata, global_sum_model, global_sum_mesh, rc) ! Arguments character(len=*), intent(in) :: fldname real(r8), intent(in) :: flddata(:) + real(r8), intent(out) :: global_sum_model + real(r8), intent(out) :: global_sum_mesh integer , intent(out) :: rc ! local variables type(ESMF_VM) :: vm integer :: ng real(r8) :: local_sum_model(1) - real(r8) :: global_sum_model(1) real(r8) :: local_sum_mesh(1) - real(r8) :: global_sum_mesh(1) + real(r8) :: global_model(1) + real(r8) :: global_mesh(1) !--------------------------------------- rc = ESMF_SUCCESS @@ -151,16 +153,15 @@ subroutine cam_esmf_global_sum(fldname, flddata, rc) call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMAllreduce(vm, senddata=local_sum_model, recvdata=global_sum_model, & + call ESMF_VMAllreduce(vm, senddata=local_sum_model, recvdata=global_model, & count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMAllreduce(vm, senddata=local_sum_mesh, recvdata=global_sum_mesh, & + call ESMF_VMAllreduce(vm, senddata=local_sum_mesh, recvdata=global_mesh, & count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(iulog,'(a)') 'Global sum for forcing field '//trim(fldname) - write(iulog,'(a,d13.5)') ' global sum with model areas = ',global_sum_model(1) - write(iulog,'(a,d13.5)') ' global sum with mesh areas = ',global_sum_mesh(1) + global_sum_model = global_model(1) + global_sum_mesh = global_mesh(1) end subroutine cam_esmf_global_sum diff --git a/src/physics/cam/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 index 1ea1998b1d..96489ca657 100644 --- a/src/physics/cam/co2_data_flux.F90 +++ b/src/physics/cam/co2_data_flux.F90 @@ -9,7 +9,7 @@ module co2_data_flux use ESMF, only: ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT use cam_logfile, only: iulog use cam_abortutils, only: endrun - use spmd_utils, only: iam + use spmd_utils, only: iam, masterproc use dshr_strdata_mod, only: shr_strdata_type implicit none @@ -35,6 +35,7 @@ module co2_data_flux integer :: co2flux_fuel_year_first = -999 ! first year in stream to use integer :: co2flux_fuel_year_last = -999 ! last year in stream to use integer :: co2flux_fuel_year_align = -999 ! align stream_year_first + character(len=cs) :: co2flux_fuel_tintalgo = 'unset' ! time interpolation [linear, lower, upper] character(len=cs) :: co2flux_fuel_taxmode = 'unset' ! time extraploation [cycle, extend or limit] logical :: debug = .false. @@ -70,6 +71,7 @@ subroutine co2_data_flux_readnl(nlfile) co2flux_fuel_year_first, & ! first year in stream to use co2flux_fuel_year_last, & ! last year in stream to use co2flux_fuel_year_align, & ! align stream_year_first + co2flux_fuel_tintalgo, & ! time extraploation [linear, lower, upper] co2flux_fuel_taxmode ! time extraploation [cycle, extend or limit] !-------------------------------------------- @@ -95,6 +97,8 @@ subroutine co2_data_flux_readnl(nlfile) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_last") call mpi_bcast(co2flux_fuel_year_align, 1, mpi_integer, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_align") + call mpi_bcast(co2flux_fuel_tintalgo, len(co2flux_fuel_tintalgo), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_tintalgo") call mpi_bcast(co2flux_fuel_taxmode, len(co2flux_fuel_taxmode), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode") @@ -142,7 +146,7 @@ subroutine co2_data_flux_init () stream_offset = 0, & stream_taxmode = trim(co2flux_fuel_taxmode), & stream_dtlimit = 1.0e30_r8, & - stream_tintalgo = 'linear', & + stream_tintalgo = trim(co2flux_fuel_tintalgo), & stream_name = 'CO2 forcing data ', & rc = rc) call chkrc(rc,__LINE__,u_FILE_u) @@ -172,6 +176,7 @@ subroutine co2_data_flux_advance() integer :: mcdate ! Current model date (yyyymmdd) integer :: rc logical :: first_time = .true. + real(r8) :: global_sum_model, global_sum_mesh real(r8), pointer :: dataptr1d(:) character(len=*), parameter :: subname = 'co2_data_flux_advance' !---------------------------------------------------------------------------- @@ -193,8 +198,16 @@ subroutine co2_data_flux_advance() call chkrc(rc,__LINE__,u_FILE_u) if (debug) then - call cam_esmf_global_sum(trim(data_flux_fuel%varname), dataptr1d, rc) + if (masterproc) then + write(iulog,*) + write(iulog,'(a)')'Calling cam_esmf_global_sum from co2_data_flux' + end if + call cam_esmf_global_sum(trim(data_flux_fuel%varname), dataptr1d, & + global_sum_model, global_sum_mesh, rc) call chkrc(rc,__LINE__,u_FILE_u) + write(iulog,'(a)') 'Global sum for forcing field '//trim(data_flux_fuel%varname) + write(iulog,'(a,d20.10)') ' global sum with model areas = ',global_sum_model + write(iulog,'(a,d20.10)') ' global sum with mesh areas = ',global_sum_mesh end if g = 1 From 0dae7b0d747b2cd1a22e77453a43a4b39fe8f804 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 Dec 2025 17:00:54 +0100 Subject: [PATCH 18/31] addressed issues in PR --- bld/build-namelist | 18 +- bld/namelist_files/namelist_defaults_cam.xml | 2 - bld/namelist_files/namelist_definition.xml | 24 ++- src/chemistry/utils/aircraft_emit.F90 | 73 ++++++--- src/chemistry/utils/tracer_data.F90 | 163 +++++++------------ src/physics/cam/co2_data_flux.F90 | 46 +++++- 6 files changed, 182 insertions(+), 144 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index d9263c0269..ed9e0214d7 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -700,8 +700,10 @@ if (defined $nl->get_value('sim_year')) { # If sim_year is input as a range of years, then select the first year # to use with some datasets my $sim_year_start = $sim_year; +my $sim_year_end = $sim_year; if ($sim_year =~ /(\d+)-(\d+)/) { $sim_year_start = $1; + $sim_year_end = $2; } # Setup default ndep streams only if not simple_phys or aqua_mode and @@ -824,16 +826,16 @@ if ($co2_cycle) { # (user specification has higher precedence than the true value set above) if ($nl->get_value('co2_readflux_fuel') =~ /$TRUE/io) { if ($sim_year =~ /(\d+)-(\d+)/) { - add_default($nl, 'co2flux_fuel_taxmode', 'val'=>'limit' ); + add_default($nl, 'co2flux_fuel_taxmode', 'val'=>'extend' ); } else { add_default($nl, 'co2flux_fuel_taxmode', 'val'=>'cycle' ); } add_default($nl, 'co2flux_fuel_tintalgo'); add_default($nl, 'co2flux_fuel_meshfile'); add_default($nl, 'co2flux_fuel_datafile'); - add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year); - add_default($nl, 'co2flux_fuel_year_last' , 'sim_year'=>$sim_year); - add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year); + add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year_start); + add_default($nl, 'co2flux_fuel_year_last' , 'sim_year'=>$sim_year_end); + add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year_start); } add_default($nl, 'co2_readflux_aircraft', 'val'=>'.true.'); @@ -842,16 +844,16 @@ if ($co2_cycle) { # (user specification has higher precedence than the true value set above) if ($nl->get_value('co2_readflux_aircraft') =~ /$TRUE/io) { if ($sim_year =~ /(\d+)-(\d+)/) { - add_default($nl, 'aircraft_co2_taxmode', 'val'=>'limit' ); + add_default($nl, 'aircraft_co2_taxmode', 'val'=>'extend' ); } else { add_default($nl, 'aircraft_co2_taxmode', 'val'=>'cycle' ); } add_default($nl, 'aircraft_co2_tintalgo'); add_default($nl, 'aircraft_co2_meshfile'); add_default($nl, 'aircraft_co2_datafile'); - add_default($nl, 'aircraft_co2_year_first', 'sim_year'=>$sim_year); - add_default($nl, 'aircraft_co2_year_last' , 'sim_year'=>$sim_year); - add_default($nl, 'aircraft_co2_year_align', 'sim_year'=>$sim_year); + add_default($nl, 'aircraft_co2_year_first', 'sim_year'=>$sim_year_start); + add_default($nl, 'aircraft_co2_year_last' , 'sim_year'=>$sim_year_end); + add_default($nl, 'aircraft_co2_year_align', 'sim_year'=>$sim_year_start); } } } diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 78b31a59df..92e7dba64f 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -655,7 +655,6 @@ atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc -linear 2000 2000 1 @@ -669,7 +668,6 @@ atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc -linear 2000 2000 1 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 6be3bc7701..c50e2b64f8 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1824,9 +1824,10 @@ Default: 0 + group="co2_ffuel_nl" valid_values="linear,lower,upper,nearest"> Time interpolation algorithm to use for co2flux_fuel_datafile. -Default: linear +If not set by user, then set to 'nearest' if the variable 'time_bnds' is in +the forcing file otherwise, set to 'linear' + group="aircraft_emit_nl" valid_values="linear,lower,upper,nearest"> Time interpolation algorithm to use for aircraft_co2_datafile. -Default: linear +If not set by user, then set to 'nearest' if the variable 'time_bnds' is in +the forcing file otherwise, set to 'linear' + +Time interpolation algorithm to use for aircraft_h2o_datafile. +If not set by user, then set to 'nearest' if the variable 'time_bnds' is in +the forcing file otherwise, set to 'linear' + + Time extrapolation algorithm to use for aircraft_h2o_datafile. @@ -7071,6 +7080,13 @@ Last year of the aircraft_slant_dist to use. Model year that aligns with aircraft_year_first. + +Time interpolation algorithm to use for aircraft_slant_dist_datafile. +If not set by user, then set to 'nearest' if the variable 'time_bnds' is in +the forcing file otherwise, set to 'linear' + + Time extrapolation algorithm to use for aircraft_slant_dist. diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index eaeabfd8b1..c27d412a27 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -26,6 +26,9 @@ module aircraft_emit public :: aircraft_emit_readnl public :: get_aircraft + private :: get_vertical_dimension + private :: interpz_conserve + integer, parameter :: N_AERO = 3 character(len=13) :: aero_names(N_AERO) = & (/'ac_CO2 ','ac_H2O ','ac_SLANT_DIST'/) @@ -68,6 +71,10 @@ subroutine aircraft_emit_readnl(nlfile) use spmd_utils, only: mpicom, masterprocid use spmd_utils, only: mpi_integer, mpi_logical, mpi_character use co2_cycle, only: co2_readflux_aircraft + use cam_pio_utils, only: cam_pio_openfile + use pio, only: PIO_BCAST_ERROR, PIO_NOERR, PIO_NOWRITE + use pio, only: file_desc_t, pio_seterrorhandling, pio_inq_varid + use pio, only: pio_closefile ! Arguments character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -76,6 +83,10 @@ subroutine aircraft_emit_readnl(nlfile) integer :: nf, ni integer :: index integer :: unitn, ierr + type(file_desc_t) :: fileid + integer :: err_handling + integer :: varid + logical :: use_time_bnds character(len=cs) :: aircraft_co2_fldname = 'ac_CO2' character(len=cl) :: aircraft_co2_datafile = 'unset' @@ -200,6 +211,24 @@ subroutine aircraft_emit_readnl(nlfile) forcing(nf)%mapalgo = 'nn' end if + ! Overwrite forcing(nf)%tintalgo if it is set to 'unset' + ! Check if the data file has a time_bnds variable and if so set the time interpolation + ! type to 'nearest' otherwise set it to 'linear' + + if (trim(forcing(nf)%tintalgo) == 'unset') then + call cam_pio_openfile( fileid, forcing(nf)%datafile, PIO_NOWRITE ) + call pio_seterrorhandling( fileid, PIO_BCAST_ERROR, oldmethod=err_handling ) + ierr = pio_inq_varid( fileid, 'time_bnds', varid ) + call pio_seterrorhandling( fileid, err_handling) + use_time_bnds = (ierr == PIO_NOERR) + if (use_time_bnds) then + forcing(nf)%tintalgo = 'nearest' + else + forcing(nf)%tintalgo = 'linear' + end if + call pio_closefile( fileid ) + end if + ! obtain index in aero_names module array index = 0 do ni = 1,size(aero_names) @@ -217,15 +246,16 @@ subroutine aircraft_emit_readnl(nlfile) ! diagnostics if (masterproc) then write(iulog,*) ' ' - write(iulog,'(a)' ) ' aircraft init settings for: '//trim(forcing(nf)%fldname) - write(iulog,'(a,a)') ' aircraft datafile = ',trim(forcing(nf)%datafile) - write(iulog,'(a,a)') ' aircraft meshfile = ',trim(forcing(nf)%meshfile) - write(iulog,'(a,a)') ' aircraft mapalgo = ',trim(forcing(nf)%mapalgo) - write(iulog,'(a,a)') ' aircraft tintalgo = ',trim(forcing(nf)%tintalgo) - write(iulog,'(a,i8)')' aircraft year_first = ',forcing(nf)%year_first - write(iulog,'(a,i8)')' aircraft year_last = ',forcing(nf)%year_last - write(iulog,'(a,i8)')' aircraft year_align = ',forcing(nf)%year_align - write(iulog,'(a,i8)')' aircraft index_map for '//trim(forcing(nf)%fldname)//' = ',& + write(iulog,'(2a)' ) ' aircraft init settings for: ',trim(forcing(nf)%fldname) + write(iulog,'(2a)' ) ' aircraft datafile = ',trim(forcing(nf)%datafile) + write(iulog,'(2a)' ) ' aircraft meshfile = ',trim(forcing(nf)%meshfile) + write(iulog,'(2a)' ) ' aircraft mapalgo = ',trim(forcing(nf)%mapalgo) + write(iulog,'(2a)' ) ' aircraft tintalgo = ',trim(forcing(nf)%tintalgo) + write(iulog,'(2a)' ) ' aircraft taxmode = ',trim(forcing(nf)%taxmode) + write(iulog,'(a,i0)')' aircraft year_first = ',forcing(nf)%year_first + write(iulog,'(a,i0)')' aircraft year_last = ',forcing(nf)%year_last + write(iulog,'(a,i0)')' aircraft year_align = ',forcing(nf)%year_align + write(iulog,'(a,i0)')' aircraft index_map for '//trim(forcing(nf)%fldname)//' = ',& forcing(nf)%index_map write(iulog,*) ' ' end if @@ -285,12 +315,12 @@ subroutine aircraft_emit_init() character(len=*), parameter :: subname = 'aircraft_emit_init' !----------------------------------------------- + call phys_getopts(history_chemistry_out=history_chemistry) + loop_n_aero: do nf = 1,N_AERO if (trim(forcing(nf)%datafile) /= 'unset') then ! Open file - if (masterproc) then - end if call cam_pio_openfile( pioid, forcing(nf)%datafile, PIO_NOWRITE) ! Determine units @@ -332,14 +362,10 @@ subroutine aircraft_emit_init() ! Add field to cam history output call addfld(trim(forcing(nf)%fldname), (/ 'lev' /), 'A', trim(forcing(nf)%fldunits), & 'aircraft emission '//trim(forcing(nf)%fldname)) - call phys_getopts(history_chemistry_out=history_chemistry) if (history_chemistry) then call add_default( trim(forcing(nf)%fldname), 1, ' ' ) end if - ! Get index in pbuf - forcing(nf)%pbuf_index = pbuf_get_index(forcing(nf)%fldname) - end if end do loop_n_aero @@ -638,21 +664,30 @@ subroutine get_vertical_dimension( fid, dname, dsize, data ) ! Local variables integer :: vid, ierr, id integer :: err_handling + character(len=*), parameter :: subname = 'get_vertical_dimension' !------------------------------------------------------------------ - call pio_seterrorhandling( fid, PIO_BCAST_ERROR, oldmethod=err_handling) + call pio_seterrorhandling(fid, PIO_BCAST_ERROR, oldmethod=err_handling) ierr = pio_inq_dimid( fid, dname, id ) - call pio_seterrorhandling( fid, err_handling) if ( ierr == PIO_NOERR ) then ierr = pio_inq_dimlen( fid, id, dsize ) + if (ierr /= PIO_NOERR) then + call endrun(trim(subname)//': failed on pio_inq_dimid') + end if allocate( data(dsize), stat=ierr ) if ( ierr /= 0 ) then - write(iulog,*) 'get_dimension: data allocation error = ',ierr - call endrun('get_dimension: failed to allocate data array') + call endrun(trim(subname)//': failed to allocate data array') end if ierr = pio_inq_varid( fid, dname, vid ) + if (ierr /= PIO_NOERR) then + call endrun(trim(subname)//': failed on pio_inq_varid') + end if ierr = pio_get_var( fid, vid, data ) + if (ierr /= PIO_NOERR) then + call endrun(trim(subname)//': failed on pio_get_var') + end if endif + call pio_seterrorhandling(fid, err_handling) end subroutine get_vertical_dimension diff --git a/src/chemistry/utils/tracer_data.F90 b/src/chemistry/utils/tracer_data.F90 index 74ca0405ae..2c8d937703 100644 --- a/src/chemistry/utils/tracer_data.F90 +++ b/src/chemistry/utils/tracer_data.F90 @@ -26,11 +26,11 @@ module tracer_data pio_get_var, pio_get_att, pio_nowrite, pio_inq_dimlen, & pio_inq_vardimid, pio_inq_dimlen, pio_closefile, & pio_inquire_variable + use string_utils, only: int2str implicit none private ! all unless made public - save public :: trfld, input3d, input2d, trfile public :: trcdata_init @@ -397,14 +397,12 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( file%hyam(file%nlev), file%hybm(file%nlev), stat=astat ) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%hyam,file%hybm allocation error = ',astat - call endrun('trcdata_init: failed to allocate file%hyam and file%hybm arrays') + call endrun('trcdata_init: failed to allocate file%hyam and file%hybm arrays, error code = '//int2str(astat)) end if allocate( file%hyai(file%nlev+1), file%hybi(file%nlev+1), stat=astat ) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%hyai,file%hybi allocation error = ',astat - call endrun('trcdata_init: failed to allocate file%hyai and file%hybi arrays') + call endrun('trcdata_init: failed to allocate file%hyai and file%hybi arrays, error code = '//int2str(astat)) end if call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR, oldmethod=err_handling) @@ -429,24 +427,20 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( file%ps_in(1)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: failed to allocate file%ps_in(1)%data array; error = ',astat - call endrun + call endrun('trcdata_init: failed to allocate file%ps_in(1)%data array; error = '//int2str(astat)) end if allocate( file%ps_in(2)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: failed to allocate file%ps_in(2)%data array; error = ',astat - call endrun + call endrun('trcdata_init: failed to allocate file%ps_in(2)%data array; error = '//int2str(astat)) end if if( file%fill_in_months ) then allocate( file%ps_in(3)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: failed to allocate file%ps_in(3)%data array; error = ',astat - call endrun + call endrun('trcdata_init: failed to allocate file%ps_in(3)%data array; error = '//int2str(astat)) end if allocate( file%ps_in(4)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: failed to allocate file%ps_in(4)%data array; error = ',astat - call endrun + call endrun('trcdata_init: failed to allocate file%ps_in(4)%data array; error = '//int2str(astat)) end if end if endif @@ -459,8 +453,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & ! get netcdf variable id for the field ierr = pio_inq_varid( file%curr_fileid, flds(f)%srcnam, flds(f)%var_id ) if (ierr/=pio_noerr) then - call endrun('trcdata_init: Cannot find var "'//trim(flds(f)%srcnam)// & - '" in file "'//trim(file%curr_filename)//'"') + call endrun('trcdata_init: Cannot find var "'//trim(flds(f)%srcnam)//'" in file "'//trim(file%curr_filename)//'"') endif ! determine if the field has a vertical dimension @@ -482,21 +475,19 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( flds(f)%data(pcols,pver,begchunk:endchunk), stat=astat ) endif if( astat/= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%data array; error = ',astat - call endrun + call endrun('trcdata_init: failed to allocate flds(f)%data array; error = '//int2str(astat)) end if else flds(f)%pbuf_ndx = pbuf_get_index(flds(f)%fldnam,errcode) endif if (flds(f)%srf_fld) then - allocate( flds(f)%input(1)%data(pcols,1,begchunk:endchunk), stat=astat ) + allocate( flds(f)%input(1)%data(pcols,1,begchunk:endchunk), stat=astat) else - allocate( flds(f)%input(1)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) + allocate( flds(f)%input(1)%data(pcols,file%nlev,begchunk:endchunk), stat=astat) endif if( astat/= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%input(1)%data array; error = ',astat - call endrun + call endrun('trcdata_init: failed to allocate flds(f)%input(1)%data array; error = '//int2str(astat)) end if if (flds(f)%srf_fld) then allocate( flds(f)%input(2)%data(pcols,1,begchunk:endchunk), stat=astat ) @@ -504,28 +495,25 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & allocate( flds(f)%input(2)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) endif if( astat/= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%input(2)%data array; error = ',astat - call endrun + call endrun('trcdata_init: failed to allocate flds(f)%input(2)%data array; error = '//int2str(astat)) end if if( file%fill_in_months ) then if (flds(f)%srf_fld) then - allocate( flds(f)%input(3)%data(pcols,1,begchunk:endchunk), stat=astat ) + allocate( flds(f)%input(3)%data(pcols,1,begchunk:endchunk), stat=astat) else - allocate( flds(f)%input(3)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) + allocate( flds(f)%input(3)%data(pcols,file%nlev,begchunk:endchunk), stat=astat) endif if( astat/= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%input(3)%data array; error = ',astat - call endrun + call endrun('trcdata_init: failed to allocate flds(f)%input(3)%data array; error = '//int2str(astat)) end if if (flds(f)%srf_fld) then - allocate( flds(f)%input(4)%data(pcols,1,begchunk:endchunk), stat=astat ) + allocate( flds(f)%input(4)%data(pcols,1,begchunk:endchunk), stat=astat) else - allocate( flds(f)%input(4)%data(pcols,file%nlev,begchunk:endchunk), stat=astat ) + allocate( flds(f)%input(4)%data(pcols,file%nlev,begchunk:endchunk), stat=astat) endif if( astat/= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: failed to allocate flds(f)%input(4)%data array; error = ',astat - call endrun + call endrun('trcdata_init: failed to allocate flds(f)%input(4)%data array; error = '//int2str(astat)) end if endif @@ -625,36 +613,30 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & deallocate(phi,lam) -! weight_x & weight_y are weighting function for x & y interpolation + ! weight_x & weight_y are weighting function for x & y interpolation allocate(file%weight_x(plon,file%nlon), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%weight_x allocation error = ',astat - call endrun('trcdata_init: failed to allocate weight_x array') + call endrun('trcdata_init: file%weight_x allocation error = '//int2str(astat)) end if allocate(file%weight_y(plat,file%nlat), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%weight_y allocation error = ',astat - call endrun('trcdata_init: failed to allocate weight_y array') + call endrun('trcdata_init: file%weight_y allocation error = '//int2str(astat)) end if allocate(file%count_x(plon), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%count_x allocation error = ',astat - call endrun('trcdata_init: failed to allocate count_x array') + call endrun('trcdata_init: file%count_x allocation error = '//int2str(astat)) end if allocate(file%count_y(plat), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%count_y allocation error = ',astat - call endrun('trcdata_init: failed to allocate count_y array') + call endrun('trcdata_init: file%count_y allocation error = '//int2str(astat)) end if allocate(file%index_x(plon,file%nlon), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%index_x allocation error = ',astat - call endrun('trcdata_init: failed to allocate index_x array') + call endrun('trcdata_init: file%index_x allocation error = '//int2str(astat)) end if allocate(file%index_y(plat,file%nlat), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%index_y allocation error = ',astat - call endrun('trcdata_init: failed to allocate index_y array') + call endrun('trcdata_init: file%index_y allocation error = '//int2str(astat)) end if file%weight_x(:,:) = 0.0_r8 file%weight_y(:,:) = 0.0_r8 @@ -666,33 +648,28 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & if( file%dist ) then allocate(file%weight0_x(plon,file%nlon), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%weight0_x allocation error = ',astat - call endrun('trcdata_init: failed to allocate weight0_x array') + write(iulog,'(a,i0)') + call endrun('trcdata_init: file%weight0_x allocation error = '//int2str(astat)) end if allocate(file%weight0_y(plat,file%nlat), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%weight0_y allocation error = ',astat - call endrun('trcdata_init: failed to allocate weight0_y array') + call endrun('trcdata_init: file%weight0_y allocation error = '//int2str(astat)) end if allocate(file%count0_x(plon), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%count0_x allocation error = ',astat - call endrun('trcdata_init: failed to allocate count0_x array') + call endrun('trcdata_init: file%count0_x allocation error = '//int2str(astat)) end if allocate(file%count0_y(plat), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%count0_y allocation error = ',astat - call endrun('trcdata_init: failed to allocate count0_y array') + call endrun('trcdata_init: file%count0_y allocation error = '//int2str(astat)) end if allocate(file%index0_x(plon,file%nlon), stat=astat) - if( astat /= '(a,i8)' ) then - write(iulog,'(a,i8)') 'trcdata_init: file%index0_x allocation error = ',astat - call endrun('trcdata_init: failed to allocate index0_x array') + if( astat /= 0 ) then + call endrun('trcdata_init: file%index0_x allocation error = '//int2str(astat)) end if allocate(file%index0_y(plat,file%nlat), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i8)') 'trcdata_init: file%index0_y allocation error = ',astat - call endrun('trcdata_init: failed to allocate index0_y array') + call endrun('trcdata_init: file%index0_y allocation error = '//int2str(astat)) end if file%weight0_x(:,:) = 0.0_r8 file%weight0_y(:,:) = 0.0_r8 @@ -824,7 +801,7 @@ subroutine advance_trcdata( flds, file, state, pbuf2d ) call t_startf('read_next_trcdata') call read_next_trcdata( flds, file ) call t_stopf('read_next_trcdata') - if(masterproc) write(iulog,*) 'READ_NEXT_TRCDATA ', flds%fldnam + if(masterproc) write(iulog,'(2a)') 'READ_NEXT_TRCDATA ',flds%fldnam end if endif @@ -1040,9 +1017,7 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ end if istat = incstr( fn_new(:pos), 1 ) if( istat /= 0 ) then - write(iulog,*) 'incr_flnm: incstr returned ', istat - write(iulog,*) ' while trying to decrement ',trim( fn_new ) - call endrun + call endrun('incr_flnm: incstr returned '//int2str(istat)//' while trying to decrement '//trim(fn_new)) end if else @@ -1186,8 +1161,7 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found allocate( all_data_times( all_tsize ), stat=astat ) if( astat/= 0 ) then - write(iulog,*) 'find_times: failed to allocate all_data_times array; error = ',astat - call endrun + call endrun('find_times: failed to allocate all_data_times array; error = '//int2str(astat)) end if all_data_times(:curr_tsize) = file%curr_data_times(:) @@ -1247,8 +1221,7 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found deallocate( all_data_times, stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'find_times: failed to deallocate all_data_times array; error = ',astat - call endrun + call endrun('find_times: failed to deallocate all_data_times array; error = '//int2str(astat)) end if if ( .not. file%cyclical ) then @@ -1476,14 +1449,14 @@ subroutine read_2d_trc( fid, vid, loc_arr, strt, cnt, file, order ) nullify(wrk2d_in) allocate( wrk2d(cnt(1),cnt(2)), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'read_2d_trc: wrk2d allocation error = ',ierr + write(iulog,'(a,i0)') 'read_2d_trc: wrk2d allocation error = ',ierr call endrun end if if(order(1)/=1 .or. order(2)/=2 .or. cnt(1)/=file%nlon .or. cnt(2)/=file%nlat) then allocate( wrk2d_in(file%nlon, file%nlat), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'read_2d_trc: wrk2d_in allocation error = ',ierr + write(iulog,'(a,i0)') 'read_2d_trc: wrk2d_in allocation error = ',ierr call endrun end if end if @@ -1591,14 +1564,14 @@ subroutine read_za_trc( fid, vid, loc_arr, strt, cnt, file, order ) nullify(wrk2d_in) allocate( wrk2d(cnt(1),cnt(2)), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'read_2d_trc: wrk2d allocation error = ',ierr + write(iulog,'(a,i0)') 'read_2d_trc: wrk2d allocation error = ',ierr call endrun end if if(order(1)/=1 .or. order(2)/=2 .or. cnt(1)/=file%nlat .or. cnt(2)/=file%nlev) then allocate( wrk2d_in(file%nlat, file%nlev), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'read_2d_trc: wrk2d_in allocation error = ',ierr + write(iulog,'(a,i0)') 'read_2d_trc: wrk2d_in allocation error = ',ierr call endrun end if end if @@ -1731,7 +1704,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) nullify(wrk3d_in) allocate(wrk3d(cnt(1),cnt(2),cnt(3)), stat=ierr) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'read_3d_trc: wrk3d allocation error = ',ierr + write(iulog,'(a,i0)') 'read_3d_trc: wrk3d allocation error = ',ierr call endrun end if @@ -1741,7 +1714,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) cnt(1)/=file%nlon.or.cnt(2)/=file%nlat.or.cnt(3)/=file%nlev) then allocate(wrk3d_in(file%nlon,file%nlat,file%nlev),stat=ierr) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'read_3d_trc: wrk3d allocation error = ',ierr + write(iulog,'(a,i0)') 'read_3d_trc: wrk3d allocation error = ',ierr call endrun end if wrk3d_in = reshape( wrk3d(:,:,:),(/file%nlon,file%nlat,file%nlev/), order=order ) @@ -1802,8 +1775,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) deallocate( wrk3d_in, stat=astat ) end if if( astat/= 0 ) then - write(iulog,'(a,i8)') 'read_3d_trc: failed to deallocate wrk3d array; error = ',astat - call endrun + call endrun('read_3d_trc: failed to deallocate wrk3d array; error = '//int2str(astat)) endif if(dycore_is('LR')) call polar_average(file%nlev, loc_arr) end subroutine read_3d_trc @@ -2024,13 +1996,13 @@ subroutine get_dimension( fid, dname, dsize, dimid, data ) if ( associated(data) ) then deallocate(data, stat=ierr) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'get_dimension: data deallocation error = ',ierr + write(iulog,'(a,i0)') 'get_dimension: data deallocation error = ',ierr call endrun('get_dimension: failed to deallocate data array') end if endif allocate( data(dsize), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'get_dimension: data allocation error = ',ierr + write(iulog,'(a,i0)') 'get_dimension: data allocation error = ',ierr call endrun('get_dimension: failed to allocate data array') end if @@ -2065,8 +2037,7 @@ subroutine set_cycle_indices( fileid, cyc_ndx_beg, cyc_ndx_end, cyc_yr ) allocate( dates(timesize), stat=astat ) if( astat/= 0 ) then - write(*,*) 'set_cycle_indices: failed to allocate dates array; error = ',astat - call endrun + call endrun('set_cycle_indices: failed to allocate dates array; error = '//int2str(astat)) end if ierr = pio_inq_varid( fileid, 'date', dateid ) @@ -2083,12 +2054,10 @@ subroutine set_cycle_indices( fileid, cyc_ndx_beg, cyc_ndx_end, cyc_yr ) enddo deallocate( dates, stat=astat ) if( astat/= 0 ) then - write(*,*) 'set_cycle_indices: failed to deallocate dates array; error = ',astat - call endrun + call endrun('set_cycle_indices: failed to deallocate dates array; error = '//int2str(astat)) end if if (cyc_ndx_beg < 0) then - write(*,*) 'set_cycle_indices: cycle year not found : ' , cyc_yr - call endrun('set_cycle_indices: cycle year not found') + call endrun('set_cycle_indices: cycle year not found : '//int2str(cyc_yr)) endif end subroutine set_cycle_indices @@ -2136,25 +2105,23 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ if ( associated(times) ) then deallocate(times, stat=ierr) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'open_trc_datafile: data deallocation error = ',ierr + write(iulog,'(a,i0)') 'open_trc_datafile: data deallocation error = ',ierr call endrun('open_trc_datafile: failed to deallocate data array') end if endif allocate( times(timesize), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i8)') 'open_trc_datafile: data allocation error = ',ierr + write(iulog,'(a,i0)') 'open_trc_datafile: data allocation error = ',ierr call endrun('open_trc_datafile: failed to allocate data array') end if allocate( dates(timesize), stat=astat ) if( astat/= 0 ) then - if(masterproc) write(iulog,'(a,i8)') 'open_trc_datafile: failed to allocate dates array; error = ',astat - call endrun + call endrun('open_trc_datafile: failed to allocate dates array; error = '//int2str(astat)) end if allocate( datesecs(timesize), stat=astat ) if( astat/= 0 ) then - if(masterproc) write(iulog,'(a,i8)') 'open_trc_datafile: failed to allocate datesec array; error = ',astat - call endrun + call endrun('open_trc_datafile: failed to allocate datesec array; error = '//int2str(astat)) end if ierr = pio_inq_varid( piofile, 'date', dateid ) @@ -2191,18 +2158,15 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ deallocate( dates, stat=astat ) if( astat/= 0 ) then - if(masterproc) write(iulog,'(a,i8)') 'open_trc_datafile: failed to deallocate dates array; error = ',astat - call endrun + call endrun('open_trc_datafile: failed to deallocate dates array; error = '//int2str(astat)) end if deallocate( datesecs, stat=astat ) if( astat/= 0 ) then - if(masterproc) write(iulog,'(a,i8)') 'open_trc_datafile: failed to deallocate datesec array; error = ',astat - call endrun + call endrun('open_trc_datafile: failed to deallocate datesec array; error = '//int2str(astat)) end if if ( present(cyc_yr) .and. present(cyc_ndx_beg) ) then if (cyc_ndx_beg < 0) then - write(iulog,'(a,i8)') 'open_trc_datafile: cycle year not found : ' , cyc_yr call endrun('open_trc_datafile: cycle year not found '//trim(filepath)) endif endif @@ -2228,8 +2192,7 @@ subroutine specify_fields( specifier, fields ) allocate(fld_name(nflds), src_name(nflds), stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'specify_fields: failed to allocate fld_name, src_name arrays; error = ',astat - call endrun + call endrun('specify_fields: failed to allocate fld_name, src_name arrays; error = '//int2str(astat)) end if fld_cnt = 0 @@ -2266,8 +2229,7 @@ subroutine specify_fields( specifier, fields ) !----------------------------------------------------------------------- allocate( fields(fld_cnt), stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'specify_fields: failed to allocate fields array; error = ',astat - call endrun + call endrun('specify_fields: failed to allocate fields array; error = '//int2str(astat)) end if do i = 1,fld_cnt @@ -2822,13 +2784,11 @@ subroutine advance_file(file) !----------------------------------------------------------------------- deallocate( file%curr_data_times, stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'advance_file: failed to deallocate file%curr_data_times array; error = ',astat - call endrun + call endrun('advance_file: failed to deallocate file%curr_data_times array; error = '//int2str(astat)) end if allocate( file%curr_data_times( size( file%next_data_times ) ), stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'advance_file: failed to allocate file%curr_data_times array; error = ',astat - call endrun + call endrun('advance_file: failed to allocate file%curr_data_times array; error = '//int2str(astat)) end if file%curr_data_times(:) = file%next_data_times(:) @@ -2839,8 +2799,7 @@ subroutine advance_file(file) deallocate( file%next_data_times, stat=astat ) if( astat/= 0 ) then - write(iulog,'(a,i8)') 'advance_file: failed to deallocate file%next_data_times array; error = ',astat - call endrun + call endrun('advance_file: failed to deallocate file%next_data_times array; error = '//int2str(astat)) end if nullify( file%next_data_times ) diff --git a/src/physics/cam/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 index 96489ca657..165732c56b 100644 --- a/src/physics/cam/co2_data_flux.F90 +++ b/src/physics/cam/co2_data_flux.F90 @@ -40,6 +40,8 @@ module co2_data_flux logical :: debug = .false. + logical :: first_advance_call = .true. + character(*),parameter :: u_FILE_u = __FILE__ !=============================================================================== @@ -56,6 +58,10 @@ subroutine co2_data_flux_readnl(nlfile) use spmd_utils, only: mpi_logical, mpi_character, mpi_integer use cam_logfile, only: iulog use cam_abortutils, only: endrun + use cam_pio_utils, only: cam_pio_openfile + use pio, only: PIO_BCAST_ERROR, PIO_NOERR, PIO_NOWRITE + use pio, only: file_desc_t, pio_seterrorhandling, pio_inq_varid + use pio, only: pio_closefile ! Arguments character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -63,6 +69,10 @@ subroutine co2_data_flux_readnl(nlfile) ! Local variables integer :: unitn, ierr character(len=256) :: msg + type(file_desc_t) :: fileid + integer :: err_handling + integer :: varid + logical :: use_time_bnds character(len=*), parameter :: subname = 'co2_cycle_readnl' namelist /co2_ffuel_nl/ & @@ -102,6 +112,24 @@ subroutine co2_data_flux_readnl(nlfile) call mpi_bcast(co2flux_fuel_taxmode, len(co2flux_fuel_taxmode), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode") + ! Overwrite co2flux_fuel_tintalgo if it is set to 'unset' + ! Check if the data file has a time_bnds variable and if so set the time interpolation + ! type to 'nearest' otherwise set it to 'linear' + + if (trim(co2flux_fuel_tintalgo) == 'unset') then + call cam_pio_openfile( fileid, co2flux_fuel_datafile, PIO_NOWRITE ) + call pio_seterrorhandling( fileid, PIO_BCAST_ERROR, oldmethod=err_handling ) + ierr = pio_inq_varid( fileid, 'time_bnds', varid ) + call pio_seterrorhandling( fileid, err_handling) + use_time_bnds = (ierr == PIO_NOERR) + if (use_time_bnds) then + co2flux_fuel_tintalgo = 'nearest' + else + co2flux_fuel_tintalgo = 'linear' + end if + call pio_closefile( fileid ) + end if + end subroutine co2_data_flux_readnl !=============================================================================== @@ -168,23 +196,21 @@ subroutine co2_data_flux_advance() use cam_esmf_mod , only : cam_esmf_global_sum ! Local variables - integer :: icol,lchnk,g + integer :: icol,lchnk,gindx 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) integer :: rc - logical :: first_time = .true. real(r8) :: global_sum_model, global_sum_mesh real(r8), pointer :: dataptr1d(:) - character(len=*), parameter :: subname = 'co2_data_flux_advance' !---------------------------------------------------------------------------- ! Initialize stream data type for fossil fuel read - if (first_time) then + if (first_advance_call) then call co2_data_flux_init() - first_time = .false. + first_advance_call = .false. end if ! Advance sdat stream @@ -210,11 +236,11 @@ subroutine co2_data_flux_advance() write(iulog,'(a,d20.10)') ' global sum with mesh areas = ',global_sum_mesh end if - g = 1 + gindx = 1 do lchnk = begchunk,endchunk do icol = 1,get_ncols_p(lchnk) - data_flux_fuel%co2flx(icol,lchnk) = dataptr1d(g) - g = g + 1 + data_flux_fuel%co2flx(icol,lchnk) = dataptr1d(gindx) + gindx = gindx + 1 end do end do @@ -231,8 +257,10 @@ 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 files (filenames begin with PET)') end if end subroutine chkrc + + end module co2_data_flux From f1e5eb648f373e227bfb3ec66f13b4ad5541b72d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 Dec 2025 19:38:01 +0100 Subject: [PATCH 19/31] more changes for PR comments --- bld/namelist_files/namelist_definition.xml | 8 +++--- src/chemistry/utils/aircraft_emit.F90 | 30 +++++++++++----------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index c50e2b64f8..6b6acc1cff 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1808,12 +1808,12 @@ Default: none -Year first to use in co2flux_fuel_datafile. +First year to use in co2flux_fuel_datafile. Default: 0 -Year last to use in co2flux_fuel_datafile. +Last year to use in co2flux_fuel_datafile. Default: 0 @@ -8133,12 +8133,12 @@ Default: FALSE -Year first to use in nitrogen deposition stream data. +First year to use in nitrogen deposition stream data. -Year last to use in nitrogen deposition stream data. +Last year last to use in nitrogen deposition stream data. Date: Mon, 8 Dec 2025 22:42:21 +0100 Subject: [PATCH 20/31] added documentation requested in PR --- bld/namelist_files/namelist_definition.xml | 55 ++++++++++++++++++++-- 1 file changed, 50 insertions(+), 5 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 6b6acc1cff..567ffc4b5b 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1819,8 +1819,18 @@ Default: 0 -Year align to use in co2flux_fuel_datafile. -Default: 0 +The simulation year corresponding to co2flux_fuel_year_first. +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. +Set by build-namelist. -Model year that aligns with aircraft_co2_year_first. +The simulation year corresponding to aircraft_co2_year_first. +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. +Set by build-namelist. Default: set by build-namelist. @@ -7033,7 +7054,19 @@ Last year of the aircraft_h2o_datafile to use. -Model year that aligns with aircraft_h2o_year_first. +The simulation year corresponding to aircraft_h2o_year_first. +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. +Set by build-namelist. +Default: set by build-namelist. -Model year that aligns with aircraft_year_first. +The simulation year corresponding to aircraft_slant_dist_year_first. +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. +Set by build-namelist. +Default: set by build-namelist. Date: Tue, 9 Dec 2025 19:28:15 +0100 Subject: [PATCH 21/31] addressed more issues raised in the PR review --- src/chemistry/utils/aircraft_emit.F90 | 60 ++++++++------------------- 1 file changed, 18 insertions(+), 42 deletions(-) diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index 9bd4fc31fd..afd8f9f492 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -29,10 +29,6 @@ module aircraft_emit private :: get_vertical_dimension private :: interpz_conserve - integer, parameter :: N_AERO = 3 - character(len=13) :: aero_names(N_AERO) = & - (/'ac_CO2 ','ac_H2O ','ac_SLANT_DIST'/) - type :: forcing_type type(shr_strdata_type) :: sdat character(len=cs) :: fldname = 'unset ' @@ -48,13 +44,15 @@ module aircraft_emit integer :: nilev = -1 integer :: nlev = -1 integer :: pbuf_index = -1 - integer :: index_map = -1 real(r8), pointer :: altitude_int(:) real(r8), pointer :: altitude_lev(:) end type forcing_type - type(forcing_type) :: forcing(N_AERO) + integer, parameter :: N_AERO = 3 + type(forcing_type) :: forcing(N_AERO) + character(len=3) :: mixtype(N_AERO) = 'wet' real(r8), parameter :: molmass(N_AERO) = 1._r8 + character(len=*),parameter :: u_FILE_u = __FILE__ !============================================================================ @@ -72,6 +70,7 @@ subroutine aircraft_emit_readnl(nlfile) use spmd_utils, only: mpi_integer, mpi_logical, mpi_character use co2_cycle, only: co2_readflux_aircraft use cam_pio_utils, only: cam_pio_openfile + use string_utils, only: int2str use pio, only: PIO_BCAST_ERROR, PIO_NOERR, PIO_NOWRITE use pio, only: file_desc_t, pio_seterrorhandling, pio_inq_varid use pio, only: pio_closefile @@ -81,7 +80,6 @@ subroutine aircraft_emit_readnl(nlfile) ! Local variables integer :: nf, ni - integer :: index integer :: unitn, ierr type(file_desc_t) :: fileid integer :: err_handling @@ -189,37 +187,23 @@ subroutine aircraft_emit_readnl(nlfile) ! Broadcast namelist variables call mpi_bcast(forcing(nf)%datafile, len(forcing(nf)%datafile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%datapath") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing("//int2str(nf)//"%datapath") call mpi_bcast(forcing(nf)%fldname,len(forcing(nf)%fldname), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%fldname") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing("//int2str(nf)//"%fldname") call mpi_bcast(forcing(nf)%meshfile, len(forcing(nf)%meshfile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%meshfile") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing("//int2str(nf)//"%meshfile") call mpi_bcast(forcing(nf)%year_first, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_first") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing("//int2str(nf)//"%year_first") call mpi_bcast(forcing(nf)%year_last, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_last") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing("//int2str(nf)//"%year_last") call mpi_bcast(forcing(nf)%year_align, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing("//int2str(nf)//"%year_align") call mpi_bcast(forcing(nf)%tintalgo, len(forcing(nf)%tintalgo), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing("//int2str(nf)//"%year_tintalgo") call mpi_bcast(forcing(nf)%taxmode, len(forcing(nf)%taxmode), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing(nf)%year_align") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: forcing("//int2str(nf)//"%year_taxmode") datafile_isnot_unset: if (trim(forcing(nf)%datafile) /= 'unset') then - ! obtain index in aero_names module array - index = 0 - do ni = 1,size(aero_names) - if (trim(forcing(nf)%fldname) == trim(aero_names(ni))) then - index = ni - exit - endif - end do - if ( index < 1 ) then - call endrun('aircraft_emit_register: '//trim(forcing(nf)%fldname)//& - ' is not a supported aircraft emission field name') - endif - forcing(nf)%index_map = index - ! overwrite mapalgo for ac_SLANT_DIST if ( trim(forcing(nf)%fldname) == 'ac_SLANT_DIST') then forcing(nf)%mapalgo = 'nn' @@ -255,8 +239,6 @@ subroutine aircraft_emit_readnl(nlfile) write(iulog,'(a,i0)')' aircraft year_first = ',forcing(nf)%year_first write(iulog,'(a,i0)')' aircraft year_last = ',forcing(nf)%year_last write(iulog,'(a,i0)')' aircraft year_align = ',forcing(nf)%year_align - write(iulog,'(a,i0)')' aircraft index_map for '//trim(forcing(nf)%fldname)//' = ',& - forcing(nf)%index_map write(iulog,*) ' ' end if end if datafile_isnot_unset @@ -273,11 +255,9 @@ subroutine aircraft_emit_register() !------------------------------------------------------------------ use ppgrid, only: pver, pcols use physics_buffer, only: pbuf_add_field, dtype_r8 - use constituents, only: cnst_add ! Local variables - integer :: i,idx, mm, ind, nf - integer :: ierr + integer :: nf !-------------------------------------------- do nf = 1,N_AERO @@ -311,7 +291,6 @@ subroutine aircraft_emit_init() integer :: klev integer :: nf logical :: history_chemistry - character(len=3) :: mixtype(N_AERO) = 'wet' character(len=*), parameter :: subname = 'aircraft_emit_init' !----------------------------------------------- @@ -411,7 +390,6 @@ subroutine aircraft_emit_adv( state, pbuf2d ) real(r8) :: data_col(pver) real(r8) :: model_z(pverp) character(len=cs) :: units - integer :: index integer :: rc logical :: first_time = .true. type(physics_buffer_desc), pointer :: pbuf_chnk(:) @@ -524,9 +502,7 @@ subroutine aircraft_emit_adv( state, pbuf2d ) call endrun('aircraft_emit_adv: units are not recognized') end select - index = forcing(nf)%index_map - - !$OMP PARALLEL DO PRIVATE (lchnk, ncol, index, to_mmr, tmpptr, pbuf_chnk, wght) + !$OMP PARALLEL DO PRIVATE (lchnk, ncol, to_mmr, tmpptr, pbuf_chnk, wght) do lchnk = begchunk,endchunk ncol = state(lchnk)%ncol @@ -534,7 +510,7 @@ subroutine aircraft_emit_adv( state, pbuf2d ) call get_wght_all_p(lchnk, ncol, wght(:ncol)) if (caseid == 1) then - to_mmr(:ncol,:) = (molmass(index)*1.e6_r8*boltz*state(lchnk)%t(:ncol,:)) & + to_mmr(:ncol,:) = (molmass(nf)*1.e6_r8*boltz*state(lchnk)%t(:ncol,:)) & /(mwdry*state(lchnk)%pmiddry(:ncol,:)) elseif (caseid == 2) then to_mmr(:ncol,:) = 1._r8 @@ -545,7 +521,7 @@ subroutine aircraft_emit_adv( state, pbuf2d ) elseif (caseid == 6) then to_mmr(:ncol,:) = 1.0_r8 else - to_mmr(:ncol,:) = molmass(index)/mwdry + to_mmr(:ncol,:) = molmass(nf)/mwdry endif pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) @@ -640,7 +616,7 @@ subroutine get_aircraft(cnt, spc_name_list_out) spc_name_list_out(:) = '' do nf = 1,N_AERO - if (forcing(nf)%fldname /= ' ') then + if (trim(forcing(nf)%datafile) /= 'unset') then cnt = cnt + 1 spc_name_list_out(nf) = trim(forcing(nf)%fldname) end if From 6a76e9ba2ce5d56cef69180cefc0c13ef0ea536d Mon Sep 17 00:00:00 2001 From: mvertens Date: Tue, 9 Dec 2025 19:39:19 +0100 Subject: [PATCH 22/31] Update src/control/cam_esmf_mod.F90 Co-authored-by: goldy <1588651+gold2718@users.noreply.github.com> --- src/control/cam_esmf_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/control/cam_esmf_mod.F90 b/src/control/cam_esmf_mod.F90 index b77585788b..eac9e37f98 100644 --- a/src/control/cam_esmf_mod.F90 +++ b/src/control/cam_esmf_mod.F90 @@ -1,6 +1,6 @@ module cam_esmf_mod - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_kind_mod , only : r8=>shr_kind_r8 use ESMF , only : ESMF_Mesh, ESMF_Clock use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_VMGetCurrent use ESMF , only : ESMF_SUCCESS, ESMF_REDUCE_SUM From c1f45356729ff7a8ae90f543a58a672f5d30307a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 10 Dec 2025 11:11:27 +0100 Subject: [PATCH 23/31] addressed more comments in PR --- bld/build-namelist | 16 ++++++++---- bld/namelist_files/namelist_defaults_cam.xml | 3 +++ bld/namelist_files/namelist_definition.xml | 22 +++++++++++++--- src/chemistry/utils/aircraft_emit.F90 | 3 ++- src/chemistry/utils/tracer_data.F90 | 20 +++++---------- src/control/cam_esmf_mod.F90 | 21 +++------------ src/cpl/nuopc/atm_comp_nuopc.F90 | 1 - src/physics/cam/co2_data_flux.F90 | 19 +++++++------- src/utils/ioFileMod.F90 | 27 ++++++++++++-------- 9 files changed, 71 insertions(+), 61 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index ed9e0214d7..acfabebaa3 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -811,13 +811,13 @@ if ($cfg->get('cosp')) { # Carbon cycle constituents my $co2_cycle = $cfg->get('co2_cycle'); -if ($co2_cycle) { +# co2_flag turns on the co2_cycle code in CAM +add_default($nl, 'co2_flag'); - # co2_flag turns on the co2_cycle code in CAM - add_default($nl, 'co2_flag', 'val'=>'.true.'); +if ($co2_cycle) { - # Supply a fossil fuel dataset and aircraft emissions datasets if - # the co2_cycle is active and it's a transient run ... + # Supply a fossil fuel and aircraft emission datasets if the + # co2_cycle is active and it is a transient run if ($sim_year =~ /(\d+)-(\d+)/ || $sim_year =~ /(\d+)/) { add_default($nl, 'co2_readflux_fuel', 'val'=>'.true.'); @@ -856,6 +856,12 @@ if ($co2_cycle) { add_default($nl, 'aircraft_co2_year_align', 'sim_year'=>$sim_year_start); } } + +} else { + + add_default($nl, 'co2_readflux_fuel', 'val'=>'.false.'); + add_default($nl, 'co2_readflux_aircraft', 'val'=>'.false.'); + } # By default the prognostic co2_cycle CO2 will be radiative active, unless the diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 92e7dba64f..e9569858fe 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -652,6 +652,9 @@ atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_RNOCStrend_c141002.nc atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc +.false. +.true. + atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 567ffc4b5b..044498de14 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1782,14 +1782,14 @@ Default: set by build-namelist group="co2_cycle_nl" valid_values="" > If TRUE read co2 aircraft flux from file and use all the settings for aircraft_co2_xxx namelist variables. -Default: set by build-namelist +Default: TRUE for transient model runs, FALSE otherwise. If TRUE read co2 fuel flux from file and use all the settings for co2flux_fuel_xxx namelist variables. -Default: set by build-namelist +Default: TRUE for transient model runs, FALSE otherwise. @@ -1843,7 +1843,10 @@ the forcing file otherwise, set to 'linear' Time extrapolation algorithm to use for co2flux_fuel_datafile. -Default: cycle +- cycle: Simply cycle through the available model data (i.e., start over when the end is reached) +- extend: Use the final value when end of data is reached. +- limit: Halt the model run if the model time exceeds the available data. +Default: extend for transient, otherwise cycle @@ -1899,7 +1902,10 @@ the forcing file otherwise, set to 'linear' Time extrapolation algorithm to use for aircraft_co2_datafile. -Default: cycle +- cycle: Simply cycle through the available model data (i.e., start over when the end is reached) +- extend: Use the final value when end of data is reached. +- limit: Halt the model run if the model time exceeds the available data. +Default: extend for transient, otherwise cycle @@ -7079,6 +7085,10 @@ the forcing file otherwise, set to 'linear' Time extrapolation algorithm to use for aircraft_h2o_datafile. +- cycle: Simply cycle through the available model data (i.e., start over when the end is reached) +- extend: Use the final value when end of data is reached. +- limit: Halt the model run if the model time exceeds the available data. +Default: extend for transient, otherwise cycle @@ -7135,6 +7145,10 @@ the forcing file otherwise, set to 'linear' Time extrapolation algorithm to use for aircraft_slant_dist. +- cycle: Simply cycle through the available model data (i.e., start over when the end is reached) +- extend: Use the final value when end of data is reached. +- limit: Halt the model run if the model time exceeds the available data. +Default: extend for transient, otherwise cycle diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index afd8f9f492..34d38f995a 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -28,6 +28,7 @@ module aircraft_emit private :: get_vertical_dimension private :: interpz_conserve + private :: chkrc type :: forcing_type type(shr_strdata_type) :: sdat @@ -499,7 +500,7 @@ subroutine aircraft_emit_adv( state, pbuf2d ) if (masterproc) then write(iulog,*)'aircraft_emit_adv: units = '//trim(units)//' are not recognized' end if - call endrun('aircraft_emit_adv: units are not recognized') + call endrun(trim(subname)//' aircraft_emit_adv: units are not recognized') end select !$OMP PARALLEL DO PRIVATE (lchnk, ncol, to_mmr, tmpptr, pbuf_chnk, wght) diff --git a/src/chemistry/utils/tracer_data.F90 b/src/chemistry/utils/tracer_data.F90 index 2c8d937703..7568008251 100644 --- a/src/chemistry/utils/tracer_data.F90 +++ b/src/chemistry/utils/tracer_data.F90 @@ -1449,19 +1449,16 @@ subroutine read_2d_trc( fid, vid, loc_arr, strt, cnt, file, order ) nullify(wrk2d_in) allocate( wrk2d(cnt(1),cnt(2)), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'read_2d_trc: wrk2d allocation error = ',ierr - call endrun + call endrun('read_2d_trc: wrk2d allocation error = '//int2str(ierr)) end if if(order(1)/=1 .or. order(2)/=2 .or. cnt(1)/=file%nlon .or. cnt(2)/=file%nlat) then allocate( wrk2d_in(file%nlon, file%nlat), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'read_2d_trc: wrk2d_in allocation error = ',ierr - call endrun + call endrun('read_2d_trc: wrk2d_in allocation error = '//int2str(ierr)) end if end if - ierr = pio_get_var( fid, vid, strt, cnt, wrk2d ) if(associated(wrk2d_in)) then wrk2d_in = reshape( wrk2d(:,:),(/file%nlon,file%nlat/), order=order ) @@ -1564,19 +1561,16 @@ subroutine read_za_trc( fid, vid, loc_arr, strt, cnt, file, order ) nullify(wrk2d_in) allocate( wrk2d(cnt(1),cnt(2)), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'read_2d_trc: wrk2d allocation error = ',ierr - call endrun + call endrun('read_2d_trc: wrk2d allocation error = '//int2str(ierr)) end if if(order(1)/=1 .or. order(2)/=2 .or. cnt(1)/=file%nlat .or. cnt(2)/=file%nlev) then allocate( wrk2d_in(file%nlat, file%nlev), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'read_2d_trc: wrk2d_in allocation error = ',ierr - call endrun + call endrun('read_2d_trc: wrk2d_in allocation error = '//int2str(ierr)) end if end if - ierr = pio_get_var( fid, vid, strt, cnt, wrk2d ) if(associated(wrk2d_in)) then wrk2d_in = reshape( wrk2d(:,:),(/file%nlat,file%nlev/), order=order ) @@ -1704,8 +1698,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) nullify(wrk3d_in) allocate(wrk3d(cnt(1),cnt(2),cnt(3)), stat=ierr) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'read_3d_trc: wrk3d allocation error = ',ierr - call endrun + call endrun('read_3d_trc: wrk3d allocation error = '//int2str(ierr)) end if ierr = pio_get_var( fid, vid, strt, cnt, wrk3d ) @@ -1714,8 +1707,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) cnt(1)/=file%nlon.or.cnt(2)/=file%nlat.or.cnt(3)/=file%nlev) then allocate(wrk3d_in(file%nlon,file%nlat,file%nlev),stat=ierr) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'read_3d_trc: wrk3d allocation error = ',ierr - call endrun + call endrun('read_3d_trc: wrk3d allocation error = '//int2str(ierr)) end if wrk3d_in = reshape( wrk3d(:,:,:),(/file%nlon,file%nlat,file%nlev/), order=order ) deallocate(wrk3d) diff --git a/src/control/cam_esmf_mod.F90 b/src/control/cam_esmf_mod.F90 index eac9e37f98..7d581c571e 100644 --- a/src/control/cam_esmf_mod.F90 +++ b/src/control/cam_esmf_mod.F90 @@ -4,7 +4,6 @@ module cam_esmf_mod use ESMF , only : ESMF_Mesh, ESMF_Clock use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_VMGetCurrent use ESMF , only : ESMF_SUCCESS, ESMF_REDUCE_SUM - use shr_sys_mod , only : shr_sys_abort use cam_abortutils , only : endrun use nuopc_shr_methods , only : chkerr use error_messages , only : alloc_err @@ -24,10 +23,7 @@ module cam_esmf_mod real(r8), allocatable, public, protected :: model_areas(:) real(r8), allocatable, public, protected :: mesh_areas(:) - logical :: model_clock_initialized = .false. - logical :: model_mesh_initialized = .false. - - character(*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & __FILE__ !===================================================================== @@ -47,12 +43,7 @@ subroutine cam_esmf_set_clock(clock_in, rc) model_clock = ESMF_ClockCreate(clock_in, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (model_clock_initialized) then - call shr_sys_abort('initialize_model_clock: model clock already initialized') - else - model_clock = clock_in - model_clock_initialized = .true. - end if + model_clock = clock_in end subroutine cam_esmf_set_clock @@ -60,12 +51,8 @@ end subroutine cam_esmf_set_clock subroutine cam_esmf_set_mesh(mesh_in) type(ESMF_Mesh) , intent(in) :: mesh_in - if (model_mesh_initialized) then - call shr_sys_abort('initialize_model_mesh: model mesh already initialized') - else - model_mesh = mesh_in - model_mesh_initialized = .true. - end if + model_mesh = mesh_in + end subroutine cam_esmf_set_mesh !===================================================================== 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/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 index 165732c56b..12b80f30ff 100644 --- a/src/physics/cam/co2_data_flux.F90 +++ b/src/physics/cam/co2_data_flux.F90 @@ -36,7 +36,7 @@ module co2_data_flux integer :: co2flux_fuel_year_last = -999 ! last year in stream to use integer :: co2flux_fuel_year_align = -999 ! align stream_year_first character(len=cs) :: co2flux_fuel_tintalgo = 'unset' ! time interpolation [linear, lower, upper] - character(len=cs) :: co2flux_fuel_taxmode = 'unset' ! time extraploation [cycle, extend or limit] + character(len=cs) :: co2flux_fuel_taxmode = 'unset' ! time extrapolation [cycle, extend or limit] logical :: debug = .false. @@ -59,6 +59,7 @@ subroutine co2_data_flux_readnl(nlfile) use cam_logfile, only: iulog use cam_abortutils, only: endrun use cam_pio_utils, only: cam_pio_openfile + use string_utils, only: int2str use pio, only: PIO_BCAST_ERROR, PIO_NOERR, PIO_NOWRITE use pio, only: file_desc_t, pio_seterrorhandling, pio_inq_varid use pio, only: pio_closefile @@ -81,7 +82,7 @@ subroutine co2_data_flux_readnl(nlfile) co2flux_fuel_year_first, & ! first year in stream to use co2flux_fuel_year_last, & ! last year in stream to use co2flux_fuel_year_align, & ! align stream_year_first - co2flux_fuel_tintalgo, & ! time extraploation [linear, lower, upper] + co2flux_fuel_tintalgo, & ! time interpolation [linear, lower, upper] co2flux_fuel_taxmode ! time extraploation [cycle, extend or limit] !-------------------------------------------- @@ -98,19 +99,19 @@ subroutine co2_data_flux_readnl(nlfile) end if call mpi_bcast(co2flux_fuel_datafile, len(co2flux_fuel_datafile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_datafile") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_datafile "//trim(co2flux_fuel_datafile)) call mpi_bcast(co2flux_fuel_meshfile, len(co2flux_fuel_meshfile), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_meshfile") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_meshfile "//trim(co2flux_fuel_meshfile)) call mpi_bcast(co2flux_fuel_year_first, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_first") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_first "//int2str(co2flux_fuel_year_first)) call mpi_bcast(co2flux_fuel_year_last, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_last") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_last "//int2str(co2flux_fuel_year_last)) call mpi_bcast(co2flux_fuel_year_align, 1, mpi_integer, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_align") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_year_align "//int2str(co2flux_fuel_year_align)) call mpi_bcast(co2flux_fuel_tintalgo, len(co2flux_fuel_tintalgo), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_tintalgo") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_tintalgo "//trim(co2flux_fuel_tintalgo)) call mpi_bcast(co2flux_fuel_taxmode, len(co2flux_fuel_taxmode), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode") + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode "//trim(co2flux_fuel_taxmode)) ! Overwrite co2flux_fuel_tintalgo if it is set to 'unset' ! Check if the data file has a time_bnds variable and if so set the time interpolation diff --git a/src/utils/ioFileMod.F90 b/src/utils/ioFileMod.F90 index 4a9969eb25..3f75718e00 100644 --- a/src/utils/ioFileMod.F90 +++ b/src/utils/ioFileMod.F90 @@ -3,8 +3,7 @@ module ioFileMod ! ! Purpose: ! -! Input/Output file manipulations. Mind file on archival system, or local -! disk etc. +! Input/Output file manipulations. ! ! Author: Mariana Vertenstein ! @@ -81,7 +80,9 @@ subroutine getfil(fulpath, locfn, iflag, lexist) if (abort_on_failure) then call endrun('(GETFIL): local filename variable is too short for path length') else - if (masterproc) write(iulog,'(a,i8,i8)') '(GETFIL): local filename variable is too short for path length',klen-i,maxlen + if (masterproc) then + write(iulog,'(a,i0,a,i0)') '(GETFIL): local filename variable is too short for path length: ',klen-i,' > ',maxlen + end if if (present(lexist)) lexist = .false. return end if @@ -91,13 +92,13 @@ subroutine getfil(fulpath, locfn, iflag, lexist) if (len_trim(locfn) == 0) then call endrun ('(GETFIL): local filename has zero length') else if (masterproc) then - write(iulog,'(a)')'(GETFIL): attempting to find local file '//trim(locfn) + write(iulog,'(2a)')'(GETFIL): attempting to find local file ',trim(locfn) end if inquire(file=locfn, exist=lexist_in) if (present(lexist)) lexist = lexist_in if (lexist_in) then - if (masterproc) write(iulog,'(a)') '(GETFIL): using '//trim(locfn)//' in current working directory' + if (masterproc) write(iulog,'(3a)') '(GETFIL): using ',trim(locfn),' in current working directory' return end if @@ -107,7 +108,9 @@ subroutine getfil(fulpath, locfn, iflag, lexist) if (abort_on_failure) then call endrun('(GETFIL): local filename variable is too short for path length') else - if (masterproc) write(iulog,'(a,i8,i8)') '(GETFIL): local filename variable is too short for path length',klen,maxlen + if (masterproc) then + write(iulog,'(a,i0,a,i0)') '(GETFIL): local filename variable is too short for path length: ',klen,' > ',maxlen + end if if (present(lexist)) lexist = .false. return end if @@ -117,10 +120,10 @@ subroutine getfil(fulpath, locfn, iflag, lexist) inquire(file=locfn, exist=lexist_in) if (present(lexist)) lexist = lexist_in if (lexist_in) then - if (masterproc) write(iulog,'(a)')'(GETFIL): using '//trim(fulpath) + if (masterproc) write(iulog,'(2a)')'(GETFIL): using ',trim(fulpath) return else - if (masterproc) write(iulog,'(a)')'(GETFIL): all tries to get file have been unsuccessful: '//trim(fulpath) + if (masterproc) write(iulog,'(2a)')'(GETFIL): all tries to get file have been unsuccessful: ',trim(fulpath) if (abort_on_failure) then call endrun ('GETFIL: FAILED to get '//trim(fulpath)) else @@ -167,10 +170,14 @@ subroutine opnfil (locfn, iun, form, status) end if open (unit=iun,file=locfn,status=st, form=ft,iostat=ioe) if (ioe /= 0) then - if(masterproc) write(iulog,'(a,i8,a,i8)')'(OPNFIL): failed to open file '//trim(locfn)//' on unit ',iun,' ierr=',ioe + if(masterproc) then + write(iulog,'(3a,i0,a,i0)')'(OPNFIL): failed to open file ', trim(locfn), ' on unit ',iun,', ierr=',ioe + end if call endrun ('opnfil') else - if(masterproc) write(iulog,'(a,i8)')'(OPNFIL): Successfully opened file '//trim(locfn)//' on unit= ',iun + if(masterproc) then + write(iulog,'(3a,i0)')'(OPNFIL): Successfully opened file ', trim(locfn), ' on unit = ', iun + end if end if return From 3109891dadfee5c4b7f61b621f89bcd8dac23f00 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 10 Dec 2025 16:10:59 +0100 Subject: [PATCH 24/31] yet more changes to address PR comments --- bld/namelist_files/namelist_definition.xml | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 044498de14..173756a35b 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -8202,7 +8202,19 @@ Last year last to use in nitrogen deposition stream data. -Model year to align with stream_ndep_year_first. +The simulation year corresponding to stream_ndep_year_first. +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. +Set by build-namelist. +Default: set by build-namelist. Date: Wed, 10 Dec 2025 23:25:08 +0100 Subject: [PATCH 25/31] Addressed final PR comments and requests --- bld/build-namelist | 16 ++-- bld/namelist_files/namelist_definition.xml | 32 -------- src/chemistry/utils/aircraft_emit.F90 | 66 ++++++++------- src/chemistry/utils/tracer_data.F90 | 95 ++++++---------------- src/control/cam_esmf_mod.F90 | 43 ++++++---- src/physics/cam/co2_cycle.F90 | 73 ++++++++--------- src/physics/cam/co2_data_flux.F90 | 13 ++- src/physics/clubb | 2 +- src/utils/ioFileMod.F90 | 3 +- 9 files changed, 145 insertions(+), 198 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index acfabebaa3..71e0c5e2a2 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -712,9 +712,9 @@ if (!($simple_phys or $aqua_mode)) { my $chem_nitrodep = chem_has_species($cfg, 'NO') and chem_has_species($cfg, 'NH3'); if ((!$chem_nitrodep) or ($chem =~ /geoschem/)) { add_default($nl, 'stream_ndep_mesh_filename'); - add_default($nl, 'stream_ndep_data_filename', 'sim_year'=>$sim_year); - add_default($nl, 'stream_ndep_year_first', 'sim_year'=>$sim_year); - add_default($nl, 'stream_ndep_year_last', 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_data_filename', 'sim_year'=>$sim_year_start); + add_default($nl, 'stream_ndep_year_first', 'sim_year'=>$sim_year_start); + add_default($nl, 'stream_ndep_year_last', 'sim_year'=>$sim_year_end); add_default($nl, 'stream_ndep_year_align', 'sim_year'=>$sim_year); } } @@ -812,6 +812,7 @@ if ($cfg->get('cosp')) { my $co2_cycle = $cfg->get('co2_cycle'); # co2_flag turns on the co2_cycle code in CAM +# defaults set in namelist_defaults_cam.xml add_default($nl, 'co2_flag'); if ($co2_cycle) { @@ -855,13 +856,14 @@ if ($co2_cycle) { add_default($nl, 'aircraft_co2_year_last' , 'sim_year'=>$sim_year_end); add_default($nl, 'aircraft_co2_year_align', 'sim_year'=>$sim_year_start); } - } - + } else { + # This case probably should not happen (co2_cycle on with no sim year) + add_default($nl, 'co2_readflux_fuel', 'val'=>'.false.'); + add_default($nl, 'co2_readflux_aircraft', 'val'=>'.false.'); + } } else { - add_default($nl, 'co2_readflux_fuel', 'val'=>'.false.'); add_default($nl, 'co2_readflux_aircraft', 'val'=>'.false.'); - } # By default the prognostic co2_cycle CO2 will be radiative active, unless the diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 173756a35b..ad1f70ae89 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -10099,38 +10099,6 @@ If TRUE perform temp tendency scaling before send to fv3 dynamics Default: FALSE - - - - - - - - -Stream filename(s) for Nitrogen Deposition data - - - -Stream meshfile for Nitrogen Deposition data - - - -First year to loop over for Nitrogen Deposition data - - - -Last year to loop over for Nitrogen Deposition data - - - -Simulation year that aligns with stream_year_first_ndep value - - diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index 34d38f995a..f4a7e8434f 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -51,9 +51,10 @@ module aircraft_emit integer, parameter :: N_AERO = 3 type(forcing_type) :: forcing(N_AERO) - character(len=3) :: mixtype(N_AERO) = 'wet' real(r8), parameter :: molmass(N_AERO) = 1._r8 + logical :: first_update = .true. + character(len=*),parameter :: u_FILE_u = __FILE__ !============================================================================ @@ -279,7 +280,6 @@ subroutine aircraft_emit_init() !------------------------------------------------------------------- use cam_history, only: addfld, add_default use phys_control, only: phys_getopts - use physics_buffer, only: pbuf_get_chunk, pbuf_get_index use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile use pio, only: file_desc_t, var_desc_t use pio, only: pio_inq_varid, pio_get_att @@ -288,7 +288,7 @@ subroutine aircraft_emit_init() ! Local variables type(file_desc_t) :: pioid type(var_desc_t) :: varid - integer :: ierr, rc + integer :: ierr integer :: klev integer :: nf logical :: history_chemistry @@ -369,7 +369,7 @@ subroutine aircraft_emit_adv( state, pbuf2d ) use physconst, only : boltz ! J/K/molecule use phys_grid, only : get_wght_all_p, get_ncols_p use physics_buffer, only : physics_buffer_desc, pbuf_get_field - use physics_buffer, only : pbuf_get_chunk, pbuf_get_index + use physics_buffer, only : pbuf_get_chunk use time_manager, only : get_curr_date ! Arguments @@ -377,25 +377,24 @@ subroutine aircraft_emit_adv( state, pbuf2d ) type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! Local variables - integer :: gcell, ind, nf - integer :: lchnk, icol, klev, ncol - integer :: caseid - integer :: year, mon, day, sec - integer :: mcdate - real(r8) :: to_mmr(pcols,pver) - real(r8) :: wght(pcols) - real(r8), pointer :: tmpptr(:,:) - real(r8), pointer :: data_out(:,:) - real(r8), pointer :: dataptr2d(:,:) - real(r8) :: datain3d(pcols,pver,begchunk:endchunk) - real(r8) :: data_col(pver) - real(r8) :: model_z(pverp) - character(len=cs) :: units - integer :: rc - logical :: first_time = .true. - type(physics_buffer_desc), pointer :: pbuf_chnk(:) - real(r8), parameter :: m2km = 1.e-3_r8 - character(len=*), parameter :: subname = 'aircraft_emit_adv' + integer :: gcell, nf + integer :: lchnk, icol, klev, ncol + integer :: caseid + integer :: year, mon, day, sec + integer :: mcdate + real(r8) :: to_mmr(pcols,pver) + real(r8) :: wght(pcols) + real(r8), pointer :: tmpptr(:,:) + real(r8), pointer :: data_out(:,:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), allocatable :: datain3d(:,:,:) + real(r8) :: data_col(pver) + real(r8) :: model_z(pverp) + character(len=cs) :: units + integer :: rc + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + real(r8), parameter :: m2km = 1.e-3_r8 + character(len=*), parameter :: subname = 'aircraft_emit_adv' !------------------------------------------------------------------ call t_startf('All_aircraft_emit_adv') @@ -406,7 +405,7 @@ subroutine aircraft_emit_adv( state, pbuf2d ) n_aero_loop: do nf = 1,N_AERO unset_file: if (trim(forcing(nf)%datafile) /= 'unset') then - first_call: if (first_time) then + first_call: if (first_update) then ! Initialize forcing%sdat call shr_strdata_init_from_inline(forcing(nf)%sdat, & my_task = iam, & @@ -431,7 +430,7 @@ subroutine aircraft_emit_adv( state, pbuf2d ) rc = rc) call chkrc(rc,__LINE__,u_FILE_u) - first_time = .false. + first_update = .false. end if first_call !------------------------------------------------------------------- @@ -453,6 +452,10 @@ subroutine aircraft_emit_adv( state, pbuf2d ) call chkrc(rc,__LINE__,u_FILE_u) ! Obtain datain on model horizontal grid but the same vertical levels as the forcing dataset + allocate(datain3d(pcols,pver,begchunk:endchunk), stat=ierr) + if ( ierr /= 0 ) then + call endrun(trim(subname)//': failed to allocate datain3d, error = '//int2str(ierr)) + end if do klev = 1, forcing(nf)%nlev !nlev is the number of levels in the forcing data gcell = 1 do lchnk = begchunk,endchunk @@ -476,12 +479,13 @@ subroutine aircraft_emit_adv( state, pbuf2d ) data_out(icol,:) = data_col(pver:1:-1) end do end do + deallocate(datain3d) !------------------------------------------------------------------- ! set the tracer fields with the correct units !------------------------------------------------------------------- - ! GLC IS position of last significant character in string. + ! GLC is position of last significant character in string. units = to_lower(trim(forcing(nf)%fldunits(:GLC(forcing(nf)%fldunits)))) select case (trim(units)) case ("molec/cm3","/cm3","molecules/cm3","cm^-3","cm**-3") @@ -540,6 +544,7 @@ end subroutine aircraft_emit_adv !========================================================================= subroutine interpz_conserve( nsrc, ndst, src_x, dst_x, src, dst) + ! Note, this routine is an edited version of the tracer_data version ! Arguments integer, intent(in) :: nsrc ! dimension source array @@ -628,9 +633,10 @@ end subroutine get_aircraft !========================================================================= subroutine get_vertical_dimension( fid, dname, dsize, data ) - use pio, only : file_desc_t, pio_seterrorhandling - use pio, only : pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_get_var - use pio, only : PIO_BCAST_ERROR, PIO_NOERR + use pio, only: file_desc_t, pio_seterrorhandling + use pio, only: pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_get_var + use pio, only: PIO_BCAST_ERROR, PIO_NOERR + use string_utils, only: int2str ! Arguments type(file_desc_t), intent(inout) :: fid @@ -653,7 +659,7 @@ subroutine get_vertical_dimension( fid, dname, dsize, data ) end if allocate( data(dsize), stat=ierr ) if ( ierr /= 0 ) then - call endrun(trim(subname)//': failed to allocate data array') + call endrun(trim(subname)//': failed to allocate data array, error = '//int2str(ierr)) end if ierr = pio_inq_varid( fid, dname, vid ) if (ierr /= PIO_NOERR) then diff --git a/src/chemistry/utils/tracer_data.F90 b/src/chemistry/utils/tracer_data.F90 index 7568008251..578e3b0951 100644 --- a/src/chemistry/utils/tracer_data.F90 +++ b/src/chemistry/utils/tracer_data.F90 @@ -170,8 +170,6 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & use horizontal_interpolate, only : xy_interp_init use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_integer - implicit none - character(len=*), intent(in) :: specifier(:) character(len=*), intent(in) :: filename character(len=*), intent(in) :: filelist @@ -237,7 +235,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & file%cyc_yr = data_cycle_yr case( 'SERIAL' ) case default - write(iulog,'(a)') 'trcdata_init: invalid data type: '//trim(data_type)//' file: '//trim(filename) + write(iulog,'(4a)') 'trcdata_init: invalid data type: ', trim(data_type), ' file: ', trim(filename) write(iulog,'(a)') 'trcdata_init: valid data types: SERIAL | CYCLICAL | CYCLICAL_LIST | FIXED | INTERP_MISSING_MONTHS ' call endrun('trcdata_init: invalid data type: '//trim(data_type)//' file: '//trim(filename)) endselect @@ -254,7 +252,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & end if if (masterproc) then - write(iulog,'(a)') 'trcdata_init: data type: '//trim(data_type)//' file: '//trim(filename) + write(iulog,'(4a)') 'trcdata_init: data type: ', trim(data_type), ' file: ', trim(filename) endif ! if there is no list of files (len_trim(file%filenames_list)<1) then @@ -648,7 +646,6 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & if( file%dist ) then allocate(file%weight0_x(plon,file%nlon), stat=astat) if( astat /= 0 ) then - write(iulog,'(a,i0)') call endrun('trcdata_init: file%weight0_x allocation error = '//int2str(astat)) end if allocate(file%weight0_y(plat,file%nlat), stat=astat) @@ -771,8 +768,6 @@ end subroutine trcdata_init subroutine advance_trcdata( flds, file, state, pbuf2d ) use physics_types,only : physics_state - implicit none - type(trfile), intent(inout) :: file type(trfld), intent(inout) :: flds(:) type(physics_state), intent(in) :: state(begchunk:endchunk) @@ -822,9 +817,6 @@ end subroutine advance_trcdata !------------------------------------------------------------------- subroutine get_fld_data( flds, field_name, data, ncol, lchnk, pbuf ) - - implicit none - type(trfld), intent(inout) :: flds(:) character(len=*), intent(in) :: field_name real(r8), intent(out) :: data(:,:) @@ -856,8 +848,6 @@ end subroutine get_fld_data !------------------------------------------------------------------- subroutine get_fld_ndx( flds, field_name, idx ) - implicit none - type(trfld), intent(in) :: flds(:) character(len=*), intent(in) :: field_name integer, intent(out) :: idx @@ -878,7 +868,7 @@ end subroutine get_fld_ndx !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ subroutine get_model_time(file) - implicit none + type(trfile), intent(inout) :: file integer yr, mon, day, ncsec ! components of a date @@ -895,8 +885,6 @@ end subroutine get_model_time !------------------------------------------------------------------------------ subroutine check_files( file, fids, itms, times_found) - implicit none - type(trfile), intent(inout) :: file type(file_desc_t), intent(out) :: fids(2) ! ids of files that contains these recs integer, optional, intent(out) :: itms(2) @@ -974,9 +962,6 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ !----------------------------------------------------------------------- use string_utils, only : incstr - use shr_file_mod, only : shr_file_getunit, shr_file_freeunit - - implicit none character(len=*), intent(in) :: filename ! present dynamical dataset filename character(len=*), optional, intent(in) :: filenames_list @@ -1011,7 +996,7 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ !----------------------------------------------------------------------- pos = len_trim( filename ) fn_new = filename(:pos) - if ( masterproc ) write(iulog,'(a)') 'incr_flnm: old filename = '//trim(fn_new) + if ( masterproc ) write(iulog,'(2a)') 'incr_flnm: old filename = ', trim(fn_new) if( fn_new(pos-2:) == '.nc' ) then pos = pos - 3 end if @@ -1025,16 +1010,17 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ !------------------------------------------------------------------- ! ... open filenames_list !------------------------------------------------------------------- - if ( masterproc ) write(iulog,'(a)') 'incr_flnm: old filename = '//trim(filename) - if ( masterproc ) write(iulog,'(a)') 'incr_flnm: open filenames_list : '//trim(filenames_list) - unitnumber = shr_file_getUnit() + if ( masterproc ) then + write(iulog,'(2a)') 'incr_flnm: old filename = ', trim(filename) + write(iulog,'(2a)') 'incr_flnm: open filenames_list : ', trim(filenames_list) + end if if ( present(datapath) ) then filepath = trim(datapath) //'/'// trim(filenames_list) else filepath = trim(filenames_list) endif - open( unit=unitnumber, file=filepath, iostat=ios, status="OLD") + open( newunit=unitnumber, file=filepath, iostat=ios, status="OLD") if (ios /= 0) then call endrun('not able to open file: '//trim(filepath)) endif @@ -1050,8 +1036,8 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ fn_new = 'NOT_FOUND' incr_filename = trim(fn_new) return - endif - endif + end if + end if !------------------------------------------------------------------- ! If current filename is '', then initialize with the first filename read in @@ -1071,9 +1057,9 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ fn_new = 'NOT_FOUND' incr_filename = trim(fn_new) return - endif - endif - enddo + end if + end if + end do !------------------------------------------------------------------- ! Read next filename @@ -1117,14 +1103,13 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ fn_new = trim(line) close(unit=unitnumber) - call shr_file_freeUnit(unitnumber) - endif + end if !--------------------------------------------------------------------------------- ! return the current filename !--------------------------------------------------------------------------------- incr_filename = trim(fn_new) - if ( masterproc ) write(iulog,'(a)') 'incr_flnm: new filename = '//trim(incr_filename) + if ( masterproc ) write(iulog,'(2a)') 'incr_flnm: new filename = ', trim(incr_filename) end function incr_filename @@ -1134,8 +1119,6 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found use intp_util, only: findplb - implicit none - type(trfile), intent(in) :: file real(r8), intent(out) :: datatimem, datatimep @@ -1212,7 +1195,7 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found if ( .not. times_found ) then if (masterproc) then write(iulog,*)'FIND_TIMES: Failed to find dates bracketing desired time =', time - write(iulog,'(a)') 'filename = '//trim(file%curr_filename) + write(iulog,'(2a)') 'filename = ', trim(file%curr_filename) write(iulog,*)' datatimem = ',file%datatimem write(iulog,*)' datatimep = ',file%datatimep endif @@ -1246,7 +1229,6 @@ end subroutine find_times !------------------------------------------------------------------------ !------------------------------------------------------------------------ subroutine read_next_trcdata( flds, file ) - implicit none type (trfile), intent(inout) :: file type (trfld),intent(inout) :: flds(:) @@ -1429,7 +1411,6 @@ subroutine read_2d_trc( fid, vid, loc_arr, strt, cnt, file, order ) use polar_avg, only: polar_average use horizontal_interpolate, only : xy_interp - implicit none type(file_desc_t), intent(in) :: fid type(var_desc_t), intent(in) :: vid integer, intent(in) :: strt(:), cnt(:), order(2) @@ -1544,7 +1525,6 @@ subroutine read_za_trc( fid, vid, loc_arr, strt, cnt, file, order ) use ppgrid, only : pcols, begchunk, endchunk use phys_grid, only : get_ncols_p, get_rlat_all_p - implicit none type(file_desc_t), intent(in) :: fid type(var_desc_t), intent(in) :: vid integer, intent(in) :: strt(:), cnt(:) @@ -1674,8 +1654,6 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) use polar_avg, only : polar_average use horizontal_interpolate, only : xy_interp - implicit none - type(file_desc_t), intent(in) :: fid type(var_desc_t), intent(in) :: vid integer, intent(in) :: strt(:), cnt(:), order(3) @@ -1779,8 +1757,6 @@ subroutine interpolate_trcdata( state, flds, file, pbuf2d ) use physics_types,only : physics_state use physconst, only : cday, rga - implicit none - type(physics_state), intent(in) :: state(begchunk:endchunk) type (trfld), intent(inout) :: flds(:) type (trfile), intent(inout) :: file @@ -1961,7 +1937,7 @@ end subroutine interpolate_trcdata !----------------------------------------------------------------------- !----------------------------------------------------------------------- subroutine get_dimension( fid, dname, dsize, dimid, data ) - implicit none + type(file_desc_t), intent(inout) :: fid character(*), intent(in) :: dname integer, intent(out) :: dsize @@ -1988,14 +1964,12 @@ subroutine get_dimension( fid, dname, dsize, dimid, data ) if ( associated(data) ) then deallocate(data, stat=ierr) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'get_dimension: data deallocation error = ',ierr - call endrun('get_dimension: failed to deallocate data array') + call endrun('get_dimension: failed to deallocate data array, error = '//int2str(ierr)) end if endif allocate( data(dsize), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'get_dimension: data allocation error = ',ierr - call endrun('get_dimension: failed to allocate data array') + call endrun('get_dimension: failed to allocate data array, error = '//int2str(ierr)) end if ierr = pio_inq_varid( fid, dname, vid ) @@ -2014,8 +1988,6 @@ end subroutine get_dimension !----------------------------------------------------------------------- subroutine set_cycle_indices( fileid, cyc_ndx_beg, cyc_ndx_end, cyc_yr ) - implicit none - type(file_desc_t), intent(inout) :: fileid integer, intent(out) :: cyc_ndx_beg integer, intent(out) :: cyc_ndx_end @@ -2061,8 +2033,6 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ use ioFileMod, only: getfil use cam_pio_utils, only: cam_pio_openfile - implicit none - character(*), intent(in) :: fname character(*), intent(in) :: path type(file_desc_t), intent(inout) :: piofile @@ -2090,21 +2060,19 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ ! call getfil( filepath, filen, 0 ) call cam_pio_openfile( piofile, filen, PIO_NOWRITE) - if(masterproc) write(iulog,'(a)')'open_trc_datafile: '//trim(filen) + if(masterproc) write(iulog,'(2a)')'open_trc_datafile: ', trim(filen) call get_dimension(piofile, 'time', timesize) if ( associated(times) ) then deallocate(times, stat=ierr) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'open_trc_datafile: data deallocation error = ',ierr - call endrun('open_trc_datafile: failed to deallocate data array') + call endrun('open_trc_datafile: failed to deallocate data array, error = '//int2str(ierr)) end if endif allocate( times(timesize), stat=ierr ) if( ierr /= 0 ) then - write(iulog,'(a,i0)') 'open_trc_datafile: data allocation error = ',ierr - call endrun('open_trc_datafile: failed to allocate data array') + call endrun('open_trc_datafile: failed to allocate data array, error = '//int2str(ierr)) end if allocate( dates(timesize), stat=astat ) @@ -2169,8 +2137,6 @@ end subroutine open_trc_datafile !-------------------------------------------------------------------------- subroutine specify_fields( specifier, fields ) - implicit none - character(len=*), intent(in) :: specifier(:) type(trfld), pointer, dimension(:) :: fields @@ -2237,7 +2203,6 @@ end subroutine specify_fields subroutine init_trc_restart( whence, piofile, tr_file ) - implicit none character(len=*), intent(in) :: whence type(file_desc_t), intent(inout) :: piofile type(trfile), intent(inout) :: tr_file @@ -2281,8 +2246,6 @@ end subroutine init_trc_restart !------------------------------------------------------------------------- subroutine write_trc_restart( piofile, tr_file ) - implicit none - type(file_desc_t), intent(inout) :: piofile type(trfile), intent(inout) :: tr_file @@ -2304,8 +2267,6 @@ end subroutine write_trc_restart !------------------------------------------------------------------------- subroutine read_trc_restart( whence, piofile, tr_file ) - implicit none - character(len=*), intent(in) :: whence type(file_desc_t), intent(inout) :: piofile type(trfile), intent(inout) :: tr_file @@ -2342,8 +2303,6 @@ end subroutine read_trc_restart !------------------------------------------------------------------------------ subroutine interpz_conserve( nsrc, ntrg, src_x, trg_x, src, trg) - implicit none - integer, intent(in) :: nsrc ! dimension source array integer, intent(in) :: ntrg ! dimension target array real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates @@ -2411,8 +2370,6 @@ end subroutine interpz_conserve !------------------------------------------------------------------------------ subroutine vert_interp_mixrat( ncol, nsrc, ntrg, trg_x, src, trg, p0, ps, hyai, hybi, use_flight_distance) - implicit none - integer, intent(in) :: ncol integer, intent(in) :: nsrc ! dimension source array integer, intent(in) :: ntrg ! dimension target array @@ -2551,7 +2508,6 @@ subroutine vert_interp( ncol, levsiz, pin, pmid, datain, dataout ) ! ! Interpolate data from current time-interpolated values to model levels !-------------------------------------------------------------------------- - implicit none ! Arguments ! integer, intent(in) :: ncol ! number of atmospheric columns @@ -2628,7 +2584,6 @@ subroutine vert_interp_ub( ncol, nlevs, plevs, datain, dataout ) ! Interpolate data from current time-interpolated values to top interface pressure ! -- from mo_tgcm_ubc.F90 !-------------------------------------------------------------------------- - implicit none ! Arguments ! integer, intent(in) :: ncol @@ -2737,8 +2692,6 @@ subroutine advance_file(file) use shr_sys_mod, only: shr_sys_system use ioFileMod, only: getfil - implicit none - type(trfile), intent(inout) :: file !----------------------------------------------------------------------- @@ -2758,7 +2711,7 @@ subroutine advance_file(file) !----------------------------------------------------------------------- if( file%remove_trc_file ) then call getfil( file%curr_filename, loc_fname, 0 ) - write(iulog,'(a)') 'advance_file: removing file = ',trim(loc_fname) + write(iulog,'(2a)') 'advance_file: removing file = ',trim(loc_fname) ctmp = 'rm -f ' // trim(loc_fname) write(iulog,'(a)') 'advance_file: fsystem issuing command - ' write(iulog,'(a)') trim(ctmp) diff --git a/src/control/cam_esmf_mod.F90 b/src/control/cam_esmf_mod.F90 index 7d581c571e..42d6b2ee3a 100644 --- a/src/control/cam_esmf_mod.F90 +++ b/src/control/cam_esmf_mod.F90 @@ -4,7 +4,6 @@ module cam_esmf_mod use ESMF , only : ESMF_Mesh, ESMF_Clock use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_VMGetCurrent use ESMF , only : ESMF_SUCCESS, ESMF_REDUCE_SUM - use cam_abortutils , only : endrun use nuopc_shr_methods , only : chkerr use error_messages , only : alloc_err use cam_logfile , only : iulog @@ -23,15 +22,17 @@ module cam_esmf_mod real(r8), allocatable, public, protected :: model_areas(:) real(r8), allocatable, public, protected :: mesh_areas(:) - character(len=*), parameter :: u_FILE_u = & - __FILE__ + logical :: check_global_areas = .false. + + character(len=*), parameter :: u_FILE_u = __FILE__ !===================================================================== contains !===================================================================== subroutine cam_esmf_set_clock(clock_in, rc) - use ESMF, only : ESMF_Clock, ESMF_ClockCreate + use ESMF, only: ESMF_Clock, ESMF_ClockCreate, ESMF_ClockIsCreated + use cam_abortutils, only: endrun ! Arguments type(ESMF_Clock), intent(in) :: clock_in @@ -40,10 +41,14 @@ subroutine cam_esmf_set_clock(clock_in, rc) rc = ESMF_SUCCESS - model_clock = ESMF_ClockCreate(clock_in, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(model_clock, rc=rc)) then + call endrun('cam_esmf_set_clock: model_clock already set') + else + model_clock = ESMF_ClockCreate(clock_in, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - model_clock = clock_in + model_clock = clock_in + end if end subroutine cam_esmf_set_clock @@ -94,19 +99,23 @@ subroutine cam_esmf_set_areas(model_areas_in, mesh_areas_in, rc) local_mesh_area(1) = local_mesh_area(1) + mesh_areas(ng) end do - call ESMF_VMGetCurrent(vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (check_global_areas) then + call ESMF_VMGetCurrent(vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMAllreduce(vm, senddata=local_model_area, recvdata=global_model_area, & - count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_model_area, recvdata=global_model_area, & + count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMAllreduce(vm, senddata=local_mesh_area, recvdata=global_mesh_area, & - count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_mesh_area, recvdata=global_mesh_area, & + count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(iulog,'(a,d13.5)') ' global mesh area = ',global_mesh_area(1) - write(iulog,'(a,d13.5)') ' global model area = ',global_model_area(1) + if (masterproc) then + write(iulog,'(a,d13.5)') ' global mesh area = ',global_mesh_area(1) + write(iulog,'(a,d13.5)') ' global model area = ',global_model_area(1) + end if + end if end subroutine cam_esmf_set_areas diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 index 7c058e3297..f1e6823b0a 100644 --- a/src/physics/cam/co2_cycle.F90 +++ b/src/physics/cam/co2_cycle.F90 @@ -12,7 +12,7 @@ module co2_cycle ! !------------------------------------------------------------------------------- - use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_kind_mod, only: r8=>shr_kind_r8 implicit none private @@ -35,16 +35,15 @@ module co2_cycle ! new constituents !------------------------------------------------------------------------------- - integer, parameter :: ncnst=4 ! number of constituents implemented - integer, public, protected :: c_i(ncnst) ! global index for new constituents + integer, parameter :: ncnst=4 ! number of constituents implemented + integer, public, protected :: c_i(ncnst) ! global index for new constituents character(len=7), dimension(ncnst), parameter :: & ! constituent names c_names = (/'CO2_OCN', 'CO2_FFF', 'CO2_LND', 'CO2 '/) - integer :: co2_ocn_glo_ind ! global index of 'CO2_OCN' - integer :: co2_fff_glo_ind ! global index of 'CO2_FFF' - integer :: co2_lnd_glo_ind ! global index of 'CO2_LND' - integer :: co2_glo_ind ! global index of 'CO2' + integer :: co2_fff_glo_ind = -1 ! global index of 'CO2_FFF' + integer :: co2_glo_ind = -1 ! global index of 'CO2' + integer :: idx_ac_CO2 = -1 ! pbuf index of aircraft CO2 field !=============================================================================== contains @@ -96,6 +95,12 @@ subroutine co2_cycle_readnl(nlfile) call mpi_bcast(co2_readFlux_fuel, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2_readFlux_fuel") + if (masterproc) then + write(iulog, '(a, l4)') "co2_flag = ", co2_flag + write(iulog, '(a, l4)')"co2_readFlux_aircraft = ", co2_readFlux_aircraft + write(iulog, '(a, l4)')"co2_readFlux_fuel = ", co2_readFlux_fuel + end if + if (co2_readFlux_fuel) then call co2_data_flux_readnl(nlfile) end if @@ -135,12 +140,8 @@ subroutine co2_register longname=c_names(icnst), mixtype='dry') select case (trim(c_names(icnst))) - case ('CO2_OCN') - co2_ocn_glo_ind = c_i(icnst) case ('CO2_FFF') co2_fff_glo_ind = c_i(icnst) - case ('CO2_LND') - co2_lnd_glo_ind = c_i(icnst) case ('CO2') co2_glo_ind = c_i(icnst) end select @@ -150,15 +151,12 @@ end subroutine co2_register !=============================================================================== - function co2_transport() + logical function co2_transport() !------------------------------------------------------------------------------- ! Purpose: return true if this package is active !------------------------------------------------------------------------------- - ! Return value - logical :: co2_transport - !---------------------------------------------------------------------------- co2_transport = co2_flag @@ -167,28 +165,25 @@ end function co2_transport !=============================================================================== - function co2_implements_cnst(name) + logical function co2_implements_cnst(name) !------------------------------------------------------------------------------- ! Purpose: return true if specified constituent is implemented by this package !------------------------------------------------------------------------------- - ! Return value - logical :: co2_implements_cnst - ! Arguments character(len=*), intent(in) :: name ! constituent name ! Local variables - integer :: m + integer :: mind !---------------------------------------------------------------------------- co2_implements_cnst = .false. if (.not. co2_flag) return - do m = 1, ncnst - if (name == c_names(m)) then + do mind = 1, ncnst + if (name == c_names(mind)) then co2_implements_cnst = .true. return end if @@ -217,28 +212,28 @@ subroutine co2_init_cnst(name, latvals, lonvals, mask, q) real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev) ! Local variables - integer :: k + integer :: kindx !---------------------------------------------------------------------------- if (.not. co2_flag) return - do k = 1, size(q, 2) + do kindx = 1, size(q, 2) select case (name) case ('CO2_OCN') where(mask) - q(:, k) = chem_surfvals_get('CO2MMR') + q(:, kindx) = chem_surfvals_get('CO2MMR') end where case ('CO2_FFF') where(mask) - q(:, k) = chem_surfvals_get('CO2MMR') + q(:, kindx) = chem_surfvals_get('CO2MMR') end where case ('CO2_LND') where(mask) - q(:, k) = chem_surfvals_get('CO2MMR') + q(:, kindx) = chem_surfvals_get('CO2MMR') end where case ('CO2') where(mask) - q(:, k) = chem_surfvals_get('CO2MMR') + q(:, kindx) = chem_surfvals_get('CO2MMR') end where end select end do @@ -280,6 +275,9 @@ subroutine co2_init call add_default('TM'//trim(cnst_name(mm)), 1, ' ') end do + ! Find and store the aircraft CO2 index + idx_ac_CO2 = pbuf_get_index('ac_CO2') + end subroutine co2_init !=============================================================================== @@ -319,16 +317,17 @@ subroutine co2_cycle_set_ptend(state, pbuf, ptend) call physics_ptend_init(ptend, state%psetcols, 'co2_cycle_ac', lq=lq) - ifld = pbuf_get_index('ac_CO2') - call pbuf_get_field(pbuf, ifld, ac_CO2) + if (idx_ac_CO2 > 0) then + call pbuf_get_field(pbuf, idx_ac_CO2, ac_CO2) - ! [ac_CO2] = 'kg m-2 s-1' - ! [ptend%q] = 'kg kg-1 s-1' - ncol = state%ncol - do k = 1, pver - ptend%q(:ncol,k,co2_fff_glo_ind) = gravit * state%rpdeldry(:ncol,k) * ac_CO2(:ncol,k) - ptend%q(:ncol,k,co2_glo_ind) = gravit * state%rpdeldry(:ncol,k) * ac_CO2(:ncol,k) - end do + ! [ac_CO2] = 'kg m-2 s-1' + ! [ptend%q] = 'kg kg-1 s-1' + ncol = state%ncol + do k = 1, pver + ptend%q(:ncol,k,co2_fff_glo_ind) = gravit * state%rpdeldry(:ncol,k) * ac_CO2(:ncol,k) + ptend%q(:ncol,k,co2_glo_ind) = gravit * state%rpdeldry(:ncol,k) * ac_CO2(:ncol,k) + end do + end if end subroutine co2_cycle_set_ptend diff --git a/src/physics/cam/co2_data_flux.F90 b/src/physics/cam/co2_data_flux.F90 index 12b80f30ff..6ffcde55c6 100644 --- a/src/physics/cam/co2_data_flux.F90 +++ b/src/physics/cam/co2_data_flux.F90 @@ -42,7 +42,7 @@ module co2_data_flux logical :: first_advance_call = .true. - character(*),parameter :: u_FILE_u = __FILE__ + character(len=*),parameter :: u_FILE_u = __FILE__ !=============================================================================== contains @@ -69,7 +69,6 @@ subroutine co2_data_flux_readnl(nlfile) ! Local variables integer :: unitn, ierr - character(len=256) :: msg type(file_desc_t) :: fileid integer :: err_handling integer :: varid @@ -113,6 +112,16 @@ subroutine co2_data_flux_readnl(nlfile) call mpi_bcast(co2flux_fuel_taxmode, len(co2flux_fuel_taxmode), mpi_character, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: co2flux_fuel_taxmode "//trim(co2flux_fuel_taxmode)) + if (masterproc) then + write(iulog, '(2a)') "co2flux_fuel_datafile = ", trim(co2flux_fuel_datafile) + write(iulog, '(2a)') "co2flux_fuel_meshfile = ", trim(co2flux_fuel_meshfile) + write(iulog, '(a,i0)') "co2flux_fuel_year_first = ", co2flux_fuel_year_first + write(iulog, '(a,i0)') "co2flux_fuel_year_last = ", co2flux_fuel_year_last + write(iulog, '(a,i0)') "co2flux_fuel_year_align = ", co2flux_fuel_year_align + write(iulog, '(2a)') "co2flux_fuel_tintalgo = ", trim(co2flux_fuel_tintalgo) + write(iulog, '(2a)') "co2flux_fuel_taxmode = ", trim(co2flux_fuel_taxmode) + end if + ! Overwrite co2flux_fuel_tintalgo if it is set to 'unset' ! Check if the data file has a time_bnds variable and if so set the time interpolation ! type to 'nearest' otherwise set it to 'linear' diff --git a/src/physics/clubb b/src/physics/clubb index 15e802092f..178eb9c737 160000 --- a/src/physics/clubb +++ b/src/physics/clubb @@ -1 +1 @@ -Subproject commit 15e802092f65b3a20e5d67cb32d40f8a2771ca9b +Subproject commit 178eb9c7375388341cb0674b168b5e8ec38ad43d diff --git a/src/utils/ioFileMod.F90 b/src/utils/ioFileMod.F90 index 3f75718e00..01a4204b22 100644 --- a/src/utils/ioFileMod.F90 +++ b/src/utils/ioFileMod.F90 @@ -137,6 +137,7 @@ end subroutine getfil subroutine opnfil (locfn, iun, form, status) + use string_utils, only: int2str !----------------------------------------------------------------------- ! open file locfn in unformatted or formatted form on unit iun @@ -173,7 +174,7 @@ subroutine opnfil (locfn, iun, form, status) if(masterproc) then write(iulog,'(3a,i0,a,i0)')'(OPNFIL): failed to open file ', trim(locfn), ' on unit ',iun,', ierr=',ioe end if - call endrun ('opnfil') + call endrun('(OPNFIL): failed to open file '//trim(locfn)//' on unit '//int2str(iun)//', ierr='//int2str(ioe)) else if(masterproc) then write(iulog,'(3a,i0)')'(OPNFIL): Successfully opened file ', trim(locfn), ' on unit = ', iun From 9789e284a16bfbdc5ca455470074d213df734436 Mon Sep 17 00:00:00 2001 From: Steve Goldhaber Date: Wed, 10 Dec 2025 23:36:21 +0100 Subject: [PATCH 26/31] Try fixing clubb submodule hash --- src/physics/clubb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/clubb b/src/physics/clubb index 178eb9c737..15e802092f 160000 --- a/src/physics/clubb +++ b/src/physics/clubb @@ -1 +1 @@ -Subproject commit 178eb9c7375388341cb0674b168b5e8ec38ad43d +Subproject commit 15e802092f65b3a20e5d67cb32d40f8a2771ca9b From 678168e3becc95e820d97c9be384ed6e3424e479 Mon Sep 17 00:00:00 2001 From: Steve Goldhaber Date: Thu, 11 Dec 2025 20:26:03 +0100 Subject: [PATCH 27/31] Fix compiler errors --- src/chemistry/utils/aircraft_emit.F90 | 33 ++++++++++++++------------- src/control/cam_esmf_mod.F90 | 1 + src/physics/cam/co2_cycle.F90 | 7 +++--- 3 files changed, 22 insertions(+), 19 deletions(-) diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index f4a7e8434f..2788fd0490 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -358,19 +358,20 @@ subroutine aircraft_emit_adv( state, pbuf2d ) ! **** Advance to the aircraft data **** !------------------------------------------------------------------- - use dshr_methods_mod , only : dshr_fldbun_getfldptr - use dshr_strdata_mod , only : shr_strdata_init_from_inline, shr_strdata_advance - use cam_esmf_mod, only : model_mesh, model_clock - use physics_types, only : physics_state - use ppgrid, only : begchunk, endchunk, pcols, pver, pverp - use string_utils, only : to_lower, GLC - use cam_history, only : outfld - use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole - use physconst, only : boltz ! J/K/molecule - use phys_grid, only : get_wght_all_p, get_ncols_p - use physics_buffer, only : physics_buffer_desc, pbuf_get_field - use physics_buffer, only : pbuf_get_chunk - use time_manager, only : get_curr_date + use dshr_methods_mod , only: dshr_fldbun_getfldptr + use dshr_strdata_mod , only: shr_strdata_init_from_inline, shr_strdata_advance + use cam_esmf_mod, only: model_mesh, model_clock + use physics_types, only: physics_state + use ppgrid, only: begchunk, endchunk, pcols, pver, pverp + use string_utils, only: to_lower, GLC + use cam_history, only: outfld + use physconst, only: mwdry ! molecular weight dry air ~ kg/kmole + use physconst, only: boltz ! J/K/molecule + use phys_grid, only: get_wght_all_p, get_ncols_p + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use physics_buffer, only: pbuf_get_chunk + use string_utils, only: int2str + use time_manager, only: get_curr_date ! Arguments type(physics_state), intent(in) :: state(begchunk:endchunk) @@ -452,9 +453,9 @@ subroutine aircraft_emit_adv( state, pbuf2d ) call chkrc(rc,__LINE__,u_FILE_u) ! Obtain datain on model horizontal grid but the same vertical levels as the forcing dataset - allocate(datain3d(pcols,pver,begchunk:endchunk), stat=ierr) - if ( ierr /= 0 ) then - call endrun(trim(subname)//': failed to allocate datain3d, error = '//int2str(ierr)) + allocate(datain3d(pcols,pver,begchunk:endchunk), stat=rc) + if ( rc /= 0 ) then + call endrun(trim(subname)//': failed to allocate datain3d, error = '//int2str(rc)) end if do klev = 1, forcing(nf)%nlev !nlev is the number of levels in the forcing data gcell = 1 diff --git a/src/control/cam_esmf_mod.F90 b/src/control/cam_esmf_mod.F90 index 42d6b2ee3a..f1312f2894 100644 --- a/src/control/cam_esmf_mod.F90 +++ b/src/control/cam_esmf_mod.F90 @@ -62,6 +62,7 @@ end subroutine cam_esmf_set_mesh !===================================================================== subroutine cam_esmf_set_areas(model_areas_in, mesh_areas_in, rc) + use spmd_utils, only: masterproc ! Arguments real(r8), intent(in) :: model_areas_in(:) diff --git a/src/physics/cam/co2_cycle.F90 b/src/physics/cam/co2_cycle.F90 index f1e6823b0a..cffbc5618d 100644 --- a/src/physics/cam/co2_cycle.F90 +++ b/src/physics/cam/co2_cycle.F90 @@ -250,8 +250,9 @@ subroutine co2_init ! read co2 flux form fuel, as data_flux_fuel !------------------------------------------------------------------------------- - use cam_history, only: addfld, add_default, horiz_only - use constituents, only: cnst_name, cnst_longname, sflxnam + use cam_history, only: addfld, add_default, horiz_only + use constituents, only: cnst_name, cnst_longname, sflxnam + use physics_buffer, only: pbuf_get_index ! Local variables integer :: m, mm @@ -289,7 +290,7 @@ subroutine co2_cycle_set_ptend(state, pbuf, ptend) !------------------------------------------------------------------------------- use physics_types, only: physics_state, physics_ptend, physics_ptend_init - use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field + use physics_buffer, only: physics_buffer_desc, pbuf_get_field use constituents, only: pcnst use ppgrid, only: pver use physconst, only: gravit From e57a676ea1166dffeebb19b0220d8c138ae5d63f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Dec 2025 20:16:02 +0100 Subject: [PATCH 28/31] fixed problems in namelist generation --- bld/build-namelist | 22 ++++++++++---------- bld/namelist_files/namelist_defaults_cam.xml | 4 +++- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 71e0c5e2a2..4d0a468d24 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -711,11 +711,11 @@ if ($sim_year =~ /(\d+)-(\d+)/) { if (!($simple_phys or $aqua_mode)) { my $chem_nitrodep = chem_has_species($cfg, 'NO') and chem_has_species($cfg, 'NH3'); if ((!$chem_nitrodep) or ($chem =~ /geoschem/)) { - add_default($nl, 'stream_ndep_mesh_filename'); - add_default($nl, 'stream_ndep_data_filename', 'sim_year'=>$sim_year_start); - add_default($nl, 'stream_ndep_year_first', 'sim_year'=>$sim_year_start); - add_default($nl, 'stream_ndep_year_last', 'sim_year'=>$sim_year_end); - add_default($nl, 'stream_ndep_year_align', 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_mesh_filename' , 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_data_filename' , 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_year_first' , 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_year_last' , 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_year_align' , 'sim_year'=>$sim_year); } } @@ -834,9 +834,9 @@ if ($co2_cycle) { add_default($nl, 'co2flux_fuel_tintalgo'); add_default($nl, 'co2flux_fuel_meshfile'); add_default($nl, 'co2flux_fuel_datafile'); - add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year_start); - add_default($nl, 'co2flux_fuel_year_last' , 'sim_year'=>$sim_year_end); - add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year_start); + add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year; + add_default($nl, 'co2flux_fuel_year_last' , 'sim_year'=>$sim_year; + add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year; } add_default($nl, 'co2_readflux_aircraft', 'val'=>'.true.'); @@ -852,9 +852,9 @@ if ($co2_cycle) { add_default($nl, 'aircraft_co2_tintalgo'); add_default($nl, 'aircraft_co2_meshfile'); add_default($nl, 'aircraft_co2_datafile'); - add_default($nl, 'aircraft_co2_year_first', 'sim_year'=>$sim_year_start); - add_default($nl, 'aircraft_co2_year_last' , 'sim_year'=>$sim_year_end); - add_default($nl, 'aircraft_co2_year_align', 'sim_year'=>$sim_year_start); + add_default($nl, 'aircraft_co2_year_first', 'sim_year'=>$sim_year); + add_default($nl, 'aircraft_co2_year_last' , 'sim_year'=>$sim_year); + add_default($nl, 'aircraft_co2_year_align', 'sim_year'=>$sim_year); } } else { # This case probably should not happen (co2_cycle on with no sim year) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index e9569858fe..9b8683127f 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2016,7 +2016,9 @@ share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc -lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc +lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc + +share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc lnd/clm2/ndepdata/fndep_clm_WACCM6_CMIP6piControl001_y21-50avg_1850monthly_0.95x1.25_c180802.nc 2000 From 40106a6faa3e43b2f6d6268b9784e0e7945554fc Mon Sep 17 00:00:00 2001 From: Steve Goldhaber Date: Fri, 19 Dec 2025 18:45:11 +0100 Subject: [PATCH 29/31] Fix typos in build-namelist --- bld/build-namelist | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 4d0a468d24..09d7112292 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -713,9 +713,9 @@ if (!($simple_phys or $aqua_mode)) { if ((!$chem_nitrodep) or ($chem =~ /geoschem/)) { add_default($nl, 'stream_ndep_mesh_filename' , 'sim_year'=>$sim_year); add_default($nl, 'stream_ndep_data_filename' , 'sim_year'=>$sim_year); - add_default($nl, 'stream_ndep_year_first' , 'sim_year'=>$sim_year); - add_default($nl, 'stream_ndep_year_last' , 'sim_year'=>$sim_year); - add_default($nl, 'stream_ndep_year_align' , 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_year_first' , 'sim_year'=>$sim_year_start); + add_default($nl, 'stream_ndep_year_last' , 'sim_year'=>$sim_year_end); + add_default($nl, 'stream_ndep_year_align' , 'sim_year'=>$sim_year_start); } } @@ -834,9 +834,9 @@ if ($co2_cycle) { add_default($nl, 'co2flux_fuel_tintalgo'); add_default($nl, 'co2flux_fuel_meshfile'); add_default($nl, 'co2flux_fuel_datafile'); - add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year; - add_default($nl, 'co2flux_fuel_year_last' , 'sim_year'=>$sim_year; - add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year; + add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year_start); + add_default($nl, 'co2flux_fuel_year_last' , 'sim_year'=>$sim_year_end); + add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year_start); } add_default($nl, 'co2_readflux_aircraft', 'val'=>'.true.'); From 38ddd6b68e7a1e9288f02a8dc9afeaa646f48f5b Mon Sep 17 00:00:00 2001 From: Steve Goldhaber Date: Sat, 20 Dec 2025 11:42:18 +0100 Subject: [PATCH 30/31] Fix use of sim_year and add to NorESM use-case files --- bld/build-namelist | 22 +++++-------------- bld/namelist_files/namelist_definition.xml | 10 +++++---- .../use_cases/1850_camnor_lt_ghgosloaero.xml | 3 +++ .../use_cases/1850_camnor_lt_osloaero.xml | 3 +++ .../use_cases/1850_camnor_lt_tropmam4.xml | 3 +++ .../use_cases/2000_camnor_osloaero.xml | 5 ++++- .../use_cases/2000_camnor_tropmam4.xml | 3 +++ .../use_cases/hist_camnor_lt_osloaero.xml | 5 ++++- .../use_cases/hist_camnor_lt_tropmam4.xml | 3 +++ 9 files changed, 35 insertions(+), 22 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 09d7112292..6806da76c0 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -696,16 +696,6 @@ if (defined $nl->get_value('sim_year')) { $sim_year =~ s/['"]//g; #"' } -# sim_year_start -# If sim_year is input as a range of years, then select the first year -# to use with some datasets -my $sim_year_start = $sim_year; -my $sim_year_end = $sim_year; -if ($sim_year =~ /(\d+)-(\d+)/) { - $sim_year_start = $1; - $sim_year_end = $2; -} - # Setup default ndep streams only if not simple_phys or aqua_mode and # the chemistry cannot produce the nitrogen depostion fluxes if (!($simple_phys or $aqua_mode)) { @@ -713,9 +703,9 @@ if (!($simple_phys or $aqua_mode)) { if ((!$chem_nitrodep) or ($chem =~ /geoschem/)) { add_default($nl, 'stream_ndep_mesh_filename' , 'sim_year'=>$sim_year); add_default($nl, 'stream_ndep_data_filename' , 'sim_year'=>$sim_year); - add_default($nl, 'stream_ndep_year_first' , 'sim_year'=>$sim_year_start); - add_default($nl, 'stream_ndep_year_last' , 'sim_year'=>$sim_year_end); - add_default($nl, 'stream_ndep_year_align' , 'sim_year'=>$sim_year_start); + add_default($nl, 'stream_ndep_year_first' , 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_year_last' , 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_year_align' , 'sim_year'=>$sim_year); } } @@ -834,9 +824,9 @@ if ($co2_cycle) { add_default($nl, 'co2flux_fuel_tintalgo'); add_default($nl, 'co2flux_fuel_meshfile'); add_default($nl, 'co2flux_fuel_datafile'); - add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year_start); - add_default($nl, 'co2flux_fuel_year_last' , 'sim_year'=>$sim_year_end); - add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year_start); + add_default($nl, 'co2flux_fuel_year_first', 'sim_year'=>$sim_year); + add_default($nl, 'co2flux_fuel_year_last' , 'sim_year'=>$sim_year); + add_default($nl, 'co2flux_fuel_year_align', 'sim_year'=>$sim_year); } add_default($nl, 'co2_readflux_aircraft', 'val'=>'.true.'); diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index ad1f70ae89..aef4d8aaba 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -8192,12 +8192,14 @@ Default: FALSE -First year to use in nitrogen deposition stream data. + First year to use in nitrogen deposition stream data. + Default: 2000 -Last year last to use in nitrogen deposition stream data. + Last year last to use in nitrogen deposition stream data. + Default: 2000 This varible is only used internally by build-namelist to determine appropriate defaults for climatological or transient forcing datasets. -Default: set by build-namelist. +Default: 2000 diff --git a/bld/namelist_files/use_cases/1850_camnor_lt_ghgosloaero.xml b/bld/namelist_files/use_cases/1850_camnor_lt_ghgosloaero.xml index d8898106dc..5c352f3c35 100644 --- a/bld/namelist_files/use_cases/1850_camnor_lt_ghgosloaero.xml +++ b/bld/namelist_files/use_cases/1850_camnor_lt_ghgosloaero.xml @@ -98,4 +98,7 @@ 4 .true. + +1850 + diff --git a/bld/namelist_files/use_cases/1850_camnor_lt_osloaero.xml b/bld/namelist_files/use_cases/1850_camnor_lt_osloaero.xml index 0167860ad5..c414bb45d2 100644 --- a/bld/namelist_files/use_cases/1850_camnor_lt_osloaero.xml +++ b/bld/namelist_files/use_cases/1850_camnor_lt_osloaero.xml @@ -99,4 +99,7 @@ 4 .true. + +1850 + diff --git a/bld/namelist_files/use_cases/1850_camnor_lt_tropmam4.xml b/bld/namelist_files/use_cases/1850_camnor_lt_tropmam4.xml index 0dd5289c14..abea1bc3c0 100644 --- a/bld/namelist_files/use_cases/1850_camnor_lt_tropmam4.xml +++ b/bld/namelist_files/use_cases/1850_camnor_lt_tropmam4.xml @@ -78,4 +78,7 @@ 4 .true. + +1850 + diff --git a/bld/namelist_files/use_cases/2000_camnor_osloaero.xml b/bld/namelist_files/use_cases/2000_camnor_osloaero.xml index 9ba14f40b7..27e6ca6304 100644 --- a/bld/namelist_files/use_cases/2000_camnor_osloaero.xml +++ b/bld/namelist_files/use_cases/2000_camnor_osloaero.xml @@ -71,7 +71,7 @@ 4.60D0 -Leung_2023 +Leung_2023 @@ -91,4 +91,7 @@ 4 .true. + +2000 + diff --git a/bld/namelist_files/use_cases/2000_camnor_tropmam4.xml b/bld/namelist_files/use_cases/2000_camnor_tropmam4.xml index 08a4a04f6b..310ddb7673 100644 --- a/bld/namelist_files/use_cases/2000_camnor_tropmam4.xml +++ b/bld/namelist_files/use_cases/2000_camnor_tropmam4.xml @@ -101,4 +101,7 @@ 4 .true. + +2000 + diff --git a/bld/namelist_files/use_cases/hist_camnor_lt_osloaero.xml b/bld/namelist_files/use_cases/hist_camnor_lt_osloaero.xml index ef7f962161..5694cd424a 100644 --- a/bld/namelist_files/use_cases/hist_camnor_lt_osloaero.xml +++ b/bld/namelist_files/use_cases/hist_camnor_lt_osloaero.xml @@ -72,7 +72,7 @@ 4.60D0 -Leung_2023 +Leung_2023 @@ -92,4 +92,7 @@ 4 .true. + +1850-2015 + diff --git a/bld/namelist_files/use_cases/hist_camnor_lt_tropmam4.xml b/bld/namelist_files/use_cases/hist_camnor_lt_tropmam4.xml index 25e9e17d13..094971eeb3 100644 --- a/bld/namelist_files/use_cases/hist_camnor_lt_tropmam4.xml +++ b/bld/namelist_files/use_cases/hist_camnor_lt_tropmam4.xml @@ -60,4 +60,7 @@ 4 .true. + +1850-2015 + From 1740a6a6b29f51787604ab652d2d067fc7c3677a Mon Sep 17 00:00:00 2001 From: Steve Goldhaber Date: Sat, 20 Dec 2025 12:03:52 +0100 Subject: [PATCH 31/31] Correct some namelist documentation --- bld/namelist_files/namelist_definition.xml | 46 ++++++++++++---------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index aef4d8aaba..a39843f2d4 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1797,24 +1797,24 @@ Default: TRUE for transient model runs, FALSE otherwise. Full filepath for dataset containing CO2 flux from fossil fuel. -Default: none +Default: set by build-namelist, see namelist_defaults_cam.xml Full filepath for ESMF Mesh corresponding to co2flux_fuel_datafile File. -Default: none +Default: set by build-namelist First year to use in co2flux_fuel_datafile. -Default: 0 +Default: set by build-namelist based on sim_year. Last year to use in co2flux_fuel_datafile. -Default: 0 +Default: set by build-namelist based on sim_year. Full pathname of the data file containing aircraft co2 emissions. -Default: set by build-namelist. +Default: set by build-namelist based on sim_year. First year of the aircraft_co2_datafile to use. -Default: set by build-namelist. +Default: set by build-namelist based on sim_year. Last year of the aircraft_co2_datafile to use. -Default: set by build-namelist. +Default: set by build-namelist based on sim_year. -First year of the aircraft_h2o_datafile to use. + First year of the aircraft_h2o_datafile to use. + Default: NONE -Last year of the aircraft_h2o_datafile to use. + Last year of the aircraft_h2o_datafile to use. + Default: NONE -Full pathname of the data file containing ac_SLANT_DIST (by default). + Full pathname of the data file containing ac_SLANT_DIST (by default). + Default: NONE -Full pathname of the ESMF mesh file corresponding to aircraft_slant_dist. + Full pathname of the ESMF mesh file corresponding to aircraft_slant_dist. + Default: NONE -Full pathname of the ESMF mesh file corresponding to aircraft_slant_dist. + Full pathname of the ESMF mesh file corresponding to aircraft_slant_dist. + Default: NONE -First year of the aircraft_slant_dist to use. + First year of the aircraft_slant_dist to use. + Default: NONE -Last year of the aircraft_slant_dist to use. + Last year of the aircraft_slant_dist to use. + Default: NONE