! montogrim.f90
! f90 main program written on 02.05.01 by Tim Mitchell
! last modification on 17.06.02
! pgf90 -Mstandard -Minfo -fast -Mscalarsse -Mvect=sse -Mflushz 
! 	-o ./../grim/montogrim filenames.f90 initialmod.f90 time.f90 
!	grimfiles.f90 ./../grim/montogrim.f90 2> /tyn1/tim/scratch/stderr.txt
! loads .mon file(s) into standard grim files
! NOW: the 96*73 files are NOT uploaded as 192*144, BUT as 97*73 

program MonToGrim

use FileNames
use InitialMod
use Time
use GrimFiles

implicit none

real, pointer, dimension (:,:,:)		:: GrimData
real, pointer, dimension (:,:)			:: MonRealData

integer, pointer, dimension (:,:) 		:: GrimGrid, MonIntData
integer, pointer, dimension (:) 		:: YearAD, GrimRow,GrimCol,GrimLat,GrimLon
integer, dimension (8) 				:: HeaderInt

character (len=80), pointer, dimension (:,:) 	:: MonFile
character (len=80), pointer, dimension (:) 	:: GrimFile

real, dimension (4) 				:: GrimBounds

real, parameter 		:: MissVal = -999.0

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

real :: FileMissVal,Fraction,Factor,Multiplier

integer :: AllocStat,ReadStatus
integer :: MonLonN,MonLatN,MonRowN,MonColN,MonBoxN,MonDataN,MonFileN,MonYearN,MonHeadN 
integer :: ExecN,YearN,MonthN, GrimExeN,GrimWyeN,GrimDataN, FinalColN,YearHeadN
integer :: XMonHead,XMonFile,XMonRow,XMonCol,XMonBox,XMonDatum,XMonLon,XMonLat,XMonYear
integer :: XYear,XMonth,XBound,XExec,XBox,XYearHead
integer :: XGrimExe,XGrimWye,XGrimDatum
integer :: StringLen, PosChar, Col0Box
integer :: Box0,Box1, YearAD0,YearAD1
integer :: QIntReal,QGreenDate,QZip,QDataGrim,QNorthSouth,QDataSpec,QNoZip,QSaveZip,QWritePerm,QSilent
integer :: QModelChoice,QVinerDKRZ
integer :: SubLen, SubBeg, SuffixBeg,SuffixEnd,SuffixLen, GrimSubBeg, YearSubLen,YearSubBeg,YearSubEnd
integer :: LoadFileLen,NameBeg,MissTot,FileMissTot, FullLen,SpecLen
integer :: OldSub0Beg,OldSub1Beg,NoZip

character (len=1)  :: CharIntReal
character (len=4)  :: SaveSuffix, RefSuffix, ThisSuffix
character (len=10) :: GridTitle
character (len=20) :: OldSub0,OldSub1,NewSub0,NewSub1
character (len=40) :: LineFormat,FinalFormat
character (len=80) :: OrigSub, ThisSub, YearSub, SpecSub
character (len=80) :: GridFilePath,GivenFile,FilePath,AutoLoadPath,AutoSavePath,RefFile,LoadFile,LoadName
character (len=80) :: Info, InfoItem, Variable
character (len=80) :: Trash, GridFile

logical, parameter :: True = .TRUE.

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

call Initialise

call GridSelect (QModelChoice,GridTitle,MonLonN,MonLatN,MonDataN,GridFile)
call GetGridBasics
call GetInfoLine
call FileSpec

call FirstExec
if (ExecN.GT.1) call AutoExecSpec

call SelectStructure
call AutoDataSpec

call LoadData

call Finalise

contains

!*******************************************************************************
! initialise
! in this program we take raw data files organised as sequential spatial grids
!   (one grid per month, with FileYearN * 12 months (Jan,Feb,...,Dec) * YearN per file)
! we store the data in standard grim files

subroutine Initialise

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

print*
print*, "  > ***** MonToGrim : store .mon data as grim files *****"
print*

end subroutine Initialise

!*******************************************************************************
! specify .mon domain and grid

subroutine GetGridBasics

