Télécharger kfn.eso

Retour à la liste

Numérotation des lignes :

  1. C KFN SOURCE CB215821 16/04/21 21:17:31 8920
  2. SUBROUTINE KFN (IFACFO,INOR,KIMP)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C----------------------------------------------------------------------
  6. C IMPRESSION , NORMALISATION ET SYMETRISATION DES FACTEURS DE FORME
  7. C entrée et sortie ;
  8. C IFACFO : POINTEUR SUR L OBJET SFACFOR (FACTEURS DE FORME)
  9. C entrée :
  10. C INOR : SI 0 PAS DE NORMALISATION
  11. C KIMP : parametre d'impression
  12. C----------------------------------------------------------------------
  13. C FACTEURS DE FORME
  14. C NNBEL1 = NOMBRE DE LIGNES + 1
  15. C NBEL2 = NOMBRE DE COLONNES
  16. C LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES
  17. C
  18. SEGMENT IFACFO
  19. INTEGER LFACT(NNBEL1)
  20. ENDSEGMENT
  21. SEGMENT LFAC
  22. REAL*8 FACT(NBEL2)
  23. ENDSEGMENT
  24. POINTEUR PSUR.LFAC, PLIG.LFAC
  25. POINTEUR IFACF1.IFACFO,IFACF2.IFACFO
  26. POINTEUR LF1.LFAC,LF2.LFAC
  27. C----------------------------------------------------------------------
  28. C OBJETS POUR L EVALUATION DES BILANS ET SYMETRISATION
  29. SEGMENT,PSOM
  30. REAL*8 SOM(N2),EBL
  31. ENDSEGMENT
  32. SEGMENT,PTRA
  33. REAL*8 TRA(N2),ESM
  34. ENDSEGMENT
  35. C----------------------------------------------------------------------
  36. C
  37. KIMP0=0
  38. C
  39. C NOMBRE D ITERATION MAX
  40. NK=30
  41. C
  42. C CRITERE POUR NORMALISER : ERREUR LES BILANS
  43. EBILAN=0.2
  44. C CRITERE D'IMPRESSION : ERREUR LES BILANS
  45. EBIMPR=0.1
  46.  
  47. C
  48. C>>> ACTIVATION DE L OBJET SFACFOR
  49. C
  50. SEGACT IFACFO
  51. N1= LFACT(/1)
  52. PSUR=LFACT(N1)
  53. SEGACT PSUR
  54. N2 = N1 - 1
  55. DO 1 L1 = 1,N2
  56. LFAC= LFACT(L1)
  57. SEGACT LFAC*MOD
  58. 1 CONTINUE
  59.  
  60. SEGINI PSOM, PTRA
  61.  
  62. CALL KFANAL(IFACFO,PSOM,1,PTRA,1,KIMP,KIMP)
  63.  
  64. KBIL=0
  65. DO 2 I=1,N2
  66. IF (ABS(SOM(I)).GE.EBIMPR) THEN
  67. IF (ABS(SOM(I)).GE.EBILAN) THEN
  68. KBIL=1
  69. ENDIF
  70. IF ((INOR.NE.0).AND.(KIMP.GE.1)) THEN
  71. WRITE(6,1004) I,ABS(SOM(I))
  72. 1004 FORMAT(1X,'ELEMENT ',I4,
  73. # ' ERREUR ABSOLUE SUR LE BILAN ',E9.3)
  74. ENDIF
  75. ENDIF
  76. 2 CONTINUE
  77. C
  78. IF (INOR.NE.0) THEN
  79. IF (KBIL.EQ.1) THEN
  80. C>>> PAS DE NORMALISATION ---------------------------------------
  81. WRITE(6,*) ' CAVITE NON FERMEE OU BILAN VERFIE A PLUS DE 20
  82. $% : PAS DE NORMALISATION '
  83. ELSE
  84. C
  85. C>>> ON NORMALISE -----------------------------------------------
  86. C
  87. IFACF1=IFACFO
  88.  
  89. C IFACF1 :OBJET DE DEPART
  90. C IFACF2 :OBJET CORRIGE
  91. C
  92. NNBEL1 = N1
  93. NBEL2 = N2
  94. SEGINI IFACFO
  95. C
  96. DO 900 L1=1,NNBEL1
  97. LF1=IFACF1.LFACT(L1)
  98. SEGINI PLIG
  99. LFACT(L1) = PLIG
  100. DO 901 L2=1,NBEL2
  101. PLIG.FACT(L2)=LF1.FACT(L2)
  102. 901 CONTINUE
  103. C!
  104. SEGDES LF1
  105. C!
  106. C
  107. 900 CONTINUE
  108. C
  109. IFACF2=IFACFO
  110. C!!
  111. SEGDES IFACF1
  112. PSUR=LFACT(N1)
  113. C!!
  114.  
  115. C-----ITERATIONS------------------------------------
  116.  
  117. DO 100 K=1,NK
  118. C
  119. C>>> SYMETRISATION
  120. C
  121.  
  122. DO 20 L1 = 1,N2
  123.  
  124. S1=PSUR.FACT(L1)
  125. LF1=LFACT(L1)
  126. DO 21 L2 = 1,N2
  127. LF2=LFACT(L2)
  128. S2=PSUR.FACT(L2)
  129. IF (L2.LT.L1) THEN
  130. FF=0.5*(S1*LF1.FACT(L2)+S2*LF2.FACT(L1))
  131. LF1.FACT(L2)=FF/S1
  132. LF2.FACT(L1)=FF/S2
  133. ENDIF
  134. 21 CONTINUE
  135. 20 CONTINUE
  136. C
  137. CALL KFANAL(IFACF2,PSOM,1,PTRA,0,KIMP0,KIMP0)
  138.  
  139. C
  140. C>>> NORMALISATION
  141. C
  142. DO 10 L1 = 1,N2
  143. LF1=LFACT(L1)
  144. S2=0.D0
  145. DO 12 L2= 1,N2
  146. S2=S2+LF1.FACT(L2)
  147. 12 CONTINUE
  148. DO 13 L2= 1,N2
  149. LF1.FACT(L2)=LF1.FACT(L2) / S2
  150. 13 CONTINUE
  151. 10 CONTINUE
  152.  
  153. CALL KFANAL(IFACF2,PSOM,0,PTRA,1,KIMP0,KIMP0)
  154. IF (KIMP.GE.1) THEN
  155. WRITE(6,1000) K,EBL,ESM
  156. 1000 FORMAT(1X,'ITER',I2,' ERREURS REL MAX: BILAN ET SYMETRIE',2E9.3)
  157. ENDIF
  158. C
  159. C>>> CONVERGENCE A PRIORI
  160. C
  161. IF (EBL.LE.1.E-2.AND.ESM.LE.1.E-2) THEN
  162. CALL KFANAL(IFACF2,PSOM,1,PTRA,1,KIMP,KIMP)
  163.  
  164. C ON GARDE LA SOLUTION CORRIGEE ON DETRUIT L'OBJET DE DEPART
  165.  
  166. C!!
  167. SEGACT IFACF1
  168. C!!
  169. DO 950 L1=1,N1
  170. LF1=IFACF1.LFACT(L1)
  171. SEGSUP LF1
  172. LF2 = IFACF2.LFACT(L1)
  173. SEGDES LF2
  174. 950 CONTINUE
  175. SEGSUP IFACF1
  176. IFACFO=IFACF2
  177. C
  178. C>>> DESACTIVATION DE L OBJET SFACFOR
  179. C
  180. SEGDES IFACFO
  181. SEGSUP PSOM, PTRA
  182. RETURN
  183. C
  184. ENDIF
  185.  
  186. 100 CONTINUE
  187. C-----ITERATIONS--FIN-------------------------------
  188. C
  189. WRITE(6,*) ' LA NORMALISATION N A PAS CONVERGÉ '
  190. C ON GARDE L'OBJET DE DEPART ON DETRUIT l'OBJET CORRIGE
  191. C
  192. DO 975 L1=1,N1
  193. LF2 = IFACF2.LFACT(L1)
  194. SEGSUP LF2
  195. 975 CONTINUE
  196. SEGSUP IFACF2
  197. IFACFO=IFACF1
  198. C!
  199. SEGACT IFACFO
  200. C!
  201. ENDIF
  202. ENDIF
  203.  
  204. DO 980 L1=1,N1
  205. LF1=IFACFO.LFACT(L1)
  206. SEGDES LF1
  207. 980 CONTINUE
  208. SEGDES IFACFO
  209. SEGSUP PSOM,PTRA
  210. C
  211. RETURN
  212. END
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  

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