! makeannualeasy.f90
! f90 program written by Tim Mitchell on 19.12.00
! last modified on 01.11.01
! tool to transform messy annual data sets with multi-variables into .ann format
! pgf90 -Mstandard -Minfo -fast -Mscalarsse -Mvect=sse -Mflushz 
! 	-o ./../obs/makeannualeasy filenames.f90 annfiles.f90 
!	./../obs/makeannualeasy.f90 2> /tyn1/tim/scratch/stderr.txt

program MakeMonthlyEasy

use FileNames
use ANNFiles

implicit none

real, pointer 			:: Data (:,:)
real, pointer			:: LineReal (:)

integer, pointer		:: YearAD (:)
integer, pointer		:: LineInt (:)

character (len=9), pointer	:: ColTitles (:)

real, parameter :: MissVal = -999.0

character (len=80), parameter :: BlankFile = ""
character (len= 4), parameter :: BlankSuffix = "    "

real :: OrigMissVal, Multiplier

integer :: ReadStatus, AllocStat
integer :: XYear, XMonth, XDay, XHeader, XFooter, XFileYear, XMasterYear, XSeason, XCol
integer :: ColN, YearN, Year0, HeaderN, FooterN, StringLen
integer :: VariCode,PosChar
integer :: QIntReal

character (len=80) :: SaveFile, OrigFile, LineFormat, Waste
character (len=1)  :: CharIntReal

!*******************************************************************************
! main

call Intro
call SpecOriginal
call PrepLoad
call SpecSave 						
call LoadOriginal 					
call SaveANN (SaveFile, YearAD, ColTitles, Data) 	
call Conclude 					

contains

!*******************************************************************************
! intro

subroutine Intro

open (99,file="/tyn1/tim/scratch/log-mae.dat",status="replace",action="write")

print*
print*, "  > ##### MakeAnnualEasy.f90 ##### Tool for reformatting #####"
print*

end subroutine Intro

!*******************************************************************************
! spec original

subroutine SpecOriginal

print*, "  > Select the original file."
OrigFile = LoadPath (BlankFile,BlankSuffix)

print*, "  > Enter the number of columns of data in the file:"
do
	read (*,*,iostat=ReadStatus), ColN
	if (ReadStatus.LE.0.AND.ColN.GE.1) exit
end do
    
print*, "  > Enter the number of header lines in the file:"
do
	read (*,*,iostat=ReadStatus), HeaderN
	if (ReadStatus.LE.0.AND.HeaderN.GE.0) exit
end do
    
print*, "  > Enter the number of years (lines) in the file:"
do
	read (*,*,iostat=ReadStatus), YearN
	if (ReadStatus.LE.0.AND.YearN.GE.1) exit
end do
    
print*, "  > Enter the first year:"
do
	read (*,*,iostat=ReadStatus), Year0
	if (ReadStatus.LE.0) exit
end do
    
print*, "  > Enter the format of the data: '(A?,?x?)' x=I,F,E: "
do
	read (*,*,iostat=ReadStatus), LineFormat
	
	StringLen   = len (trim(LineFormat))	
        
	PosChar = max (scan(LineFormat,'I'),scan(LineFormat,'i'),scan(LineFormat,'F'),scan(LineFormat,'f'))
	PosChar = max (scan(LineFormat,'E'),scan(LineFormat,'e'),PosChar)
	
	CharIntReal = ""
	if (PosChar.GT.0) CharIntReal = LineFormat(PosChar:PosChar)
	
	if (LineFormat(1:1).NE."(" .OR. LineFormat(StringLen:StringLen).NE.")") then
	    ReadStatus = 99
	    print*, "  > Format is unacceptable. Retry."
	else 
	  if      (CharIntReal.EQ.'I'.OR.CharIntReal.EQ.'i') then
	    QIntReal = 1
	  else if (CharIntReal.EQ.'F'.OR.CharIntReal.EQ.'f') then
	    QIntReal = 2
	  else if (CharIntReal.EQ.'E'.OR.CharIntReal.EQ.'e') then
	    QIntReal = 2
	  else
	    ReadStatus = 99
	    print*, "  > Format is unacceptable. Retry."
	  end if
	end if
	
	if (ReadStatus.LE.0) exit
end do
    
print*, "  > Enter the missing value: "
do
	read (*,*,iostat=ReadStatus), OrigMissVal
	if (ReadStatus.LE.0) exit
end do
    
print*, "  > Enter the multiplier: "
do
	read (*,*,iostat=ReadStatus), Multiplier
	if (ReadStatus.LE.0) exit
end do

end subroutine SpecOriginal

!*******************************************************************************
! prepare to load

subroutine PrepLoad

allocate ( Data     (YearN,ColN), &
	   YearAD   (YearN),      &
	   LineReal (ColN),       &
	   LineInt  (ColN),       &
	   ColTitles(ColN),       stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: PrepLoad: Allocation failure #####"
Data = MissVal ; ColTitles = "X"

print*, YearN,ColN,size(Data,1),size(Data,2)		! ########################

do XYear = 1, YearN
  YearAD (XYear) = Year0 + XYear - 1
end do

end subroutine PrepLoad

!*******************************************************************************
! spec save file

subroutine SpecSave

print*, "  > Select the .ann file to save."
SaveFile = SavePath (BlankFile,'.ann')

print*, "  > Enter the title (max=9char,'X'=miss) for each column in turn: "
do XCol = 1, ColN
  do
  	read (*,*,iostat=ReadStatus), ColTitles(XCol)
  	if (ColTitles(XCol).EQ."") Readstatus=1
  	if (ReadStatus.GT.0) print*, "  > Unacceptable entry, Try again."
	if (ReadStatus.LE.0) exit
  end do
end do
    
end subroutine SpecSave

!*******************************************************************************
! load original

subroutine LoadOriginal

open (2, file=OrigFile, status="old", access="sequential", form="formatted", action="read")

print*, "  > Loading headers..."
if (HeaderN.GT.0) then				! read headers
        do XHeader = 1, HeaderN
          read  (2, *), Waste
        end do
end if

print*, "  > Loading data...", QIntReal,size(Data),size(LineReal)
do XYear = 1,YearN      			! read data
      write (99,"(i4)"), XYear		! ########################
      
      LineInt = OrigMissVal ; LineReal = OrigMissVal

      if (QIntReal.EQ.1) read (2, LineFormat), Waste, (LineInt  (XCol), XCol=1,ColN)
      if (QIntReal.EQ.2) read (2, LineFormat), Waste, (LineReal (XCol), XCol=1,ColN)
      
      do XCol = 1, ColN
              if (LineInt(XCol).NE.OrigMissVal.OR.LineReal(XCol).NE.OrigMissVal) then
                if (QIntReal.EQ.1) Data (XYear,XCol) = real (LineInt(XCol))
                if (QIntReal.EQ.2) Data (XYear,XCol) = LineReal(XCol)
                Data (XYear,XCol) = Data (XYear,XCol) * Multiplier
              else
              	Data (XYear,XCol) = MissVal
              end if
      end do      
end do

close (2)

end subroutine LoadOriginal

!*******************************************************************************
! conclude

subroutine Conclude

deallocate (Data,YearAD,LineInt,LineReal,ColTitles,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Conclude: Deallocation failure #####"

close (99)

print*

end subroutine Conclude

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

end program MakeMonthlyEasy