MonBoxN=MonDataN
if      (QModelChoice.EQ. 2) then
  GrimExeN = 128 ; GrimWyeN = 64  ; GrimDataN = 8192
  GrimBounds(1) = -182.8125 ; GrimBounds(2) = 177.1875 
  GrimBounds(3) = -90.0 ; GrimBounds (4) = 90.0
else if (QModelChoice.EQ. 3) then
  GrimExeN = 97  ; GrimWyeN = 73  ; GrimDataN = 7081
  GrimBounds(1) = -181.875 ; GrimBounds(2) = 181.875 
  GrimBounds(3) = -91.25 ; GrimBounds (4) = 91.25
else if (QModelChoice.EQ. 5) then
  GrimExeN = 96  ; GrimWyeN = 48  ; GrimDataN = 4608
  GrimBounds(1) = -181.875 ; GrimBounds(2) = 178.125 
  GrimBounds(3) = -90.0 ; GrimBounds (4) = 90.0
else if (QModelChoice.EQ. 6) then			! CSIRO
  GrimExeN = 64  ; GrimWyeN = 56  ; GrimDataN = 3584
  GrimBounds(1) = -182.8125 ; GrimBounds(2) = 177.1875 
  GrimBounds(3) = -90.0 ; GrimBounds (4) = 90.0
else if (QModelChoice.EQ.11) then
  GrimExeN = 128 ; GrimWyeN = 64  ; GrimDataN = 8192
  GrimBounds(1) = -181.40625 ; GrimBounds(2) = 178.59375 
  GrimBounds(3) = -90.0 ; GrimBounds (4) = 90.0
else if (QModelChoice.EQ.12) then
  GrimExeN = 720 ; GrimWyeN = 360 ; GrimDataN = 259200
  GrimBounds(1) = -180.0 ; GrimBounds(2) = 180.0 
  GrimBounds(3) = -90.0 ; GrimBounds (4) = 90.0
else if (QModelChoice.EQ.22) then
  GrimExeN =  72 ; GrimWyeN =  36 ; GrimDataN = 2592
  GrimBounds(1) = -180.0 ; GrimBounds(2) = 180.0 
  GrimBounds(3) = -90.0 ; GrimBounds (4) = 90.0
else
  print*, "  > @@@@@ ERROR: Model not coded into montogrim 1 @@@@@"
end if

end subroutine GetGridBasics

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

subroutine GetInfoLine

Info = ""
if      (QModelChoice.EQ.2) then
  Info = "grid=ECHam4"
else if (QModelChoice.EQ.3) then
  Info = "grid=h2"
else if (QModelChoice.EQ.5) then
  Info = "grid=CCCma"
else if (QModelChoice.EQ.6) then
  Info = "grid=CSIRO"
else if (QModelChoice.EQ.11) then
  Info = "grid=PCM"
else if (QModelChoice.EQ.12) then
  Info = "grid=0.5"
else if (QModelChoice.EQ.22) then
  Info = "grid=5.0"
end if
if (Info.EQ."") print*, "  > @@@@@ ERROR: Model not coded into montogrim 2 @@@@@"

print*, "  > Name the scenario: "
do
	read (*,*,iostat=ReadStatus), InfoItem
	if (ReadStatus.LE.0.AND.InfoItem.NE."") exit
end do
Info = trim(Info) // " " // trim(InfoItem)

end subroutine GetInfoLine

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

subroutine FileSpec

print*, "  > Select the number of .mon files to upload: "
do
	read (*,*,iostat=ReadStatus), MonFileN
	if (ReadStatus.LE.0.AND.MonFileN.GE.1) exit
end do

print*, "  > How many years are in each .mon file ? "
do
	read (*,*,iostat=ReadStatus), MonYearN
	if (ReadStatus.LE.0.AND.MonYearN.GE.1) exit
end do

print*, "  > What is the first year AD of the first .mon file ? "
do
	read (*,*,iostat=ReadStatus), YearAD0
	if (ReadStatus.LE.0) exit
end do

YearN   = (MonFileN * MonYearN)
YearAD1 = YearAD0 + YearN - 1
MonthN  = 12

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

