! setupGP.f90
! written by Tim Mitchell on 04.10.01
! last modified on 07.11.01
! program to set-up a specification file for the execution of GetPattern
! f90 -o ./../grim/setupGP filenames.f90 time.f90 grimfiles.f90 linfiles.f90 glofiles.f90 
!     grid.f90 ./../grim/setupGP.f90

program SetUpGP

use FileNames
use Time
use GrimFiles
use LinFiles
use GloFiles
use Grid

implicit none

integer, pointer, dimension (:,:)		:: RefGrid

character (len=80), pointer, dimension (:,:)	:: SimFile, SimGloT, SimEquT
character (len=20), pointer, dimension (:,:)	:: SimName
character (len=80), pointer, dimension (:)	:: ExecKayFile, ExecKayInfo, ExecBaseFile
character (len=20), pointer, dimension (:)	:: ExecName

real, dimension (4) :: Bounds

real, parameter :: MissVal = -999.0

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

real :: MissAccept

integer :: ReadStatus, AllocStat
integer :: ExecN, SimN, BoxN, ExeN, WyeN, BoundN
integer :: XExec, XSim, XBox, XExe, XWye, XBound
integer :: PerLen, GapLen, QMethod, QDumpGlo, QRestrictPer
integer :: NoPrompt, SubLen, FileSubBeg, YearAD0, YearAD1

character (len=80) :: GivenFile, SpecFile, LongString, GloRefFile
character (len=20) :: ShortString
character (len= 4) :: CheckSuffix, OrigSub, SpecSub

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

call Intro
call PrescribeSpec
call FirstExec
if (ExecN.GT.1) call AutoSpec
call SaveSpecFile
call Conclude

contains

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

subroutine Intro

open (99,file="/cru/mikeh1/f709762/scratch/log/log-setupGP.dat",status="replace",action="write")
print*
print*, "  > ***** SetUpGP: prepares to construct response patterns *****"
print*

end subroutine Intro

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

subroutine PrescribeSpec

print*, "  > Enter the filepath of the operations file (.ops): "
print*, "  >   (/cru/mikeh1/f709762/f90/grim/_ref/ops/getpattern.??.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
if (ExecN.GT.1) print*, "  > SPECIFY ELEMENTS COMMON TO EACH VARIABLE."

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*, "  > Enter the number of simulations: "
do
	read (*,*,iostat=ReadStatus), SimN
	if (ReadStatus.LE.0.AND.SimN.GE.1) exit
end do

print*, "  > Enter the time scale at which to smooth: "
do
	read (*,*,iostat=ReadStatus), PerLen
	if (ReadStatus.LE.0.AND.PerLen.GE.1) exit
end do
GapLen = MissVal

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*, "  > Restrict the period loaded to specified start/end? (0=no,1=yes)"
do
	read (*,*,iostat=ReadStatus), QRestrictPer
	if (ReadStatus.LE.0.AND.QRestrictPer.GE.0.AND.QRestrictPer.LE.1) exit
end do

if (QRestrictPer.EQ.0) then
  YearAD0 = MissVal ; YearAD1 = MissVal
else
  print*, "  > Specify the period to load (first,last years AD):"
  do
	read (*,*,iostat=ReadStatus), YearAD0, YearAD1
	if (ReadStatus.LE.0.AND.YearAD0.LE.YearAD1) exit
  end do
end if

print*, "  > Select the method of calculating the response pattern: "
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*, "  > Dump to .glo ? (0=no,1=all,2=annual,3=seasonal,4=monthly)"
do
	read (*,*,iostat=ReadStatus), QDumpGlo
	if (ReadStatus.LE.0.AND.QDumpGlo.GE.0.AND.QDumpGlo.LE.4) exit
end do
if (QDumpGlo.GT.0) GloRefFile = GetGloRef (ExeN,WyeN)

