Télécharger rgbase.eso

Retour à la liste

Numérotation des lignes :

  1. C RGBASE SOURCE CHAT 09/10/09 21:23:01 6519
  2. SUBROUTINE RGBASE(IPOI2,IRIG,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C CE SUBROUTINE ENCHAINE LES CALCULS DES RIGIDITES SUIVANTES :
  7. C . RIGIDITE DUES AUX MODES (MN OU KN) ....RGMODE
  8. C . COUPLAGE MODE-LIAISONS ....RGLIMO
  9. C . COUPLAGE LIAISONS-LIAISONS ....RGLILI
  10. C LE RESULTAT EST MIS DANS IRET
  11. C
  12. C PROGRAMME PAR FARVACQUE
  13. C APPELE PAR RIGI
  14. C APPELLE RGLIMO FUSRIG RGLILI RIGMOD
  15. C=======================================================================
  16. -INC CCOPTIO
  17. -INC SMRIGID
  18. -INC SMBASEM
  19. -INC SMSOLUT
  20. -INC SMSTRUC
  21. -INC SMATTAC
  22. C
  23. SEGMENT LIAT(NBASE)
  24. SEGMENT LRAT(0)
  25. C
  26. KRIGI=0
  27. LRAT=0
  28. IFLAT=0
  29. LIAT=0
  30. MBASEM=IPOI2
  31. SEGACT MBASEM
  32. NBASE=LISBAS(/1)
  33. C
  34. C ON TRAITE D ABORD LES OBJETS ATTACHE
  35. C ON ENVOIT A RGMATT UN ATTACHE OU LES RIGIDITES SONT TOUTES
  36. C DIFFERENTES POUR NE PAS COMPTER PLUSIEURS FOIS LE MEME TERME
  37. C
  38. IF(IRIG.NE.2) GOTO 100
  39. SEGINI LIAT
  40. NLIA=0
  41. DO 10 IA=1,NBASE
  42. MSOBAS=LISBAS(IA)
  43. SEGACT MSOBAS
  44. IF(IBSTRM(4).EQ.0) GO TO 12
  45. DO 11 IAT=1,NLIA
  46. IF(IBSTRM(4).EQ.LIAT(IAT)) GO TO 12
  47. 11 CONTINUE
  48. LIAT(NLIA)=IBSTRM(4)
  49. 12 CONTINUE
  50. SEGDES MSOBAS
  51. 10 CONTINUE
  52. IF(NLIA.EQ.0) GO TO 100
  53. IF(NLIA.EQ.1) THEN
  54. KATTAC=LIAT(1)
  55. GO TO 19
  56. ENDIF
  57. C
  58. SEGINI LRAT
  59. DO 13 JAT=1,NLIA
  60. MATTAC=LIAT(JAT)
  61. SEGACT MATTAC
  62. DO 16 JJAT=1,LISATT(/1)
  63. MSOUMA=LISATT(JJAT)
  64. SEGACT MSOUMA
  65. DO 14 KAT=1,IPMATK(/1)
  66. IF(IPMATK(KAT).EQ.0)GO TO 14
  67. DO 15 LAT=1,LRAT(/1)
  68. IF(IPMATK(KAT).EQ.LRAT(LAT))GO TO 14
  69. 15 CONTINUE
  70. LRAT(**)=IPMATK(KAT)
  71. 14 CONTINUE
  72. SEGDES MSOUMA
  73. 16 CONTINUE
  74. SEGDES MATTAC
  75. 13 CONTINUE
  76. C
  77. C ON CREE L ATTACHE SI BESOIN
  78. C
  79. IFLAT=1
  80. N=1
  81. SEGINI MATTAC
  82. KATTAC=MATTAC
  83. N=0
  84. M=LRAT(/1)
  85. SEGINI MSOUMA
  86. LISATT(1)=MSOUMA
  87. ITYATT='MECA'
  88. IGEOCH=0
  89. IPHYCH=0
  90. DO 18 NLI=1,M
  91. IPMATK(NLI)=LRAT(NLI)
  92. 18 CONTINUE
  93. C
  94. C MATTAC ET MSOUMA SEGDESES DANS RGMATT
  95. C
  96. 19 CONTINUE
  97. CALL RGMATT(KATTAC,KRIG)
  98. KRIGI=KRIG
  99. C
  100. 100 CONTINUE
  101. IF(LIAT.NE.0)SEGSUP LIAT
  102. IF(LRAT.NE.0)SEGSUP LRAT
  103. IF(IFLAT.NE.0)CALL DTMATT(KATTAC)
  104. DO 1 IB=1,NBASE
  105. MSOBAS=LISBAS(IB)
  106. SEGACT MSOBAS
  107. ISTRU=IBSTRM(1)
  108. IMODE=IBSTRM(2)
  109. ISOLS=IBSTRM(3)
  110. IF(ISOLS.EQ.0) GO TO 4
  111. IF(IMODE.EQ.0) GO TO 1032
  112. IF(IRIG.EQ.2) GO TO 1032
  113. CALL RGLIMO(IMODE,ISOLS,ISTRU,IRIG,KRIG)
  114. IF(IERR.NE.0) GO TO 2000
  115. IF(KRIG.EQ.0) GO TO 1032
  116. IF(KRIGI.EQ.0) THEN
  117. KRIGI=KRIG
  118. ELSE
  119. CALL FUSRIG(KRIGI,KRIG,IRET)
  120. MRIGID=KRIGI
  121. SEGSUP MRIGID
  122. KRIGI=IRET
  123. ENDIF
  124. 1032 CALL RGLILI(ISOLS,ISTRU,IRIG,KRIG)
  125. IF(IERR.NE.0) GO TO 2000
  126. IF(KRIG.EQ.0) GO TO 4
  127. IF(KRIGI.EQ.0) THEN
  128. KRIGI=KRIG
  129. ELSE
  130. CALL FUSRIG(KRIGI,KRIG,IRET)
  131. MRIGID=KRIGI
  132. SEGSUP MRIGID
  133. KRIGI=IRET
  134. ENDIF
  135. 4 CONTINUE
  136. IF(IMODE.EQ.0) GO TO 1036
  137. CALL RIGMOD(IMODE,IRIG,KRIG)
  138. IF(IERR.NE.0) GO TO 2000
  139. IF(KRIGI.EQ.0) THEN
  140. KRIGI=KRIG
  141. ELSE
  142. CALL FUSRIG(KRIGI,KRIG,IRET)
  143. MRIGID=KRIGI
  144. SEGSUP MRIGID
  145. KRIGI=IRET
  146. ENDIF
  147. 1036 CONTINUE
  148. SEGDES MSOBAS
  149. 1 CONTINUE
  150. SEGDES MBASEM
  151. C
  152. IRET=KRIGI
  153. 2000 CONTINUE
  154. RETURN
  155. END
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  

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