! gridshrink.f90
! f90 -o ./../grim/gridshrink filenames.f90 time.f90 grimfiles.f90 grid.f90 execfiles.f90 
!     ./../grim/gridshrink.f90
! written by Tim Mitchell on 06.04.01
! last modified on 12.04.01
! this takes a fixed domain and shrinks the lat/long grid

program GridShrink

use FileNames
use Time
use GrimFiles
use Grid
use ExecFiles

implicit none

real, pointer, dimension (:,:,:)		:: FileData,  OrigData,  ShrinkData
real, dimension (4)				:: FileBounds,OrigBounds,ShrinkBounds

integer, pointer, dimension (:,:)		:: FileGrid,  OrigGrid,  ShrinkGrid, ReGrid
integer, pointer, dimension (:)			:: FileYearAD,OrigYearAD

character (len=80), pointer, dimension (:)	:: ExecLoadFile,ExecSaveFile,ExecSubs

real, parameter :: MissVal = -999.0

real :: OrigLatPerBox,OrigLonPerBox,ShrinkLatPerBox,ShrinkLonPerBox

integer :: AllocStat,ReadStatus
integer :: QOrigGrid,QShrinkGrid
integer :: ExecN,TestBoxN
integer :: OrigExeN,OrigWyeN,OrigBoxN,OrigGlobalN
integer :: ShrinkExeN,ShrinkWyeN,ShrinkBoxN,ShrinkGlobalN,ShrinkExeCept,ShrinkWyeCept
integer :: FileExeN,FileWyeN,FileBoxN,FileYearN,FileMonthN
integer :: XBound,XExec,XShrinkExe,XShrinkWye,XOrigExe,XOrigWye,XYear,XMonth,XShrinkBox
integer :: SubLen,SubBeg
integer :: ValidShrink,CheckShrink

character (len=80) :: OrigFile,ShrinkFile,GivenFile,CheckFile
character (len=80) :: FileInfo,OrigInfo,ShrinkInfo
character (len=80) :: OrigSub,SpecSub
character (len=80) :: ShrinkGridName
character (len= 4) :: FileSuffix,OrigSuffix,CheckSuffix,SaveSuffix

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

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

call Initialise

print*, "  > ORIGINAL GRID."
call GrabGrid (nint(MissVal),OrigGrid,OrigBounds,OrigBoxN,Quiet=1)
OrigExeN = size(OrigGrid,1) ; OrigWyeN = size (OrigGrid,2)

print*
print*, "  > SHRUNK GRID."
call GrabGrid (nint(MissVal),ShrinkGrid,ShrinkBounds,ShrinkBoxN,Quiet=1)
ShrinkExeN = size(ShrinkGrid,1) ; ShrinkWyeN = size (ShrinkGrid,2)
print*, "  > Enter the name of the shrunk grid: "
do
	read (*,*,iostat=ReadStatus), ShrinkGridName
	if (ReadStatus.LE.0.AND.ShrinkGridName.NE."") exit
end do
    
print*
print*, "  > EXECUTIONS."
call GetExecFiles (nint(MissVal),ExecLoadFile,ExecSaveFile,ExecSubs)
ExecN = size (ExecLoadFile)
  
print*
print*, "  > EXECUTING."
call AutoExec  

call Finalise

close (99)

contains

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

subroutine Initialise

print*
print*, "  > ***** GridShrink: for fixed domain, shrink grid *****"
print*

ValidShrink = 0

end subroutine Initialise

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

subroutine AutoExec

