! makeeqlsr.f90
! f90 main program written on 07.01.00 by Tim Mitchell
! last modification on 07.01.00
! f90 -o makeeqlsr initialmod.f90 loadmod.f90 scalemod.f90 savemod.f90 makeeqlsr.f90

program MakeEqLSR

use InitialMod
use LoadMod
use ScaleMod
use SaveMod

implicit none

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

real, pointer, dimension (:)		:: WorkRegAye
real, pointer, dimension (:,:)		:: TimSeries
real, pointer, dimension (:,:)		:: WorkActualExe, WorkActualWye, WorkPredictor
real, pointer, dimension (:,:,:)	:: WorkPredictand

integer, pointer, dimension (:)		:: WorkADYear, WorkMapRawReg, WorkRegSizes
integer, pointer, dimension (:,:)	:: WorkMapIDLRaw, WorkMapIDLReg

character (len=20), pointer, dimension (:) 	:: WorkRegNames 
character (len=80), pointer, dimension (:) 	:: TimRegNames

real, parameter :: MissVal = -999.0

real :: WorkAye

integer :: WorkGrid,WorkLongN,WorkLatN,WorkDataN
integer :: WorkMonth0,WorkMonth1,WorkMonthN,WorkYearN,WorkDecN
integer :: WorkRegN
integer :: XYear, XMem, XReg
integer :: ReadStatus, AllocStat
integer :: WorkMemN
integer :: TimRegN
integer :: PredictorReg

character (len=10) :: WorkGridTitle
character (len=40) :: WorkRegTitle
character (len=80) :: WorkGridFilePath, WorkGloTitle, Blank

!*******************************************************************************
! preliminaries

Blank = ""

print*
print*, "  > ***** MakeEqLSR *****"
print*, "  > Calculates scaling equation using multiple .tim"
print*

call GridSelect   (WorkGrid,WorkGridTitle,WorkLongN,WorkLatN,WorkDataN,WorkGridFilePath)
call PeriodSelect (WorkYearN,WorkDecN,WorkADYear)
call RegSelect    (WorkGrid,WorkLongN,WorkLatN,WorkDataN,WorkMapIDLReg,WorkRegSizes,WorkRegNames,&
		   WorkRegTitle,WorkRegN)

!*******************************************************************************
! specify ensemble size

print*, "  > Enter the number of ensemble members over which to average: "
do
	read (*,*,iostat=ReadStatus), WorkMemN
	if (ReadStatus.LE.0 .AND. WorkMemN.GE.1) exit
end do

allocate ( WorkRegAye     (WorkRegN),	        &
	   WorkActualExe  (WorkMemN,WorkYearN), &
	   WorkActualWye  (WorkMemN,WorkYearN), &
	   WorkPredictor  (WorkMemN,WorkYearN), &
	   WorkPredictand (WorkRegN,WorkMemN,WorkYearN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Allocation failure #####"

WorkPredictor  = MissVal
WorkPredictand = MissVal

!*******************************************************************************
! get .tim files

print*, "  > Load time series from .tim files."
do XMem = 1, WorkMemN
  print*, "  > *** MEMBER ", XMem
  
  do
    print*, "  > PREDICTOR:"
    call LoadTim (WorkYearN,WorkADYear,TimRegN,TimRegNames,TimSeries)
    
    if (TimRegN.GT.1) then
    	print*, "  > Select a region (0=display list): "
    	do
		read (*,*,iostat=ReadStatus), PredictorReg
		if (PredictorReg.EQ.0) then
		  do XReg = 1, TimRegN
		    print "(I6,A1,A40)", XReg, " ", trim(adjustl(TimRegNames(XReg)))
		  end do
		end if
		if (ReadStatus.LE.0.AND.PredictorReg.GE.1) exit
    	end do
    else
    	PredictorReg = 1
    end if

  end do
  
  do XYear = 1, WorkYearN
    WorkPredictor (XMem,XYear) = TimSeries (PredictorReg,XYear)
  end do
  
  deallocate (TimRegNames,TimSeries)
  
  do
    print*, "  > PREDICTAND:"
    call LoadTim (WorkYearN,WorkADYear,TimRegN,TimRegNames,TimSeries)
    
    if (TimRegN.NE.WorkRegN) print*, "  > Unacceptable .tim file due to wrong no. of regions."
    if (TimRegN.EQ.WorkRegN) exit
  end do
  
  do XReg = 1, WorkRegN
   do XYear = 1, WorkYearN
    WorkPredictand (XReg,XMem,XYear) = TimSeries (XReg,XYear)
   end do
  end do
  
  deallocate (TimRegNames,TimSeries)
  
end do

!*******************************************************************************
! calculate  'a' in y=ax

do XMem = 1, WorkMemN
  do XYear = 1, WorkYearN
    WorkActualExe (XMem,XYear) = WorkPredictor (XMem,XYear)
    
    do XReg = 1, WorkRegN
      WorkActualWye (XMem,XYear) = WorkPredictand (XReg,XMem,XYear)
    end do
  end do
end do
  
do XReg = 1, WorkRegN
  call LinearLSR (WorkMemN,WorkYearN,WorkActualExe,WorkActualWye,WorkAye)  
  WorkRegAye (XReg) = WorkAye
end do

!*******************************************************************************
! save .glo file

call SaveGlo (WorkLongN,WorkLatN,WorkRegN,WorkGridFilePath,Blank,Blank,WorkRegAye,WorkMapIDLReg)

!*******************************************************************************
! end proceedings

deallocate (WorkActualExe,WorkActualWye,WorkPredictor,WorkPredictand)

print*

end program MakeEqLSR