* Last processed by NICE on 12-Jun-2000 15:54:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
      SUBROUTINE POWER(LINE,ERROR)
      CHARACTER*(*) LINE
*
      INCLUDE 'nic.inc'
      INCLUDE 'par.inc'
*
      INTEGER*4 IP_BASE, SIC_GETVM, IADDR, POINTER
      INTEGER THIS_SCAN, FIRST_SCAN, LAST_SCAN, DUMMY
      INTEGER NFILE, LENC, IER, I, J, DIM(2), OFFSET1, OFFSET2
      INTEGER MEGA, SCAN_COUNTER, SCAN_RECORD(21), CALPOW_FOUND
      LOGICAL SIC_PRESENT, ERROR, YES, POWER_FOUND, FOUND, SIC_CTRLC
      LOGICAL DATA_TYPE,FITS_FILE
      CHARACTER SCAN_TEXT*14,FILENAME*80
      DATA POWER_FOUND /.FALSE./
      SAVE POWER_FOUND, DIM
      CALPOW_FOUND = 0
      IF (POWER_FOUND) THEN
         CALL FREE_VM (DIM(1)*DIM(2),IADDRPOWER)
         CALL SIC_DELVARIABLE('TOTPOW',.FALSE.,ERROR)
         POWER_FOUND = .FALSE.
      ENDIF
*
* Option /SCAN
*
      THIS_SCAN = SCAN_NUMBER            ! default is only one scan
      FIRST_SCAN = THIS_SCAN
      LAST_SCAN = THIS_SCAN
      IF (SIC_PRESENT(1,1)) THEN
         CALL SIC_I4 (LINE,1,1,FIRST_SCAN,.TRUE.,ERROR)
         IF (ERROR) RETURN
         FIRST_SCAN = ABS(FIRST_SCAN)
         LAST_SCAN = FIRST_SCAN
         IF (SIC_PRESENT(1,2)) THEN
            CALL SIC_I4 (LINE,1,2,LAST_SCAN,.TRUE.,ERROR)
            IF (ERROR) RETURN
         ENDIF
         LAST_SCAN = ABS(LAST_SCAN)
      ENDIF
      IF (SCAN_NUMBER.LE.0.AND.FIRST_SCAN.EQ.SCAN_NUMBER) THEN
         CALL MESSAGE (2,1,'POWER','Use /SCAN option...')
         ERROR = .TRUE.
         RETURN
      ENDIF
      IF (FIRST_SCAN.GT.LAST_SCAN) THEN
         DUMMY = FIRST_SCAN
         FIRST_SCAN = LAST_SCAN
         LAST_SCAN = DUMMY
      ENDIF
      IF (FIRST_SCAN.GT.9999.OR.LAST_SCAN.GT.9999) THEN
         CALL MESSAGE(2,1,'POWER','Illegal scan number')
         ERROR = .TRUE.
         RETURN
      ENDIF
*
      MEGA = 262144
      IER = SIC_GETVM (MEGA,IADDR)
      IF (IER.NE.1) THEN
         CALL MESSAGE (2,1,'POWER',' *** Unable to allocate memory ***')
         ERROR = .TRUE.
         RETURN
      ENDIF
      IP_BASE = POINTER(IADDR,MEMORY)
      SCAN_TEXT = 'BOLO_DATA:0000'
      CALL SIC_PARSEF(SCAN_TEXT,FILENAME,' ',DEFEXT)
      NFILE = LENC(FILENAME)
      SCAN_COUNTER = 0
      DO I = FIRST_SCAN,LAST_SCAN
         FOUND = SIC_CTRLC ()
         WRITE (FILENAME(NFILE-7:NFILE-4),'(I4.4)') I
         FILENAME(NFILE+1:NFILE+1) = CHAR(0)
         INQUIRE (FILE=FILENAME,EXIST=YES)
         FITS_FILE = .FALSE.
         IF (.NOT.YES) THEN
            FITS_FILE = .TRUE.
            FILENAME(NFILE-2:NFILE+1) ='fits'
            FILENAME(NFILE+2:NFILE+2) = CHAR(0)
            NFILE = NFILE+1
            INQUIRE (FILE=FILENAME,EXIST=YES)
         ENDIF
         IF (YES) THEN
            DATA_TYPE = .FALSE.
            IF (.NOT.FITS_FILE) THEN
               CALL INPUT_NMB(FILENAME,NFILE,ERROR,DATA_TYPE)
            ELSE
               CALL INPUT_FITS(FILENAME,NFILE,ERROR,DATA_TYPE)
            ENDIF
            IF (NCALPOW.GE.1) THEN
               CALPOW_FOUND = NCALPOW
               CALL R4TOR4 (MEMORY(IP_UT),
     $         MEMORY(IP_BASE),NRECORD)
               CALL R4TOR4 (MEMORY(IP_EL),
     $         MEMORY(IP_BASE+NRECORD),NRECORD)
               CALL R4TOR4 (MEMORY(IP_CALPOW),MEMORY(IP_BASE+2*NRECORD),
     $         NCALPOW*NRECORD)
               IP_BASE = IP_BASE+(2+NCALPOW)*NRECORD
               IF (SCAN_COUNTER.LT.20) THEN
                  SCAN_COUNTER = SCAN_COUNTER+1
                  SCAN_RECORD(SCAN_COUNTER) = NRECORD
               ELSE
                  CALL FREE_VM (MEGA,IADDR)
                  CALL MESSAGE(2,1,'POWER',
     $            'Please select a maximum of 20 scans')
                  ERROR = .TRUE.
                  RETURN
               ENDIF
            ENDIF
         ENDIF
         IF (FOUND) GOTO 100
      ENDDO
      SCAN_RECORD(SCAN_COUNTER+1) = 0
100   DIM(2) = CALPOW_FOUND+2
      IF (CALPOW_FOUND.NE.0) THEN
         DIM(1) = (IP_BASE-POINTER(IADDR,MEMORY))/DIM(2)
         IP_BASE = POINTER(IADDR,MEMORY)
         IF (DIM(1).NE.0) THEN
            IER = SIC_GETVM (DIM(1)*DIM(2),IADDRPOWER)
            IF (IER.NE.1) THEN
               CALL MESSAGE (2,1,'POWER',
     $         ' *** Unable to allocate memory ***')
               ERROR = .TRUE.
               RETURN
            ENDIF
            IP_POWER = POINTER(IADDRPOWER,MEMORY)
            OFFSET1 = 0
            OFFSET2 = 0
            DO J = 1,DIM(2)
               DO I = 1,SCAN_COUNTER
                  CALL R4TOR4 (MEMORY(IP_BASE+OFFSET1),
     $            MEMORY(IP_POWER+OFFSET2),SCAN_RECORD(I))
                  OFFSET1 = SCAN_RECORD(I)*(DIM(2)-(J-1))+
     $            SCAN_RECORD(I+1)*(J-1)+OFFSET1
                  OFFSET2 = OFFSET2+SCAN_RECORD(I)
               ENDDO
               OFFSET1 = SCAN_RECORD(1)*J
            ENDDO
            CALL FREE_VM (MEGA,IADDR)
            CALL SIC_DEF_REAL ('TOTPOW',MEMORY(IP_POWER),2,DIM,
     $      .TRUE.,ERROR)
            POWER_FOUND = .TRUE.
         ENDIF
      ENDIF
      RETURN
      END
