! updatejl.f90
! f90 program written by Tim Mitchell on 25.01.01
! last modified on 25.01.01
! tool to update standard .dat and .syn files from UKMO and text updates
! f90 -o ./../obs/updatejl filenames.f90 jldatfiles.f90 synfiles.f90 jlgeneral.f90 ./../obs/updatejl.f90

program UpdateJL

use FileNames
use JLDATFiles
use SYNFiles
use JLGeneral

implicit none

real, pointer, dimension (:,:,:,:)	:: Flow, FileFlow
real, pointer, dimension (:)		:: LineReal

integer, pointer, dimension (:,:,:)	:: Lamb, FileLamb, Jenk, FileJenk, Auto, FileAuto, FileData
integer, pointer, dimension (:,:)	:: MonthLengths
integer, pointer, dimension (:)		:: YearAD, FileYearAD, LineInt

real, parameter :: MissVal = -999.0

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

real :: BlockMissVal, Multiplier
real :: OpMiss, OpEn, OpFrac
real :: LambMiss,JenkMiss,AutoMiss,FlowMiss,LambFrac,JenkFrac,AutoFrac,FlowFrac 

integer :: ReadStatus, AllocStat, MenuChoice
integer :: StartYear, EndYear, FirstYear, YearN
integer :: BlockYearN, BlockStartAD, BlockEndAD, BlockStartX, BlockEndX
integer :: XYear, XMonth, XDay, XHeader, XFooter, XFileYear, XInt, XReal, XVari
integer :: Year, Month, Day, Pos31, BegMon, EndMon
integer :: HeaderN, FooterN, MonthN, DayN, VariN, StringLen, AbsentMonBegN, AbsentMonEndN
integer :: FileYear0,FileYear1,Year0,Year1
integer :: QComp, QIntFloat, QFileComp

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

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

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.10)  then
    call LoadFromSYN
  else if (MenuChoice.EQ.11)  then
    QComp = 1
    call LoadFromDAT
  else if (MenuChoice.EQ.12)  then
    QComp = 2
    call LoadFromDAT
  else if (MenuChoice.EQ.13)  then
    QComp = 3
    call LoadFromDAT
  else if (MenuChoice.EQ.14)  then
    QComp = 4
    call LoadOriginal
  else if (MenuChoice.EQ.15)  then
    QComp = 5
    call LoadOriginal
  else if (MenuChoice.EQ.20)  then
    call SaveSYN (Blank,YearAD,Lamb,Jenk,Auto,Flow)
    print*
  else if (MenuChoice.EQ.21)  then
    call SaveJLDAT (Blank,YearAD,Lamb)
    print*
  else if (MenuChoice.EQ.22)  then
    call SaveJLDAT (Blank,YearAD,Jenk)
    print*
  else if (MenuChoice.EQ.23)  then
    call SaveJLDAT (Blank,YearAD,Auto)
    print*
  else if (MenuChoice.EQ.30)  then
    call CheckMaster
  else if (MenuChoice.NE.99) then
    print*, "  >  1. Reinitialise"
    print*, "  > 10. Load data from .syn"
    print*, "  > 11. Load Lamb from .dat"
    print*, "  > 12. Load Jenk from .dat"
    print*, "  > 13. Load Auto from .dat"
    print*, "  > 14. Load data from UKMO update"
    print*, "  > 15. Load data from month per line file"
    print*, "  > 20. Save data to   .syn"
    print*, "  > 21. Save Lamb to   .dat"
    print*, "  > 22. Save Jenk to   .dat"
    print*, "  > 23. Save Auto to   .dat"
    print*, "  > 30. Check main arrays"
    print*, "  > 99. Exit"
  end if
  
  if (MenuChoice.EQ.99) exit
end do

call Conclude

contains

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

subroutine Intro

open (99,file="/cru/u2/f709762/data/scratch/log-ujl.dat",status="replace",action="write")

print*
print*, "  > ##### UpdateJL.f90 ##### Tool for updating synoptic data #####"
print*

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