allocate (YearAD(YearN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FileSpec: Allocation failure #####"

do XYear = 1, YearN
  YearAD(XYear) = YearAD0 + XYear - 1
end do

end subroutine FileSpec

!*******************************************************************************
! specify first execution

subroutine FirstExec

if (ExecN.GT.1)    print*, "  > Specify the first execution. "

allocate (MonFile (ExecN,MonFileN), &
          GrimFile(ExecN),          stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: AutoExecSpec: Allocation failure #####"

print*, "  > Enter the filepath of the .mon or .dat file: "
do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0.AND.GivenFile.NE."") exit
end do
MonFile(1,1) = LoadPath (GivenFile,"    ")

print*, "  > Do you have write permission for this location (1=no,2=yes) ? "
do
	read (*,*,iostat=ReadStatus), QWritePerm
	if (ReadStatus.LE.0.AND.QWritePerm.GE.1.AND.QWritePerm.LE.2) exit
end do

if (MonFileN.GT.1) then
  OldSub0 = GetTextFromInt (YearAD0)					! start year of first .mon file
  OldSub1 = GetTextFromInt (YearAD0+MonYearN-1)				! last year
  
  SubLen = len_trim(OldSub0)						! length of subs
  
  do XMonFile = 2, MonFileN
    NewSub0 = GetTextFromInt (YearAD0 + ((XMonFile-1)*MonYearN))	! start year of this .mon file
    NewSub1 = GetTextFromInt (YearAD0 + ( XMonFile   *MonYearN) - 1) 	! last year
  
    GivenFile = MonFile(1,1)
    
    OldSub0Beg = index(GivenFile,trim(OldSub0))
    OldSub1Beg = index(GivenFile,trim(OldSub1))
    
    GivenFile (OldSub0Beg:(OldSub0Beg+SubLen-1)) = trim(NewSub0)
    GivenFile (OldSub1Beg:(OldSub1Beg+SubLen-1)) = trim(NewSub1)
    
    MonFile (1,XMonFile) = GivenFile
  end do
end if
  
print*, "  > Enter the filepath of the grim file to save: "
do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0.AND.GivenFile.NE."") exit
end do	
call ReviewCall (GivenFile,"    ",AutoSavePath,SaveSuffix,2)	! checks for file/suffix consistency
GrimFile(1) = AutoSavePath

QSaveZip=2
!print*, "  > Decide whether to zip save file (=1), or not (=2): "
!do
!	read (*,*,iostat=ReadStatus), QSaveZip
!	if (ReadStatus.LE.0.AND.QSaveZip.GE.1.AND.QSaveZip.LE.2) exit
!end do	

end subroutine FirstExec
    
!*******************************************************************************
! specify automatics

subroutine AutoExecSpec

print*, "  > Enter the substring to vary from the first .mon: "
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))
  
print*, "  > Enter the substring in each execution, starting with no.2:"
do XExec = 2, ExecN
	do
		read (*,*,iostat=ReadStatus), SpecSub
		if (ReadStatus.GT.0) then	
			print*, "  > Bad format. Try again."
		else if (SpecSub.EQ."") then
			print*, "  > Blank not permitted. Try again."
			ReadStatus = 1
		end if
		if (ReadStatus.LE.0) exit
	end do
        
        do XMonFile = 1, MonFileN
          GivenFile = MonFile(1,XMonFile)
          FullLen=len_trim(GivenFile) ; SpecLen=len_trim(Specsub)
          SubBeg = index(GivenFile,OrigSub(1:SubLen))
          MonFile(XExec,XMonFile) = GivenFile(1:SubBeg-1) // trim(SpecSub)
          if (FullLen.GE.SubBeg+SubLen) &
          	MonFile(XExec,XMonFile) = trim(MonFile(XExec,XMonFile)) // GivenFile(SubBeg+SubLen:FullLen)
        end do
end do
  
print*, "  > Enter the substring to vary from the first grim: "
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))
  
