! aggfiles.f90 ! written by Tim Mitchell ! module in which all .agg file routines are held ! contains: SaveAgg, LoadAgg module AggFiles use FileNames use SortMod implicit none contains !******************************************************************************* ! either call with AllData, or Monthly+Seasonal+Annual subroutine SaveAgg (CallFile, AggNames, AllData, Monthly, Seasonal, Annual, & CallLineFormat,NoResponse,ExtraHeads,CallVariName,CallTimeName) real, pointer, dimension (:,:), optional :: AllData ! (AggN,17) real, pointer, dimension (:,:), optional :: Monthly, Seasonal ! (AggN,12), (AggN,4) real, pointer, dimension (:), optional :: Annual ! (AggN) integer, pointer, dimension (:) :: AggOrder character (len=20), pointer, dimension (:) :: AggNames ! (AggN) character (len=80), pointer, dimension (:) :: AggNamesShort character (len=20), intent(in),optional :: CallLineFormat ! specify if you don't want the auto hi-prec character (len=20), intent(in),optional :: CallTimeName ! description of time period e.g. '1961-1990' character (len=80), intent(in),optional :: CallVariName ! variable character (len=80), intent(in) :: CallFile ! can be blank character(len=158),pointer,dimension(:) :: Headers integer, intent(in), optional :: NoResponse ! ensures no run-time inputs are required integer, intent(in), optional :: ExtraHeads ! writes extra header lines if =1 real, parameter :: MissVal = -999.0 integer :: AllocStat integer :: AggN, MonthN, SeasonN, HeaderN, PeriodN integer :: XAgg, XMonth, XSeason, XHeader, XPeriod integer :: QSepAll character (len=80) :: SaveFile, NameVa character (len=20) :: LineFormat, NameTi !*************************************** ! check sizes if (present(Annual).AND.present(Seasonal).AND.present(Monthly)) then QSepAll = 1 AggN = size (Monthly,1) MonthN = size (Monthly,2) SeasonN = size (Seasonal,2) if (size(Seasonal,1).NE.AggN.OR.size(Annual).NE.AggN.OR.MonthN.NE.12.OR.SeasonN.NE.4) & print*, " > SaveAgg: No save. Weird number of months or Aggs." else if (present(AllData)) then QSepAll = 2 AggN = size (AllData,1) PeriodN = size (AllData,2) if (size(AllData,2).NE.17) print*, " > SaveAgg: No save. Weird number of periods." else print*, " > ##### ERROR: SaveAgg: call is unacceptable #####" end if if (present(CallLineFormat)) then LineFormat = trim(adjustl(CallLineFormat)) else LineFormat = '(a20,12f8.3,5f8.3)' end if if (present(ExtraHeads)) then if (present(CallTimeName)) then NameTi = CallTimeName else NameTi = " " end if if (present(CallVariName)) then NameVa = CallVariName else NameVa = " " end if call MakeAggHeaders (LineFormat,Headers,ManyHeads=ExtraHeads,TimeName=NameTi,VariName=NameVa) else call MakeAggHeaders (LineFormat,Headers) end if allocate (AggNamesShort(AggN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SaveAgg: Allocation failure: ANS #####" do XAgg = 1, AggN AggNamesShort(XAgg) = trim(adjustl(AggNames(XAgg))) end do call QuickSortText (AggNamesShort,AggOrder,Restricted=20) deallocate (AggNamesShort, stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SaveAgg: Deallocation failure: ANS #####" !*************************************** ! save data to file SaveFile = SavePath (CallFile,".agg") open (2, file=SaveFile, status="replace", access="sequential", form="formatted", action="write") do XHeader = 1, size(Headers,1) write (2,"(a158)"), Headers(XHeader) end do do XAgg = 1, AggN if (QSepAll.EQ.1) write (2,LineFormat), trim(adjustl(AggNames(AggOrder(XAgg)))), & (Monthly(AggOrder(XAgg),XMonth),XMonth=1,12), (Seasonal(AggOrder(XAgg),XSeason),XSeason=1,4), & Annual(AggOrder(XAgg)) if (QSepAll.EQ.2) write (2,LineFormat), trim(adjustl(AggNames(AggOrder(XAgg)))), & (AllData(AggOrder(XAgg),XPeriod),XPeriod=1,17) end do close (2) deallocate (Headers,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: SaveAgg: Deallocation failure #####" end subroutine SaveAgg !******************************************************************************* ! make headers for .agg data files subroutine MakeAggHeaders (LineFormat,Headers,ManyHeads,TimeName,VariName) character (len=158), pointer, dimension (:) :: Headers integer, intent (in), optional :: ManyHeads ! writes extra headers if =1 character (len=20),intent(in) :: LineFormat character (len=20),intent(in), optional :: TimeName character (len=80),intent(in), optional :: VariName real, parameter :: MissVal = -999.0 integer :: AllocStat character (len=12) :: Date, Time character (len=4 ) :: Year character (len=2 ) :: Month, Day, Hour, Minute !*************************************** call date_and_time (Date, Time) Year = Date (1:4) ; Month = Date (5:6) ; Day = Date (7:8) Hour = Time (1:2) ; Minute= Time (3:4) if (present(ManyHeads)) then if (ManyHeads.EQ.1) then allocate (Headers(20), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: MakeAggHeaders: Allocation failure #####" Headers = " " Headers ( 1) = "Monthly, seasonal, and annual climate observations averaged for political units." if (present(TimeName)) Headers ( 2) = "Time period = " // trim(adjustl(TimeName)) if (present(VariName)) Headers ( 3) = "Variable = " // trim(adjustl(VariName)) Headers ( 4) = "missing value = -999.0 : format = " // trim(adjustl(LineFormat)) Headers ( 5) = "*" Headers ( 6) = "File created and owned by Dr. Tim Mitchell (t.mitchell@uea.ac.uk). Full rights retained." Headers ( 7) = "Created at the Tyndall Centre (www.tyndall.ac.uk) on " & // Day // "." // Month // "." // Year // " at " // Hour // ":" // Minute Headers ( 8) = "The data in this file may be used for non-commercial scientific and educational purposes." Headers ( 9) = "Where research using this data is published, the source should be acknowledged as: " Headers (10) = " Mitchell,T.D. et al 2003: A comprehensive set of climate scenarios for Europe" Headers (11) = " and the globe. In prep." Headers (12) = "Method: The country aggregation is based on the TYN SC 2.0 gridded data-set." Headers (13) = " The gridded data were aggregated into countries using political boundaries; see:" Headers (14) = " Mitchell,Hulme,New,2001: Climate data for political areas. Area 34:109-112" Headers (15) = "For more information see http://www.cru.uea.ac.uk/~timm/" Headers (16) = "Disclaimer: No responsibility is taken for the accuracy of these data." Headers (17) = "Disclaimer: No political statement is implied in the selection of these political units." Headers (18) = "*" Headers (19) = "*" Headers (20) = ' AGGREGATION JAN FEB MAR APR MAY JUN JUL ' // & 'AUG SEP OCT NOV DEC MAM JJA SON DJF ANN' end if else allocate (Headers( 4), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: MakeAggHeaders: Allocation failure #####" Headers = "" Headers (1) = "Tyndall Centre file (www.tyndall.ac.uk) created on " & // Day // "." // Month // "." // Year // " at " // Hour // ":" // Minute & // " by Dr. Tim Mitchell" Headers (2) = "missing value = -999.0 : format = " // trim(adjustl(LineFormat)) Headers (3) = "Monthly, seasonal, and annual climate observations averaged for regions." Headers (4) = ' AGGREGATION JAN FEB MAR APR MAY JUN JUL ' // & 'AUG SEP OCT NOV DEC MAM JJA SON DJF ANN' end if end subroutine MakeAggHeaders !******************************************************************************* end module AggFiles