! annfiles.f90 ! module in which standard save to and load from .ann file routines are held ! contains: MakeANNColTitles, LoadANN, SaveANN module ANNFiles use FileNames implicit none contains !******************************************************************************* ! load .ann files subroutine LoadANN (CallFile, YearAD, ColTitles, Data) real, pointer, dimension (:,:) :: Data ! YearN, ColN integer, pointer, dimension (:) :: YearAD character (len=9), pointer, dimension(:) :: ColTitles character (len=80), intent(in) :: CallFile ! can be blank real, parameter :: MissVal = -999.0 integer :: ReadStatus, AllocStat integer :: YearN, ColN integer :: XYear, XCol, XHeader integer :: Year character (len=99) :: Trash character (len=80) :: LoadFile character (len=20) :: LineFormat character (len= 4) :: Suffix !*************************************** Suffix = ".ann" LoadFile = LoadPath (CallFile,Suffix) call LoadANNHeaders (LoadFile,LineFormat,ColTitles,YearAD) YearN = size (YearAD) ColN = size (ColTitles) allocate (Data(YearN,ColN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadANN: 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 read (2 ,LineFormat), Year, (Data(XYear,XCol), XCol=1,ColN) end do close (2) end subroutine LoadANN !******************************************************************************* ! save .ann files: multiple columns with common precision subroutine SaveANN (CallFile, YearAD, ColTitles, Data, DecPlaceN) real, pointer, dimension (:,:) :: Data ! YearN, ColN integer, pointer, dimension (:) :: YearAD character (len=9), pointer, dimension(:) :: ColTitles ! can be 'X', no blanks integer, intent (in), optional :: DecPlaceN character (len=80), intent(in) :: CallFile ! can be blank character (len=200), dimension (4) :: Headers real, parameter :: MissVal = -999.0 integer :: ReadStatus, AllocStat integer :: YearN, ColN integer :: XYear, XCol, XHeader character (len=80) :: SaveFile character (len=20) :: LineFormat character (len= 4) :: Suffix !*************************************** Suffix = ".ann" YearN = size (YearAD) ColN = size (ColTitles) if (YearN.NE.size(Data,1)) then print*, " > SaveANN. Mismatch between YearAD and Data arrays. No save." else if (ColN .NE.size(Data,2)) then print*, " > SaveANN. Mismatch between ColTitles and Data arrays. No save." else if (present(DecPlaceN)) then call MakeANNFormat (ColN,LineFormat,DecPlaceN=DecPlaceN) else call MakeANNFormat (ColN,LineFormat) end if call MakeANNHeaders (LineFormat,YearAD,ColTitles,Headers) SaveFile = SavePath (CallFile,Suffix) open (2, file=SaveFile, status="replace", access="sequential", form="formatted", action="write") do XHeader = 1, 4 write (2,"(a)"), trim(Headers(XHeader)) end do do XYear = 1, YearN write (2,LineFormat), YearAD(XYear), (Data(XYear,XCol), XCol=1,ColN) end do close (2) end if end subroutine SaveANN !******************************************************************************* ! make line format for .ann save subroutine MakeANNFormat (ColN,LineFormat,DecPlaceN) integer, intent (in) :: ColN integer, intent (in), optional :: DecPlaceN character (len=20), intent(out) :: LineFormat integer :: ReadStatus, PlaceN character (len=20) :: DeciTxtLong,ColNText character (len= 1) :: DeciTxtShort LineFormat = "" if (present(DecPlaceN)) then PlaceN = DecPlaceN if (PlaceN.LT.1) PlaceN = 1 if (PlaceN.GT.3) PlaceN = 3 DeciTxtLong = GetTextFromInt (PlaceN) DeciTxtLong = adjustl(DeciTxtLong) DeciTxtShort = DeciTxtLong(1:1) else 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 end if ColNText=GetTextFromInt(ColN) LineFormat = '(i4,' // trim(adjustl(ColNText)) // 'f9.' // DeciTxtShort // ')' end subroutine MakeANNFormat !******************************************************************************* ! make headers for .ann files subroutine MakeANNHeaders (LineFormat,YearAD,ColTitles,Headers) integer, dimension (:), pointer :: YearAD character (len=9), dimension (:), pointer :: ColTitles character (len=200), dimension (4), intent (out) :: Headers character (len=20), intent(in) :: LineFormat real, parameter :: MissVal = -999.0 integer :: YearN, ColN, XCol character (len=12) :: Date, Time character (len=4 ) :: Year, Year0, Year1, ColNText character (len=2 ) :: Month, Day, Hour, Minute !*************************************** Headers = "" YearN = size (YearAD) ColN = size (ColTitles) open (1,status="scratch") write (1,"(3i4)"), YearAD(1), YearAD(YearN), ColN rewind (1) read (1,"(3a4)"), Year0, Year1, ColNText 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) = "Annual (.ann) file format: year AD, with" // ColNText // " data columns" Headers (3) = "Period = " // Year0 // "-" // Year1 // ": missing value = -999.0 : format = " // LineFormat Headers (4) = 'YEAR' do XCol = 1, ColN Headers (4) = trim(Headers(4)) // adjustr(ColTitles(XCol)) end do end subroutine MakeANNHeaders !******************************************************************************* ! load headers for .ann data files subroutine LoadANNHeaders (FileName,LineFormat,ColTitles,YearAD) integer, dimension (:), pointer :: YearAD character (len=9), dimension (:), pointer :: ColTitles character (len=80), intent (in) :: FileName character (len=20), intent (out) :: LineFormat real, parameter :: MissVal = -999.0 integer :: Year0, Year1, YearN, AllocStat, XYear, XCol, ColN character (len=4) :: ColNText character (len=20) :: HeaderFormat character (len=80) :: LoadName, Trash !*************************************** open (1, file=FileName, status="old", action="read") read (1,*), Trash ! ownership and date stamp read (1,"(a40,i4)"), Trash, ColN ! number of columns read (1,"(a9,i4,a1,i4,a36,a20)"), Trash, Year0, Trash, Year1, Trash, LineFormat open (2,status="scratch") write (2,"(i4)"), ColN rewind (2) read (2,"(a4)"), ColNText close (2) allocate (ColTitles (ColN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadANNHeaders: Allocation failure #####" HeaderFormat = "(a4," // trim(adjustl(ColNText)) // "a9)" read (1,HeaderFormat), Trash, (ColTitles(XCol), XCol=1,ColN) close (1) YearN = Year1 - Year0 + 1 allocate (YearAD (YearN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadANNHeaders: Allocation failure #####" do XYear = 1, YearN YearAD (XYear) = XYear + Year0 - 1 end do end subroutine LoadANNHeaders !******************************************************************************* ! make titles to columns subroutine MakeANNColTitles (ColTitles) character (len=9), pointer, dimension (:) :: ColTitles integer :: XCol, ColN, ChosenCol integer :: QModify, ReadStatus print*, " > Modify column titles (1=no,2=yes) ? " do read (*,*,iostat=ReadStatus), QModify if (ReadStatus.LE.0.AND.QModify.GE.1.AND.QModify.LE.2) exit end do if (QModify.EQ.2) then ColN = size (ColTitles) print "(a16)", " COL TITLE" do XCol = 1, ColN print "(i7,a9)", XCol, ColTitles(XCol) end do do if (ColN.GT.1) then print*, " > Select column (0=all,-1=exit): " do read (*,*,iostat=ReadStatus), ChosenCol if (ReadStatus.LE.0.AND.ChosenCol.GE.-1.AND.ChosenCol.LE.ColN) exit end do else ChosenCol = 0 end if if (ChosenCol.EQ. 0) then do ChosenCol = 1, ColN print "(a44,i4)", " > Enter title (9 characters) for column: ", ChosenCol do read (*,*,iostat=ReadStatus), ColTitles(ChosenCol) if (ReadStatus.GT.0) print*, " > Not a string. Try again." if (ColTitles(ChosenCol).EQ."") print*, " > A blank. Try again." if (ColTitles(ChosenCol).NE."") ColTitles(ChosenCol) = adjustr(ColTitles(ChosenCol)) if (ReadStatus.LE.0.AND.ColTitles(ChosenCol).NE."") exit end do end do ChosenCol = -1 end if if (ChosenCol.GE. 1) then print*, " > Enter title (9 characters): " do read (*,*,iostat=ReadStatus), ColTitles(ChosenCol) if (ReadStatus.GT.0) print*, " > Not a string. Try again." if (ColTitles(ChosenCol).EQ."") print*, " > A blank. Try again." if (ColTitles(ChosenCol).NE."") ColTitles(ChosenCol) = adjustr(ColTitles(ChosenCol)) if (ReadStatus.LE.0.AND.ColTitles(ChosenCol).NE."") exit end do end if if (ChosenCol.EQ.-1) exit end do end if end subroutine MakeANNColTitles !******************************************************************************* end module ANNFiles