module cressanl_common
!$$$ module documentation block
!           .      .    .                                       .
! module:   cressanl_common
!   prgmmr: pondeca          org: np23                date: 2012-10-15
!
! abstract: 
!
!
! program history log:
!   2012-10-15  pondeca - 
!
! attributes:
!   language: f90
!   machine:
!
!$$$ end documentation block

  use kinds, only: i_kind,r_single

  implicit none

  integer(i_kind) nobsmax
  integer(i_kind) nmax


  integer(i_kind) nflds,kflds
  integer(i_kind) kps,kts,kqs,kus,kvs,kugrds,kvgrds,kws,kw2s,kwds, &
                  ktds,kgusts,kvis,kpblhs,kdists

  integer(i_kind),allocatable,dimension(:,:)  :: ipointer
  integer(i_kind),allocatable,dimension(:,:)  :: jpointer
  integer(i_kind),allocatable,dimension(:,:)  :: uvpointer

  real(r_single),allocatable,dimension(:)     :: xlocs
  real(r_single),allocatable,dimension(:)     :: ylocs
  real(r_single),allocatable,dimension(:)     :: hgt0s
  real(r_single),allocatable,dimension(:)     :: hgts
  real(r_single),allocatable,dimension(:)     :: hobs
  real(r_single),allocatable,dimension(:)     :: rmuses
  real(r_single),allocatable,dimension(:)     :: oberrs
  real(r_single),allocatable,dimension(:)     :: dtimes
  real(r_single),allocatable,dimension(:)     :: rtvts
  real(r_single),allocatable,dimension(:,:,:) :: bckgs
  real(r_single),allocatable,dimension(:,:,:) ::xberrs  !sqrt of bckg error variance
  real(r_single),allocatable,dimension(:,:)   ::terrain
  
  character(8),allocatable,dimension(:)       :: cstations
  character(8),allocatable,dimension(:)       :: obstypes

  logical(4),allocatable,dimension(:)         :: insubdoms
  logical(4),allocatable,dimension(:)         :: dups


contains

!*****************************************************************************************
!*****************************************************************************************
subroutine create_cressanl_common(ista,iend,jsta,jend,nx,ny,npe)

   implicit none
 
   integer(i_kind),intent(in)::ista,iend,jsta,jend
   integer(i_kind),intent(in)::nx,ny
   integer(i_kind),intent(in)::npe


   nflds=13       !order is ps,t,q,u,v,w,w2,wdir,td,gust,vis,pblh,dist
   kflds=9        !perform cressman analysis for 9 fields only
                  !(u,v,t,ps,q,gust,vis,pblh,dist)
!  nmax=50000
   print*,'in create_cressanl_common: nmax=',nmax

   allocate(ipointer(nmax,nflds))
   allocate(jpointer(nmax,kflds))
   allocate(uvpointer(nmax,2))
   allocate(xlocs(nobsmax))
   allocate(ylocs(nobsmax))
   allocate(hgt0s(nobsmax))
   allocate(hgts(nobsmax))
   allocate(hobs(nobsmax))
   allocate(rmuses(nobsmax))
   allocate(oberrs(nobsmax))
   allocate(dtimes(nobsmax))
   allocate(rtvts(nobsmax))
   allocate(cstations(nobsmax))
   allocate(obstypes(nobsmax))
   allocate(insubdoms(nobsmax))
   allocate(dups(nobsmax))
   allocate(bckgs(ista:iend,jsta:jend,kflds))
   allocate(xberrs(ista:iend,jsta:jend,kflds))
   allocate(terrain(nx,ny))

end subroutine create_cressanl_common
!*****************************************************************************************
!*****************************************************************************************

!*****************************************************************************************
!*****************************************************************************************
subroutine destroy_cressanl_common
   implicit none

   deallocate(ipointer)
   deallocate(jpointer)
   deallocate(uvpointer)
   deallocate(xlocs)
   deallocate(ylocs)
   deallocate(hgt0s)
   deallocate(hgts)
   deallocate(hobs)
   deallocate(rmuses)
   deallocate(oberrs)
   deallocate(dtimes)
   deallocate(rtvts)
   deallocate(cstations)
   deallocate(obstypes)
   deallocate(insubdoms)
   deallocate(dups)
   deallocate(bckgs)
   deallocate(xberrs)
   deallocate(terrain)

end subroutine destroy_cressanl_common
!*****************************************************************************************
!*****************************************************************************************

!*****************************************************************************************
!*****************************************************************************************
subroutine load_cressanl_common(mype)
   implicit none

   integer(4),intent(in)::mype

   integer(4),parameter:: lun1=11
   real(4),parameter::spval=-99999.

   integer(4) itype
   real(4) rlat,rlon,dtime,xx,yy,oberr
   real(4) ob,ob_model,qtflg,bb,shgt0,hgt0,hgt,slm,rmuse
   character(8) cstation,cprovider,csubprovider,obstype
   logical insubdom

   integer(4) n
   character(2) clun1
