* Last processed by NICE on 12-Jun-2000 15:53:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
      SUBROUTINE HEADER (LINE,ERROR)
C ----------------------------------------------------------------------
C 	Support routine for command
C	HEADER 	no input parameter required
C
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'
      INCLUDE 'const.inc'
*
* Local
*
      CHARACTER SOURCE_LINE*80,ARGUM2*3
      CHARACTER MODE(9)*12,MONTH(12)*3,BASIS(3)*6
      INTEGER*4 LENC,LEN_S,LEN_M,I,ISYS,OFF,NC,IER,LUN
      INTEGER*4 SL1,SL2,SB1,SB2,SL3,SB3,SL4,SB4,SIC_OPEN
      CHARACTER*40 SOURCE_NAME_BL,C*1,D*1,MINUS*1
      CHARACTER*80 FILENAME,INPUT_LINE
      LOGICAL FILE_OPT,SIC_PRESENT,APPEND_OPT
      DATA MONTH /'JAN','FEB','MAR','APR','MAY','JUN',
     $'JUL','AUG','SEP','OCT','NOV','DEC'/
      DATA MODE/'ON-OFF','ON-THE-FLY','SKYDIP','POINTING',
     $'FOCUS','UNKNOWN','ON-OFF [Sym]','SKYPAD','RASTERDIP'/
      DATA BASIS /'(Equ)','(Gal)','(Ecl)'/
      DATA MINUS /'-'/
      DATA C /':'/
      DATA D /'.'/
*
* Verify this is possible now
*
      IF (NRECORD.EQ.0) THEN
         CALL MESSAGE(2,1,'HEADER','No input file opened')
         RETURN
      ENDIF
*
* Option /FILE
*
      LUN = 6
      FILE_OPT = .FALSE.
      IF (SIC_PRESENT(1,1)) THEN
         CALL SIC_CH(LINE,1,1,FILENAME,NC,.TRUE.,ERROR)
         IF (ERROR) RETURN
!DB:03-99 CALL SIC_LOWER(FILENAME)
         FILE_OPT = .TRUE.
         APPEND_OPT = .TRUE.
         IF (SIC_PRESENT(1,2)) THEN
            CALL SIC_KE(LINE,1,2,ARGUM2,NC,.FALSE.,ERROR)
            IF (ARGUM2.EQ.'NEW') APPEND_OPT = .FALSE.
         ENDIF
         IF (APPEND_OPT) THEN
            IER = SIC_OPEN(2,FILENAME,'OLD',.FALSE.)
            IF (IER.NE.0) IER = SIC_OPEN(2,FILENAME,'NEW',.FALSE.)
80          READ (2,'(A)',END=90,ERR=90) INPUT_LINE
            GOTO 80
         ELSE
85          IER = SIC_OPEN(2,FILENAME,'NEW',.FALSE.)
         ENDIF
90       IF (IER.NE.0) THEN
            CALL MESSAGE (2,1,'FIND','Not able to create file')
            RETURN
         ENDIF
         LUN = 2
      ENDIF
*
* Parse source name
*
      SOURCE_NAME_BL = SOURCE_NAME
      I=LENC(SOURCE_NAME)
      LEN_S = 0
      DO WHILE (LEN_S.EQ.0.AND.I.GT.0)
         IF (SOURCE_NAME(I:I).GT.' ') LEN_S = I
         I = I-1
      ENDDO
      DO I=1,LEN_S
         SOURCE_NAME_BL(I:I)= SOURCE_NAME(I:I)
         IF (SOURCE_NAME_BL(I:I).EQ.'_') SOURCE_NAME_BL(I:I)=' '
      ENDDO
