From 1268191a5d3d499976129595aade2ee7a0495fe7 Mon Sep 17 00:00:00 2001 From: Tanya Spero Date: Thu, 13 Jun 2024 15:14:44 -0400 Subject: [PATCH 1/7] Corrections for tipping bucket and nudging for very long simulations --- dyn_em/module_first_rk_step_part1.F | 5 ++-- dyn_em/solve_em.F | 9 +++++-- phys/module_diag_misc.F | 7 ++++- phys/module_fdda_psufddagd.F | 40 ++++++++++++++++++++--------- phys/module_fdda_spnudging.F | 28 +++++++++++++++----- phys/module_fddagd_driver.F | 8 +++--- 6 files changed, 70 insertions(+), 27 deletions(-) diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F index 6623cab7bd..e771b70da4 100644 --- a/dyn_em/module_first_rk_step_part1.F +++ b/dyn_em/module_first_rk_step_part1.F @@ -19,6 +19,7 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & , ph_tendf, mu_tendf & , tke_tend & , adapt_step_flag , curr_secs & + , curr_mins2 & , psim , psih , gz1oz0 , chklowq & , cu_act_flag , hol , th_phy & , pi_phy , p_phy , t_phy & @@ -77,7 +78,7 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & LOGICAL ,INTENT(IN) :: adapt_step_flag - REAL, INTENT(IN) :: curr_secs + REAL, INTENT(IN) :: curr_secs, curr_mins2 REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist_tend @@ -1770,7 +1771,7 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & BENCH_START(fdda_driver_tim) CALL fddagd_driver(itimestep=grid%itimestep,dt=grid%dt,xtime=grid%XTIME, & - id=grid%id, & + curr_mins2=curr_mins2, id=grid%id, & RUNDGDTEN=grid%rundgdten,RVNDGDTEN=grid%rvndgdten, & RTHNDGDTEN=grid%rthndgdten,RPHNDGDTEN=grid%rphndgdten, & RQVNDGDTEN=grid%rqvndgdten,RMUNDGDTEN=grid%rmundgdten, & diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F index c5f47a50a6..96eb582d0b 100644 --- a/dyn_em/solve_em.F +++ b/dyn_em/solve_em.F @@ -183,7 +183,8 @@ SUBROUTINE solve_em ( grid , config_flags & LOGICAL :: leapfrog INTEGER :: l,kte,kk LOGICAL :: f_flux ! flag for computing averaged fluxes in cu_gd - REAL :: curr_secs, curr_secs2 + REAL :: curr_secs, curr_secs2, curr_mins2 + REAL(8) :: curr_secs_r8, curr_secs2_r8 INTEGER :: num_sound_steps INTEGER :: idex, jdex REAL :: max_msft @@ -198,6 +199,7 @@ SUBROUTINE solve_em ( grid , config_flags & TYPE(WRFU_TimeInterval) :: tmpTimeInterval, tmpTimeInterval2 REAL :: real_time + REAL(8) :: real_time_r8 LOGICAL :: adapt_step_flag LOGICAL :: fill_w_flag @@ -331,6 +333,9 @@ END SUBROUTINE CMAQ_DRIVER tmpTimeInterval2 = domain_get_current_time ( grid ) - domain_get_start_time ( grid ) curr_secs = real_time(tmpTimeInterval) curr_secs2 = real_time(tmpTimeInterval2) + curr_secs_r8 = real_time_r8(tmpTimeInterval) + curr_secs2_r8 = real_time_r8(tmpTimeInterval2) + curr_mins2 = REAL( curr_secs2_r8 / 60.0d0 ) old_dt = grid%dt ! store old time step for flux averaging code at end of RK loop @@ -811,7 +816,7 @@ END SUBROUTINE CMAQ_DRIVER , ph_tendf, mu_tendf & , tke_tend & , config_flags%use_adaptive_time_step & - , curr_secs & + , curr_secs, curr_mins2 & , psim , psih , gz1oz0 & , chklowq & , cu_act_flag , hol , th_phy & diff --git a/phys/module_diag_misc.F b/phys/module_diag_misc.F index 04ca35f82f..83e544ba7c 100644 --- a/phys/module_diag_misc.F +++ b/phys/module_diag_misc.F @@ -288,7 +288,12 @@ SUBROUTINE diagnostic_output_calc( & !----------------------------------------------------------------- ! Handle accumulations with buckets to prevent round-off truncation in long runs ! This is done every 360 minutes assuming time step fits exactly into 360 minutes - IF(bucket_mm .gt. 0. .AND. MOD(NINT(XTIME),360) .EQ. 0)THEN + +!!!~~ If CURR_SECS2 really is since restart, it would be preferred to +!!!~~ XTIME here because XTIME goes imprecise at just under 32 years. TLS + +!!! IF(bucket_mm .gt. 0. .AND. MOD(NINT(XTIME),360) .EQ. 0)THEN + IF(bucket_mm .gt. 0. .AND. MOD(NINT(CURR_SECS2),3600) .EQ. 0)THEN ! SET START AND END POINTS FOR TILES ! !$OMP PARALLEL DO & ! !$OMP PRIVATE ( ij ) diff --git a/phys/module_fdda_psufddagd.F b/phys/module_fdda_psufddagd.F index 6a64a62ae2..5d1ac717cd 100644 --- a/phys/module_fdda_psufddagd.F +++ b/phys/module_fdda_psufddagd.F @@ -9,7 +9,17 @@ ! surfance reanalsys !Reference: Alapaty et al., 2008: Development of the flux-adjusting surface ! data assimilation system for mesoscale models. JAMC, 47, 2331-2350 - +! +! Changed logic for determining next nudging time to rely on minutes elapsed +! since restart (CURR_MINS2) rather than on minutes since initialization +! (XTIME). The REAL variable, XTIME, will become imprecise after 1 X 2^24 +! minutes (just under 32 years of continuous simulation). Cannot remove all +! reliance on XTIME because actual end time is in absolute minutes. Using XTIME +! results in spectral nudging analyses ingested at the wrong times, beginning +! 23 years and 3.5 months into a continous simulation. Purposefully not +! modifying the ramping function because pragmatically we will not get +! very large XTIME values in any situation where the off-ramp for nudging would +! be used. (Tanya Spero, U.S. Environmental Protection Agency -- June 2024) ! ! MODULE module_fdda_psufddagd @@ -18,7 +28,7 @@ MODULE module_fdda_psufddagd ! !------------------------------------------------------------------- ! - SUBROUTINE fddagd(itimestep,dx,dt,xtime, & + SUBROUTINE fddagd(itimestep,dx,dt,xtime, curr_mins2, & id,analysis_interval, end_fdda_hour, & if_no_pbl_nudging_uv, if_no_pbl_nudging_t, if_no_pbl_nudging_q, & if_zfac_uv, k_zfac_uv, if_zfac_t, k_zfac_t, if_zfac_q, k_zfac_q, & @@ -101,7 +111,7 @@ SUBROUTINE fddagd(itimestep,dx,dt,xtime, & INTEGER, INTENT(IN) :: if_ramping INTEGER , INTENT(IN) :: id - REAL, INTENT(IN) :: DT, dx, xtime, dtramp_min + REAL, INTENT(IN) :: DT, dx, xtime, dtramp_min, curr_mins2 INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -243,10 +253,12 @@ SUBROUTINE fddagd(itimestep,dx,dt,xtime, & ENDIF IF( analysis_interval <= 0 )CALL wrf_error_fatal('In grid FDDA, gfdda_interval_m must be > 0') - xtime_old = FLOOR(xtime/analysis_interval) * analysis_interval * 1.0 +!!! xtime_old = FLOOR(xtime/analysis_interval) * analysis_interval * 1.0 + xtime_old = FLOOR(curr_mins2/analysis_interval) * analysis_interval * 1.0 xtime_new = xtime_old + analysis_interval IF( int4 == 1 ) THEN - coef = (xtime-xtime_old)/(xtime_new-xtime_old) +!!! coef = (xtime-xtime_old)/(xtime_new-xtime_old) + coef = (curr_mins2-xtime_old)/(xtime_new-xtime_old) ELSE coef = 1.0 ! Nudging toward a target value (*_ndg_new values) ENDIF @@ -255,7 +267,8 @@ SUBROUTINE fddagd(itimestep,dx,dt,xtime, & CALL get_wrf_debug_level( dbg_level ) - IF( xtime-xtime_old < 0.5*dt/60.0 ) THEN +!!! IF( xtime-xtime_old < 0.5*dt/60.0 ) THEN + IF( curr_mins2-xtime_old < 0.5*dt/60.0 ) THEN IF( xtime < end_fdda_hour*60.0 ) THEN WRITE(message,'(a,i1,a,f10.3,a)') & @@ -578,7 +591,7 @@ SUBROUTINE fddagd(itimestep,dx,dt,xtime, & ! Surface Analysis Nudging ! IF( grid_sfdda >= 1 ) THEN - CALL SFDDAGD(itimestep,dx,dt,xtime, id, & + CALL SFDDAGD(itimestep,dx,dt,xtime, curr_mins2, id, & analysis_interval_sfc, end_fdda_hour_sfc, guv_sfc, gt_sfc, gq_sfc, & rinblw, & u3d,v3d,th3d,t3d, & @@ -680,7 +693,7 @@ SUBROUTINE fddagd(itimestep,dx,dt,xtime, & END SUBROUTINE fddagd !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - SUBROUTINE sfddagd(itimestep,dx,dt,xtime, & + SUBROUTINE sfddagd(itimestep,dx,dt,xtime, curr_mins2, & id, analysis_interval_sfc, end_fdda_hour_sfc, & guv_sfc, gt_sfc, gq_sfc, rinblw, & u3d,v3d,th3d,t3d, & @@ -758,7 +771,7 @@ SUBROUTINE sfddagd(itimestep,dx,dt,xtime, & INTEGER, INTENT(IN) :: itimestep, analysis_interval_sfc, end_fdda_hour_sfc INTEGER , INTENT(IN) :: id - REAL, INTENT(IN) :: dx,DT, xtime + REAL, INTENT(IN) :: dx,DT, xtime, curr_mins2 INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -862,10 +875,12 @@ SUBROUTINE sfddagd(itimestep,dx,dt,xtime, & int4 = 1 ! 1: temporal ionterpolation. else: target nudging toward *_ndg_new values IF( analysis_interval_sfc <= 0 )CALL wrf_error_fatal('In grid sfc FDDA, sgfdda_interval_m must be > 0') - xtime_old_sfc = FLOOR(xtime/analysis_interval_sfc) * analysis_interval_sfc * 1.0 +!!! xtime_old_sfc = FLOOR(xtime/analysis_interval_sfc) * analysis_interval_sfc * 1.0 + xtime_old_sfc = FLOOR(curr_mins2/analysis_interval_sfc) * analysis_interval_sfc * 1.0 xtime_new_sfc = xtime_old_sfc + analysis_interval_sfc IF( int4 == 1 ) THEN - coef = (xtime-xtime_old_sfc)/(xtime_new_sfc-xtime_old_sfc) ! Temporal interpolation +!!! coef = (xtime-xtime_old_sfc)/(xtime_new_sfc-xtime_old_sfc) ! Temporal interpolation + coef = (curr_mins2-xtime_old_sfc)/(xtime_new_sfc-xtime_old_sfc) ! Temporal interpolation ELSE coef = 1.0 ! Nudging toward a target value (*_ndg_new values) ENDIF @@ -874,7 +889,8 @@ SUBROUTINE sfddagd(itimestep,dx,dt,xtime, & CALL get_wrf_debug_level( dbg_level ) - IF( xtime-xtime_old_sfc < 0.5*dt/60.0 ) THEN +!!! IF( xtime-xtime_old_sfc < 0.5*dt/60.0 ) THEN + IF( curr_mins2-xtime_old_sfc < 0.5*dt/60.0 ) THEN IF( xtime < end_fdda_hour_sfc*60.0 ) THEN WRITE(message,'(a,i1,a,f10.3,a)') & diff --git a/phys/module_fdda_spnudging.F b/phys/module_fdda_spnudging.F index d48b3d0fd9..fb32d7a7af 100644 --- a/phys/module_fdda_spnudging.F +++ b/phys/module_fdda_spnudging.F @@ -5,6 +5,17 @@ ! Added capability to spectrally nudge water vapor mixing ratio, and added ! user-definable lid for nudging potential temperature and water vapor mixing ! ratio. (Tanya Spero, U.S. Environmental Protection Agency -- October 2017) +! +! Changed logic for determining next nudging time to rely on minutes elapsed +! since restart (CURR_MINS2) rather than on minutes since initialization +! (XTIME). The REAL variable, XTIME, will become imprecise after 1 X 2^24 +! minutes (just under 32 years of continuous simulation). Cannot remove all +! reliance on XTIME because actual end time is in absolute minutes. Using XTIME +! results in spectral nudging analyses ingested at the wrong times, beginning +! 23 years and 3.5 months into a continous simulation. Purposefully not +! modifying the ramping function because pragmatically we will not get +! very large XTIME values in any situation where the off-ramp for nudging would +! be used. (Tanya Spero, U.S. Environmental Protection Agency -- June 2024) MODULE module_fdda_spnudging @@ -17,7 +28,8 @@ MODULE module_fdda_spnudging ! !------------------------------------------------------------------- ! - SUBROUTINE spectral_nudging(grid,itimestep,dt,xtime,id,analysis_interval, end_fdda_hour, & + SUBROUTINE spectral_nudging(grid,itimestep,dt,xtime,curr_mins2, & + id,analysis_interval, end_fdda_hour, & if_no_pbl_nudging_uv, if_no_pbl_nudging_t, if_no_pbl_nudging_ph,if_no_pbl_nudging_q,& if_zfac_uv, k_zfac_uv, dk_zfac_uv, & if_zfac_t, k_zfac_t, dk_zfac_t, & @@ -95,7 +107,7 @@ SUBROUTINE spectral_nudging(grid,itimestep,dt,xtime,id,analysis_interval, end_fd INTEGER, INTENT(IN) :: xwavenum,ywavenum INTEGER , INTENT(IN) :: id - REAL, INTENT(IN) :: DT, xtime, dtramp_min + REAL, INTENT(IN) :: DT, xtime, dtramp_min, curr_mins2 INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -202,15 +214,18 @@ SUBROUTINE spectral_nudging(grid,itimestep,dt,xtime,id,analysis_interval, end_fd ! IF( if_ramping == 1 .AND. dtramp_min > 0.0 ) & ! actual_end_fdda_min = end_fdda_hour*60.0 + ABS(dtramp_min) - xtime_old = FLOOR(xtime/analysis_interval) * analysis_interval * 1.0 +!!! xtime_old = FLOOR(xtime/analysis_interval) * analysis_interval * 1.0 + xtime_old = FLOOR(curr_mins2/analysis_interval) * analysis_interval * 1.0 xtime_new = xtime_old + analysis_interval - coef = (xtime-xtime_old)/(xtime_new-xtime_old) +!!! coef = (xtime-xtime_old)/(xtime_new-xtime_old) + coef = (curr_mins2-xtime_old)/(xtime_new-xtime_old) IF ( wrf_dm_on_monitor()) THEN CALL get_wrf_debug_level( dbg_level ) - IF( xtime-xtime_old < 0.5*dt/60.0 ) THEN +!!! IF( xtime-xtime_old < 0.5*dt/60.0 ) THEN + IF( curr_mins2-xtime_old < 0.5*dt/60.0 ) THEN IF( xtime < end_fdda_hour*60.0 ) THEN WRITE(wrf_err_message,FMT='(a,i2.2,a,f15.3,a)') & @@ -549,7 +564,8 @@ SUBROUTINE spectral_nudging(grid,itimestep,dt,xtime,id,analysis_interval, end_fd tfac = 1.0 ELSEIF( xtime >= actual_end_fdda_min-ABS(dtramp_min) .AND. xtime <= actual_end_fdda_min )THEN tfac = ( actual_end_fdda_min - xtime ) / ABS(dtramp_min) - IF( dtramp_min > 0.0 ) coef = (xtime-xtime_old+analysis_interval)/analysis_interval +!!! IF( dtramp_min > 0.0 ) coef = (xtime-xtime_old+analysis_interval)/analysis_interval + IF( dtramp_min > 0.0 ) coef = (curr_mins2-xtime_old+analysis_interval)/analysis_interval ELSE tfac = 0.0 ENDIF diff --git a/phys/module_fddagd_driver.F b/phys/module_fddagd_driver.F index dd9b8b38e9..ba5fcdfda4 100644 --- a/phys/module_fddagd_driver.F +++ b/phys/module_fddagd_driver.F @@ -6,7 +6,7 @@ MODULE module_fddagd_driver !------------------------------------------------------------------ SUBROUTINE fddagd_driver(itimestep,dt,xtime, & - id, & + curr_mins2, id, & RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, & RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & SDA_HFX, SDA_QFX, & !fasdas @@ -143,7 +143,7 @@ SUBROUTINE fddagd_driver(itimestep,dt,xtime, & INTEGER, INTENT(IN ) :: itimestep,STEPFG ! - REAL, INTENT(IN ) :: DT,DX,XTIME + REAL, INTENT(IN ) :: DT,DX,XTIME, curr_mins2 ! @@ -521,7 +521,7 @@ SUBROUTINE fddagd_driver(itimestep,dt,xtime, & ENDIF CALL FDDAGD(itimestep,dx,dt,xtime, & - id, & + curr_mins2, id, & config_flags%auxinput10_interval_m, & config_flags%auxinput10_end_h, & config_flags%if_no_pbl_nudging_uv, & @@ -570,7 +570,7 @@ SUBROUTINE fddagd_driver(itimestep,dt,xtime, & CASE (SPNUDGING) CALL wrf_debug(100,'in SPECTRAL NUDGING scheme') CALL SPECTRAL_NUDGING(grid,itimestep,dt,xtime, & - id, & + curr_mins2, id, & config_flags%auxinput10_interval_m, & config_flags%auxinput10_end_h, & config_flags%if_no_pbl_nudging_uv, & From ed4b1aedaf44e30a4940558f0849413787db309c Mon Sep 17 00:00:00 2001 From: Tanya Spero Date: Thu, 13 Jun 2024 16:59:03 -0400 Subject: [PATCH 2/7] removed commented-out code that was replace in this update --- phys/module_diag_misc.F | 5 ++--- phys/module_fdda_psufddagd.F | 6 ------ phys/module_fdda_spnudging.F | 4 ---- 3 files changed, 2 insertions(+), 13 deletions(-) diff --git a/phys/module_diag_misc.F b/phys/module_diag_misc.F index 83e544ba7c..54ba69e42d 100644 --- a/phys/module_diag_misc.F +++ b/phys/module_diag_misc.F @@ -289,10 +289,9 @@ SUBROUTINE diagnostic_output_calc( & ! Handle accumulations with buckets to prevent round-off truncation in long runs ! This is done every 360 minutes assuming time step fits exactly into 360 minutes -!!!~~ If CURR_SECS2 really is since restart, it would be preferred to -!!!~~ XTIME here because XTIME goes imprecise at just under 32 years. TLS +!!!~~ CURR_SECS2 is elapsed seconds since restart. It is preferred to +!!!~~ XTIME here because XTIME goes imprecise at 2^24, just under 32 years. -!!! IF(bucket_mm .gt. 0. .AND. MOD(NINT(XTIME),360) .EQ. 0)THEN IF(bucket_mm .gt. 0. .AND. MOD(NINT(CURR_SECS2),3600) .EQ. 0)THEN ! SET START AND END POINTS FOR TILES ! !$OMP PARALLEL DO & diff --git a/phys/module_fdda_psufddagd.F b/phys/module_fdda_psufddagd.F index 5d1ac717cd..fc773ab3d2 100644 --- a/phys/module_fdda_psufddagd.F +++ b/phys/module_fdda_psufddagd.F @@ -253,11 +253,9 @@ SUBROUTINE fddagd(itimestep,dx,dt,xtime, curr_mins2, & ENDIF IF( analysis_interval <= 0 )CALL wrf_error_fatal('In grid FDDA, gfdda_interval_m must be > 0') -!!! xtime_old = FLOOR(xtime/analysis_interval) * analysis_interval * 1.0 xtime_old = FLOOR(curr_mins2/analysis_interval) * analysis_interval * 1.0 xtime_new = xtime_old + analysis_interval IF( int4 == 1 ) THEN -!!! coef = (xtime-xtime_old)/(xtime_new-xtime_old) coef = (curr_mins2-xtime_old)/(xtime_new-xtime_old) ELSE coef = 1.0 ! Nudging toward a target value (*_ndg_new values) @@ -267,7 +265,6 @@ SUBROUTINE fddagd(itimestep,dx,dt,xtime, curr_mins2, & CALL get_wrf_debug_level( dbg_level ) -!!! IF( xtime-xtime_old < 0.5*dt/60.0 ) THEN IF( curr_mins2-xtime_old < 0.5*dt/60.0 ) THEN IF( xtime < end_fdda_hour*60.0 ) THEN @@ -875,11 +872,9 @@ SUBROUTINE sfddagd(itimestep,dx,dt,xtime, curr_mins2, & int4 = 1 ! 1: temporal ionterpolation. else: target nudging toward *_ndg_new values IF( analysis_interval_sfc <= 0 )CALL wrf_error_fatal('In grid sfc FDDA, sgfdda_interval_m must be > 0') -!!! xtime_old_sfc = FLOOR(xtime/analysis_interval_sfc) * analysis_interval_sfc * 1.0 xtime_old_sfc = FLOOR(curr_mins2/analysis_interval_sfc) * analysis_interval_sfc * 1.0 xtime_new_sfc = xtime_old_sfc + analysis_interval_sfc IF( int4 == 1 ) THEN -!!! coef = (xtime-xtime_old_sfc)/(xtime_new_sfc-xtime_old_sfc) ! Temporal interpolation coef = (curr_mins2-xtime_old_sfc)/(xtime_new_sfc-xtime_old_sfc) ! Temporal interpolation ELSE coef = 1.0 ! Nudging toward a target value (*_ndg_new values) @@ -889,7 +884,6 @@ SUBROUTINE sfddagd(itimestep,dx,dt,xtime, curr_mins2, & CALL get_wrf_debug_level( dbg_level ) -!!! IF( xtime-xtime_old_sfc < 0.5*dt/60.0 ) THEN IF( curr_mins2-xtime_old_sfc < 0.5*dt/60.0 ) THEN IF( xtime < end_fdda_hour_sfc*60.0 ) THEN diff --git a/phys/module_fdda_spnudging.F b/phys/module_fdda_spnudging.F index fb32d7a7af..facebb8453 100644 --- a/phys/module_fdda_spnudging.F +++ b/phys/module_fdda_spnudging.F @@ -214,17 +214,14 @@ SUBROUTINE spectral_nudging(grid,itimestep,dt,xtime,curr_mins2, & ! IF( if_ramping == 1 .AND. dtramp_min > 0.0 ) & ! actual_end_fdda_min = end_fdda_hour*60.0 + ABS(dtramp_min) -!!! xtime_old = FLOOR(xtime/analysis_interval) * analysis_interval * 1.0 xtime_old = FLOOR(curr_mins2/analysis_interval) * analysis_interval * 1.0 xtime_new = xtime_old + analysis_interval -!!! coef = (xtime-xtime_old)/(xtime_new-xtime_old) coef = (curr_mins2-xtime_old)/(xtime_new-xtime_old) IF ( wrf_dm_on_monitor()) THEN CALL get_wrf_debug_level( dbg_level ) -!!! IF( xtime-xtime_old < 0.5*dt/60.0 ) THEN IF( curr_mins2-xtime_old < 0.5*dt/60.0 ) THEN IF( xtime < end_fdda_hour*60.0 ) THEN @@ -564,7 +561,6 @@ SUBROUTINE spectral_nudging(grid,itimestep,dt,xtime,curr_mins2, & tfac = 1.0 ELSEIF( xtime >= actual_end_fdda_min-ABS(dtramp_min) .AND. xtime <= actual_end_fdda_min )THEN tfac = ( actual_end_fdda_min - xtime ) / ABS(dtramp_min) -!!! IF( dtramp_min > 0.0 ) coef = (xtime-xtime_old+analysis_interval)/analysis_interval IF( dtramp_min > 0.0 ) coef = (curr_mins2-xtime_old+analysis_interval)/analysis_interval ELSE tfac = 0.0 From cecfcce3f9c68b9d3139096688b08bc500693161 Mon Sep 17 00:00:00 2001 From: Tanya Spero Date: Fri, 13 Sep 2024 08:45:07 -0400 Subject: [PATCH 3/7] updates to analogous adjoint codes to make the change comprehensive --- wrftladj/module_first_rk_step_part1_ad.F | 3 ++- wrftladj/module_first_rk_step_part1_tl.F | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/wrftladj/module_first_rk_step_part1_ad.F b/wrftladj/module_first_rk_step_part1_ad.F index a82001ef8d..0c05aa6e67 100644 --- a/wrftladj/module_first_rk_step_part1_ad.F +++ b/wrftladj/module_first_rk_step_part1_ad.F @@ -19,6 +19,7 @@ SUBROUTINE a_first_rk_step_part1 ( grid , config_flags & , ph_tendf, a_ph_tendf, mu_tendf, a_mu_tendf & , tke_tend, a_tke_tend & , adapt_step_flag , curr_secs & + , curr_mins2 & , psim , psih , gz1oz0 , chklowq & , cu_act_flag , hol , th_phy , a_th_phy & , pi_phy , a_pi_phy , p_phy , a_p_phy , t_phy , a_t_phy & @@ -75,7 +76,7 @@ SUBROUTINE a_first_rk_step_part1 ( grid , config_flags & LOGICAL ,INTENT(IN) :: adapt_step_flag - REAL, INTENT(IN) :: curr_secs + REAL, INTENT(IN) :: curr_secs, curr_mins2 REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: a_moist diff --git a/wrftladj/module_first_rk_step_part1_tl.F b/wrftladj/module_first_rk_step_part1_tl.F index 65dda7278a..5879a5ee84 100644 --- a/wrftladj/module_first_rk_step_part1_tl.F +++ b/wrftladj/module_first_rk_step_part1_tl.F @@ -19,6 +19,7 @@ SUBROUTINE g_first_rk_step_part1 ( grid , config_flags & , ph_tendf, g_ph_tendf, mu_tendf, g_mu_tendf & , tke_tend, g_tke_tend & , adapt_step_flag , curr_secs & + , curr_mins2 & , psim , psih , gz1oz0 , chklowq & , cu_act_flag , hol , th_phy , g_th_phy & , pi_phy, g_pi_phy, p_phy ,g_p_phy, t_phy ,g_t_phy & @@ -76,7 +77,7 @@ SUBROUTINE g_first_rk_step_part1 ( grid , config_flags & LOGICAL ,INTENT(IN) :: adapt_step_flag - REAL, INTENT(IN) :: curr_secs + REAL, INTENT(IN) :: curr_secs, curr_mins2 REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: g_moist From 293ab0132164ebeacad773b83a222baf6ffc59f9 Mon Sep 17 00:00:00 2001 From: Tanya Spero Date: Fri, 13 Sep 2024 13:26:27 -0400 Subject: [PATCH 4/7] adding two more stragglers in the adjoint code --- wrftladj/solve_em_ad.F | 2 +- wrftladj/solve_em_tl.F | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/wrftladj/solve_em_ad.F b/wrftladj/solve_em_ad.F index 5acb79d4d8..5d3cd90d20 100644 --- a/wrftladj/solve_em_ad.F +++ b/wrftladj/solve_em_ad.F @@ -672,7 +672,7 @@ SUBROUTINE solve_em_ad ( grid , config_flags & , ph_tendf, mu_tendf & , tke_tend & , config_flags%use_adaptive_time_step & - , curr_secs & + , curr_secs, curr_mins2 & , psim , psih , gz1oz0 & , chklowq & , cu_act_flag , hol , th_phy & diff --git a/wrftladj/solve_em_tl.F b/wrftladj/solve_em_tl.F index e669c47a8b..06730cba0c 100644 --- a/wrftladj/solve_em_tl.F +++ b/wrftladj/solve_em_tl.F @@ -650,7 +650,7 @@ SUBROUTINE solve_em_tl ( grid , config_flags & , ph_tendf,g_ph_tendf, mu_tendf,g_mu_tendf & , tke_tend,g_tke_tend & , config_flags%use_adaptive_time_step & - , curr_secs & + , curr_secs, curr_mins2 & , psim ,psih & , gz1oz0 , chklowq & , cu_act_flag , hol , th_phy ,g_th_phy & From 0ba80b9f7d14ec78170378e769c0985bffaff0fa Mon Sep 17 00:00:00 2001 From: Tanya Spero Date: Mon, 16 Sep 2024 10:25:18 -0400 Subject: [PATCH 5/7] updated the 'solve' routines in the adjoint code...again --- wrftladj/solve_em_ad.F | 8 +++++++- wrftladj/solve_em_tl.F | 7 ++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/wrftladj/solve_em_ad.F b/wrftladj/solve_em_ad.F index 5d3cd90d20..00ef154d6c 100644 --- a/wrftladj/solve_em_ad.F +++ b/wrftladj/solve_em_ad.F @@ -178,7 +178,8 @@ SUBROUTINE solve_em_ad ( grid , config_flags & LOGICAL :: leapfrog INTEGER :: l,kte,kk LOGICAL :: f_flux ! flag for computing averaged fluxes in cu_gd - REAL :: curr_secs + REAL :: curr_secs, curr_secs2, curr_mins2 + REAL(8) :: curr_secs_r8, curr_secs2_r8 INTEGER :: num_sound_steps INTEGER :: idex, jdex REAL :: max_msft @@ -193,6 +194,7 @@ SUBROUTINE solve_em_ad ( grid , config_flags & TYPE(WRFU_TimeInterval) :: tmpTimeInterval REAL :: real_time + REAL(8) :: real_time_r8 LOGICAL :: adapt_step_flag LOGICAL :: fill_w_flag @@ -300,6 +302,10 @@ SUBROUTINE solve_em_ad ( grid , config_flags & ! tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_sim_start_time ( grid ) curr_secs = real_time(tmpTimeInterval) + curr_secs2 = real_time(tmpTimeInterval2) + curr_secs_r8 = real_time_r8(tmpTimeInterval) + curr_secs2_r8 = real_time_r8(tmpTimeInterval2) + curr_mins2 = REAL( curr_secs2_r8 / 60.0d0 ) old_dt = grid%dt ! store old time step for flux averaging code at end of RK loop !----------------------------------------------------------------------------- diff --git a/wrftladj/solve_em_tl.F b/wrftladj/solve_em_tl.F index 06730cba0c..a7cfee4bb7 100644 --- a/wrftladj/solve_em_tl.F +++ b/wrftladj/solve_em_tl.F @@ -154,7 +154,8 @@ SUBROUTINE solve_em_tl ( grid , config_flags & LOGICAL :: leapfrog INTEGER :: l,kte,kk LOGICAL :: f_flux ! flag for computing averaged fluxes in cu_gd - REAL :: curr_secs, curr_secs2 + REAL :: curr_secs, curr_secs2, curr_mins2 + REAL(8) :: curr_secs_r8, curr_secs2_r8 INTEGER :: num_sound_steps INTEGER :: idex, jdex REAL :: max_msft @@ -169,6 +170,7 @@ SUBROUTINE solve_em_tl ( grid , config_flags & TYPE(WRFU_TimeInterval) :: tmpTimeInterval, tmpTimeInterval2 REAL :: real_time + REAL(8) :: real_time_r8 LOGICAL :: adapt_step_flag LOGICAL :: fill_w_flag @@ -270,6 +272,9 @@ SUBROUTINE solve_em_tl ( grid , config_flags & tmpTimeInterval2 = domain_get_current_time ( grid ) - domain_get_start_time ( grid ) curr_secs = real_time(tmpTimeInterval) curr_secs2 = real_time(tmpTimeInterval2) + curr_secs_r8 = real_time_r8(tmpTimeInterval) + curr_secs2_r8 = real_time_r8(tmpTimeInterval2) + curr_mins2 = REAL( curr_secs2_r8 / 60.0d0 ) old_dt = grid%dt ! store old time step for flux averaging code at end of RK loop !----------------------------------------------------------------------------- From 778ae0b3c527e9ea07097624f348d69b3766d0dc Mon Sep 17 00:00:00 2001 From: Tanya Spero Date: Wed, 18 Sep 2024 09:47:56 -0400 Subject: [PATCH 6/7] updated wrftlad/solve_em_ad.F to define tmpTimeInterval2, which was missing from this routine --- wrftladj/solve_em_ad.F | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/wrftladj/solve_em_ad.F b/wrftladj/solve_em_ad.F index 00ef154d6c..8309f3dac2 100644 --- a/wrftladj/solve_em_ad.F +++ b/wrftladj/solve_em_ad.F @@ -192,7 +192,7 @@ SUBROUTINE solve_em_ad ( grid , config_flags & ! urban related variables INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS ! urban - TYPE(WRFU_TimeInterval) :: tmpTimeInterval + TYPE(WRFU_TimeInterval) :: tmpTimeInterval, tmpTimeInterval2 REAL :: real_time REAL(8) :: real_time_r8 LOGICAL :: adapt_step_flag @@ -301,6 +301,7 @@ SUBROUTINE solve_em_ad ( grid , config_flags & ! calculate it here--but, this is not clean!! ! tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_sim_start_time ( grid ) + tmpTimeInterval2 = domain_get_current_time ( grid ) - domain_get_start_time ( grid ) curr_secs = real_time(tmpTimeInterval) curr_secs2 = real_time(tmpTimeInterval2) curr_secs_r8 = real_time_r8(tmpTimeInterval) From 9cac4f1c086ed28b56c5db930b33aa6146ae9411 Mon Sep 17 00:00:00 2001 From: Wei Wang Date: Wed, 5 Feb 2025 20:01:25 -0700 Subject: [PATCH 7/7] curr_mins2 are not needed in these modules --- wrftladj/module_first_rk_step_part1_ad.F | 3 +-- wrftladj/module_first_rk_step_part1_tl.F | 3 +-- wrftladj/solve_em_tl.F | 9 ++------- 3 files changed, 4 insertions(+), 11 deletions(-) diff --git a/wrftladj/module_first_rk_step_part1_ad.F b/wrftladj/module_first_rk_step_part1_ad.F index 0c05aa6e67..a82001ef8d 100644 --- a/wrftladj/module_first_rk_step_part1_ad.F +++ b/wrftladj/module_first_rk_step_part1_ad.F @@ -19,7 +19,6 @@ SUBROUTINE a_first_rk_step_part1 ( grid , config_flags & , ph_tendf, a_ph_tendf, mu_tendf, a_mu_tendf & , tke_tend, a_tke_tend & , adapt_step_flag , curr_secs & - , curr_mins2 & , psim , psih , gz1oz0 , chklowq & , cu_act_flag , hol , th_phy , a_th_phy & , pi_phy , a_pi_phy , p_phy , a_p_phy , t_phy , a_t_phy & @@ -76,7 +75,7 @@ SUBROUTINE a_first_rk_step_part1 ( grid , config_flags & LOGICAL ,INTENT(IN) :: adapt_step_flag - REAL, INTENT(IN) :: curr_secs, curr_mins2 + REAL, INTENT(IN) :: curr_secs REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: a_moist diff --git a/wrftladj/module_first_rk_step_part1_tl.F b/wrftladj/module_first_rk_step_part1_tl.F index 5879a5ee84..65dda7278a 100644 --- a/wrftladj/module_first_rk_step_part1_tl.F +++ b/wrftladj/module_first_rk_step_part1_tl.F @@ -19,7 +19,6 @@ SUBROUTINE g_first_rk_step_part1 ( grid , config_flags & , ph_tendf, g_ph_tendf, mu_tendf, g_mu_tendf & , tke_tend, g_tke_tend & , adapt_step_flag , curr_secs & - , curr_mins2 & , psim , psih , gz1oz0 , chklowq & , cu_act_flag , hol , th_phy , g_th_phy & , pi_phy, g_pi_phy, p_phy ,g_p_phy, t_phy ,g_t_phy & @@ -77,7 +76,7 @@ SUBROUTINE g_first_rk_step_part1 ( grid , config_flags & LOGICAL ,INTENT(IN) :: adapt_step_flag - REAL, INTENT(IN) :: curr_secs, curr_mins2 + REAL, INTENT(IN) :: curr_secs REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: g_moist diff --git a/wrftladj/solve_em_tl.F b/wrftladj/solve_em_tl.F index a7cfee4bb7..e669c47a8b 100644 --- a/wrftladj/solve_em_tl.F +++ b/wrftladj/solve_em_tl.F @@ -154,8 +154,7 @@ SUBROUTINE solve_em_tl ( grid , config_flags & LOGICAL :: leapfrog INTEGER :: l,kte,kk LOGICAL :: f_flux ! flag for computing averaged fluxes in cu_gd - REAL :: curr_secs, curr_secs2, curr_mins2 - REAL(8) :: curr_secs_r8, curr_secs2_r8 + REAL :: curr_secs, curr_secs2 INTEGER :: num_sound_steps INTEGER :: idex, jdex REAL :: max_msft @@ -170,7 +169,6 @@ SUBROUTINE solve_em_tl ( grid , config_flags & TYPE(WRFU_TimeInterval) :: tmpTimeInterval, tmpTimeInterval2 REAL :: real_time - REAL(8) :: real_time_r8 LOGICAL :: adapt_step_flag LOGICAL :: fill_w_flag @@ -272,9 +270,6 @@ SUBROUTINE solve_em_tl ( grid , config_flags & tmpTimeInterval2 = domain_get_current_time ( grid ) - domain_get_start_time ( grid ) curr_secs = real_time(tmpTimeInterval) curr_secs2 = real_time(tmpTimeInterval2) - curr_secs_r8 = real_time_r8(tmpTimeInterval) - curr_secs2_r8 = real_time_r8(tmpTimeInterval2) - curr_mins2 = REAL( curr_secs2_r8 / 60.0d0 ) old_dt = grid%dt ! store old time step for flux averaging code at end of RK loop !----------------------------------------------------------------------------- @@ -655,7 +650,7 @@ SUBROUTINE solve_em_tl ( grid , config_flags & , ph_tendf,g_ph_tendf, mu_tendf,g_mu_tendf & , tke_tend,g_tke_tend & , config_flags%use_adaptive_time_step & - , curr_secs, curr_mins2 & + , curr_secs & , psim ,psih & , gz1oz0 , chklowq & , cu_act_flag , hol , th_phy ,g_th_phy &