! wmocode.f90 ! module in which standard routines for checking/adopting WMO station codes ! contains: ! ManualCountry : manual selection of country ! NextFreePseudo : returns next available pseudo code module WMOCode ! use SortMod implicit none contains !******************************************************************************* ! employs (from call) the country name and region number vectors from master file ! returns an index corresponding to the chosen country from those vectors function ManualCountry (CtyName,CtyReg) integer :: ManualCountry integer, pointer, dimension (:) :: CtyReg character (len=13), pointer, dimension (:) :: CtyName integer :: ReadStatus integer :: QCountry,QContinent integer :: NCty,XCty,LastCty NCty = size(CtyName,1) if (size(CtyReg,1).NE.NCty) print*, " > @@@@@ ERROR: ManualCountry: dim mismatch @@@@@" do print*, " > Enter the country (0=help,<0=continent): " read (*,*,iostat=ReadStatus), QCountry if (QCountry.EQ.0) then print*, " > -1=Europe -2=ex-USSR -3=Middle-East -4=Asia" print*, " > -5=Africa -6=N.America -7=C.America -8=S.America" print*, " > -9=Antarctica -10=Oceania -11=Marine" end if if (QCountry.LE.-1.AND.QCountry.GE.-11) then LastCty = 0 ; QContinent=-1*QCountry do XCty = 1,NCty if (CtyReg(XCty).EQ.QContinent) then if (LastCty.EQ.0) then LastCty = XCty else print "(2(a,i3,2a))", " > ", LastCty, ". ", CtyName(LastCty), & " ", XCty, ". ", CtyName(XCty) LastCty = 0 end if end if end do if (LastCty.NE.0) print "(a,i3,2a)", " > ", LastCty, ". ", CtyName(LastCty) end if if (ReadStatus.LE.0.AND.QCountry.GE.1.AND.QCountry.LE.NCty) exit end do print "(2a)", " > The selected country is: ", CtyName(QCountry) ManualCountry = QCountry end function ManualCountry !******************************************************************************* ! takes two vectors of pre-existing station codes (Master,Original) ! assumes that Master is sorted in numerical order ! takes an integer representing the first code that would be acceptable ! returns the first pseudo code that is free function NextFreePseudo (MasterStn,OriginalStn,StartSearch) integer :: NextFreePseudo,StartSearch integer, pointer, dimension (:) :: MasterStn,OriginalStn integer :: NMaster,NOriginal,XMaster,XOriginal, LookingFor,FoundIt NMaster = size(MasterStn,1) NOriginal = size(OriginalStn,1) XMaster = NMaster + 1 ; NextFreePseudo = 0 ; LookingFor = StartSearch do XMaster = XMaster - 1 if (MasterStn(XMaster).EQ.LookingFor) then ! next code is already in Master LookingFor = LookingFor - 1 else if (MasterStn(XMaster).LT.LookingFor) then ! next code is not in Master XOriginal = 0 ; FoundIt = 0 do XOriginal = XOriginal + 1 if (OriginalStn(XOriginal).EQ.LookingFor) FoundIt = 1 ! next code is already in Original if (FoundIt.EQ.1) exit if (XOriginal.EQ.NOriginal) exit end do if (FoundIt.EQ.0) NextFreePseudo = LookingFor ! next code is not in Original either if (FoundIt.EQ.1) then LookingFor = LookingFor - 1 ; XMaster = XMaster + 1 end if end if if (NextFreePseudo.NE.0) exit end do end function NextFreePseudo !******************************************************************************* end module WMOCode