Télécharger assmor.eso

Retour à la liste

Numérotation des lignes :

  1. C ASSMOR SOURCE PV 16/11/17 21:58:16 9180
  2. SUBROUTINE ASSMOR(MATRIK,LL)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. -INC SMELEME
  7. POINTEUR MELEMP.MELEME,MELEMD.MELEME
  8. -INC SMLENTI
  9. POINTEUR IPADP.MLENTI,IPADD.MLENTI
  10.  
  11. INTEGER PRI,DUA,LI,CO
  12.  
  13. C *********************************
  14. C On active le segment MATRIK et on
  15. C pointe sur tous les elements dont
  16. C on a besoin
  17. C *********************************
  18.  
  19. SEGACT MATRIK*MOD
  20. MELEMP=IRIGEL(1,LL)
  21. MELEMD=IRIGEL(2,LL)
  22. PMORS=IRIGEL(5,LL)
  23. SEGACT PMORS
  24. NBVA=JA(/1)
  25. SEGINI IZA
  26.  
  27. C On recupere les segment MINCP et MINCD
  28. MINCP=KMINCP
  29. MINCD=KMINCD
  30.  
  31. SEGACT MINCP,MINCD
  32. NPTP=MINCP.MPOS(/1)
  33. NPTD=MINCD.MPOS(/1)
  34. NBIP=MINCP.MPOS(/2)-1
  35. NBID=MINCD.MPOS(/2)-1
  36.  
  37. C On prend le segment IMATRI
  38. IMATRI=IRIGEL(4,LL)
  39. SEGACT IMATRI
  40. NBSOUS=LIZAFM(/1)
  41. NBME=LIZAFM(/2)
  42. IF (NBSOUS.EQ.0) NBSOUS=1
  43.  
  44. IPT1=MELEMP
  45. IPT2=MELEMD
  46.  
  47. C On active les connectivites primales et duales pour
  48. C prendre les NBSOUS1 et NBSOUS2
  49. SEGACT MELEMP,MELEMD
  50. NBSOUS1=MELEMP.LISOUS(/1)
  51. NBSOUS2=MELEMD.LISOUS(/1)
  52. IF (NBSOUS1.EQ.0) NBSOUS1=1
  53. IF (NBSOUS2.EQ.0) NBSOUS2=1
  54.  
  55. NBEL1=0
  56. NBEL2=0
  57.  
  58. DO L=1,NBSOUS
  59. C Si NBSOUS n est pas egal a 1 c est que l on est en
  60. C multi-elements cependant, il se peut que les connectivites
  61. C (aucune, une seule ou les deux) soit un support (par
  62. C exemple l inconue primale est sur les CENTRE). Dans ce cas
  63. C le MELEME n'a pas de LISOUS.
  64. IF (NBSOUS.NE.1) THEN
  65. IF (NBSOUS1.NE.1) THEN
  66. IPT1=MELEMP.LISOUS(L)
  67. END IF
  68. IF (NBSOUS2.NE.1) THEN
  69. IPT2=MELEMD.LISOUS(L)
  70. END IF
  71. END IF
  72.  
  73. CALL KRIPAD(IPT1,IPADP)
  74. CALL KRIPAD(IPT2,IPADD)
  75.  
  76. SEGACT IPT1,IPT2
  77. SEGACT IPADP,IPADD
  78.  
  79. NP=IPT1.NUM(/1)
  80. MP=IPT2.NUM(/1)
  81.  
  82. C Il faut faire attention pour le nombre d elements
  83. IF (NBSOUS.EQ.1) THEN
  84. NBEL=IPT1.NUM(/2)
  85. ELSE
  86. IF (NBSOUS1.NE.1) THEN
  87. NBEL=IPT1.NUM(/2)
  88. ELSEIF (NBSOUS2.NE.1) THEN
  89. NBEL=IPT2.NUM(/2)
  90. END IF
  91. END IF
  92.  
  93. c WRITE(6,*) 'IRIGEL',IRIGEL(7,LL),NP,MP,NBEL
  94. c IF (IRIGEL(7,LL.EQ.5) THEN
  95. c DO NL=1,NBME
  96. c IZAFM=LIZAFM(L,NL)
  97. c SEGACT IZAFM
  98. c DO K=1,NBEL
  99. c IF (NBSOUS.EQ.1) THEN
  100. c PRI=IPADP.LECT(IPT1.NUM(1,K))
  101. c DUA=IPADD.LECT(IPT2.NUM(1,K))
  102. c ELSE
  103. c IF (NBSOUS1.NE.1) THEN
  104. c PRI=IPADP.LECT(IPT1.NUM(1,K))
  105. c ELSE
  106. c PRI=IPADP.LECT(IPT1.NUM(1,NBEL1+K))
  107. c END IF
  108. c IF (NBSOUS2.NE.1) THEN
  109. c DUA=IPADD.LECT(IPT2.NUM(1,K))
  110. c ELSE
  111. c DUA=IPADD.LECT(IPT2.NUM(1,NBEL2+K))
  112. c END IF
  113. c END IF
  114. c
  115. c WRITE(6,*) 'PRI',PRI,'DUA',DUA
  116. c
  117. c END DO
  118. c SEGDES IZAFM
  119. c END DO
  120. c ELSE
  121. DO NL=1,NBME
  122. IZAFM=LIZAFM(L,NL)
  123. SEGACT IZAFM
  124. DO K=1,NBEL
  125. DO I=1,NP
  126. DO J=1,MP
  127. IF (NBSOUS.EQ.1) THEN
  128. PRI=IPADP.LECT(IPT1.NUM(I,K))
  129. DUA=IPADD.LECT(IPT2.NUM(J,K))
  130. ELSE
  131. IF (NBSOUS1.NE.1) THEN
  132. PRI=IPADP.LECT(IPT1.NUM(I,K))
  133. ELSE
  134. PRI=IPADP.LECT(IPT1.NUM(I,NBEL1+K))
  135. END IF
  136. IF (NBSOUS2.NE.1) THEN
  137. DUA=IPADD.LECT(IPT2.NUM(J,K))
  138. ELSE
  139. DUA=IPADD.LECT(IPT2.NUM(J,NBEL2+K))
  140. END IF
  141. END IF
  142.  
  143. C NINCP et NINCD sont les numero des inconnues primales et
  144. C duale traite.
  145. IFLAG=0
  146. DO JJ=1,NBIP
  147. IF ((LISPRI(NL).EQ.MINCP.LISINC(JJ)).AND.
  148. & (IFLAG.EQ.0)) THEN
  149. IFLAG=1
  150. NINCP=JJ
  151. END IF
  152. END DO
  153.  
  154. IFLAG=0
  155. DO JJ=1,NBID
  156. IF ((LISDUA(NL).EQ.MINCD.LISINC(JJ)).AND.
  157. & (IFLAG.EQ.0)) THEN
  158. IFLAG=1
  159. NINCD=JJ
  160. END IF
  161. END DO
  162.  
  163. LI=MINCD.NPOS(DUA)+MINCD.MPOS(DUA,NINCD)-1
  164. CO=MINCP.NPOS(PRI)+MINCP.MPOS(PRI,NINCP)-1
  165. NB=IA(LI+1)-IA(LI)
  166.  
  167. M=IA(LI)
  168. c WRITE(6,*) 'LI',LI,'CO',CO,'M',M,'NB',NB
  169.  
  170. IFLAG=0
  171. DO KK=1,NB
  172. c WRITE(6,*) 'JA(',M+KK-1,')=',JA(M+KK-1)
  173. IF ((JA(M+KK-1).EQ.CO).AND.(IFLAG.EQ.0)) THEN
  174. IFLAG=1
  175. A(M+KK-1)=A(M+KK-1)+AM(K,I,J)
  176. M=M+KK-1
  177. END IF
  178. END DO
  179. c WRITE(6,*) 'AFFECT: M ',M
  180.  
  181. END DO
  182. END DO
  183. END DO
  184. SEGDES IZAFM
  185. END DO
  186. NBEL1=NBEL1+NBEL
  187. NBEL2=NBEL2+NBEL
  188. SEGDES IPADP,IPADD
  189. SEGDES IPT1,IPT2
  190. c END IF
  191. END DO
  192.  
  193. SEGDES MELEMP,MELEMD
  194. SEGDES IMATRI
  195. SEGDES MINCP,MINCD
  196. SEGDES IZA
  197. SEGDES PMORS
  198. IRIGEL(6,LL)=IZA
  199. SEGDES MATRIK
  200. RETURN
  201.  
  202. END
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  

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