SUBROUTINE update_period_update_vars() USE pd_dates_vars USE pd_update_vars USE pd_report_vars USE pd_var_tables IMPLICIT NONE include "p1werm.inc" ! needed by other include files include "s1sgeo.inc" ! aslrr(sbr) Allmaras RR values ! aszrgh(sbr) Ridge height ! asxrgs(sbr) Ridge spacing ! asargo(sbr) Ridge dir include "c1glob.inc" ! acftcv(sbr) crop canopy cover ! acrlai(sbr) & acrsai(sbr) crop silhouette ! acmst(sbr) crop standing mass include "d1glob.inc" ! adftcv(idx,sbr) total dead flat cover ! adrsai(idx,sbr) total dead silhouette area ! admf(idx,sbr) total dead flat mass ! admst(idx,sbr) total dead standing mass include "b1glob.inc" ! abftcv(sbr) all flat cover ! abrlai(sbr) & abrsai(sbr) all silhouette area ! abmf(idx,sbr) all flat mass ! abmst(idx,sbr) all standing mass include "erosion/m2geo.inc" ! imax, jmax, ix, iy of simulation grid include "erosion/e2erod.inc"! egt, egtcs, egtss, egt10 include "inc/s1agg.inc" ! aslagm, as0ags, aslagn, aslagx (ASD parms) ! aseags (agg stability) include "inc/s1surf.inc" ! asfcr (crust fraction) REAL :: biodrag ! biodrag() function in util/misc/biodrag.for REAL :: tmp REAL :: ef84 ! erodible agg. size fraction below 0.84mm INTEGER :: sbr = 1 ! current subregion - set to 1 for now INTEGER :: i,j,idx ! local loop variables INTEGER :: y ! local loop variables INTEGER :: ngdpt ! number of simulation grid datapoints INTEGER :: cnt ! number of simulation grid datapoints REAL :: sum_salt ! Threshold value for determining erosive wind energy (m/s) REAL, PARAMETER :: wind_energy_thresh = 8.0 ! Threshold value for determining protective snow depth (mm) REAL, PARAMETER :: snow_depth_thresh = 20.0 ! Threshold value for determining erosion loss and deposition regions REAL, PARAMETER :: eros_thresh = 0.025 ! Flag to specify whether we have experienced an erosion event or not. ! It is set in the "Salt_Loss2" section and used in the "Trans_Cap" ! and "Sheltered" code sections. LOGICAL :: Have_Erosion Have_Erosion = .FALSE. ! Initialize for each invocation of routine !End of period (eop) variables ! Roughness vars period_update(Random_rough)%val = aslrr(sbr) period_update(Random_rough)%cnt = period_update(Random_rough)%cnt + 1 period_update(Ridge_ht)%val = aszrgh(sbr) period_update(Ridge_ht)%cnt = period_update(Ridge_ht)%cnt + 1 period_update(Ridge_sp)%val = asxrgs(sbr) period_update(Ridge_sp)%cnt = period_update(Ridge_sp)%cnt + 1 period_update(Ridge_dir)%val = asargo(sbr) period_update(Ridge_dir)%cnt = period_update(Ridge_dir)%cnt + 1 call sbsfdi(aslagm(1,sbr), as0ags(1,sbr), aslagn(1,sbr), & aslagx(1,sbr),0.84,ef84) period_update(Surface_84)%val = ef84 period_update(Surface_84)%cnt = period_update(Surface_84)%cnt + 1 period_update(Surface_AS)%val = aseags(1,sbr) !Ag Stability (J/m^2) period_update(Surface_AS)%cnt = period_update(Surface_AS)%cnt + 1 period_update(Surface_Crust)%val = asfcr(sbr) !Surface Crust fraction period_update(Surface_Crust)%cnt = period_update(Surface_Crust)%cnt + 1 ! Crop vars period_update(Crop_canopy_cov)%val = acftcv(sbr) period_update(Crop_canopy_cov)%cnt = period_update(Crop_canopy_cov)%cnt + 1 period_update(Crop_stand_sil)%val = biodrag(acrlai(sbr), acrsai(sbr)) period_update(Crop_stand_sil)%cnt = period_update(Crop_stand_sil)%cnt + 1 period_update(Crop_stand_mass)%val = acmst(sbr) period_update(Crop_stand_mass)%cnt = period_update(Crop_stand_mass)%cnt + 1 ! Residue vars tmp = 0.0 DO idx = 1, mnbpls tmp = tmp + adftcv(idx,sbr) * (1.0-tmp) END DO period_update(Res_flat_cov)%val = tmp period_update(Res_flat_cov)%cnt = period_update(Res_flat_cov)%cnt + 1 period_update(Res_stand_sil)%val = 0.0 period_update(Res_flat_mass)%val = 0.0 period_update(Res_stand_mass)%val = 0.0 DO idx=1,mnbpls period_update(Res_stand_sil)%val = period_update(Res_stand_sil)%val + & adrsai(idx,sbr) period_update(Res_flat_mass)%val = period_update(Res_flat_mass)%val + & admf(idx,sbr) period_update(Res_stand_mass)%val = period_update(Res_stand_mass)%val + & admst(idx,sbr) END DO period_update(Res_stand_sil)%cnt = period_update(Res_stand_sil)%cnt + 1 period_update(Res_flat_mass)%cnt = period_update(Res_flat_mass)%cnt + 1 period_update(Res_stand_mass)%cnt = period_update(Res_stand_mass)%cnt + 1 ! Biomass vars period_update(All_flat_cov)%val = abftcv(sbr) period_update(All_flat_cov)%cnt = period_update(All_flat_cov)%cnt + 1 period_update(All_stand_sil)%val = biodrag(abrlai(sbr),abrsai(sbr)) period_update(All_stand_sil)%cnt = period_update(All_stand_sil)%cnt + 1 period_update(All_flat_mass)%val = abmf(sbr) period_update(All_flat_mass)%cnt = period_update(All_flat_mass)%cnt + 1 period_update(All_stand_mass)%val = abmst(sbr) period_update(All_stand_mass)%cnt = period_update(All_stand_mass)%cnt + 1 !variables summed for period ngdpt = (imax-1) * (jmax-1) DO i = 1, imax-1 DO j = 1, jmax-1 period_update(Eros_loss)%val = period_update(Eros_loss)%val + & egt(i,j)/ngdpt period_update(Salt_loss)%val = period_update(Salt_loss)%val + & (egt(i,j) - egtss(i,j))/ngdpt period_update(Susp_loss)%val = period_update(Susp_loss)%val + & egtss(i,j)/ngdpt period_update(PM10_loss)%val = period_update(PM10_loss)%val + & egt10(i,j)/ngdpt END DO END DO period_update(Eros_loss)%cnt = period_update(Eros_loss)%cnt + 1 period_update(Salt_loss)%cnt = period_update(Salt_loss)%cnt + 1 period_update(Susp_loss)%cnt = period_update(Susp_loss)%cnt + 1 period_update(PM10_loss)%cnt = period_update(PM10_loss)%cnt + 1 ! Determine the saltation loss and area from region that generated it sum_salt = 0.0; cnt = 0 DO i = 1, imax-1 DO j = 1, jmax-1 IF ((egt(i,j) - egtss(i,j)) < -eros_thresh) THEN sum_salt = sum_salt + egt(i,j) - egtss(i,j) cnt = cnt + 1 END IF END DO END DO IF (cnt /= 0) THEN Have_Erosion = .TRUE. !We have erosion occuring, set flag for use later period_update(Salt_loss2)%val = & period_update(Salt_loss2)%val + sum_salt/cnt period_update(Salt_loss2)%cnt = & period_update(Salt_loss2)%cnt + 1 CALL run_ave (period_update(Salt_loss2_area), (ix*jy)*cnt/10000.0, 1) CALL run_ave (period_update(Salt_loss2_frac), REAL(cnt)/ngdpt, 1) END IF ! Determine the saltation deposition and area from region that generated it sum_salt = 0.0; cnt = 0 DO i = 1, imax-1 DO j = 1, jmax-1 IF ((egt(i,j) - egtss(i,j)) > eros_thresh) THEN sum_salt = sum_salt + egt(i,j) - egtss(i,j) cnt = cnt + 1 END IF END DO END DO IF (cnt /= 0) THEN period_update(Salt_dep2)%val = & period_update(Salt_dep2)%val + sum_salt/cnt period_update(Salt_dep2)%cnt = period_update(Salt_dep2)%cnt + 1 CALL run_ave (period_update(Salt_dep2_area), (ix*jy)*cnt/10000.0, 1) CALL run_ave (period_update(Salt_dep2_frac), REAL(cnt)/ngdpt, 1) END IF IF (Have_Erosion == .TRUE.) THEN !We have erosion so compute TC, etc. ! Determine the region under saltation transport capacity ! (heavy erosion flux rates but zero net erosion and deposition) ! Note: Currently this assumes no barrier protection - LEW ! Also, the "sheltered area" is set equal to the "transport capacity area" cnt = 0 DO i = 1, imax-1 DO j = 1, jmax-1 IF ( ABS((egt(i,j) - egtss(i,j))) <= eros_thresh) THEN cnt = cnt + 1 END IF END DO END DO ! IF (cnt /= 0) THEN ! Note: We currently don't have a way of computing the Flux Rate over a grid area CALL run_ave (period_update(Trans_Cap_area), (ix*jy)*cnt/10000.0, 1) CALL run_ave (period_update(Trans_Cap_frac), REAL(cnt)/ngdpt, 1) !Assume Sheltered region is same as Transport Region for now as mentioned in Note above. CALL run_ave (period_update(Sheltered_area), (ix*jy)*cnt/10000.0, 1) CALL run_ave (period_update(Sheltered_frac), REAL(cnt)/ngdpt, 1) ! END IF END IF !Have_Erosion flag ! Sum boundary losses (ave value per boundary grid point) DO i = 0, imax ! Note that egt contains creep+saltation not total soil loss on boundary period_update(Salt_1)%val = period_update(Salt_1)%val + & egt(i,0)/(imax-1) period_update(Salt_3)%val = period_update(Salt_3)%val + & egt(i,jmax)/(imax-1) period_update(Susp_1)%val = period_update(Susp_1)%val + & egtss(i,0)/(imax-1) period_update(Susp_3)%val = period_update(Susp_3)%val + & egtss(i,jmax)/(imax-1) period_update(PM10_1)%val = period_update(PM10_1)%val + & egt10(i,0)/(imax-1) period_update(PM10_3)%val = period_update(PM10_3)%val + & egt10(i,jmax)/(imax-1) END DO period_update(Salt_1)%cnt = period_update(Salt_1)%cnt + 1 period_update(Salt_3)%cnt = period_update(Salt_3)%cnt + 1 period_update(Susp_1)%cnt = period_update(Susp_1)%cnt + 1 period_update(Susp_3)%cnt = period_update(Susp_3)%cnt + 1 period_update(PM10_1)%cnt = period_update(PM10_1)%cnt + 1 period_update(PM10_3)%cnt = period_update(PM10_3)%cnt + 1 DO j = 0, jmax ! Note that egt contains creep+saltation not total soil loss on boundary period_update(Salt_2)%val = period_update(Salt_2)%val + & egt(0,j)/(jmax-1) period_update(Salt_4)%val = period_update(Salt_4)%val + & egt(imax,j)/(jmax-1) period_update(Susp_2)%val = period_update(Susp_2)%val + & egtss(0,j)/(jmax-1) period_update(Susp_4)%val = period_update(Susp_4)%val + & egtss(imax,j)/(jmax-1) period_update(PM10_2)%val = period_update(PM10_2)%val + & egt10(0,j)/(jmax-1) period_update(PM10_4)%val = period_update(PM10_4)%val + & egt10(imax,j)/(jmax-1) END DO period_update(Salt_2)%cnt = period_update(Salt_2)%cnt + 1 period_update(Salt_4)%cnt = period_update(Salt_4)%cnt + 1 period_update(Susp_2)%cnt = period_update(Susp_2)%cnt + 1 period_update(Susp_4)%cnt = period_update(Susp_4)%cnt + 1 period_update(PM10_2)%cnt = period_update(PM10_2)%cnt + 1 period_update(PM10_4)%cnt = period_update(PM10_4)%cnt + 1 END SUBROUTINE update_period_update_vars SUBROUTINE update_period_report_vars(pd,npd,cur_day,cur_month,cur_yr,nrot_yrs) USE pd_dates_vars USE pd_update_vars USE pd_report_vars USE pd_var_tables IMPLICIT NONE INTEGER, INTENT (IN) :: pd, npd INTEGER, INTENT (IN) :: cur_day INTEGER, INTENT (IN) :: cur_month INTEGER, INTENT (IN) :: cur_yr INTEGER, INTENT (IN) :: nrot_yrs INTEGER :: i ! local loop variables !variables averaged for reporting period ! This should be all of "erosion" and "eop" vars ! DO i = Min_period_vars, Max_period_vars DO i = Min_period_vars, PM10_4 ! Catch all averaged "erosion" vars CALL run_ave (period_report(i,pd), & period_update(i)%val, 1 ) END DO DO i = Max_cli_ave_vars+1, Max_period_vars ! Catch all "eop" vars CALL run_ave (period_report(i,pd), & period_update(i)%val, 1 ) END DO CALL run_ave (period_report(Salt_loss2,pd), & period_update(Salt_loss2)%val, 1 ) CALL run_ave (period_report(Salt_dep2,pd), & period_update(Salt_dep2)%val, 1 ) CALL run_ave (period_report(Trans_Cap,pd), & period_update(Trans_Cap)%val, 1 ) ! If we have saltating loss, add the area and fraction info IF (period_update(Salt_loss2)%cnt > 0) THEN CALL run_ave (period_report(Salt_loss2_area,pd), & period_update(Salt_loss2_area)%val, 1 ) CALL run_ave (period_report(Salt_loss2_frac,pd), & period_update(Salt_loss2_frac)%val, 1 ) CALL run_ave (period_report(Salt_dep2_area,pd), & period_update(Salt_dep2_area)%val, 1 ) CALL run_ave (period_report(Salt_dep2_frac,pd), & period_update(Salt_dep2_frac)%val, 1 ) CALL run_ave (period_report(Trans_Cap_area,pd), & period_update(Trans_Cap_area)%val, 1 ) CALL run_ave (period_report(Trans_Cap_frac,pd), & period_update(Trans_Cap_frac)%val, 1 ) CALL run_ave (period_report(Sheltered_area,pd), & period_update(Sheltered_area)%val, 1 ) CALL run_ave (period_report(Sheltered_frac,pd), & period_update(Sheltered_frac)%val, 1 ) END IF ! reset update_vars DO i=Min_period_vars,Max_period_vars period_update(i)%cnt = 0 period_update(i)%val = 0.0 IF (pd == npd) THEN period_update(i)%date => period_dates(1) ELSE period_update(i)%date => period_dates(pd+1) END IF END DO END SUBROUTINE update_period_report_vars