!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!

      subroutine getobstag  1,16
      use modfgat, only : nstamplist, nobsgid, nobs, notag, nstepobs
      use mod4dv, only : mvar, l4dvar
#if defined (DOC)
*
***s/r read local observation tag from GEM TLM-ADJ .
*
*Author  : Bin He *ARMA/MRB  Feb. 2009
*
*Revision:
*  
*Arguments: none
*
#endif
      USE procs_topo  
      USE obstag 
      IMPLICIT NONE
*implicits
!!        integer,pointer,dimension(:) :: locObsTag 

#include "comlun.cdk"
#include "comdimo.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comvfiles.cdk"
#include "cvcord.cdk"
#include <prof_f.h>
*
!     Local Variables
      integer :: prof_wrrec,prof_rdrec
      integer :: ihdl,istat  
      character(len=2) :: cljx,cljy 
      character(len=512) :: clprof 

      integer ,allocatable,dimension(:) :: locObsTag_tmp  

      logical :: isExist_L
      integer ::  i,j, jj,k,ierr,interv,istart,iend   
      integer :: ibegin,ilast,ibeginob,ilastob
      integer :: length_l, iobs,idata 
      integer :: count
      real*8  :: a  
*-------------------------------------------------------------
      write(nulout,*) '-------- Start Getobstag ---------'
      IF(l4dvar) THEN
         write(cljx,'(i2.2)') myidx
         write(cljy,'(i2.2)') myidy

         clprof = trim(CEXC4DV) // '/obstag_'//cljx//'_'//cljy//'.prof'
         WRITE(*,*) 'Open File: ',clprof 
         count=0
         waiting: DO 
            INQUIRE(FILE=clprof,EXIST=isExist_L)
            if(isExist_L .and. (count>50000) ) EXIT 
            count=count+1
         ENDDO waiting

         ihdl= prof_open(clprof,'READ','FILE')
         If(ihdl < 0) CALL ABORT3D(nulout,'getobstag')
         istat= prof_rdrec(ihdl) 
         istat= prof_gvar(ihdl,locObsTag,V2D_OTAG) 
       
         istat= prof_close(ihdl,.true.) 
         length_l=size(locObsTag) 
*-------------------------------------------------------------
      !!! for 3dvar 
      ELSE
        jj=0
        IF(nprocs == 0) nprocs=1
        WRITE(nulout,*) 'nobtot= ',nobtot 
        ALLOCATE(locObsTag_tmp(nobtot),STAT=ierr)
        DO J=1,NFILES
           ibegin= NBEGINTYP(j)
           ilast = NENDTYP(j) 

           ibeginob= MOBDATA(NCMOBS,ibegin) 
           ilastob = MOBDATA(NCMOBS,ilast)  
           Write(*,*) 'J ibeginob ilastob= ',j,ibeginob,ilastob 

           interv=INT((ilastob-ibeginob+1)/nprocs)  
           IF(interv == 0) THEN
              IF(myid <= (ilastob-ibeginob)-1) THEN
                interv=1
              ENDIF 
           ENDIF  
           istart=interv*myid+ibeginob
           iend=interv*(myid+1)+ibeginob -1 
           if(myid == nprocs-1) iend=ilastob

           IF( interv == 0) THEN
              istart=ibeginob
              iend=istart
           ENDIF

           write(*,*)'istart iend= ',istart,iend  
           IF (NBEGINTYP(J) .GT. 0)THEN
              SELECT CASE(CFAMTYP(J)) 
                 CASE('UA') 
                    CALL calObsTag(ibeginob,ilastob,jj)
                 CASE('AI')
                    CALL calObsTag(ibeginob,ilastob,jj)
                 CASE('SW')
                    CALL calObsTag(ibeginob,ilastob,jj)
                 CASE('SF')
                    CALL calObsTag(ibeginob,ilastob,jj)
                 CASE('TO') 
                    CALL calObsTag(ibeginob,ilastob,jj)
                 CASE('GO')
                    CALL calObsTag(ibeginob,ilastob,jj)
                 CASE('RO')
                    CALL calObsTag(ibeginob,ilastob,jj)
                 CASE('PR')
                    CALL calObsTag(ibeginob,ilastob,jj)
                 CASE('SC')
                    CALL calObsTag(ibeginob,ilastob,jj)
                 CASE('GP')
                    CALL calObsTag(ibeginob,ilastob,jj)
               END SELECT
           ELSE
             WRITE(nulout,*) 'Zero for Type ',CFAMTYP(J)  
           ENDIF

        ENDDO  ! bhe   
        length_l=jj
        ALLOCATE(locObsTag(length_l),STAT=ierr)

        locObsTag(1:length_l)=locObsTag_tmp(1:length_l)

        DEALLOCATE(locObsTag_tmp) 

      ENDIF !! end if(l4dvar)  

   !! Calculate the size of the local obs data  
      ndata_l=0
      IF(length_l<=0) CALL ABORT3D(nulout,'Zero lenght of ObsTag,Abort!') 
      DO i=1,length_l
       iobs=locObsTag(i)
       idata= MOBHDR(NCMNLV,iobs) 
       ndata_l = ndata_l + idata
      ENDDO 

      write(nulout,*) ' '
      write(nulout,*) '-------- END OF Getobstag ---------'
      write(nulout,*) ' '
c  
      CONTAINS 

      subroutine calObsTag(startindx,endindx,jsize) 10
         integer,intent(in) :: startindx,endindx
         integer,intent(inout) :: jsize
         !Local variables
         integer :: k 
         DO k=startindx,endindx
           IF(k>=ISTART .and.k<= IEND) THEN
              jsize=jsize+1
              locObsTag_tmp(jsize)=k
           ENDIF
           
         ENDDO 
      end subroutine calObsTag 

      end subroutine getobstag