*
* Parse observing mode
*
      OFF = 0
      IF (ONOFF_MODE.EQ.1) OFF = 6
      LEN_M = LENC(MODE(SCAN_TYPE+OFF))
      IF (SCAN_TYPE.NE.3) THEN
         SOURCE_LINE = '(10H Source : ,A00,00X,18H Observing Ty'//
     $   'pe : ,A00,00X,7HScan : ,I4)'
         WRITE (SOURCE_LINE(17:18),'(i2.2)') MIN(LEN_S,19)
         WRITE (SOURCE_LINE(20:21),'(i2.2)') 20-MIN(LEN_S,19)
         WRITE (SOURCE_LINE(47:48),'(i2.2)') LEN_M
         WRITE (SOURCE_LINE(50:51),'(i2.2)') 13-LEN_M
         WRITE (LUN,SOURCE_LINE) SOURCE_NAME_BL(1:MIN(LEN_S,19)),
     $   MODE(SCAN_TYPE+OFF), SCAN_NUMBER
      ELSE
         SOURCE_LINE = '(30X,18H Observing Mo'//
     $   'de : ,A00,00X,7HScan : ,I4)'
         WRITE (SOURCE_LINE(29:30),'(i2.2)') LEN_M
         WRITE (SOURCE_LINE(32:33),'(i2.2)') 13-LEN_M
         WRITE (LUN,SOURCE_LINE) MODE(SCAN_TYPE), SCAN_NUMBER
      ENDIF
      ISYS = 1                           ! assume Equatorial
      IF (COORDINATE_SYSTEM.LE.4.OR.
     $(COORDINATE_SYSTEM.GE.6.AND.COORDINATE_SYSTEM.LE.9)) THEN
         IF (COORDINATE_SYSTEM.EQ.0)  ISYS = 2
         IF (COORDINATE_SYSTEM.GE.6)  ISYS = 3
         CALL POSITION (SL1,SL2,SL3,SL4,SB1,SB2,SB3,SB4)
         WRITE (LUN,100)
     $   ' Lambda : ',SL1,C,SL2,C,SL3,D,SL4,BASIS(ISYS),
     $   ' Beta : ',SB1,C,SB2,C,SB3,D,SB4,' Epoch : ',EPOCH
100      FORMAT(A,2(I2.2,A),I2.2,A,I3.3,1X,A,1X,A,
     $   I3.2,2(A,I2.2),A,I2.2,10X,A,F8.3)
      ENDIF
      IF (COORDINATE_SYSTEM.EQ.10) THEN  ! Azimuth system
         WRITE (LUN,'('' Azimuth : '',f10.6,a,31x,'' Epoch : '',f8.3)')
     $   SOURCE_LAMBDA,' degrees',EPOCH
      ENDIF
* Wobbler section
      IF (WOBBLER_THROW.NE.0.AND.WOBBLER_THROW.NE.-999) THEN
         WRITE (LUN,'(A,f5.1,A,A,F4.2,A,$)') ' Wobbler-throw : ',
     $   WOBBLER_THROW,' arcsec ',' Wobbler Period : ',
     $   WOBBLER_PERIOD,' sec'
         IF (NINT(REFERENCE_GAIN).NE.0) THEN
            WRITE (LUN,'(4x,'' Gain : '',i2)') NINT(REFERENCE_GAIN)
         ELSE
            WRITE (LUN,'(1x)')
         ENDIF
      ENDIF
      IF (REFERENCE_GAIN.NE.0.AND.WOBBLER_THROW.EQ.0)
     $WRITE (LUN,'(60x,'' Gain : '',i2)') NINT(REFERENCE_GAIN)
*
      WRITE (LUN,'(A,I3,A,I5,$)') ' No Subscan/Records: ',
     $NSUBSCAN,'/' ,NRECORD
      IF (VAZM.NE.0) THEN
         WRITE (LUN,'(A,F5.1,A$)') ' Drift velocity : ',VAZM*60,' "/sec'
         IF (SINT.NE.0) THEN
            WRITE (LUN,'(A,f4.1,A)') '  Sint : ',SINT,' "'
         ELSE
            WRITE (LUN,'(1x)')
         ENDIF
      ELSE
         WRITE (LUN,'(1x)')
      ENDIF
