! SetupSP.f90
! written by Tim Mitchell on 20.11.01
! last modified on 20.11.01
! program to set up scalepattern.f90
! f90 -o ./../grim/setupSP filenames.f90 initialmod.f90 time.f90 grimfiles.f90 grid.f90 ./../grim/setupSP.f90

program SetupSP

use FileNames
use InitialMod
use Time
use GrimFiles
use Grid

implicit none

integer, pointer, dimension (:,:)		:: RefGrid, LoadGrid, MapIDLReg
integer, pointer, dimension (:)			:: YearAD, LoadYearAD, RegSizes
integer, pointer, dimension (:)			:: DumpYear		! periods to dump

character (len=80), pointer, dimension (:)	:: ExecKay1File,ExecKay2File,ExecGloTFile,ExecEquTFile
character (len=80), pointer, dimension (:)	:: ExecTargFile,ExecBaseFile
character (len=80), pointer, dimension (:)	:: DumpRegSet,TextRegSet  ! region sets to dump
character (len=20), pointer, dimension (:) 	:: RegNames,ExecName
character (len= 9),  pointer, dimension(:)	:: ColTitles

real, dimension (4)				:: Bounds, LoadBounds

integer, dimension (3)				:: DumpStat
integer, dimension (17)				:: DumpCal

character (len=3), dimension (17), parameter	:: SeasonNames = ['jan','feb','mar','apr','may','jun','jul',&
						'aug','sep','oct','nov','dec','MAM','JJA','SON','DJF','ann']

character (len=3), dimension (3), parameter	:: StatsText = ['est','mod','dif']

real, parameter 	:: MissVal = -999.0
integer, parameter 	:: SeasonN=17, MonthN=12, BoundN=4, StatN=3

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

real :: MissAccept, MissThresh, OpTot, OpEn, OpMiss

integer :: ReadStatus, AllocStat
integer :: ExecN, BoxN, ExeN, WyeN, YearN, LoadYearN, SliceN, DumpYearN, DumpRegSetN, RegN
integer :: XExec, XBox, XExe, XWye, XYear, XLoadYear, XSlice, XDumpYear, XDumpRegSet, XReg
integer :: XSeason, XMonth, XBound, XStat
integer :: PerLen, GapLen, YearAD0, YearAD1, YearLimit, CheckBoxN, ThisYear, ThisMonth
integer :: QMethod,QCompare,QMeanSum,QDumpGrip,QDumpGlo,QDumpAgg,QDumpGrim,QDumpPer,QDumpGlobe
integer :: Year0,Year1,LoadYear0,LoadYear1, GridChosen
integer :: StringBeg,FileSubBeg,SubLen

character (len=80) :: LoadInfo,LoadFile,SaveInfo,SaveFile,GivenFile,SpecFile
character (len=80) :: TextDir,TextInfo,TextTarg,TextPatt,TextGrid,TextGCM
character (len=20) :: TextYear
character (len= 4) :: LoadSuffix,SaveSuffix,CheckSuffix,Variable,OrigSub,SpecSub

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

call Intro
call PrescribeSpec
call SetupExec
call FirstExec
call AutoSpec
call SaveSpec
call SaveOpsFile
call Finish

contains

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

subroutine Intro

open (99,file="/cru/mikeh1/f709762/scratch/log/log-setupSP.dat",status="replace",action="write")
print*
print*, "  > ***** SetupSP: sets up ScalePattern *****"
print*

end subroutine Intro

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

subroutine PrescribeSpec

print*, "  > INITIALISATION."

print*, "  > Enter the filepath of the operations file (.ops): "
print*, "  >   /cru/mikeh1/f709762/f90/grim/_ref/ops/scalepattern.??.ops"
do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0.AND.GivenFile.NE."") exit
end do
SpecFile = SavePath (GivenFile,".ops")
SpecFile = trim(SpecFile) // ".X"

print*, "  > Enter the number of variables for which to calc patterns: "
do
	read (*,*,iostat=ReadStatus), ExecN
	if (ReadStatus.LE.0.AND.ExecN.GE.1) exit
