! This subroutine generates the output file used by the Java 2 interface. ! It includes a new initial column that defines the type of data on each ! output line. The key definitions are: ! # - comment line (interface should ignore these lines) ! P - period or "detail" lines ! H - rotation half month lines - (currently not generated) ! M - rotation month lines - (currently not generated) ! Y - rotation year total lines ! T - rotation total line ! m - month lines ! h - half month lines ! y - individual year lines ! t - total line - (same as rotation total line) ! Note that all key definitions in CAPS refer to "rotation year" info. ! All non-CAP key definitions refer to calendar year info ! (rotation years are combined, eg. rotation year 1 and 2 monthly info combined) SUBROUTINE print_ui1_output(nperiods, nrot_years, ncycles) USE pd_dates_vars USE pd_update_vars USE pd_report_vars USE pd_var_tables USE mandate_vars IMPLICIT NONE INCLUDE 'file.fi' INCLUDE 'p1werm.inc' INCLUDE 'm1geo.inc' INTEGER, INTENT (IN) :: nperiods INTEGER, INTENT (IN) :: nrot_years INTEGER, INTENT (IN) :: ncycles INTEGER :: i,hm,m,y ! local loop variables INTEGER :: p,x ! local loop variables LOGICAL :: match = .false. INTEGER :: match_no = 0 CHARACTER(len=256) :: opname, cropname ! format for header of ui1 output report file write (UNIT=luogui1,FMT="(1(A))",ADVANCE="NO") & 'key|' write (UNIT=luogui1,FMT="(1(A))",ADVANCE="NO") & 'sd ed mo yr|' write (UNIT=luogui1,FMT="(2(A))",ADVANCE="NO") & ' operation |', & ' crop |' write (UNIT=luogui1,FMT="(A)",ADVANCE="NO") 'gross_loss|' write (UNIT=luogui1,FMT="(16(A))",ADVANCE="NO") & ' tot_loss|',' crp+salt|',' suspen|',' pm10|', & ' cs1|',' cs2|',' cs3|',' cs4|', & ' ss1|',' ss2|',' ss3|',' ss4|', & ' pm1|',' pm2|',' pm3|',' pm4|' write (UNIT=luogui1,FMT="(11(A))",ADVANCE="NO") & ' salt_loss|',' loss_area|',' loss_frac|', & ' salt_dep|',' dep_area|',' dep_frac|', & ' flux_rate|',' flux_area|',' flux_frac|', & 'shelt_area|','shelt_frac|' write (UNIT=luogui1,FMT="(3(A))",ADVANCE="NO") & ' precip|',' w_energy|','snow_cover|' ! ' precip|',' w_energy|','snow_cover|',' dry_idx|' write (UNIT=luogui1,FMT="(11(A))",ADVANCE="NO") & ' l_can_cov|','l_sil_area|',' l_st_mass|', & ' d_fl_cov|',' d_st_sil|',' d_fl_mass|',' d_st_mass|', & 'b_f_fl_cov|','b_f_st_sil|','b_m_fl_cov|','b_m_st_sil|' write (UNIT=luogui1,FMT="(4(A))",ADVANCE="NO") & ' rdg_or|',' rdg_ht|',' rdg_sp|',' rr|' write (UNIT=luogui1,FMT="(3(A))",ADVANCE="YES") & ' surf_84|',' surf_AS|',' surf_crust|' DO y = 1, nrot_years x = 1 DO p = 1, nperiods IF (period_dates(p)%sy == y) THEN write (UNIT=luogui1,FMT="(' P |')",ADVANCE="NO") write (UNIT=luogui1,FMT="(i2, '-',i2,'/',i2,'/',i2,'|')",ADVANCE="NO") & period_dates(p)%sd, period_dates(p)%ed, & period_dates(p)%sm, period_dates(p)%sy ! Check to see if an operation occurs on this date ! If so, set the flag and then look for any additional ! operations on the same date. When done, print the ! concatenated list of operations and any cropname(s) match = .false. match_no = 0 DO i = 1, size(mandate) IF ((mandate(i)%d == period_dates(p)%sd) .and. & (mandate(i)%m == period_dates(p)%sm) .and. & (mandate(i)%y == y)) THEN match = .true. match_no = match_no + 1 IF (match_no == 1) THEN opname = mandate(i)%opname cropname = mandate(i)%cropname ELSE opname = trim(opname) // "~" // mandate(i)%opname cropname = trim(cropname) // "~" // mandate(i)%cropname END IF END IF END DO IF (match) THEN write (UNIT=luogui1,FMT="(1x,A,'| ',A,'|')",ADVANCE="NO") & trim(opname), trim(cropname) ELSE ! No operation or crop on this date write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" END IF write (UNIT=luogui1,FMT="(1(f10.4,'|'))",ADVANCE="NO") & period_report(Eros_loss,p)%val - & period_report(Salt_dep2,p)%val write (UNIT=luogui1,FMT="(16(f10.4,'|'))",ADVANCE="NO") & period_report(Eros_loss,p)%val, & period_report(Salt_loss,p)%val, & period_report(Susp_loss,p)%val, & period_report(PM10_loss,p)%val, & period_report(Salt_1,p)%val, & period_report(Salt_2,p)%val, & period_report(Salt_3,p)%val, & period_report(Salt_4,p)%val, & period_report(Susp_1,p)%val, & period_report(Susp_2,p)%val, & period_report(Susp_3,p)%val, & period_report(Susp_4,p)%val, & period_report(PM10_1,p)%val, & period_report(PM10_2,p)%val, & period_report(PM10_3,p)%val, & period_report(PM10_4,p)%val write (UNIT=luogui1,FMT="(11(f10.4,'|'))",ADVANCE="NO") & period_report(Salt_loss2_rate,p)%val, & period_report(Salt_loss2_area,p)%val, & period_report(Salt_loss2_frac,p)%val, & period_report(Salt_dep2_rate,p)%val, & period_report(Salt_dep2_area,p)%val, & period_report(Salt_dep2_frac,p)%val, & period_report(Trans_cap,p)%val, & period_report(Trans_cap_area,p)%val, & period_report(Trans_cap_frac,p)%val, & period_report(Sheltered_area,p)%val, & period_report(Sheltered_frac,p)%val ! Check to see if period is an "end of half month" period ! If so, set the flag and print the "weather" variables ! x = half_month index value that we last had a match match = .false. DO hm = x, 24 !print *, "p/hm/y: ", p, hm,y, period_dates(p), hmonth_dates(hm,y) IF ((hmonth_dates(hm,y)%ed == period_dates(p)%ed) .and. & (hmonth_dates(hm,y)%em == period_dates(p)%em) .and. & (hmonth_dates(hm,y)%ey == period_dates(p)%ey)) THEN match = .true. x = hm write (UNIT=luogui1,FMT="(3(f10.4,'|'))",ADVANCE="NO") & hmonth_report(Precipi,x,y)%val, & hmonth_report(Wind_energy,x,y)%val, & hmonth_report(Snow_cover,x,y)%val ! hmonth_report(Dryness_ratio,x,y)%val GOTO 20 END IF END DO 20 IF (.not. match) THEN ! No climate info on this date write (UNIT=luogui1,FMT="(3(A10,'|'))",ADVANCE="NO") "","","" END IF write (UNIT=luogui1,FMT="(11(f10.4,'|'))",ADVANCE="NO") & period_report(Crop_canopy_cov,p)%val, & period_report(Crop_stand_sil,p)%val, & period_report(Crop_stand_mass,p)%val, & period_report(Res_flat_cov,p)%val, & period_report(Res_stand_sil,p)%val, & period_report(Res_flat_mass,p)%val, & period_report(Res_stand_mass,p)%val, & period_report(All_flat_cov,p)%val, & period_report(All_stand_sil,p)%val, & period_report(All_flat_mass,p)%val, & period_report(All_stand_mass,p)%val write (UNIT=luogui1,FMT="(4(f10.4,'|'))",ADVANCE="NO") & period_report(Ridge_dir,p)%val, & period_report(Ridge_ht,p)%val, & period_report(Ridge_sp,p)%val, & period_report(Random_rough,p)%val write (UNIT=luogui1,FMT="(3(f10.4,'|'))",ADVANCE="YES") & period_report(Surface_84,p)%val, & period_report(Surface_AS,p)%val, & period_report(Surface_Crust,p)%val END IF END DO ! print the rotation yearly values here write (UNIT=luogui1,FMT="(' Y |')",ADVANCE="NO") write (UNIT=luogui1,FMT="(1('Rot. yr: ',i2,'|'))",ADVANCE="NO") & yrly_dates(y)%sy write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" !skip op field write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" !skip crop field write (UNIT=luogui1,FMT="(1(f10.4,'|'))",ADVANCE="NO") & yrly_report(Eros_loss,y)%val - & yrly_report(Salt_dep2,y)%val write (UNIT=luogui1,FMT="(16(f10.4,'|'))",ADVANCE="NO") & yrly_report(Eros_loss,y)%val, & yrly_report(Salt_loss,y)%val, & yrly_report(Susp_loss,y)%val, & yrly_report(PM10_loss,y)%val, & yrly_report(Salt_1,y)%val, & yrly_report(Salt_2,y)%val, & yrly_report(Salt_3,y)%val, & yrly_report(Salt_4,y)%val, & yrly_report(Susp_1,y)%val, & yrly_report(Susp_2,y)%val, & yrly_report(Susp_3,y)%val, & yrly_report(Susp_4,y)%val, & yrly_report(PM10_1,y)%val, & yrly_report(PM10_2,y)%val, & yrly_report(PM10_3,y)%val, & yrly_report(PM10_4,y)%val write (UNIT=luogui1,FMT="(11(f10.4,'|'))",ADVANCE="NO") & yrly_report(Salt_loss2_rate,y)%val, & yrly_report(Salt_loss2_area,y)%val, & yrly_report(Salt_loss2_frac,y)%val, & yrly_report(Salt_dep2_rate,y)%val, & yrly_report(Salt_dep2_area,y)%val, & yrly_report(Salt_dep2_frac,y)%val, & yrly_report(Trans_cap,y)%val, & yrly_report(Trans_cap_area,y)%val, & yrly_report(Trans_cap_frac,y)%val, & yrly_report(Sheltered_area,y)%val, & yrly_report(Sheltered_frac,y)%val write (UNIT=luogui1,FMT="(3(f10.4,'|'))",ADVANCE="NO") & yrly_report(Precipi,y)%val, & yrly_report(Wind_energy,y)%val, & yrly_report(Snow_cover,y)%val ! yrly_report(Dryness_ratio,y)%val DO i = 1, 18 !skip veg/surf fields write (UNIT=luogui1,FMT="(A7,'N/A|')",ADVANCE="NO") "" END DO write (UNIT=luogui1,FMT="(A)",ADVANCE="YES") "" END DO ! print the monthly values here y = 0 DO m = 1, 12 write (UNIT=luogui1,FMT="(' m |')",ADVANCE="NO") write (UNIT=luogui1,FMT="(A,i2,A)",ADVANCE="NO") & 'Month: ',m,'|' write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" !skip op field write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" !skip crop field write (UNIT=luogui1,FMT="(1(f10.4,'|'))",ADVANCE="NO") & monthly_report(Eros_loss,m,y)%val - & monthly_report(Salt_dep2,m,y)%val write (UNIT=luogui1,FMT="(16(f10.4,'|'))",ADVANCE="NO") & monthly_report(Eros_loss,m,y)%val, & monthly_report(Salt_loss,m,y)%val, & monthly_report(Susp_loss,m,y)%val, & monthly_report(PM10_loss,m,y)%val, & monthly_report(Salt_1,m,y)%val, & monthly_report(Salt_2,m,y)%val, & monthly_report(Salt_3,m,y)%val, & monthly_report(Salt_4,m,y)%val, & monthly_report(Susp_1,m,y)%val, & monthly_report(Susp_2,m,y)%val, & monthly_report(Susp_3,m,y)%val, & monthly_report(Susp_4,m,y)%val, & monthly_report(PM10_1,m,y)%val, & monthly_report(PM10_2,m,y)%val, & monthly_report(PM10_3,m,y)%val, & monthly_report(PM10_4,m,y)%val write (UNIT=luogui1,FMT="(11(f10.4,'|'))",ADVANCE="NO") & monthly_report(Salt_loss2_rate,m,y)%val, & monthly_report(Salt_loss2_area,m,y)%val, & monthly_report(Salt_loss2_frac,m,y)%val, & monthly_report(Salt_dep2_rate,m,y)%val, & monthly_report(Salt_dep2_area,m,y)%val, & monthly_report(Salt_dep2_frac,m,y)%val, & monthly_report(Trans_cap,m,y)%val, & monthly_report(Trans_cap_area,m,y)%val, & monthly_report(Trans_cap_frac,m,y)%val, & monthly_report(Sheltered_area,m,y)%val, & monthly_report(Sheltered_frac,m,y)%val write (UNIT=luogui1,FMT="(3(f10.4,'|'))",ADVANCE="NO") & monthly_report(Precipi,m,y)%val, & monthly_report(Wind_energy,m,y)%val, & monthly_report(Snow_cover,m,y)%val ! monthly_report(Dryness_ratio,m,y)%val DO i = 1, 18 !skip veg/surf fields write (UNIT=luogui1,FMT="(A7,'N/A|')",ADVANCE="NO") "" END DO write (UNIT=luogui1,FMT="(A)",ADVANCE="YES") "" END DO DO y = 1, nrot_years*ncycles ! print the simulation run individual yearly ave values here write (UNIT=luogui1,FMT="(' y |')",ADVANCE="NO") write (UNIT=luogui1,FMT="(A,i3,A)",ADVANCE="NO") & 'Year: ',y,'|' write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" !skip op field write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" !skip crop field write (UNIT=luogui1,FMT="(1(f10.4,'|'))",ADVANCE="NO") & yr_report(Eros_loss,y)%val - & yr_report(Salt_dep2,y)%val write (UNIT=luogui1,FMT="(16(f10.4,'|'))",ADVANCE="NO") & yr_report(Eros_loss,y)%val, & yr_report(Salt_loss,y)%val, & yr_report(Susp_loss,y)%val, & yr_report(PM10_loss,y)%val, & yr_report(Salt_1,y)%val, & yr_report(Salt_2,y)%val, & yr_report(Salt_3,y)%val, & yr_report(Salt_4,y)%val, & yr_report(Susp_1,y)%val, & yr_report(Susp_2,y)%val, & yr_report(Susp_3,y)%val, & yr_report(Susp_4,y)%val, & yr_report(PM10_1,y)%val, & yr_report(PM10_2,y)%val, & yr_report(PM10_3,y)%val, & yr_report(PM10_4,y)%val write (UNIT=luogui1,FMT="(11(f10.4,'|'))",ADVANCE="NO") & yr_report(Salt_loss2_rate,y)%val, & yr_report(Salt_loss2_area,y)%val, & yr_report(Salt_loss2_frac,y)%val, & yr_report(Salt_dep2_rate,y)%val, & yr_report(Salt_dep2_area,y)%val, & yr_report(Salt_dep2_frac,y)%val, & yr_report(Trans_cap,y)%val, & yr_report(Trans_cap_area,y)%val, & yr_report(Trans_cap_frac,y)%val, & yr_report(Sheltered_area,y)%val, & yr_report(Sheltered_frac,y)%val write (UNIT=luogui1,FMT="(3(f10.4,'|'))",ADVANCE="NO") & yr_report(Precipi,y)%val, & yr_report(Wind_energy,y)%val, & yr_report(Snow_cover,y)%val ! yr_report(Dryness_ratio,y)%val DO i = 1, 18 !skip veg/surf fields write (UNIT=luogui1,FMT="(A7,'N/A|')",ADVANCE="NO") "" END DO write (UNIT=luogui1,FMT="(A)",ADVANCE="YES") "" END DO ! print the simulation run yearly average values here write (UNIT=luogui1,FMT="(' T |')",ADVANCE="NO") write (UNIT=luogui1,FMT="(2(A))",ADVANCE="NO") & 'Ave. Annual','|' write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" !skip op field write (UNIT=luogui1,FMT="(1x,A80,'|')",ADVANCE="NO") "" !skip crop field y = 0 write (UNIT=luogui1,FMT="(1(f10.4,'|'))",ADVANCE="NO") & yrly_report(Eros_loss,y)%val - & yrly_report(Salt_dep2,y)%val write (UNIT=luogui1,FMT="(16(f10.4,'|'))",ADVANCE="NO") & yrly_report(Eros_loss,y)%val, & yrly_report(Salt_loss,y)%val, & yrly_report(Susp_loss,y)%val, & yrly_report(PM10_loss,y)%val, & yrly_report(Salt_1,y)%val, & yrly_report(Salt_2,y)%val, & yrly_report(Salt_3,y)%val, & yrly_report(Salt_4,y)%val, & yrly_report(Susp_1,y)%val, & yrly_report(Susp_2,y)%val, & yrly_report(Susp_3,y)%val, & yrly_report(Susp_4,y)%val, & yrly_report(PM10_1,y)%val, & yrly_report(PM10_2,y)%val, & yrly_report(PM10_3,y)%val, & yrly_report(PM10_4,y)%val write (UNIT=luogui1,FMT="(11(f10.4,'|'))",ADVANCE="NO") & yrly_report(Salt_loss2_rate,y)%val, & yrly_report(Salt_loss2_area,y)%val, & yrly_report(Salt_loss2_frac,y)%val, & yrly_report(Salt_dep2_rate,y)%val, & yrly_report(Salt_dep2_area,y)%val, & yrly_report(Salt_dep2_frac,y)%val, & yrly_report(Trans_cap,y)%val, & yrly_report(Trans_cap_area,y)%val, & yrly_report(Trans_cap_frac,y)%val, & yrly_report(Sheltered_area,y)%val, & yrly_report(Sheltered_frac,y)%val write (UNIT=luogui1,FMT="(3(f10.4,'|'))",ADVANCE="NO") & yrly_report(Precipi,y)%val, & yrly_report(Wind_energy,y)%val, & yrly_report(Snow_cover,y)%val ! yrly_report(Dryness_ratio,y)%val DO i = 1, 18 !skip veg/surf fields write (UNIT=luogui1,FMT="(A7,'N/A|')",ADVANCE="NO") "" END DO write (UNIT=luogui1,FMT="(A)",ADVANCE="YES") "" END SUBROUTINE print_ui1_output