CFPRIME SPECT1                                                          SPECT1      1
C***********************************************************************RIGHTE      1
C*                                                                     *RIGHTE      2
C*               Output Analysis Program for ETMSP (OAP)               *RIGHTE      4
C*               =======================================               *RIGHTE      5
C*                                                                     *RIGHTE     11
C*        copyright @(1993) Electric Power Research Institute          *RIGHTE     12
C*                                                                     *RIGHTE     13
C* EPRI reserves all rights in the software and associated             *RIGHTE     14
C* documentation as delivered. The software and its associated         *RIGHTE     15
C* documention or any portion thereof may not be reproduced in any form*RIGHTE     16
C* whatsoever without the consent of EPRI, except as explicity provided*RIGHTE     17
C* for by license. Licensee shall submit a detailed description to EPRI*RIGHTE     18
C* of any changes or modifications to the software within two (2)      *RIGHTE     19
C* months after such changes or modifications are made. At EPRI's sole *RIGHTE     20
C* discretion, the software, as changed or modified, shall be given a  *RIGHTE     21
C* new designation sufficiently different from its then current        *RIGHTE     22
C* designation as to prevent mistake,confusion, or deception as between*RIGHTE     23
C* the current software as changed or modified.                        *RIGHTE     24
C*                                                                     *RIGHTE     25
C* A license under EPRI's rights in the software can be obtained       *RIGHTE     26
C* directly from EPRI.                                                 *RIGHTE     27
C*                                                                     *RIGHTE     28
C* This program and supporting materials may be independently available*RIGHTE     29
C* from Electric Power Software centre (EPSC) for an appropriate       *RIGHTE     30
C* distribution fee. The EPSC is a service of                          *RIGHTE     31
C*                                                                     *RIGHTE     32
C*                    Power Computing Company                          *RIGHTE     33
C*                    1930 Hi Line                                     *RIGHTE     34
C*                    Dallas, Tx 75207                                 *RIGHTE     35
C*                                                                     *RIGHTE     36
C* NEITHER EPRI, ANY MEMBER OF EPRI, NOR ANY PERSON OR  ORGANIZATION   *RIGHTE     37
C* ACTING ON BEHAVE OF THEM:                                           *RIGHTE     38
C*                                                                     *RIGHTE     39
C* 1. MAKE ANY WARRANTY OR REPRESENTATION WHATSOEVER, EXPRESS OR       *RIGHTE     40
C*    IMPLIED, INCLUDING ANY WARRANTY OF MERCHANTABILITY OR FITNESS OR *RIGHTE     41
C*    ANY PURPOSE WITH RESPECT TO THE SOFTWARE OR ITS ASSOCIATED       *RIGHTE     42
C*    DOCUMENTATION; OR                                                *RIGHTE     43
C*                                                                     *RIGHTE     44
C* 2. ASSUMES ANY LIABILITY WHATSOEVER WITH RESPECT TO ANY USE OF THE  *RIGHTE     45
C*    SOFTWARE OR ITS ASSOCIATED DOCUMENTATION OR ANY PORTION THEREOF  *RIGHTE     46
C*    OR WITH RESPECT TO ANY DAMAGES WHICH MAY RESULT FROM SUCH USE.   *RIGHTE     47
C*                                                                     *RIGHTE     48
C* THIS NOTICE MAY NOT BE REMOVED FROM THE SOFTWARE BY ANY USER        *RIGHTE     49
C* THEREOF.                                                            *RIGHTE     50
C*                                                                     *RIGHTE     51
C***********************************************************************RIGHTE     52
      SUBROUTINE SPECT1(XA,YA,NOGO)                                     SPECT1      3
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCSPECT1      4
CD                                                                      SPECT1      5
CD            This routine is the Interface routine for all other       SPECT1      6
CD            routines for spectrum analysis. It performs the necessary SPECT1      7
CD            calculations and return the plotting values in the XA()   SPECT1      8
CD            and the YA() arrays.                                      SPECT1      9
CD                                                                      SPECT1     10
CD            CALLING PARAMETERS :                                      SPECT1     11
CD                                                                      SPECT1     12
CD                       XA() - time axis array as read from            SPECT1     13
CD                              the channel file.                       SPECT1     14
CD                      YA(,) - Y-axix array as read from the           SPECT1     15
CD                              channel file, Each column corresponds   SPECT1     16
CD                              to a channel.                           SPECT1     17
CD                      NOGO  = STATUS FLAG                             SPECT1     18
CD                              NOGO = 0  : CONTINUE ANALYSIS PROCESS   SPECT1     19
CD                              NOGO = -1 : ABORT ANALYSI PROCESS       SPECT1     20
CD                                                                      SPECT1     21
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCSPECT1     22
      PARAMETER (NTAIL=1024)                                            SPECT1     23
      PARAMETER (NSTEP=100)                                             SPECT1     24
      REAL*8 XSIG(0:NTAIL-1),SHAT(0:NTAIL-1)                            SPECT1     25
      DIMENSION FREQ(NSTEP+2),RESP(NSTEP+2),ANGLE(NSTEP+2)              SPECT1     26
                                                                        SPECT1     27
      INCLUDE 'PARAM.INS'                                               SPECT1     28
      INCLUDE 'DBFLG.INS'                                               SPECT1     29
      INCLUDE 'SOAPC1.INS'                                              SPECT1     30
      INCLUDE 'XYARAY.INS'                                              SPECT1     31
      INCLUDE 'CHDISP.INS'                                              SPECT1     32
      DIMENSION XA(MXPT,MXPLOT),YA(MXPT,MXPLOT)                         SPECT1     33
      CHARACTER*80 STRING,MSG                                           SPECT1     34
      CHARACTER*1 CH                                                    SPECT1     35
      CHARACTER*8 CTIME                                                 SPECT1     36
      CHARACTER*9 VDATE                                                 SPECT1     37