YearN  = EndYear - StartYear + 1
MonthN = 12 ; DayN = 31 ; VariN  = 8

allocate ( Flow   (YearN, MonthN, DayN, VariN), &
	   Lamb   (YearN, MonthN, DayN),        &
	   Jenk   (YearN, MonthN, DayN),        &
	   Auto   (YearN, MonthN, DayN),        &
	   YearAD (YearN),                      stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure #####"
Flow = MissVal
Lamb = -9 ; Jenk = -9 ; Auto = -9

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

print*

end subroutine Intro

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

subroutine LoadOriginal

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(YearN)) then
	  ReadStatus = 99
	  print*, "  > Year beyond master array. Try again."
	end if
	if (ReadStatus.LE.0) exit
end do

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(YearN)) 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
  	if (QComp.EQ.4) call LoadUKMO
  	if (QComp.EQ.5) call LoadLineMon
  end if
  
  BlockStartAD = BlockEndAD + 1
  BlockStartX  = BlockEndX  + 1
  if (BlockStartAD.GT.YearAD(YearN)) then
    	print*, "  > End of block is also end of master array."
    	BlockYearN = 0
  end if

  if (BlockYearN.EQ.0) exit	
end do
close (2)

print*

end subroutine LoadOriginal

!*******************************************************************************
! load UKMO

subroutine LoadUKMO

print*, "  > Final year in block = ", BlockEndAD
BlockEndX = BlockEndAD - BlockStartAD + BlockStartX		! define BlockEndX
    
print*, "  > Enter the number of absent months at the start:"
do
	read (*,*,iostat=ReadStatus), AbsentMonBegN
	if (ReadStatus.LE.0) exit
end do
    
print*, "  > Enter the number of absent months at the end:"
do
	read (*,*,iostat=ReadStatus), AbsentMonEndN
	if (ReadStatus.LE.0) exit
end do
    
print*, "  > Enter the number of header lines per month:"
do
	read (*,*,iostat=ReadStatus), HeaderN
	if (ReadStatus.LE.0) exit
end do
    
print*, "  > Enter the number of footer lines per month:"
do
	read (*,*,iostat=ReadStatus), FooterN
	if (ReadStatus.LE.0) exit
end do
    
print*, "  > We assume one line of data per day (year,mon,day,Jenk,Auto,8*Flow)."
print*, "  > We assume that only existent days are included."
print*, "  > Enter the data line format, e.g. (i4,2i3,i4,i5,f9.1,4f7.1,3f8.1)"
do
	read (*,*,iostat=ReadStatus), LineFormat
	
	StringLen = len (trim(LineFormat))	
	if (LineFormat(1:1).NE."(" .OR. LineFormat(StringLen:StringLen).NE.")") then
	  ReadStatus = 99
	  print*, "  > Format is unacceptable. Retry."
	end if
	
	if (ReadStatus.LE.0) exit
end do
    
