Télécharger avtrsf.eso

Retour à la liste

Numérotation des lignes :

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

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