

Télécharger avtrsf.eso

Retour à la liste

Numérotation des lignes :

  1. C AVTRSF SOURCE CHAT 05/01/12 21:30:58 5004
  2. C CE SOUS PROGRAMME FABRIQUE LE SEGMENT FER OU SONT MISE EN FORME
  3. C LES DONNEES DE TRANSF
  4. C
  5. SUBROUTINE AVTRSF(MELEME,FER,IPT5)
  6. C
  7. C MELEME = OBJET A EXPLORER
  8. C FER = DONNEES MISES EN FORME
  9. C IPT5 = OBJET DANS LA NUMEROTATION DE FER
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8 (A-H,O-Z)
  12. -INC CCOPTIO
  13. -INC SMELEME
  14. -INC SMCOORD
  15. SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR),AFER.FER
  16. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  17. SEGMENT IDCP(ITE)
  18. SEGMENT KON(NBCON,NMAX)
  19. SEGMENT IDCT(ITT)
  20. SEGINI ICPR
  21. DO 1 I=1,ICPR(/1)
  22. 1 ICPR(I)=0
  23. C REMPLISSAGE DE ICPR
  24. IT=0
  25. ITE=0
  26. SEGACT MELEME
  27. NBELEM=NUM(/2)
  28. NBNN=NUM(/1)
  29. NBSOUS=0
  30. NBREF=0
  31. ITT=(2+NBNN)*NBELEM
  32. IPP=NBELEM
  33. SEGINI FER
  34. IF (ITYPEL.EQ.2) IPT5=0
  35. IF (IPT5.EQ.0) GOTO 8
  36. SEGINI IPT5
  37. IPT5.ITYPEL=ITYPEL
  38. DO 7 J=1,NBELEM
  39. IT=IT+1
  40. ITE=ITE+1
  41. NFI(IT)=NUM(2,J)
  42. ICPR(NUM(2,J))=ITE
  43. 7 CONTINUE
  44. 8 CONTINUE
  45. DO 2 J=1,NBNN
  46. DO 2 K=1,NBELEM
  47. IPOIT=NUM(J,K)
  48. IF (ICPR(IPOIT).NE.0) GOTO 2
  49. ITE=ITE+1
  50. ICPR(IPOIT)=ITE
  51. 2 CONTINUE
  52. C TABLEAU INVERSE
  53. SEGINI IDCP
  54. ILO=XCOOR(/1)/(IDIM+1)
  55. DO 3 I=1,ILO
  56. II=ILO+1-I
  57. IF (ICPR(II).NE.0) IDCP(ICPR(II))=II
  58. 3 CONTINUE
  59. C ITE EST LE NOMBRE DE POINTS A TRACER ICPR LE TABLEAU
  60. C ON VA MAINTENANT INITIALISER ET REMPLIR LE TABLEAU DES CONNECTIONS
  61. NBCON=3
  62. NBCONR=NBCON-1
  63. NMAX=(5*ITE)/NBCON
  64. SEGINI KON
  65. C MISE A ZERO DU TABLEAU KON
  66. DO 10 I=1,NMAX
  67. DO 10 J=1,NBCON
  68. 10 KON(J,I)=0
  69. C FABRICATION DU TABLEAU DES CONNECTIONS
  70. ICHAIN=ITE
  71. DO 20 I=1,NUM(/2)
  72. N1=ICPR(NUM(1,I))
  73. N2=ICPR(NUM(NBNN,I))
  74. IF (N1.EQ.N2) GOTO 31
  75. ISENS=1
  76. NI=N1
  77. NJ=N2
  78. 21 CONTINUE
  79. 22 DO 23 K=1,NBCONR
  80. IF (ABS(KON(K,NI)).EQ.NJ) GOTO 31
  81. IF (KON(K,NI).EQ.0) GOTO 25
  82. 23 CONTINUE
  83. IF (KON(NBCON,NI).EQ.0) GOTO 24
  84. NI=KON(NBCON,NI)
  85. GOTO 22
  86. 24 ICHAIN=ICHAIN+1
  87. IF (ICHAIN.EQ.NMAX) GOTO 30
  88. KON(NBCON,NI)=ICHAIN
  89. K=1
  90. NI=ICHAIN
  91. 25 KON(K,NI)=NJ*ISENS
  92. IF (ISENS.LE.0) GOTO 20
  93. NI=N2
  94. NJ=N1
  95. ISENS=-1
  96. GOTO 21
  97. 20 CONTINUE
  98. C FABRICATION DES CONTOURS
  99. IP=0
  100. MAI(1)=IT
  101. KAUX=1
  102. 40 KAUXR=KAUX
  103. K=KAUX
  104. KPRESS=KAUXR
  105. 41 DO 42 KL=1,NBCONR
  106. ITRA=KON(KL,K)
  107. IF (ITRA.LE.0) GOTO 42
  108. GOTO 44
  109. 42 CONTINUE
  110. K=KON(NBCON,K)
  111. IF (K.NE.0) GOTO 41
  112. 43 KAUX=KAUX+1
  113. IF (KAUX.EQ.ITE+1) GOTO 60
  114. GOTO 40
  115. 44 IT=IT+1
  116. NFI(IT)=IDCP(KAUXR)
  117. GOTO 46
  118. 45 KL=1
  119. 46 DO 47 L=KL,NBCONR
  120. M=ABS(KON(L,K))
  121. IF (M.EQ.0) GOTO 47
  122. GOTO 48
  123. 47 CONTINUE
  124. K=KON(NBCON,K)
  125. IF (K.EQ.0) GOTO 31
  126. GOTO 45
  127. 48 IT=IT+1
  128. NFI(IT)=IDCP(M)
  129. KON(L,K)=0
  130. M1=M
  131. 49 DO 50 L=1,NBCONR
  132. IF (KON(L,M1).EQ.0) GOTO 50
  133. IF (ABS(KON(L,M1)).EQ.KPRESS) GOTO 51
  134. 50 CONTINUE
  135. M1=KON(NBCON,M1)
  136. GOTO 49
  137. 51 KON(L,M1)=0
  138. IF (M.EQ.KAUXR) GOTO 52
  139. GOTO 45
  140. 52 IT=IT-1
  141. IP=IP+1
  142. MAI(IP+1)=IT
  143. GOTO 40
  144. 60 CONTINUE
  145. ITOUR=IP
  146. IF (IPT5.EQ.0) GOTO 70
  147. SEGINI IDCT
  148. DO 71 I=1,IT
  149. IDCT(ICPR(NFI(I)))=I
  150. 71 CONTINUE
  151. DO 72 I=1,NBNN
  152. DO 72 J=1,NBELEM
  153. IPT5.NUM(I,J)=IDCT(ICPR(NUM(I,J)))
  154. 72 CONTINUE
  155. SEGSUP IDCT
  156. 70 CONTINUE
  157. SEGSUP KON,ICPR,IDCP
  158. RETURN
  159. 30 CALL ERREUR(23)
  160. RETURN
  161. 31 CALL ERREUR(28)
  162. RETURN
  163. END
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  

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