print*, "  > Enter the substring in each execution, starting with no.2:"
do XExec = 2, ExecN
	do
		read (*,*,iostat=ReadStatus), SpecSub
		if (ReadStatus.GT.0) then	
			print*, "  > Bad format. Try again."
		else if (SpecSub.EQ."") then
			print*, "  > Blank not permitted. Try again."
			ReadStatus = 1
		end if
		if (ReadStatus.LE.0) exit
	end do
        
        GivenFile = GrimFile(1)
        FullLen=len_trim(GivenFile) ; SpecLen=len_trim(Specsub)
        SubBeg = index(GivenFile,OrigSub(1:SubLen))
        GrimFile(XExec) = GivenFile(1:SubBeg-1) // trim(SpecSub)
        if (FullLen.GE.SubBeg+SubLen) &
        	GrimFile(XExec) = trim(GrimFile(XExec)) // GivenFile(SubBeg+SubLen:FullLen)
end do
  
end subroutine AutoExecSpec

!*******************************************************************************
! select original file structure

subroutine SelectStructure

print*, "  > Load from Viner .mon (=1) or DKRZ output (=2) ?"
do
	read (*,*,iostat=ReadStatus), QVinerDKRZ
	if (ReadStatus.LE.0.AND.QVinerDKRZ.GE.1.AND.QVinerDKRZ.LE.2) exit
end do

if (QVinerDKRZ.EQ.1) then
  print*, "  > Select the .mon file structure (-1=list): "
  do
	read (*,*,iostat=ReadStatus), QDataSpec
	if (QDataSpec.EQ.-1) then
  		print*, "  >  0. HadCM2  6e12.5 N-S Gr-E 10000.00"
  		print*, "  >  1. HadCM2  6e12.5 N-S Gr-E  -999.00"
  		print*, "  >  2. HadCM2  10f8.2 N-S Gr-E  9999.99"
  		print*, "  >  3. HadCM2 96e16.7 N-S Gr-E  -999.90"
  		print*, "  >  4. 2.5deg  6e12.5 N-S Gr-E -9999.00"
  		print*, "  >  5. 0.5deg  6e12.5 N-S Gr-E -9999.00"
  		print*, "  >  6. CSIRO   10f8.2 N-S Gr-E -9999.99"
  		print*, "  >  7. CCCma   10f8.2 N-S Gr-E -9999.99"
  		print*, "  >  8. 0.5deg   720i5 N-S Gr-E -9999.00"
  		print*, "  >  9. 0.5deg   720i5 S-N DL-E -9999.00"
  		print*, "  > 10. 5.0deg    72i5 N-S DL-E -9999.00"
  		print*, "  > 11. ECHam4  10f8.2 N-S Gr-E  9999.99"
	end if
	if (ReadStatus.LE.0.AND.QDataSpec.GE.0.AND.QDataSpec.LE.11) exit
  end do
else
  QDataSpec = -1
end if

if (QDataSpec.EQ.-1) then
  call GetFirstLine
else if (QDataSpec.EQ.0) then
  MonHeadN = 6 ; MonColN = 6 ; MonRowN = 1168 ; MonBoxN = 7008 ; MonDataN = 7008
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(6e12.5)" ; QIntReal = 2 ; FileMissVal = 10000.0
  FinalFormat=LineFormat ; FinalColN=MonColN
else if (QDataSpec.EQ.1) then
  MonHeadN = 6 ; MonColN = 6 ; MonRowN = 1168 ; MonBoxN = 7008 ; MonDataN = 7008
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(6e12.5)" ; QIntReal = 2 ; FileMissVal = -999.0
  FinalFormat=LineFormat ; FinalColN=MonColN
else if (QDataSpec.EQ.2) then
  MonHeadN = 6 ; MonColN = 10 ; MonRowN = 701 ; MonBoxN = 7008 ; MonDataN = 7008
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(10f8.2)" ; QIntReal = 2 ; FileMissVal = 9999.99
  FinalFormat="(8f8.2)" ; FinalColN=8
else if (QDataSpec.EQ.3) then
  MonHeadN = 0 ; MonColN = 96 ; MonRowN = 73 ; MonBoxN = 7008 ; MonDataN = 7008
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(96e16.7)" ; QIntReal = 2 ; FileMissVal = -999.9
  FinalFormat=LineFormat ; FinalColN=MonColN
