! makedaily.f90
! f90 program written by Tim Mitchell on 14.12.00
! last modified on 07.01.02
! tool to transform messy daily data sets into clean ones with a single formatting structure
! pgf90 -o ./../obs/makedaily filenames.f90 dayfiles.f90 time.f90 
!	cetgeneral.f90 ./../obs/makedaily.f90

program MakeDaily

use FileNames
use DAYFiles
use Time
use CETGeneral

implicit none

real, pointer, dimension (:,:,:)	:: MasterDaily, FileDaily

real, dimension (12)			:: LineReal

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

integer, dimension (12)			:: LineInt

real, parameter :: MissVal = -999.0

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

real :: BlockMissVal, Multiplier
real :: OpMiss, OpEn, OpFrac

integer :: ReadStatus, AllocStat,MenuChoice
integer :: StartYear, EndYear, FirstYear, MasterYearN
integer :: BlockYearN, BlockStartAD, BlockEndAD, BlockStartX, BlockEndX
integer :: XYear, XMonth, XDay, XHeader, XFooter, XFileYear, XMasterYear
integer :: HeaderN, FooterN, StringLen
integer :: FileYear0,FileYear1,MasterYear0,MasterYear1
integer :: VariCode,PosChar,OpDays,QIntReal,ArraySize

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

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

call Intro
call Select

contains

!*******************************************************************************
! check master array

subroutine CheckMaster

call GetMonthLengths (YearAD,MonthLengths)

OpMiss = 0.0
OpEn   = 0.0

do XYear = 1, MasterYearN
  do XMonth = 1, 12
    do XDay = 1, MonthLengths(XYear,XMonth)
      if (MasterDaily (XYear,XMonth,XDay) .NE. MissVal) then
        OpEn   = OpEn   + 1.0
      else
        OpMiss = OpMiss + 1.0
      end if
    end do
  end do
end do

OpFrac = 100.0 * OpMiss / (OpMiss + OpEn)
OpDays = OpMiss + OpEn

print "(a26,i8,f8.2)", "   > Data: days, missing%: ", OpDays, OpFrac
print*

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

end subroutine CheckMaster

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

subroutine Intro

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

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

print*, "  > We assume 12 months in a year and 31 days (max) in a month."
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 (YearAD(MasterYearN),stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure #####"

allocate (MasterDaily(MasterYearN,12,31),stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure #####"
MasterDaily = MissVal

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

VariCode = MissVal

print*

end subroutine Intro

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

subroutine LoadFromDAY

call LoadDAY      (Blank, VariCode, FileYearAD, FileDaily)

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
    do XDay = 1, 31
      MasterDaily(XMasterYear,XMonth,XDay) = FileDaily(XFileYear,XMonth,XDay)
    end do
  end do
end do

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

print*

end subroutine LoadFromDAY

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

subroutine LoadOriginal

BlockStartAD = FirstYear
BlockStartX  = FirstYear - StartYear + 1

open (2, file=OrigFile, status="old", access="sequential", form="formatted", action="read")
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
    
    print*, "  > We assume one line of data per day with intercept and 12 months."
    print*, "  > Enter the data line format, e.g. (a10,12i5) or (a4,12f8.1)"
    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.'F'.OR.CharIntReal.EQ.'f') 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 factor by which to multiply to obtain actual data: "
    do
	read (*,*,iostat=ReadStatus), Multiplier
	if (ReadStatus.LE.0) exit
    end do
    
    print*, "  > Enter the missing value: "
    do
	read (*,*,iostat=ReadStatus), BlockMissVal
	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
      
      do XDay = 1, 31					! read year
          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)
           
          if (BlockStartX.GE.1) then
            do XMonth = 1, 12
              if (LineInt(XMonth).NE.BlockMissVal.AND.LineReal(XMonth).NE.BlockMissVal) then
                if (QIntReal.EQ.1) MasterDaily (XYear,XMonth,XDay) = real (LineInt(XMonth))
                if (QIntReal.EQ.2) MasterDaily (XYear,XMonth,XDay) = LineReal(XMonth)
                MasterDaily (XYear,XMonth,XDay) = MasterDaily (XYear,XMonth,XDay) * Multiplier
!              else
!              	MasterDaily (XYear,XMonth,XDay) = MissVal
              end if
            end do
          end if	
      end do
      
      LineReal = 0
      LineInt  = 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

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

subroutine Select

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 LoadFromDAY
  else if (MenuChoice.EQ.4)  then
    call SaveDAY (Blank,VariCode,YearAD,MasterDaily)
    print*
  else if (MenuChoice.EQ.5)  then
    call CheckMaster
  else if (MenuChoice.NE.99) then
    print*, "  >  1. Reinitialise"
    print*, "  >  2. Load data from original file"
    print*, "  >  3. Load data from .day file"
    print*, "  >  4. Save to .day file"
    print*, "  >  5. Check master daily array"
    print*, "  > 99. Exit"
  end if
  
  if (MenuChoice.EQ.99) exit
end do

end subroutine Select

!*******************************************************************************
! 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*, "  > Enter the first year AD in the 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

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

end program MakeDaily