! GetPattern.f90
! written by Tim Mitchell on 02.10.01
! last modified on 20.11.01
! program to construct response pattern(s) from grim files and dump them to grip file(s)
! designed using the linked list concept: to understand, inspect type sim
! f90 -lnagfl90 -I/sw7/nag90/nagfl90 -o ./../grim/getpattern filenames.f90 time.f90 grimfiles.f90 annfiles.f90 
!	glofiles.f90 regress.f90 ./../grim/getpattern.f90
! note that for .wet .pre .frs the program auto calcs sums, not means, for seasons and years
! the method has been changed to smooth at PerLen rather than use overlapping slices

program GetPattern

use nag_lin_reg, ONLY : nag_mult_lin_reg
use FileNames
use Time
use GrimFiles
use AnnFiles
use GloFiles
use Regress

implicit none

character (len=80), parameter 	:: SpecFile = "/cru/mikeh1/f709762/f90/grim/_ref/ops/getpattern.57.ops.X"

type Exec
  character (len=20) 				:: Name			! execution name
  type (Exec), pointer 				:: Prev			! prev execution defined: recursion
  type (Exec), pointer 				:: Next			! next execution defined: recursion
  character (len=80), pointer, dimension (:)	:: SimName, SimFile	! sim name and path: SimN
  character (len=80), pointer, dimension (:)	:: SimGloT		! sim GloT path: SimN
  character (len=80), pointer, dimension (:)	:: SimEquT		! sim equilib T path: SimN
  character (len=80) 				:: KayFile, KayInfo	! save file and info
  character (len=80) 				:: BaseFile		! base file from which to anomalise
end type Exec

type Sim
  character (len=20) 				:: Name		! simulation name
  type (Sim), pointer 				:: Prev		! prev simulation defined: recursion
  type (Sim), pointer 				:: Next		! next simulation defined: recursion
  integer					:: YearN	! no. of years in array
  real, pointer, dimension (:,:,:) 		:: Data		! grim file: YearN,SeasonN,BoxN
  real, pointer, dimension (:) 			:: GloT		! .ann file: YearN
  real, pointer, dimension (:) 			:: EquT		! .ann file: YearN
end type Sim

type (Exec), pointer				:: OneExec, CurrentExec, StackExec

type (Sim), pointer				:: OneSim, CurrentSim, StackSim

integer, parameter :: MLRtype = KIND(1.0D0)

real (MLRtype), allocatable, dimension (:)   :: Response, Coefficients, Weight
real (MLRtype), allocatable, dimension (:,:) :: Predictor

real, pointer, dimension (:,:,:)		:: FileData
real, pointer, dimension (:,:)			:: FileGloT, FileEquT, BaseData
real, pointer, dimension (:,:)			:: Kay1, Kay2, CurrentKay  ! the arrays of k: SeasonN, BoxN
real, pointer, dimension (:)			:: GloVector, Array1D, TSLowVec, TSHighVec

integer, pointer, dimension (:,:)		:: Grid, FileGrid
integer, pointer, dimension (:)			:: YearAD, FileYearAD, GloTYearAD, EquTYearAD

character (len=80), pointer, dimension (:,:) 	:: BinFile, BinGloT, BinEquT
character (len=20), pointer, dimension (:,:) 	:: BinName
character (len=09), pointer, dimension (:) 	:: AnnNames

real, dimension (4)				:: Bounds, FileBounds

integer, dimension (12), parameter		:: SeasonMonths = [3,4,5,6,7,8,9,10,11,12,1,2]

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

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

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

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

integer :: AllocStat, ReadStatus
integer :: YearN,ExecN,XSim,AllYearN, BoxN, ExeN, WyeN, FileYearN
integer :: XYear,XExec,SimN,XAllYear, XBox, XExe, XWye, XBound, XFileYear, XSeason, XMonth, XKay
integer :: PredictorN, CheckBoxN
integer :: QMethod, QDumpGlo, QHalt, QSimLoaded, QRestrictPer, QMeanSum
integer :: PerLen, GapLen, YearLimit, YearAD0,YearAD1
integer :: Year0,Year1, FileYear0,FileYear1, ThisMonth,ThisYear
integer :: CheckGrid, MissThresh, SuffixStart

