! gsodlist.f90
! f90 program written by Tim Mitchell on 30.11.01
! last modified on 30.11.01
! tool to obtain list of all stations in Global Summary Of Stn Stn sets from NCEP
! f90 -o ./../obs/gsodlist filenames.f90 ./../obs/gsodlist.f90

program GSoDList

use FileNames

implicit none

real, pointer, dimension (:)			:: StnLat, StnLon

integer, pointer, dimension (:)			:: StnT, Stn0, Stn1, StnElv

character (len=80), pointer, dimension (:,:) 	:: Files
character (len=80), pointer, dimension (:) 	:: Batch, BatchName
character (len=22), pointer, dimension (:) 	:: StnName
character (len= 6), pointer, dimension (:) 	:: StnCall

character (len=3), dimension (12), parameter :: MonthNames = ['jan','feb','mar','apr','may','jun',&
							      'jul','aug','sep','oct','nov','dec']

real, parameter :: MissVal = -999.0

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

integer :: ReadStatus, AllocStat
integer :: BegYearAD,EndYearAD,BegMonth,EndMonth
integer :: StnN, BatchN, LineN, YearN
integer :: XStn,XBatch, XLine, XYear, XMonth, XYearAD
integer :: QZip
integer :: Month0,Month1, GotYear,GotMonth, LastSlash, LoadFileLen
integer :: Station,DateCode,LatDeg,LatMin,LonDeg,LonMin,Elev

character (len=80) :: GivenFile, SaveFile, LoadFile, InfoFile, Trash, BatchFilter
character (len=22) :: FullName
character (len=20) :: YearStr20
character (len=12) :: Date,Time
character (len= 6) :: CallName
character (len= 4) :: Year
character (len= 2) :: Month,Stn,Hour,Minute,YearStr02
character (len= 1) :: Ch,LatDir,LonDir

!*******************************************************************************
! main

call Intro
call Specifics
call LoadInfo
call LoadStationInfo
call SaveInfo
call Conclude 					

contains

!*******************************************************************************
! intro

subroutine Intro

open (99,file="/cru/mikeh1/f709762/scratch/log/log-gsodlist.dat",status="replace",action="write")

print*
print*, "  > ***** GSoDList.f90 : obtains station list from GSoD set *****"
print*