end do

print*, "  > Specify a grim containing the relevant grid and bounds."
call GrabGrid (1,RefGrid,Bounds,BoxN)
ExeN = size (RefGrid,1) ; WyeN = size (RefGrid,2)

print*, "  > Give a one-word name for the grid: "			! get grid name
do
	read (*,*,iostat=ReadStatus), TextGrid
	if (ReadStatus.LE.0.AND.TextGrid.NE."") exit
end do

print*, "  > Give a one-word name for the GCM: "			! get grid name
do
	read (*,*,iostat=ReadStatus), TextGCM
	if (ReadStatus.LE.0.AND.TextGCM.NE."") exit
end do

print*, "  > Specify the period to estimate (first,last years AD):"
do
	read (*,*,iostat=ReadStatus), YearAD0, YearAD1
	if (ReadStatus.LE.0.AND.YearAD0.LE.YearAD1) exit
end do
YearN = YearAD1 - YearAD0 + 1

print*, "  > CALCULATION DETAILS."

print*, "  > Enter the period length to emphasise: "
do
	read (*,*,iostat=ReadStatus), PerLen
	if (ReadStatus.LE.0.AND.PerLen.GE.1) exit
end do

print*, "  > Enter the percentage of missing values that is acceptable: "
do
	read (*,*,iostat=ReadStatus), MissAccept
	if (ReadStatus.LE.0.AND.MissAccept.GE.0.AND.MissAccept.LE.100) exit
end do

print*, "  > Select the pattern scaling method: "
print*, "  >   1:linear, 11:equilib"
do
	read (*,*,iostat=ReadStatus), QMethod
	if (ReadStatus.LE.0.AND.QMethod.GE.1.AND.QMethod.LE.11) exit
end do

print*, "  > Compare the estimate with a model experiment (0=no,1=yes) ?"
do
	read (*,*,iostat=ReadStatus), QCompare
	if (ReadStatus.LE.0.AND.QCompare.GE.0.AND.QCompare.LE.1) exit
end do

end subroutine PrescribeSpec

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

subroutine SaveSpec

print*, "  > SAVE TO FILES."

DumpRegSetN = 0

if (QCompare.EQ.0) then
  DumpStat = 0 ; DumpStat (1) = 1
else
  print*, "  > Save the estimate, model, difference (3 entries: 0=no,1=yes) ?"
  do
	read (*,*,iostat=ReadStatus), DumpStat(1), DumpStat(2), DumpStat(3)
	if (ReadStatus.LE.0.AND.minval(DumpStat).GE.0.AND.maxval(DumpStat).LE.1) exit
  end do
end if

if (maxval(DumpStat).EQ.1) then
  print*, "  > SAVE TIME SLICES (0=none,>0=number to save) ?"
  do
	read (*,*,iostat=ReadStatus), DumpYearN
	if (ReadStatus.LE.0.AND.DumpYearN.GE.0) exit
  end do
else
  DumpYearN = 0
end if

if (DumpYearN.GT.0) then
  call SaveTimeSlices
else
  QDumpGrip=0 ; QDumpGlo=0 ; QDumpAgg=0 ; DumpCal=0
end if

print*, "  > SAVE TIME SERIES: grid,regions,globe (3 entries: 0=no,1=yes) ?"
do
	read (*,*,iostat=ReadStatus), QDumpGrim,QDumpPer,QDumpGlobe
	if (ReadStatus.LE.0.AND.min(QDumpGrim,QDumpPer,QDumpGlobe).GE.0.AND. &
			max(QDumpGrim,QDumpPer,QDumpGlobe).LE.1) exit
end do
  
if (QDumpPer.EQ.1.OR.QDumpGlobe.EQ.1.OR.QDumpGlo.EQ.1) call SaveRegSets

call SaveStems

end subroutine SaveSpec

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

subroutine SaveTimeSlices

