! program written by Tim Mitchell on 17.8.00
! last modified on 17.9.00
! process the standard pca output files into .glo and .lin
! f90 -o pcproc initialmod.f90 savemod.f90 pcproc.f90

program PCProc

use InitialMod
use SaveMod

implicit none

real, pointer,  dimension (:,:)			:: PCLine
real, pointer,  dimension (:)			:: PCSlice

integer, pointer, dimension (:,:)		:: MapIDLRaw, MapIDLReg
integer, pointer,  dimension (:)		:: MapRawReg, RegSizes, ADYear

character (len=20), dimension (:), pointer 	:: RegNames,LineNames

character (len=10), dimension (:), allocatable 	:: VarExpl
character (len=2) , dimension (:), allocatable 	:: ProjIdentity

integer :: LatN, LongN, GridChosen, GridDataN, RegN
integer :: Month0, Month1, MonthN, YearN, DecN
integer :: CheckRegN, CheckYearN, CheckPCN
integer :: AllocStat, ReadStatus
integer :: XPC, XReg, XYear
integer :: SuffixStart, StemLen

character (len=80) :: VarFile, BoxFile, StpFile
character (len=80) :: FilePathStem, GloFilePath
character (len=80) :: GridFilePath, RegTitle, GloTitle, TitleStem
character (len=10) :: GridTitle

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

print*
print*, "  > ***** PRProc: process the PCA output into .glo + .lin *****"

VarFile = '/cru/u2/f709762/data/scratch/var-expl.dat'
BoxFile = '/cru/u2/f709762/data/scratch/box7.dat'
StpFile = '/cru/u2/f709762/data/scratch/step7.dat'

call GridSelect   (GridChosen,GridTitle,LongN,LatN,GridDataN,GridFilePath)
call RegSelect    (GridChosen, LongN, LatN, GridDataN, MapIDLReg, RegSizes, RegNames, RegTitle, RegN)
call PeriodSelect (YearN, DecN, ADYear)

open (2, file=BoxFile, status="old", access="sequential", form="formatted", action="read")
read (2,"(i8)"), CheckRegN
close (2)

open (3, file=StpFile, status="old", access="sequential", form="formatted", action="read")
read (3,"(i8)"), CheckYearN
close (3)

if (CheckRegN.NE.RegN.OR.CheckYearN.NE.YearN) then
  print*, "  > ##### Incompatible region or year numbers #####"
else

  allocate (PCSlice(RegN),    &
  	    PCLine(7,YearN),  &
  	    ProjIdentity(7),  &
  	    LineNames(7),     &
  	    VarExpl(7),       stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: PCProc: Allocation failure #####"
  
  ProjIdentity = ['-1','-2','-3','-4','-5','-6','-7']

  call OpVarExpl
  call OpPCSlice
  call OpPCLine
  
  deallocate (PCSlice,PCLine,ProjIdentity,LineNames,VarExpl,stat=AllocStat)  
  if (AllocStat.NE.0) print*, "  > ##### ERROR: PCProc: Deallocation failure #####"
  
end if

print*

contains

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

subroutine OpPCSlice

print*, "  > Save the first seven PC projections to .glo."

print*, "  > Enter the common title for the .glo (not incl 'PC'): "
do
	do
		read (*,*,iostat=ReadStatus), TitleStem
		if (ReadStatus.LE.0) exit
	end do	
	if (ReadStatus .EQ. 0) exit
end do

print*, "  > Enter the common filepath for the .glo (not incl 'PC'): "
do
	do
		do
			read (*,*,iostat=ReadStatus), FilePathStem
			if (ReadStatus.LE.0) exit
		end do
	
		inquire (file=FilePathStem, name=FilePathStem)
		open (1, file=FilePathStem, status="new", iostat=ReadStatus)
		if (ReadStatus .EQ. 0) close (1)
		if (ReadStatus .NE. 0) print*, "  > Filepath unacceptable. Re-enter it."
		if (ReadStatus .EQ. 0) exit
	end do
	
	SuffixStart = index (FilePathStem, '.glo')
	if (SuffixStart.EQ.0) print*, "  > Filepath is not a .glo. Re-enter it."
	if (SuffixStart.NE.0) exit
end do

open (5, file=BoxFile, status="old", access="sequential", form="formatted", action="read")
read (5,"(i8)"), CheckRegN

do XPC = 1, 7
  do XReg = 1, RegN
    read (5,"(f10.2)"), PCSlice (XReg)
  end do

  GloFilePath = FilePathStem(1:(SuffixStart-1)) // '-PC' // ProjIdentity(XPC) // FilePathStem(SuffixStart:78)
  GloFilePath = adjustl (GloFilePath)
  GloFilePath = trim    (GloFilePath)
  
  TitleStem = adjustl   (TitleStem)
  StemLen   = len_trim  (TitleStem)
  GloTitle  = TitleStem (1:StemLen) // ' PC' // ProjIdentity(XPC) // VarExpl (XPC)
  
  call SaveGlo (LongN, LatN, RegN, GridFilePath, GloFilePath, GloTitle, PCSlice, MapIDLReg)
end do

close (5)

end subroutine OpPCSlice

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

subroutine OpPCLine

open (30, file=StpFile, status="old", access="sequential", form="formatted", action="read")
read (30,"(i8)"), CheckYearN
do XPC = 1, 7
  LineNames (XPC) = 'PC' // ProjIdentity (XPC) // VarExpl (XPC)
  
  do XYear = 1, YearN
    read (30,"(f10.2)"), PCLine (XPC,XYear)
  end do
end do
close (30)

print*, "  > Save PC time series to .lin."

call SaveLin (7, YearN, LineNames, ADYear, PCLine)

end subroutine OpPCLine

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

subroutine OpVarExpl

open (10, file=VarFile, status="old", access="sequential", form="formatted", action="read")
read (10,"(i8)"), CheckPCN
do XPC = 1, 7
    read (10,"(a10)"), VarExpl (XPC)  
end do
close (10)

end subroutine OpVarExpl

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

end program PCProc