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

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