Télécharger dual00.eso

Retour à la liste

Numérotation des lignes :

  1. C DUAL00 SOURCE BP208322 16/11/18 21:16:33 9177
  2.  
  3. SUBROUTINE dual00(mrigid,ri1)
  4. C a appeler dual ulterieurement
  5. c====================================================================
  6. c
  7. c entrees
  8. c mrigid rigidité [C] de dependance rela depend
  9. c sorties
  10. C ri1 [C] Transpose
  11. c
  12. c====================================================================
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8(A-H,O-Z)
  15.  
  16. -INC CCOPTIO
  17. -INC CCGEOME
  18. -INC CCHAMP
  19. -INC SMRIGID
  20.  
  21. character*4 NOMM
  22.  
  23. segment snomip
  24. character*4 nomip(lnomip), nompi(lnomip)
  25. endsegment
  26. segment snomda
  27. character*4 nomda(lnomda), nompa(lnomda)
  28. endsegment
  29.  
  30. C on en profite pour recenser les inconnues en question (primales)
  31. lnomip = 200
  32. lnomda = 200
  33. segini,snomip,snomda
  34. inomip = 0
  35. inomda = 0
  36.  
  37. segact mrigid
  38. nrigel = IRIGEL(/2)
  39.  
  40. DO 1501 I=1, NRIGEL
  41. DESCR=IRIGEL(3,I)
  42. SEGACT DESCR
  43. C attention ces matrices ne sont pas carrees il faut 2 boucles
  44. C pour identifier les inconnues
  45. DO 1402 J=1,LISINC(/2)
  46. NOMM = LISINC(J)
  47. DO 1406 K=1,inomip
  48. IF (NOMM.EQ.nomip(K)) GO TO 1405
  49. 1406 CONTINUE
  50. IF (inomip.EQ.lnomip) THEN
  51. lnomip = lnomip + 200
  52. segadj,snomip
  53. ENDIF
  54. inomip = inomip + 1
  55. nomip(inomip)=NOMM
  56. 1405 CONTINUE
  57. 1402 CONTINUE
  58. C
  59. DO 1502 J=1,LISDUA(/2)
  60. NOMM = LISDUA(J)
  61. DO 1506 K=1,inomda
  62. IF (NOMM.EQ.nomda(K)) GO TO 1505
  63. 1506 CONTINUE
  64. IF (inomda.EQ.lnomda) THEN
  65. lnomda = lnomda + 200
  66. segadj,snomda
  67. ENDIF
  68. inomda = inomda + 1
  69. nomda(inomda)=NOMM
  70. 1505 CONTINUE
  71. 1502 CONTINUE
  72.  
  73. 1501 CONTINUE
  74.  
  75. C tableau des correspondances
  76.  
  77. do 325 il=1,inomip
  78. NOMM =nomip(IL)
  79. do 326 in = 1,lnomdd
  80. if (NOMM.EQ.NOMDD(in)) then
  81. NOMPI(il) =NOMDU(in)
  82. goto 327
  83. endif
  84. 326 continue
  85. C nompi(il) = ' '
  86. nompi(il) = NOMM
  87. 327 continue
  88. 325 continue
  89.  
  90. do 425 il=1,inomda
  91. NOMM =nomda(IL)
  92. do 426 in = 1,lnomdd
  93. if (NOMM.EQ.NOMDD(in)) then
  94. NOMPA(il) =NOMDU(in)
  95. goto 427
  96. endif
  97. 426 continue
  98. C nompa(il) = ' '
  99. nompa(il) = NOMM
  100. 427 continue
  101. 425 continue
  102.  
  103. C write(ioimp,*) 'primales',(nomip(j),j=1,inomip),'sortie ' ,
  104. C & ( nompi(j),j=1,inomip)
  105. C write(ioimp,*) 'duales ',(nomda(j),j=1,inomda),'sortie ' ,
  106. C & ( nompa(j),j=1,inomda)
  107.  
  108. C on stoke le ddel en question en position ad-hoc
  109.  
  110. segini , ri1=mrigid
  111.  
  112. do 1700 ima=1,NRIGEL
  113.  
  114. descr = irigel(3,ima)
  115.  
  116. nligrp = lisdua(/2)
  117. nligrd = lisinc(/2)
  118. segini,des1
  119. ri1.irigel(3,ima) = des1
  120. C
  121. do 1634 ik=1,nligrd
  122. nomm = lisinc(ik)
  123. do 1635 ij=1,inomip
  124. if(NOMM.eq.NOMIP(ij)) des1.lisdua(ik) = nompi(ij)
  125. 1635 continue
  126. des1.noeled(ik)=noelep(ik)
  127. 1634 continue
  128.  
  129. do 1644 ik=1,nligrp
  130. nomm = lisdua(ik)
  131. do 1645 ij=1,inomda
  132. if(NOMM.eq.NOMDA(ij)) des1.lisinc(ik) = nompa(ij)
  133. 1645 continue
  134. des1.noelep(ik)=noeled(ik)
  135. 1644 continue
  136.  
  137. segdes,descr,des1
  138.  
  139. 1700 continue
  140.  
  141. segdes ri1,mrigid
  142.  
  143. segsup,snomip,snomda
  144.  
  145. RETURN
  146. END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  

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