! boxtogrim.f90
! f90 program written by Tim Mitchell on 17.12.01
! last modified on 01.04.03
! converts raw data file (lat,long,1or12*mon) into grim file
! pgf90 -Mstandard -Minfo -fast -Mscalarsse -Mvect=sse -Mflushz 
! 	-o ./../grim/boxtogrim filenames.f90 time.f90 grimfiles.f90 grid.f90 
!    	./../grim/boxtogrim.f90

program BoxToGrim

use FileNames
use Time
use GrimFiles
use Grid

implicit none

real, pointer, dimension (:,:,:)		:: Data
real, dimension (12)				:: LineData
real, dimension (4)				:: Bounds

integer, pointer, dimension (:,:)		:: RefGrid
integer, pointer, dimension (:)			:: YearAD

character (len=80), pointer, dimension (:)	:: RawPaths,SavePaths

real, parameter :: MissVal = -999.0

real :: Lat,Long,Elev
real :: FileMissVal,FileMulti
real :: BoxEW,BoxNS

integer :: ReadStatus,AllocStat
integer :: BoxN,HeaderN,LineN,ValidN,MonthN,LongN,LatN,PathN
integer :: XBox,XHeader,XLine,XValid,XMonth,XLong,XLat,XPath
integer :: OnlyAD,FullLen,SubBeg,SubOldLen,SubNewLen,QFormat
integer :: BoxMiss,MissTot

character (len=80) :: GivenFile,CheckFile,RawFile,GrimFile,LineFormat,Trash,GrimInfo
character (len=80) :: SubStringOld,SubStringNew
character (len=04) :: GrimSuffix,SaveSuffix

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

call Intro
call GetFiles
call Specifics
do XPath = 1, PathN
  print*
  print "(2a)", "   > Load: ", trim(RawPaths(XPath))
  call LoadRaw
!  print "(2a)", "   > Save: ", trim(SavePaths(XPath))
  call SaveGrim (Data,RefGrid,YearAD,Bounds,GrimInfo,SavePaths(XPath),"    ",SaveSuffix,NoZip=1)
end do
call Conclude

contains

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

subroutine Intro

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

print*
print*, "  > ***** BoxToGrim: converts raw data file into grim file *****"
print*

end subroutine Intro

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

subroutine GetFiles

print*, "  > Enter the filter describing the RAW files to load: "
do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0.AND.GivenFile.NE."") exit
end do
call GetBatch (GivenFile,RawPaths)
PathN = size(RawPaths,1)

print*, "  > Enter the substring to alter: "
do
	read (*,*,iostat=ReadStatus), SubStringOld
	if (ReadStatus.LE.0.AND.SubStringOld.NE."") exit
end do

print*, "  > Enter the new substring in the SAVE files: "
do
	read (*,*,iostat=ReadStatus), SubStringNew
	if (ReadStatus.LE.0.AND.SubStringNew.NE."") exit
end do