do XExec = 1, ExecN
  if (ValidShrink.EQ.0) then
   print*
   print "(2a)", "   > Loading: ", trim(ExecLoadFile(XExec))
   
   call LoadGrim (OrigData,FileGrid,FileYearAD,FileBounds,OrigInfo,ExecLoadFile(XExec),"    ",OrigSuffix)
  
   FileExeN  = size(FileGrid,1) ; FileWyeN   = size(FileGrid,2)
   FileYearN = size(OrigData,1) ; FileMonthN = size(OrigData,2) ; FileBoxN = size(OrigData,3)
  
   do XBound = 1, 4						! check bounds
    if (FileBounds(XBound).NE.OrigBounds(XBound)) then
      print*, "  > Bounds mismatch. File not shrunk."
      ValidShrink = 1
    end if
   end do
  
   if (FileExeN.NE.OrigExeN.OR.FileWyeN.NE.OrigWyeN) then	! check grid dimensions
      print*, "  > Grid mismatch.   File not shrunk."
      ValidShrink = 1
   end if
  
   if (ValidShrink.EQ.0) then
  	print*, "  > File grid dimensions and bounds checked against specifications."
  	call CheckOrigGrid
   end if
  end if
  
  if (ValidShrink.EQ.0.AND.XExec.EQ.1) & 
  	call DefineShrinking(OrigBounds,ShrinkBounds,OrigGrid,ShrinkGrid,ReGrid,CheckShrink)
  ValidShrink = CheckShrink
  
  if (ValidShrink.EQ.0) then  
    ShrinkBoxN = maxval (ShrinkGrid)
    
    allocate (ShrinkData(FileYearN,FileMonthN,ShrinkBoxN), stat=AllocStat)	! allocate shrink data
    if (AllocStat.NE.0) print*, "  > ##### ERROR: AutoExec: Allocation failure #####"
    ShrinkData = MissVal
    
    do XShrinkExe = 1, ShrinkExeN						! fill shrink data
      do XShrinkWye = 1, ShrinkWyeN
        if (ShrinkGrid(XShrinkExe,XShrinkWye).NE.MissVal) then
          do XYear = 1, FileYearN
            do XMonth = 1, FileMonthN
              ShrinkData(XYear,XMonth,ShrinkGrid(XShrinkExe,XShrinkWye)) = &
              		OrigData(XYear,XMonth,ReGrid(XShrinkExe,XShrinkWye))
            end do
          end do
        end if
      end do
    end do
    
    ShrinkInfo = trim(OrigInfo) // " ->" // trim(ShrinkGridName)

    print "(2a)", "   > Saving:  ", trim(ExecSaveFile(XExec))

    call SaveGrim (ShrinkData,ShrinkGrid,FileYearAD,ShrinkBounds,ShrinkInfo, &
    			ExecSaveFile(XExec),OrigSuffix,SaveSuffix)

    deallocate (ShrinkData, stat=AllocStat)					! deallocate shrink data
    if (AllocStat.NE.0) print*, "  > ##### ERROR: AutoExec: Deallocation failure #####"
  end if
  
  if (associated(OrigData)) deallocate (OrigData,FileYearAD,stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: AutoExec: Deallocation failure #####"
end do

end subroutine AutoExec

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

subroutine CheckOrigGrid

if (OrigBoxN.EQ.MissVal) then					! if the original grid is not defined    
      OrigBoxN = FileBoxN					! ...define domain size
      
      do XOrigExe = 1, OrigExeN					! ...fill original grid
        do XOrigWye = 1, OrigWyeN
          OrigGrid(XOrigExe,XOrigWye) = FileGrid(XOrigExe,XOrigWye)
        end do
      end do

      print*, "  > Original domain defined from file domain."
else 								! if the original grid is defined
      if (OrigBoxN.NE.FileBoxN) then				! ...and the file domain size does not match
        print*, "  > Original domain size mismatch. File not shrunk."
        ValidShrink = 1
      else							! ...and the file domain size matches
        do XOrigExe = 1, OrigExeN				! ...check precise domain
          do XOrigWye = 1, OrigWyeN
              if (OrigGrid(XOrigExe,XOrigWye).NE.FileGrid(XOrigExe,XOrigWye)) ValidShrink = 1
          end do
        end do
        
        if (ValidShrink.EQ.1) then 
        	print*, "  > Original domain cells mismatch. File not shrunk."
        else
                print*, "  > File domain checked against original domain."
        end if
      end if
end if

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

end subroutine CheckOrigGrid

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

subroutine Finalise

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

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

if (associated(ExecLoadFile)) deallocate (ExecLoadFile,ExecSaveFile,ExecSubs,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Finalise: Deallocation failure #####"

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

print*

end subroutine Finalise

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

end program GridShrink