! gsodfind.f90 ! f90 program written by Tim Mitchell on 24.09.03 ! tool to find adjacent stations from GSOD list extracted using gsodlist.f90 ! f90 -o ./../obs/gsodfind filenames.f90 sortmod.f90 gridops.f90 ./../obs/gsodfind.f90 program GSoDFind use FileNames use SortMod use GridOps implicit none real, pointer, dimension (:) :: StnLat, StnLon, Dist integer, pointer, dimension (:) :: StnT, Stn0, Stn1, StnElv, Order character (len=22), pointer, dimension (:) :: StnName character (len= 6), pointer, dimension (:) :: StnCall real, parameter :: MissVal = -999.0 character (len=80), parameter :: Blank = "" real :: Lat0,Lon0 integer :: ReadStatus, AllocStat integer :: StnN,NCloseStn integer :: XStn,XCloseStn integer :: NBStn,YearAD0,YearAD1 character (len=80) :: GivenFile, LoadFile, Trash !******************************************************************************* ! main call Intro call Specifics call LoadInfo call Process call Conclude contains !******************************************************************************* ! conclude subroutine Conclude deallocate (StnT,Stn0,Stn1,StnLat,StnLon,StnElv,StnName,StnCall,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: Conclude: Deallocation failure #####" close (99) print* end subroutine Conclude !******************************************************************************* ! intro subroutine Intro open (99,file="./../../../scratch/log-gsodfind.dat",status="replace",action="write") print* print*, " > ***** GSoDfind.f90 : finds adjacents stns on list *****" print* end subroutine Intro !******************************************************************************* ! save info to .txt file subroutine LoadInfo print*, " > Loading station list from file..." open (2,file=LoadFile,status="old",access="sequential",form="formatted",action="read") read (2,"(a)"), Trash read (2,"(a)"), Trash read (2,"(a22,i6)"), Trash, StnN read (2,"(a)"), Trash allocate (StnT (StnN), & Stn0 (StnN), & Stn1 (StnN), & Dist (StnN), & Order(StnN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: Intro: Allocation failure #####" StnT = 0 ; Stn0 = 0 ; Stn1 = 0 ; Dist=MissVal ; Order=MissVal 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="" do XStn = 1, StnN read (2,"(6x,i6,2i9,a23,a7,2f9.3,i6)"), StnT(XStn), Stn0(XStn), Stn1(XStn), & StnName(XStn), StnCall(XStn), StnLat(XStn), StnLon(XStn), StnElv(XStn) end do close (2) end subroutine LoadInfo !******************************************************************************* ! process data subroutine Process do XStn = 1, StnN if ( (YearAD0.EQ.nint(MissVal).AND.YearAD1.EQ.nint(MissVal)).OR. & (Stn0(XStn).LE.YearAD0.AND.Stn1(XStn).GE.YearAD1)) then if (StnLat(XStn).NE.MissVal.AND.StnLon(XStn).NE.MissVal) then Dist(XStn) = GetDistance (StnLat(XStn),StnLon(XStn),Lat0,Lon0) if (Dist(XStn).GT.1000) then Dist(XStn)=MissVal else write (99,"(i4,3f8.2)"), XStn,Dist(XStn),StnLat(XStn),StnLon(XStn) ! @@@@@@@@@@ end if end if end if end do call QuickSort (Reals=Dist,OrderValid=Order) print "(a3,a4,a6,2a9,17x,a3,a3,12x,a3,6x,a3,3x,a3)", " X"," KM", & " VALID", " BEG", " END", "STN", " CY", & "LAT","LON","ELV" do XCloseStn=1,NCloseStn XStn=Order(XCloseStn) if (XStn.NE.MissVal) & print "(i3,i4,i6,2i9,a23,a7,2f9.3,i6)", XCloseStn,nint(Dist(XStn)), & StnT(XStn), Stn0(XStn), Stn1(XStn), & StnName(XStn), StnCall(XStn), StnLat(XStn), StnLon(XStn), StnElv(XStn) end do end subroutine Process !******************************************************************************* ! get specifics subroutine Specifics print*, " > Enter the GSOD list file (.txt) to load:" do read (*,*,iostat=ReadStatus), GivenFile if (ReadStatus.LE.0.AND.GivenFile.NE."") exit end do LoadFile = LoadPath (GivenFile,".txt") print*, " > Enter the lat and long: " do read (*,*,iostat=ReadStatus), Lat0,Lon0 if (ReadStatus.LE.0.AND.Lat0.GE.-90.AND.Lat0.LE.90.AND.Lon0.GE.-180.AND.Lon0.LE.180) exit end do print*, " > Find the closest N stations. Specify N." do read (*,*,iostat=ReadStatus), NCloseStn if (ReadStatus.LE.0.AND.NCloseStn.GE.1) exit end do print*, " > Restrict to stns with data in period: beg,end (-999=don't restrict):" do read (*,*,iostat=ReadStatus), YearAD0,YearAD1 if (ReadStatus.LE.0) exit end do YearAD0=(YearAD0*10000)+101 ; YearAD1=(YearAD1*10000)+1231 end subroutine Specifics !******************************************************************************* end program GSoDFind