! makemonthlyeasy.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/makemonthlyeasy filenames.f90 perfiles.f90 time.f90 
!     	./../obs/makemonthlyeasy.f90 2> /tyn1/tim/scratch/stderr.txt

program MakeMonthlyEasy

use FileNames
use PerFiles
use Time
! use CETGeneral

implicit none

real, dimension (:,:), pointer 	:: MasterMonthly, FileMonthly
real, dimension (:,:), pointer	:: MasterSeasonal, FileSeasonal
real, dimension (:),   pointer	:: MasterAnnual, FileAnnual

real, dimension (12)			:: LineReal

integer, pointer, dimension (:,:)	:: MonthLengths
integer, pointer, dimension (:)		:: YearAD, FileYearAD

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*, "  > ##### MakeMonthlyEasy.f90 ##### 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*, "  > Are you sure? (1=no,2=yes)"
    do
	read (*,*,iostat=ReadStatus), MenuChoice
	if (ReadStatus.LE.0.AND.MenuChoice.GE.1.AND.MenuChoice.LE.2) exit
    end do
    if (MenuChoice.EQ.1) print*, "  > No changes made."
    if (MenuChoice.EQ.2) call Intro
  else if (MenuChoice.EQ.2)  then
    call SpecOriginal
    call LoadOriginal
  else if (MenuChoice.EQ.3)  then
    call LoadFromPER
  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.EQ.5)  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 SaveCETMON (Blank,VariCode,YearAD,MasterMonthly,MasterSeasonal,MasterAnnual)
    print*
  else if (MenuChoice.EQ.6)  then
    call DeriveSeaMon
  else if (MenuChoice.EQ.7)  then
    call DeriveAnnMon
  else if (MenuChoice.EQ.8)  then
    call DeriveAnnSea
  else if (MenuChoice.NE.99) then
    print*, "  >  1. Reinitialise"
    print*, "  >  2. Load data from raw file"
    print*, "  >  3. Load data from .per file"
    print*, "  >  4. Save to .per file"
    print*, "  >  5. Save to .mon file"
    print*, "  >  6. Derive seasonal from monthly  data"
    print*, "  >  7. Derive annual   from monthly  data"
    print*, "  >  8. Derive annual   from seasonal data"
    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 ( MasterMonthly (MasterYearN, 12), &
	   MasterSeasonal(MasterYearN,  4), &
	   MasterAnnual  (MasterYearN),      &
	   YearAD        (MasterYearN),     stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure #####"
print*, MasterYearN,size(MasterMonthly,1),size(MasterMonthly,2)
MasterMonthly  = MissVal
MasterSeasonal = MissVal
MasterAnnual   = MissVal

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
    
    print*, size(MasterMonthly)	! ###################
    
    do XYear = BlockStartX, BlockEndX
!      print*, XYear	! ######################
      
      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

!*******************************************************************************
! load from .day file

subroutine LoadFromPER

call LoadPER (Blank,VariCode,FileYearAD,FileMonthly,FileSeasonal,FileAnnual)

call CommonVecPer (FileYearAD,YearAD,FileYear0,FileYear1,MasterYear0,MasterYear1)

if (FileYear0.EQ.MissVal) then
  print*, "  > The loaded file has no period in common with the master array."
else
  print*, "  > Common period loaded into master array: ", FileYearAD(FileYear0), FileYearAD(FileYear1)
end if

do XFileYear = FileYear0, FileYear1
  XMasterYear = MasterYear0 + XFileYear - FileYear0
  
  do XMonth = 1, 12
      MasterMonthly(XMasterYear,XMonth) = FileMonthly(XFileYear,XMonth)
  end do
  
  do XSeason = 1, 4
      MasterSeasonal(XMasterYear,XSeason) = FileSeasonal(XFileYear,XSeason)
  end do
  
  MasterAnnual(XMasterYear) = FileAnnual(XFileYear)
end do

deallocate (FileYearAD,FileMonthly,FileSeasonal,FileAnnual, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadFromDAY: Deallocation failure #####"

print*

end subroutine LoadFromPER

!*******************************************************************************
! derive seasonal and annual data

subroutine DeriveSeaMon

if (VariCode.LT.-1.OR.VariCode.GT.2) then
  print*, "  > Enter the monthly 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

allocate (FileAnnual (MasterYearN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: DeriveSeaMon: Allocation failure #####"
FileAnnual = MissVal

! if (VariCode.EQ.-1) call FillSeaAnnMin  (YearAD,MasterMonthly,MasterSeasonal,FileAnnual)
! if (VariCode.EQ. 0) call FillSeaAnnMean (YearAD,MasterMonthly,MasterSeasonal,FileAnnual)
! if (VariCode.EQ. 1) call FillSeaAnnMax  (YearAD,MasterMonthly,MasterSeasonal,FileAnnual)
! if (VariCode.EQ. 2) call FillSeaAnnSum  (YearAD,MasterMonthly,MasterSeasonal,FileAnnual)

deallocate (FileAnnual,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: DeriveSeaMon: Deallocation failure #####"

print*

end subroutine DeriveSeaMon

!*******************************************************************************
! derive seasonal and annual data

subroutine DeriveAnnMon

if (VariCode.LT.-1.OR.VariCode.GT.2) then
  print*, "  > Enter the monthly 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

allocate (FileSeasonal (MasterYearN, 4), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: DeriveAnnMon: Allocation failure #####"
FileSeasonal = MissVal

! if (VariCode.EQ.-1) call FillSeaAnnMin  (YearAD,MasterMonthly,FileSeasonal,MasterAnnual)
! if (VariCode.EQ. 0) call FillSeaAnnMean (YearAD,MasterMonthly,FileSeasonal,MasterAnnual)
! if (VariCode.EQ. 1) call FillSeaAnnMax  (YearAD,MasterMonthly,FileSeasonal,MasterAnnual)
! if (VariCode.EQ. 2) call FillSeaAnnSum  (YearAD,MasterMonthly,FileSeasonal,MasterAnnual)

deallocate (FileSeasonal,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: DeriveAnnMon: Deallocation failure #####"

print*

end subroutine DeriveAnnMon

!*******************************************************************************
! derive seasonal and annual data

subroutine DeriveAnnSea

if (VariCode.LT.-1.OR.VariCode.GT.2) then
  print*, "  > Enter the seasonal 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

allocate (FileMonthly  (MasterYearN,12), &
	  FileSeasonal (MasterYearN, 4), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: DeriveAnnSea: Allocation failure #####"
FileMonthly = MissVal ; FileSeasonal = MissVal

do XYear = 1, MasterYearN
 do XSeason = 1, 4
  do XMonth = 1, 3
   ThisMonth = 2 + ((XSeason-1)*3) + XMonth
   ThisYear  = XYear
   if (ThisMonth.GT.12) then
     ThisYear = ThisYear + 1 ; ThisMonth = ThisMonth - 12  
   end if
   
   if (ThisYear.LE.MasterYearN) then
     FileMonthly (ThisYear,ThisMonth) = MasterSeasonal (XYear,XSeason)
   end if
  end do
 end do
end do

! if (VariCode.EQ.-1) call FillSeaAnnMin  (YearAD,FileMonthly,FileSeasonal,MasterAnnual)
! if (VariCode.EQ. 0) call FillSeaAnnMean (YearAD,FileMonthly,FileSeasonal,MasterAnnual)
! if (VariCode.EQ. 1) call FillSeaAnnMax  (YearAD,FileMonthly,FileSeasonal,MasterAnnual)
! if (VariCode.EQ. 2) call FillSeaAnnSum  (YearAD,FileMonthly,FileSeasonal,MasterAnnual)

deallocate (FileMonthly,FileSeasonal,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: DeriveAnnSea: Deallocation failure #####"

print*

end subroutine DeriveAnnSea

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