!=====================================================================
!==>all tasks reads in ob locations and other info. from stats files
!=====================================================================
   xlocs=0.    
   ylocs=0.
   hobs=0.
   rmuses=spval
   oberrs=spval
   rtvts=spval

   write(clun1,'(i2.2)') mype

   open (lun1,file='stats_ges_cv_'//clun1,form='formatted')

      kps=0;    kts=0;    kqs=0;  kus=0;    kvs=0;  kws=0; kw2s=0; kwds=0
      ktds=0;   kgusts=0; kvis=0; kpblhs=0; kdists=0
      kugrds=0; kvgrds=0 

      ipointer(:,:)=0

      n=0
100   continue
      read(lun1,'(4a8)',end=200) cstation,cprovider,csubprovider,obstype
      read(lun1,*,end=200) itype,rlat,rlon,dtime,xx,yy,oberr, & 
                  ob,ob_model,qtflg,bb,shgt0,hgt0,hgt,slm,rmuse,insubdom

      n=n+1

      xlocs(n)=xx
      ylocs(n)=yy
      hgt0s(n)=hgt0
      hgts(n)=hgt
      hobs(n)=ob
      rmuses(n)=rmuse
      oberrs(n)=oberr
      dtimes(n)=dtime
      rtvts(n)=bb
      cstations(n)(1:8)=cstation(1:8)
      obstypes(n)(1:8)=obstype(1:8)
      insubdoms(n)=insubdom

      if (trim(obstypes(n))=='p-ob') then 
          kps=kps+1
          ipointer(kps,1)=n

      elseif (trim(obstypes(n))=='t-ob') then
          kts=kts+1
          ipointer(kts,2)=n

      elseif (trim(obstypes(n))=='q-ob') then
          kqs=kqs+1
          ipointer(kqs,3)=n

      elseif (trim(obstypes(n))=='u-ob') then 
          kus=kus+1 
          ipointer(kus,4)=n

      elseif (trim(obstypes(n))=='v-ob') then 
          kvs=kvs+1
          ipointer(kvs,5)=n

      elseif (trim(obstypes(n))=='w-ob') then 
          kws=kws+1
          ipointer(kws,6)=n

      elseif (trim(obstypes(n))=='w2-ob') then 
          kw2s=kw2s+1
          ipointer(kw2s,7)=n

      elseif (trim(obstypes(n))=='wd-ob') then 
          kwds=kwds+1
          ipointer(kwds,8)=n

      elseif (trim(obstypes(n))=='td-ob') then 
          ktds=ktds+1
          ipointer(ktds,9)=n

      elseif (trim(obstypes(n))=='gust-ob') then 
          kgusts=kgusts+1 
          ipointer(kgusts,10)=n

      elseif (trim(obstypes(n))=='vis-ob') then
          kvis=kvis+1
          ipointer(kvis,11)=n

      elseif (trim(obstypes(n))=='pblh-ob') then
          kpblhs=kpblhs+1
          ipointer(kpblhs,12)=n

      elseif (trim(obstypes(n))=='dist-ob') then
          kdists=kdists+1
          ipointer(kdists,13)=n

      elseif (trim(obstypes(n))=='ugrel-ob') then 
          kugrds=kugrds+1 
          uvpointer(kugrds,1)=n

      elseif (trim(obstypes(n))=='vgrel-ob') then 
          kvgrds=kvgrds+1
          uvpointer(kvgrds,2)=n
      endif

      goto 100
200   continue 
   print*,' in load_cressanl_common: mype, number of obs,nobsmax=',mype,n,nobsmax
   print*,' in load_cressanl_common: kps,kts,kqs,kus,kvs,kugrds,kvgrds,kws,kw2s,kwds,& 
                                    &ktds,kgusts,kvis,kpblhs,kdists=',& 
                                     kps,kts,kqs,kus,kvs,kugrds,kvgrds,kws,kw2s,kwds,& 
                                     ktds,kgusts,kvis,kpblhs,kdists

   close(lun1)

   jpointer(:,1)=uvpointer(:,1)
   jpointer(:,2)=uvpointer(:,2)
   jpointer(:,3)=ipointer(:,2)
   jpointer(:,4)=ipointer(:,1)
   jpointer(:,5)=ipointer(:,3)
   jpointer(:,6)=ipointer(:,10)
   jpointer(:,7)=ipointer(:,11)
   jpointer(:,8)=ipointer(:,12)
   jpointer(:,9)=ipointer(:,13)


end subroutine load_cressanl_common
!*****************************************************************************************
!*****************************************************************************************

end module cressanl_common
!*****************************************************************************************
!*****************************************************************************************
