! annfiles.f90
! module in which standard save to and load from .ann file routines are held
! contains: MakeANNColTitles, LoadANN, SaveANN
! This file has been modified by Soenke Zaehle (PIK) on 30.07.02 for use with XLF compiler
! (PIK). changes are: 
! - removed "," after read and write statements
! - replaced SCRATCH statements with REPLACE statements


module ANNFiles

use FileNames

implicit none

contains

!*******************************************************************************
! 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
character (len= 4) 	:: 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
      
open   (1,file="col-scratch.txt",status="replace")  
write  (1,"(i4)") ColN 
rewind (1)
read   (1,"(a4)") ColNText
close  (1)

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,file="year-scratch.txt",status="replace")  
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,file="year-scratch.txt",status="replace")  
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

!*******************************************************************************
! 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)  
  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

!*******************************************************************************

end module ANNFiles