C PFI       SOURCE    FANDEUR   22/05/02    21:15:29     11359          
      SUBROUTINE PFI(L,ITF,LY,LQ,PHI,LPOI)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC PPARAM
-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
      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

      LOGRE = .TRUE.
      BLANK = '        '
*     Valeur des fonctions linéaires F_i
      CALL ACCTAB(MTABLE,'MOT     ',0,0.D0,'F',LOGRE,0,
     &                   'TABLE   ',IVALRE,XVALRE,BLANK,LOGRE,MTB)
      DO I=1,L
         CALL ACCTAB(MTB,'ENTIER  ',I,0.D0,BLANK,LOGRE,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',LOGRE,0,
     &                   MTYPR,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.LT.1) THEN
        DO IN=1,N
          PHI=PHI+(MLREE3.PROG(IN)*(PROG(IN)-G(IN)))**2
        ENDDO
      ELSE
        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 SSCAL1(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
      ENDIF

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

c      RETURN
      END