Télécharger dual01.eso

Retour à la liste

Numérotation des lignes :

  1. C DUAL01 SOURCE BP208322 15/06/22 21:17:10 8543
  2. SUBROUTINE dual01(mrigid,ri1)
  3. C a appeler dual ulterieurement
  4. c====================================================================
  5. c
  6. c entrees
  7. c mrigid rigidité [C] de dependance rela depend
  8. c sorties
  9. C ri1 [C] Transpose non symétrique
  10. C La différence par rapport à dual00, c'est que la matrice à
  11. C transposer n'est pas nécessairement symétrique.
  12. c
  13. c====================================================================
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8(A-H,O-Z)
  16. CHARACTER*4 CMOT
  17. *
  18. -INC SMRIGID
  19. -INC SMELEME
  20. -INC CCHAMP
  21. character*4 NOMM,NODUA
  22.  
  23. segment snomip
  24. character*4 nomip(0)
  25. endsegment
  26. segment snomda
  27. character*4 nomda(0)
  28. endsegment
  29.  
  30. segment snomm
  31. character*4 nompi(nomip(/2)),nompa(nomda(/2))
  32. endsegment
  33.  
  34. SEGACT MRIGID
  35.  
  36. C on en profite pour recenser les inconnues en question (primales)
  37. C a voir
  38. segini snomip,snomda
  39. segact mrigid
  40.  
  41. DO 1501 I=1,IRIGEL(/2)
  42. * MELEME=IRIGEL(1,I)
  43. * SEGACT MELEME
  44. DESCR=IRIGEL(3,I)
  45. SEGACT DESCR
  46. C attention ces matrices ne sont pas carrees il faut 2 boucles
  47. C pour identifier les inconnues
  48.  
  49. DO 1402 J=1,LISINC(/2)
  50. IF(nomip(/2).EQ.0) THEN
  51. nomip(**)=LISINC(J)
  52. ELSE
  53. DO 1406 K=1,nomip(/2)
  54. IF(LISINC(J).EQ.nomip(K)) GO TO 1405
  55. 1406 CONTINUE
  56. nomip(**)=LISINC(J)
  57. 1405 CONTINUE
  58. ENDIF
  59. 1402 CONTINUE
  60. C
  61. DO 1502 J=1,LISDUA(/2)
  62. IF(nomda(/2).EQ.0) THEN
  63. nomda(**)=LISDUA(J)
  64. ELSE
  65. DO 1506 K=1,nomda(/2)
  66. IF(LISDUA(J).EQ.nomda(K)) GO TO 1505
  67. 1506 CONTINUE
  68. nomda(**)=LISDUA(J)
  69. 1505 CONTINUE
  70. ENDIF
  71. 1502 CONTINUE
  72.  
  73. 1501 CONTINUE
  74.  
  75. C tableau des correspondances
  76.  
  77. segini snomm
  78.  
  79. do 325 il=1,nomip(/2)
  80. NOMM =nomip(IL)
  81. do 326 in = 1,lnomdd
  82. if (NOMM.EQ.NOMDD(in)) then
  83. NOMPI(il) =NOMDU(in)
  84. goto 327
  85. endif
  86. 326 continue
  87. NOMPI(il)=NOMM
  88. 327 continue
  89. 325 continue
  90.  
  91. do 425 il=1,nomda(/2)
  92. NOMM =nomda(IL)
  93. do 426 in = 1,lnomdd
  94. if (NOMM.EQ.NOMDU(in)) then
  95. NOMPA(il) =NOMDD(in)
  96. goto 427
  97. endif
  98. 426 continue
  99. NOMPA(il)=NOMM
  100. 427 continue
  101. 425 continue
  102.  
  103.  
  104. * write(6,*) 'primales',(nomip(j),j=1,nomip(/2)),'sortie ' ,
  105. * & ( nompi(j),j=1,nompi(/2))
  106. *
  107. *
  108. * write(6,*) 'duales ',(nomda(j),j=1,nomda(/2)),'sortie ' ,
  109. * & ( nompa(j),j=1,nompa(/2))
  110.  
  111. C on stoke le ddel en question en position ad-hoc
  112.  
  113. nrigel=coerig(/1)
  114. segini , ri1
  115. * segini , ri1=mrigid
  116.  
  117. do 1700 ima=1,IRIGEL(/2)
  118. ri1.mtymat=mtymat
  119. ri1.coerig(ima)=coerig(ima)
  120. do 1750 iri =1,irigel(/1)
  121. if(iri.eq.3.or.iri.eq.4) goto 1750
  122. ri1.irigel(iri,ima)= IRIGEL(iri,ima)
  123. 1750 continue
  124.  
  125. descr = irigel(3,ima)
  126.  
  127. nligrp = lisdua(/2)
  128. nligrd = lisinc(/2)
  129. segini des1
  130. ri1.irigel(3,ima) = des1
  131. C
  132. do 1634 ik=1,lisinc(/2)
  133. nomm = lisinc(ik)
  134. do 1635 ij=1,nomip(/2)
  135. if(NOMM.eq.NOMIP(ij)) des1.lisdua(ik) = nompi(ij)
  136. 1635 continue
  137. des1.noeled(ik)=noelep(ik)
  138. 1634 continue
  139.  
  140. do 1644 ik=1,lisdua(/2)
  141. nomm = lisdua(ik)
  142. do 1645 ij=1,nomda(/2)
  143. if(NOMM.eq.NOMDA(ij)) des1.lisinc(ik) = nompa(ij)
  144. 1645 continue
  145. des1.noelep(ik)=noeled(ik)
  146. 1644 continue
  147. segdes des1,descr
  148.  
  149. if (irigel(7,ima).ne.0.or.nligrp.ne.nligrd) then
  150. XMATRI = IRIGEL(4,ima)
  151. segact XMATRI
  152. NELRIG=XMATRI.RE(/3)
  153. SEGINI xmatr1
  154. do i=1,nelrig
  155. do j=1,nligrp
  156. do k=1,nligrd
  157. xmatr1.re(k,j,i)=re(j,k,i)
  158. enddo
  159. enddo
  160. enddo
  161. segdes xmatr1,xmatri
  162. ri1.irigel(4,ima)=xmatr1
  163. else
  164. ri1.irigel(4,ima)=irigel(4,ima)
  165. endif
  166. 1700 continue
  167.  
  168. segdes ri1,mrigid
  169.  
  170. segsup ,snomm,snomip,snomda
  171.  
  172. RETURN
  173. END
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  

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