diff --git a/physics/GWD/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 index 0bcbc4f62..fcdee3b5d 100644 --- a/physics/GWD/unified_ugwp.F90 +++ b/physics/GWD/unified_ugwp.F90 @@ -253,7 +253,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt cdmbgwd, jdat, xlat, xlat_d, sinlat, coslat, area, & ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, & del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & - tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & + tau_tofd, tau_mtb, tau_ogw, tau_ngw, & dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, & con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & @@ -309,7 +309,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt & slmsk(:) real(kind=kind_phys), intent(out), dimension(:) :: dusfcg, dvsfcg - real(kind=kind_phys), intent(out), dimension(:) :: zmtb, zlwb, zogw, rdxzb + real(kind=kind_phys), intent(out), dimension(:) :: rdxzb real(kind=kind_phys), intent(out), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(out), dimension(:,:) :: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms diff --git a/physics/GWD/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta index a08ee3960..189f7072c 100644 --- a/physics/GWD/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -900,30 +900,6 @@ type = real kind = kind_phys intent = out -[zmtb] - standard_name = height_of_mountain_blocking - long_name = height of mountain blocking drag - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[zlwb] - standard_name = height_of_low_level_wave_breaking - long_name = height of low level wave breaking - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[zogw] - standard_name = height_of_launch_level_of_orographic_gravity_wave - long_name = height of launch level of orographic gravity wave - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out [dudt_mtb] standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 index e9e477fce..53867f6cc 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 @@ -18,7 +18,7 @@ module GFS_suite_stateout_update subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs, qgrs, & dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, oz0, ntiw, nqrimef, imp_physics, & imp_physics_fer_hires, epsq, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, prsl, & - dp, ozpl, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) + dp, ozpl, qdiag3d, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) ! Inputs integer, intent(in ) :: im @@ -31,12 +31,13 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs, ozpl real(kind=kind_phys), intent(in ), dimension(:,:) :: dudt, dvdt, dtdt real(kind=kind_phys), intent(in ), dimension(:,:,:) :: dqdt + logical, intent(in) :: qdiag3d logical, intent(in) :: oz_phys_2015 logical, intent(in) :: oz_phys_2006 type(ty_ozphys), intent(in) :: ozphys ! Outputs (optional) - real(kind=kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + real(kind=kind_phys), intent(inout), dimension(:,:) :: & do3_dt_prd, & ! Physics tendency: production and loss effect do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect do3_dt_temp, & ! Physics tendency: temperature effect @@ -50,7 +51,7 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs ! Locals integer :: i, k - + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -65,12 +66,12 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs ! If using photolysis physics schemes, update (prognostic) gas concentrations using ! updated state. if (oz_phys_2015) then - call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & - do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & + do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) endif if (oz_phys_2006) then - call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & - do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & + do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) endif ! If using Ferrier-Aligo microphysics, set bounds on the mass-weighted rime factor. diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta index 9f8977482..608ee83da 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta @@ -44,6 +44,13 @@ dimensions = () type = ty_ozphys intent = in +[qdiag3d] + standard_name = flag_for_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in [oz_phys_2015] standard_name = flag_for_nrl_2015_ozone_scheme long_name = flag for new (2015) ozone physics diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 index fd16dea59..d36a86721 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 @@ -42,9 +42,9 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice real(kind=kind_phys), dimension(:), intent( out) :: frland - real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss + real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss, tisfc - real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl, tisfc + real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl real(kind=kind_phys), dimension(:), intent(inout) :: snowd_lnd, snowd_ice, tprcp_wat, & tprcp_lnd, tprcp_ice, tsfc_wat, tsurf_wat,tsurf_lnd, tsurf_ice, & uustar_wat, uustar_lnd, uustar_ice, weasd_lnd, weasd_ice, & @@ -86,7 +86,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. - tisfc(i) = max(timin, min(tisfc(i), tgice)) if (cplflx) then islmsk_cice(i) = 4 flag_cice(i) = .true. @@ -111,7 +110,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (cice(i) >= min_lakeice) then icy(i) = .true. islmsk(i) = 2 - tisfc(i) = max(timin, min(tisfc(i), tgice)) else cice(i) = zero hice(i) = zero @@ -151,7 +149,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. - tisfc(i) = max(timin, min(tisfc(i), tgice)) ! This cplice namelist option was added to deal with the ! situation of the FV3ATM-HYCOM coupling without an active sea ! ice (e.g., CICE6) component. By default, the cplice is true @@ -187,9 +184,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0 if (cice(i) >= min_lakeice) then icy(i) = .true. - if(.not.is_clm) then - tisfc(i) = max(timin, min(tisfc(i), tgice)) - endif islmsk(i) = 2 else cice(i) = zero diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta index 33e2f0523..4d1021118 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta @@ -358,7 +358,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = in [tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_water long_name = surface skin temperature after iteration over water diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 index 5d321814c..b85168a2d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 @@ -61,8 +61,7 @@ end subroutine GFS_surface_generic_pre_init !! subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, ivegsrc, stype, scolor,vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, sigmaf, work3, zlvl, & - drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & - lndp_var_list, lndp_prt_list, & + lndp_type, n_var_lndp, sfc_wts, lndp_var_list, lndp_prt_list, & z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, & cplflx, flag_cice, islmsk_cice, slimskin_cpl, & wind, u1, v1, cnvwind, smcwlt2, smcref2, vtype_save, stype_save,scolor_save, slope_save, & @@ -87,10 +86,6 @@ subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, real(kind=kind_phys), dimension(:), intent(inout) :: sigmaf, work3, zlvl ! Stochastic physics / surface perturbations - real(kind=kind_phys), dimension(:), intent(out) :: drain_cpl - real(kind=kind_phys), dimension(:), intent(out) :: dsnow_cpl - real(kind=kind_phys), dimension(:), intent(in) :: rain_cpl - real(kind=kind_phys), dimension(:), intent(in) :: snow_cpl integer, intent(in) :: lndp_type, n_var_lndp character(len=3), dimension(:), intent(in) :: lndp_var_list real(kind=kind_phys), dimension(:), intent(in) :: lndp_prt_list diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta index bbf7dd5c3..2b21c606d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta @@ -290,38 +290,6 @@ type = real kind = kind_phys intent = inout -[drain_cpl] - standard_name = tendency_of_lwe_thickness_of_rain_amount_on_dynamics_timestep_for_coupling - long_name = change in rain_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dsnow_cpl] - standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling - long_name = change in show_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[rain_cpl] - standard_name = cumulative_lwe_thickness_of_precipitation_amount_for_coupling - long_name = total rain precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[snow_cpl] - standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling - long_name = total snow precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [lndp_type] standard_name = control_for_stochastic_land_surface_perturbation long_name = index for stochastic land surface perturbations type diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f index 36299651d..1e373ae12 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f @@ -44,7 +44,7 @@ module dcyc2t3 ! input/output: ! ! dtdt,dtdtnp, ! ! outputs: ! -! adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, ! +! adjsfcdsw,adjsfcnsw,adjsfcdlw, ! ! adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, ! ! adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, ! ! adjdnnbmd,adjdnndfd,adjdnvbmd,adjdnvdfd) ! @@ -181,7 +181,7 @@ subroutine dcyc2t3_run & ! --- input/output: & dtdt,dtdtnp,htrlw, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -242,7 +242,7 @@ subroutine dcyc2t3_run & ! --- outputs: real(kind=kind_phys), dimension(:), intent(out) :: & - & adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, & + & adjsfcdsw, adjsfcnsw, adjsfcdlw, xmu, xcosz, & & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd @@ -352,7 +352,7 @@ subroutine dcyc2t3_run & ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) -! &,' sfcemis=',sfcemis(i,:),' adjsfculw=',adjsfculw(i,:) +! &,' sfcemis=',sfcemis(i,:) ! !> - normalize by average value over radiation period for daytime. diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta index 95b3f341b..6f8a0eda0 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta @@ -524,14 +524,6 @@ type = real kind = kind_phys intent = out -[adjsfculw] - standard_name = surface_upwelling_longwave_flux - long_name = surface upwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land long_name = surface upwelling longwave flux at current time over land diff --git a/physics/photochem/module_ozphys.F90 b/physics/photochem/module_ozphys.F90 index f824736b1..b66eb0a74 100644 --- a/physics/photochem/module_ozphys.F90 +++ b/physics/photochem/module_ozphys.F90 @@ -95,13 +95,18 @@ function load_o3prog(this, file, fileID) result (err_message) integer, intent(in) :: fileID character(len=*), intent(in) :: file character(len=128) :: err_message - integer :: i1, i2, i3 + integer :: i1, i2, i3, ierr real(kind=4), dimension(:), allocatable :: lat4, pres4, time4, tempin real(kind=4) :: blatc4 + ! initialize error message + err_message = "" + ! Get dimensions from data file - open(unit=fileID,file=trim(file), form='unformatted', convert='big_endian') - read (fileID) this%ncf, this%nlat, this%nlev, this%ntime + open(unit=fileID,file=trim(file), form='unformatted', convert='big_endian', iostat=ierr, iomsg=err_message) + if (ierr /= 0 ) return + read (fileID, iostat=ierr, iomsg=err_message) this%ncf, this%nlat, this%nlev, this%ntime + if (ierr /= 0 ) return rewind(fileID) allocate (this%lat(this%nlat)) @@ -111,7 +116,8 @@ function load_o3prog(this, file, fileID) result (err_message) allocate (this%data(this%nlat,this%nlev,this%ncf,this%ntime)) allocate(lat4(this%nlat), pres4(this%nlev), time4(this%ntime+1)) - read (fileID) this%ncf, this%nlat, this%nlev, this%ntime, lat4, pres4, time4 + read (fileID, iostat=ierr, iomsg=err_message) this%ncf, this%nlat, this%nlev, this%ntime, lat4, pres4, time4 + if (ierr /= 0 ) return ! Store this%pres(:) = pres4(:) @@ -124,7 +130,8 @@ function load_o3prog(this, file, fileID) result (err_message) do i1=1,this%ntime do i2=1,this%ncf do i3=1,this%nlev - read(fileID) tempin + read(fileID, iostat=ierr, iomsg=err_message) tempin + if (ierr /= 0 ) return this%data(:,i3,i2,i1) = tempin(:) enddo enddo @@ -198,7 +205,7 @@ end subroutine update_o3prog ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2015). ! ######################################################################################### - subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, & + subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_dt_prd, & do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: & @@ -213,7 +220,8 @@ subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, ozpl ! Ozone forcing data real(kind_phys), intent(inout), dimension(:,:) :: & oz ! Ozone concentration updated by physics - real(kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + logical, intent(in) :: do_diag + real(kind_phys), intent(inout), dimension(:,:) :: & do3_dt_prd, & ! Physics tendency: production and loss effect do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect do3_dt_temp, & ! Physics tendency: temperature effect @@ -297,10 +305,12 @@ subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, enddo ! Diagnostics (optional) - if (associated(do3_dt_prd)) do3_dt_prd(:,iLev) = (prod(:,1)-prod(:,2)*prod(:,6))*dt - if (associated(do3_dt_ozmx)) do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) - if (associated(do3_dt_temp)) do3_dt_temp(:,iLev) = prod(:,3)*(t(:,iLev)-prod(:,5))*dt - if (associated(do3_dt_ohoz)) do3_dt_ohoz(:,iLev) = prod(:,4) * (colo3(:,iLev)-coloz(:,iLev))*dt + if (do_diag) then + do3_dt_prd(:,iLev) = (prod(:,1)-prod(:,2)*prod(:,6))*dt + do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) + do3_dt_temp(:,iLev) = prod(:,3)*(t(:,iLev)-prod(:,5))*dt + do3_dt_ohoz(:,iLev) = prod(:,4) * (colo3(:,iLev)-coloz(:,iLev))*dt + endif enddo return @@ -309,7 +319,7 @@ end subroutine run_o3prog_2015 ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2006). ! ######################################################################################### - subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, & + subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_dt_prd, & do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: & @@ -324,7 +334,8 @@ subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, ozpl ! Ozone forcing data real(kind_phys), intent(inout), dimension(:,:) :: & oz ! Ozone concentration updated by physics - real(kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + logical, intent(in) :: do_diag + real(kind_phys), intent(inout), dimension(:,:) :: & do3_dt_prd, & ! Physics tendency: production and loss effect do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect do3_dt_temp, & ! Physics tendency: temperature effect @@ -418,12 +429,14 @@ subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, oz(iCol,iLev) = (ozib(iCol) + tem*dt) / (1.0 + prod(iCol,2)*dt) enddo endif - ! Diagnostics (optional) - if (associated(do3_dt_prd)) do3_dt_prd(:,iLev) = prod(:,1)*dt - if (associated(do3_dt_ozmx)) do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) - if (associated(do3_dt_temp)) do3_dt_temp(:,iLev) = prod(:,3) * t(:,iLev) * dt - if (associated(do3_dt_ohoz)) do3_dt_ohoz(:,iLev) = prod(:,4) * colo3(:,iLev) * dt + ! Diagnostics (optional) + if (do_diag) then + do3_dt_prd(:,iLev) = prod(:,1)*dt + do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) + do3_dt_temp(:,iLev) = prod(:,3) * t(:,iLev) * dt + do3_dt_ohoz(:,iLev) = prod(:,4) * colo3(:,iLev) * dt + endif enddo return @@ -520,12 +533,18 @@ function load_o3clim(this, file, fileID) result (err_message) ! Locals real(kind=4) :: blatc4 - integer :: iLev, iLat, imo + integer :: iLev, iLat, imo, ierr real(kind=4), allocatable :: o3clim4(:,:,:), pstr4(:) integer, allocatable :: imond(:), ilatt(:,:) - open(unit=fileID,file=trim(file), form='unformatted', convert='big_endian') - read (fileID,end=101) this%nlatc, this%nlevc, this%ntimec, blatc4 + ! initialize error message + err_message = "" + + open(unit=fileID,file=trim(file),form='unformatted',convert='big_endian', iostat=ierr, iomsg=err_message) + if (ierr /= 0 ) return + read (fileID,end=101,iostat=ierr,iomsg=err_message) this%nlatc, this%nlevc, this%ntimec, blatc4 + if (ierr /= 0 ) return + 101 if (this%nlevc < 10 .or. this%nlevc > 100) then rewind (fileID) this%nlevc = 17 @@ -545,15 +564,18 @@ function load_o3clim(this, file, fileID) result (err_message) allocate (this%pkstr(this%nlevc), this%pstr(this%nlevc), this%datac(this%nlatc,this%nlevc,12)) if ( this%nlevc == 17 ) then ! For the operational ozone climatology do iLev = 1, this%nlevc - read (fileID,15) pstr4(iLev) + read (fileID,15,iostat=ierr,iomsg=err_message) pstr4(iLev) + if (ierr /= 0 ) return 15 format(f10.3) enddo do imo = 1, 12 do iLat = 1, this%nlatc - read (fileID,16) imond(imo), ilatt(iLat,imo), (o3clim4(iLat,iLev,imo),iLev=1,10) + read (fileID,16,iostat=ierr,iomsg=err_message) imond(imo), ilatt(iLat,imo), (o3clim4(iLat,iLev,imo),iLev=1,10) + if (ierr /= 0 ) return 16 format(i2,i4,10f6.2) - read (fileID,20) (o3clim4(iLat,iLev,imo),iLev=11,this%nlevc) + read (fileID,20,iostat=ierr,iomsg=err_message) (o3clim4(iLat,iLev,imo),iLev=11,this%nlevc) + if (ierr /= 0 ) return 20 format(6x,10f6.2) enddo enddo @@ -565,7 +587,8 @@ function load_o3clim(this, file, fileID) result (err_message) do imo = 1, 12 do iLev = 1, this%nlevc - read (fileID) (o3clim4(iLat,iLev,imo),iLat=1,this%nlatc) + read (fileID,iostat=ierr,iomsg=err_message) (o3clim4(iLat,iLev,imo),iLat=1,this%nlatc) + if (ierr /= 0 ) return enddo enddo endif ! end if_this%nlevc_block