Télécharger kfanal.eso

Retour à la liste

Numérotation des lignes :

kfanal
  1. C KFANAL SOURCE NC 08/05/29 21:15:00 6112
  2. SUBROUTINE KFANAL (IFACFO,PSOM,KBIL,PTRA,KSYM,LIMP,LIMP2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C----------------------------------------------------------------------
  6. C CALCUL DES ERREURS SUR LE BILAN ET LA SYMETRIE
  7. C SP APPELE PAR KFN
  8. C
  9. C entrée:
  10. C IFACFO : POINTEUR SUR L OBJET SFACFOR (SUPPOSE ACTIVE)
  11. C ------
  12. C KBIL = 1 calcul des bilans
  13. C KSYM = 1 calcul de la symétrie
  14. C
  15. C LIMP : PARAMETRE IMPRESSION GENERAL
  16. C SI GE.1 ON IMPRIME LES LES VALEURS GLOBALES EBL ET ESM
  17. C LIMP2: DETAILS
  18. C SI GE.2 VALEURS RELATIVE AU MAX PAR LIGNE
  19. C SI GE.3 TOUT Y COMPRIS LES FACTEURS DE FORME
  20. C
  21. C sortie :
  22. C PSOM : OBJET ASSOCIE AU BILAN
  23. C EBL REPRESENTE LE MAX DE L ERREUR SUR LES BILANS
  24. C PTRA : OBJET ASSOCIE A LA SYMETRIE
  25. C ESM REPRESENTE LE MAX DE L ERREUR SUR LA SYMETRIE
  26. C----------------------------------------------------------------------
  27. C FACTEURS DE FORME
  28. C NNBEL1 = NOMBRE DE LIGNES + 1
  29. C NBEL2 = NOMBRE DE COLONNES
  30. C LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES
  31. C
  32. SEGMENT IFACFO
  33. INTEGER LFACT(NNBEL1)
  34. ENDSEGMENT
  35. SEGMENT LFAC
  36. REAL*8 FACT(NBEL2)
  37. ENDSEGMENT
  38. POINTEUR PSUR.LFAC, PLIG.LFAC
  39. POINTEUR PCOL.LFAC
  40. C----------------------------------------------------------------------
  41. SEGMENT,PSOM
  42. REAL*8 SOM(N2),EBL
  43. ENDSEGMENT
  44. SEGMENT,PTRA
  45. REAL*8 TRA(N2),ESM
  46. ENDSEGMENT
  47. C----------------------------------------------------------------------
  48. C
  49. N2 = LFACT(/1)-1
  50. PSUR=LFACT(N2+1)
  51.  
  52. CALL UTINIV(TRA,N2)
  53.  
  54. C>>> VERIFICATION DE SYMETRIE
  55. C ------------------------
  56.  
  57. IF (KSYM.EQ.1) THEN
  58.  
  59.  
  60. DO 800 K1=1,N2
  61. PLIG=LFACT(K1)
  62. C> SEGACT PLIG
  63. CALL UTINIV(SOM,N2)
  64. DO 801 K2=1,N2
  65. IF (K2.NE.K1) THEN
  66. PCOL=LFACT(K2)
  67. C> SEGACT PCOL
  68. IF (PLIG.FACT(K2).GE.1E-6.AND.PCOL.FACT(K1).GE.1E-6) THEN
  69. SOM(K2) = PSUR.FACT(K1)*PLIG.FACT(K2)
  70. SOM(K2) = SOM(K2) - PSUR.FACT(K2)*PCOL.FACT(K1)
  71. SOM(K2) = SOM(K2)/PLIG.FACT(K2)/PSUR.FACT(K1)
  72. ENDIF
  73. C> SEGDES PCOL
  74. ENDIF
  75. 801 CONTINUE
  76. CALL UTMXV(SOM,N2,TRA(K1))
  77. IF (LIMP2.GE.4) THEN
  78. WRITE(6,*) ' FIJ LIGNE ',K1
  79. CALL UTPRIM(PLIG.FACT,N2)
  80. ENDIF
  81. IF (LIMP2.GE.4) THEN
  82. WRITE(6,*) ' SYMETRIE ',K1
  83. CALL UTPRIM(SOM,N2)
  84. ENDIF
  85. C> SEGDES PLIG
  86. 800 CONTINUE
  87. CALL UTMXV(TRA,N2,ESM)
  88.  
  89. IF (LIMP2.GE.2) THEN
  90. WRITE(6,*)
  91. WRITE(6,*) 'SYMETRIE : ECART RELATIF MAXIMAL PAR LIGNE '
  92. CALL UTPRIM(TRA,N2)
  93. ENDIF
  94. IF(LIMP.GE.1) THEN
  95. WRITE(6,1001) ESM
  96. 1001 FORMAT(1X,'SYMETRIE : ECART RELATIF MAXIMAL GLOBAL ',E12.5)
  97. ENDIF
  98.  
  99. ENDIF
  100.  
  101.  
  102. IF (KBIL.EQ.1) THEN
  103.  
  104. C
  105. C>>> CALCUL DES BILANS ET IMPRESSION EVENTUELLE
  106. C ------------------------------------------
  107. C
  108. DO 500 K1 = 1,N2
  109. SOM(K1) = 0.
  110. PLIG = LFACT(K1)
  111. C> SEGACT PLIG
  112. DO 501 K2=1,N2
  113. SOM(K1) = SOM(K1) + PLIG.FACT(K2)
  114. 501 CONTINUE
  115. C> SEGDES PLIG
  116. 500 CONTINUE
  117.  
  118. IF (LIMP2.GE.2) THEN
  119. WRITE(6,*)
  120. WRITE(6,*) 'BILAN '
  121. CALL UTPRIM(SOM,N2)
  122. ENDIF
  123.  
  124. DO 502 K1 =1,N2
  125. SOM(K1) = SOM(K1) - 1.D0
  126. 502 CONTINUE
  127. CALL UTMXV(SOM,N2,EBL)
  128.  
  129. IF (LIMP.GE.1) THEN
  130. WRITE(6,1000) EBL
  131. 1000 FORMAT(1X,'BILAN : ECART MAXIMAL ',E12.5)
  132. ENDIF
  133.  
  134. ENDIF
  135.  
  136.  
  137. RETURN
  138. END
  139.  
  140.  
  141.  

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