CFPRIME FNTTRN                                                          FNTTRN      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 FNTTRN(XA,YA,NOGO)                                     FNTTRN      3
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCFLFCCCCCFNTTRN      4
CD                                                                      FNTTRN      5
CD          THE ROUTINE PERFORMS THE TREND ANALYSIS ON THE              FNTTRN      6
CD          GIVEN CHANNELS                                              FNTTRN      7
CD                                                                      FNTTRN      8
CD          CALLING PARAMETERS :                                        FNTTRN      9
CD                                                                      FNTTRN     10
CD                        XA  -  THE INPUT X ARRAY                      FNTTRN     11
CD                        YA  -  THE INPUT Y ARRAY                      FNTTRN     12
CD                      NOGO  -  I/O ERROR FLAG                         FNTTRN     13
CD                                                                      FNTTRN     14
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCFNTTRN     15
C                                                                       FNTTRN     16
      INCLUDE 'PARAM.INS'                                               FNTTRN     17
      INCLUDE 'SOAPC1.INS'                                              FNTTRN     18
      INCLUDE 'XYARAY.INS'                                              FNTTRN     19
      INCLUDE 'CHDISP.INS'                                              FNTTRN     20
C                                                                       FNTTRN     21
      CHARACTER*1 CH                                                    FNTTRN     22
      CHARACTER*2 UID                                                   FNTTRN     23
      CHARACTER*80 STRING,MSG                                           FNTTRN     24
      DIMENSION XA(MXPT,MXPLOT),YA(MXPT,MXPLOT)                         FNTTRN     25
      NOGO=0                                                            FNTTRN     26
      MM=MAXPT(1)                                                       FNTTRN     27
C                                                                       FNTTRN     28
C                Establish starting and ending time for trend analysis  FNTTRN     29
 70   WRITE(LOUT,1000) XA(1,1),XA(MM,1)                                 FNTTRN     30
      MSG='Enter START time, END time (M)in,max'                        FNTTRN     31
      CALL PMTRED(LOUT,LIN,JERR,ISLEN(MSG),MSG,'TR1',STRING)            FNTTRN     32
      IF(RECORD) WRITE(IREC,'(A)') STRING                               FNTTRN     33
      IF(STRING(1:1).EQ.'Q'.OR.STRING(1:1).EQ.'q')THEN                  FNTTRN     34
         NOGO=-1                                                        FNTTRN     35
         GOTO 9999                                                      FNTTRN     36
      ELSEIF(STRING(1:1).EQ.'M' .OR.STRING(1:1).EQ.'m')THEN             FNTTRN     37
        XAS=XA(1,1)                                                     FNTTRN     38
        XAE=XA(MM,1)                                                    FNTTRN     39
      ELSE                                                              FNTTRN     40
        READ(STRING,*,IOSTAT=IOS)XAS,XAE                                FNTTRN     41
        IF(IOS.NE.0) GOTO 70                                            FNTTRN     42
      ENDIF                                                             FNTTRN     43
C                                                                       FNTTRN     44
      IF((XAS.GE.XAE).OR.(XAE.EQ.0.0)) THEN                             FNTTRN     45
         WRITE(LOUT,'(//,1X,A,/)')'*ERROR.. (START > END) TRY AGAIN *'  FNTTRN     46
         GOTO 70                                                        FNTTRN     47
      ENDIF                                                             FNTTRN     48
C                                                                       FNTTRN     49
      DO 80 I=1,MM                                                      FNTTRN     50
        IF(XA(I,1).GE.XAS)THEN                                          FNTTRN     51
          IXAS=I                                                        FNTTRN     52
          GOTO 85                                                       FNTTRN     53
        ENDIF                                                           FNTTRN     54
 80   CONTINUE                                                          FNTTRN     55
C                                                                       FNTTRN     56
      WRITE(LOUT,'(//,1X,A,/)')'*OUT OF RANGE. TRY AGAIN *'             FNTTRN     57
      GOTO 70                                                           FNTTRN     58
C                                                                       FNTTRN     59
 85   DO 87 I=IXAS,MM                                                   FNTTRN     60
        IF(XA(I,1).GE.XAE)THEN                                          FNTTRN     61
          IXAE=I                                                        FNTTRN     62
          GOTO 100                                                      FNTTRN     63
        ENDIF                                                           FNTTRN     64
 87   CONTINUE                                                          FNTTRN     65
C                                                                       FNTTRN     66
      WRITE(LOUT,'(//,1X,A,/)')'*OUT OF RANGE. TRY AGAIN *'             FNTTRN     67
      GOTO 70                                                           FNTTRN     68
C                                                                       FNTTRN     69
 100  CONTINUE                                                          FNTTRN     70
C                                            Calculate average X and Y  FNTTRN     71
      AVEX=0.0                                                          FNTTRN     72
      AVEY=0.0                                                          FNTTRN     73
      DO 110 I=IXAS,IXAE                                                FNTTRN     74
        AVEX=AVEX+XA(I,1)                                               FNTTRN     75
        AVEY=AVEY+YA(I,1)                                               FNTTRN     76
 110  CONTINUE                                                          FNTTRN     77
      RNPT=IXAE-IXAS+1                                                  FNTTRN     78
      AVEX=AVEX/RNPT                                                    FNTTRN     79
      AVEY=AVEY/RNPT                                                    FNTTRN     80