character (len=80) :: FileInfo, GloRefFile, GloFile, GloInfo, GripFile, GripInfo
character (len=20) :: FindName
character (len= 4) :: Suffix, FileSuffix, SaveSuffix, KaySuffix, Variable

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

call Intro			! initialises, loads command file, allocates Exec

call ResetCurrentExec		! points CurrentExec back to the first exec

do
  if (associated(CurrentExec%Prev)) CurrentExec => CurrentExec%Next		! not 1st exec, so next exec
  
  print*, "  > Execution: ", CurrentExec%Name
  
  Variable = trim(CurrentExec%Name)
  if (Variable.EQ.".wet".OR.Variable.EQ.".pre".OR.Variable.EQ.".frs") then
    QMeanSum = 2
  else
    QMeanSum = 1
  end if
  
  call LoadSims  
  call CalcPatterns
  
  if (.not.associated(CurrentExec%Next)) exit					! last exec, so exit loop
end do

call Finish

contains

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

subroutine Intro

open (99,file="/cru/mikeh1/f709762/scratch/log/log-getpattern.dat",status="replace",action="write")
print*
print*, "  > ***** GetPattern: constructs response patterns *****"
print*
print*, "  > Spec file: ", trim(SpecFile)
print*

open  (1,file=SpecFile,status="old",access="sequential",form="unformatted",action="read")

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

