! uploadglo.f90
! f90 main program written on 19.03.01 by Tim Mitchell
! last modification on 19.03.01
! pgf90 -o ./../goglo/uploadglo initialmod.f90 filenames.f90 
!	glofiles.f90 ./../goglo/uploadglo.f90
! loads data files into .glo  

program UploadGlo

use InitialMod
use FileNames
use GloFiles

implicit none

real, pointer, dimension (:)		:: RowReal, Glo

integer, pointer, dimension (:) 	:: RegSizes,MapRawReg, RowInt
integer, pointer, dimension (:,:) 	:: MapIDLReg,MapIDLRaw

character (len=20), pointer, dimension (:) 	:: RegNames, Sub

real, parameter :: MissVal = -999.0

real :: FileMissVal,Multiplier,Fraction

integer :: LongN,LatN,DataN, RegN, GloN, HeaderN,RowN,ColN,CellN, BlockN
integer :: AllocStat,ReadStatus
integer :: MaxRegSize,DateCol,Grid
integer :: XRow,XCol,XCell, XReg, XLong,XLat, XHeader, XGlo, XBlock
integer :: StringLen, PosChar
integer :: Cell0,Cell1
integer :: QIntReal,QManuAuto,QDateGreen
integer :: SubLen, FileSubBeg,FileSubEnd, TitleSubBeg,TitleSubEnd, SuffixBeg,SuffixEnd,SuffixLen

character (len=1)  :: CharIntReal
character (len=10) :: GridTitle, OrigSub, ThisSub
character (len=40) :: RegTitle, LineFormat
character (len=80) :: GridFilePath, Blank, GivenFile, FilePath, AutoPath, Trash, GloFilePath, GloTitle

logical, parameter :: True = .TRUE.

!*******************************************************************************
! main program

call Initialise
call DataSpec
if (QManuAuto.EQ.2) call AutoSpec
call LoadData
call Finalise

contains

!*******************************************************************************
! initialise

subroutine Initialise

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

print*, "  > ***** UpLoadGlo *****"
print*

Blank = ""

call GridSelect (Grid,GridTitle,LongN,LatN,DataN,GridFilePath)

print*, "  > The region set must include only one grid box per region."

do
  call RegSelect (Grid,LongN,LatN,DataN,MapIDLReg,RegSizes,RegNames,RegTitle,RegN)
  
  write (99,*), "### got regions..."				! ####################
  
  MaxRegSize = 0
  do XReg = 1, RegN
    if (RegSizes(XReg).GT.MaxRegSize) MaxRegSize = RegSizes(XReg)
  end do
  
  if (MaxRegSize.GT.1) then
	deallocate (MapIDLReg,RegSizes,RegNames, stat=AllocStat)
	if (AllocStat.NE.0) print*, "  > ##### ERROR: Initialise: Deallocation failure #####"
	print*, "  > Not all regions have only a single grid box. Try again."
  end if
  
  if (MaxRegSize.LE.1) exit
end do

print*, "  > Select the number of data files to upload: "
do
	read (*,*,iostat=ReadStatus), GloN
	if (ReadStatus.LE.0) exit
end do

if (GloN.GT.1) then  
  print*, "  > Upload manually (=1) or automatically (=2) ?"
  do
	read (*,*,iostat=ReadStatus), QManuAuto
	if (ReadStatus.LE.0.AND.QManuAuto.GE.1.AND.QManuAuto.LE.2) exit
  end do
else
  QManuAuto = 1
end if

