Télécharger kmors.eso

Retour à la liste

Numérotation des lignes :

  1. C KMORS SOURCE PV 16/11/17 21:59:49 9180
  2. SUBROUTINE KMORS(ASSTAB,MATRIK,LL)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C ***********************************************
  6. C * Routine de remplissage du tableau de ASSTAB *
  7. C * avec le profil de MATRIK. *
  8. C * Entree/sortie : MATRIK *
  9. C * Sortie : ASSTAB *
  10. C ***********************************************
  11.  
  12.  
  13. -INC SMELEME
  14. POINTEUR MELEMP.MELEME,MELEMD.MELEME
  15. POINTEUR SPGD.MELEME
  16. -INC SMLENTI
  17. POINTEUR IPADP.MLENTI,IPADD.MLENTI
  18.  
  19. SEGMENT ASSTAB
  20. INTEGER ITAB(NBCOMP,NTA)
  21. ENDSEGMENT
  22.  
  23. INTEGER PRI,DUA
  24.  
  25. C *********************************
  26. C On active le segment MATRIK et on
  27. C pointe sur tous les elements dont
  28. C on a besoin
  29. C *********************************
  30.  
  31. SEGACT MATRIK
  32. MELEMP=IRIGEL(1,LL)
  33. MELEMD=IRIGEL(2,LL)
  34.  
  35. C On prend le segment IMATRI
  36. IMATRI=IRIGEL(4,LL)
  37. SEGACT IMATRI
  38. NBSOUS=LIZAFM(/1)
  39. IF (NBSOUS.EQ.0) NBSOUS=1
  40.  
  41. C Le support dual contient le nombre de ligne de la matrice
  42. C pour une variable scalaire uniquement
  43. SPGD=KSPGD
  44. SEGACT SPGD
  45. NBCOMP=10
  46. NTA=SPGD.NUM(/2)
  47. SEGDES SPGD
  48.  
  49. C On initialise ASSTAB
  50. SEGINI ASSTAB
  51. IPT1=MELEMP
  52. IPT2=MELEMD
  53.  
  54. C On active les connectivites primales et duales pour
  55. C prendre les NBSOUS1 et NBSOUS2
  56. SEGACT MELEMP,MELEMD
  57. NBSOUS1=MELEMP.LISOUS(/1)
  58. NBSOUS2=MELEMD.LISOUS(/1)
  59. IF (NBSOUS1.EQ.0) NBSOUS1=1
  60. IF (NBSOUS2.EQ.0) NBSOUS2=1
  61.  
  62. NBEL1=0
  63. NBEL2=0
  64. NTTD=0
  65.  
  66. DO L=1,NBSOUS
  67. C Si NBSOUS n est pas egal a 1 c est que l on est en
  68. C multi-elements cependant, il se peut que les connectivites
  69. C (aucune, une seule ou les deux) soit un support (par
  70. C exemple l inconue primale est sur les CENTRE). Dans ce cas
  71. C le MELEME n'a pas de LISOUS.
  72. IF (NBSOUS.NE.1) THEN
  73. IF (NBSOUS1.NE.1) THEN
  74. IPT1=MELEMP.LISOUS(L)
  75. END IF
  76. IF (NBSOUS2.NE.1) THEN
  77. IPT2=MELEMD.LISOUS(L)
  78. END IF
  79. END IF
  80.  
  81. CALL KRIPAD(IPT1,IPADP)
  82. CALL KRIPAD(IPT2,IPADD)
  83.  
  84. SEGACT IPT1,IPT2
  85. SEGACT IPADP,IPADD
  86.  
  87. NP=IPT1.NUM(/1)
  88. MP=IPT2.NUM(/1)
  89.  
  90. C Il faut faire attention pour le nombre d elements
  91. IF (NBSOUS.EQ.1) THEN
  92. NBEL=IPT1.NUM(/2)
  93. ELSE
  94. IF (NBSOUS1.NE.1) THEN
  95. NBEL=IPT1.NUM(/2)
  96. ELSEIF (NBSOUS2.NE.1) THEN
  97. NBEL=IPT2.NUM(/2)
  98. END IF
  99. END IF
  100.  
  101. DO K=1,NBEL
  102. DO I=1,NP
  103. DO J=1,MP
  104. IF (NBSOUS.EQ.1) THEN
  105. PRI=IPADP.LECT(IPT1.NUM(I,K))
  106. DUA=IPADD.LECT(IPT2.NUM(J,K))
  107. ELSE
  108. IF (NBSOUS1.NE.1) THEN
  109. PRI=IPADP.LECT(IPT1.NUM(I,K))
  110. ELSE
  111. PRI=IPADP.LECT(IPT1.NUM(I,NBEL1+K))
  112. END IF
  113. IF (NBSOUS2.NE.1) THEN
  114. DUA=IPADD.LECT(IPT2.NUM(J,K))
  115. ELSE
  116. DUA=IPADD.LECT(IPT2.NUM(J,NBEL2+K))
  117. END IF
  118. END IF
  119. NTTD=MAX(NTTD,DUA)
  120.  
  121. NB=ITAB(1,DUA)
  122. 100 CONTINUE
  123. IF (NB+2.GT.NBCOMP) THEN
  124. NBCOMP=NBCOMP+10
  125. SEGADJ ASSTAB
  126. GOTO 100
  127. END IF
  128.  
  129. IFLAG=0
  130. DO II=1,NB
  131. IF (ITAB(II+1,DUA).EQ.PRI) THEN
  132. IFLAG=1
  133. END IF
  134. END DO
  135.  
  136. IF (IFLAG.EQ.0) THEN
  137. ITAB(1,DUA)=NB+1
  138. ITAB(NB+2,DUA)=PRI
  139. END IF
  140.  
  141. END DO
  142. END DO
  143. END DO
  144.  
  145. NBEL1=NBEL1+NBEL
  146. NBEL2=NBEL2+NBEL
  147. SEGDES IPADP,IPADD
  148. SEGDES IPT1,IPT2
  149. END DO
  150.  
  151. DO I=1,NTTD
  152. CALL ORDOTA(ITAB(2,I),ITAB(1,I))
  153. END DO
  154.  
  155. SEGDES ASSTAB
  156. SEGDES MELEMP,MELEMD
  157. SEGDES IMATRI
  158. SEGDES MATRIK
  159. END
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  

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