PROGRAM fbprint
   USE toolspar_kind 
   USE obs_fbm
   USE index_sort
   IMPLICIT NONE
   !
   ! Command line arguments input file
   !
#ifndef NOIARGCPROTO
   INTEGER,EXTERNAL :: iargc
#endif
   INTEGER :: nargs
   CHARACTER(len=256) :: cdinfile,cdbrief
   LOGICAL :: lbrief, lqcflags, lstat
   CHARACTER(len=8) :: cdstat
   INTEGER :: nqc
   !
   ! Input data
   !
   TYPE(obfbdata) :: obsdata
   !
   ! Loop variables
   !
   INTEGER :: ii
   !
   ! Sorting
   !
   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
   INTEGER,ALLOCATABLE  :: iindex(:)
   !
   ! Get number of command line arguments
   !
   nargs  = IARGC()
   lbrief = .FALSE.
   lstat = .FALSE.
   cdstat = 'XXXXXXX'
   nqc = 0
   IF ( (nargs < 1) .OR. (nargs > 3) ) THEN
      CALL usage()
   ENDIF
   IF (( nargs == 2 )) THEN
      CALL getarg( 1, cdbrief )
      IF ( cdbrief == '-b' ) THEN
         lbrief = .TRUE.
      ELSEIF( cdbrief == '-q' ) THEN
         lqcflags = .TRUE.
         nqc=1
      ELSEIF( cdbrief == '-Q' ) THEN
         lqcflags = .TRUE.
         nqc=2
      ELSEIF( cdbrief == '-B' ) THEN
         lqcflags = .TRUE.
         nqc=3
      ELSE
         CALL usage
      ENDIF
   ENDIF
   IF (( nargs == 3 )) THEN
      CALL getarg( 1, cdbrief )
      IF ( cdbrief == '-s' ) THEN
         lstat = .TRUE.
         CALL getarg( 2, cdstat )
      ELSE
         CALL usage
      ENDIF
   ENDIF
   CALL getarg( nargs, cdinfile )
   !
   ! Get input data
   !
   CALL read_obfbdata( TRIM(cdinfile), obsdata )
   WRITE(*,'(2A,I9,A,I9,A)')TRIM(cdinfile), ' has ', obsdata%nobs ,&
      & ' observations and a maximum of ', obsdata%nlev, ' levels'
   !
   ! Sort the data
   !   
   ALLOCATE(zsort(3,obsdata%nobs),iindex(obsdata%nobs))
   DO ii=1,obsdata%nobs
      zsort(1,ii)=obsdata%ptim(ii)
      zsort(2,ii)=obsdata%pphi(ii)
      zsort(3,ii)=obsdata%plam(ii)
   ENDDO
   CALL index_sort_dp_n(zsort,3,iindex,obsdata%nobs)
   !
   ! Print the sorted list
   !   
   DO ii=1,obsdata%nobs
      IF (lstat) THEN
         IF (cdstat /= obsdata%cdwmo(ii)) CYCLE
      ENDIF
      IF (lqcflags) THEN
         CALL print_obs_qc(obsdata,iindex(ii),nqc)
      ELSE
         CALL print_obs(obsdata,iindex(ii),lbrief,lqcflags,nqc)
      ENDIF
   ENDDO

END PROGRAM fbprint

SUBROUTINE usage
   WRITE(*,'(A)')'Usage:'
   WRITE(*,'(A)')'fbprint [-b] [-q] inputfile'
   WRITE(*,'(A)')'where -b selects brief output'
   WRITE(*,'(A)')'  and -q selects qc flags rather than extra fields'
   CALL abort()
END SUBROUTINE usage