if (YearAD0.NE.MissVal.AND.YearAD1.NE.MissVal) then
  YearN = YearAD1 - YearAD0 + 1
  allocate (YearAD (YearN), stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure: YearAD #####"
  do XYear = 1, YearN
    YearAD (XYear) = YearAD0 + XYear - 1
  end do
  QRestrictPer = 1
else
  YearN = MissVal
  QRestrictPer = 0
end if

allocate (Grid   (ExeN,WyeN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure: Grid #####"

do XExe = 1, ExeN
  read (1), (Grid(XExe,XWye), XWye=1,WyeN)
end do

allocate (BinName  (ExecN,SimN), &
	  BinFile  (ExecN,SimN), &
	  BinGloT  (ExecN,SimN), &
	  BinEquT  (ExecN,SimN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure: Bin* #####"
  
do XExec = 1, ExecN
  allocate (OneExec,                 &
	    OneExec%SimName  (SimN), &
	    OneExec%SimFile  (SimN), &
	    OneExec%SimGloT  (SimN), &
	    OneExec%SimEquT  (SimN), stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure: OneExec #####"
  
  read (1), OneExec%Name, OneExec%KayFile, OneExec%KayInfo, OneExec%BaseFile
  
  do XSim = 1, SimN
  	read (1), BinName  (XExec,XSim)
  	read (1), BinFile  (XExec,XSim)
  	read (1), BinGloT  (XExec,XSim)
  	read (1), BinEquT  (XExec,XSim)
  	
  	OneExec%SimName  (XSim) = BinName  (XExec,XSim)
  	OneExec%SimFile  (XSim) = BinFile  (XExec,XSim)
  	OneExec%SimGloT  (XSim) = BinGloT  (XExec,XSim)
  	OneExec%SimEquT  (XSim) = BinEquT  (XExec,XSim)
  end do
  
  if      (XExec.EQ.1) then
    nullify(OneExec%Prev)
    nullify(OneExec%Next)
  else
    OneExec%Prev     => CurrentExec
    CurrentExec%Next => OneExec
    nullify(OneExec%Next)
  end if
  
  CurrentExec => OneExec
  
end do

close (1)

deallocate (BinName,BinFile,BinGloT,BinEquT, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Deallocation failure: Bin* #####"
  
end subroutine Intro

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

subroutine LoadSims

call GetBaseData

do XSim = 1, SimN
  call LoadSimGrim
  call LoadSimGloTS
  
  write (99,*), "anomalising and smoothing...." 			! ###########################
  call AnomSmoothSim
  
  if      (XSim.EQ.1) then
      nullify(OneSim%Prev)
      nullify(OneSim%Next)
  else
      OneSim%Prev     => CurrentSim
      CurrentSim%Next => OneSim
      nullify(OneSim%Next)
  end if
  
  CurrentSim => OneSim
    
  print*, "  > Have loaded sim: ", trim(CurrentExec%SimName(XSim))
end do

deallocate (BaseData,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadSims: Deallocation failure: BaseData #####"

end subroutine LoadSims

!*******************************************************************************
! option ( 1): assumed relationship: Vy = k1*Ty
!              Vy=box-season-anom, Ty=globalT-anom
! option (11): assumed relationship: Vy = k1*Ty + (Te-Ty)*k2
!              Vy=box-season-anom, Ty=globalTanom, Te=equilTanom

subroutine CalcPatterns

write (99,*), "calc allyearn..."				! ########################

call CalcAllYearN

if (QMethod.EQ. 1) PredictorN = 1
if (QMethod.EQ.11) PredictorN = 2

allocate (Predictor     (AllYearN,PredictorN), &
	  Response      (AllYearN),    &
	  Weight        (AllYearN),    &
	  Coefficients  (PredictorN+1), &
	  Kay1          (SeasonN,BoxN), &
	  Kay2          (SeasonN,BoxN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: CalcPatterns: Allocation failure: 01 #####"

write (99,*), "filling predictor..."				! ########################

call ResetCurrentSim
XAllYear = 0
do 									! fill predictor
  if (XAllYear.GT.0.AND.associated(CurrentSim%Next)) CurrentSim => CurrentSim%Next
  XFileYear = 0
  
  do
    XFileYear = XFileYear + 1 ; XAllYear = XAllYear + 1
    
    Predictor (XAllYear,1) = CurrentSim%GloT(XFileYear)			! fill global T
    									! fill equilT - globalT
    if (QMethod.GT.10) Predictor(XAllYear,2) = CurrentSim%EquT(XFileYear) - CurrentSim%GloT(XFileYear)
    
    if (XFileYear.EQ.CurrentSim%YearN) exit
  end do
  
  if (.not.associated(CurrentSim%Next)) exit  
end do

write (99,*), "filling response..."				! ########################

do XSeason = 1, SeasonN						! iterate by season and box
 do XBox = 1, BoxN
  call ResetCurrentSim ; XAllYear = 0 ; XFileYear = 0
  
  do
    if (XAllYear.GT.0.AND.associated(CurrentSim%Next)) CurrentSim => CurrentSim%Next
    XFileYear = 0
    do
      XFileYear = XFileYear + 1 ; XAllYear = XAllYear + 1

      Response (XAllYear) = CurrentSim%Data(XFileYear,XSeason,XBox)		! fill response

      if (XFileYear.EQ.CurrentSim%YearN) exit
    end do
    if (.not.associated(CurrentSim%Next)) exit  
  end do
    
  if (PredictorN.EQ.1) then							! calc weights
    do XAllYear = 1, AllYearN
      if (Response(XAllYear).EQ.MissVal.OR.Predictor(XAllYear,1).EQ.MissVal) then
         Weight(XAllYear) = 0.0
      else
         Weight(XAllYear) = 1.0
      end if
    end do
  else
    do XAllYear = 1, AllYearN
      if (Response(XAllYear).EQ.MissVal.OR.Predictor(XAllYear,1).EQ.MissVal.OR. &
      			Predictor(XAllYear,2).EQ.MissVal) then
         Weight(XAllYear) = 0.0
      else
         Weight(XAllYear) = 1.0
      end if
    end do
  end if  										

  call nag_mult_lin_reg (Predictor,Response,Coefficients,wt=Weight,add_alpha=.FALSE.)

  Kay1(XSeason,XBox) = Coefficients (1)
  Kay2(XSeason,XBox) = Coefficients (2)
 end do
end do

write (99,*), "removing sims..."				! ########################

call RemoveSims

write (99,*), "iterating by constant..."			! ########################

do XKay = 1, PredictorN
    write (99,*), "constant: ", XKay				! ########################

    if (XKay.EQ.1) then
    	CurrentKay => Kay1 ; KaySuffix = ".k1 "
    else
    	CurrentKay => Kay2 ; KaySuffix = ".k2 "
    end if
    
    SuffixStart = index (CurrentExec%KayFile,Suffix)
    GripFile = trim(CurrentExec%KayFile(1:(SuffixStart-1))) // trim(KaySuffix) // trim(Suffix)
    GripInfo = trim(CurrentExec%KayInfo) // adjustr(KaySuffix)
    call SaveGrip (CurrentKay,Grid,Bounds,GripInfo,GripFile,Suffix,SaveSuffix)

    if (QDumpGlo.GT.0) then
      if (QDumpGlo.EQ.1.OR.QDumpGlo.EQ.2) then
        XSeason = 17
        GloVector => CurrentKay(XSeason,1:BoxN:1) ; call SaveSeasonGlo
      end if
      if (QDumpGlo.EQ.1.OR.QDumpGlo.EQ.3) then
       do XSeason = 13, 16
        GloVector => CurrentKay(XSeason,1:BoxN:1) ; call SaveSeasonGlo
       end do
      end if
      if (QDumpGlo.EQ.1.OR.QDumpGlo.EQ.4) then
       do XSeason = 1, 12
        GloVector => CurrentKay(XSeason,1:BoxN:1) ; call SaveSeasonGlo
       end do
      end if
    end if
end do
nullify (CurrentKay)

deallocate (Predictor,Response,Weight,Coefficients,Kay1,Kay2, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: CalcLinear: Deallocation failure: ABK #####"

write (99,*), "finished calcpatterns"				! ########################

end subroutine CalcPatterns

!*******************************************************************************
! load the main grim file for a particular simulation

subroutine LoadSimGrim

if (QRestrictPer.EQ.1) then
    call LoadGrim (FileData,FileGrid,FileYearAD,FileBounds,FileInfo,CurrentExec%SimFile(XSim),Suffix,&
                  FileSuffix,MasterYearAD=YearAD)
    FileYearN = YearN
    call CommonVecPer (YearAD,FileYearAD,Year0,Year1,FileYear0,FileYear1)
    
    deallocate (FileYearAD,stat=AllocStat)
    if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadSims: Deallocation failure: LoadGrim #####"
else
    call LoadGrim (FileData,FileGrid,YearAD,FileBounds,FileInfo,CurrentExec%SimFile(XSim),Suffix,&
                  FileSuffix)
    FileYearN = size (YearAD,1)
    Year0 = 1 ; Year1 = FileYearN ; FileYear0 = 1; FileYear1 = FileYearN
end if
  
call CheckGridAB (Grid,FileGrid,CheckBoxN)
if (CheckBoxN.NE.BoxN) print*, "  > ##### ERROR: LoadSimGrim: grids do not match #####"
  
allocate (OneSim, 				   &
    	  OneSim%Data  (FileYearN,SeasonN,BoxN), &
    	  OneSim%GloT  (FileYearN),              &
    	  OneSim%EquT  (FileYearN),              stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadSims: Allocation failure: OneSim #####"
OneSim%Name  = CurrentExec%SimName(XSim)
OneSim%YearN = FileYearN
OneSim%Data  = MissVal ; OneSim%GloT = MissVal ; OneSim%EquT = MissVal

do XYear = Year0, Year1					! store data
  XFileYear = FileYear0 + XYear - 1
    
  do XMonth = 1, MonthN
    do XBox = 1, BoxN
        OneSim%Data (XYear,XMonth,XBox) = FileData (XFileYear,XMonth,XBox)
    end do
  end do
end do

deallocate (FileData,FileGrid,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadSimGrim: Deallocation failure: File* #####"
        
do XYear = Year0, Year1					! seasonalise data
 do XBox = 1, BoxN
  do XSeason = 1, 4
    OneSim%Data(XYear,XSeason+12,XBox) = 0.0
    
    do XMonth = (((XSeason-1)*3)+3), (((XSeason-1)*3)+5)
      if (OneSim%Data(XYear,XSeason+12,XBox).NE.MissVal) then
        if (XMonth.LE.12) then
        	ThisYear = XYear ; ThisMonth = XMonth
        else
        	ThisYear = XYear + 1 ; ThisMonth = XMonth - 12
        end if
        
        if (ThisYear.LE.Year1) then
          if (OneSim%Data(ThisYear,ThisMonth,XBox).NE.MissVal) then
          	OneSim%Data(XYear,XSeason+12,XBox) = OneSim%Data(XYear,XSeason+12,XBox) + &
          						OneSim%Data(ThisYear,ThisMonth,XBox)
          else
          	OneSim%Data(XYear,XSeason+12,XBox) = MissVal
          end if
        else
          	OneSim%Data(XYear,XSeason+12,XBox) = MissVal
        end if
      end if
    end do
    
    if (OneSim%Data(XYear,XSeason+12,XBox).NE.MissVal) then
      if (QMeanSum.EQ.1) OneSim%Data(XYear,XSeason+12,XBox) = OneSim%Data(XYear,XSeason+12,XBox) / 3.0
    end if
  end do
 end do
end do

do XYear = Year0, Year1					! annualise data
 do XBox = 1, BoxN
  OneSim%Data(XYear,17,XBox) = 0.0
  
  do XMonth = 1, 12
    if (OneSim%Data(XYear,17,XBox).NE.MissVal) then
      if (OneSim%Data(XYear,XMonth,XBox).NE.MissVal) then
        OneSim%Data(XYear,17,XBox) = OneSim%Data(XYear,17,XBox) + OneSim%Data(XYear,XMonth,XBox)
      else
        OneSim%Data(XYear,17,XBox) = MissVal
      end if
    end if
  end do
  
  if (OneSim%Data(XYear,17,XBox).NE.MissVal) then
    if (QMeanSum.EQ.1) OneSim%Data(XYear,17,XBox) = OneSim%Data(XYear,17,XBox) / 12.0
  end if
 end do
end do

end subroutine LoadSimGrim

!*******************************************************************************
! anomalise and smooth the simulation

subroutine AnomSmoothSim

write (99,*), "anomalising...." 			! ###########################

do XBox = 1, BoxN					! anomalise
  do XSeason = 1, SeasonN
    if (BaseData(XSeason,XBox).NE.MissVal) then
     do XYear = 1, OneSim%YearN
      if (OneSim%Data(XYear,XSeason,XBox).NE.MissVal) then
       OneSim%Data(XYear,XSeason,XBox) = OneSim%Data(XYear,XSeason,XBox) - BaseData(XSeason,XBox)
      else
       OneSim%Data(XYear,XSeason,XBox) = MissVal
      end if
     end do
    else
     do XYear = 1, OneSim%YearN
       OneSim%Data(XYear,XSeason,XBox) = MissVal
     end do
    end if
  end do
end do

write (99,*), "smoothing...." 				! ###########################

allocate (Array1D  (OneSim%YearN), &
	  TSLowVec (OneSim%YearN), &
	  TSHighVec(OneSim%YearN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: AnomSmoothSim: Allocation failure #####"

do XBox = 1, BoxN					! smooth
  do XSeason = 1, SeasonN
    TSLowVec = MissVal ; TSHighVec = MissVal
    
    do XYear = 1, OneSim%YearN
      Array1D(XYear) = OneSim%Data(XYear,XSeason,XBox)
    end do
    
    call GaussSmooth (OneSim%YearN,PerLen,1,Array1D,TSLowVec,TSHighVec)
    
    do XYear = 1, OneSim%YearN
      OneSim%Data(XYear,XSeason,XBox) = TSLowVec(XYear)
    end do
  end do
end do

deallocate (Array1D,TSLowVec,TSHighVec, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: AnomSmoothSim: Deallocation failure #####"

write (99,*), "finished anomalising and smoothing" 			! ###########################

end subroutine AnomSmoothSim

!*******************************************************************************
! load the global time series for a particular sim
! these should already be anomalised and smoothed

subroutine LoadSimGloTS

call LoadANN (CurrentExec%SimGloT(XSim), GloTYearAD, AnnNames, FileGloT)	! get global T data
  
if (size(FileGloT,2).NE.1) then
    print "(a,i2,a)", "   > ##### ERROR: LoadSimGloTS: GloT file has multiple columns #####"
else
    call CommonVecPer (YearAD,GloTYearAD,Year0,Year1,FileYear0,FileYear1)
    do XYear = Year0, Year1
      XFileYear = FileYear0 + XYear - 1
      OneSim%GloT (XYear) = FileGloT(XFileYear,1)
    end do
end if
    
deallocate (GloTYearAD,AnnNames,FileGloT,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadSimGloTS: Deallocation failure: GloT info #####"

if (QMethod.GE.10) then  
 call LoadANN (CurrentExec%SimEquT(XSim), EquTYearAD, AnnNames, FileEquT)	! get rad forcing data
  
 if (size(FileEquT,2).NE.1) then
    print "(a,i2,a)", "   > ##### ERROR: LoadSimGloTS: EquT file has multiple columns #####"
    QHalt = 1
 else
    call CommonVecPer (YearAD,EquTYearAD,Year0,Year1,FileYear0,FileYear1)
    do XYear = Year0, Year1
      XFileYear = FileYear0 + XYear - 1
      OneSim%EquT (XYear) = FileEquT(XFileYear,1)
    end do
 end if    
    
 deallocate (EquTYearAD,AnnNames,FileEquT,stat=AllocStat)
 if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadSimGloTS: Deallocation failure: EquT info #####"
end if

if (QRestrictPer.EQ.2) then  
  deallocate (YearAD,stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadSimGloTS: Deallocation failure: YearAD #####"
end if

end subroutine LoadSimGloTS

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

subroutine GetBaseData

call LoadGrim (FileData,FileGrid,FileYearAD,FileBounds,FileInfo,CurrentExec%BaseFile,&
		CurrentExec%Name,Suffix)

call CheckGridAB (Grid,FileGrid,CheckBoxN)
if (CheckBoxN.NE.BoxN) print*, "  > ##### ERROR: LoadSims: grids do not match #####"
  
if (size(FileData,1).NE.1) print*, "  > ##### ERROR: GetBaseData: base length not 1 year #####"

allocate (BaseData(SeasonN,BoxN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: GetBaseData: Allocation failure: BaseData #####"
BaseData = 0.0

do XMonth = 1, MonthN
  do XBox = 1, BoxN
    BaseData (XMonth,XBox) = FileData (1,XMonth,XBox)
  end do
end do
 
deallocate (FileData,FileGrid,FileYearAD,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: GetBaseData: Deallocation failure: File* #####"

do XSeason = 1, 4
  do XBox = 1, BoxN
   do XMonth = 1, 3
    if (BaseData(XSeason+12,XBox).NE.MissVal) then
     ThisMonth = SeasonMonths (((XSeason-1)*3)+XMonth)
     if (BaseData(ThisMonth,XBox).NE.MissVal) then
    	BaseData(XSeason+12,XBox) = BaseData(XSeason+12,XBox) + BaseData(ThisMonth,XBox)
     else
        BaseData(XSeason+12,XBox) = MissVal
     end if
    end if
   end do
   
   if (BaseData(XSeason+12,XBox).NE.MissVal) then
     if (QMeanSum.EQ.1) BaseData(XSeason+12,XBox) = BaseData(XSeason+12,XBox) / 3.0
   end if
  end do
end do
 
do XBox = 1, BoxN
   do XMonth = 1, 12
    if (BaseData(17,XBox).NE.MissVal) then
     if (BaseData(XMonth,XBox).NE.MissVal) then
    	BaseData(17,XBox) = BaseData(17,XBox) + BaseData(XMonth,XBox)
     else
        BaseData(17,XBox) = MissVal
     end if
    end if
   end do
   
   if (BaseData(17,XBox).NE.MissVal) then
     if (QMeanSum.EQ.1) BaseData(17,XBox) = BaseData(17,XBox) / 12.0
   end if
end do 

end subroutine GetBaseData

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

subroutine CalcAllYearN

call ResetCurrentSim ; AllYearN = 0
do						! calcs total Years from all sims
      if (AllYearN.GT.0.AND.associated(CurrentSim%Next)) CurrentSim => CurrentSim%Next
      AllYearN = AllYearN + CurrentSim%YearN

      if (.not.associated(CurrentSim%Next)) exit
end do

end subroutine CalcAllYearN

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

subroutine SaveSeasonGlo

GloFile = trim(GripFile) // '.' // SeasonNames(XSeason) // ".glo"
GloInfo = trim(GripInfo) // ' ' // SeasonNames(XSeason)
call SaveGlo (ExeN,WyeN,BoxN,GloRefFile,GloFile,GloInfo,GloVector,Grid)
nullify (GloVector)

end subroutine SaveSeasonGlo

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

subroutine ResetCurrentSim

do						! resets CurrentSim so that it points at first Sim
      if      (associated(CurrentSim%Prev)) CurrentSim => CurrentSim%Prev
      if (.not.associated(CurrentSim%Prev)) exit
end do

end subroutine ResetCurrentSim

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

subroutine ResetCurrentExec

do						! resets CurrentExec so that it points at first Exec
      if      (associated(CurrentExec%Prev)) CurrentExec => CurrentExec%Prev
      if (.not.associated(CurrentExec%Prev)) exit
end do

end subroutine ResetCurrentExec

!*******************************************************************************
! destroys all sims

subroutine RemoveSims

call ResetCurrentSim

do
      if (associated(CurrentSim%Next)) then			! set stack to next sim...
      	StackSim => CurrentSim%Next	
      else							! ...or if no next sim, nullify
        nullify (StackSim)
      end if
      
      deallocate (CurrentSim, stat=AllocStat)			! deallocate current sim
      if (AllocStat.NE.0) print*, "  > ##### ERROR: RemoveSims: Deallocation failure: CurrentSim #####"
      
      if (     associated(StackSim)) CurrentSim => StackSim  	! set current to next sim...
      if (.not.associated(StackSim)) exit			! ....or exit
end do

end subroutine RemoveSims

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

subroutine RemoveExecs

call ResetCurrentExec

do
      if (associated(CurrentExec%Next)) then			! set stack to next Exec...
      	StackExec => CurrentExec%Next	
      else							! ...or if no next Exec, nullify
        nullify (StackExec)
      end if
      
      deallocate (CurrentExec, stat=AllocStat)			! deallocate current Exec
      if (AllocStat.NE.0) print*, "  > ##### ERROR: RemoveExecs: Deallocation failure: CurrentExec #####"
      
      if (     associated(StackExec)) CurrentExec => StackExec  ! set current to next Exec...
      if (.not.associated(StackExec)) exit			! ....or exit
end do

end subroutine RemoveExecs

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

subroutine Finish

print*
close (99)

deallocate (Grid, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Finish: Deallocation failure: Grid #####"

if (QRestrictPer.EQ.1) then
  deallocate (YearAD, stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: Finish: Deallocation failure: YearAD #####"
end if

call RemoveExecs

end subroutine Finish

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

end program GetPattern