From 140df2460b6f350b48a68322147f16bb7570050c Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Wed, 20 Nov 2019 02:52:38 +0000 Subject: [PATCH 01/11] Reset to zero coupling arrays for accumulated snow, large scale rain, and convective rain at the end of each coupling step if coupling with chemistry model. --- atmos_model.F90 | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/atmos_model.F90 b/atmos_model.F90 index 5d99b5c1b..45327aaeb 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1395,6 +1395,24 @@ subroutine update_atmos_chemistry(state, rc) enddo enddo + ! -- zero out accumulated fields +!$OMP parallel do default (none) & +!$OMP shared (nj, ni, Atm_block, IPD_Control, IPD_Data) & +!$OMP private (j, jb, i, ib, nb, ix) + do j = 1, nj + jb = j + Atm_block%jsc - 1 + do i = 1, ni + ib = i + Atm_block%isc - 1 + nb = Atm_block%blkno(ib,jb) + ix = Atm_block%ixp(ib,jb) + IPD_Data(nb)%coupling%rainc_cpl(ix) = 0._IPD_kind_phys + if (.not.IPD_Control%cplflx) then + IPD_Data(nb)%coupling%rain_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%snow_cpl(ix) = 0._IPD_kind_phys + end if + enddo + enddo + if (IPD_Control%debug) then ! -- diagnostics write(6,'("update_atmos: prsi - min/max/avg",3g16.6)') minval(prsi), maxval(prsi), sum(prsi)/size(prsi) From bafa4592b98472d87cc5fca6a5e6d4114343a5bd Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Wed, 20 Nov 2019 03:21:05 +0000 Subject: [PATCH 02/11] Properly set kind type of literal constants. --- atmos_model.F90 | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 45327aaeb..f4f7e67ab 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -2554,24 +2554,24 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - IPD_Data(nb)%coupling%dusfc_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%dvsfc_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%dtsfc_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%dqsfc_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%dlwsfc_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%dswsfc_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%rain_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%nlwsfc_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%nswsfc_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%dnirbm_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%dnirdf_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%dvisbm_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%dvisdf_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%nnirbm_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%nnirdf_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%nvisbm_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%nvisdf_cpl(ix) = 0.0 - IPD_Data(nb)%coupling%snow_cpl(ix) = 0.0 + IPD_Data(nb)%coupling%dusfc_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%dvsfc_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%dtsfc_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%dqsfc_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%dlwsfc_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%dswsfc_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%rain_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%nlwsfc_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%nswsfc_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%dnirbm_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%dnirdf_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%dvisbm_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%dvisdf_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%nnirbm_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%nnirdf_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%nvisbm_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%nvisdf_cpl(ix) = 0._IPD_kind_phys + IPD_Data(nb)%coupling%snow_cpl(ix) = 0._IPD_kind_phys enddo enddo endif !cplflx From 5a9cbd782917c18c27f28150a2e060c78bb1dc66 Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Wed, 23 Oct 2019 23:23:53 +0000 Subject: [PATCH 03/11] Initialize to zero canopy resistance output variable in noah/osu land-surface model subdriver. --- gfsphysics/physics/sflx.f | 1 + 1 file changed, 1 insertion(+) diff --git a/gfsphysics/physics/sflx.f b/gfsphysics/physics/sflx.f index dc821576f..e86630ed7 100644 --- a/gfsphysics/physics/sflx.f +++ b/gfsphysics/physics/sflx.f @@ -250,6 +250,7 @@ subroutine sflx & runoff2 = 0.0 runoff3 = 0.0 snomlt = 0.0 + rc = 0.0 ! --- ... define local variable ice to achieve: ! sea-ice case, ice = 1 From e75f23b7b8f8b68760a7fff8a98d6bbb2dd9f7e3 Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Wed, 23 Oct 2019 23:47:07 +0000 Subject: [PATCH 04/11] Re-implement radiation diagnostic output involving spectral band layer cloud optical depths (0.55 and 10 mu channels) to prevent floating invalid errors due to uninitialized optical depth arrays. --- gfsphysics/GFS_layer/GFS_radiation_driver.F90 | 39 +++++++++++++++---- 1 file changed, 31 insertions(+), 8 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 index 9db2f3312..b530c61b2 100644 --- a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 @@ -2116,18 +2116,41 @@ subroutine GFS_radiation_driver & Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt) Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb) Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + end do + end do ! Anning adds optical depth and emissivity output - tem1 = 0. - tem2 = 0. - do k=ibtc,itop - tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel - tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel + + if (Model%lsswr .and. (nday > 0)) then + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem1 = 0. + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) ! approx .55 um channel + enddo + Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 enddo - Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 - Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) enddo - enddo + end if + + if (Model%lslwr) then + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem2 = 0. + do k=ibtc,itop + tem2 = tem2 + cldtaulw(i,k) ! approx 10. um channel + enddo + Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + enddo + enddo + endif + endif ! if (.not. Model%uni_cld) then From c1d99db5733975fa20bb87f1a4a56941cc4295dd Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Wed, 20 Nov 2019 03:58:52 +0000 Subject: [PATCH 05/11] Reset to zero instantaneous total moisture tendency coupling array at the beginning of each coupling step if coupled with chemistry model or legacy gocart. --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 7088eba12..2d0fb1b8a 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -3206,6 +3206,10 @@ subroutine GFS_physics_driver & dqdt(1:im,:,1) = Stateout%gq0(1:im,:,1) endif ! end if_ldiag3d/lgocart + if (Model%lgocart .or. Model%cplchm) then + Coupling%dqdti(1:im,:) = 0._kind_phys + endif ! end if_lgocart/cplchm + #ifdef GFS_HYDRO call get_phi(im, ix, levs, ntrac, Stateout%gt0, Stateout%gq0, & Model%thermodyn_id, Model%sfcpress_id, & From b21d1e2ee229a95a162e5ebf1ddc1a9092928301 Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Fri, 22 Nov 2019 01:06:01 +0000 Subject: [PATCH 06/11] Correctly reset dqdt array when coupled with chemistry model. --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 2d0fb1b8a..72073fae7 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -3202,9 +3202,9 @@ subroutine GFS_physics_driver & dtdt(1:im,:) = Stateout%gt0(1:im,:) endif ! end if_ldiag3d/cnvgwd - if (Model%ldiag3d .or. Model%lgocart) then + if (Model%ldiag3d .or. Model%lgocart .or. Model%cplchm) then dqdt(1:im,:,1) = Stateout%gq0(1:im,:,1) - endif ! end if_ldiag3d/lgocart + endif ! end if_ldiag3d/lgocart/cplchm if (Model%lgocart .or. Model%cplchm) then Coupling%dqdti(1:im,:) = 0._kind_phys From 45a3448ed9e6c9a34fa55e7dd63bea88477a9b1c Mon Sep 17 00:00:00 2001 From: Bing Fu Date: Wed, 4 Dec 2019 04:10:39 +0000 Subject: [PATCH 07/11] add capability to output restart files at specified time only Change-Id: I14d98941ac0e7362d5aacfb73bd644554ef29fab --- fv3_cap.F90 | 5 +++++ module_fcst_grid_comp.F90 | 21 +++++++++++++++++---- module_fv3_config.F90 | 2 +- 3 files changed, 23 insertions(+), 5 deletions(-) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 05dd67e2e..d75cc6c6c 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -23,6 +23,7 @@ module fv3gfs_cap_mod NUOPC_ModelGet ! use module_fv3_config, only: quilting, restart_interval, & + other_restart_time, & nfhout, nfhout_hf, nsout, dt_atmos, & nfhmax, nfhmax_hf,output_hfmax, & output_interval,output_interval_hf, & @@ -283,6 +284,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) CALL ESMF_ConfigGetAttribute(config=CF,value=restart_interval, & label ='restart_interval:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! + CALL ESMF_ConfigGetAttribute(config=CF,value=other_restart_time, & + label ='other_restart_time:',rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! CALL ESMF_ConfigGetAttribute(config=CF,value=calendar, & label ='calendar:',rc=rc) diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 6ff1f39c7..4889e8f66 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -68,7 +68,8 @@ module module_fcst_grid_comp ! use module_fv3_io_def, only: num_pes_fcst, num_files, filename_base, nbdlphys, & iau_offset - use module_fv3_config, only: dt_atmos, calendar, restart_interval, & + use module_fv3_config, only: dt_atmos, calendar, restart_interval, & + other_restart_time, & quilting, calendar_type, cpl, & cplprint_flag, force_date_from_configure ! @@ -88,7 +89,8 @@ module module_fcst_grid_comp type(atmos_data_type) :: Atm type(time_type) :: Time_atmos, Time_init, Time_end, & Time_step_atmos, Time_step_ocean, & - Time_restart, Time_step_restart + Time_restart, Time_step_restart, & + Time_restart1, Time_other_restart integer :: num_atmos_calls, ret, intrm_rst end type @@ -179,7 +181,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) integer :: Run_length integer,dimension(6) :: date, date_end - integer :: res_intvl + integer :: res_intvl, res_time integer :: mpi_comm_comp ! logical,save :: first=.true. @@ -321,10 +323,13 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) date_init,'time_atmos=',date,'time_end=',date_end,'dt_atmos=',dt_atmos, & 'Run_length=',Run_length res_intvl = restart_interval*3600 + res_time = other_restart_time*3600 atm_int_state%Time_step_restart = set_time (res_intvl, 0) + atm_int_state%Time_other_restart = set_time (res_time, 0) atm_int_state%Time_restart = atm_int_state%Time_atmos + atm_int_state%Time_step_restart + atm_int_state%Time_restart1 = atm_int_state%Time_atmos + atm_int_state%Time_other_restart atm_int_state%intrm_rst = 0 - if (res_intvl>0) atm_int_state%intrm_rst = 1 + if (res_intvl>0 .or. res_time>0) atm_int_state%intrm_rst = 1 atm_int_state%Atm%iau_offset = iau_offset ! ! @@ -784,6 +789,14 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) call wrt_atmres_timestamp(atm_int_state,timestamp) atm_int_state%Time_restart = atm_int_state%Time_restart + atm_int_state%Time_step_restart endif + + if ((na /= atm_int_state%num_atmos_calls) .and. & + (atm_int_state%Time_atmos == atm_int_state%Time_restart1)) then + timestamp = date_to_string (atm_int_state%Time_restart1) + call atmos_model_restart(atm_int_state%Atm, timestamp) + call wrt_atmres_timestamp(atm_int_state,timestamp) + endif + endif ! call print_memuse_stats('after full step') diff --git a/module_fv3_config.F90 b/module_fv3_config.F90 index eb1bb2036..5c1d9e485 100644 --- a/module_fv3_config.F90 +++ b/module_fv3_config.F90 @@ -14,7 +14,7 @@ module module_fv3_config implicit none ! - integer :: restart_interval + integer :: restart_interval, other_restart_time ! integer :: nfhout, nfhout_hf, nsout, dt_atmos integer :: nfhmax, nfhmax_hf, first_kdt From 3364556a882119535d2a30706c73cde3e70ea0c9 Mon Sep 17 00:00:00 2001 From: Bing Fu Date: Wed, 4 Dec 2019 21:23:40 +0000 Subject: [PATCH 08/11] Outout random patterns for each restart time, by setting fhstoch=restart_interval Change-Id: Icee8f7b9cd6c32bf4d225c6f90712aee1a021668 --- stochastic_physics/stochastic_physics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stochastic_physics/stochastic_physics.F90 b/stochastic_physics/stochastic_physics.F90 index 80831ba77..679e7bfa0 100644 --- a/stochastic_physics/stochastic_physics.F90 +++ b/stochastic_physics/stochastic_physics.F90 @@ -190,7 +190,7 @@ subroutine run_stochastic_physics(nblks,Model,Grid,Coupling) maxlen = max(maxlen,size(Grid(blk)%xlat,1)) ENDDO ! check to see if it is time to write out random patterns -if (Model%phour .EQ. fhstoch) then +if (MOD(Model%phour,fhstoch) .EQ. 0) then write(STRFH,FMT='(I6.6)') nint(Model%phour) sfile='stoch_out.F'//trim(STRFH) call dump_patterns(sfile) From 5596154a190ffc06c29ec7308080f54debb899d0 Mon Sep 17 00:00:00 2001 From: Bing Fu Date: Mon, 9 Dec 2019 16:42:24 +0000 Subject: [PATCH 09/11] Add condition fhstoch >=0 for writing out random patterns Change-Id: I61f70d94fd170d7f42a13369198eefcea7602309 --- stochastic_physics/stochastic_physics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stochastic_physics/stochastic_physics.F90 b/stochastic_physics/stochastic_physics.F90 index 679e7bfa0..dd8d90339 100644 --- a/stochastic_physics/stochastic_physics.F90 +++ b/stochastic_physics/stochastic_physics.F90 @@ -190,7 +190,7 @@ subroutine run_stochastic_physics(nblks,Model,Grid,Coupling) maxlen = max(maxlen,size(Grid(blk)%xlat,1)) ENDDO ! check to see if it is time to write out random patterns -if (MOD(Model%phour,fhstoch) .EQ. 0) then +if (fhstoch.GE. 0 .AND. MOD(Model%phour,fhstoch) .EQ. 0) then write(STRFH,FMT='(I6.6)') nint(Model%phour) sfile='stoch_out.F'//trim(STRFH) call dump_patterns(sfile) From 9ff95567b1325e31ceb05fa829fcc92fd58e9d1a Mon Sep 17 00:00:00 2001 From: Bing Fu Date: Mon, 9 Dec 2019 16:57:34 +0000 Subject: [PATCH 10/11] change other_restart_time to be only relative to intial time Change-Id: I9eda1f1cb323b913e282f0530d24fc7112beff68 --- module_fcst_grid_comp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 4889e8f66..413564a29 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -327,7 +327,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) atm_int_state%Time_step_restart = set_time (res_intvl, 0) atm_int_state%Time_other_restart = set_time (res_time, 0) atm_int_state%Time_restart = atm_int_state%Time_atmos + atm_int_state%Time_step_restart - atm_int_state%Time_restart1 = atm_int_state%Time_atmos + atm_int_state%Time_other_restart + atm_int_state%Time_restart1 = atm_int_state%Time_init + atm_int_state%Time_other_restart atm_int_state%intrm_rst = 0 if (res_intvl>0 .or. res_time>0) atm_int_state%intrm_rst = 1 atm_int_state%Atm%iau_offset = iau_offset From a396bf7ed79ae8fb32128aad529c16b71e22a0d2 Mon Sep 17 00:00:00 2001 From: Bing Date: Thu, 26 Mar 2020 13:33:27 +0000 Subject: [PATCH 11/11] change output directory of stochastic physics random pattern files Change-Id: I8dde464c3f8ef0c853cdc25c602173f661f766e4 --- stochastic_physics/stochastic_physics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stochastic_physics/stochastic_physics.F90 b/stochastic_physics/stochastic_physics.F90 index dd8d90339..cf1951254 100644 --- a/stochastic_physics/stochastic_physics.F90 +++ b/stochastic_physics/stochastic_physics.F90 @@ -192,7 +192,7 @@ subroutine run_stochastic_physics(nblks,Model,Grid,Coupling) ! check to see if it is time to write out random patterns if (fhstoch.GE. 0 .AND. MOD(Model%phour,fhstoch) .EQ. 0) then write(STRFH,FMT='(I6.6)') nint(Model%phour) - sfile='stoch_out.F'//trim(STRFH) + sfile='RESTART/stoch_out.F'//trim(STRFH) call dump_patterns(sfile) endif allocate(tmp_wts(nblks,maxlen))