Esope source files

   1 : C PFI       SOURCE    MAUGIS    06/04/27    21:15:55     5419           
   2 :       SUBROUTINE PFI(L,ITF,LY,LQ,PHI,LPOI)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : -INC CCOPTIO
   6 : -INC SMLREEL
   7 : -INC SMTABLE
   8 : * TABLEAUX DE TRAVAIL
   9 :       SEGMENT TRAV
  10 :           REAL*8 T(J)
  11 :           REAL*8 S(I)
  12 :           INTEGER MF(J)
  13 :       ENDSEGMENT
  14 : * TABLEAUX DES FONCTIONS  Fi ET G AUX POINTS Xj
  15 :       SEGMENT FG
  16 :           REAL*8 F(K,M)
  17 :           REAL*8 G(M)
  18 :       ENDSEGMENT
  19 :       CHARACTER*8 BLANK
  20 :       DATA BLANK/'        '/
  21 :       REAL*8 XVALRE
  22 :       LOGICAL LOGRE
  23 :       CHARACTER*8 MTYPR
  24 : C----------------------------------------------------
  25 : *     LISTE DES VALEURS DE Y
  26 :       MLREEL=LY
  27 :       SEGACT MLREEL
  28 :       N=PROG(/1)
  29 : *     LISTE DES VALEURS DES PARAMETRES LINEAIRES:LQ
  30 :       JG=L
  31 :       SEGINI MLREE2
  32 :       LQ=MLREE2
  33 : *     LISTE DES POIDS
  34 :       MLREE3=LPOI
  35 :       SEGACT MLREE3
  36 : *     TABLE DES VALEURS DES FONCTIONS Fi ET G AUX POINTS Xj
  37 :       MTABLE=ITF
  38 :       SEGACT MTABLE
  39 :       I=L*(L+1)/2
  40 :       J=L
  41 :       SEGINI TRAV
  42 :       K=L
  43 :       M=N
  44 :       SEGINI FG
  45 : 
  46 : *     Valeur des fonctions linéaires F_i
  46 :       CALL ACCTAB(MTABLE,'MOT     ',0,0.D0,'F',.TRUE.,0,
  47 :      &                   'TABLE   ',IVALRE,XVALRE,BLANK,LOGRE,MTB)
  48 :       DO I=1,L
  48 :          CALL ACCTAB(MTB,'ENTIER  ',I,0.D0,BLANK,.TRUE.,0,
  49 :      &                   'LISTREEL',IVALRE,XVALRE,BLANK,LOGRE,MFI)
  50 :          MF(I)=MFI
  51 :       ENDDO
  52 :       DO I=1,L
  53 :          MLREE1=MF(I)
  54 :          SEGACT MLREE1
  55 :          DO J=1,N
  56 :               F(I,J)=MLREE1.PROG(J)
  57 :          ENDDO
  58 :          SEGDES MLREE1
  59 :       ENDDO
  60 : 
  61 : *     Valeur de la fonction G
  62 :       MTYPR='        '
  62 :       CALL ACCTAB(MTABLE,'MOT     ',0,0.D0,'G',.TRUE.,0,
  63 :      &                   MTYPR,IVALRE,XVALRE,BLANK,LOGRE,MG)
  64 : *     &                    'LISTREEL',IVALRE,XVALRE,BLANK,LOGRE,MG)
  65 :       IF (MG.NE.0) THEN
  66 :          IF (MTYPR.NE.'LISTREEL') THEN
  67 :             MOTERR(1:8)='G       '
  68 :             MOTERR(9:16)='LISTREEL'
  68 :             CALL ERREUR(800)
  69 :             RETURN
  70 :          ENDIF
  71 :          MLREE1=MG
  72 :          SEGACT MLREE1
  73 :          DO J=1,N
  74 :               G(J)=MLREE1.PROG(J)
  75 :          ENDDO
  76 :          SEGDES MLREE1
  77 :       ELSE
  78 :          DO J=1,N
  79 :               G(J)=0
  80 :          ENDDO
  81 :       ENDIF
  82 : 
  83 : *     Calcul de l'erreur d'estimation
  84 :       PHI=0.D0
  85 :       IF (L.GE.1) GOTO 60
  86 :       DO IN=1,N
  87 :          PHI=PHI+(MLREE3.PROG(IN)*(PROG(IN)-G(IN)))**2
  88 :       ENDDO
  89 :       GOTO 9999
  90 :  60   DO IN=1,N
  91 :            PDS= MLREE3.PROG(IN)*MLREE3.PROG(IN)
  92 :            Z=(PROG(IN)-G(IN))*PDS
  93 :            M=0
  94 :            DO I=1,L
  95 :                 T(I)=T(I)+Z*(F(I,IN))
  96 :                 XX=PDS*F(I,IN)
  97 :                 DO J=I,L
  98 :                      M=M+1
  99 :                      S(M)=S(M)+XX*F(J,IN)
 100 :                 ENDDO
 101 :            ENDDO
 102 :       ENDDO
 102 :       CALL SYSLIN(TRAV)
 103 :       DO IN=1,N
 103 :            CALL SSCAL(F,T ,IN,SC,L)
 104 :            PHI=PHI+(MLREE3.PROG(IN)*(G(IN)+SC-PROG(IN)))**2
 105 :       ENDDO
 106 :       DO I=1,L
 107 :            MLREE2.PROG(I)=T(I)
 108 :       ENDDO
 109 : 
 110 :       SEGDES,MLREEL,MTABLE,FG,MLREE2,MLREE3
 111 :       SEGSUP TRAV
 112 :  9999 END
 113 : 
 114 : 
 115 : 
 116 :