!-------------------------------------- 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,7
      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:
*         . Bin HE  *ARMA/MRB*   Oct. 2011
*            -  Fix problem when interv=0 for 3Dvar mode.   
*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,nsum
      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) 

           IF(ibegin == -999 .and. ilast==-999) THEN
             ibeginob=0
             ilastob=-1
             istart=0
             iend=0 
           ELSE
             ibeginob= MOBDATA(NCMOBS,ibegin) 
             ilastob = MOBDATA(NCMOBS,ilast)  
             Write(*,*) 'J ibeginob ilastob= ',j,ibeginob,ilastob 
         
             nsum=ilastob-ibeginob+1
             interv=INT(nsum/nprocs)  
             IF(interv > 0) THEN
               istart=interv*myid+ibeginob
               iend=interv*(myid+1)+ibeginob -1 
               if(myid == nprocs-1) iend=ilastob
             ELSE 
               IF(myid<nsum)THEN
                istart=ibeginob+myid
                iend=istart 
               ELSE
                istart=0
                iend=0
               ENDIF 
             ENDIF  

           ENDIF !! ibegin=-999  

           write(*,*)'istart iend= ',istart,iend  
           IF (NBEGINTYP(J) .GT. 0)THEN
              CALL calObsTag(ibeginob,ilastob,jj)
           ELSE
              WRITE(nulout,*) 'Zero for Type ',CFAMTYP(J)  
           ENDIF

        ENDDO  ! J=1,NFILES      
        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) 1
         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