! loadrawmonth.f90
! f90 program written by Tim Mitchell on 19.12.00
! last modified on 04.01.02
! tool to transform messy monthly data sets into clean ones with a 
!	single formatting structure
! pgf90 -Mstandard -Minfo -fast -Mscalarsse -Mvect=sse -Mflushz 
! 	-o ./../obs/loadrawmonth filenames.f90 perfiles.f90 
!     	./../obs/loadrawmonth.f90 2> /tyn1/tim/scratch/stderr.txt

program LoadRawMonth

use FileNames
use SavePerFiles

implicit none

real, dimension (:,:), pointer 	:: MasterMonthly,FileMonthly,MasterSeasonal,FileSeasonal
real, dimension (:),   pointer	:: MasterAnnual, FileAnnual
real, dimension (:,:), allocatable, target :: Monthly,Seasonal
real, dimension (:),   allocatable, target :: Annual

real, dimension (12)			:: LineReal

integer, pointer, dimension (:,:)	:: MonthLengths
integer, pointer, dimension (:)		:: YearAD, FileYearAD
integer, allocatable, dimension (:), target	:: YearTarg

integer, dimension (12)			:: LineInt, LineData
integer, dimension (4)			:: RawSeaCode

real, parameter :: MissVal = -999.0

character (len=80), parameter :: Blank = ""

real :: BlockMissVal, Multiplier

integer :: ReadStatus, AllocStat
integer :: MenuChoice
integer :: StartYear, EndYear, FirstYear, MasterYearN,FileHeadN,XFileHead
integer :: BlockYearN, BlockStartAD, BlockEndAD, BlockStartX, BlockEndX
integer :: XYear, XMonth, XDay, XHeader, XFooter, XFileYear, XMasterYear, XSeason
integer :: HeaderN, FooterN, StringLen, MastYear,MastSeas, ThisYear,ThisMonth
integer :: FileYear0,FileYear1,MasterYear0,MasterYear1
integer :: VariCode,PosChar
integer :: QIntReal,QLineYearMon,QMonSea,QFirstSea

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

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

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

print*
print*, "  > ##### LoadRawMonth = tool for reformatting #####"
print*

call Intro