allocate (DumpYear(DumpYearN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: PrescribeSpec: Allocation failure: DumpYear #####"

print*, "  > Enter each year AD to save in turn: "
XDumpYear = 0
do
    XDumpYear = XDumpYear + 1
    
    do
      read (*,*,iostat=ReadStatus), DumpYear(XDumpYear)
      if (ReadStatus.LE.0.AND.DumpYear(XDumpYear).GE.YearAD0.AND.DumpYear(XDumpYear).LE.YearAD1) then
	  DumpYear(XDumpYear) = DumpYear(XDumpYear) - YearAD0 + 1
      else
	  print*, "  > Entry unacceptable. Re-enter the year AD."
	  ReadStatus = 1
      end if
	
      if (ReadStatus.LE.0) exit
    end do
    
    if (XDumpYear.EQ.DumpYearN) exit
end do
  
print*, "  > Save to grip, .glo, .agg (3 entries: 0=no,1=yes) ?"
do
	read (*,*,iostat=ReadStatus), QDumpGrip,QDumpGlo,QDumpAgg
	if (ReadStatus.LE.0.AND.min(QDumpGrip,QDumpGlo,QDumpAgg).GE.0.AND. &
			max(QDumpGrip,QDumpGlo,QDumpAgg).EQ.1) exit
end do
  
DumpCal = 0
if (QDumpGlo.EQ.1) then    
    print*, "  > Save annual,seasonal,monthly (3 entries: 0=no,1=yes) ?"
    do
	read (*,*,iostat=ReadStatus), DumpCal(17),DumpCal(13),DumpCal(1)
	if (ReadStatus.LE.0.AND.min(DumpCal(17),DumpCal(13),DumpCal(1)).GE.0.AND. &
			max(DumpCal(17),DumpCal(13),DumpCal(1)).EQ.1) exit
    end do
    
    if (DumpCal(13).EQ.1) then
      DumpCal(14)=1 ; DumpCal(15)=1 ; DumpCal(16)=1
    end if     
    if (DumpCal( 1).EQ.1) then
      DumpCal(2)=1 ; DumpCal(3)=1 ; DumpCal(4)=1 ; DumpCal(5)=1 ; DumpCal(6)=1
      DumpCal(7)=1 ; DumpCal(8)=1 ; DumpCal(9)=1 ; DumpCal(10)=1 ; DumpCal(11)=1 ; DumpCal(12)=1
    end if
end if

end subroutine SaveTimeSlices

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

subroutine SaveRegSets

print*, "  > When saving to .glo, .agg, .per we save region sets."
print*, "  > Enter the number of region sets to save (>0):"
do
	read (*,*,iostat=ReadStatus), DumpRegSetN
	if (ReadStatus.LE.0.AND.DumpRegSetN.GT.0) exit
end do

allocate (DumpRegSet(DumpRegSetN), &
	  TextRegSet(DumpRegSetN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: SaveRegSets: Allocation failure #####"

GridChosen = GetGrid (ExeN,WyeN)

print*, "  > Select and name each region set in turn. "
do XDumpRegSet = 1, DumpRegSetN
  call RegSelectFile (GridChosen,DumpRegSet(XDumpRegSet))
  
  print*, "  > Name this region set: "
  do
	read (*,*,iostat=ReadStatus), TextRegSet(XDumpRegSet)
	if (ReadStatus.GT.0.OR.TextRegSet(XDumpRegSet).EQ."") print*, "  > Re-enter the name."
	if (ReadStatus.LE.0.AND.TextRegSet(XDumpRegSet).NE."") exit
  end do
end do

end subroutine SaveRegSets

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

subroutine SaveStems

TextInfo = "grid=" // trim(adjustl(TextGrid)) // " GCM=" // trim(adjustl(TextGCM))

print*, "  > Enter the directory to which to save: "			! get textdir
do
	read (*,*,iostat=ReadStatus), TextDir
	
	if (ReadStatus.LE.0) then
	  SubLen = len_trim(adjustl(TextDir))
	  if (TextDir(SubLen:SubLen).NE."/") TextDir = trim(TextDir) // "/"
	  GivenFile = trim(TextDir) // "trashme.txt"
          open (1, file=GivenFile, status="scratch", action="write", iostat=ReadStatus)
          if (ReadStatus.NE.0) print*, "  > Directory not found. Try again."
	else
	  print*, "  > Unacceptable entry. Try again."
	end if
	
	if (ReadStatus.LE.0) exit
end do

end subroutine SaveStems

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

subroutine SetupExec

allocate (ExecName     (ExecN), &
          ExecKay1File (ExecN), &
          ExecKay2File (ExecN), &
          ExecGloTFile (ExecN), &
          ExecEquTFile (ExecN), &
          ExecTargFile (ExecN), &
          ExecBaseFile (ExecN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: PrescribeSpec: Allocation failure: Exec #####"
ExecName = Blank ; ExecKay1File = Blank ; ExecKay2File = Blank
ExecGloTFile = Blank ; ExecEquTFile = Blank ; ExecTargFile = Blank ; ExecBaseFile = Blank

print*, "  > INDIVIDUAL VARIABLE DETAILS."

if (ExecN.GT.1) then
	print*, "  > Enter the grim variable suffix for each variable in turn: "
else
	print*, "  > Enter the grim variable suffix: "
end if

do XExec = 1, ExecN
    ExecName (XExec) = GetFreshSuffix (NoPrompt=1)
end do

end subroutine SetupExec

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

subroutine FirstExec

if (ExecN.GT.1) print "(a,a4)", "   > FIRST VARIABLE:", trim(ExecName(1))

print*, "  > Enter the pattern k1 grip file: "				! get k1 pattern
do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0) exit
end do
ExecKay1File(1) = LoadPath (GivenFile,trim(ExecName(1)))
! call ReviewCall (GivenFile,trim(ExecName(1)),ExecKay1File(1),CheckSuffix,1)    

if (QMethod.EQ.11) then							! get k2 pattern
  print*, "  > Also obtaining k2 pattern..."
  GivenFile = ExecKay1File(1)
  StringBeg = index (GivenFile,"k1")
  GivenFile = GivenFile(1:(StringBeg-1)) // "k2" // GivenFile((StringBeg+2):80)
!  call ReviewCall (GivenFile,trim(ExecName(1)),ExecKay2File(1),CheckSuffix,1)
  ExecKay2File(1) = LoadPath (GivenFile,trim(ExecName(1)))    
end if

print*, "  > Give a one-word name for these response patterns: "	! get pattern name
do
	read (*,*,iostat=ReadStatus), TextPatt
	if (ReadStatus.LE.0.AND.TextPatt.NE."") exit
end do

print*, "  > Give a one-word name for the scenario being estimated: "	! get target name
do
	read (*,*,iostat=ReadStatus), TextTarg
	if (ReadStatus.LE.0.AND.TextTarg.NE."") exit
end do

print*, "  > Enter the global temperature .ann file (anom,smoo): "		! get gloT
do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0) exit
end do
ExecGloTFile(1) = LoadPath (GivenFile,".ann")    

if (QMethod.EQ.11) then							
  print*, "  > Enter the equilibrium temperature .ann file (anom,smoo): "	! get equT
  do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0) exit
  end do
  ExecEquTFile(1) = LoadPath (GivenFile,".ann")    
end if

if (QCompare.EQ.1) then
  print*, "  > Enter the unanomalised target grim file to compare: "	! get targ
  do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0) exit
  end do
!  call ReviewCall (GivenFile,trim(ExecName(1)),ExecTargFile(1),CheckSuffix,1)    
  ExecTargFile(1) = LoadPath (GivenFile,trim(ExecName(1)))

  print*, "  > Enter the base grim file from which to anomalise: "	! get base
  do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0) exit
  end do
!  call ReviewCall (GivenFile,trim(ExecName(1)),ExecBaseFile(1),CheckSuffix,1)    
  ExecBaseFile(1) = LoadPath (GivenFile,trim(ExecName(1)))
end if

end subroutine FirstExec

!*******************************************************************************
! specify automatics

subroutine AutoSpec

print*, "  > Calculating other variables automatically..."

OrigSub = ExecName(1) ; SubLen = len(trim(adjustl(OrigSub)))
do XExec = 2, ExecN
  write (99,*), "execution: ", XExec				! #####################
  
  SpecSub = ExecName(XExec)
  
  write (99,*), "calc kay1 file..."				! #####################
  
  GivenFile = ExecKay1File(1) ; FileSubBeg = index(GivenFile,OrigSub(1:SubLen))
  GivenFile (FileSubBeg:(FileSubBeg+SubLen-1)) = trim(adjustl(SpecSub))
  ExecKay1File(XExec) = GivenFile
  
  write (99,*), "calc gloT file..."				! #####################
  
  ExecGloTFile(XExec) = ExecGloTFile(1)
  
  GivenFile = ExecTargFile(1) ; FileSubBeg = index(GivenFile,OrigSub(1:SubLen))
  GivenFile (FileSubBeg:(FileSubBeg+SubLen-1)) = trim(adjustl(SpecSub))
  ExecTargFile(XExec) = GivenFile
  
  GivenFile = ExecBaseFile(1) ; FileSubBeg = index(GivenFile,OrigSub(1:SubLen))
  GivenFile (FileSubBeg:(FileSubBeg+SubLen-1)) = trim(adjustl(SpecSub))
  ExecBaseFile(XExec) = GivenFile

  if (QMethod.GE.10) then
    write (99,*), "calc kay2 file..."				! #####################
  
    GivenFile = ExecKay2File(1) ; FileSubBeg = index(GivenFile,OrigSub(1:SubLen))
    GivenFile (FileSubBeg:(FileSubBeg+SubLen-1)) = trim(adjustl(SpecSub))
    ExecKay2File(XExec) = GivenFile
  
    write (99,*), "calc equT file..."				! #####################
  
    ExecEquTFile(XExec) = ExecEquTFile(1)
  end if
  
  write (99,*), "finished execution: ", XExec				! #####################
end do

end subroutine AutoSpec

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

subroutine SaveOpsFile

open  (1,file=SpecFile,status="new",access="sequential",form="unformatted",action="write")

write (1), ExecN, BoxN, ExeN, WyeN
write (1), PerLen, MissAccept, QMethod, QCompare, YearAD0, YearAD1
write (1), (Bounds(XBound),XBound=1,4)
write (1), (DumpStat(XStat),XStat=1,3)
write (1), (DumpCal(XSeason),XSeason=1,17)
write (1), DumpYearN,DumpRegSetN
write (1), QDumpGrip,QDumpGlo,QDumpAgg,QDumpGrim,QDumpPer,QDumpGlobe
write (1), TextInfo,TextDir,TextTarg,TextPatt

if (DumpYearN.GT.0) then 
  write (1), (DumpYear(XDumpYear),XDumpYear=1,DumpYearN)
end if

if (DumpRegSetN.GT.0) then 
  write (1), (DumpRegSet(XDumpRegSet),XDumpRegSet=1,DumpRegSetN)
  write (1), (TextRegSet(XDumpRegSet),XDumpRegSet=1,DumpRegSetN)
end if

do XExe = 1, ExeN
  write(1), (RefGrid(XExe,XWye), XWye=1,WyeN)
end do

do XExec = 1, ExecN
  write (1), ExecName(XExec)
  write (1), ExecKay1File(XExec), ExecKay2File(XExec), ExecGloTFile(XExec), ExecEquTFile(XExec)
  write (1), ExecBaseFile(XExec), ExecTargFile(XExec)
end do
  
close (1)

end subroutine SaveOpsFile

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

subroutine Finish

deallocate (DumpYear,DumpRegSet,TextRegSet,ExecName,ExecKay1File,ExecKay2File,ExecGloTFile,ExecEquTFile, &
		ExecBaseFile,ExecTargFile,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Finish: Deallocation failure #####"

print*
close (99)

end subroutine Finish

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

end program SetupSP