Télécharger pfi.eso

Retour à la liste

Numérotation des lignes :

  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
  47. CALL ACCTAB(MTABLE,'MOT ',0,0.D0,'F',.TRUE.,0,
  48. & 'TABLE ',IVALRE,XVALRE,BLANK,LOGRE,MTB)
  49. DO I=1,L
  50. CALL ACCTAB(MTB,'ENTIER ',I,0.D0,BLANK,.TRUE.,0,
  51. & 'LISTREEL',IVALRE,XVALRE,BLANK,LOGRE,MFI)
  52. MF(I)=MFI
  53. ENDDO
  54. DO I=1,L
  55. MLREE1=MF(I)
  56. SEGACT MLREE1
  57. DO J=1,N
  58. F(I,J)=MLREE1.PROG(J)
  59. ENDDO
  60. SEGDES MLREE1
  61. ENDDO
  62.  
  63. * Valeur de la fonction G
  64. MTYPR=' '
  65. CALL ACCTAB(MTABLE,'MOT ',0,0.D0,'G',.TRUE.,0,
  66. & MTYPR,IVALRE,XVALRE,BLANK,LOGRE,MG)
  67. * & 'LISTREEL',IVALRE,XVALRE,BLANK,LOGRE,MG)
  68. IF (MG.NE.0) THEN
  69. IF (MTYPR.NE.'LISTREEL') THEN
  70. MOTERR(1:8)='G '
  71. MOTERR(9:16)='LISTREEL'
  72. CALL ERREUR(800)
  73. RETURN
  74. ENDIF
  75. MLREE1=MG
  76. SEGACT MLREE1
  77. DO J=1,N
  78. G(J)=MLREE1.PROG(J)
  79. ENDDO
  80. SEGDES MLREE1
  81. ELSE
  82. DO J=1,N
  83. G(J)=0
  84. ENDDO
  85. ENDIF
  86.  
  87. * Calcul de l'erreur d'estimation
  88. PHI=0.D0
  89. IF (L.GE.1) GOTO 60
  90. DO IN=1,N
  91. PHI=PHI+(MLREE3.PROG(IN)*(PROG(IN)-G(IN)))**2
  92. ENDDO
  93. GOTO 9999
  94. 60 DO IN=1,N
  95. PDS= MLREE3.PROG(IN)*MLREE3.PROG(IN)
  96. Z=(PROG(IN)-G(IN))*PDS
  97. M=0
  98. DO I=1,L
  99. T(I)=T(I)+Z*(F(I,IN))
  100. XX=PDS*F(I,IN)
  101. DO J=I,L
  102. M=M+1
  103. S(M)=S(M)+XX*F(J,IN)
  104. ENDDO
  105. ENDDO
  106. ENDDO
  107. CALL SYSLIN(TRAV)
  108. DO IN=1,N
  109. CALL SSCAL(F,T ,IN,SC,L)
  110. PHI=PHI+(MLREE3.PROG(IN)*(G(IN)+SC-PROG(IN)))**2
  111. ENDDO
  112. DO I=1,L
  113. MLREE2.PROG(I)=T(I)
  114. ENDDO
  115.  
  116. SEGDES,MLREEL,MTABLE,FG,MLREE2,MLREE3
  117. SEGSUP TRAV
  118. 9999 END
  119.  
  120.  
  121.  
  122.  
  123.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales