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

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