! baseproducts.f90
! f90 main program written on 15.12.99 by Tim Mitchell
! last modification on 04.01.00
! f90 -o baseproducts initialmod.f90 runselectmod.f90 extractmod.f90 transformmod.f90 savemod.f90 baseproducts.f90

program BaseProducts

use InitialMod
use RunSelectMod
use ExtractMod
use TransformMod
use SaveMod

implicit none

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

real, pointer, dimension (:)	:: WorkGloAnaSlice, TempIn, TempOut, TempOutA, TempOutB
real, pointer, dimension (:,:)	:: WorkLinAnaSeries, WorkGotDecade, WorkGotFull

integer, pointer, dimension (:) 	:: WorkADYear, WorkMapRawReg, WorkRegSizes, WorkAnaSizes
integer, pointer, dimension (:) 	:: WorkDecYearN, WorkDecGetYear0, WorkDecGetYear1
integer, pointer, dimension (:)		:: WorkDecStyleThis, WorkDecStyleNext
integer, pointer, dimension (:,:) 	:: WorkMapIDLRaw, WorkMapIDLReg
integer, pointer, dimension (:,:) 	:: WorkDecBlockKey

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

real, parameter :: MissVal = -999.0

integer :: WorkMonth0,WorkMonth1,WorkMonthN,WorkYearN,WorkDecN
integer :: WorkGrid,WorkLongN,WorkLatN,WorkDataN,WorkRegN
integer :: AllocStat, ReadStatus
integer :: XDec, XReg, XYear, XMonth
integer :: Year0, Year1
integer :: DegChosen, SaveChosen

character (len=10) :: WorkGridTitle
character (len=40) :: WorkRegTitle
character (len=80) :: WorkGridFilePath, WorkDecTitle, SaveTitle
character (len=80) :: WorkDecPathA, WorkDecPathB, Blank

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

Blank = ""

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

print*
print*, "  > ***** BaseProducts *****"
print*, "  > Calculates products from control data."
print*

call GridSelect   (WorkGrid,WorkGridTitle,WorkLongN,WorkLatN,WorkDataN,WorkGridFilePath)
call PeriodSelect (WorkYearN,WorkDecN,WorkADYear)
call SeasonSelect (WorkMonth0,WorkMonth1,WorkMonthN)
call RegSelect    (WorkGrid,WorkLongN,WorkLatN,WorkDataN,WorkMapIDLReg,WorkRegSizes,WorkRegNames,&
		   WorkRegTitle,WorkRegN)
call RawSelect    (WorkGrid,WorkLongN,WorkLatN,WorkMapIDLReg,WorkMapIDLRaw,WorkMapRawReg)

allocate ( WorkAnaSizes    (WorkRegN), &
	   WorkGloAnaSlice (WorkRegN), &
	   WorkLinAnaSeries(WorkRegN, WorkYearN), &
	   WorkGotDecade   (WorkRegN, 10), &
	   WorkGotFull     (WorkRegN, WorkYearN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Allocation failure #####"

print*, "  > Select the control run."

call RunSelect    (WorkGrid,WorkMonth0,WorkMonth1,WorkYearN,WorkDecN,WorkADYear,&
		   WorkDecTitle,WorkDecStyleThis,WorkDecStyleNext,&
		   WorkDecPathThis,WorkDecPathNext,WorkDecYearN,WorkDecGetYear0,WorkDecGetYear1)

!*******************************************************************************
! extract data into WorkGotFull

WorkGotFull = 0.0
print*, "  > Operating on decade starting in: "

do XDec = 1, WorkDecN
  Year0 = (XDec-1)*10 + 1
  Year1 = Year0 + 9
  
  WorkGotDecade = 0.0
  print*, WorkADYear(Year0)
  
  call BlockKey    (WorkDecYearN(XDec),WorkMonthN,WorkDecGetYear0(XDec),WorkDecGetYear1(XDec),&
  		    WorkMonth0,WorkMonth1,WorkDecPathThis(XDec),WorkDecPathNext(XDec),&
  		    WorkDecStyleThis(XDec),WorkDecStyleNext(XDec),WorkDecBlockKey)
  
  call ExtractFile (WorkLongN,WorkLatN,WorkDataN,WorkDecPathThis(XDec),WorkDecPathNext(XDec),&
  		    WorkDecStyleThis(XDec),WorkDecStyleNext(XDec),WorkRegN,WorkMonthN,&
  		    WorkDecYearN(XDec),WorkDecGetYear0(XDec),&
  		    WorkMapRawReg,WorkRegSizes,WorkDecBlockKey,WorkGotDecade)
  
  do XReg = 1, WorkRegN
    WorkGotFull (XReg,Year0:Year1) = WorkGotDecade (XReg,1:10)
  end do
end do

!*******************************************************************************
! save unsmoothed time series to .tim

print*, "  > Save unsmoothed region time series to file ? (1=no,2=yes)"
do
	read (*,*,iostat=ReadStatus), SaveChosen
	if (ReadStatus.LE.0 .AND. SaveChosen.GE.1 .AND. SaveChosen.LE.2) exit
end do

if (SaveChosen.EQ.2) then
  call SaveTim (WorkRegN,WorkYearN,Blank,Blank,WorkRegNames,WorkADYear,WorkGotFull)
end if

!*******************************************************************************
! generate and save smoothed time series to .tim

print*, "  > Save smoothed (Gauss,30y) region time series to file ? (1=no,2=yes)"
do
	read (*,*,iostat=ReadStatus), SaveChosen
	if (ReadStatus.LE.0 .AND. SaveChosen.GE.1 .AND. SaveChosen.LE.2) exit
end do

if (SaveChosen.EQ.2) then

  WorkLinAnaSeries = 0.0

  allocate (TempIn   (WorkYearN), &
  	  TempOutA (WorkYearN), &
  	  TempOutB (WorkYearN), stat=AllocStat)

  do XReg = 1, WorkRegN
    if (AllocStat.NE.0) print*, "  > ##### ERROR: Allocation failure #####"
  
    TempIn (1:WorkYearN) = WorkGotFull (XReg,1:WorkYearN)
    TempOutA = MissVal
    TempOutB = MissVal
  
    call GaussSmooth (WorkYearN,30,1,TempIn,TempOutA,TempOutB)
  
    WorkLinAnaSeries (XReg,1:WorkYearN) = TempOutA (1:WorkYearN)
  end do

  deallocate (TempIn, TempOutA, TempOutB)

  call SaveTim (WorkRegN,WorkYearN,Blank,Blank,WorkRegNames,WorkADYear,WorkLinAnaSeries)

end if

!*******************************************************************************
! generate and save means to .glo

print*, "  > Save region means to .glo file ? (1=no,2=yes)"
do
	read (*,*,iostat=ReadStatus), SaveChosen
	if (ReadStatus.LE.0 .AND. SaveChosen.GE.1 .AND. SaveChosen.LE.2) exit
end do

if (SaveChosen.EQ.2) then

  WorkGloAnaSlice  = 0.0
  WorkAnaSizes     = 0

  do XReg = 1, WorkRegN
   do XYear = 1, WorkYearN
    if (WorkGotFull(XReg,XYear).NE.MissVal) then
      WorkGloAnaSlice (XReg) = WorkGloAnaSlice (XReg) + WorkGotFull(XReg,XYear)
      WorkAnaSizes (XReg)    = WorkAnaSizes (XReg) + 1
    end if
   end do
  
   if (WorkAnaSizes(XReg).GT.0) then
    WorkGloAnaSlice (XReg) = WorkGloAnaSlice (XReg) / real (WorkAnaSizes (XReg))
   else
    WorkGloAnaSlice (XReg) = MissVal
   end if
  end do

  call SaveGlo (WorkLongN,WorkLatN,WorkRegN,WorkGridFilePath,Blank,Blank,&
  		WorkGloAnaSlice,WorkMapIDLReg)

end if

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

print*

deallocate (WorkAnaSizes,WorkGloAnaSlice,WorkLinAnaSeries,WorkGotDecade,WorkGotFull)

close (99)

end program BaseProducts