allocate (ExecName    (ExecN), &
          ExecKayFile (ExecN), &
          ExecKayInfo (ExecN), &
          ExecBaseFile(ExecN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: PrescribeSpec: Allocation failure: B #####"
ExecName = Blank ; ExecKayFile = Blank ; ExecKayInfo = Blank ; ExecBaseFile = Blank

allocate (SimName   (ExecN,SimN), &
          SimFile   (ExecN,SimN), &
          SimGloT   (ExecN,SimN), &
          SimEquT   (ExecN,SimN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: PrescribeSpec: Allocation failure: C #####"
SimName = Blank ; SimFile = Blank ; SimGloT = Blank ; SimEquT = Blank

print*, "  > Enter the grim variable suffix for each variable in turn: "
do XExec = 1, ExecN
    ExecName (XExec) = GetFreshSuffix (NoPrompt=1)
end do

end subroutine PrescribeSpec

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

subroutine FirstExec

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

print*, "  > Enter a short string describing each sim in turn (e.g. 'Ga1'):"
do XSim = 1, SimN
  do
    read (*,*,iostat=ReadStatus), ShortString
    if (ReadStatus.NE.0.OR. ShortString.EQ."") print*, "  > That entry is not acceptable. Try again."    
    if (ReadStatus.LE.0.AND.ShortString.NE."") exit
  end do
  do XExec = 1, ExecN
    SimName (XExec,XSim) = adjustl(ShortString)
  end do
end do

do XSim = 1, SimN
  print "(2a)", "   > Enter the unanomalised grim file for simulation: ", trim(adjustl(SimName(1,XSim)))
  do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0) exit
  end do
  call ReviewCall (GivenFile,trim(ExecName(1)),SimFile(1,XSim),CheckSuffix,1)    
end do

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

do XSim = 1, SimN
  print "(2a)", "   > Enter the smoothed, anom, globalT .ann file for sim: ", trim(SimName(1,XSim))
  do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0) exit
  end do
  SimGloT(1,XSim) = LoadPath (GivenFile,".ann")
  if (ExecN.GT.1) then
      do XExec = 2, ExecN
        SimGloT(XExec,XSim) = SimGloT(1,XSim)
      end do
  end if
  
  if (QMethod.GE.10) then
    print "(2a)", "   > Enter the smoothed, anom, equiliT .ann file for sim: ", trim(SimName(1,XSim))
    do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0) exit
    end do
    SimEquT(1,XSim) = LoadPath (GivenFile,".ann")
    if (ExecN.GT.1) then
      do XExec = 2, ExecN
        SimEquT(XExec,XSim) = SimEquT(1,XSim)
      end do
    end if
  end if
end do

print*, "  > Enter the response pattern grip file to save: " 
do
    read (*,*,iostat=ReadStatus), GivenFile
    if (ReadStatus.LE.0) exit
end do
call ReviewCall (GivenFile,trim(ExecName(1)),ExecKayFile(1),CheckSuffix,2)    

print*, "  > Enter the info line for each grip file: " 
do
    read (*,*,iostat=ReadStatus), LongString
    if (ReadStatus.LE.0.AND.LongString.NE."") exit
end do
do XExec = 1, ExecN
  ExecKayInfo(XExec) = LongString
end do

end subroutine FirstExec

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

subroutine AutoSpec

OrigSub = ExecName(1) ; SubLen = len(trim(adjustl(OrigSub)))
do XExec = 2, ExecN
  SpecSub = ExecName(XExec)
  
  GivenFile = ExecKayFile(1) ; FileSubBeg = index(GivenFile,OrigSub(1:SubLen))
  GivenFile (FileSubBeg:(FileSubBeg+SubLen-1)) = trim(adjustl(SpecSub))
  ExecKayFile(XExec) = GivenFile
  
  GivenFile = ExecBaseFile(1) ; FileSubBeg = index(GivenFile,OrigSub(1:SubLen))
  GivenFile (FileSubBeg:(FileSubBeg+SubLen-1)) = trim(adjustl(SpecSub))
  ExecBaseFile(XExec) = GivenFile
  
  do XSim = 1, SimN
    GivenFile = SimFile(1,XSim) ; FileSubBeg = index(GivenFile,OrigSub(1:SubLen))
    GivenFile (FileSubBeg:(FileSubBeg+SubLen-1)) = trim(adjustl(SpecSub))
    SimFile(XExec,XSim) = GivenFile  
  end do
end do

end subroutine AutoSpec

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

subroutine SaveSpecFile

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

write  (1), ExecN, SimN, BoxN, ExeN, WyeN
write  (1), PerLen, GapLen, MissAccept, QMethod, QDumpGlo, YearAD0, YearAD1
write  (1), (Bounds(XBound),XBound=1,4)
write  (1), GloRefFile

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

do XExec = 1, ExecN
  write (1), ExecName(XExec), ExecKayFile(XExec), ExecKayInfo(XExec), ExecBaseFile(XExec)

  do XSim = 1, SimN
  	write (1), SimName  (XExec,XSim)
  	write (1), SimFile  (XExec,XSim)
  	write (1), SimGloT  (XExec,XSim)  
  	write (1), SimEquT  (XExec,XSim)  
  end do
end do

close (1)

end subroutine SaveSpecFile

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

subroutine Conclude

deallocate (ExecName, ExecKayFile, ExecKayInfo, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Conclude: Deallocation failure: A #####"

deallocate (SimName, SimFile, SimGloT, SimEquT, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Conclude: Deallocation failure: B #####"

print*
close (99)

end subroutine Conclude

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

end program SetUpGP