C                                                                       SPECT1     38
      LU15=35                                                           SPECT1     39
      LDEBUG=DEBUG(13)                                                  SPECT1     40
      MM=MAXPT(1)                                                       SPECT1     41
C    ...................................................                SPECT1     42
C    : Check that the arrays get passed over correctly :                SPECT1     43
      IF(LDEBUG) THEN                                                   SPECT1     44
         WRITE(IDBOUT,5000)MM                                           SPECT1     45
         DO 100 I=1,MM                                                  SPECT1     46
            WRITE(IDBOUT,5010)I,(XA(I,I1),YA(I,I1),I1=1,KCH(1))         SPECT1     47
 100     CONTINUE                                                       SPECT1     48
      ENDIF                                                             SPECT1     49
C    :..................................................:               SPECT1     50
                                                                        SPECT1     51
C    ...........................................                        SPECT1     52
C    :Get output file name to save results     :                        SPECT1     53
 95   CONTINUE                                                          SPECT1     54
      MSG='Enter Output File Name'                                      SPECT1     55
      CALL PMTRED(LOUT,LIN,JERR,22,MSG,'SP4',STRING)                    SPECT1     56
      IF((JERR.LT.0).OR.(STRING(1:4).EQ.'QUIT').OR.                     SPECT1     57
     1   (STRING(1:5).EQ.'ABORT') ) THEN                                SPECT1     58
          WRITE(LOUT,1003)                                              SPECT1     59
          NOGO=-1                                                       SPECT1     60
          GOTO 9999                                                     SPECT1     61
      ENDIF                                                             SPECT1     62
 1003 FORMAT(//,1X,'+++ PRONY ABORTED +++',//)                          SPECT1     63
      LENFIL=LENS(STRING)                                               SPECT1     64
      IF(LENFIL.LE.0) THEN                                              SPECT1     65
          NOGO=-1                                                       SPECT1     66
          GOTO 95                                                       SPECT1     67
      ENDIF                                                             SPECT1     68
      IF(RECORD) WRITE(IREC,'(A)') STRING                               SPECT1     69
C   ..................................................                  SPECT1     70
C   : Parse parameter for a logical unit number      :                  SPECT1     71
      CALL PARSIU(STRING,LENFIL,IU,LO)                                  SPECT1     72
      IF(IU.GT.0)THEN                                                   SPECT1     73
         LU15=IU                                                        SPECT1     74
         LENFIL=LO                                                      SPECT1     75
      ENDIF                                                             SPECT1     76
C   :................................................:                  SPECT1     77
      CALL OPENFI(LU15,STRING,LENFIL,IERR,'UNKNOWN',1)                  SPECT1     78
      IF(IERR.LT.0) THEN                                                SPECT1     79
          WRITE(LOUT,1005)                                              SPECT1     80
          GOTO 95                                                       SPECT1     81
 1005     FORMAT(//,1X,'** File Open ERROR **',//)                      SPECT1     82
      ENDIF                                                             SPECT1     83
      CALL YYMMDD(VDATE)                                                SPECT1     84
      WRITE(LU15,2000)VDATE,YTITLE(1),LTITLE(1),CTITLE(1)               SPECT1     85
 2000 FORMAT(/,10X,'PRONY Analysis Detail Record File.  Date : ',A9,/,  SPECT1     86
     1       /,10X,'Signal type : ',A50,                                SPECT1     87
     1       /,10X,'Description : ',A32,                                SPECT1     88
     1       /,10X,'File Name   : ',A,/)                                SPECT1     89
C    :.........................................:                        SPECT1     90
                                                                        SPECT1     91
      WRITE(LOUT,2010)LU15,MM                                           SPECT1     92
 2010 FORMAT(//,10X,'...........................................',/,    SPECT1     93
     1          10X,'.     PRONY SIGNAL ANALYSIS FUNCTION      .',/,    SPECT1     94
     1          10X,'.     (FORTRAN LOGICAL UNIT = ',I2,')',     /,     SPECT1     95
     1          10X,'.                                         .',/,    SPECT1     96
     1          10X,'.     NO. OF DATA POINTS = ',I5,'         .',/,    SPECT1     97
     1          10X,'...........................................',//)   SPECT1     98
                                                                        SPECT1     99
                                                                        SPECT1    100
C    .........................................................          SPECT1    101
C    :Establish starting and ending time for trend analysis  :          SPECT1    102
C    :                                                       :          SPECT1    103
 70   CONTINUE                                                          SPECT1    104
      NPOINT=0                                                          SPECT1    105
      DELTA1=0.0                                                        SPECT1    106
      DELTA2=0.0                                                        SPECT1    107
      WRITE(LOUT,2012)XA(1,1),XA(MM,1)                                  SPECT1    108
                                                                        SPECT1    109
 2012 FORMAT(//,                                                        SPECT1    110
     1 10X,'......................................................',/,  SPECT1    111
     1 10X,'. The PRONY analysis can be calculated based on any  .',/,  SPECT1    112
     1 10X,'. time period of interest. As read from channel file .',/,  SPECT1    113
     1 10X,'.                                                    .',/,  SPECT1    114
     1 10X,'.          DATA Starting time = ',F10.3, '           .',/,  SPECT1    115
     1 10X,'.          DATA Ending time   = ',F10.3, '           .',/,  SPECT1    116
     1 10X,'.                                                    .',/,  SPECT1    117
     1 10X,'.         Please specify the time period.            .',/,  SPECT1    118
     1 10X,'.                                                    .',/,  SPECT1    119
     1 10X,'......................................................',//) SPECT1    120
                                                                        SPECT1    121
      MSG='Enter START time, END time (M)in,max'                        SPECT1    122
      CALL PMTRED(LOUT,LIN,JERR,ISLEN(MSG),MSG,'SP1',STRING)            SPECT1    123
      IF(RECORD) WRITE(IREC,'(A)') STRING                               SPECT1    124
      IF(STRING(1:1).EQ.'Q'.OR.STRING(1:1).EQ.'q')THEN                  SPECT1    125
         NOGO=-1                                                        SPECT1    126
         WRITE(LOUT,'(//,10X,A,//)')'* ABORT FUNCTION SPECTRUM *'       SPECT1    127
         GOTO 9999                                                      SPECT1    128
      ENDIF                                                             SPECT1    129
      IF(STRING(1:1).EQ.'M'.OR.STRING(1:1).EQ.'m')THEN                  SPECT1    130
        XAS=XA(1,1)                                                     SPECT1    131
        XAE=XA(MAXPT(1),1)                                              SPECT1    132
      ELSE                                                              SPECT1    133
        READ(STRING,*,IOSTAT=IOS)XAS,XAE                                SPECT1    134
        IF(IOS.NE.0) GOTO 70                                            SPECT1    135
      ENDIF                                                             SPECT1    136
      IF((XAS.GE.XAE).OR.(XAE.EQ.0.0)) THEN                             SPECT1    137
         WRITE(LOUT,'(//,1X,A,/)')'*ERROR.. (START > END) TRY AGAIN '   SPECT1    138
         GOTO 70                                                        SPECT1    139
      ENDIF                                                             SPECT1    140
                                                                        SPECT1    141
      DO 80 I=1,MM                                                      SPECT1    142
         IF(XA(I,1).GE.XAS)THEN                                         SPECT1    143
            IXAS=I                                                      SPECT1    144
            GOTO 85                                                     SPECT1    145
         ENDIF                                                          SPECT1    146
 80   CONTINUE                                                          SPECT1    147
      WRITE(LOUT,'(//,1X,A,/)')'*OUT OF RANGE. TRY AGAIN '              SPECT1    148
      GOTO 70                                                           SPECT1    149
                                                                        SPECT1    150
 85   CONTINUE                                                          SPECT1    151
      DO 87 I=IXAS,MM                                                   SPECT1    152
         IF(XA(I,1).GE.XAE)THEN                                         SPECT1    153
            IXAE=I                                                      SPECT1    154
            GOTO 88                                                     SPECT1    155
         ENDIF                                                          SPECT1    156
 87   CONTINUE                                                          SPECT1    157
c      WRITE(LOUT,'(//,1X,A,/)')'*OUT OF RANGE.. TRY AGAIN '            SPECT1    158
c      GOTO 70                                                          SPECT1    159
      WRITE(LOUT,'(//,A,/)')                                            SPECT1    160
     *   ' *** WARNING OUT OF RANGE, THE END POINT IS RESETED'//        SPECT1    161
     *   ' BY THE PROGRAM'                                              SPECT1    162
      IXAE=MM-1                                                         SPECT1    163
                                                                        SPECT1    164
 88   CONTINUE                                                          SPECT1    165
C    :...........................................................:      SPECT1    166
                                                                        SPECT1    167
                                                                        SPECT1    168
                                                                        SPECT1    169
C    ...........................................                        SPECT1    170
C    :check number of points and time interval :                        SPECT1    171
      NPOINT=IXAE-IXAS+1                                                SPECT1    172
      DELTA1=XA(IXAS+1,1)-XA(IXAS,1)                                    SPECT1    173
      DO 90 I=IXAS,IXAE                                                 SPECT1    174
         DELTA2=XA(I+1,1)-XA(I,1)                                       SPECT1    175
C        TYPE *, DELTA1,DELTA2,I,XA(I,1)                                SPECT1    176
         IF(ABS(DELTA2-DELTA1).GT..0001)THEN                            SPECT1    177
           WRITE(LOUT,5020)DELTA1,XA(I,1),XA(I+1,1),DELTA2              SPECT1    178
 5020      FORMAT(//,10X,'** WARNING : Unequal time interval ',//,      SPECT1    179
     1     10X,'Initial interval is ',F10.5,/,                          SPECT1    180
     1     10X,'Interval between ',F10.5,' and ',F10.5,' is ',F10.5,//) SPECT1    181
            MSG='Use it anyway ? (Y/N/Q) '                              SPECT1    182
            CALL PMTRED(LOUT,LIN,JERR,24,MSG,'SP1',STRING)              SPECT1    183
            IF(RECORD) WRITE(IREC,'(A)') STRING                         SPECT1    184
            IF(STRING(1:1).EQ.'Q'.OR.STRING(1:1).EQ.'q')THEN            SPECT1    185
               NOGO=-1                                                  SPECT1    186
               GOTO 9999                                                SPECT1    187
           ENDIF                                                        SPECT1    188
           IF(STRING(1:1).NE.'Y'.AND.STRING(1:1).NE.'y' )GOTO 70        SPECT1    189
           IF(STRING(1:1).EQ.'Y'.OR.STRING(1:1).EQ.'y') GOTO 75         SPECT1    190
         ENDIF                                                          SPECT1    191
 90   CONTINUE                                                          SPECT1    192
C    :.........................................:                        SPECT1    193
                                                                        SPECT1    194
                                                                        SPECT1    195
C    ...........................................                        SPECT1    196
C    :Get mode trim variable ANS for PRONYX    :                        SPECT1    197
 75   CONTINUE                                                          SPECT1    198
      MSG='Enter Mode trim in % '                                       SPECT1    199
      CALL PMTRED(LOUT,LIN,JERR,21,MSG,'SP3',STRING)                    SPECT1    200
      IF(RECORD) WRITE(IREC,'(A)') STRING                               SPECT1    201
      IF(STRING(1:1).EQ.'Q'.OR.STRING(1:1).EQ.'q' )THEN                 SPECT1    202
         NOGO=-1                                                        SPECT1    203
         WRITE(LOUT,'(//,10X,A,//)')'* ABORT FUNCTION SPECTRUM *'       SPECT1    204
         GOTO 9999                                                      SPECT1    205
      ENDIF                                                             SPECT1    206
      READ(STRING,*,IOSTAT=IOS)ANS                                      SPECT1    207
      IF(IOS.NE.0) GOTO 75                                              SPECT1    208
C    :.........................................:                        SPECT1    209
                                                                        SPECT1    210
C    ...........................................                        SPECT1    211
C    :Tell her what you're doing               :                        SPECT1    212
      CALL HHMMSS(CTIME)                                                SPECT1    213
      WRITE(LOUT,4010)CTIME,XA(IXAS,1),XA(IXAE,1),DELTA1,               SPECT1    214
     *  NPOINT,ANS                                                      SPECT1    215
      WRITE(LU15,4010)CTIME,XA(IXAS,1),XA(IXAE,1),DELTA1,               SPECT1    216
     *  NPOINT,ANS                                                      SPECT1    217
 4010 FORMAT(//,15X, 'Parameters selected for Analysis ',10X,A8,/,      SPECT1    218
     1          15X, '-------------------------------- ',/,             SPECT1    219
     1          15X, '    Starting Time : ',F10.5,/,                    SPECT1    220
     1          15X, '      Ending Time : ',F10.5,/,                    SPECT1    221
     1          15X, '    Time interval : ',F10.5,/,                    SPECT1    222
     1          15X, ' Number of points : ',I5,/,                       SPECT1    223
     1          15X, 'Mode trim percent :  ',F7.3,////)                 SPECT1    224
C    :.........................................:                        SPECT1    225
                                                                        SPECT1    226
      WRITE(LOUT,'(//,15X,A,//)')'* Processing ... Wait... *'           SPECT1    227
                                                                        SPECT1    228
C    ...........................................                        SPECT1    229
C    :Prepare the signal array for PRONYX      :                        SPECT1    230
      DO 200 I=IXAS,NPOINT+IXAS                                         SPECT1    231
        J=I-IXAS                                                        SPECT1    232
C       Note: XSIG(0,1,.....)                                           SPECT1    233
        XSIG(J)=YA(I,1)                                                 SPECT1    234
 200  CONTINUE                                                          SPECT1    235
C    :.........................................:                        SPECT1    236
                                                                        SPECT1    237
C    ......................................                             SPECT1    238
C    :DEBUG                               :                             SPECT1    239
      IF(LDEBUG) THEN                                                   SPECT1    240
         WRITE(IDBOUT,5030)IXAS,NPOINT,DELTA1                           SPECT1    241
         DO 210 I=1,NPOINT                                              SPECT1    242
            J=I+IXAS-1                                                  SPECT1    243
            WRITE(IDBOUT,5040)I-1,XSIG(I-1),J,YA(J,1)                   SPECT1    244
 210     CONTINUE                                                       SPECT1    245
      ENDIF                                                             SPECT1    246
C    :....................................:                             SPECT1    247
                                                                        SPECT1    248
                                                                        SPECT1    249
C    ...........................................                        SPECT1    250
C    :Do your thing here                       :                        SPECT1    251
      CALL PRONYX(NPOINT,DELTA1,NOGO,ANS,LU15,LDEBUG,                   SPECT1    252
     1 FREQ,RESP,ANGLE,XSIG,SHAT)                                       SPECT1    253
      IF(NOGO.EQ.-2) THEN                                               SPECT1    254
         WRITE(LOUT,'(/10X,A,/)')'  Try selecting a larger window '     SPECT1    255
         GOTO 70                                                        SPECT1    256
      ENDIF                                                             SPECT1    257
      IF(NOGO.LT.0) GOTO 9999                                           SPECT1    258
      WRITE(LU15,2050)                                                  SPECT1    259
 2050 FORMAT(/,1X,79('*'),/)                                            SPECT1    260
C    :.........................................:                        SPECT1    261
                                                                        SPECT1    262
                                                                        SPECT1    263
C    .................................................................. SPECT1    264
C    :Ask if he wants to do it again with the same signal             : SPECT1    265
      WRITE(LOUT,4015)                                                  SPECT1    266
 4015 FORMAT(//,10X,' Analysis completed for this time frame.',//,      SPECT1    267
     1 10X,' Do you wish to do another analysis based on the same',/,   SPECT1    268
     1 10X,' channel but using a different time frame ?         ',/)    SPECT1    269
                                                                        SPECT1    270
      MSG='Wish to do it again (Y/N)'                                   SPECT1    271
      CALL PMTRED(LOUT,LIN,JERR,25,MSG,'SP5',STRING)                    SPECT1    272
      IF(RECORD) WRITE(IREC,'(A)') STRING                               SPECT1    273
                                                                        SPECT1    274
      IF(STRING(1:1).EQ.'Y'.OR.STRING(1:1).EQ.'y') GOTO 70              SPECT1    275
C    :...............................................................:  SPECT1    276
                                                                        SPECT1    277
                                                                        SPECT1    278
                                                                        SPECT1    279
C    .................................................................. SPECT1    280
C    :Save values in buffer for plotting                              : SPECT1    281
      WRITE(LOUT,4020)                                                  SPECT1    282
 4020 FORMAT(//,15X,' For the curent analysis, Save to buffer :',//,    SPECT1    283
     1 10X,'  1. Orginal and Calculated data     ',/,                   SPECT1    284
     1 10X,'  2. Difference of Orginal and Calculated data    ',/,      SPECT1    285
     1 10X,'  3. Frequency response (Amplitute vs Frequency)  ',/,      SPECT1    286
     1 10X,'  4. Frequency response (Angle vs Frequency)      ',/,      SPECT1    287
     1 10X,'  5. No save.         ',/)                                  SPECT1    288
                                                                        SPECT1    289
      MSG='Please select (1/2/3/4/5)'                                   SPECT1    290
      CALL PMTRED(LOUT,LIN,JERR,25,MSG,'SP6',STRING)                    SPECT1    291
      IF(RECORD) WRITE(IREC,'(A)') STRING                               SPECT1    292
                                                                        SPECT1    293
      IOK=0                                                             SPECT1    294
      IF(STRING(1:1).EQ.'1')THEN                                        SPECT1    295
C       ................................................                SPECT1    296
C       :Put orginal in 1st plot, calculed in 2nd plot :                SPECT1    297
         IPLTYP=1                                                       SPECT1    298
         KCH(1)=2                                                       SPECT1    299
         KCH(3)=11                                                      SPECT1    300
         YTITLE(2)='CALCULATED'                                         SPECT1    301
         LTITLE(2)=LTITLE(1)                                            SPECT1    302
         LTITL2(2)=LTITL2(1)                                            SPECT1    303
         FTITLE='PRONY ANALYSIS - BOTH ORIGINAL AND CALCULATED'         SPECT1    304
         CTITLE(2)=' '                                                  SPECT1    305
         CTITL2(2)=CTITL2(1)                                            SPECT1    306
         CASEID(2)=CASEID(1)                                            SPECT1    307
         FILCHN(2)=FILCHN(1)                                            SPECT1    308
         ICHTYP(2)=4                                                    SPECT1    309
         DISPCH(1,2)='          PRONY ANALYSIS DATA'                    SPECT1    310
         WRITE(DISPCH(1,2)(1:6),'(I6)')KCH(3)                           SPECT1    311
         DISPCH(2,2)=' '                                                SPECT1    312
         KRECFD(1,1)=KCH(1)                                             SPECT1    313
         KRECFD(1,2)=KCH(1)                                             SPECT1    314
         MAXPT(1)=NPOINT                                                SPECT1    315
         MAXPT(2)=NPOINT                                                SPECT1    316
         DO 300 I=1,NPOINT                                              SPECT1    317
            J=I+IXAS-1                                                  SPECT1    318
            XARAY(I,1)=XA(J,1)                                          SPECT1    319
            XARAY(I,2)=XA(J,1)                                          SPECT1    320
            T(I,1)=XARAY(I,1)                                           SPECT1    321
            T(I,2)=XARAY(I,2)                                           SPECT1    322
            YARAY(I,1)=XSIG(I-1)                                        SPECT1    323
            YARAY(I,2)=SHAT(I-1)                                        SPECT1    324
 300     CONTINUE                                                       SPECT1    325
         WRITE(LOUT,'(//,10X,A,/)')                                     SPECT1    326
     1   'Original and Calculated data saved'                           SPECT1    327
C       :.............................................:                 SPECT1    328
      ELSE IF(STRING(1:1).EQ.'2')THEN                                   SPECT1    329
C       ................................................                SPECT1    330
C       :PLOT differences of orginal and calculated    :                SPECT1    331
         IPLTYP=1                                                       SPECT1    332
         KCH(1)=1                                                       SPECT1    333
         KCH(2)=11                                                      SPECT1    334
         FTITLE='PRONY ANALYSIS - DIFFERENCES ORIGINAL VS CALCULATED'   SPECT1    335
         ICHTYP(1)=4                                                    SPECT1    336
         DISPCH(1,1)='          PRONY ANALYSIS DATA'                    SPECT1    337
         WRITE(DISPCH(1,1)(1:6),'(I6)')KCH(2)                           SPECT1    338
         DISPCH(2,1)=' '                                                SPECT1    339
         KRECFD(1,1)=KCH(1)                                             SPECT1    340
         KRECFD(1,2)=KCH(1)                                             SPECT1    341
         MAXPT(1)=NPOINT                                                SPECT1    342
         DO 310 I=1,NPOINT                                              SPECT1    343
            J=I+IXAS-1                                                  SPECT1    344
            XARAY(I,1)=XA(J,1)                                          SPECT1    345
            T(I,1)=XARAY(I,1)                                           SPECT1    346
            YARAY(I,1)=XSIG(I-1)-SHAT(I-1)                              SPECT1    347
 310     CONTINUE                                                       SPECT1    348
         WRITE(LOUT,'(//,10X,A,/)')                                     SPECT1    349
     1   'Difference of Orginal and Calculated data saved'              SPECT1    350
C       :.............................................:                 SPECT1    351
      ELSE IF(STRING(1:1).EQ.'3')THEN                                   SPECT1    352
C       ................................................                SPECT1    353
C       :PLOT Frequency Vs Amplitute                   :                SPECT1    354
         IPLTYP=3                                                       SPECT1    355
         KCH(1)=1                                                       SPECT1    356
         KCH(2)=11                                                      SPECT1    357
         XTITLE='FREQUENCY RESPONSE IN HZ'                              SPECT1    358
         YTITLE(1)='RELATIVE AMPLITUDE'                                 SPECT1    359
         FTITLE='PRONY ANALYSIS - FREQUENCY VS AMPLITUTE'               SPECT1    360
         ICHTYP(1)=4                                                    SPECT1    361
         DISPCH(1,1)='          PRONY ANALYSIS DATA'                    SPECT1    362
         WRITE(DISPCH(1,1)(1:6),'(I6)')KCH(2)                           SPECT1    363
         DISPCH(2,1)=' '                                                SPECT1    364
         KRECFD(1,1)=KCH(1)                                             SPECT1    365
         KRECFD(1,2)=KCH(1)                                             SPECT1    366
         MAXPT(1)=NSTEP                                                 SPECT1    367
         DO 320 I=1,NSTEP                                               SPECT1    368
            XARAY(I,1)=FREQ(I)                                          SPECT1    369
            T(I,1)=XARAY(I,1)                                           SPECT1    370
            YARAY(I,1)=RESP(I)                                          SPECT1    371
 320     CONTINUE                                                       SPECT1    372
         WRITE(LOUT,'(//,10X,A,/)')                                     SPECT1    373
     1   'Amplitute vs Frequency saved'                                 SPECT1    374
C       :.............................................:                 SPECT1    375
      ELSE IF(STRING(1:1).EQ.'4')THEN                                   SPECT1    376
C       ................................................                SPECT1    377
C       :PLOT Frequency Vs ANGLE                       :                SPECT1    378
         IPLTYP=3                                                       SPECT1    379
         KCH(1)=1                                                       SPECT1    380
         KCH(2)=11                                                      SPECT1    381
         XTITLE='FREQUENCY RESPONSE IN HZ'                              SPECT1    382
         YTITLE(1)='ANGLE IN DEGREES'                                   SPECT1    383
         FTITLE='PRONY ANALYSIS - FREQUENCY VS ANGLE'                   SPECT1    384
         ICHTYP(1)=4                                                    SPECT1    385
         DISPCH(1,1)='          PRONY ANALYSIS DATA'                    SPECT1    386
         WRITE(DISPCH(1,1)(1:6),'(I6)')KCH(2)                           SPECT1    387
         DISPCH(2,1)=' '                                                SPECT1    388
         KRECFD(1,1)=KCH(1)                                             SPECT1    389
         KRECFD(1,2)=KCH(1)                                             SPECT1    390
         MAXPT(1)=NSTEP                                                 SPECT1    391
         DO 330 I=1,NSTEP                                               SPECT1    392
            XARAY(I,1)=FREQ(I)                                          SPECT1    393
            T(I,1)=XARAY(I,1)                                           SPECT1    394
            YARAY(I,1)=ANGLE(I)                                         SPECT1    395
 330     CONTINUE                                                       SPECT1    396
         WRITE(LOUT,'(//,10X,A,/)')                                     SPECT1    397
     1   'Angle vs Frequency saved.'                                    SPECT1    398
C       :.............................................:                 SPECT1    399
      ELSE                                                              SPECT1    400
         IOK=-1                                                         SPECT1    401
         WRITE(LOUT,'(//,10X,A,//)')                                    SPECT1    402
     1   ' Calculated results not saved in buffer.'                     SPECT1    403
      ENDIF                                                             SPECT1    404
C    :................................................................: SPECT1    405
                                                                        SPECT1    406
      IF(IOK.NE.-1)THEN                                                 SPECT1    407
        WRITE(LOUT,'(/,10X,A,/)')'Use GPPLOT or DPPLOT'//               SPECT1    408
     +    ' commands to plot contents of buffer.'                       SPECT1    409
        IF(LIN.EQ.LPIN)THEN                                             SPECT1    410
          WRITE(LOUT,'(/,1X,A)')'Press <RETURN> to continue'            SPECT1    411
          READ(LIN,'(A)')CH                                             SPECT1    412
        ENDIF                                                           SPECT1    413
        STRING(1:7)='ANALYSI'                                           SPECT1    414
        CALL GPPAGE                                                     SPECT1    415
        CALL GETCHN(STRING)                                             SPECT1    416
      ENDIF                                                             SPECT1    417
C                                                                       SPECT1    418
 9999 CONTINUE                                                          SPECT1    419
      CLOSE(LU15)                                                       SPECT1    420
      RETURN                                                            SPECT1    421
C                                                                       SPECT1    422
 5000 FORMAT(/,1X,'DEBUG (SPECT1) ARRAYS AS READIN # OF POINTS: ',I5)   SPECT1    423
 5010 FORMAT(10X,I5,1X,8F20.5)                                          SPECT1    424
 5030 FORMAT(/,1X,'DEBUG (SPECT1) ARRAYS AS COPIED TO XSIG():',/,       SPECT1    425
     1 1X,'START AT ',I5,' # OF POINTS : ',I5,' DELTA-T:',F10.5,//,     SPECT1    426
     1 T13,'(I)    XSIG(I)',T42,' (J)     YA(J,1)',/)                   SPECT1    427
 5040 FORMAT(T10,I5,F20.5,T40,I5,F20.5)                                 SPECT1    428
      END                                                               SPECT1    429
