! wmokey.f90 ! module in which standard routines for obtaining WMO station info are held ! contains: GetCRUtsInfo, LoadWMOCty, LoadWMOInfo module WMOkey use FileNames implicit none contains !******************************************************************************* ! supply this routine with the list of WMO numbers you will be saving into CRU ts file ! it will give you back all the station-info for the headers in the CRU ts file subroutine GetCRUtsInfo (Code,Lat,Long,Elev,NameStn,NameCty,Digits) real, pointer, dimension (:) :: Lat,Long,Elev real, pointer, dimension (:) :: InfoLat,InfoLong,InfoElev integer, pointer, dimension (:) :: Code integer, pointer, dimension (:) :: InfoCode,InfoCode0,InfoCode1,InfoReg character (len=20), pointer, dimension (:) :: NameStn,InfoNameStn character (len=13), pointer, dimension (:) :: NameCty,InfoNameCty character (len=04), pointer, dimension (:) :: InfoAcroStn character (len=02), pointer, dimension (:) :: AcroCty,InfoAcroCty integer, intent(in) :: Digits ! 5 or 6 digit WMO numbers integer :: ReadStatus, AllocStat integer :: StnN,InfoStnN, XStn,XInfoStn, OpTot real, parameter :: MissVal = -999.0 StnN = size (Code,1) ! allocate main arrays allocate (Lat (StnN), & Long (StnN), & Elev (StnN), & AcroCty (StnN), & NameStn (StnN), & NameCty (StnN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GetCRUtsInfo: Allocation failure #####" Lat=MissVal ; Long=MissVal ; Elev=MissVal ; AcroCty="" ; NameStn="" ; NameCty="unidentified" call LoadWMOInfo (InfoCode,InfoAcroStn,InfoNameStn,InfoAcroCty,InfoLat,InfoLong,InfoElev) InfoStnN = size (InfoCode,1) if (Digits.EQ.6) then ! no action required else if (Digits.EQ.5) then InfoCode = floor(real(InfoCode)/10.0) end if OpTot = 0 ! ############################ do XStn = 1, StnN ! fill main arrays with station info XInfoStn = 0 do XInfoStn = XInfoStn + 1 if (Code(XStn).EQ.InfoCode(XInfoStn)) then OpTot = OpTot + 1 Lat (XStn) = InfoLat (XInfoStn) Long (XStn) = InfoLong (XInfoStn) Elev (XStn) = InfoElev (XInfoStn) AcroCty(XStn) = InfoAcroCty(XInfoStn) NameStn(XStn) = InfoNameStn(XInfoStn) end if if (Code(XStn).LE.InfoCode(XInfoStn)) exit if (XInfoStn.EQ.InfoStnN) exit end do end do ! print*, " > Stations with meta-data: ", OpTot ! ############################ deallocate (InfoCode,InfoAcroStn,InfoNameStn,InfoAcroCty,InfoLat,InfoLong,InfoElev,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GetCRUtsInfo: Deallocation failure: 1 #####" call LoadWMOCty (InfoCode0,InfoCode1,InfoAcroCty,InfoReg,InfoNameCty,PlusAcro=1) InfoStnN = size (InfoCode0,1) if (Digits.EQ.6) then ! no action required else if (Digits.EQ.5) then InfoCode0 = floor(real(InfoCode0)/10.0) InfoCode1 = floor(real(InfoCode1)/10.0) end if do XStn = 1, StnN ! find cty-name using WMO-code + cty-acronym if (len_trim(AcroCty(XStn)).EQ.2) then XInfoStn = 0 do XInfoStn = XInfoStn + 1 if (InfoAcroCty(XInfoStn).EQ.AcroCty(XStn)) then if (InfoCode0(XInfoStn).LE.Code(XStn).AND.InfoCode1(XInfoStn).GE.Code(XStn)) then NameCty(XStn)=InfoNameCty(XInfoStn) end if end if if (InfoCode0(XInfoStn).GT.Code(XStn)) exit if (XInfoStn.EQ.InfoStnN) exit end do end if end do deallocate (InfoCode0,InfoCode1,InfoAcroCty,InfoReg,InfoNameCty,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GetCRUtsInfo: Deallocation failure: 2 #####" call LoadWMOCty (InfoCode0,InfoCode1,InfoAcroCty,InfoReg,InfoNameCty) InfoStnN = size (InfoCode0,1) if (Digits.EQ.6) then ! no action required else if (Digits.EQ.5) then InfoCode0 = floor(real(InfoCode0)/10.0) InfoCode1 = floor(real(InfoCode1)/10.0) end if do XStn = 1, StnN ! find cty-name using WMO-code only if (trim(NameCty(XStn)).EQ."unidentified") then XInfoStn = 0 do XInfoStn = XInfoStn + 1 if (InfoCode0(XInfoStn).LE.Code(XStn).AND.InfoCode1(XInfoStn).GE.Code(XStn)) then NameCty(XStn)=InfoNameCty(XInfoStn) end if if (InfoCode0(XInfoStn).GT.Code(XStn)) exit if (XInfoStn.EQ.InfoStnN) exit end do end if end do deallocate (InfoCode0,InfoCode1,InfoAcroCty,InfoReg,InfoNameCty,stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: GetCRUtsInfo: Deallocation failure: 3 #####" end subroutine GetCRUtsInfo !******************************************************************************* ! loads arrays that allow one to go from WMO number to the name of a country (+acro sometimes, +reg) ! set PlusAcro when using acronym information + WMO number to deduce country ! set ExtraCty when you want to allow an extra 'unclassified' country subroutine LoadWMOCty (Code0,Code1,Acro,Reg,Name,PlusAcro,ExtraCty) integer, pointer, dimension (:) :: Code0,Code1,Reg character (len=13), pointer, dimension (:) :: Name character (len=02), pointer, dimension (:) :: Acro integer, intent(in), optional :: PlusAcro,ExtraCty integer :: ReadStatus, AllocStat integer :: CtyN,XCty, AllN,XAll real, parameter :: MissVal = -999.0 character (len=80) :: LoadFile,Trash character (len=30) :: LoadFormat = "(2i8,i3,a2,a1,a13)" if (present(PlusAcro)) then LoadFile = "./../../../constants/wmo/wmoacro-to-cty.dat" else LoadFile = "./../../../constants/wmo/wmo-to-cty.dat" end if call system ('tail -c +1 ' // LoadFile // ' | wc | tr -s " " "\t" | cut -f2 > count.txt') open (3,file='count.txt',status="old",access="sequential", & form="formatted",action="read") read (3,"(i)"), CtyN close (3) call system ('rm count.txt') if (present(ExtraCty)) then AllN = CtyN + 1 else AllN = CtyN end if allocate (Code0 (AllN), & Code1 (AllN), & Reg (AllN), & Name (AllN), & Acro (AllN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadWMOCty: Allocation failure #####" Code0 = MissVal ; Code1 = MissVal ; Reg = MissVal ; Name = "" ; Acro = "" open (3,file=LoadFile,status="old",access="sequential",form="formatted",action="read") do XCty = 1, CtyN read (3,LoadFormat), Code0(XCty),Code1(XCty),Reg(XCty),Acro(XCty),Trash,Name(XCty) end do close (3) end subroutine LoadWMOCty !******************************************************************************* ! loads arrays that allow one to obtain all kinds of info based solely on WMO number subroutine LoadWMOInfo (Code,AcroStn,Name,AcroCty,Lat,Long,Elev) real, pointer, dimension (:) :: Lat,Long,Elev integer, pointer, dimension (:) :: Code character (len=20), pointer, dimension (:) :: Name character (len=04), pointer, dimension (:) :: AcroStn character (len=02), pointer, dimension (:) :: AcroCty integer :: ReadStatus, AllocStat integer :: StnN,XStn real, parameter :: MissVal = -999.0 character (len=80) :: LoadFile,Trash character (len=30) :: LoadFormat = "(i6,a1,a4,a3,a20,a1,a2,3f8.2)" LoadFile = "/cru/mikeh1/f709762/obs/meta/comb-stn-proc.dat" call system ('wc -l ' // LoadFile // ' > trashme-wmoinfo.txt') open (3,file='trashme-wmoinfo.txt',status="old",access="sequential",form="formatted",action="read") read (3,"(i10)"), StnN close (3) call system ('rm trashme-wmoinfo.txt') allocate (Code (StnN), & Lat (StnN), & Long (StnN), & Elev (StnN), & Name (StnN), & AcroStn (StnN), & AcroCty (StnN), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### ERROR: LoadWMOCty: Allocation failure #####" Code=MissVal ; Lat=MissVal ; Long=MissVal ; Elev=MissVal ; Name="" ; AcroStn="" ; AcroCty="" open (3,file=LoadFile,status="old",access="sequential",form="formatted",action="read") do XStn = 1, StnN read (3,LoadFormat), Code(XStn),Trash,AcroStn(XStn),Trash,Name(XStn),Trash,AcroCty(XStn),& Lat(XStn),Long(XStn),Elev(XStn) end do close (3) end subroutine LoadWMOInfo !******************************************************************************* end module WMOkey