! reformat.f90
! program to convert MCDW data files (_clean) or CLIMAT files to CRU ts format
! written by Dr. Tim Mitchell (Tyndall Centre) on 17.01.03
! last modified 17.03.03
! pgf90 -Mstandard -Minfo -fast -Mscalarsse -Mvect=sse -Mflushz 
! 	-o ./../cruts/reformat time.f90 filenames.f90 grimfiles.f90 crutsfiles.f90 
!      	wmokey.f90 sortmod.f90 ./../cruts/reformat.f90 2> /tyn1/tim/scratch/stderr.txt

program ReFormat

use Time
use FileNames
use GrimFiles
use CRUtsFiles
use WMOkey
use SortMod

implicit none
	  
real, pointer, dimension (:)			:: Lat,Lon,Elv
real, pointer, dimension (:)			:: MasterLat,MasterLon,MasterElv
real, allocatable, dimension (:)		:: McdwMissVals,McdwMulti
real, allocatable, dimension (:)		:: UkmoMissVals,UkmoMulti

integer, pointer, dimension (:,:,:)	:: OutSLP,OutTMP,OutVAP,OutWET,OutPRE,OutSNH
integer, pointer, dimension (:,:,:)	:: OutSTP,OutTMX,OutTMN
integer, pointer, dimension (:,:)	:: StnInfo
integer, allocatable, dimension (:)	:: FileLines
integer, pointer, dimension (:)		:: YearAD,OldCode,NewCode,MasterCode
integer, pointer, dimension (:)		:: Code0,Code1,Reg,Order,PreOrder

character (len=80), pointer, dimension (:) 	:: RawFiles
character (len=20), pointer, dimension (:)	:: StnName,MasterStn
character (len=13), pointer, dimension (:)	:: CtyName,MasterCty
character (len=13), pointer, dimension (:)	:: Name
character (len=09), pointer, dimension (:)	:: LocalName
character (len=04), pointer, dimension (:) 	:: OutSuffices
character (len=03), dimension (12)		:: NameMon
character (len=02), pointer, dimension (:)	:: Acro

real, parameter :: MissVal = -999.0

integer, parameter :: DataMissVal = -9999
integer, parameter :: OrigMissVal = -32768

real :: UnusedReal,SaveMulti,LoadMulti
real :: McdwSLP,McdwTMP,McdwVAP,RealTMP

integer :: ReadStatus,AllocStat,ErrStat
integer :: QRaw
integer :: RawFileN,RawColN,ColN,CheckStnN,LineN,StnN,YearN,MonthN,CodeN,CheckN,MasterN,ValidN
integer :: XRawFile,XRawCol,XCol,XCheckStn,XLine,XStn,XYear,XMonth,XCode,XCheck,XMaster,XValid
integer :: WMOMissVal,LoadMissVal,LoadTraceVal,SaveTraceVal,Month0,Month1
integer :: UnusedInt,TrashInt,SelectCol,WMOCol,YearCol,YearAD0,YearAD1,OpTot,Digits
integer :: InsertSuffix,SubBeg,SubLen,YearInt
integer :: RawCodeCty,RawCodeStn,RawCode,RawLat,RawLon,RawElv,RawWET,RawPRE,RawSNH
integer :: RawLatDeg,RawLatMin,RawLonDeg,RawLonMin, ClimatPRE
integer :: ClimatSTP,ClimatTMX,ClimatTMN,ClimatWET,ClimatSNH,ClimatSLP,ClimatTMP,ClimatVAP
integer :: ValidSTP,ValidSLP,ValidTMX,ValidTMN,ValidVAP,ValidWET,ValidSNH

character (len=80) :: Blank = " ",CommandLine
character (len=80) :: McdwFormat,ClimatOrigFormat,ClimatUkmoFormat,SaveFormat
character (len=80) :: SaveVari,SaveFile,LoadFile,GivenFile,CodeFile
character (len=80) :: Trash,SaveFilePlain
character (len=25) :: RawName25,GivenStn
character (len=20) :: RawName
character (len=04) :: SaveSuffix,TextYear
character (len=03) :: TextMon
character (len=01) :: TrashChar,LatSign,LonSign

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