SUBROUTINE print_obs(obsdata,iindex,lshort)
   USE obs_fbm
   USE date_utils
   IMPLICIT NONE
   TYPE(obfbdata) :: obsdata
   INTEGER :: iindex
   LOGICAL :: lshort
   INTEGER :: jv,ja,je,jk
   INTEGER :: kj,iyr,imon,iday,ihou,imin,isec
   LOGICAL :: lskip
   CHARACTER(len=1024) :: cdfmt1,cdfmt2
   CHARACTER(len=16) :: cdtmp

   WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
   WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
   WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
   WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
   WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
   WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
   WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
   WRITE(*,*)'Julian date         = ',obsdata%ptim(iindex)
   CALL jul2greg(isec,imin,ihou,iday,imon,iyr,obsdata%ptim(iindex))
   WRITE(*,'(1X,A,I4,2I2.2)') &
      &      'Gregorian date      = ',iyr,imon,iday
   WRITE(*,'(1X,A,I2.2,A1,I2.2,A1,I2.2)') &
      &      'Time                = ',ihou,':',imin,':',isec
   IF (.NOT.lshort) THEN
      DO jv = 1,obsdata%nvar
         WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
         WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
         IF (obsdata%lgrid) THEN
            WRITE(*,*)'Grid I              = ',obsdata%iobsi(iindex,jv)
            WRITE(*,*)'Grid J              = ',obsdata%iobsj(iindex,jv)
         ENDIF
      ENDDO
      cdfmt1='(1X,A8,1X,A8'
      cdfmt2='(1X,F8.2,1X,I8'
      DO jv=1, obsdata%nvar
         cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
         cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
         IF (obsdata%nadd>0) THEN
            WRITE(cdtmp,'(I10)')obsdata%nadd
            cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
            cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
         ENDIF
         IF (obsdata%lgrid) THEN
            cdfmt1 = TRIM(cdfmt1)//',1X,A10'
            cdfmt2 = TRIM(cdfmt2)//',1X,I10'
         ENDIF
      ENDDO
      IF (obsdata%next>0) THEN
         WRITE(cdtmp,'(I10)')obsdata%next
         cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
         cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
      ENDIF
      cdfmt1=TRIM(cdfmt1)//')'
      cdfmt2=TRIM(cdfmt2)//')'
      IF (obsdata%lgrid) THEN
         WRITE(*,FMT=cdfmt1)&
            & 'DEPTH', 'DEP_QC', &
            & (TRIM(obsdata%cname(jv))//'_OBS', &
            & TRIM(obsdata%cname(jv))//'_QC' , &
            & (TRIM(obsdata%cname(jv))//'_'//TRIM(obsdata%caddname(ja)),&
            & ja = 1, obsdata%nadd ), &
            & TRIM(obsdata%cname(jv))//'_K' , &
            & jv = 1, obsdata%nvar ), &
            & ( TRIM(obsdata%cextname(ja)),&
            & ja = 1, obsdata%next )
         DO kj=1,obsdata%nlev
            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
               WRITE (*,FMT=cdfmt2) &
                  & obsdata%pdep(kj,iindex),   &
                  & obsdata%idqc(kj,iindex),   &
                  & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
                  & ( obsdata%padd(kj,iindex,ja,jv) , ja=1, obsdata%nadd ), &
                  & obsdata%iobsk(kj,iindex,jv), &
                  & jv = 1, obsdata%nvar ), &
                  & ( obsdata%pext(kj,iindex,ja), ja=1, obsdata%next )
            ENDIF
         ENDDO
      ELSE
         cdfmt1=TRIM(cdfmt1)//')'
         cdfmt2=TRIM(cdfmt2)//')'
         WRITE(*,FMT=cdfmt1)&
            & 'DEPTH', 'DEP_QC', &
            & (TRIM(obsdata%cname(jv))//'_OBS', &
            & TRIM(obsdata%cname(jv))//'_QC' , &
            & (TRIM(obsdata%cname(jv))//TRIM(obsdata%caddname(ja)),&
            & ja = 1, obsdata%nadd ), &
            & jv = 1, obsdata%nvar ), &
            & ( TRIM(obsdata%cextname(ja)),&
            & ja = 1, obsdata%next )
         DO kj=1,obsdata%nlev
            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
               WRITE (*,FMT=cdfmt2) &
                  & obsdata%pdep(kj,iindex),   &
                  & obsdata%idqc(kj,iindex),   &
                  & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
                  & ( obsdata%padd(kj,iindex,ja,jv) , ja=1, obsdata%nadd ), &
                  & jv = 1, obsdata%nvar ), &
                     & ( obsdata%pext(kj,iindex,ja), ja=1, obsdata%next )
            ENDIF
         ENDDO
      ENDIF
   ENDIF
   WRITE(*,*)
END SUBROUTINE print_obs

