! synfiles.f90 ! module in which all .syn file routines are held ! contains: LoadSYN, SaveSYN module SYNFiles use FileNames implicit none contains !******************************************************************************* ! make line format for save subroutine MakeSYNFormat (LineFormat) character (len=20), intent(out) :: LineFormat integer :: ReadStatus character (len=1) :: DeciTxtShort LineFormat = "" print*, " > Enter the no. of decimal places to save (1...3): " do read (*,*,iostat=ReadStatus), DeciTxtShort if (ReadStatus.GT.0) print*, " > Not a string. Try again." if (DeciTxtShort.EQ."") print*, " > A null string. Try again." if (ReadStatus.LE.0.AND.DeciTxtShort.NE."") exit end do LineFormat = '(3i4,3i5,8f9.' // DeciTxtShort // ')' end subroutine MakeSYNFormat !******************************************************************************* ! make headers for .syn files subroutine MakeSYNHeaders (LineFormat,YearAD,Headers) integer, dimension (:), pointer :: YearAD character (len=99), dimension (4), intent (out) :: Headers character (len=20), intent(in) :: LineFormat real, parameter :: MissVal = -999.0 integer :: YearN character (len=12) :: Date, Time character (len=4 ) :: Year, Year0, Year1 character (len=2 ) :: Month, Day, Hour, Minute !*************************************** Headers = "" YearN = size (YearAD) open (1,file="year-scratch.txt",status="scratch") write (1,"(2i4)"), YearAD(1), YearAD(YearN) rewind (1) read (1,"(2a4)"), Year0, Year1 close (1) 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) Headers (1) = "Tyndall Centre file (www.tyndall.ac.uk) created on " & // Day // "." // Month // "." // Year // " at " // Hour // ":" // Minute & // " by Dr. Tim Mitchell" Headers (2) = "UK Synoptics. 'Orig'= manual Lamb type, rest are Jenkinson-Lamb products as labelled by UKMO" Headers (3) = "Period = " // Year0 // "-" // Year1 // ": missing value = -999.0 : format = " // LineFormat Headers (4) = 'YEAR MON DAY ORIG LAMB JENK' // & ' PM-1000 W S F D ZW ZS Z' end subroutine MakeSYNHeaders !******************************************************************************* ! load headers for .syn data files subroutine LoadSYNHeaders (FileName,LineFormat,YearAD) integer, dimension (:), pointer :: YearAD character (len=80), intent (in) :: FileName character (len=20), intent (out) :: LineFormat real, parameter :: MissVal = -999.0 integer :: Year0, Year1, YearN, AllocStat, XYear character (len=80) :: LoadName, Trash !*************************************** open (1, file=FileName, status="old", action="read") read (1,*), Trash ! ownership and date stamp read (1,*), Trash ! description read (1,"(a9,i4,a1,i4,a36,a20)"), Trash, Year0, Trash, Year1, Trash, LineFormat close (1) YearN = Year1 - Year0 + 1 allocate ( YearAD (YearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadSYNHeaders: Allocation failure #####" do XYear = 1, YearN YearAD (XYear) = XYear + Year0 - 1 end do end subroutine LoadSYNHeaders !******************************************************************************* subroutine LoadSYN (CallFile,YearAD,Lamb,Jenk,Auto,Flow) real, pointer, dimension (:,:,:,:) :: Flow integer, pointer, dimension (:,:,:) :: Lamb, Jenk, Auto integer, pointer, dimension (:) :: YearAD character (len=80), intent(in) :: CallFile ! can be blank character (len=99), dimension (4) :: Headers real, parameter :: MissVal = -999.0 integer :: ReadStatus, AllocStat, NoSave integer :: YearN, MonthN, DayN, VariN integer :: XYear, XMonth, XDay, XVari, XHeader integer :: Year, Month, Day character (len=99) :: Trash character (len=80) :: LoadFile character (len=20) :: LineFormat character (len= 4) :: Suffix !*************************************** Suffix = '.syn' MonthN = 12 DayN = 31 VariN = 8 LoadFile = LoadPath (CallFile,Suffix) call LoadSYNHeaders (LoadFile,LineFormat,YearAD) print "(a25,a20)", " > The line format is: ", LineFormat YearN = size (YearAD) allocate (Flow (YearN,MonthN,DayN,VariN), & Lamb (YearN,MonthN,DayN), & Jenk (YearN,MonthN,DayN), & Auto (YearN,MonthN,DayN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadSYN: Allocation failure #####" open (2, file=LoadFile, status="old", access="sequential", form="formatted", action="read") do XHeader = 1, 4 read (2,"(a99)"), Trash end do do XYear = 1, YearN do XMonth = 1, MonthN do XDay = 1, DayN read (2,LineFormat), Year, Month, Day, & Lamb(XYear,XMonth,XDay),Jenk(XYear,XMonth,XDay),Auto(XYear,XMonth,XDay), & (Flow(XYear,XMonth,XDay,XVari), XVari = 1, VariN) end do end do end do close (2) end subroutine LoadSYN !******************************************************************************* subroutine SaveSYN (CallFile,YearAD,Lamb,Jenk,Auto,Flow) real, pointer, dimension (:,:,:,:) :: Flow integer, pointer, dimension (:,:,:) :: Lamb, Jenk, Auto integer, pointer, dimension (:) :: YearAD character (len=80), intent(in) :: CallFile ! can be blank character (len=99), dimension (4) :: Headers real, parameter :: MissVal = -999.0 integer :: ReadStatus, AllocStat, NoSave integer :: YearN, MonthN, DayN, VariN integer :: XYear, XMonth, XDay, XVari, XHeader character (len=80) :: SaveFile character (len=20) :: LineFormat character (len= 4) :: Suffix !*************************************** ! initialise and check for harmony in array sizes Suffix = ".syn" NoSave = 0 ; MonthN = 12 ; DayN = 31 ; VariN = 8 YearN = size (YearAD,1) if (size(Flow,1).NE.YearN.OR.size(Lamb,1).NE.YearN.OR.size(Jenk,1).NE.YearN.OR.size(Auto,1).NE.YearN) then NoSave = 1 ; print*, " > SaveSYN: Incompatible year dims. No save" end if if (size(Flow,2).NE.MonthN.OR.size(Lamb,2).NE.MonthN.OR.size(Jenk,2).NE.MonthN.OR.size(Auto,2).NE.MonthN) then NoSave = 1 ; print*, " > SaveSYN: Incompatible month dims. No save" end if if (size(Flow,3).NE.DayN.OR.size(Lamb,3).NE.DayN.OR.size(Jenk,3).NE.DayN.OR.size(Auto,3).NE.DayN) then NoSave = 1 ; print*, " > SaveSYN: Incompatible day dims. No save" end if if (size(Flow,4).NE.VariN) then NoSave = 1 ; print*, " > SaveSYN: Incompatible vari dims. No save" end if !*************************************** ! prepare to save if (NoSave.EQ.0) then call MakeSYNFormat (LineFormat) call MakeSYNHeaders (LineFormat,YearAD,Headers) SaveFile = SavePath (CallFile,Suffix) end if !*************************************** ! save if (NoSave.EQ.0) then open (2, file=SaveFile, status="replace", access="sequential", form="formatted", action="write") do XHeader = 1, 4 write (2,"(a99)"), Headers(XHeader) end do do XYear = 1, YearN do XMonth = 1, MonthN do XDay = 1, DayN write (2,LineFormat), YearAD(XYear), XMonth, XDay, & Lamb(XYear,XMonth,XDay), Jenk(XYear,XMonth,XDay), Auto(XYear,XMonth,XDay), & (Flow(XYear,XMonth,XDay,XVari), XVari=1,VariN) end do end do end do close (2) end if end subroutine SaveSYN !******************************************************************************* end module SYNFiles