allocate (MapIDLRaw(LongN,LatN), &
          MapRawReg(DataN),      &
          Glo      (RegN),       &
          Sub      (GloN),       stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Initialise: Allocation failure #####"
MapIDLRaw = MissVal
MapRawReg = MissVal
Glo       = MissVal
Sub       = ""

end subroutine Initialise

!*******************************************************************************
! specify automatics

subroutine AutoSpec

print*, "  > Enter the filepath of the first raw data file: "
do
  do
	do
		read (*,*,iostat=ReadStatus), GivenFile
		if (ReadStatus.LE.0) exit
	end do
	
	inquire (file=GivenFile, name=AutoPath)
	open (1, file=AutoPath, status="old", iostat=ReadStatus)
	if (ReadStatus .NE. 0) print*, "  > File cannot be opened. Try again."
	if (ReadStatus .EQ. 0) close (1)
	if (ReadStatus .EQ. 0) exit
  end do
  
  SuffixBeg = index(AutoPath,".",True)
  SuffixLen = len(trim(AutoPath)) - SuffixBeg + 1
  SuffixEnd = SuffixBeg + SuffixLen - 1
  
  if (SuffixBeg.EQ.0) then
  	print*, "  > No .? suffix in filepath. Try again."
  else
  	print*, "  > Suffix recognised: ", AutoPath(SuffixBeg:SuffixEnd)
  end if
  
  if (SuffixBeg.GT.0) exit
end do
  
print*, "  > Enter the substring in the filepath to vary: "
do
	do
		read (*,*,iostat=ReadStatus), OrigSub
		if (ReadStatus.GT.0) then	
			print*, "  > Bad format. Try again."
		else if (OrigSub.EQ."") then
			print*, "  > Blank not permitted. Try again."
		end if
		if (ReadStatus.LE.0.AND.OrigSub.NE."") exit
	end do
	
	SubLen     = len(trim(OrigSub))
	FileSubBeg = index(AutoPath,OrigSub(1:SubLen))
	FileSubEnd = FileSubBeg + SubLen - 1
	
	if (FileSubBeg.EQ.0) print*, "  > Substring not in filepath. Try again."
	if (FileSubBeg.GT.0) exit
end do
  
Sub (1) = OrigSub

print*, "  > Enter the substring in each filepath, starting with no.2:"
do XGlo = 2, GloN
	do
		read (*,*,iostat=ReadStatus), OrigSub
		if (ReadStatus.GT.0) then	
			print*, "  > Bad format. Try again."
		else if (OrigSub.EQ."") then
			print*, "  > Blank not permitted. Try again."
		end if
		if (ReadStatus.LE.0.AND.OrigSub.NE."") exit
	end do

 	Sub (XGlo) = OrigSub
end do
  
print*, "  > Enter the first .glo title (must include first substring): "
do
	do
		read (*,*,iostat=ReadStatus), GloTitle
		if (ReadStatus.GT.0) then	
			print*, "  > Bad format. Try again."
		else if (GloTitle.EQ."") then
			print*, "  > Blank not permitted. Try again."
		end if
		if (ReadStatus.LE.0.AND.GloTitle.NE."") exit
	end do
	
	ThisSub = Sub(1)
	TitleSubBeg = index(GloTitle,ThisSub(1:SubLen))
	TitleSubEnd = TitleSubBeg + SubLen - 1
	
	if (TitleSubBeg.EQ.0) print*, "  > Substring not in title. Try again."
	if (TitleSubBeg.GT.0) exit
end do
    
end subroutine AutoSpec

!*******************************************************************************
! specify data structure in original files

subroutine DataSpec

print*, "  > Enter the number of header lines: "
do
	read (*,*,iostat=ReadStatus), HeaderN
	if (ReadStatus.LE.0.AND.HeaderN.GE.0) exit
end do
  
print*, "  > Enter the number of rows, columns: "
do
	read (*,*,iostat=ReadStatus), RowN, ColN
	if (ReadStatus.LE.0.AND.RowN.GE.1.AND.ColN.GE.1) exit
end do
  
allocate (RowInt (ColN), &
	  RowReal(ColN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: DataSpec: Allocation failure #####"
RowInt  = MissVal
RowReal = MissVal

CellN = RowN * ColN

if (CellN.EQ.DataN) then
  if      (RowN.EQ.LatN.AND.ColN.EQ.LongN) then
    print*, "  > We assume that top-bottom = N-S and left-right = W-E."
    print*, "  > Is the first column the date-line (=1) or Greenwich (=2) ? "
    do
	read (*,*,iostat=ReadStatus), QDateGreen
	if (ReadStatus.LE.0.AND.QDateGreen.GE.1.AND.QDateGreen.LE.2) exit
    end do
  
    if (QDateGreen.EQ.2) then
      DateCol = floor(real(ColN)/2.0)
      XLat  = LatN + 1
      XCell = 0		
      do XRow = 1, RowN	
        XLat = XLat - 1
      
        do XLong = (DateCol+1), LongN
          XCell = XCell + 1
          MapIDLRaw (XLong,XLat) = XCell
        end do
      
        do XLong = 1, DateCol
          XCell = XCell + 1
          MapIDLRaw (XLong,XLat) = XCell
        end do
      end do        
    else if (QDateGreen.EQ.1) then
      XLat  = LatN + 1
      XCell = 0		
      do XRow = 1, RowN	
        XLat = XLat - 1
      
        do XLong = 1, LongN
          XCell = XCell + 1
          MapIDLRaw (XLong,XLat) = XCell
        end do
      end do    
    end if
    
    BlockN = 1
  else if (ColN.EQ.LatN.AND.RowN.EQ.LongN) then
    print*, "  > ##### ERROR: rotated section X not written #####"
  else
    Fraction = real(RowN) / real(LatN)
    							! The grid is actually split by long in file
    if (Fraction.EQ.floor(Fraction)) then		!    but we imagine it as a single grid    
      BlockN = nint (Fraction)

      XLat  = LatN + 1
      XCell = 0						! We assume that 1st col = most westerly.
      do XRow = 1, (nint(real(RowN)/real(BlockN)))	! We assume that 1st row = most northerly.
        XLat  = XLat - 1
        XLong = 0
        
        do XBlock = 1, BlockN
          do XCol = 1, ColN
            XLong = XLong + 1
            XCell = XCell + 1         
            MapIDLRaw (XLong,XLat) = XCell
          end do
       end do
      end do
    else
      print*, "  > ##### ERROR: difficult blocks not written #####"
    end if
  end if
else
  print*, "  > ##### ERROR: The cells in file do not match with grid. #####"
end if

do XLong = 1, LongN
  do XLat = 1, LatN
    if (MapIDLReg (XLong,XLat).NE.MissVal) then
      MapRawReg (MapIDLRaw (XLong,XLat)) = MapIDLReg (XLong, XLat)
    end if
  end do
end do

print*, "  > Enter the data line format, as multiples of i,f,e: "
do
	read (*,*,iostat=ReadStatus), LineFormat
	
	StringLen = len (trim(LineFormat))	
        
	PosChar = max (scan(LineFormat,'I'),scan(LineFormat,'i'),scan(LineFormat,'F'),scan(LineFormat,'f'))
	PosChar = max (scan(LineFormat,'E'),scan(LineFormat,'e'),PosChar)
	
	CharIntReal = ""
	if (PosChar.GT.0) CharIntReal = LineFormat(PosChar:PosChar)
	
	if (LineFormat(1:1).NE."(" .OR. LineFormat(StringLen:StringLen).NE.")") then
	    ReadStatus = 99
	    print*, "  > Format is unacceptable. Retry."
	else 
	  if      (CharIntReal.EQ.'I'.OR.CharIntReal.EQ.'i') then
	    QIntReal = 1
	  else if (CharIntReal.EQ.'F'.OR.CharIntReal.EQ.'f') then
	    QIntReal = 2
	  else if (CharIntReal.EQ.'F'.OR.CharIntReal.EQ.'f') then
	    QIntReal = 2
	  else
	    ReadStatus = 99
	    print*, "  > Format is unacceptable. Retry."
	  end if
	end if
	
	if (ReadStatus.LE.0) exit
end do
    
print*, "  > Enter the multiplier by which to convert data: "
do
	read (*,*,iostat=ReadStatus), Multiplier
	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 DataSpec

!*******************************************************************************
! load data

subroutine LoadData

do XGlo = 1, GloN
  if (QManuAuto.EQ.1) then
    print*
    print "(a,i2)", "   > Enter the filepath of raw data file: ", XGlo
    do
	do
		read (*,*,iostat=ReadStatus), GivenFile
		if (ReadStatus.LE.0) exit
	end do
	
	inquire (file=GivenFile, name=FilePath)
	open (1, file=FilePath, status="old", iostat=ReadStatus)
	if (ReadStatus .EQ. 0) close (1)
	if (ReadStatus .EQ. 0) exit
    end do  
    print*, "  > Loading data..."
  else
    ThisSub  = Sub(XGlo)
    FilePath = AutoPath(1:(FileSubBeg-1)) // ThisSub(1:SubLen) // AutoPath((FileSubEnd+1):80)
    print "(a,a)", "   > Loading: ", trim(FilePath)
  end if
  
  open (2,file=FilePath,status="old",access="sequential",action="read",form="formatted") 

  if (HeaderN.GT.0) then				! load headers
    do XHeader = 1, HeaderN
      read (2,"(a80)"), Trash
    end do
  end if
  
  XCell = 0
  do XRow = 1, RowN					! load data by row,block,col into long vector
      if (QIntReal.EQ.1) then
      	read (2,fmt=LineFormat), (RowInt (XCol), XCol=1,ColN)
        
      	do XCol = 1, ColN
      	  XCell = XCell + 1
      	  Glo(MapRawReg(XCell)) = real (RowInt (XCol))

          if (Glo(MapRawReg(XCell)).NE.FileMissVal) then
            Glo(MapRawReg(XCell)) = Glo(MapRawReg(XCell)) * Multiplier
          else
            Glo(MapRawReg(XCell)) = MissVal
          end if
      	end do
      else if (QIntReal.EQ.2) then
      	read (2,fmt=LineFormat), (RowReal(XCol), XCol=1,ColN)

      	do XCol = 1, ColN
      	  XCell = XCell + 1
      	  Glo(MapRawReg(XCell)) = RowReal (XCol)

          if (Glo(MapRawReg(XCell)).NE.FileMissVal) then
            Glo(MapRawReg(XCell)) = Glo(MapRawReg(XCell)) * Multiplier
          else
            Glo(MapRawReg(XCell)) = MissVal
          end if
      	end do
      end if
  end do
  
  close (2)

  if (QManuAuto.EQ.1) then
    GloFilePath = Blank
    GloTitle    = Blank
  else
    ThisSub     = Sub(XGlo)
    GloFilePath = FilePath(1:(SuffixBeg-1)) // ".glo"
    GloTitle    = GloTitle(1:(TitleSubBeg-1)) // ThisSub(1:SubLen) // GloTitle((TitleSubEnd+1):80)
    print "(a,a)", "   > Saving:  ", trim(GloFilePath)
  end if

  call SaveGlo (LongN,LatN,RegN, GridFilePath, GloFilePath, GloTitle, Glo, MapIDLReg)
  
  Glo = MissVal
end do

end subroutine LoadData

!*******************************************************************************
! finalise

subroutine Finalise

close (99)

print*

deallocate (MapIDLReg,RegSizes,RegNames,MapIDLRaw,MapRawReg,RowInt,RowReal,Glo,Sub, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Finalise: Deallocation failure #####"

end subroutine Finalise

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

end program UploadGlo