SUBROUTINE print_obs_qc(obsdata,iindex,kqc)
   USE obs_fbm
   USE date_utils
   IMPLICIT NONE
   TYPE(obfbdata) :: obsdata
   INTEGER :: iindex
   LOGICAL :: lqc
   INTEGER :: kqc
   INTEGER :: jv,ja,je,jk
   INTEGER :: kj,iyr,imon,iday,ihou,imin,isec
   LOGICAL :: lskip
   CHARACTER(len=1024) :: cdfmt1,cdfmt2
   CHARACTER(len=16) :: cdtmp
   integer :: iqcf

   IF (kqc==2) THEN
      lskip=.TRUE.
      IF (obsdata%ipqc(iindex)>1) lskip=.FALSE.
      IF (obsdata%ioqc(iindex)>1) lskip=.FALSE.
      DO jv = 1,obsdata%nvar
         IF (obsdata%ivqc(iindex,jv)>1) lskip=.FALSE.
      ENDDO
      DO kj=1,obsdata%nlev
         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
            IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
            DO jv = 1, obsdata%nvar
               IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
            ENDDO
         ENDIF
      ENDDO
      IF (lskip) RETURN
   ELSEIF (kqc==3) THEN
      lskip=.TRUE.
      DO kj=1,obsdata%nlev
         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
            iqcf=0
            DO jv = 1, obsdata%nvar
               IF (obsdata%ivlqc(kj,iindex,jv)>1) iqcf=iqcf+1
               IF (iqcf==obsdata%nvar) lskip=.FALSE.
            ENDDO
         ENDIF
      ENDDO
      IF (lskip) RETURN
   ENDIF
   WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
   WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
   WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
   WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
   WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
   WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
   WRITE(*,*)'Position QC flags   = ',obsdata%ipqcf(:,iindex)
   WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
   WRITE(*,*)'Observation QC flags= ',obsdata%ioqcf(:,iindex)
   WRITE(*,*)'Julian date         = ',obsdata%ptim(iindex)
   CALL jul2greg(isec,imin,ihou,iday,imon,iyr,obsdata%ptim(iindex))
   WRITE(*,'(1X,A,I4,2I2.2)') &
      &      'Gregorian date      = ',iyr,imon,iday
   WRITE(*,'(1X,A,I2.2,A1,I2.2,A1,I2.2)') &
      &      'Time                = ',ihou,':',imin,':',isec
   DO jv = 1,obsdata%nvar
      WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
      WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
      WRITE(*,*)'Variable QC flags   = ',obsdata%ivqcf(:,iindex,jv)
   ENDDO
   cdfmt1='(1X,A8,1X,A8'
   cdfmt2='(1X,F8.2,1X,I8'
   WRITE(cdtmp,'(I10)')obsdata%nqcf
   cdfmt1 = TRIM(cdfmt1)//',1X,A18'
   cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
   DO jv=1, obsdata%nvar
      cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
      cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
      WRITE(cdtmp,'(I10)')obsdata%nqcf
      cdfmt1 = TRIM(cdfmt1)//',1X,A18'
      cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
   ENDDO
   IF (obsdata%next>0) THEN
      WRITE(cdtmp,'(I10)')obsdata%next
      cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
      cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
   ENDIF
   cdfmt1=TRIM(cdfmt1)//')'
   cdfmt2=TRIM(cdfmt2)//')'
   WRITE(*,FMT=cdfmt1)&
      & 'DEPTH', 'DEP_QC', 'DEP_QC_FLAGS', &
      & (TRIM(obsdata%cname(jv))//'_OBS', &
      & TRIM(obsdata%cname(jv))//'_QC' , &
      & TRIM(obsdata%cname(jv))//'_QC_FLAGS',&
      & jv = 1, obsdata%nvar ), &
      & ( TRIM(obsdata%cextname(ja)),&
      & ja = 1, obsdata%next )
   DO kj=1,obsdata%nlev
      IF (kqc>=2)  THEN
         lskip=.TRUE.
         IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
         DO jv = 1, obsdata%nvar
            IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
         ENDDO
         IF (lskip) CYCLE
      ENDIF
      IF (obsdata%pdep(kj,iindex)<99999.0) THEN
         WRITE (*,FMT=cdfmt2) &
            & obsdata%pdep(kj,iindex),   &
            & obsdata%idqc(kj,iindex),   &
            & ( obsdata%idqcf(ja,kj,iindex), ja = 1, obsdata%nqcf ), &
            & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
            & ( obsdata%ivlqcf(ja,kj,iindex,jv) , ja=1, obsdata%nqcf ), &
            & jv = 1, obsdata%nvar ), &
            & ( obsdata%pext(kj,iindex,ja), ja=1, obsdata%next )
      ENDIF
   ENDDO
   WRITE(*,*)

END SUBROUTINE print_obs_qc