! countries.f90
! module for using the master countries file: master-cty.txt
! contains:
!   	ClarifyCty: for a vector of fresh stn, check the cty names
! requires:
!	GridOps, SortMod, CtyFiles (from 23.1.04)

module Countries

use GridOps
use SortMod
use CtyFiles

implicit none

contains

!*******************************************************************************
! Raw (required) are the vectors describing the fresh data-set (assumes caps and no hyphens)
! Ref (required) are the vectors describing a recent (not necessarily the most recent)
!	version of the master code file [future mod could make this optional and load in sub]
! Got (required) returns the correct start/end codes, and continent code
! 	the correct country Cty is placed in RawCty

subroutine ClarifyCty (RawCty,RawName,RawLat,RawLon,RawCode,RefCty,RefName,RefLat,RefLon, &
			GotCode0,GotCode1,GotContinent)

real, dimension (:), pointer			:: RawLat,RawLon,RefLat,RefLon,Distances

integer, dimension (:), pointer			:: GotCode0,GotCode1,GotContinent,RawCode
integer, dimension (:), pointer 		:: MasterCode0,MasterCode1,MasterContinent
integer, dimension (:), pointer 		:: Order

character (len=20), dimension (:), pointer 	:: RawName,RefName,GotName
character (len=13), dimension (:), pointer 	:: RawCty,RefCty,GotCty
character (len=13), dimension (:), pointer 	:: MasterRawCty,MasterFinalCty

integer, parameter 		:: MissVal = -999
character (len=13), parameter 	:: MissText = 'unknown'
character (len=80), parameter 	:: MasterFile = './../../../data/cruts/cty/master.txt'

real :: MinDistance

integer :: AllocStat,ReadStatus,QChoice,QAddMaster,QLabel
integer :: NRaw,NRef,NGot,NMaster,NMiss
integer :: XRaw,XRef,XGot,XMaster,XMiss
integer :: Cty1,Cty2,Cty3

character (len=13) :: CtyLabel,String13

!*************************************** preliminaries
								! see routine below
NRaw = size(RawCty) ; NGot = NRaw
NRef = size(RefCty)

if (NRaw.NE.size(RawLat).OR.NRaw.NE.size(RawLon).OR. &
	NRef.NE.size(RefLat).OR.NRef.NE.size(RefLon)) &
	print*, "  > @@@@@ ERROR: vector size mismatched @@@@@"

