! redomain.f90
! pgf90 -Mstandard -Minfo -fast -Mscalarsse -Mvect=sse -Mflushz 
! 	-o ./../grim/redomain filenames.f90 time.f90 grimfiles.f90 grid.f90 
!	execfiles.f90 ./../grim/redomain.f90
! written by Tim Mitchell on 03.04.01
! last modified on 09.11.01
! this takes a fixed lat/long grid and respecifies the spatial domain 
!	(i.e. valid cells on grid)

program ReDomain

use FileNames
use Time
use GrimFiles
use Grid
use ExecFiles

implicit none

real, pointer, dimension (:,:,:)		:: FileData,OldData,NewData
real, dimension (4)				:: RefBounds,FileBounds,OldBounds

integer, pointer, dimension (:,:)		:: FileGrid,RefGrid,OldGrid
integer, pointer, dimension (:)			:: FileYearAD,OldYearAD

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

real, parameter 		:: MissVal = -999.0

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

integer :: AllocStat,ReadStatus
integer :: YearN, MonthN, BoxN, ExeN, WyeN, ExecN
integer :: FileYearN,FileMonthN,FileBoxN
integer :: RefBoxN,RefExeN,RefWyeN
integer :: OldYearN,OldMonthN,OldBoxN,OldExeN,OldWyeN
integer :: XYear, XMonth, XBox, XExe, XWye, XExec, XCell, XBound
integer :: CheckGrid,CellCheck
integer :: QElimBlank
integer :: SubLen,SubBeg

character (len=80) :: RefFile, CheckFile, GivenFile
character (len=80) :: FileInfo, GivenInfo, OldInfo, NewInfo, NewDomain
character (len=80) :: OrigSub, SpecSub
character (len= 4) :: FileSuffix, CheckSuffix, OldSuffix, NewSuffix

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

open  (99,file="/tyn1/tim/scratch/log-redomain.dat",status="replace",action="write")

call Initialise

print*, "  > NEW DOMAIN. "
call GetReference

call GetExecFiles (nint(MissVal),ExecLoadFile,ExecSaveFile,Subs,NewExecN=ExecN)
call DoTheJob
call Finalise

close (99)

contains

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

subroutine Initialise

print*
print*, "  > ***** ReDomain: for fixed grid, respecifies domain *****"
print*

end subroutine Initialise

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

subroutine GetReference

print*, "  > Choose: use the domain as found (=1), or eliminate blanks (=2): "
do
	read (*,*,iostat=ReadStatus), QElimBlank
	if (ReadStatus.LE.0.AND.QElimBlank.GE.1.AND.QElimBlank.LE.2) exit
end do

if (QElimBlank.EQ.1) then  
  call GrabGrid (1,RefGrid,RefBounds,RefBoxN,Quiet=1)
  
  RefExeN = size (RefGrid,1) ; RefWyeN = size (RefGrid,2)
else
  call LoadGrim (FileData,FileGrid,FileYearAD,RefBounds,FileInfo,RefFile,"    ",FileSuffix)

  RefExeN = size (FileGrid,1) ; RefWyeN = size (FileGrid,2)
  FileYearN = size (FileData,1) ; FileMonthN = size (FileData,2) ; FileBoxN = size (FileData,3) 
  
  allocate (RefGrid(RefExeN,RefWyeN),stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: GetReference: Allocation failure #####"  
  RefGrid = MissVal
  
  XCell = 0
  do XExe = 1, RefExeN
   do XWye = 1, RefWyeN
    if (FileGrid(XExe,XWye).NE.MissVal) then
      CellCheck = 0
      XYear = 0
      
      do
        XYear  = XYear + 1
        XMonth = 0
        
        do
          XMonth = XMonth + 1
          
          if (FileData(XYear,XMonth,FileGrid(XExe,XWye)).NE.MissVal) CellCheck = 1
          if (CellCheck.EQ.1) exit
          if (XMonth.EQ.FileMonthN) exit
        end do
        
        if (CellCheck.EQ.1) exit
        if (XYear.EQ.FileYearN) exit
      end do
      
      if (CellCheck.EQ.1) then
        XCell = XCell + 1
        
        RefGrid(XExe,XWye) = XCell
      end if
    end if
   end do
  end do
  
  RefBoxN = XCell
  print "(a,2i8)", "   > Domain size as found, and without blanks: ", FileBoxN, RefBoxN
  
  deallocate (FileData,FileYearAD,FileGrid,stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: GetReference: Deallocation failure #####"  
end if

print*, "  > Enter the name of the NEW domain: "
do
	read (*,*,iostat=ReadStatus), NewDomain
	if (ReadStatus.LE.0.AND.NewDomain.NE."") exit
end do
    
end subroutine GetReference

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

subroutine DoTheJob

do XExec = 1, ExecN
  call LoadGrim (OldData,OldGrid,OldYearAD,OldBounds,OldInfo,ExecLoadFile(XExec),"    ",OldSuffix)
  
  OldYearN = size (OldData,1) ; OldMonthN = size (OldData,2) ; OldBoxN = size (OldData,3) 
  OldExeN  = size (OldGrid,1) ; OldWyeN   = size (OldGrid,2)
  
  CheckGrid = 0
  if (OldExeN.EQ.RefExeN.AND.OldWyeN.EQ.RefWyeN) then
    do XBound = 1, 4
      if (OldBounds(XBound).NE.RefBounds(XBound)) then
        CheckGrid = 1
        print "(a,i1)", "   > The bounds of the loaded grid do not match the reference: ", XBound
      end if
    end do
  else
    CheckGrid = 1
    print*, "  > The dimensions of the loaded grid do not match the reference."
  end if
  
  if (CheckGrid.EQ.0) then
    allocate (NewData(OldYearN,OldMonthN,RefBoxN), stat=AllocStat)
    if (AllocStat.NE.0) print*, "  > ##### ERROR: DoTheJob: Allocation failure #####"  
    NewData = MissVal
    
    do XExe = 1, RefExeN
      do XWye = 1, RefWyeN
        if (RefGrid(XExe,XWye).NE.MissVal.AND.OldGrid(XExe,XWye).NE.MissVal) then
          do XYear = 1, OldYearN
            do XMonth = 1, OldMonthN
              if (OldData(XYear,XMonth,OldGrid(XExe,XWye)).NE.MissVal) &
              		NewData(XYear,XMonth,RefGrid(XExe,XWye)) = OldData(XYear,XMonth,OldGrid(XExe,XWye))
            end do
          end do
        end if
      end do
    end do
    
    NewInfo = trim(OldInfo) // " ->" // trim(NewDomain)
    
    print "(2a)", "   > Saving: ", trim(adjustl(ExecSaveFile(XExec)))
    call SaveGrim (NewData,RefGrid,OldYearAD,RefBounds,NewInfo,ExecSaveFile(XExec),OldSuffix,NewSuffix,&
    			NoZip=1,Silent=1)

    deallocate (NewData,stat=AllocStat)
    if (AllocStat.NE.0) print*, "  > ##### ERROR: DoTheJob: Deallocation failure #####"  
  else
    print*, "  > ##### ERROR: CheckGrid /= 0 #####"
  end if

  deallocate (OldData,OldGrid,OldYearAD,stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: DoTheJob: Deallocation failure #####"  
end do

end subroutine DoTheJob

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

subroutine Finalise

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

print*

end subroutine Finalise

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

end program ReDomain