* Last processed by NICE on 12-Jun-2000 15:53:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
C $Header: /scisoft/gildas/sou/nic/main/nic_flag.for,v 1.27 2000/02/17 17:20:33 neri Exp $
C $Log: nic_flag.for,v $
C Revision 1.27  2000/02/17 17:20:33  neri
C *** empty log message ***
C
C Revision 1.26  2000/02/16  11:27:40  11:27:40  neri (Roberto Neri)
C allows .. TO .. sytnax for channels, as well.
C
C Revision 1.25  2000/02/10  11:21:04  11:21:04  broguier (Dominique Broguiere)
C new option ?FAG /sub i TO j[D[D[D[D[D[D[D[D[D[D[D[D[D[D[/FLAG
C
C Revision 1.24  98/12/10  12:42:18  12:42:18  neri (Roberto Neri)
C *** empty log message ***
C
C Revision 1.23  98/01/29  04:01:06  04:01:06  broguier ()
C free memry for subscans
C
C
C Revision 1.22  97/12/18  15:31:27  15:31:27  broguier ()
C add TOTPOW variables
C
C Revision 1.13  96/03/19  14:57:45  14:57:45  broguier (Dominique Broguiere)
C option /SUBSCAN
C
C Revision 1.6  95/03/30  10:52:35  10:52:35  broguier (Dominique Broguiere)
C *** empty log message ***
C
C Revision 1.3  95/01/12  12:43:46  12:43:46  broguier (Dominique Broguiere)
C remove variable IADDRSUBSCAN
C
C Revision 1.2  95/01/05  14:38:03  14:38:03  broguier (Dominique Broguiere)
C .EQ. changed in .EQV.
C
C Revision 1.1  95/01/03  13:41:19  13:41:19  broguier (Dominique Broguiere)
C Initial revision
C
      SUBROUTINE FLAG (LINE,SELECTED_CHANNEL,ERROR)
C ----------------------------------------------------------------------
C 	Support routine for command
C	FLAG   /CHANNEL /RESET /SUBSCAN /TOTPOW
C Arguments :
C	LINE	C*(*)	Command line			Input
C	ERROR	L	Logical error flag		Output
C
C ----------------------------------------------------------------------
      CHARACTER*(*) LINE
      LOGICAL ERROR
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
*
      INTEGER*4 IP_SCANLIST,POINTER,IADDR,IP_SUBFLAG
      INTEGER*4 I,J,K,SELECTED_CHANNEL(NCHAN), FIRST, LAST
      INTEGER*4 SIC_GETVM,IER,SELECTED_SUBSCAN,ICHAN,NC,NUMBER
      INTEGER*4 SELECTED_CHAN
      LOGICAL   SIC_PRESENT,FLAG_RESET
      LOGICAL   ANY_FLAG, SUBSCAN_RESET
      CHARACTER TEXT*2
*
* Test if a file has been opened
*
      IF (IADDRRECORD.EQ.0) THEN
         CALL MESSAGE(2,1,'FLAG','No input file opened')
         ERROR = .TRUE.
         RETURN
      ENDIF
*
* Read SIC variable RECEIVER_FLAG[]
      CALL  R4TOR4(MEMORY(IP_FLAG),RECEIVER_FLAG(1),NCHAN)
*
* 1. Flag channels
*
      IF (.NOT.SIC_PRESENT(3,0)) THEN
*
*
*  Option /RESET
*
         IF (SIC_PRESENT(2,0)) THEN
            FLAG_RESET = .TRUE.
            IF (.NOT.SIC_PRESENT(1,0)) THEN
               DO J=1,NCHAN
                  RECEIVER_FLAG(J) = .FALSE.
               ENDDO
            ENDIF
         ELSE
            FLAG_RESET = .FALSE.
         ENDIF
*
*  Option /CHANNEL
*
         IF (SIC_PRESENT(1,0)) THEN
            I = 1
            J = 1
            LAST = 1
            DO WHILE (SIC_PRESENT(1,J))
               CALL SIC_KE (LINE,1,J,TEXT,NC,.TRUE.,ERROR)
               IF (ERROR) GOTO 99
               READ (TEXT,'(I3)',ERR=92,END=92) NUMBER
               SELECTED_CHAN = NUMBER
               IF (LAST.NE.0) FIRST = NUMBER
               LAST = NUMBER
               GOTO 93
92             IF (TEXT(1:2).EQ."TO") THEN
                  FIRST = SELECTED_CHAN
                  LAST = 0
                  I = I-1
               ELSE
                  CALL MESSAGE (2,1,'FLAG','Bad parameter')
                  ERROR = .TRUE.
                  RETURN
               ENDIF
93             IF (LAST.NE.0) THEN
                  DO K=FIRST,LAST
                     IF (K.GT.NCHAN) THEN
                        CALL MESSAGE (2,1,'FLAG','Bad channel number ')
                        ERROR = .TRUE.
                        RETURN
                     ENDIF
                     SELECTED_CHANNEL(I) = K
                     I = I+1
                  ENDDO
               ENDIF
               J = J+1
            ENDDO
            IF (I.EQ.1) CALL MESSAGE (2,1,'FLAG','No channel selected ')
            IF (I.LE.NCHAN) THEN
               DO J=I,NCHAN
                  SELECTED_CHANNEL(J) = 0
               ENDDO
            ENDIF
         ELSE
            DO J=1,NCHAN
               SELECTED_CHANNEL(J) = 0
            ENDDO
         ENDIF
*
*
         ANY_FLAG = .FALSE.
         DO J = 1,NCHAN
            IF (SELECTED_CHANNEL(J).NE.0 .AND. FLAG_RESET)
     $      RECEIVER_FLAG(SELECTED_CHANNEL(J)) = .FALSE.
            IF (SELECTED_CHANNEL(J).NE.0 .AND. (.NOT.FLAG_RESET))
     $      RECEIVER_FLAG(SELECTED_CHANNEL(J)) = .TRUE.
            ANY_FLAG = ANY_FLAG.OR.RECEIVER_FLAG(J)
         ENDDO
*
         IF (.NOT.SIC_PRESENT(1,0) .AND.
     $   .NOT.SIC_PRESENT(2,0)) THEN
            IF (ANY_FLAG.EQV..FALSE.) THEN
               CALL MESSAGE (2,1,'FLAG','No flagged channels')
            ELSE
               WRITE (6,'('' Flagged channel(s): '',$)')
               DO J = 1,NCHAN
                  IF (RECEIVER_FLAG(J))
     $            WRITE (6,'(i3,$)') J
               ENDDO
               WRITE (6,'(1x)')
            ENDIF
            IP_SUBFLAG  = POINTER(IADDR_SUBFLAG,MEMORY)
            CALL SHOW_SUBSCAN_FLAG(MEMORY(IP_SUBFLAG))
         ENDIF
*  Update SIC variable RECEIVER_FLAG[]
         CALL  R4TOR4(RECEIVER_FLAG(1),MEMORY(IP_FLAG),NCHAN)
      ELSE
*
*
* 2. Flag subscans
*
*
*  Read reset option
         IF (SIC_PRESENT(2,0)) THEN
            SUBSCAN_RESET = .TRUE.
         ELSE
            SUBSCAN_RESET = .FALSE.
         ENDIF
         IER = SIC_GETVM (NSUBSCAN,IADDR)
         IF (IER.NE.1) THEN
            CALL MESSAGE (2,1,'FLAG','Memory allocation failure')
            RETURN
         ENDIF
         IP_SCANLIST = POINTER(IADDR,MEMORY)
         IP_SUBFLAG  = POINTER(IADDR_SUBFLAG,MEMORY)
*  Read selected subscans
         I = 1
         J = 1
         LAST = 1
         DO WHILE (SIC_PRESENT(3,J))
            CALL SIC_KE (LINE,3,J,TEXT,NC,.TRUE.,ERROR)
            IF (ERROR) GOTO 99
            READ (TEXT,'(I3)',ERR=95,END=95) NUMBER
            SELECTED_SUBSCAN = NUMBER
            IF (LAST.NE.0) FIRST = NUMBER
            LAST = NUMBER
            GOTO 96
95          IF (TEXT(1:2).EQ."TO") THEN
               FIRST = SELECTED_SUBSCAN
               LAST = 0
               I = I-1
            ELSE
               CALL MESSAGE (2,1,'FLAG','Bad parameter')
               ERROR = .TRUE.
               RETURN
            ENDIF
96          IF (LAST.NE.0) THEN
               DO K=FIRST,LAST
                  IF (K.GT.NSUBSCAN) THEN
                     CALL MESSAGE (2,1,'FLAG','Bad subscan number ')
                     ERROR = .TRUE.
                     RETURN
                  ENDIF
                  CALL R4TOR4(K,MEMORY(IP_SCANLIST+I-1),1)
                  I = I+1
               ENDDO
            ENDIF
            J = J+1
         ENDDO
         IF (I.EQ.1) CALL MESSAGE (2,1,'FLAG','No subscan selected ')
         IF (I.GT.NSUBSCAN) THEN
            CALL MESSAGE (2,1,'FLAG',
     $      'Flagging all the subscans is not allowed')
            RETURN
         ENDIF
         DO J=I,NSUBSCAN
            CALL R4TOR4(0.,MEMORY(IP_SCANLIST+J-1),1)
         ENDDO
*   Read selected channels
         IF (SIC_PRESENT(1,0)) THEN
            I = 1
            J = 1
            LAST = 1
            DO WHILE (SIC_PRESENT(1,J))
               CALL SIC_KE (LINE,1,J,TEXT,NC,.TRUE.,ERROR)
               IF (ERROR) GOTO 99
               READ (TEXT,'(I3)',ERR=97,END=97) NUMBER
               SELECTED_CHAN = NUMBER
               IF (LAST.NE.0) FIRST = NUMBER
               LAST = NUMBER
               GOTO 98
97             IF (TEXT(1:2).EQ."TO") THEN
                  FIRST = SELECTED_CHAN
                  LAST = 0
                  I = I-1
               ELSE
                  CALL MESSAGE (2,1,'FLAG','Bad parameter')
                  ERROR = .TRUE.
                  RETURN
               ENDIF
98             IF (LAST.NE.0) THEN
                  DO K=FIRST,LAST
                     IF (K.GT.NCHAN) THEN
                        CALL MESSAGE (2,1,'FLAG','Bad channel number ')
                        ERROR = .TRUE.
                        RETURN
                     ENDIF
                     SELECTED_CHANNEL(I) = K
                     I = I+1
                  ENDDO
               ENDIF
               J = J+1
            ENDDO
            IF (I.EQ.1) CALL MESSAGE (2,1,'FLAG','No channel selected ')
            IF (I.LE.NCHAN) THEN
               DO J=I,NCHAN
                  SELECTED_CHANNEL(J) = 0
               ENDDO
            ENDIF
         ELSE
            DO J=1,NCHAN
               SELECTED_CHANNEL(J) = J
            ENDDO
         ENDIF
* Flags subscans
         CALL R4TOR4(MEMORY(IP_SCANLIST),SELECTED_SUBSCAN,1)
         J = 1
         DO WHILE (SELECTED_SUBSCAN.NE.0)
            I = 1
            DO WHILE (SELECTED_CHANNEL(I).NE.0.AND.I.LE.NCHAN)
               ICHAN = SELECTED_CHANNEL(I)
               CALL FLAG_SUBSCAN(SELECTED_SUBSCAN,
     $         MEMORY(IPSUBREC),
     $         MEMORY(IP_SIGNAL+(ICHAN-1)*NRECORD),BLANKING,
     $         MEMORY(IP_SUBFLAG),SUBSCAN_RESET,IER,ICHAN)
               I = I+1
               IF (IER.NE.1) THEN
                  CALL MESSAGE (2,1,'FLAG','Memory allocation failure')
                  RETURN
               ENDIF
            ENDDO
            J = J+1
            CALL R4TOR4(MEMORY(IP_SCANLIST+J-1),SELECTED_SUBSCAN,1)
         ENDDO
         CALL FREE_VM(NSUBSCAN,IADDR)
      ENDIF
      RETURN
99    ERROR = .TRUE.
      RETURN
      END
*
********************************************************************
*
      SUBROUTINE FLAG_SUBSCAN(ISUBSCAN,NSUBREC,SIGNAL,BLANKING,
     $IADDR_FLAG,SUBSCAN_RESET,IER,ICHAN)
*
      INCLUDE 'nic.inc'
*
      INTEGER ISUBSCAN,NSUBREC(1),IER,ICHAN,J
      REAL    SIGNAL(1),BLANKING
      INTEGER*4 IADDR_FLAG(1)
      LOGICAL SUBSCAN_RESET
*
      INTEGER*4 IADDR,POINTER,IP
      INTEGER ISIG,ISUB,NP,I
      INTEGER SIC_GETVM
*
      ISIG = 0
      DO ISUB=1,ISUBSCAN-1
         ISIG = ISIG+NSUBREC(ISUB)
      ENDDO
      NP = NSUBREC(ISUBSCAN)
*
      J = ISUBSCAN + (ICHAN-1)*NSUBSCAN
*
      IF (.NOT.SUBSCAN_RESET) THEN
         IF (IADDR_FLAG(J).EQ.0) THEN
            IER=SIC_GETVM(NP,IADDR)
            IF (IER.NE.1) RETURN
            IP = POINTER(IADDR,MEMORY)
            CALL R4TOR4(SIGNAL(ISIG+1),MEMORY(IP),NP)
            DO I=1,NP
               SIGNAL(ISIG+I)= BLANKING
            ENDDO
            IADDR_FLAG(J) = IADDR
         ENDIF
      ELSE
         IF (IADDR_FLAG(J).NE.0) THEN
            IADDR = IADDR_FLAG(J)
            IP = POINTER(IADDR,MEMORY)
            CALL R4TOR4(MEMORY(IP),SIGNAL(ISIG+1),NP)
            IADDR_FLAG(J)=0
            CALL FREE_VM(NP,IADDR)
         ENDIF
      ENDIF
      END
*
********************************************************************
*
      SUBROUTINE SHOW_SUBSCAN_FLAG(IADDR_FLAG)
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INTEGER*4 IADDR_FLAG(1)
      INTEGER  I,K
*
* Find if any flagged subscans
      I = 1
      DO WHILE (IADDR_FLAG(I).EQ.0 .AND. I.LE.NCHAN*NSUBSCAN)
         I = I+1
      ENDDO
      IF (I.EQ.NCHAN*NSUBSCAN+1) THEN
         CALL MESSAGE (2,1,'FLAG','No flagged subscans')
         RETURN
      ENDIF
*
* Look for flagged channels
      WRITE (6,'('' Flagged subscans(s): '')')
      DO I=1,NCHAN
         K = (I-1)*NSUBSCAN+1
         DO WHILE (IADDR_FLAG(K).EQ.0 .AND. K.LE.I*NSUBSCAN)
            K = K+1
         ENDDO
         IF (K.LE.I*NSUBSCAN) THEN       ! flags found
            WRITE (6,'('' channel '',i2,'':'',$)') I
            DO K=(I-1)*NSUBSCAN+1,I*NSUBSCAN
               IF (IADDR_FLAG(K).NE.0)
     $         WRITE (6,'(i3,$)') K-(I-1)*NSUBSCAN
            ENDDO
            WRITE (6,'(1x)')
         ENDIF
      ENDDO
      END
********************************************************************
*
      SUBROUTINE FREE_SUBSCAN_MEMORY(NSUBREC,IADDR_FLAG)
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
*
      INTEGER*4 IADDR_FLAG(1)
      INTEGER         NSUBREC(1)
*
      INTEGER*4 IADDR
      INTEGER NP
      INTEGER ICHAN,ISUBSCAN,J
*
      DO ICHAN=1,NCHAN
         DO ISUBSCAN=1,NSUBSCAN
            J = ISUBSCAN+(ICHAN-1)*NSUBSCAN
            IF (IADDR_FLAG(J).NE.0) THEN
               IADDR = IADDR_FLAG(J)
               NP = NSUBREC(ISUBSCAN)
               CALL FREE_VM(NP,IADDR)
               IADDR_FLAG(J)=0
            ENDIF
         ENDDO
      ENDDO
      END
