C PFI       SOURCE    MAUGIS    06/04/27    21:15:55     5419           
      SUBROUTINE PFI(L,ITF,LY,LQ,PHI,LPOI)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC CCOPTIO
-INC SMLREEL
-INC SMTABLE
* TABLEAUX DE TRAVAIL
      SEGMENT TRAV
          REAL*8 T(J)
          REAL*8 S(I)
          INTEGER MF(J)
      ENDSEGMENT
* TABLEAUX DES FONCTIONS  Fi ET G AUX POINTS Xj
      SEGMENT FG
          REAL*8 F(K,M)
          REAL*8 G(M)
      ENDSEGMENT
      CHARACTER*8 BLANK
      DATA BLANK/'        '/
      REAL*8 XVALRE
      LOGICAL LOGRE
      CHARACTER*8 MTYPR
C----------------------------------------------------
*     LISTE DES VALEURS DE Y
      MLREEL=LY
      SEGACT MLREEL
      N=PROG(/1)
*     LISTE DES VALEURS DES PARAMETRES LINEAIRES:LQ
      JG=L
      SEGINI MLREE2
      LQ=MLREE2
*     LISTE DES POIDS
      MLREE3=LPOI
      SEGACT MLREE3
*     TABLE DES VALEURS DES FONCTIONS Fi ET G AUX POINTS Xj
      MTABLE=ITF
      SEGACT MTABLE
      I=L*(L+1)/2
      J=L
      SEGINI TRAV
      K=L
      M=N
      SEGINI FG

*     Valeur des fonctions linéaires F_i
      CALL ACCTAB(MTABLE,'MOT     ',0,0.D0,'F',.TRUE.,0,
     &                   'TABLE   ',IVALRE,XVALRE,BLANK,LOGRE,MTB)
      DO I=1,L
         CALL ACCTAB(MTB,'ENTIER  ',I,0.D0,BLANK,.TRUE.,0,
     &                   'LISTREEL',IVALRE,XVALRE,BLANK,LOGRE,MFI)
         MF(I)=MFI
      ENDDO
      DO I=1,L
         MLREE1=MF(I)
         SEGACT MLREE1
         DO J=1,N
              F(I,J)=MLREE1.PROG(J)
         ENDDO
         SEGDES MLREE1
      ENDDO

*     Valeur de la fonction G
      MTYPR='        '
      CALL ACCTAB(MTABLE,'MOT     ',0,0.D0,'G',.TRUE.,0,
     &                   MTYPR,IVALRE,XVALRE,BLANK,LOGRE,MG)
*     &                    'LISTREEL',IVALRE,XVALRE,BLANK,LOGRE,MG)
      IF (MG.NE.0) THEN
         IF (MTYPR.NE.'LISTREEL') THEN
            MOTERR(1:8)='G       '
            MOTERR(9:16)='LISTREEL'
            CALL ERREUR(800)
            RETURN
         ENDIF
         MLREE1=MG
         SEGACT MLREE1
         DO J=1,N
              G(J)=MLREE1.PROG(J)
         ENDDO
         SEGDES MLREE1
      ELSE
         DO J=1,N
              G(J)=0
         ENDDO
      ENDIF

*     Calcul de l'erreur d'estimation
      PHI=0.D0
      IF (L.GE.1) GOTO 60
      DO IN=1,N
         PHI=PHI+(MLREE3.PROG(IN)*(PROG(IN)-G(IN)))**2
      ENDDO
      GOTO 9999
 60   DO IN=1,N
           PDS= MLREE3.PROG(IN)*MLREE3.PROG(IN)
           Z=(PROG(IN)-G(IN))*PDS
           M=0
           DO I=1,L
                T(I)=T(I)+Z*(F(I,IN))
                XX=PDS*F(I,IN)
                DO J=I,L
                     M=M+1
                     S(M)=S(M)+XX*F(J,IN)
                ENDDO
           ENDDO
      ENDDO
      CALL SYSLIN(TRAV)
      DO IN=1,N
           CALL SSCAL(F,T ,IN,SC,L)
           PHI=PHI+(MLREE3.PROG(IN)*(G(IN)+SC-PROG(IN)))**2
      ENDDO
      DO I=1,L
           MLREE2.PROG(I)=T(I)
      ENDDO

      SEGDES,MLREEL,MTABLE,FG,MLREE2,MLREE3
      SEGSUP TRAV
 9999 END