C                                                   x=X-Xave; y=Y-Yave  FNTTRN     81
C                                        Calculate SUM x*x and SUM x*y  FNTTRN     82
      SUMSXX=0.0                                                        FNTTRN     83
      SUMSXY=0.0                                                        FNTTRN     84
      DO 210 I=IXAS,IXAE                                                FNTTRN     85
        SMALLX=XA(I,1)-AVEX                                             FNTTRN     86
        SXSQ=SMALLX**2                                                  FNTTRN     87
        SUMSXX=SUMSXX+SXSQ                                              FNTTRN     88
        SMALLY=YA(I,1)-AVEY                                             FNTTRN     89
        SXY=SMALLX*SMALLY                                               FNTTRN     90
        SUMSXY=SUMSXY+SXY                                               FNTTRN     91
 210  CONTINUE                                                          FNTTRN     92
C                                                                       FNTTRN     93
      XS=XAS                                                            FNTTRN     94
      XE=XAE                                                            FNTTRN     95
      XINC=(XE-XS)/10.0                                                 FNTTRN     96
C                                                Calculate x*x and x*y  FNTTRN     97
C                                  Calculate the equation of the curve  FNTTRN     98
      MAXPT(2)=10                                                       FNTTRN     99
      XARAY(1,2)=XS                                                     FNTTRN    100
      XARAY(10,2)=XE                                                    FNTTRN    101
      DO 310 I=1,MAXPT(2)                                               FNTTRN    102
        IF(I.GT.1) XARAY(I,2)=XARAY(I-1,2)+XINC                         FNTTRN    103
        T(I,2)=XARAY(I,2)                                               FNTTRN    104
        YARAY(I,2)=((SUMSXY/SUMSXX)*(XARAY(I,2)-AVEX))+AVEY             FNTTRN    105
 310  CONTINUE                                                          FNTTRN    106
C                                                                       FNTTRN    107
      KCH(1)=2                                                          FNTTRN    108
      KCH(3)=11                                                         FNTTRN    109
      YTITLE(2)='LEAST SQUARE FIT'                                      FNTTRN    110
      LTITLE(2)=LTITLE(1)                                               FNTTRN    111
      LTITL2(2)=LTITL2(1)                                               FNTTRN    112
      FTITLE='TREND ANALYSIS - BOTH ORIGINAL AND CALCULATED'            FNTTRN    113
      CTITLE(2)=' '                                                     FNTTRN    114
      CTITL2(2)=CTITL2(1)                                               FNTTRN    115
      CASEID(2)=CASEID(1)                                               FNTTRN    116
      FILCHN(2)=FILCHN(1)                                               FNTTRN    117
      ICHTYP(2)=4                                                       FNTTRN    118
      DISPCH(1,2)='          TREND ANALYSIS DATA'                       FNTTRN    119
      WRITE(DISPCH(1,2)(1:6),'(I6)')KCH(3)                              FNTTRN    120
      DISPCH(2,2)=' '                                                   FNTTRN    121
      KRECFD(1,1)=KCH(1)                                                FNTTRN    122
      KRECFD(1,2)=KCH(1)                                                FNTTRN    123
C                                                                       FNTTRN    124
      WRITE(LOUT,'(/,10X,A,/)')'Use GPPLOT or DPPLOT'//                 FNTTRN    125
     +  ' commands to plot contents of buffer.'                         FNTTRN    126
      IF(LIN.EQ.LPIN)THEN                                               FNTTRN    127
        WRITE(LOUT,'(/,1X,A)')'Press <RETURN> to continue'              FNTTRN    128
        READ(LIN,'(A)')CH                                               FNTTRN    129
      ENDIF                                                             FNTTRN    130
      STRING(1:7)='ANALYSI'                                             FNTTRN    131
      CALL GPPAGE                                                       FNTTRN    132
      CALL GETCHN(STRING)                                               FNTTRN    133
C                                                                       FNTTRN    134
 9999 RETURN                                                            FNTTRN    135
C                                                                       FNTTRN    136
 1000 FORMAT(//,                                                        FNTTRN    137
     1 10X,'......................................................',/,  FNTTRN    138
     1 10X,'.                                                    .',/,  FNTTRN    139
     1 10X,'.          LEAST SQUARE FIT (TREND) ANALYSIS         .',/,  FNTTRN    140
     1 10X,'.                                                    .',/,  FNTTRN    141
     1 10X,'.          DATA Starting time = ',F10.3,/,                  FNTTRN    142
     1 10X,'.          DATA Ending time   = ',F10.3,/,                  FNTTRN    143
     1 10X,'.                                                    .',/,  FNTTRN    144
     1 10X,'.           Please specify time period.              .',/,  FNTTRN    145
     1 10X,'.                                                    .',/,  FNTTRN    146
     1 10X,'......................................................',//) FNTTRN    147
C                                                                       FNTTRN    148
      END                                                               FNTTRN    149
C                                                                       FNTTRN    150
        FUNCTION ISLEN(STRING)                                          FNTTRN    151
CD                                                                      FNTTRN    152
CD        THIS FUNCTION DETERMINES THE LENGTH OF A STRING               FNTTRN    153
CD                                                                      FNTTRN    154
CD        PARAMETER :                                                   FNTTRN    155
CD                                                                      FNTTRN    156
CD           STRING -  INCOMING CHARACTER STRING                        FNTTRN    157
CD                                                                      FNTTRN    158
        CHARACTER*(*) STRING                                            FNTTRN    159
        DO 10 I=LEN(STRING),1,-1                                        FNTTRN    160
          IF(STRING(I:I).NE.' ')GOTO 20                                 FNTTRN    161
  10    CONTINUE                                                        FNTTRN    162
  20    ISLEN=I                                                         FNTTRN    163
        RETURN                                                          FNTTRN    164
        END                                                             FNTTRN    165