allocate (SavePaths(PathN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: GetFiles: Allocation failure #####"
SavePaths = "./"

do XPath = 1, PathN
  GivenFile = RawPaths(XPath)
  FullLen = len_trim(GivenFile)
  SubOldLen = len_trim(SubStringOld)
  SubNewLen = len_trim(SubStringNew)
  SubBeg = index(GivenFile,trim(SubStringOld))
  if (SubBeg.GT.0) then
  	SavePaths(XPath)=GivenFile(1:SubBeg-1) // trim(SubStringNew)
  	if (FullLen.GE.SubBeg+SubOldLen) SavePaths(XPath)=trim(SavePaths(XPath)) // &
  			GivenFile(SubBeg+SubOldLen:FullLen)
  end if  
end do

print*, "  > Enter the info line in the SAVE files: "
do
	read (*,*,iostat=ReadStatus), GrimInfo
	if (ReadStatus.LE.0.AND.GrimInfo.NE."") exit
end do

end subroutine GetFiles

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

subroutine Specifics

print*, "  > Identify the RefGrid of the raw files, using a template grim." 
call GrabGrid (1,RefGrid,Bounds,BoxN,Quiet=1)
LongN = size(RefGrid,1)
LatN  = size(RefGrid,2)
BoxEW = (Bounds(2)-Bounds(1)) / real(LongN)
BoxNS = (Bounds(4)-Bounds(3)) / real(LatN)

print*, "  > Enter the year AD of the raw files: "
do
	read (*,*,iostat=ReadStatus), OnlyAD
	if (ReadStatus.LE.0) exit
end do

allocate (Data(1,12,BoxN), &
	  YearAD(1), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Specifics: Allocation failure #####"
YearAD(1) = OnlyAD

print*, "  > Enter the number of headers: "
do
	read (*,*,iostat=ReadStatus), HeaderN
	if (ReadStatus.LE.0.AND.HeaderN.GE.0) exit
end do

print*, "  > Select a format 0:lat,lon,elv,12*mon ;  1:lat,lon,1*ann"
do
	read (*,*,iostat=ReadStatus), QFormat
	if (ReadStatus.LE.0.AND.QFormat.GE.0.AND.QFormat.LE.1) exit
end do

print*, "  > Enter the line format (all reals): "
do
	read (*,*,iostat=ReadStatus), LineFormat
	if (ReadStatus.LE.0.AND.LineFormat.NE."") exit
end do

print*, "  > Enter the data multiplier: "
do
	read (*,*,iostat=ReadStatus), FileMulti
	if (ReadStatus.LE.0) exit
end do

print*, "  > Enter the file missing value: "
do
	read (*,*,iostat=ReadStatus), FileMissVal
	if (ReadStatus.LE.0) exit
end do

end subroutine Specifics

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

subroutine LoadRaw

call system ('wc -l ' // trim(RawPaths(XPath)) // ' > trashme.txt')	! get number of lines
open  (3,file='trashme.txt',status="old",access="sequential",form="formatted",action="read")
read  (3,"(i10)"), LineN
close (3)
call system ('rm trashme.txt')

Data = MissVal

open (1,file=RawPaths(XPath),status="old",access="sequential",action="read",form="formatted") 

ValidN = LineN - HeaderN

if (HeaderN.GT.0) then
  do XHeader = 1, HeaderN
    read (1,*), Trash
  end do
end if

BoxMiss = 0.0 ; MissTot = 0.0
do XValid = 1, ValidN
  if      (QFormat.EQ.0) then
    read (1,LineFormat), Lat, Long, Elev, (LineData(XMonth),XMonth=1,12)
  else if (QFormat.EQ.1) then
    read (1,LineFormat), Lat, Long, LineData(1)
    do XMonth = 2, 12
      LineData(XMonth)=LineData(1)
    end do
    Elev=MissVal
  end if
  
  XLong = nint(((Long-Bounds(1))/BoxEW)+0.5)
  XLat  = nint(((Lat -Bounds(3))/BoxNS)+0.5)
  
  if (XLong.GE.1.AND.XLong.LE.LongN.AND.XLat.GE.1.AND.XLat.LE.LatN) then
   if (RefGrid(XLong,XLat).NE.MissVal) then
    XBox = RefGrid(XLong,XLat)
   else
    BoxMiss = BoxMiss +  1
    MissTot = MissTot + 12
    XBox = MissVal
   end if
  else
    BoxMiss = BoxMiss +  1
    MissTot = MissTot + 12
    XBox = MissVal
  end if
  
  if (XBox.NE.MissVal) then
    do XMonth = 1, 12
      if (LineData(XMonth).NE.FileMissVal) then
        Data(1,XMonth,XBox) = LineData(XMonth) * FileMulti
      else
        MissTot = MissTot + 1
      end if
    end do
  end if
end do

close (1)

print "(a,3i10)", "   > Boxes in: grid,file,both: ", BoxN,ValidN,(ValidN-BoxMiss) 
print "(a,2i10)", "   > All raw data, missing:    ", (12*ValidN), MissTot

end subroutine LoadRaw

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

subroutine Conclude

deallocate (Data,RefGrid,YearAD, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Conclude: Deallocation failure #####"

print*

close (99)

end subroutine Conclude

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

end program BoxToGrim