allocate ( LineInt      (2), &
	   LineReal (VariN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadUKMO: Allocation failure #####"

call GetMonthLengths (YearAD,MonthLengths)

do XYear = BlockStartX, BlockEndX
  BegMon = 1 ; EndMon = MonthN  
  if (XYear.EQ.BlockStartX) BegMon = 1+AbsentMonBegN
  if (XYear.EQ.BlockEndX)   EndMon = MonthN-AbsentMonEndN
  
  do XMonth = BegMon, EndMon
      if (HeaderN.GT.0) then				! read headers
        do XHeader = 1, HeaderN
          read  (2, *), Waste
        end do
      end if
      
      do XDay = 1, MonthLengths(XYear,XMonth)		! read day
        read  (2, LineFormat), Year, Month, Day, (LineInt(XInt),XInt=1,2), (LineReal(XReal),XReal=1,8)
          
        if (Year.GE.YearAD(1).AND.Year.LE.YearAD(YearN)) then
          Year = Year - YearAD(1) + 1
          
          Jenk (Year,Month,Day) = LineInt(1)
          Auto (Year,Month,Day) = LineInt(2)
          
          do XReal = 1, 8
            Flow (Year,XMonth,XDay,XReal) = LineReal(XReal)
          end do
        end if
      end do
      
      if (FooterN.GT.0) then				! read footers
        do XFooter = 1, FooterN
          read  (2, *), Waste
        end do
      end if
  end do
end do
    
deallocate (LineInt,LineReal,MonthLengths, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadUKMO: Deallocation failure #####"

end subroutine LoadUKMO

!*******************************************************************************
! load from raw data file with one month of data per line

subroutine LoadLineMon

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*, "  > Enter the number of absent months at the start:"
do
	read (*,*,iostat=ReadStatus), AbsentMonBegN
	if (ReadStatus.LE.0) exit
end do
    
print*, "  > Enter the number of absent months at the end:"
do
	read (*,*,iostat=ReadStatus), AbsentMonEndN
	if (ReadStatus.LE.0) exit
end do
    
QIntFloat = 0
    
print*, "  > We assume one line of data per month (31 days)."
print*, "  > Enter the data line format, e.g. (31i3 or 31f7.1)"
do
	read (*,*,iostat=ReadStatus), LineFormat
	
	StringLen = len (trim(LineFormat))	
	Pos31     = index (LineFormat,'31')
	IntFloat  = LineFormat ((Pos31+2):(Pos31+2))
	
	if      (LineFormat(1:1).NE."(" .OR. LineFormat(StringLen:StringLen).NE.")") then
	  print*, "  > Brackets are incorrect. Try again."
	else if (Pos31.EQ.0) then
	  print*, "  > '31' must be included in the format. Try again."
	else if (IntFloat.EQ.'I'.OR.IntFloat.EQ.'i') then
	  print*, "  > Data recognised as integers."
	  QIntFloat = 1
	else if (IntFloat.EQ.'F'.OR.IntFloat.EQ.'f') then
	  print*, "  > Data recognised as reals."	
	  QIntFloat = 2
	else if (IntFloat.EQ.'E'.OR.IntFloat.EQ.'e') then
	  print*, "  > Data recognised as reals."
	  QIntFloat = 2
	else
	  print*, "  > Data format not recognised as integer or real. Try again."
	end if
	
	if (ReadStatus.LE.0) exit
end do

if      (QIntFloat.EQ.1) then
  print*, "  > Enter the variable: original LWT (=1), Jenk-Lamb LWT (=2), Jenk auto (=3): " 
  do
	read (*,*,iostat=ReadStatus), QFileComp
	if (ReadStatus.LE.0.AND.QFileComp.GE.1.AND.QFileComp.LE.3) exit
  end do    
else if (QIntFloat.EQ.2) then
  print*, "  > Enter the variable (1...8 = PM-1000,W,S,F,D,ZW,ZS,Z): " 
  do
	read (*,*,iostat=ReadStatus), QFileComp
	if (ReadStatus.LE.0.AND.QFileComp.GE.1.AND.QFileComp.LE.8) exit
  end do    
end if
    
do XYear = BlockStartX, BlockEndX
  if (HeaderN.GT.0) then				! read headers
    do XHeader = 1, HeaderN
          read  (2, *), Waste
    end do
  end if
      
  BegMon = 1 ; EndMon = MonthN  
  if (XYear.EQ.BlockStartX) BegMon = 1+AbsentMonBegN
  if (XYear.EQ.BlockEndX)   EndMon = MonthN-AbsentMonEndN
    
  do XMonth = BegMon, EndMon				! read months
    if      (QIntFloat.EQ.1) then
      if (QFileComp.EQ.1) read (2,LineFormat), (Lamb(XYear,XMonth,XDay), XDay=1,DayN)
      if (QFileComp.EQ.2) read (2,LineFormat), (Jenk(XYear,XMonth,XDay), XDay=1,DayN)
      if (QFileComp.EQ.3) read (2,LineFormat), (Auto(XYear,XMonth,XDay), XDay=1,DayN)
    else if (QIntFloat.EQ.2) then
      read (2,LineFormat), (Flow(XYear,XMonth,XDay,QFileComp), XDay=1,DayN)
    end if 
  end do

  if (FooterN.GT.0) then				! read footers
    do XFooter = 1, FooterN
          read  (2, *), Waste
    end do
  end if
end do
    
end subroutine LoadLineMon

!*******************************************************************************
! load from .dat file

subroutine LoadFromDAT

call LoadJLDAT    (Blank,FileYearAD,FileData)

call CommonVecPer (FileYearAD,YearAD,FileYear0,FileYear1,Year0,Year1)

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
  XYear = Year0 + XFileYear - FileYear0
  
  do XMonth = 1, MonthN
    do XDay = 1, DayN
      if (QComp.EQ.1) Lamb(XYear,XMonth,XDay) = FileData(XFileYear,XMonth,XDay)
      if (QComp.EQ.2) Jenk(XYear,XMonth,XDay) = FileData(XFileYear,XMonth,XDay)
      if (QComp.EQ.3) Auto(XYear,XMonth,XDay) = FileData(XFileYear,XMonth,XDay)
    end do
  end do
end do

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

print*

end subroutine LoadFromDAT

!*******************************************************************************
! load from .syn file

subroutine LoadFromSYN

call LoadSYN      (Blank,FileYearAD,FileLamb,FileJenk,FileAuto,FileFlow)

call CommonVecPer (FileYearAD,YearAD,FileYear0,FileYear1,Year0,Year1)

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
  XYear = Year0 + XFileYear - FileYear0
  
  do XMonth = 1, MonthN
    do XDay = 1, DayN
      Lamb(XYear,XMonth,XDay) = FileLamb(XFileYear,XMonth,XDay)
      Jenk(XYear,XMonth,XDay) = FileJenk(XFileYear,XMonth,XDay)
      Auto(XYear,XMonth,XDay) = FileAuto(XFileYear,XMonth,XDay)
      
      do XVari = 1, VariN
        Flow(XYear,XMonth,XDay,XVari) = FileFlow(XFileYear,XMonth,XDay,XVari)
      end do
    end do
  end do
end do

deallocate (FileYearAD,FileLamb,FileJenk,FileAuto,FileFlow, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadFromSYN: Deallocation failure #####"

print*

end subroutine LoadFromSYN

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

subroutine CheckMaster

call GetMonthLengths (YearAD,MonthLengths)

OpEn     = 0.0
LambMiss = 0.0 ; JenkMiss = 0.0 ; AutoMiss = 0.0 ; FlowMiss = 0.0

do XYear = 1, YearN
  do XMonth = 1, MonthN
    do XDay = 1, MonthLengths(XYear,XMonth)
      OpEn       = OpEn     + 1.0

      if (Lamb (XYear,XMonth,XDay) .EQ. -9) LambMiss = LambMiss + 1.0
      if (Jenk (XYear,XMonth,XDay) .EQ. -9) JenkMiss = JenkMiss + 1.0
      if (Auto (XYear,XMonth,XDay) .EQ. -9) AutoMiss = AutoMiss + 1.0
      
      do XVari = 1, VariN
        if (Flow (XYear,XMonth,XDay,XVari) .EQ. MissVal) FlowMiss = FlowMiss + 1.0
      end do      
    end do
  end do
end do

LambFrac = 100.0 * LambMiss /  OpEn
JenkFrac = 100.0 * JenkMiss /  OpEn
AutoFrac = 100.0 * AutoMiss /  OpEn
FlowFrac = 100.0 * FlowMiss / (OpEn*VariN)

print "(a38,f10.2)", "   > Number of days in main array:    ",   OpEn
print "(a40,4f8.2)", "   > Missing % for Lamb,Jenk,Auto,Flow: ", LambFrac,JenkFrac,AutoFrac,FlowFrac
print*

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

end subroutine CheckMaster

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

subroutine Conclude

deallocate (YearAD,Lamb,Jenk,Auto,Flow,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Conclude: Deallocation failure #####"

close (99)

print*

end subroutine Conclude

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

end program UpdateJL