Télécharger j3fac1.eso

Retour à la liste

Numérotation des lignes :

  1. C J3FAC1 SOURCE CHAT 05/01/13 00:46:38 5004
  2. SUBROUTINE J3FAC1(VWORK,TOL,IRET)
  3. C----------------------------------------------------
  4. C TEST POUR LES FACES
  5. C PP 6/97
  6. C Pierre Pegon/JRC Ispra
  7. C----------------------------------------------------
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. -INC CCOPTIO
  11. SEGMENT VWORK
  12. INTEGER FWWORK(NFACE)
  13. ENDSEGMENT
  14. POINTEUR VWORK1.VWORK,VWORK2.VWORK,VWORK3.VWORK,VWORK4.VWORK
  15. C
  16. SEGMENT WWORK
  17. REAL*8 PORIG(3),VNORM(3),VI(3),VJ(3)
  18. INTEGER FWORK
  19. INTEGER TWORK(NTROU)
  20. ENDSEGMENT
  21. POINTEUR WWORK1.WWORK,WWORK2.WWORK
  22. C
  23. SEGMENT FUSE
  24. INTEGER BLFA(2,NFAMA)
  25. ENDSEGMENT
  26. C
  27. NFAMA=50
  28. SEGINI,FUSE
  29. C
  30. C ON RENTRE AVEC DES ENSEMBLE DE VWORK REPRESENTANT CHACUN
  31. C UN BLOCK COMPOSE DE FACE
  32. C
  33. NBLOCK=FWWORK(/1)
  34. C
  35. C ON BOUCLE SUR CHAQUE BLOCK ET SUR CHAQUE FACE ...
  36. C
  37. DO IE1=1,NBLOCK
  38. VWORK1=FWWORK(IE1)
  39. NFACE1=VWORK1.FWWORK(/1)
  40. C
  41. C INITIALISATION DES VALEURS DE DEBUT DE BOUCLE POUR LES
  42. C FACES DE TRAVAIL (BLFA(1,.)=DEBUT BLOCK, BLFA(2,.)=DEBUT FACE)
  43. C
  44. IF(NFACE1.GT.NFAMA)THEN
  45. NFAMA=NFAMA+50
  46. SEGADJ,FUSE
  47. ENDIF
  48. DO KE1=1,NFACE1
  49. BLFA(1,KE1)=1
  50. BLFA(2,KE1)=1
  51. ENDDO
  52. C
  53. C "DO 1 JE1=1,NFACE1"
  54. C
  55. JE1=0
  56. 1 JE1=JE1+1
  57. IF(JE1.GT.NFACE1)GOTO 2
  58. C
  59. WWORK1=VWORK1.FWWORK(JE1)
  60. C
  61. C ... QUE L'ON COMPARE AU AUTRES BLOCKS ET FACES
  62. C
  63. DO 11 IE2=BLFA(1,JE1),NBLOCK
  64. IF(IE1.EQ.IE2)GOTO 11
  65. VWORK2=FWWORK(IE2)
  66. NFACE2=VWORK2.FWWORK(/1)
  67. DO 10 JE2=BLFA(2,JE1),NFACE2
  68. WWORK2=VWORK2.FWWORK(JE2)
  69. C
  70. C ON APPEL FAFA
  71. C
  72. CALL J3FAFA(WWORK1,WWORK2,TOL,IRET,ICAS,VWORK3,VWORK4)
  73. IF(IRET.NE.0)THEN
  74. RETURN
  75. ENDIF
  76. C
  77. C ON OPERE DIFFERENTS TRAITEMENTS SELON LES CAS
  78. C
  79. IF(ICAS.EQ.1)GOTO 10
  80. C
  81. IF(ICAS.EQ.2)GOTO 1
  82. C
  83. IF(ICAS.EQ.3)THEN
  84. C
  85. C DANS LE CAS 3 ON AJOUTE 1(le trou)+N(les coalescences) FACES
  86. C LA FACE DE TRAVAIL SE RETOUVE EN JE1+1 ET DOIT CONTINUER
  87. C L'INSPECTION DES FACES A PARTIR DE LA AINSI QUE LES NOUVELLES
  88. C FACES
  89. C
  90. C CONCATENATION DES FACES
  91. NFACE10=NFACE1
  92. CALL J3VPLU(VWORK3,VWORK1)
  93. VWORK1=VWORK3
  94. CALL J3VPLU(VWORK1,VWORK4)
  95. NFACE1=VWORK1.FWWORK(/1)
  96. FWWORK(IE1)=VWORK1
  97. C
  98. IF(NFACE1.GT.NFAMA)THEN
  99. NFAMA=NFAMA+50
  100. SEGADJ,FUSE
  101. ENDIF
  102. C LES N FACES DE COALESCENCE AJOUTEE A LA FIN DOIVENT ETRE TRAITEES
  103. C A PARTIR DE LA FACE DE TEST COURRANTE
  104. IF(NFACE10+1.LT.NFACE1)THEN
  105. DO KE1=NFACE10+2,NFACE1
  106. BLFA(1,KE1)=IE2
  107. BLFA(2,KE1)=JE2+1
  108. ENDDO
  109. ENDIF
  110. C ON SHIFTE LES INDICES A PARTIR DE LA FACE COURANTE (JE1)
  111. C
  112. DO KE1=NFACE10,JE1,-1
  113. BLFA(1,KE1+1)=BLFA(1,KE1)
  114. BLFA(2,KE1+1)=BLFA(2,KE1)
  115. ENDDO
  116. C ON MODIFIE LES INDICES DE LA FUTURE FACE COURRANTE (JE1+1)
  117. C
  118. BLFA(1,JE1+1)=IE2
  119. BLFA(2,JE1+1)=JE2+1
  120. GOTO 1
  121. ENDIF
  122. C
  123. IF(ICAS.EQ.4)THEN
  124. C
  125. C DANS LE CAS 4 ON SUBSTITUE A LA FACE COURRANTE NFACE3 FACES
  126. C (intersection interne) ET ON AJOUTE NFACE4 FACES (intersection
  127. C externe et coalescence de trou). LES NFACE3 DOIVENT ETRE SAUTEES
  128. C LES NFACE4 NOUVELLES DOIVENT ETRE TRAITEES A PARTIR DES INDICES
  129. C COURRANTS.
  130. C
  131. C AJOUT DES NFACE3 FACES: SHIFT D'INDICES
  132. NFACE3=VWORK3.FWWORK(/1)
  133. NFACE=NFACE1+NFACE3-1
  134. SEGADJ,VWORK1
  135. IF(NFACE.GE.JE1+NFACE3)THEN
  136. DO KE1=NFACE,JE1+NFACE3,-1
  137. VWORK1.FWWORK(KE1)=VWORK1.FWWORK(KE1-NFACE3+1)
  138. ENDDO
  139. ENDIF
  140. C AJOUT DES NFACE3 FACES: AJOUT EFFECTIFS
  141. DO KE1=1,NFACE3
  142. VWORK1.FWWORK(JE1-1+KE1)=VWORK3.FWWORK(KE1)
  143. ENDDO
  144. SEGSUP,VWORK3
  145. C AJOUT DES NFACE3 FACES A LA FIN
  146. NFACE4=VWORK4.FWWORK(/1)
  147. CALL J3VPLU(VWORK1,VWORK4)
  148. NFACE1=VWORK1.FWWORK(/1)
  149. FWWORK(IE1)=VWORK1
  150. C GESTION DES LIMITES
  151. IF(NFACE1.GT.NFAMA)THEN
  152. NFAMA=NFAMA+50
  153. SEGADJ,FUSE
  154. ENDIF
  155. IF(NFACE.GE.JE1+NFACE3)THEN
  156. DO KE1=NFACE,JE1+NFACE3,-1
  157. BLFA(1,KE1)=BLFA(1,KE1-NFACE3+1)
  158. BLFA(2,KE1)=BLFA(2,KE1-NFACE3+1)
  159. ENDDO
  160. ENDIF
  161. DO KE1=NFACE1-NFACE4+1,NFACE1
  162. BLFA(1,KE1)=IE2
  163. BLFA(2,KE1)=JE2+1
  164. ENDDO
  165. C
  166. JE1=JE1+NFACE3-1
  167. GOTO 1
  168. ENDIF
  169. C
  170. 10 CONTINUE
  171. BLFA(2,JE1)=1
  172. 11 CONTINUE
  173. C
  174. GOTO 1
  175. 2 CONTINUE
  176. C
  177. ENDDO
  178. C
  179. SEGSUP,FUSE
  180. C
  181. RETURN
  182. END
  183.  
  184.  
  185.  

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