! mergewmo.f90 ! written by Tim Mitchell on 30.01.02 ! merges the current standard WMO station metadata list with the WMO flatfile (processed) ! f90 -o ./../misc/mergewmo filenames.f90 wmokey.f90 ./../misc/mergewmo.f90 program MergeWMO use FileNames use WMOKey implicit none real, pointer, dimension (:) :: NCDCLat,NCDCLong,NCDCElev,WMOLat,WMOLong,WMOElev real, pointer, dimension (:) :: CombLat,CombLong,CombElev integer, pointer, dimension (:) :: NCDCCode,WMOCode,CombCode,Code character (len=20), pointer, dimension (:) :: NCDCName,WMOName,CombName character (len=04), pointer, dimension (:) :: NCDCAcroStn,WMOAcroStn,CombAcroStn character (len=02), pointer, dimension (:) :: NCDCAcroCty,WMOAcroCty,CombAcroCty integer :: ReadStatus, AllocStat integer :: NCDCStnN,WMOStnN,StnN,CombN integer :: XNCDCStn,XWMOStn,XStn,XComb integer :: FailTotA,FailTotB,FailTotC,ClashTot integer :: ChosenVersion,CheckVersions real, parameter :: MissVal = -999.0 character (len=80) :: WMOFlatFile,CombFile,Trash,GivenFile character (len=80) :: WMOFlatFormat,SaveFormat !******************************************************************************* open (99,file="/cru/mikeh1/f709762/scratch/log/log-mergewmo.dat",status="replace",action="write") call LoadWMOInfo (NCDCCode,NCDCAcroStn,NCDCName,NCDCAcroCty,NCDCLat,NCDCLong,NCDCElev) NCDCStnN = size(NCDCCode,1) print*, " > Total stations in master data-set: ", NCDCStnN call GrabWMOFlatfile call MasterVector call CombineSources call DumpCombFile close (99) contains !******************************************************************************* subroutine GrabWMOFlatFile print*, " > Enter the raw file to merge with the master file." do read (*,*,iostat=ReadStatus), GivenFile if (ReadStatus.LE.0.AND.GivenFile.NE."") exit end do WMOFlatFile = LoadPath(GivenFile," ") ! WMOFlatFile = "/cru/mikeh1/f709762/obs/meta/wmo-flatfile-sort.txt" ! WMOFlatFormat = "(i8,a17,f6.2,f8.2,f8.1)" WMOFlatFormat = "(a3,i5,a4,a20,a10,f7.2,f8.2,i5)" call system ('wc -l ' // WMOFlatFile // ' > trashme.txt') open (3,file='trashme.txt',status="old",access="sequential",form="formatted",action="read") read (3,"(i10)"), WMOStnN close (3) call system ('rm trashme.txt') print*, " > Total stations in raw file: ", WMOStnN allocate (WMOCode (WMOStnN), & WMOLat (WMOStnN), & WMOLong (WMOStnN), & WMOElev (WMOStnN), & WMOName (WMOStnN), & WMOAcroStn (WMOStnN), & WMOAcroCty (WMOStnN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GrabWMOFlatFile: Allocation failure #####" WMOCode=MissVal; WMOLat=MissVal; WMOLong=MissVal; WMOElev=MissVal; WMOName=""; WMOAcroStn=""; WMOAcroCty="" open (3,file=WMOFlatFile,status="old",access="sequential",form="formatted",action="read") do XWMOStn = 1, WMOStnN read (3,WMOFlatFormat), Trash,WMOCode(XWMOStn),Trash,WMOName(XWMOStn),Trash, & WMOLat(XWMOStn),WMOLong(XWMOStn),WMOElev(XWMOStn) WMOCode(XWMOStn) = WMOCode(XWMOStn) * 10 end do close (3) end subroutine GrabWMOFlatFile !******************************************************************************* subroutine MasterVector StnN = 1000000 allocate (Code (StnN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: MasterVector: Allocation failure #####" Code = MissVal CombN = 0 do XNCDCStn = 1, NCDCStnN Code(NCDCCode(XNCDCStn)) = 1 CombN = CombN + 1 end do do XWMOStn = 1, WMOStnN if (Code(WMOCode(XWMOStn)).EQ.MissVal) then Code(WMOCode(XWMOStn)) = -1 CombN = CombN + 1 else Code(WMOCode(XWMOStn)) = 0 end if end do allocate (CombCode (CombN), & CombLat (CombN), & CombLong (CombN), & CombElev (CombN), & CombName (CombN), & CombAcroStn (CombN), & CombAcroCty (CombN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: CombineSources: Allocation failure #####" CombCode=MissVal; CombLat=MissVal; CombLong=MissVal; CombElev=MissVal CombName="blank"; CombAcroStn=" "; CombAcroCty=" " print*, " > Total stations in contributory data-sets: ", CombN end subroutine MasterVector !******************************************************************************* subroutine CombineSources ! print*, " > Where there are clashes, decide to retain none (=0), master (=1), WMO (=2)." XWMOStn=0 ; XNCDCStn=0; XComb=0; FailTotA=0; FailTotB=0; FailTotC=0 ; ClashTot=0 do XStn = 1, StnN ! write (99,*), XStn,Code(XStn),XNCDCStn,XWMOStn,XComb ! ####################### if (Code(XStn).NE.MissVal) then if (Code(XStn).GE.0) then XNCDCStn=XNCDCStn+1 ; XComb=XComb+1 if (NCDCCode(XNCDCStn).EQ.XStn) then CombCode (XComb) = NCDCCode (XNCDCStn) CombLat (XComb) = NCDCLat (XNCDCStn) CombLong (XComb) = NCDCLong (XNCDCStn) CombElev (XComb) = NCDCElev (XNCDCStn) CombName (XComb) = trim(adjustl(NCDCName(XNCDCStn))) CombAcroStn (XComb) = NCDCAcroStn (XNCDCStn) CombAcroCty (XComb) = NCDCAcroCty (XNCDCStn) else write (99,"(5i8)"), XStn,Code(XStn),XNCDCStn,XComb,NCDCCode(XNCDCStn) ! ####################### FailTotA = FailTotA + 1 end if if (Code(XStn).EQ.0) then XWMOStn=XWMOStn+1 if (WMOCode(XWMOStn).EQ.XStn) then CheckVersions = 0 if (WMOLat(XWMOStn).NE.MissVal.AND.NCDCLat(XNCDCStn).NE.MissVal) then if (abs(NCDCLat(XNCDCStn)-WMOLat(XWMOStn)).GT.0.03) CheckVersions = 1 else if (WMOLong(XWMOStn).NE.MissVal.AND.NCDCLong(XNCDCStn).NE.MissVal) then if (abs(NCDCLong(XNCDCStn)-WMOLong(XWMOStn)).GT.0.03) CheckVersions = 1 else if (WMOElev(XWMOStn).NE.MissVal.AND.NCDCElev(XNCDCStn).NE.MissVal) then if (abs(NCDCElev(XNCDCStn)-WMOElev(XWMOStn)).GT.10.0) CheckVersions = 1 end if end if end if if (CheckVersions.EQ.0) then if (CombCode (XComb) .EQ.MissVal) CombCode (XComb) = WMOCode (XWMOStn) if (CombLat (XComb) .EQ.MissVal) CombLat (XComb) = WMOLat (XWMOStn) if (CombLong (XComb) .EQ.MissVal) CombLong (XComb) = WMOLong (XWMOStn) if (CombElev (XComb) .EQ.MissVal) CombElev (XComb) = WMOElev (XWMOStn) if (trim(CombName(XComb)).EQ."blank") CombName (XComb) = trim(adjustl(WMOName(XWMOStn))) else ClashTot = ClashTot + 1 ChosenVersion = 1 ! print "(a10,3f8.2,a)", "1=master: ",NCDCLat(XNCDCStn),NCDCLong(XNCDCStn),NCDCElev(XNCDCStn),trim(adjustl(NCDCName(XNCDCStn))) ! print "(a10,3f8.2,a)", "2=WMO: ",WMOLat(XWMOStn),WMOLong(XWMOStn),WMOElev(XWMOStn),trim(adjustl(WMOName(XWMOStn)))! ! do ! read (*,*,iostat=ReadStatus), ChosenVersion ! if (ReadStatus.LE.0.AND.ChosenVersion.GE.0.AND.ChosenVersion.LE.2) exit ! end do if (ChosenVersion.EQ.0) then CombCode (XComb) = MissVal CombLat (XComb) = MissVal CombLong (XComb) = MissVal CombElev (XComb) = MissVal CombName (XComb) = "blank" CombAcroStn (XComb) = " " CombAcroCty (XComb) = " " else if (ChosenVersion.EQ.2) then CombCode (XComb) = WMOCode (XWMOStn) CombLat (XComb) = WMOLat (XWMOStn) CombLong (XComb) = WMOLong (XWMOStn) CombElev (XComb) = WMOElev (XWMOStn) CombName (XComb) = trim(adjustl(WMOName(XWMOStn))) CombAcroStn (XComb) = " " CombAcroCty (XComb) = " " end if end if else FailTotB = FailTotB + 1 end if end if else XWMOStn=XWMOStn+1 ; XComb=XComb+1 if (WMOCode(XWMOStn).EQ.XStn) then CombCode (XComb) = WMOCode (XWMOStn) CombLat (XComb) = WMOLat (XWMOStn) CombLong (XComb) = WMOLong (XWMOStn) CombElev (XComb) = WMOElev (XWMOStn) CombName (XComb) = trim(adjustl(WMOName(XWMOStn))) CombAcroStn (XComb) = " " CombAcroCty (XComb) = " " else FailTotC = FailTotC + 1 end if end if end if end do print*, " > Clashes between data-sets: ", ClashTot print*, " > Unsorted/non-unique errors: ", FailTotA,FailTotB,FailTotC end subroutine CombineSources !******************************************************************************* subroutine DumpCombFile CombFile = "/cru/mikeh1/f709762/obs/meta/comb.txt" SaveFormat = "(i6,a1,a4,a3,a20,a1,a2,3f8.2)" open (3,file=CombFile,status="replace",access="sequential",form="formatted",action="write") do XComb = 1, CombN if (CombCode(XComb).NE.MissVal) & write (3,SaveFormat), CombCode(XComb)," ",CombAcroStn(XComb)," ",CombName(XComb)," ", & CombAcroCty(XComb),CombLat(XComb),CombLong(XComb),CombElev(XComb) end do close (3) end subroutine DumpCombFile !******************************************************************************* end program MergeWMO