! dayfiles.f90 ! module in which all .day routines are held ! contains: SaveDAY, LoadDAY module DAYFiles use FileNames implicit none contains !******************************************************************************* ! make line format for .day save subroutine MakeDAYLineFormat (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 = '(2i5,12f9.' // DeciTxtShort // ')' end subroutine MakeDAYLineFormat !******************************************************************************* ! make headers for .day data files subroutine MakeDAYHeaders (VariCode,LineFormat,YearAD,Headers) integer, dimension (:), pointer :: YearAD character (len=158), dimension (4), intent (out) :: Headers integer, intent (in) :: VariCode ! -1=min, 0=mean, 1=max, 2=sum character (len=20), intent(in) :: LineFormat real, parameter :: MissVal = -999.0 integer :: YearN character (len=12) :: Date, Time character (len=8) :: TimePeriod, Variable character (len=4 ) :: Year, Year0, Year1 character (len=2 ) :: Month, Day, Hour, Minute !*************************************** Headers = "" Variable = "" Year0 = "" YearN = size (YearAD) TimePeriod= "Daily" Headers(4) = ' YEAR DAY JAN FEB MAR APR MAY JUN JUL ' // & 'AUG SEP OCT NOV DEC' if (VariCode.EQ.-1) Variable = "Min" if (VariCode.EQ. 0) Variable = "Mean" if (VariCode.EQ. 1) Variable = "Max" if (VariCode.EQ. 2) Variable = "Sum" if (YearAD(1).GT.0.AND.YearAD(YearN).GE.YearAD(1)) then open (1,status="scratch") write (1,"(2i4)"), YearAD(1), YearAD(YearN) rewind (1) read (1,"(2a4)"), Year0, Year1 close (1) end if if (Variable.NE."".AND.Year0.NE."") then 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) = "Daily (.day) data; time, var codes: " // TimePeriod // " " // Variable Headers (3) = "Period = " // Year0 // "-" // Year1 // ": missing value = -999.0 : format = " // LineFormat else Headers = "codes not correctly specified for MakeHeader" end if end subroutine MakeDAYHeaders !******************************************************************************* ! load headers from .day data files subroutine LoadDAYHeaders (FileName,VariCode,LineFormat,YearAD) integer, dimension (:), pointer :: YearAD integer, intent (out) :: VariCode ! -1=min, 0=mean, 1=max, 2=sum 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 character (len=8) :: TimePeriod, Variable !*************************************** open (1, file=FileName, status="old", action="read") read (1,*), Trash ! ownership and date stamp read (1,"(a36,a8,a1,a8)"), Trash, TimePeriod, Trash, Variable ! time period and variable read (1,"(a9,i4,a1,i4,a36,a20)"), Trash, Year0, Trash, Year1, Trash, LineFormat close (1) if (trim(Variable).EQ."Min") then VariCode = -1 else if (trim(Variable).EQ."Mean") then VariCode = 0 else if (trim(Variable).EQ."Max") then VariCode = 1 else if (trim(Variable).EQ."Sum") then VariCode = 2 else VariCode = MissVal end if YearN = Year1 - Year0 + 1 allocate ( YearAD (YearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadHeaders: Allocation failure #####" do XYear = 1, YearN YearAD (XYear) = XYear + Year0 - 1 end do end subroutine LoadDAYHeaders !******************************************************************************* ! save .day file subroutine SaveDAY (CallFile, CallVariCode, YearAD, Daily) real, pointer, dimension (:,:,:) :: Daily integer, pointer, dimension (:) :: YearAD character (len=80), intent(in) :: CallFile ! can be blank character (len=158), dimension (4) :: Headers integer, intent(in) :: CallVariCode ! can be MissVal, -1=min,0=mean,1=max,2=sum real, parameter :: MissVal = -999.0 integer :: NoSave, ReadStatus, AllocStat integer :: YearN, MonthN, DayN integer :: XYear, XMonth, XDay integer :: VariCode character (len=80) :: SaveFile character (len=20) :: LineFormat character (len= 4) :: Suffix !*************************************** ! check sizes NoSave = 0 Suffix = ".day" YearN = size (Daily,1) if (size(YearAD).NE.YearN) then print*, " > SaveDAY: No save. Mismatch between array and vector." NoSave = 1 end if MonthN = size (Daily,2) DayN = size (Daily,3) if (MonthN.NE.12.OR.DayN.NE.31) then print*, " > SaveDAY: No save. Weird number of months or days." NoSave = 1 end if if (CallVariCode.LT.-1.OR.CallVariCode.GT.2) then print*, " > Enter the variable (-1=min,0=mean,1=max,2=sum): " do read (*,*,iostat=ReadStatus), VariCode if (ReadStatus.LE.0.AND.VariCode.GE.-1.AND.VariCode.LE.2) exit end do else VariCode = CallVariCode end if call MakeDAYLineFormat (LineFormat) call MakeDAYHeaders (VariCode,LineFormat,YearAD,Headers) if (Headers(1).EQ."codes not correctly specified for MakeHeader") then print*, " > SaveDAY: No save. Codes not correctly specified for MakeHeaders." NoSave = 1 end if !*************************************** ! save data to file if (NoSave.EQ.0) then SaveFile = SavePath (CallFile,Suffix) open (2, file=SaveFile, status="replace", access="sequential", form="formatted", action="write") write (2,"(a158)"), Headers(1) write (2,"(a158)"), Headers(2) write (2,"(a158)"), Headers(3) write (2,"(a158)"), Headers(4) do XYear = 1, YearN do XDay = 1, 31 write (2,LineFormat), YearAD(XYear), XDay, (Daily(XYear,XMonth,XDay), XMonth=1,12) end do end do close (2) end if end subroutine SaveDAY !******************************************************************************* ! load .day file subroutine LoadDAY (CallFile, VariCode, YearAD, Daily) real, pointer, dimension (:,:,:) :: Daily integer, pointer, dimension (:) :: YearAD integer, intent (out) :: VariCode character (len=80), intent(in) :: CallFile ! can be blank real, parameter :: MissVal = -999.0 integer :: ReadStatus, AllocStat integer :: YearN, MonthN, DayN integer :: XYear, XMonth, XDay, XHeader integer :: TimeCode, LineYear, LineDay character (len=80) :: LoadFile, Trash character (len=20) :: LineFormat character (len= 4) :: Suffix !*************************************** Suffix = ".day" LoadFile = LoadPath (CallFile,Suffix) call LoadDAYHeaders (LoadFile,VariCode,LineFormat,YearAD) print "(a45,a20)", " > The line format is (year,day,month*12): ", LineFormat YearN = size (YearAD) MonthN = 12 DayN = 31 allocate (Daily (YearN,MonthN,DayN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadDAY: Allocation failure #####" open (2, file=LoadFile, status="old", access="sequential", form="formatted", action="read") do XHeader = 1, 4 read (2,*), Trash end do do XYear = 1, YearN do XDay = 1, 31 read (2,LineFormat), LineYear, LineDay, (Daily(XYear,XMonth,XDay), XMonth=1,12) end do end do close (2) end subroutine LoadDAY !******************************************************************************* end module DAYFiles