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

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