allocate (GotCty      (NGot), &
	  GotCode0     (NGot), &
	  GotCode1     (NGot), &
	  GotContinent (NGot), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: ClarifyCty: Allocation failure: Got #####"
GotCty = MissText

NMaster=MasterSize()
allocate (MasterRawCty   (NMaster), &
	  MasterFinalCty (NMaster), &
	  MasterCode0     (NMaster), &
	  MasterCode1     (NMaster), &
	  MasterContinent (NMaster), &
	  Distances    (NRef), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: ClarifyCty: Allocation failure #####"

call LoadMasterCty (MasterRawCty,MasterFinalCty,MasterCode0,MasterCode1,MasterContinent)

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

do XRaw = 1, NRaw
  XMaster = 0					! look for perfect match
  do
    XMaster = XMaster + 1
!    print "(4i8)", XRaw,XMaster,size(RawCty),size(MasterRawCty) ! @@@@@@@@@@@@@@@@@@@@@@@@
		! for some unknown reason, the program may think
		! that MasterRawCty in the line below is unalloc unless
		! the -g option is invoked on the pgf90 compiler
		! if unalloc, -Mbounds will precipitate execution failure
    if (MasterRawCty(XMaster).EQ.RawCty(XRaw)) then
      GotCty(XRaw) = MasterFinalCty(XMaster)
      GotCode0(XRaw) = MasterCode0(XMaster)
      GotCode1(XRaw) = MasterCode1(XMaster)
      GotContinent(XRaw) = MasterContinent(XMaster)
    end if
    
    if (XMaster.EQ.NMaster.OR.RawCty(XRaw).EQ.MasterRawCty(XMaster)) exit
  end do
  
  if (GotCty(XRaw).EQ.MissText) then		! if no match yet found
   if (RawLat(XRaw).NE.MissVal.AND.RawLon(XRaw).NE.MissVal) then
    Distances = 10000000.0 ; MinDistance = 10000000.0
    do XRef = 1, NRef				! get distances from ref stns
      if (RefLat(XRef).NE.MissVal.AND.RefLon(XRef).NE.MissVal) then
        Distances(XRef) = GetDistance(RawLat(XRaw),RawLon(XRaw),RefLat(XRef),RefLon(XRef))
        if (Distances(XRef).LT.MinDistance) MinDistance = Distances(XRef)
        if (Distances(XRef).GT.(MinDistance+1000)) Distances(XRef) = MissVal
      end if
    end do    

    allocate (Order(NRef), stat=AllocStat)
    if (AllocStat.NE.0) print*, "  > ##### ERROR: ClarifyCty: Allocation failure: Order #####"
    call QuickSort (Reals=Distances,OrderValid=Order,NMiss=NMiss) 	! find closest stns

    XRef = 0
    do 						! look for matching stn in master data-set
      XRef=XRef+1
      if (Distances(Order(XRef)).EQ.0.OR.trim(RawName(XRaw)).EQ. &
      					trim(RefName(Order(XRef)))) then
        RawCty(XRaw) = RefCty(Order(XRef))
        XMaster = 0				! find the match in master
        do
          XMaster = XMaster + 1
          if (RawCty(XRaw).EQ.MasterRawCty(XMaster)) then
            GotCty(XRaw) = MasterFinalCty(XMaster)
            GotCode0(XRaw) = MasterCode0(XMaster)
            GotCode1(XRaw) = MasterCode1(XMaster)
            GotContinent(XRaw) = MasterContinent(XMaster)
          end if
          if (XMaster.EQ.NMaster.OR.RawCty(XRaw).EQ.MasterRawCty(XMaster)) exit
        end do
      end if
      if (Distances(Order(XRef)).GE.8.OR.RawCty(XRaw).EQ.RefCty(Order(XRef))) exit
    end do
   end if
  end if
  
  if (GotCty(XRaw).EQ.MissText) then		! do specific matches for naughty abbrevs
    if      (trim(RawCty(XRaw)).EQ.'CHI' &
    		.AND.RawCode(XRaw).GE.5000000.AND.RawCode(XRaw).LE.5999999) then
      GotCty(XRaw) = "CHINA"
    else if (trim(RawCty(XRaw)).EQ.'CHI' &
    		.AND.RawCode(XRaw).GE.8540000.AND.RawCode(XRaw).LE.8599999) then
      GotCty(XRaw) = "CHILE"
    else if (trim(RawCty(XRaw)).EQ.'IND' &
    		.AND.RawCode(XRaw).GE.4200000.AND.RawCode(XRaw).LE.4339999) then
      GotCty(XRaw) = "INDIA"
    else if (trim(RawCty(XRaw)).EQ.'IND' &
    		.AND.RawCode(XRaw).GE.9600000.AND.RawCode(XRaw).LE.9799999) then
      GotCty(XRaw) = "INDONESIA"
    else if (trim(RawCty(XRaw)).EQ.'AUS' &
    		.AND.RawCode(XRaw).GE.9410000.AND.RawCode(XRaw).LE.9599999) then
      GotCty(XRaw) = "AUSTRALIA"
    else if (trim(RawCty(XRaw)).EQ.'AUS' &
    		.AND.RawCode(XRaw).GE. 110000.AND.RawCode(XRaw).LE. 113999) then
      GotCty(XRaw) = "AUSTRIA"
    else if (trim(RawCty(XRaw)).EQ.'CAN' &
    		.AND.RawCode(XRaw).GE.7100000.AND.RawCode(XRaw).LE.7199999) then
      GotCty(XRaw) = "CANADA"
    end if
    
    if (GotCty(XRaw).NE.MissText) then
      XMaster = 0					
      do
        XMaster = XMaster + 1
        if (GotCty(XRaw).EQ.MasterRawCty(XMaster)) then
          GotCode0(XRaw) = MasterCode0(XMaster)
          GotCode1(XRaw) = MasterCode1(XMaster)
          GotContinent(XRaw) = MasterContinent(XMaster)
        end if
        if (GotCty(XRaw).EQ.MasterRawCty(XMaster)) exit
      end do
    end if
  end if
  
  if (GotCty(XRaw).EQ.MissText) then		! if no match yet found
   if (RawLat(XRaw).NE.MissVal.AND.RawLon(XRaw).NE.MissVal) then
    						! find 1st closest cty
    Cty1 = Order(1) ; XRef = 1 ; Cty2 = Cty1 ; Cty3 = Cty1
    do						! find 2nd closest cty
      XRef = XRef + 1
      if (RefCty(Order(XRef)).NE.RefCty(Cty1)) Cty2 = Order(XRef)
      if (Cty2.NE.Cty1.OR.XRef.EQ.(NRef-NMiss)) exit
    end do
    do						! find 3rd closest cty
      XRef = XRef + 1
      if (RefCty(Order(XRef)).NE.RefCty(Cty1).AND.RefCty(Order(XRef)).NE.RefCty(Cty2)) & 
      			Cty3 = Order(XRef)      
      if (Cty3.NE.Cty1.OR.XRef.EQ.(NRef-NMiss)) exit
    end do
    deallocate (Order, stat=AllocStat)
    if (AllocStat.NE.0) print*, "  > ##### ERROR: ClarifyCty: Deallocation failure: Order #####"
    
    print "(3a,i8,a)", "   > '", trim(RawCty(XRaw)), "' (", RawCode(XRaw), &
    			") has no match. Select WMO range: manual (>0),"
    
    print "(7a)", "   >   ", trim(RefCty(Cty1)), " (-1), ", trim(RefCty(Cty2)), " (-2), ", &
    			trim(RefCty(Cty3)), " (-3)"
    do						! choose which WMO code range to adopt
	read (*,*,iostat=ReadStatus), QChoice
	if (ReadStatus.LE.0.AND.QChoice.GE.-3.AND.QChoice.LE.NMaster) exit
    end do
    
    if (QChoice.LT.0) then
      if (abs(QChoice).EQ.1) XRef = Cty1
      if (abs(QChoice).EQ.2) XRef = Cty2
      if (abs(QChoice).EQ.3) XRef = Cty3

      XMaster = 0					! find the chosen master cty entry
      do
        XMaster = XMaster + 1
        if (MasterFinalCty(XMaster).EQ.RefCty(XRef)) exit        
      end do
    else
      XMaster = QChoice
    end if
   else						! if no lat/lon check possible
    print "(3a,i8,a)", "   > '", trim(RawCty(XRaw)), "' (", RawCode(XRaw), &
    			") has no match. Select WMO range: manual (>0)."
    do						! choose which WMO code range to adopt
	read (*,*,iostat=ReadStatus), XMaster
	if (ReadStatus.LE.0.AND.XMaster.GE.(0-NMaster).AND.XMaster.LE.NMaster) exit
    end do
   end if
   
   if (trim(RawCty(XRaw)).EQ.'UNKNOWN') then
     QLabel = 1
   else
     print "(5a)",  "   > Select cty label: ", trim(MasterFinalCty(XMaster)), &
   		" (=1), ", trim(RawCty(XRaw)), " (=2), manual (=3), permanent (<0)"
     do						! choose which cty to adopt
	read (*,*,iostat=ReadStatus), QLabel
	if (QLabel.EQ.2) print*, "  > Permanent entry must be made. "
	if (QLabel.EQ.3) print*, "  > Permanent entry must be made. "
	if (ReadStatus.LE.0.AND.QLabel.GE.-3.AND.QLabel.LE.1) exit
     end do
   end if
   
   if      (abs(QLabel).EQ.1) then
     GotCty(XRaw) = MasterFinalCty(XMaster)
   else if (abs(QLabel).EQ.2) then
     GotCty(XRaw) = RawCty(XRaw)
   else if (abs(QLabel).EQ.3) then
     do						! choose which cty to adopt
	print*, "  > Enter the cty label (max 13 char): "
	read (*,*,iostat=ReadStatus), CtyLabel
	if (ReadStatus.LE.0.AND.CtyLabel.NE."") exit
     end do
     GotCty(XRaw) = CtyLabel
   end if   
   
   GotCode0(XRaw) = MasterCode0(XMaster)
   GotCode1(XRaw) = MasterCode1(XMaster)
   GotContinent(XRaw) = MasterContinent(XMaster)      

   if (QLabel.LT.0) then
    						! unload old cty master data 
!     print*, "  > Deallocating..."	! @@@@@@@@@@@@@@@@@
     deallocate (MasterRawCty,MasterFinalCty,MasterCode0,MasterCode1,MasterContinent,stat=AllocStat)
     if (AllocStat.NE.0) print*, "  > ##### ERROR: ClarifyCty: Deallocation failure #####"
    						! add new country entry
!     print*, "  > Appending to ", trim(MasterFile)	! @@@@@@@@@@@@@@@@@
     open  (3,file=MasterFile,status="old",position="append",action="write")
     write (3,"(2(a13,x),x,3(x,i9))"), RawCty(XRaw),GotCty(XRaw),GotCode0(XRaw),GotCode1(XRaw),&
    			GotContinent(XRaw)
     close (3)					! sort updated master file
     call system ('sort -o ' // trim(MasterFile) // ' ' // trim(MasterFile))	
     
     call LoadMasterCty (MasterRawCty,MasterFinalCty,MasterCode0,MasterCode1,MasterContinent)
     NMaster = size(MasterRawCty)		! reload updated cty master data
!     print*, "  > Reloading with cty total ", NMaster	! @@@@@@@@@@@@@@@@@
   end if
  end if
  
  RawCty(XRaw) = GotCty(XRaw)
end do

!*************************************** exit

deallocate (MasterRawCty,MasterFinalCty,MasterCode0,MasterCode1,MasterContinent, &
		GotCty,Distances,stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: ClarifyCty: Deallocation failure #####"

end subroutine ClarifyCty

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

end module Countries