*
      IF (SCAN_TYPE.NE.2) THEN
         WRITE (LUN,'(a,i2.2,a,a3,a,i4.4,2a)') ' Date : ',
     $   IDAY,MINUS,MONTH(IMONTH),MINUS,
     $   IYEAR,'            Project: ',PROJECT_NAME
      ELSE
         IF (ABS(SKEW).GT.0.05) THEN
            WRITE (LUN,'(a,i2.2,a,a3,a,i4.4,2(a,i4),2a,f5.1,a)')
     $      ' Date : ',
     $      IDAY,MINUS,MONTH(IMONTH),MINUS,
     $      IYEAR,'            Field size: ',
     $      NINT(DAZM*3600),'" x', NINT(ABS(2*OELV*3600)),'"',
     $      '      Skew : ',SKEW,'"'
            WRITE (LUN,'(2a)')' Project: ',PROJECT_NAME
         ELSE
            WRITE (LUN,'(a,i2.2,a,a3,a,i4.4,a,i4,a,i4,2a)')
     $      ' Date : ',
     $      IDAY,MINUS,MONTH(IMONTH),MINUS,
     $      IYEAR,'            Field size: ',
     $      NINT(DAZM*3600),'" x', NINT(ABS(2*OELV*3600)),'"',
     $      '      Skew : None'
            WRITE (LUN,'(2a)')' Project: ',PROJECT_NAME
         ENDIF
      ENDIF
      IF (FILE_OPT) THEN
         WRITE (2,'(1x)')
         CLOSE(UNIT=2)
      ENDIF
      RETURN
      END
*
      SUBROUTINE ANY_SKEW (SUBRECORDS,SCAN_COORD,NUMBER)
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'const.inc'
      INTEGER NUMBER, SUBRECORDS(NUMBER), NUM, I
      REAL    AZ(200), MEAN, MEANSQX, CROSSXY
      REAL    SCAN_COORD(1)
*
      SKEW=0
      IF (NUMBER.GT.200) THEN
         CALL MESSAGE (2,1,'HEADER','Number of subscans exceeded')
         RETURN
      ENDIF
      IF (NUMBER.EQ.1) RETURN
      AZ(1) = SCAN_COORD(1)
      MEAN = AZ(1)
      NUM = SUBRECORDS(1)
      DO I=2,NUMBER,2
         NUM = NUM+SUBRECORDS(I)
         AZ(I) = SCAN_COORD(NUM)
         MEAN = MEAN+AZ(I)
         IF (I.LT.NUMBER) THEN
            AZ(I+1) = SCAN_COORD(NUM+1)
            NUM = NUM+SUBRECORDS(I+1)
            MEAN = MEAN+AZ(I+1)
         ENDIF
      ENDDO
      MEAN = MEAN/NUMBER
      MEANSQX = 0
      CROSSXY = 0
      DO I=1,NUMBER
         MEANSQX = MEANSQX+(I-(NUMBER+1)/2.)**2
         CROSSXY = CROSSXY+(I-(NUMBER+1)/2.)*(AZ(I)-MEAN)
      ENDDO
*
* Fit a straight line
*
      SKEW = NINT(NUMBER*CROSSXY/(NUMBER*MEANSQX))/10.
      RETURN
      END
*
      SUBROUTINE POSITION (SL1,SL2,SL3,SL4,SB1,SB2,SB3,SB4)
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'const.inc'
*
      INTEGER SL1, SL2, SL3, SL4, SB1, SB2, SB3, SB4, ISIGN
*
      SL1 = INT(SOURCE_LAMBDA/15)
      SL2 = INT((SOURCE_LAMBDA/15-SL1)*60)
      SL3 = INT(((SOURCE_LAMBDA/15-SL1)*60-SL2)*60)
      SL4 = INT((((SOURCE_LAMBDA/15-SL1)*60-SL2)*60-SL3)*1000)
      ISIGN = 1
      IF (ABS(SOURCE_BETA).GT.1.D-10) THEN
         ISIGN = SOURCE_BETA/ABS(SOURCE_BETA)
      ENDIF
      SB1 = INT(ABS(SOURCE_BETA))
      SB2 = INT((ABS(SOURCE_BETA)-SB1)*60)
      SB3 = INT(((ABS(SOURCE_BETA)-SB1)*60-SB2)*60)
      SB4 = INT((((ABS(SOURCE_BETA)-SB1)*60-SB2)*60-SB3)*100)
      SB1 = SB1*ISIGN
      RETURN
      END