else if (QDataSpec.EQ.4) then
  MonHeadN = 0 ; MonColN = 6 ; MonRowN = 1728  ; MonBoxN = 10368  ; MonDataN = 10368
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(6e12.5)" ; QIntReal = 2 ; FileMissVal = -9999.0
  FinalFormat=LineFormat ; FinalColN=MonColN
else if (QDataSpec.EQ.5) then
  MonHeadN = 0 ; MonColN = 6 ; MonRowN = 43200 ; MonBoxN = 259200 ; MonDataN = 259200
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(6e12.5)" ; QIntReal = 2 ; FileMissVal = -9999.0
  FinalFormat=LineFormat ; FinalColN=MonColN
else if (QDataSpec.EQ.6) then			! @@@@@@@@@ check MonHeadN @@@@@@@@@@@
  MonHeadN = 5 ; MonColN = 10 ; MonRowN = 359 ; MonBoxN = 3584 ; MonDataN = 3584
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(10f8.2)" ; QIntReal = 2 ; FileMissVal = -9999.99
  FinalFormat="(4f8.2)" ; FinalColN=4
else if (QDataSpec.EQ.7) then			! @@@@@@@@@ check MonHeadN @@@@@@@@@@@
  MonHeadN = 5 ; MonColN = 10 ; MonRowN = 461 ; MonBoxN = 4608 ; MonDataN = 4608
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(10f8.2)" ; QIntReal = 2 ; FileMissVal = -9999.99
  FinalFormat="(8f8.2)" ; FinalColN=8
else if (QDataSpec.EQ.8) then
  MonHeadN = 0 ; MonColN = 720 ; MonRowN = 360 ; MonBoxN = 259200 ; MonDataN = 259200
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(720i5)" ; QIntReal = 1 ; FileMissVal = -9999.0
  FinalFormat=LineFormat ; FinalColN=MonColN
else if (QDataSpec.EQ.9) then
  MonHeadN = 0 ; MonColN = 720 ; MonRowN = 360 ; MonBoxN = 259200 ; MonDataN = 259200
  QNorthSouth = 2 ; QGreenDate = 2 ; YearHeadN=2
  LineFormat = "(720i5)" ; QIntReal = 1 ; FileMissVal = -9999.0
  FinalFormat=LineFormat ; FinalColN=MonColN
else if (QDataSpec.EQ.10) then
  MonHeadN = 0 ; MonColN = 72 ; MonRowN = 36 ; MonBoxN = 2592 ; MonDataN = 2592
  QNorthSouth = 1 ; QGreenDate = 2 ; YearHeadN=0
  LineFormat = "(9x,72i6)" ; QIntReal = 1 ; FileMissVal = -9999.0
  FinalFormat=LineFormat ; FinalColN=MonColN
else if (QDataSpec.EQ.11) then
  MonHeadN = 6 ; MonColN = 10 ; MonRowN = 820 ; MonBoxN = 8192 ; MonDataN = 8192
  QNorthSouth = 1 ; QGreenDate = 1 ; YearHeadN=0
  LineFormat = "(10f8.2)" ; QIntReal = 2 ; FileMissVal = 9999.0
  FinalFormat="(2f8.2)" ; FinalColN=2
else
  print*, "  > ##### ERROR: AutoDataSpec: file structure undefined #####"
end if

print*, "  > Enter the multiplier to convert original to degC,mm,etc: "
do
	read (*,*,iostat=ReadStatus), Multiplier
	if (ReadStatus.LE.0) exit
end do

end subroutine SelectStructure

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

subroutine AutoDataSpec