StnN = 999999
allocate (StnT (StnN), &
	  Stn0 (StnN), &
	  Stn1 (StnN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure #####"
StnT = 0 ; Stn0 = 0 ; Stn1 = 0

end subroutine Intro

!*******************************************************************************
! make specificiations

subroutine Specifics

BatchFilter="/cru/tyn1/f709762/daily/gsod/data/????.??.txt*"
call GetBatch (BatchFilter,Batch,Silent=1)
BatchN = size (Batch,1)
BegYearAD=1994 ; BegMonth=1
EndMonth=nint(mod(real(BatchN),12.0)) 
if (EndMonth.EQ.0) EndMonth=12
EndYearAD=nint(real(BatchN-EndMonth)/12.0)+1994
YearN = EndYearAD - BegYearAD + 1
print "(2(a,i4,x,i2))", "   > Range: ", BegYearAD, BegMonth, &
			" to ", EndYearAD, EndMonth

allocate (Files     (YearN,12), &
	  BatchName (BatchN),   stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: SortBatch: Allocation failure #####"
Files = Blank ; BatchName = Blank

do XBatch = 1, BatchN
  GivenFile = Batch(XBatch)
  LastSlash = index(GivenFile,"/",.TRUE.)
  BatchName(XBatch) = adjustl(trim(GivenFile((LastSlash+1):80)))
end do

XBatch=0
do XYear=1,YearN
  do XMonth=1,12
    XBatch=XBatch+1
    if (XBatch.LE.BatchN) Files(XYear,XMonth) = Batch(XBatch)
  end do
end do

print*, "  > Enter the .txt file to save:"
do
	read (*,*,iostat=ReadStatus), GivenFile
	if (ReadStatus.LE.0.AND.GivenFile.NE."") exit
end do
SaveFile = SavePath (GivenFile,".txt")

end subroutine Specifics

!*******************************************************************************
! load information one month at a time

subroutine LoadInfo

print*, "  > Identifying stations in..."
do XYearAD = BegYearAD, EndYearAD
  XYear = XYearAD-BegYearAD+1
  
  Month0 = 1  ; if (XYearAD.EQ.BegYearAD) Month0 = BegMonth
  Month1 = 12 ; if (XYearAD.EQ.EndYearAD) Month1 = EndMonth
  
  do XMonth = Month0, Month1
    print "(2a)", "   > ", trim(Files(XYear,XMonth))
    
    LoadFile = Files(XYear,XMonth)
    LoadFileLen = len_trim(LoadFile)
    if (LoadFileLen.GT.1.AND.LoadFile((LoadFileLen-1):LoadFileLen).EQ.".Z") then
      QZip = 2							! file is zipped
      call system ('uncompress ' // LoadFile)
      LoadFile ((LoadFileLen-1):LoadFileLen) = "  "		! change filename to the unzipped file
    else
      QZip = 1							! file already unzipped
    end if
    
    call system ('wc -l ' // LoadFile // ' > 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')
    
    open  (2,file=LoadFile,status="old",access="sequential",form="formatted",action="read")    
    read  (2,*), Trash
    do XLine = 2, LineN
      read  (2,"(i6,i10)"), Station, DateCode
      if (Station.GE.1.AND.Station.LE.StnN) then
        StnT (Station) = StnT (Station) + 1
        Stn1 (Station) = DateCode
        if (StnT(Station).EQ.1) Stn0 (Station) = DateCode
      end if
    end do    
    close (2)
    
    if (QZip.EQ.2) call system ('compress ' // LoadFile // ' &')
  end do
end do

end subroutine LoadInfo

!*******************************************************************************
! load station info from .txt file

subroutine LoadStationInfo

print*, "  > Loading station information from file..."

InfoFile = '/cru/mikeh1/f709762/f90/obs/_ref/station-list-ncep.txt'

call system ('wc -l ' // InfoFile // ' > 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')
    
allocate (StnLat (StnN), &
	  StnLon (StnN), &
	  StnElv (StnN), &
	  StnName(StnN), &
	  StnCall(StnN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Intro: Allocation failure #####"
StnLat=MissVal; StnLon=MissVal; StnElv=MissVal; StnName=""; StnCall=""

open  (2,file=InfoFile,status="old",access="sequential",form="formatted",action="read")    

do XLine = 1, LineN
  read (2,"(i6,a1,a6,a1,a22,a1,i2,i2,a1,a1,i3,i2,a1,a1,i4)"), &
  		Station,Ch,CallName,Ch,FullName,Ch,LatDeg,LatMin,LatDir,Ch,LonDeg,LonMin,LonDir,Ch,Elev
  
  write (99,"(i6,a1,a6,a1,a22,a1,i2,i2,a1,a1,i3,i2,a1,a1,i4)"), &
  		Station,Ch,CallName,Ch,FullName,Ch,LatDeg,LatMin,LatDir,Ch,LonDeg,LonMin,LonDir,Ch,Elev
  
  if (Station.GE.1.AND.Station.LE.StnN) then
    StnName(Station) = FullName
    StnCall(Station) = CallName
    StnElv (Station) = Elev
    
    StnLat (Station) = real(LatDeg) + (real(LatMin)/60.0)
    StnLon (Station) = real(LonDeg) + (real(LonMin)/60.0)
    
    if (LatDir.EQ."S") StnLat (Station) = 0.0 - StnLat (Station)
    if (LonDir.EQ."W") StnLon (Station) = 0.0 - StnLon (Station)
  end if
end do

close (2)

end subroutine LoadStationInfo

!*******************************************************************************
! save info to .txt file

subroutine SaveInfo

print*, "  > Saving station list to file..."

LineN = 0					! get total no. of valid stations
do XStn = 1, StnN
  if (StnT(XStn).GT.0) LineN = LineN + 1
end do

call date_and_time (Date, Time)
Year  = Date (1:4)
Month = Date (5:6)
Stn   = Date (7:8)
Hour  = Time (1:2)
Minute= Time (3:4)

open  (2,file=SaveFile,status="replace",access="sequential",form="formatted",action="write")    

write (2,"(a,a2,a1,a2,a1,a4,a4,a2,a1,a2,a20)"), "Tyndall Centre file created on ", &
		Stn, ".", Month, ".", Year, " at ", Hour, ":", Minute, " by Dr. Tim Mitchell"
write (2,"(2(3a,i4))"), "Global Summary of the Day: ",  MonthNames(BegMonth), " ", BegYearAD, " to ", &
							MonthNames(EndMonth), " ", EndYearAD
write (2,"(a,i6)"), "Valid stations total: ", LineN
write (2,"(2a6,2a9,a23,a7,2a9,a6)"), "   WMO", " valid ", "    start", "   finish", &
		"name                   ", "abbrev ", "      lat", "     long", "  elev"

do XStn = 1, StnN
  if (StnT(XStn).GT.0) write (2,"(2i6,2i9,a23,a7,2f9.3,i6)"), XStn, StnT(XStn), Stn0(XStn), Stn1(XStn), &
  		StnName(XStn), StnCall(XStn), StnLat(XStn), StnLon(XStn), StnElv(XStn)
end do

close (2)

end subroutine SaveInfo

!*******************************************************************************
! conclude

subroutine Conclude

deallocate (StnT,Stn0,Stn1,Batch,BatchName,Files,StnLat,StnLon,StnElv,StnName,StnCall,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: Conclude: Deallocation failure #####"

close (99)

print*

end subroutine Conclude

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

end program GSoDList