Télécharger difrig.eso

Retour à la liste

Numérotation des lignes :

  1. C DIFRIG SOURCE PASCAL 20/12/02 21:15:04 10798
  2. SUBROUTINE DIFRIG(IPRIG1,IPRIG2)
  3. C----------------------------------------------------------------------C
  4. C DIFFERENCE SYMETRIQUE ENTRE DEUX RIGIDITES.
  5. C
  6. C SYNTAXE : RIG1 = DIFF RIG2 RIG3
  7.  
  8. C Rq. : l'operation est faite sur les pointeurs des rigidites elem.
  9. C
  10. C ENTREES :
  11. C - IPRIG1 = RIG2
  12. C - IPRIG2 = RIG3
  13.  
  14. C SORTIE : le resultat est renvoye dans la pile.
  15. C
  16. C----------------------------------------------------------------------C
  17.  
  18. IMPLICIT INTEGER(I-N)
  19.  
  20. SEGMENT INTERI(NRI1)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMRIGID
  26.  
  27. C Activation de l'objet :
  28. RI1 = IPRIG1
  29. RI2 = IPRIG2
  30. SEGACT, RI1, RI2
  31.  
  32. C---- CAS RIGELE VIDE EN ARGUMENT ----C
  33.  
  34. NRE1 = RI1.IRIGEL(/2)
  35. IF (NRE1.EQ.0) THEN
  36. CALL ECROBJ('RIGIDITE',IPRIG2)
  37. RETURN
  38. ENDIF
  39.  
  40. NRE2 = RI2.IRIGEL(/2)
  41. IF (NRE2.EQ.0) THEN
  42. CALL ECROBJ('RIGIDITE',IPRIG1)
  43. RETURN
  44. ENDIF
  45.  
  46. C---- CAS GENERAL ----C
  47.  
  48. C Identification des rigidites elementaires communes (INTERI(i) = 1)
  49. C Deux rigidites sont communes si COERIG et tableau IRIGEL identiques
  50. NRC1 = 0
  51. NRI1 = NRE1 + NRE2
  52. SEGINI, INTERI
  53. DO 100 I1=1,NRE1
  54. COERI1 = RI1.COERIG(I1)
  55. IRIG11 = RI1.IRIGEL(1,I1)
  56. IRIG21 = RI1.IRIGEL(2,I1)
  57. IRIG31 = RI1.IRIGEL(3,I1)
  58. IRIG41 = RI1.IRIGEL(4,I1)
  59. IRIG51 = RI1.IRIGEL(5,I1)
  60. IRIG61 = RI1.IRIGEL(6,I1)
  61. IRIG71 = RI1.IRIGEL(7,I1)
  62. DO 110 I2=1,NRE2
  63. * write(6,*) ' rigidites I1, I2', I1, I2
  64. IF (INTERI(I1).NE.0) GOTO 100
  65. COERI2 = RI2.COERIG(I2)
  66. IF (COERI1.NE.COERI2) GOTO 111
  67. IRIG12 = RI2.IRIGEL(1,I2)
  68. IF (IRIG11.NE.IRIG12) GOTO 112
  69. IRIG22 = RI2.IRIGEL(2,I2)
  70. IF (IRIG21.NE.IRIG22) GOTO 113
  71. IRIG32 = RI2.IRIGEL(3,I2)
  72. IF (IRIG31.NE.IRIG32) GOTO 114
  73. IRIG42 = RI2.IRIGEL(4,I2)
  74. IF (IRIG41.NE.IRIG42) GOTO 115
  75. IRIG52 = RI2.IRIGEL(5,I2)
  76. IF (IRIG51.NE.IRIG52) GOTO 116
  77. IRIG62 = RI2.IRIGEL(6,I2)
  78. IF (IRIG61.NE.IRIG62) GOTO 117
  79. IRIG72 = RI2.IRIGEL(7,I2)
  80. IF (IRIG71.NE.IRIG72) GOTO 118
  81. INTERI(I1) = 1
  82. INTERI(NRE1+I2) = 1
  83. NRC1 = NRC1 + 1
  84. GOTO 110
  85. 111 CONTINUE
  86. * WRITE(6,*) 'COERIG'
  87. GOTO 110
  88. 112 CONTINUE
  89. * WRITE(6,*) 'IRIGEL 1'
  90. GOTO 110
  91. 113 CONTINUE
  92. * WRITE(6,*) 'IRIGEL 2'
  93. GOTO 110
  94. 114 CONTINUE
  95. * WRITE(6,*) 'IRIGEL 3'
  96. GOTO 110
  97. 115 CONTINUE
  98. * WRITE(6,*) 'IRIGEL 4'
  99. GOTO 110
  100. 116 CONTINUE
  101. * WRITE(6,*) 'IRIGEL 5'
  102. GOTO 110
  103. 117 CONTINUE
  104. * WRITE(6,*) 'IRIGEL 6'
  105. GOTO 110
  106. 118 CONTINUE
  107. * WRITE(6,*) 'IRIGEL 7'
  108. 110 CONTINUE
  109. 100 CONTINUE
  110.  
  111. * write(6,*) 'INTERI =',(INTERI(ii),ii=1,NRI1)
  112.  
  113. C Copie des parties non communes de chaque rigidite :
  114. C Copie 1ere rigidite
  115. IF (NRC1.EQ.0) THEN
  116. IPRIG3 = IPRIG1
  117. ELSE
  118. NRE3 = 0
  119. NRIGEL = NRE1
  120. SEGINI, RI3
  121. RI3.MTYMAT = RI1.MTYMAT
  122. DO 200 I1=1,NRE1
  123. IF (INTERI(I1).EQ.1) GOTO 200
  124. NRE3 = NRE3 + 1
  125. RI3.COERIG(NRE3) = RI1.COERIG(I1)
  126. RI3.IRIGEL(1,NRE3) = RI1.IRIGEL(1,I1)
  127. RI3.IRIGEL(2,NRE3) = RI1.IRIGEL(2,I1)
  128. RI3.IRIGEL(3,NRE3) = RI1.IRIGEL(3,I1)
  129. RI3.IRIGEL(4,NRE3) = RI1.IRIGEL(4,I1)
  130. RI3.IRIGEL(5,NRE3) = RI1.IRIGEL(5,I1)
  131. RI3.IRIGEL(6,NRE3) = RI1.IRIGEL(6,I1)
  132. RI3.IRIGEL(7,NRE3) = RI1.IRIGEL(7,I1)
  133. 200 CONTINUE
  134. * write(6,*) ' ***** NRE3 =',NRE3
  135. NRIGEL = NRE3
  136. SEGADJ, RI3
  137. IPRIG3 = RI3
  138. ENDIF
  139. C Copie 2e rigidite
  140. IF (NRC1.EQ.0) THEN
  141. IPRIG4 = IPRIG2
  142. ELSE
  143. NRE4 = 0
  144. NRIGEL = NRE2
  145. SEGINI, RI4
  146. RI4.MTYMAT = RI2.MTYMAT
  147. DO 210 I2=1,NRE2
  148. IF (INTERI(NRE1+I2).EQ.1) GOTO 210
  149. NRE4 = NRE4 + 1
  150. RI4.COERIG(NRE4) = RI2.COERIG(I2)
  151. RI4.IRIGEL(1,NRE4) = RI2.IRIGEL(1,I2)
  152. RI4.IRIGEL(2,NRE4) = RI2.IRIGEL(2,I2)
  153. RI4.IRIGEL(3,NRE4) = RI2.IRIGEL(3,I2)
  154. RI4.IRIGEL(4,NRE4) = RI2.IRIGEL(4,I2)
  155. RI4.IRIGEL(5,NRE4) = RI2.IRIGEL(5,I2)
  156. RI4.IRIGEL(6,NRE4) = RI2.IRIGEL(6,I2)
  157. RI4.IRIGEL(7,NRE4) = RI2.IRIGEL(7,I2)
  158. 210 CONTINUE
  159. * write(6,*) ' ***** NRE4 =',NRE4
  160. NRIGEL = NRE4
  161. SEGADJ, RI4
  162. IPRIG4 = RI4
  163. ENDIF
  164.  
  165. C Fusion des 2 copies :
  166. CALL FUSRIG(IPRIG3,IPRIG4,IPRIG0)
  167. IF (IERR.NE.0) RETURN
  168.  
  169. C Ecriture resultat dans la pile :
  170. CALL ECROBJ('RIGIDITE',IPRIG0)
  171.  
  172. RETURN
  173. END
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  

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