do
  print*, "  > Main menu. Make your choice. (0=list)"
  do
	read (*,*,iostat=ReadStatus), MenuChoice
	if (ReadStatus.LE.0) exit
  end do
  
  if      (MenuChoice.EQ.1)  then
    print*, "...ignore..."
  else if (MenuChoice.EQ.2)  then
    call SpecOriginal
    call LoadOriginal
  else if (MenuChoice.EQ.4)  then
    if (VariCode.LT.-1.OR.VariCode.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
    end if
    call SavePER (Blank,YearAD,VariCode,Monthly=MasterMonthly, &
    		  Seasonal=MasterSeasonal,Annual=MasterAnnual)
    print*
  else if (MenuChoice.NE.99) then
    print*, "  >  1. Reinitialise"
    print*, "  >  2. Load data from raw file"
    print*, "  >  4. Save to .per file"
    print*, "  > 99. Exit"
  end if
  
  if (MenuChoice.EQ.99) exit
end do

call Conclude

contains

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

subroutine Intro

print*, "  > Enter the start and end years AD of the master array:"
do
	read (*,*,iostat=ReadStatus), StartYear, EndYear
	if (ReadStatus.LE.0 .AND. StartYear.LE.EndYear) exit
end do

MasterYearN = EndYear - StartYear + 1

allocate ( Monthly (MasterYearN, 12), &
	   Seasonal(MasterYearN,  4), &
	   Annual  (MasterYearN),     &
	   YearTarg(MasterYearN),     stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure #####"
Monthly=MissVal ; Seasonal=MissVal ; Annual=MissVal
MasterMonthly  => Monthly
MasterSeasonal => Seasonal
MasterAnnual   => Annual
YearAD         => YearTarg

do XYear = 1, MasterYearN
  YearAD (XYear) = StartYear + XYear - 1
end do

VariCode = MissVal

print*

end subroutine Intro

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

subroutine SpecOriginal

print*, "  > Enter the original file path/name:"
do
	do
		read (*,*,iostat=ReadStatus), GivenFile
		if (ReadStatus.LE.0) exit
	end do
	
	inquire (file=GivenFile, name=OrigFile)
	open (1, file=OrigFile, status="old", access="sequential", form="formatted", &
			action="read", iostat=ReadStatus)
	if (ReadStatus .NE. 0) print*, "  > Cannot open file. Try again."
	if (ReadStatus .EQ. 0) close (1)
	if (ReadStatus .EQ. 0) exit
end do

print*, "  > Identify the content: months (=1) or seasons (=2) ?"
do
	read (*,*,iostat=ReadStatus), QMonSea
	if (ReadStatus.LE.0.AND.QMonSea.GE.1.AND.QMonSea.LE.2) exit
end do

if      (QMonSea.EQ.1) then
  print*, "  > Identify the structure: one line per year (=1) or month (=2) ?"
  do
	read (*,*,iostat=ReadStatus), QLineYearMon
	if (ReadStatus.LE.0.AND.QLineYearMon.GE.1.AND.QLineYearMon.LE.2) exit
  end do
  if (QLineYearMon.EQ.2) print*, "  > The start=Jan & end=Dec: raw files may need padding." 
else if (QMonSea.EQ.2) then
  print*, "  > Identify the structure: one line per year (=1) or season (=2) ?"
  do
	read (*,*,iostat=ReadStatus), QLineYearMon
	if (ReadStatus.LE.0.AND.QLineYearMon.GE.1.AND.QLineYearMon.LE.2) exit
  end do

  print*, "  > Is the raw file MAM,JJA,SON,DJF (=1) or DJF,MAM,JJA,SON (=2) ?"
  do
	read (*,*,iostat=ReadStatus), QFirstSea
	if (ReadStatus.LE.0.AND.QFirstSea.GE.1.AND.QFirstSea.LE.2) exit
  end do
  
  if (QFirstSea.EQ.1) RawSeaCode = (/1,2,3,4/)
  if (QFirstSea.EQ.2) RawSeaCode = (/0,1,2,3/)
  
  if (QLineYearMon.EQ.2.AND.QFirstSea.EQ.1) print*, "  > The start=MAM & end=DJF: raw files may need padding."
  if (QLineYearMon.EQ.2.AND.QFirstSea.EQ.2) print*, "  > The start=DJF & end=SON: raw files may need padding."
end if

print*, "  > Enter the no. file headers: "
do
	read (*,*,iostat=ReadStatus), FileHeadN
	if (ReadStatus.LE.0.AND.FileHeadN.GE.0) exit
end do

print*, "  > Enter the first year AD in the raw file: "
do
	read (*,*,iostat=ReadStatus), FirstYear
	if (FirstYear.GT.YearAD(MasterYearN)) then
	  ReadStatus = 99
	  print*, "  > Year beyond master array. Try again."
	end if
	if (ReadStatus.LE.0) exit
end do

end subroutine SpecOriginal

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

subroutine LoadOriginal

BlockStartAD = FirstYear
BlockStartX  = FirstYear - StartYear + 1

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

if (FileHeadN.GT.0) then
  do XfileHead=1,FileHeadN
    read  (2, *), Waste
  end do
end if

do
  print*
  print*, "  > New block. First year in block = ", BlockStartAD

  if (BlockStartAD.LT.YearAD(1)) then		! define BlockYearN, BlockEndAD
    BlockYearN = YearAD(1) - BlockStartAD
    BlockEndAD = BlockStartAD + BlockYearN - 1
    print*, "  > Block predates master array. Block length = ", BlockYearN
  else
    print*, "  > Enter the number of years in the block (0=end):"
    do
	read (*,*,iostat=ReadStatus), BlockYearN

	BlockEndAD = BlockStartAD + BlockYearN - 1	
	if (BlockEndAD.GT.YearAD(MasterYearN)) then
	  ReadStatus = 99
	  print*, "  > Block extends beyond master array. Try again."
	end if
	
	if (ReadStatus.LE.0) exit
    end do
  end if
  
  if (BlockYearN.NE.0) then
    print*, "  > Final year in block = ", BlockEndAD
    BlockEndX = BlockEndAD - BlockStartAD + BlockStartX		! define BlockEndX
    
    print*, "  > Enter the number of header lines per year:"
    do
	read (*,*,iostat=ReadStatus), HeaderN
	if (ReadStatus.LE.0) exit
    end do
    
    print*, "  > Enter the number of footer lines per year:"
    do
	read (*,*,iostat=ReadStatus), FooterN
	if (ReadStatus.LE.0) exit
    end do
    
    if      (QMonSea.EQ.1) then
      if (QLineYearMon.EQ.1) print*, "  > Enter the data line format, e.g. (a10,12i5) or (a4,12f8.1)"
      if (QLineYearMon.EQ.2) print*, "  > Enter the data line format, e.g. (a10,1i5) or (a4,1f8.1)"
    else if (QMonSea.EQ.2) then
      if (QLineYearMon.EQ.1) print*, "  > Enter the data line format, e.g. (a10,4i5) or (a4,4f8.1)"
      if (QLineYearMon.EQ.2) print*, "  > Enter the data line format, e.g. (a10,1i5) or (a4,1f8.1)"
    end if
    
    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), BlockMissVal
	if (ReadStatus.LE.0) exit
    end do
    
    print*, "  > Enter the multiplier: "
    do
	read (*,*,iostat=ReadStatus), Multiplier
	if (ReadStatus.LE.0) exit
    end do
    
    do XYear = BlockStartX, BlockEndX
      if (HeaderN.GT.0) then				! read headers
        do XHeader = 1, HeaderN
          read  (2, *), Waste
        end do
      end if
      
      if      (QMonSea.EQ.1) then
       if      (QLineYearMon.EQ.1) then
        if (QIntReal.EQ.1) read (2, LineFormat), Waste, (LineInt  (XMonth), XMonth=1,12)
        if (QIntReal.EQ.2) read (2, LineFormat), Waste, (LineReal (XMonth), XMonth=1,12)
       else if (QLineYearMon.EQ.2) then
        do XMonth = 1, 12
          if (QIntReal.EQ.1) read (2, LineFormat), Waste, LineInt  (XMonth)
          if (QIntReal.EQ.2) read (2, LineFormat), Waste, LineReal (XMonth)
        end do
       end if
      else if (QMonSea.EQ.2) then
       if      (QLineYearMon.EQ.1) then
        if (QIntReal.EQ.1) read (2, LineFormat), Waste, (LineInt  (XSeason), XSeason=1,4)
        if (QIntReal.EQ.2) read (2, LineFormat), Waste, (LineReal (XSeason), XSeason=1,4)
       else if (QLineYearMon.EQ.2) then
        do XSeason = 1, 4
          if (QIntReal.EQ.1) read (2, LineFormat), Waste, LineInt  (XSeason)
          if (QIntReal.EQ.2) read (2, LineFormat), Waste, LineReal (XSeason)
        end do
       end if
      end if
      
      if (BlockStartX.GE.1) then
          if      (QMonSea.EQ.1) then
            do XMonth = 1, 12
              if (LineInt(XMonth).NE.BlockMissVal.AND.LineReal(XMonth).NE.BlockMissVal) then
                if (QIntReal.EQ.1) MasterMonthly (XYear,XMonth) = real (LineInt(XMonth))
                if (QIntReal.EQ.2) MasterMonthly (XYear,XMonth) = LineReal(XMonth)
                MasterMonthly (XYear,XMonth) = MasterMonthly (XYear,XMonth) * Multiplier
              else
              	MasterMonthly (XYear,XMonth) = MissVal
              end if
            end do
          else if (QMonSea.EQ.2) then
            do XSeason = 1, 4
              if (RawSeaCode(XSeason).GE.1) then
              	MastYear = XYear   ; MastSeas = RawSeaCode(XSeason)
              else
              	MastYear = XYear-1 ; MastSeas = 4
              end if
              
              if (MastYear.GE.1) then
               if (LineInt(XSeason).NE.BlockMissVal.AND.LineReal(XSeason).NE.BlockMissVal) then
                if (QIntReal.EQ.1) MasterSeasonal (MastYear,MastSeas) = real (LineInt(XSeason))
                if (QIntReal.EQ.2) MasterSeasonal (MastYear,MastSeas) = LineReal(XSeason)
                MasterSeasonal (MastYear,MastSeas) = MasterSeasonal (MastYear,MastSeas) * Multiplier
               else
              	MasterSeasonal (MastYear,MastSeas) = MissVal
               end if
              else
               print*, "  > ***** data error: first data DJF outside master range *****" 
              end if
            end do
          end if
      end if	
      
      LineInt  = 0
      LineReal = 0
      
      if (FooterN.GT.0) then				! read footers
        do XFooter = 1, FooterN
          read  (2, *), Waste
        end do
      end if
    end do
    
    BlockStartAD = BlockEndAD + 1
    BlockStartX  = BlockEndX  + 1
    if (BlockStartAD.GT.YearAD(MasterYearN)) then
    	print*, "  > End of block is also end of master array."
    	BlockYearN = 0
    end if
  end if
  
  if (BlockYearN.EQ.0) exit	
end do
close (2)

print*

end subroutine LoadOriginal

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

subroutine Conclude

deallocate (MasterMonthly,MasterSeasonal,MasterAnnual,YearAD,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Conclude: Deallocation failure #####"

close (99)

print*

end subroutine Conclude

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

end program LoadRawMonth