call Intro
call SpecifyRaw
call SpecifySave
call IDStns

if (QRaw.NE.3) then
  call LoadRaw
else
  call LoadOffenbach
end if

if (QRaw.EQ.1.OR.QRaw.EQ.3) then
  call GetCtyInfo
else if (QRaw.EQ.2) then
  call GetStnInfo
end if

call DumpToFile
call Close

contains

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

subroutine Intro

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

print*
print*, "  > ***** ReFormat: convert MCDW or CLIMAT to CRU ts *****"
print*

MonthN = 12 ; RawColN = 10 ; StnN=10000

allocate (McdwMissVals(RawColN), &
  	  McdwMulti   (RawColN), &
  	  OutSuffices (RawColN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure #####"

NameMon = (/"jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"/)

OutSuffices   = (/'    ','    ','    ','    ', &
  		 '.slp','.tmp','.vap','.wet','.pre','.snh'/)

McdwMissVals  = (/-9999.0,-9999.0,-99999.0,-999.0,-999.9,-9999.9,-9.9,-9.0,-999.0,-99.0/)
McdwMulti     = (/1.0,0.01,0.01,1.0,10.0,10.0,10.0,100.0,10.0,10.0/)

McdwFormat       = "(a20,i6,i6,i7,i5,f7.1,f8.1,f5.1,i3,i5,i4)" 
ClimatOrigFormat = "(3i7,i5,i4,i3,i7,i2,2i4)"
ClimatUkmoFormat = "(11i8)"
  
end subroutine Intro

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

subroutine SpecifyRaw

print*, "  > Reformat MCDW (=1) or CLIMAT raw (=2) or CLIMAT AOPL (=3) files?"
do
	read (*,*,iostat=ReadStatus), QRaw
	if (ReadStatus.LE.0.AND.QRaw.GE.1.AND.QRaw.LE.3) exit
end do

print*, "  > Enter the first year AD, month:"
do
	read (*,*,iostat=ReadStatus), YearAD0, Month0
	if (ReadStatus.LE.0) exit
end do

print*, "  > Enter the last year AD, month:"
do
	read (*,*,iostat=ReadStatus), YearAD1, Month1
	if (ReadStatus.LE.0) exit
end do

print*, "  > The raw files must include yyyy.mm consistently."
call GetBatch (Blank,RawFiles)
  
RawFileN = size(RawFiles,1)
YearN = YearAD1-YearAD0+1
CheckN = YearN*12
CheckN = CheckN - (Month0-1)
CheckN = CheckN - (12-Month1)
if (CheckN.NE.RawFileN) print*,"  > @@@@@ ERROR: raw file total does not match period length @@@@@"
  
end subroutine SpecifyRaw

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

subroutine SpecifySave

print "(a)", "   > Enter the general .cts file to save: "
do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0.AND.GivenFile.NE."") exit
end do
SaveFilePlain = SavePath(GivenFile,".cts")
InsertSuffix = index(SaveFilePlain,".cts")

allocate (NewCode(StnN), &
	  OldCode(StnN), &
	  StnName(StnN), &
	  CtyName(StnN), &
	  LocalName(StnN), &
	  Lat(StnN), &
	  Lon(StnN), &
	  Elv(StnN), &
	  OutSLP(YearN,MonthN,StnN), &
	  OutTMP(YearN,MonthN,StnN), &
	  OutVAP(YearN,MonthN,StnN), &
	  OutWET(YearN,MonthN,StnN), &
	  OutPRE(YearN,MonthN,StnN), &
	  OutSNH(YearN,MonthN,StnN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: SpecifySave: Allocation failure #####"
StnName="UNKNOWN" ; CtyName="UNKNOWN" ; LocalName="   nocode"
NewCode=-999 ; OldCode=-999 ; Lat=-999 ; Lon=-999 ; Elv=-999
OutSLP=-9999 ; OutTMP=-9999 ; OutVAP=-9999 ; OutWET=-9999 ; OutPRE=-9999 ; OutSNH=-9999

if (QRaw.EQ.3) then
  allocate (OutSTP(YearN,MonthN,StnN), &
	    OutTMX(YearN,MonthN,StnN), &
	    OutTMN(YearN,MonthN,StnN), stat=AllocStat)
  if (AllocStat.NE.0) print*, "  > ##### ERROR: alloc fail QRaw=3 #####"
  OutSTP=-9999 ; OutTMX=-9999 ; OutTMN=-9999
end if

allocate (YearAD (YearN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: SpecifySave: Allocation failure: YearAD #####"
do XYear = 1, YearN
  YearAD(XYear) = YearAD0 + XYear - 1
end do

end subroutine SpecifySave

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

subroutine IDStns

print*, "  > Calculating file lengths..."

allocate (FileLines (RawFileN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: GetFileSpecs: Allocation failure: CheckStn #####"
FileLines = 0

do XRawFile = 1, RawFileN
  call system ('wc -l ' // trim(RawFiles(XRawFile)) // ' > trashme.txt')
  open  (3,file='trashme.txt',status="old",access="sequential",form="formatted",action="read")
  read  (3,"(i8)"), FileLines(XRawFile)			! get number of lines
  close (3)
  call system ('rm trashme.txt')
end do

end subroutine IDStns

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

subroutine LoadOffenbach

print*, "  > Loading data from files..."
CommandLine = "sed 's/\\//x/g' slashed.dat > hashed.dat"

do XRawFile=1,RawFileN
  GivenFile=RawFiles(XRawFile)
  SubBeg=index(GivenFile,"/",.TRUE.) ; SubLen=len_trim(GivenFile)
  TextMon=GivenFile((SubBeg+1):(SubBeg+3)) ; TextYear=GivenFile((SubBeg+4):(SubBeg+7))
  XMonth=0
  do				! find month of this file
    XMonth=XMonth+1
    if (TextMon.EQ.NameMon(XMonth)) exit 
  end do
  YearInt=2000+((iachar(TextYear(3:3))-48)*10)+(iachar(TextYear(4:4))-48)
  XYear=YearInt-YearAD(1)+1
  
  LineN = FileLines (XRawFile)
  
  call system ("cp " // trim(RawFiles(XRawFile)) // " slashed.dat")
  call system (CommandLine)
  
  open  (3,file="hashed.dat",status="old",access="sequential",action="read")
  
  do XLine = 1, LineN
     RawCode=MissVal ; RawName25="" ; RawLatDeg=MissVal ; RawLatMin=MissVal 
     RawLonDeg=MissVal ; RawLonMin=MissVal ; ValidWET=-1 ; ValidSNH=-1
     ValidSTP=-1 ; ValidSLP=-1 ; ValidTMX=-1 ; ValidTMN=-1 ; ValidVAP=-1 
     LatSign="X" ; LonSign="X" ; RealTmp=MissVal ; ClimatPRE=MissVal 
     
     read (3,"(i5)",advance="NO",iostat=ErrStat), RawCode
     read (3,"(x,a25)",advance="NO",iostat=ErrStat), RawName25
     read (3,"(i4)",advance="NO",iostat=ErrStat), RawLatDeg
     read (3,"(i2)",advance="NO",iostat=ErrStat), RawLatMin
     read (3,"(i5)",advance="NO",iostat=ErrStat), RawLonDeg
     read (3,"(i2)",advance="NO",iostat=ErrStat), RawLonMin
     
     read (3,"(x,i1,i4)",   advance="NO",iostat=ErrStat), ValidSTP,ClimatSTP
     if (ErrStat.NE.0) then
       ValidSTP=-1 ; backspace 3 
       read (3,"(49x,a1)",advance="NO",iostat=ErrStat), TrashChar
     end if
     
     read (3,"(x,i1,i4)",   advance="NO",iostat=ErrStat), ValidSLP,ClimatSLP
     if (ErrStat.NE.0) then
       ValidSLP=-1 ; backspace 3 
       read (3,"(55x,a1)",advance="NO",iostat=ErrStat), TrashChar
     end if
     
     read (3,"(11x,i1,i3)", advance="NO",iostat=ErrStat), ValidTMX,ClimatTMX
     if (ErrStat.NE.0) then
       ValidTMX=-1 ; backspace 3 
       read (3,"(70x,a1)",advance="NO",iostat=ErrStat), TrashChar
     else if (ValidTMX.EQ.0.AND.ClimatTMX.EQ.0) then
       backspace 3
       read (3,"(67x,a1,3x)",advance="NO",iostat=ErrStat), TrashChar
       if (TrashChar.EQ." ") ValidTMX=-1
     end if
     
     read (3,"(i1,i3)",     advance="NO",iostat=ErrStat), ValidTMN,ClimatTMN
     if (ErrStat.NE.0) then
       ValidTMN=-1 ; backspace 3 
       read (3,"(74x,a1)",advance="NO",iostat=ErrStat), TrashChar
     else if (ValidTMN.EQ.0.AND.ClimatTMN.EQ.0) then
       backspace 3
       read (3,"(71x,a1,3x)",advance="NO",iostat=ErrStat), TrashChar
       if (TrashChar.EQ." ") ValidTMN=-1
     end if
     
     read (3,"(x,i1,i3)",   advance="NO",iostat=ErrStat), ValidVAP,ClimatVAP
     if (ErrStat.NE.0) then
       ValidVAP=-1 ; backspace 3 
       read (3,"(79x,a1)",advance="NO",iostat=ErrStat), TrashChar
     end if
     
     read (3,"(x,i1,5x,i2)",advance="NO",iostat=ErrStat), ValidWET,ClimatWET
     if (ErrStat.NE.0) then
       ValidWET=-1 ; backspace 3 
       read (3,"(88x,a1)",advance="NO",iostat=ErrStat), TrashChar
     end if
     
     read (3,"(x,i1,i3)",iostat=ErrStat), ValidSNH,ClimatSNH
     backspace 3
     read (3,"(470x,f6.1)",advance="NO",iostat=ErrStat), RealTMP
     read (3,"(10x,i6)",iostat=ErrStat), ClimatPRE
     
!     read (3,"(x,i1,i3)",   advance="NO",iostat=ErrStat), ValidSNH,ClimatSNH
!     if (ErrStat.NE.0) then
!       ValidSNH=-1 ; backspace 3 
!       read (3,"(93x,a1)",advance="NO",iostat=ErrStat), TrashChar
!     end if
!          
!     read (3,"(376x,f6.1)",advance="NO",iostat=ErrStat), RealTMP
!     read (3,"(10x,i6)",iostat=ErrStat), ClimatPRE
     
     if ((RawLatDeg.EQ.0.AND.RawLatMin.NE.MissVal) .OR. &
         (RawLonDeg.EQ.0.AND.RawLonMin.NE.MissVal) ) then
       backspace 3
       read (3,"(34x,a1,6x,a1)"), LatSign,LonSign
       
       if (RawLatDeg.EQ.0.AND.RawLatMin.NE.MissVal) then
         RawLatDeg=0 ; if (LatSign.EQ."-") RawLatMin=0-RawLatMin
       end if
       
       if (RawLonDeg.EQ.0.AND.RawLonMin.NE.MissVal) then
         RawLonDeg=0 ; if (LonSign.EQ."-") RawLonMin=0-RawLonMin
       end if
     end if
     
    if (RawCode.NE.0) then
      call FindRightStnOffenbach
      call ProcessClimatOffenbach
    end if
  end do
  
  close (3)

  call system ("rm *ashed.dat")
end do

end subroutine LoadOffenbach

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

subroutine LoadRaw

print*, "  > Loading data from files..."

XRawFile = 0
do XYear = 1, YearN
  do XMonth = 1, MonthN
    if ((XYear.NE.1.OR.XMonth.GE.Month0).AND.(XYear.NE.YearN.OR.XMonth.LE.Month1)) then
      XRawFile = XRawFile + 1
      LineN = FileLines (XRawFile)
      
      open  (3,file=RawFiles(XRawFile),status="old",access="sequential",action="read")
      if      (QRaw.EQ.1) then
        read (3,"(a)"), Trash
        do XLine = 2, LineN
          read (3,McdwFormat), RawName,RawCode,RawLat,RawLon,RawElv, &
        		 McdwSLP,McdwTMP,McdwVAP,RawWET,RawPRE,RawSNH
          call FindRightStnMcdw
          call ProcessMcdw
        end do
      else if (QRaw.EQ.2) then	
       if ((YearAD0+XYear-1).LE.2001) then	! "(i7,2i7,i5,i4,i3,i7,i2,2i4)"
        do XLine = 1, LineN
          read (3,ClimatOrigFormat), RawCode,TrashInt,ClimatSLP, &
        		 ClimatTMP,ClimatVAP,RawWET,RawPRE,TrashInt,RawSNH,TrashInt
          if (RawCode.NE.999999) then
            call FindRightStnClimat
            call ProcessClimatOrig
          end if
        end do
       else					! "(11i8)"
        do XLine = 1, 6
          read (3,"(a)"), Trash
        end do
        do XLine = 7, LineN
          read (3,ClimatUkmoFormat), RawCodeCty,RawCodeStn,TrashInt,ClimatSLP, &
        		 ClimatTMP,ClimatVAP,RawWET,RawPRE,TrashInt,RawSNH,TrashInt
	  RawCode = ((RawCodeCty * 1000) + RawCodeStn) * 10
          call FindRightStnClimat
          call ProcessClimatUkmo
        end do
       end if
      end if
      close (3)
    end if
  end do
end do

end subroutine LoadRaw

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

subroutine FindRightStnMcdw

XStn = 0
do
  XStn = XStn + 1
  if (NewCode(XStn).EQ.-999) then
    StnName(XStn) = RawName
    NewCode(XStn) = RawCode*10
    OldCode(XStn) = RawCode*100
    if (real(RawLat).NE.McdwMissVals(2)) Lat(XStn) = real(RawLat) * McdwMulti(2)
    if (real(RawLon).NE.McdwMissVals(3)) Lon(XStn) = real(RawLon) * McdwMulti(3)
    if (real(RawElv).NE.McdwMissVals(4)) Elv(XStn) = real(RawElv) * McdwMulti(4)
  end if
  if ((RawCode*10).EQ.NewCode(XStn)) exit
end do

end subroutine FindRightStnMcdw

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

subroutine FindRightStnClimat

XStn = 0
do
  XStn = XStn + 1
  if (NewCode(XStn).EQ.-999) then
    NewCode(XStn) = RawCode
    OldCode(XStn) = RawCode*10
  end if
  if (RawCode.EQ.NewCode(XStn)) exit
end do

end subroutine FindRightStnClimat

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

subroutine FindRightStnOffenbach

XStn = 0
do
  XStn = XStn + 1
  if (NewCode(XStn).EQ.-999) then
    GivenStn=adjustl(RawName25)
    StnName(XStn) = GivenStn(1:20)
    NewCode(XStn) = RawCode*10
    OldCode(XStn) = RawCode*100
    if (RawLatDeg.NE.MissVal.AND.RawLonDeg.NE.MissVal) then
      if (RawLatDeg.GE.0) then
        Lat(XStn) = real(RawLatDeg) + (real(RawLatMin)/60.0)
      else
        Lat(XStn) = real(RawLatDeg) - (real(RawLatMin)/60.0)
      end if
      
      if (RawLonDeg.GE.0) then
        Lon(XStn) = real(RawLonDeg) + (real(RawLonMin)/60.0)
      else
        Lon(XStn) = real(RawLonDeg) - (real(RawLonMin)/60.0)
      end if
    end if
    			! ################################
    write (99,"(a20,2i8,2f8.2,4i6,2(x,a1))"),StnName(XStn),NewCode(XStn),OldCode(XStn), &
    		Lat(XStn),Lon(XStn),RawLatDeg,RawLatMin,RawLonDeg,RawLonMin,LatSign,LonSign
  end if
  if ((RawCode*10).EQ.NewCode(XStn)) exit
end do

end subroutine FindRightStnOffenbach

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

subroutine ProcessMcdw

if (real(McdwSLP).NE.McdwMissVals( 5)) OutSLP(XYear,XMonth,XStn) = nint(real(McdwSLP) * McdwMulti( 5))
if (real(McdwTMP).NE.McdwMissVals( 6)) OutTMP(XYear,XMonth,XStn) = nint(real(McdwTMP) * McdwMulti( 6))
if (real(McdwVAP).NE.McdwMissVals( 7)) OutVAP(XYear,XMonth,XStn) = nint(real(McdwVAP) * McdwMulti( 7))
if (real(RawWET).NE.McdwMissVals( 8)) OutWET(XYear,XMonth,XStn) = nint(real(RawWET) * McdwMulti( 8))
if (real(RawPRE).NE.McdwMissVals( 9)) OutPRE(XYear,XMonth,XStn) = nint(real(RawPRE) * McdwMulti( 9))
if (real(RawSNH).NE.McdwMissVals(10)) OutSNH(XYear,XMonth,XStn) = nint(real(RawSNH) * McdwMulti(10))

end subroutine ProcessMcdw

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

subroutine ProcessClimatOrig

if (ClimatSLP.NE.-32768) OutSLP(XYear,XMonth,XStn) = ClimatSLP
if (ClimatTMP.NE.  -999) OutTMP(XYear,XMonth,XStn) = ClimatTMP
if (ClimatVAP.NE.   -99) OutVAP(XYear,XMonth,XStn) = ClimatVAP
if (RawWET.NE.      -99) OutWET(XYear,XMonth,XStn) = RawWET * 100
if (RawPRE.NE.   -32768) OutPRE(XYear,XMonth,XStn) = RawPRE *  10
if (RawSNH.NE.      -99) OutSNH(XYear,XMonth,XStn) = RawSNH *  10

end subroutine ProcessClimatOrig

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

subroutine ProcessClimatUkmo

if (ClimatSLP.NE.OrigMissVal) OutSLP(XYear,XMonth,XStn) = ClimatSLP
if (ClimatTMP.NE.OrigMissVal) OutTMP(XYear,XMonth,XStn) = ClimatTMP
if (ClimatVAP.NE.OrigMissVal) OutVAP(XYear,XMonth,XStn) = ClimatVAP
if (RawWET.NE.OrigMissVal) OutWET(XYear,XMonth,XStn) = RawWET * 100
if (RawPRE.NE.OrigMissVal) OutPRE(XYear,XMonth,XStn) = RawPRE *  10
if (RawSNH.NE.OrigMissVal) OutSNH(XYear,XMonth,XStn) = RawSNH *  10

end subroutine ProcessClimatUkmo

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

subroutine ProcessClimatOffenbach

if (ValidSTP.EQ.1) then
  if (ClimatSTP.GT.500) then
    OutSTP(XYear,XMonth,XStn) = ClimatSTP
  else
    OutSTP(XYear,XMonth,XStn) = ClimatSTP + 10000
  end if
end if

if (ValidSLP.EQ.2) then
  if (ClimatSLP.GT.500) then
    OutSLP(XYear,XMonth,XStn) = ClimatSLP
  else
    OutSLP(XYear,XMonth,XStn) = ClimatSLP + 10000
  end if
end if

if      (ValidTMX.EQ.0) then
    OutTMX(XYear,XMonth,XStn) = ClimatTMX
else if (ValidTMX.EQ.1) then
    OutTMX(XYear,XMonth,XStn) = 0 - ClimatTMX
end if

if      (ValidTMN.EQ.0) then
    OutTMN(XYear,XMonth,XStn) = ClimatTMN
else if (ValidTMN.EQ.1) then
    OutTMN(XYear,XMonth,XStn) = 0 - ClimatTMN
end if

if (ValidVAP.EQ.5) OutVAP(XYear,XMonth,XStn) = ClimatVAP
if (ValidWET.EQ.6) OutWET(XYear,XMonth,XStn) = ClimatWET * 100
if (ValidSNH.EQ.7) OutSNH(XYear,XMonth,XStn) = ClimatSNH * 10

if (ClimatPRE.NE.MissVal) OutPRE(XYear,XMonth,XStn) = ClimatPRE * 10

if (RealTMP.NE.MissVal) OutTMP(XYear,XMonth,XStn) = nint(RealTMP * 10)

write (99,"(9(i2,i6))"), ValidSTP,ClimatSTP, ValidSLP,ClimatSLP, &
	ValidTMX,ClimatTMX, ValidTMN,ClimatTMN, ValidVAP,ClimatVAP, &
	ValidWET,ClimatWET, ValidSNH,ClimatSNH, -9,ClimatPRE, -9,nint(RealTMP*10)

write (99,"(9i8)"), OutSTP(XYear,XMonth,XStn),OutSLP(XYear,XMonth,XStn), &
	OutTMX(XYear,XMonth,XStn),OutTMN(XYear,XMonth,XStn),OutVAP(XYear,XMonth,XStn), &
	OutWET(XYear,XMonth,XStn),OutSNH(XYear,XMonth,XStn), &
	OutPRE(XYear,XMonth,XStn),OutTMP(XYear,XMonth,XStn)

end subroutine ProcessClimatOffenbach

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

subroutine GetCtyInfo

print*, "  > Getting cty info..."
call LoadWMOCty (Code0,Code1,Acro,Reg,Name)
XStn=0 ; CodeN=size(Code0)
do
  XStn=XStn+1 ; XCode=0
  do
    XCode=XCode+1
    if (NewCode(XStn).GE.Code0(XCode).AND.NewCode(XStn).LE.Code1(XCode)) &
    		CtyName(XStn)=Name(XCode)
    if (XCode.EQ.CodeN.OR.NewCode(XStn).LT.Code0(XCode)) exit
  end do
  if (NewCode(XStn).EQ.-999) exit
end do

end subroutine GetCtyInfo

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

subroutine GetStnInfo

CodeFile = "/cru/tyn1/f709762/cruts/master/0210251733.hdr"

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

allocate (MasterCode(MasterN), & 		! allocate master code vectors
	  MasterStn (MasterN), &
	  MasterCty (MasterN), &
	  MasterLat (MasterN), &
	  MasterLon (MasterN), &
	  MasterElv (MasterN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure #####"
MasterCode=-999 ; MasterStn="UNKNOWN" ; MasterCty="UNKNOWN"
MasterLat=-999.0 ; MasterLon=-999.0 ; MasterElv=-999.0 

open  (3,file=CodeFile,status="old",access="sequential",form="formatted",action="read")
do XMaster = 1, MasterN				! get master info
  read (3,"(i7,i6,i7,i5,x,a20,x,a13)"), MasterCode(XMaster),RawLat,RawLon,RawElv, &
  		MasterStn(XMaster),MasterCty(XMaster)
  if (RawLat.NE. -9999) MasterLat(XMaster) = real(RawLat) / 100.0
  if (RawLon.NE.-99999) MasterLon(XMaster) = real(RawLon) / 100.0
  if (RawElv.NE.  -999) MasterElv(XMaster) = real(RawElv)
end do
close (3)

XStn=0
do
  XStn=XStn+1 ; XMaster=0
  do
    XMaster=XMaster+1
    if (NewCode(XStn).EQ.MasterCode(XMaster)) then
      StnName(XStn) = MasterStn(XMaster)
      CtyName(XStn) = MasterCty(XMaster)
      Lat(XStn) = MasterLat(XMaster)
      Lon(XStn) = MasterLon(XMaster)
      Elv(XStn) = MasterElv(XMaster)
    end if
    if (XMaster.EQ.MasterN.OR.NewCode(XStn).LT.MasterCode(XMaster)) exit
  end do
  if (NewCode(XStn).EQ.-999) exit
end do

end subroutine GetStnInfo

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

subroutine DumpToFile

print*, "  > Dumping data to CRU ts files..."

XStn = 0
do
  XStn = XStn + 1
  if (Newcode(XStn).EQ.-999) exit
end do
ValidN = XStn - 1
allocate (PreOrder(ValidN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: DumpToFile: Allocation failure #####"
do XValid = 1, ValidN
  PreOrder(XValid) = NewCode(XValid)
end do
call QuickSort (Ints=PreOrder,Order=Order)

SaveFile = SaveFilePlain(1:InsertSuffix-1) // OutSuffices( 5) // ".cts"
call MakeStnInfo (StnInfo,NewCode,OldCode,Lat,Lon,Elv,1,Silent=1,YearAD=YearAD,Data=OutSLP)
call SaveCTS (StnInfo,LocalName,StnName,CtyName,OutSLP,YearAD,CallFile=SaveFile,Order=Order,Silent=1)

SaveFile = SaveFilePlain(1:InsertSuffix-1) // OutSuffices( 6) // ".cts"
call MakeStnInfo (StnInfo,NewCode,OldCode,Lat,Lon,Elv,1,Silent=1,YearAD=YearAD,Data=OutTMP)
call SaveCTS (StnInfo,LocalName,StnName,CtyName,OutTMP,YearAD,CallFile=SaveFile,Order=Order,Silent=1)

SaveFile = SaveFilePlain(1:InsertSuffix-1) // OutSuffices( 7) // ".cts"
call MakeStnInfo (StnInfo,NewCode,OldCode,Lat,Lon,Elv,1,Silent=1,YearAD=YearAD,Data=OutVAP)
call SaveCTS (StnInfo,LocalName,StnName,CtyName,OutVAP,YearAD,CallFile=SaveFile,Order=Order,Silent=1)

SaveFile = SaveFilePlain(1:InsertSuffix-1) // OutSuffices( 8) // ".cts"
call MakeStnInfo (StnInfo,NewCode,OldCode,Lat,Lon,Elv,1,Silent=1,YearAD=YearAD,Data=OutWET)
call SaveCTS (StnInfo,LocalName,StnName,CtyName,OutWET,YearAD,CallFile=SaveFile,Order=Order,Silent=1)

SaveFile = SaveFilePlain(1:InsertSuffix-1) // OutSuffices( 9) // ".cts"
call MakeStnInfo (StnInfo,NewCode,OldCode,Lat,Lon,Elv,1,Silent=1,YearAD=YearAD,Data=OutPRE)
call SaveCTS (StnInfo,LocalName,StnName,CtyName,OutPRE,YearAD,CallFile=SaveFile,Order=Order,Silent=1)

SaveFile = SaveFilePlain(1:InsertSuffix-1) // OutSuffices(10) // ".cts"
call MakeStnInfo (StnInfo,NewCode,OldCode,Lat,Lon,Elv,1,Silent=1,YearAD=YearAD,Data=OutSNH)
call SaveCTS (StnInfo,LocalName,StnName,CtyName,OutSNH,YearAD,CallFile=SaveFile,Order=Order,Silent=1)

if (QRaw.EQ.3) then
  SaveFile = SaveFilePlain(1:InsertSuffix-1) // ".stp" // ".cts"
  call MakeStnInfo (StnInfo,NewCode,OldCode,Lat,Lon,Elv,1,Silent=1,YearAD=YearAD,Data=OutSTP)
  call SaveCTS (StnInfo,LocalName,StnName,CtyName,OutSTP,YearAD,CallFile=SaveFile,Order=Order,Silent=1)

  SaveFile = SaveFilePlain(1:InsertSuffix-1) // ".tmx" // ".cts"
  call MakeStnInfo (StnInfo,NewCode,OldCode,Lat,Lon,Elv,1,Silent=1,YearAD=YearAD,Data=OutTMX)
  call SaveCTS (StnInfo,LocalName,StnName,CtyName,OutTMX,YearAD,CallFile=SaveFile,Order=Order,Silent=1)

  SaveFile = SaveFilePlain(1:InsertSuffix-1) // ".tmn" // ".cts"
  call MakeStnInfo (StnInfo,NewCode,OldCode,Lat,Lon,Elv,1,Silent=1,YearAD=YearAD,Data=OutTMN)
  call SaveCTS (StnInfo,LocalName,StnName,CtyName,OutTMN,YearAD,CallFile=SaveFile,Order=Order,Silent=1)
end if

end subroutine DumpToFile

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

subroutine Close

print*

close (99)

end subroutine Close

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

end program ReFormat