allocate (GrimGrid(GrimExeN,GrimWyeN), &
	  GrimRow (GrimDataN),         &
  	  GrimCol (GrimDataN),         &
  	  GrimLat (GrimDataN),         &
  	  GrimLon (GrimDataN),         stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: AutoDataSpec: Allocation failure: Grim* #####"
  
do XGrimExe = 1, GrimExeN
  do XGrimWye = 1, GrimWyeN
    GrimGrid(XGrimExe,XGrimWye) = ((XGrimExe-1)*GrimWyeN) + XGrimWye		! fill GrimGrid
  end do
end do

if (QNorthSouth.EQ.1) then			! provide latitude indices
  XMonLat = MonLatN + 1						
  do XGrimWye = 1, MonLatN
    XMonLat = XMonLat - 1
    
    do XGrimExe = 1, MonLonN
      GrimLat(GrimGrid(XGrimExe,XGrimWye)) = XMonLat
    end do
  end do
else
  do XGrimWye = 1, MonLatN
    do XGrimExe = 1, MonLonN
      GrimLat(GrimGrid(XGrimExe,XGrimWye)) = XGrimWye
    end do
  end do
end if

if (QGreenDate.EQ.1) then	 		! provide longitude indices
  XMonLon = 0
  do XGrimExe = (MonLonN/2)+1,MonLonN
    XMonLon = XMonLon + 1
    
    do XGrimWye = 1, MonLatN
      GrimLon(GrimGrid(XGrimExe,XGrimWye)) = XMonLon
    end do
  end do

  XMonLon = MonLonN/2
  do XGrimExe = 1,(MonLonN/2)
    XMonLon = XMonLon + 1
    
    do XGrimWye = 1, MonLatN
      GrimLon(GrimGrid(XGrimExe,XGrimWye)) = XMonLon
    end do
  end do
else
  do XGrimExe = 1, MonLonN
    do XGrimWye = 1, MonLatN
      GrimLon(GrimGrid(XGrimExe,XGrimWye)) = XGrimExe
    end do
  end do
end if

do XGrimExe = 1, MonLonN				! now using this info we calc the row and col
  do XGrimWye = 1, MonLatN
      XGrimDatum = GrimGrid(XGrimExe,XGrimWye)		! XMonDatum is the index within the month (as in .mon)
      XMonDatum = ((GrimLat(XGrimDatum)-1) * MonLonN) + GrimLon(XGrimDatum)
      Fraction = real(XMonDatum) / real(MonColN)
      GrimRow(XGrimDatum) = ceiling(Fraction)
      GrimCol(XGrimDatum) = XMonDatum - ((ceiling(Fraction)-1)*MonColN)
  end do
end do

if (MonLonN.LT.GrimExeN) then				! if duplicate col...
    do XGrimWye = 1, MonLatN
      GrimRow(GrimGrid(GrimExeN,XGrimWye)) = GrimRow(GrimGrid(1,XGrimWye))
      GrimCol(GrimGrid(GrimExeN,XGrimWye)) = GrimCol(GrimGrid(1,XGrimWye))
    end do
end if
  
deallocate (GrimLat,GrimLon, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: AutoDataSpec: Deallocation failure: Grim* #####"
  
if (QIntReal.EQ.1) allocate (MonIntData (MonRowN,MonColN), stat=AllocStat)
if (QIntReal.EQ.2) allocate (MonRealData(MonRowN,MonColN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: AutoDataSpec: Allocation failure: Mon* #####"

end subroutine AutoDataSpec

!*******************************************************************************
! get first header line from DKRZ output file

subroutine GetFirstLine

LoadFile = LoadPath (MonFile(1,1),"    ")
call EnsureUnzipped

open  (2,file=LoadFile,status="old",access="sequential",action="read",form="formatted") 
read  (2,"(8i10)"), (HeaderInt(XMonHead),XMonHead=1,8)
close (2)

if (QZip.EQ.2) call system ('rm ' // LoadFile // ' &')		! delete any unzipped file

MonHeadN = 1 ; MonColN = 8 ; MonBoxN = HeaderInt(5)*HeaderInt(6) ; MonDataN = MonBoxN
MonRowN = MonBoxN/8 ; LineFormat = "(8e13.6)" ; QIntReal = 2

write (99,"(8i10)"), (HeaderInt(XMonHead),XMonHead=1,8)		! @@@@@@@@@@@@@@@@
write (99,"(4i10)"), MonHeadN,MonColN,MonBoxN,MonDataN 		! @@@@@@@@@@@@@@@@

print*, "  > Is the grid N to S (=1) or S to N (=2) ?"
do
	read (*,*,iostat=ReadStatus), QNorthSouth
	if (ReadStatus.LE.0.AND.QVinerDKRZ.GE.1.AND.QVinerDKRZ.LE.2) exit
end do

print*, "  > Is the grid eastwards from Greenwich (=1) or the DateLine (=2) ?"
do
	read (*,*,iostat=ReadStatus), QGreenDate
	if (ReadStatus.LE.0.AND.QVinerDKRZ.GE.1.AND.QVinerDKRZ.LE.2) exit
end do

print*, "  > What is the missing value (usually -999.0) ?"
do
	read (*,*,iostat=ReadStatus), FileMissVal
	if (ReadStatus.LE.0) exit
end do

end subroutine GetFirstLine

!*******************************************************************************
! get file into unzipped state

subroutine EnsureUnzipped

NameBeg  = index(LoadFile,'/',.TRUE.) + 1				! get .mon file name only
LoadName = LoadFile(NameBeg:80)   
if (QSilent.EQ.0) print "(2a)", "   > Loading: ", trim(LoadName)
   
LoadFileLen = len_trim(LoadFile)					! ensure we have unzipped .mon
if (LoadFileLen.GT.1.AND.LoadFile((LoadFileLen-1):LoadFileLen).EQ.".Z") then    
    QZip = 2							! file is zipped

    if (QWritePerm.EQ.1) then
      call system ('cp ' // LoadFile // ' /tyn1/tim/scratch/' // LoadName)
      call system ('uncompress /tyn1/tim/scratch/' // LoadName)
      LoadFile = '/tyn1/tim/scratch/' // LoadName
    else
      call system ('uncompress ' // LoadFile)
    end if
    
    LoadFileLen = len_trim(LoadFile)
    LoadFile ((LoadFileLen-1):LoadFileLen) = "  "
else
    QZip = 1								! file not zipped
end if
   
end subroutine EnsureUnzipped

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

subroutine LoadData

print*, "  > Remain silent during loading (0=no,1=yes) ?"
do
	read (*,*,iostat=ReadStatus), QSilent
	if (ReadStatus.LE.0.AND.QSilent.GE.0.AND.QSilent.LE.1) exit
end do

allocate (GrimData(YearN,MonthN,GrimDataN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: LoadData: Allocation failure #####"

do XExec = 1, ExecN							! iterate by execution
 GrimData = MissVal							! reinitialise output array
 
 GivenFile = GrimFile(XExec)						! identify variable
 SuffixBeg = index (GivenFile,".",.TRUE.)
 ThisSuffix=GivenFile(SuffixBeg:(SuffixBeg+3))
 call CheckVariSuffix (ThisSuffix,Variable,Factor)
 if (Variable.EQ."") Variable = "unknown"
 
 if (QSilent.EQ.0) print*
 print "(2a)", "   > Variable: ", trim(Variable)
 
 XYear = 0
 do XMonFile = 1, MonFileN						! iterate by .mon file
   LoadFile = LoadPath (MonFile(XExec,XMonFile),"    ")			! get .mon filepath
   call EnsureUnzipped

   open (2,file=LoadFile,status="old",access="sequential",action="read",form="formatted") 
   
   do XMonYear = 1, MonYearN						! iterate by year in .mon file
     XYear = XYear + 1							! identify correct year in grim array

     if (YearHeadN.GT.0) then						! load month headers
         do XYearHead = 1, YearHeadN
           read (2,*), Trash
         end do
     end if       

     do XMonth = 1, MonthN						! iterate by month
       write (99,"(2i8)"), XMonYear,XMonth
       if (MonHeadN.GT.0) then						! load month headers
         do XMonHead = 1, MonHeadN
           read (2,*), Trash
         end do
       end if       

       if (QIntReal.EQ.1) then						! load data
         do XMonRow = 1, (MonRowN-1)					! load all but final row				
	   read (2,LineFormat), (MonIntData  (XMonRow,XMonCol), XMonCol=1,MonColN)
	   
	   do XMonCol = 1, MonColN
	     if (MonIntData (XMonRow,XMonCol).EQ.FileMissVal) MonIntData (XMonRow,XMonCol) = MissVal
	   end do
	 end do
	 
	 read (2,FinalFormat), (MonIntData  (MonRowN,XMonCol), XMonCol=1,FinalColN)
	 do XMonCol = 1, FinalColN
	     if (MonIntData (MonRowN,XMonCol).EQ.FileMissVal) MonIntData  (MonRowN,XMonCol) = MissVal
	 end do
       else								! load data
         do XMonRow = 1, (MonRowN-1)					! load all but final row						
	   read (2,LineFormat), (MonRealData (XMonRow,XMonCol), XMonCol=1,MonColN)
	   
	   do XMonCol = 1, MonColN
	     if (MonRealData(XMonRow,XMonCol).EQ.FileMissVal) MonRealData(XMonRow,XMonCol) = MissVal
	   end do
         end do
	 
	 read (2,FinalFormat), (MonRealData (MonRowN,XMonCol), XMonCol=1,FinalColN)
	 do XMonCol = 1, FinalColN
	     if (MonRealData(MonRowN,XMonCol).EQ.FileMissVal) MonRealData (MonRowN,XMonCol) = MissVal
	 end do
       end if

       if (QIntReal.EQ.1) then						! store month of data in grim array
         do XGrimDatum = 1, GrimDataN					
           if (MonIntData(GrimRow(XGrimDatum),GrimCol(XGrimDatum)).NE.MissVal) &
            		GrimData(XYear,XMonth,XGrimDatum) = &
            		real(MonIntData(GrimRow(XGrimDatum),GrimCol(XGrimDatum))) * Multiplier
         end do
       else
         do XGrimDatum = 1, GrimDataN					
           if (MonRealData(GrimRow(XGrimDatum),GrimCol(XGrimDatum)).NE.MissVal) &
             		GrimData(XYear,XMonth,XGrimDatum) = &
             		MonRealData(GrimRow(XGrimDatum),GrimCol(XGrimDatum)) * Multiplier
         end do
       end if
     end do     
   end do
   
   close (2)
   
   if (QZip.EQ.2) call system ('rm ' // LoadFile // ' &')		! delete any unzipped file
 end do
 
 MissTot = 0 ; FileMissTot = 0
 do XYear = 1, YearN
   do XMonth = 1, MonthN
     do XBox = 1, GrimDataN
       if      (GrimData(XYear,XMonth,XBox).EQ.MissVal) then
         MissTot = MissTot + 1
       else if (GrimData(XYear,XMonth,XBox).EQ.FileMissVal) then
         FileMissTot = FileMissTot + 1
       end if
     end do
   end do
 end do
 
 if (QSilent.EQ.0) print "(a,2i12)", "   > Valid, missing: ", ((YearN*MonthN*GrimDataN)-MissTot-FileMissTot), MissTot
 if (FileMissTot.GT.0) print "(a,i12)", "   > ##### ERROR: SERIOUS: file MissVal not caught: ", FileMissTot
 
 if (QSilent.EQ.0) print "(2a)", "   > Saving:  ", trim(GrimFile(XExec)) 
 if (QSaveZip.EQ.1) then
 	call SaveGrim (GrimData,GrimGrid,YearAD,GrimBounds,Info,GrimFile(XExec),"    ",SaveSuffix,Silent=1)
 else
 	call SaveGrim (GrimData,GrimGrid,YearAD,GrimBounds,Info,GrimFile(XExec),"    ",SaveSuffix,NoZip=1,Silent=1)
 end if
end do

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

end subroutine LoadData

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

subroutine Finalise

close (99)

print*

if (associated(MonIntData )) deallocate (MonIntData )
if (associated(MonRealData)) deallocate (MonRealData)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Finalise: Deallocation failure: MonData #####"

deallocate (GrimRow,GrimCol,GrimGrid,YearAD,MonFile,GrimFile, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Finalise: Deallocation failure: main #####"

end subroutine Finalise

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

end program MonToGrim