Télécharger fusolu.eso

Retour à la liste

Numérotation des lignes :

  1. C FUSOLU SOURCE CHAT 05/01/13 00:13:02 5004
  2. SUBROUTINE FUSOLU(MSO1,MSO2,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C REUNION DE 2 OBJETS SOLUTION DE MEME TYPE. OPTION VALABLE ACTUELLEMENT
  7. C POUR LES MODES ET LES SOLUTIONS STATIQUES ET LES PSEUDO MODES.
  8. C LES CHPOINTS DE DEPLACEMENT (QUAND IL Y EN A) DOIVENT S APPUYER SUR
  9. C LES MEMES POINTS MUNIS DES MEMES COMPOSANTES. LA VERIF EST FAITE
  10. C DANS COCHPO
  11. C SI 2 INDICES SONT IDENTIQUES ON N EN CONSERVE QU UN.
  12. C
  13. C ECRIT PAR FARVACQUE
  14. C APPELE PAR PRFUSE
  15. C APPELLE COCHPO,ERREUR(82,83)
  16. C=======================================================================
  17. -INC CCOPTIO
  18. -INC SMSOLUT
  19. -INC SMELEME
  20. SEGMENT ITRAV(NNN2)
  21. C
  22. SEGACT MSO1,MSO2
  23. IF(MSO1.ITYSOL.NE.MSO2.ITYSOL) GOTO 1000
  24. NIPO=MSO1.MSOLIS(/1)
  25. IF(MSO1.ITYSOL.NE.'MODE ') GOTO 1
  26. ITY=1
  27. GOTO 20
  28. 1 IF(MSO1.ITYSOL.NE.'SOLUSTAT'.AND.
  29. C MSO1.ITYSOL.NE.'PSEUMODE') GOTO 2
  30. ITY=2
  31. GOTO 20
  32. 2 CONTINUE
  33. 1001 CONTINUE
  34. MOTERR(1:8)=MSO1.ITYSOL
  35. CALL ERREUR(82)
  36. GOTO 5000
  37. C OPERATION NON PROGRAMMEE POUR CE TYPE DE SOLUTION
  38. C
  39. 20 CONTINUE
  40. SEGINI MSOLUT
  41. IRET=MSOLUT
  42. ITYSOL=MSO1.ITYSOL
  43. DO 40 I=1,NIPO
  44. MSOLIS(I)=0
  45. MSOLIT(I)=0
  46. 40 CONTINUE
  47. GOTO (21,21),ITY
  48. C *********** OPERATION SUR LES MODES ET LES SOLUSTAT ****************
  49. 21 CONTINUE
  50. MSOLEN=MSO1.MSOLIS(4)
  51. SEGACT MSOLEN
  52. MMODE=ISOLEN(1)
  53. SEGACT MMODE
  54. IP1=IMMODD(3)
  55. SEGDES MMODE,MSOLEN
  56. MSOLEN=MSO2.MSOLIS(4)
  57. SEGACT MSOLEN
  58. MMODE=ISOLEN(1)
  59. SEGACT MMODE
  60. IP2=IMMODD(3)
  61. SEGDES MMODE,MSOLEN
  62. IF(IP2.NE.IP1) GOTO 1000
  63. C IF(IP2.EQ.3) GOTO 1001
  64. IPT1=MSO1.MSOLIS(3)
  65. IPT2=MSO2.MSOLIS(3)
  66. SEGACT IPT1,IPT2
  67. NNN1=IPT1.NUM(/2)
  68. NNN2=IPT2.NUM(/2)
  69. SEGINI ITRAV
  70. IMEL=0
  71. DO 22 I2=1,NNN2
  72. IPOIN=IPT2.NUM(1,I2)
  73. DO 23 I1=1,NNN1
  74. IF(IPOIN.NE.IPT1.NUM(1,I2)) GOTO 23
  75. GOTO 22
  76. 23 CONTINUE
  77. IMEL=IMEL+1
  78. ITRAV(IMEL)=I2
  79. 22 CONTINUE
  80. C
  81. NBSOUS=0
  82. NBREF=0
  83. NBNN=1
  84. NBELEM=NNN1+IMEL
  85. SEGINI MELEME
  86. ITYPEL=1
  87. DO 24 I1=1,NNN1
  88. NUM(1,I1)=IPT1.NUM(1,I1)
  89. 24 CONTINUE
  90. DO 25 I1=1,IMEL
  91. NUM(1,NNN1+I1)=IPT2.NUM(1,ITRAV(I1))
  92. 25 CONTINUE
  93. SEGDES IPT1,IPT2,MELEME
  94. MSOLIS(3)=MELEME
  95. N=NBELEM
  96. GOTO 200
  97. C
  98. C ***** POUR TOUS LES TYPES DE SOLUTION *************
  99. C
  100. 200 CONTINUE
  101. DO 127 I=4,NIPO
  102. MSOLE1=MSO1.MSOLIS(I)
  103. MSOLE2=MSO2.MSOLIS(I)
  104. IF(MSOLE1.EQ.0.AND.MSOLE2.EQ.0) GOTO 127
  105. SEGINI MSOLEN
  106. IBO=MSOLEN
  107. IF(MSOLE1.EQ.0)GOTO 110
  108. SEGACT MSOLE1
  109. DO 129 I1=1,NNN1
  110. ISOLEN(I1)=MSOLE1.ISOLEN(I1)
  111. 129 CONTINUE
  112. IF(MSOLE2.EQ.0) GOTO 111
  113. C
  114. C **** ON VERIFIE QUE LES CHPOINTS CONTENUS DANS LES MSOLEN ONT BIEN
  115. C **** DES FORMES IDENTIQUES
  116. C
  117. IF(MSO1.MSOLIT(I).NE.2) GOTO 6
  118. DO 60 I1=1,NNN1
  119. IF(MSOLE1.ISOLEN(I1).EQ.0) GOTO 60
  120. II1=MSOLE1.ISOLEN(I1)
  121. GOTO 61
  122. 60 CONTINUE
  123. 61 CONTINUE
  124. SEGACT MSOLE2
  125. DO 62 I2=1,NNN2
  126. IF(MSOLE2.ISOLEN(I2).EQ.0) GOTO 62
  127. II2=MSOLE2.ISOLEN(I2)
  128. GOTO 63
  129. 62 CONTINUE
  130. 63 ITAI=MSOLE2
  131. CALL COCHPO(II1,II2,ITAI,ITAF)
  132. IF(IERR.NE.0) GOTO 5000
  133. MSOLEN=IBO
  134. MSOLE2=ITAF
  135. C
  136. 6 CONTINUE
  137. SEGACT MSOLEN*MOD
  138. SEGACT MSOLE2
  139. DO 126 I2=1,IMEL
  140. ISOLEN(NNN1+I2)=MSOLE2.ISOLEN(ITRAV(I2))
  141. 126 CONTINUE
  142. GOTO 132
  143. C
  144. 111 CONTINUE
  145. DO 128 I2=1,IMEL
  146. ISOLEN(NNN1+I2)=0
  147. 128 CONTINUE
  148. GOTO 132
  149. C
  150. 110 CONTINUE
  151. SEGACT MSOLE2
  152. DO 130 I1=1,NNN1
  153. ISOLEN(I1)=0
  154. 130 CONTINUE
  155. DO 131 I2=1,IMEL
  156. ISOLEN(NNN1+I2)=MSOLE2.ISOLEN(ITRAV(I2))
  157. 131 CONTINUE
  158. 132 MSOLIS(I)=MSOLEN
  159. SEGDES MSOLE1
  160. SEGDES MSOLE2
  161. SEGDES MSOLEN
  162. IF(MSO1.MSOLIT(I).NE.0) THEN
  163. MSOLIT(I)=MSO1.MSOLIT(I)
  164. ELSE
  165. MSOLIT(I)=MSO2.MSOLIT(I)
  166. ENDIF
  167. 127 CONTINUE
  168. C
  169. SEGSUP ITRAV
  170. SEGDES MSOLUT
  171. GOTO 5000
  172. 1000 CONTINUE
  173. MOTERR(1:8)='SOLUTION'
  174. CALL ERREUR(83)
  175. C LES 2 OBJETS DOIVENT ETRE DE MEME TYPE
  176. 5000 CONTINUE
  177. SEGDES MSO1,MSO2
  178. RETURN
  179. END
  180.  
  181.  
  182.  

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