Télécharger sols1.eso

Retour à la liste

Numérotation des lignes :

  1. C SOLS1 SOURCE CB215821 20/11/25 13:40:01 10792
  2. SUBROUTINE SOLS1(KSOSTU,KSOLE1,KSOLUT)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C=======================================================================
  7. C SOUS-PROGRAMME APPELE PAR L'OPERATEUR SOLS
  8. C IL FABRIQUE LES SOLUTIONS STATIQUES POUR LES LIAISONS L
  9. C DE LA STRUCTURE S
  10. C
  11. C KSOLUT : OBJET SOLUTION (SOUS TYPE SOLU-STAT)
  12. C KSOSTU : STRUCTURE ELEMENTAIRE, SEGMENT MSOSTU
  13. C KSOLE1 : LISTE DES LIAISONS ELEMENTAIRES (MJONCT), SEGMENT MSOLEN
  14. C
  15. C ECRIT PAR FARVACQUE
  16. C APPELLE ECCHPO RESOU1 ECSOLU ERREUR(108)
  17. C INTRODUCTION DES RESOLUTIONS SIMULTANEES : M.PETIT 10/3/88
  18. C=======================================================================
  19. C
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC SMSTRUC
  24. -INC SMATTAC
  25. -INC SMSOLUT
  26. -INC CCHAMP
  27. -INC SMCHPOI
  28. -INC SMELEME
  29.  
  30. SEGMENT IDEMEN(0)
  31. C
  32. KSOLUT=0
  33. MSOSTU=KSOSTU
  34. MSOLE1=KSOLE1
  35. SEGACT MSOSTU,MSOLE1
  36. KRIGI=ISRAID
  37. C
  38. NJONC=MSOLE1.ISOLEN(/1)
  39. N=NJONC
  40. SEGINI MSOLEN
  41. NBELEM=NJONC
  42. NBNN=1
  43. NBSOUS=0
  44. NBREF=0
  45. SEGINI MELEME
  46. ITYPEL=1
  47. C
  48. C **** BOUCLE SUR LES MJONCT PRIS DANS MSOLE1
  49. C
  50. DO 72 IB=1,NJONC
  51. MJONCT=MSOLE1.ISOLEN(IB)
  52. SEGACT MJONCT
  53. IPT1=MJOPOI
  54. SEGACT IPT1
  55. NUM(1,IB)=IPT1.NUM(1,1)
  56. C WRITE(6,4444) NUM(1,IB)
  57. C4444 FORMAT(' POINT DU MJONCT ',I5)
  58. IF(MJOTYP.EQ.'DEPI') THEN
  59. ISOLEN(IB)=IPCHJO(1)
  60. ELSE
  61. NCCC=ISTRJO(/1)
  62. DO 73 IC=1,NCCC
  63. IF(ISTRJO(IC).EQ.MSOSTU) GOTO 74
  64. 73 CONTINUE
  65. GOTO 71
  66. 74 CONTINUE
  67. MCHPOI=IPCHJO(IC)
  68. SEGACT MCHPOI*MOD
  69. NSOUPO=IPCHP(/1)
  70. NAT=1
  71. C **** ON VA CALCULER LA REPONSE A MCHPO1 QU ON VA METTRE DANS ISOLEN(I
  72. SEGINI MCHPO1
  73. C dans les objets solutions il n'y a que des champs diffus
  74. JATTRI(1) = 1
  75. DO 80 IS=1,NSOUPO
  76. MSOUPO=IPCHP(IS)
  77. SEGACT MSOUPO
  78. NC=NOCOMP(/2)
  79. SEGINI MSOUP1
  80. MSOUP1.IGEOC=IGEOC
  81. IF(MJODDL.NE.'LX ') GO TO 87
  82. C
  83. C **** SI LIAISON LIBRE(MJODDL=LX) REPONSE A -Pt
  84. C
  85. MPOVAL=IPOVAL
  86. SEGACT MPOVAL
  87. N=VPOCHA(/1)
  88. SEGINI MPOVA1
  89. DO 86 ICOMP=1,NC
  90. DO 86 I1=1,N
  91. MPOVA1.VPOCHA(I1,ICOMP)=-VPOCHA(I1,ICOMP)
  92. 86 CONTINUE
  93. MSOUP1.IPOVAL=MPOVA1
  94. GO TO 88
  95. 87 CONTINUE
  96. MSOUP1.IPOVAL=IPOVAL
  97. 88 CONTINUE
  98. DO 81 ICOMP=1,NC
  99. DO 82 ICOMP1=1,LNOMDD
  100. IF(NOMDD(ICOMP1).NE.NOCOMP(ICOMP)) GO TO 82
  101. MSOUP1.NOCOMP(ICOMP)=NOMDU(ICOMP1)
  102. MSOUP1.NOHARM(ICOMP)=NOHARM(ICOMP)
  103. GO TO 81
  104. 82 CONTINUE
  105. MOTERR=NOCOMP(ICOMP)
  106. CALL ERREUR(108)
  107. GO TO 5000
  108. 81 CONTINUE
  109. MCHPO1.IPCHP(IS)=MSOUP1
  110. MCHPO1.IFOPOI=IFOPOI
  111. 80 CONTINUE
  112. C
  113. ISOLEN(IB)=MCHPO1
  114. IF(MJODDL.EQ.'LX ') ISOLEN(IB)=-ISOLEN(IB)
  115. 71 CONTINUE
  116. ENDIF
  117. 72 CONTINUE
  118. C
  119. C
  120. N=NJONC
  121. SEGINI MSOLE2
  122. NIPO=10
  123. SEGINI MSOLUT
  124. ITYSOL='SOLUSTAT'
  125. DO 56 I=1,NIPO
  126. MSOLIS(I)=0
  127. MSOLIT(I)=0
  128. 56 CONTINUE
  129. MSOLIS(3)=MELEME
  130. MSOLIS(4)=MSOLE2
  131. MSOLIS(5)=MSOLEN
  132. MSOLIT(5)=2
  133. MSOLIT(10)=14
  134. MSOLIS(10)=MSOLE1
  135. C
  136. SEGINI IDEMEN
  137. KDEMEN=IDEMEN
  138. DO 50 IB=1,NJONC
  139. ISEC=ABS(ISOLEN(IB))
  140. IF(IIMPI.EQ.0) GOTO 52
  141. IF(ISOLEN(IB).GT.0)WRITE(IOIMP,4441)IB
  142. IF(ISOLEN(IB).LT.0)WRITE(IOIMP,4442)IB
  143. 4441 FORMAT(' SOLUTION STATIQUE NUMERO :',I4,' BLOQUEE.')
  144. 4442 FORMAT(' SOLUTION STATIQUE NUMERO :',I4,' LIBRE .')
  145. WRITE(IOIMP,4446)
  146. 4446 FORMAT(' ***** CHPOINT D''EXCITATION ')
  147. CALL ECCHPO(ISEC,0)
  148. 52 CONTINUE
  149. IDEMEN(**)=ISEC
  150. call ecrobj('CHPOINT ',isec)
  151. 50 CONTINUE
  152. call ecrcha('NOID')
  153. call ecrcha('NOUN')
  154. call ecrobj('RIGIDITE',krigi)
  155. C
  156. C ON RESOUD SIMULTANEMENT POUR LES NJONC LIAISONS
  157. C
  158. NOID=0
  159. NOEN=1
  160. CALL RESOU
  161. IF(IERR.NE.0) GO TO 5000
  162. C
  163. C
  164. IDEMEN=KDEMEN
  165. SEGACT IDEMEN*mod
  166. do 541 ib=njonc,1,-1
  167. call lirobj('CHPOINT ',iprem,1,iretou)
  168. idemen(ib)=iprem
  169. 541 continue
  170. DO 54 IB=1,NJONC
  171. LVALM=5
  172. NIMOD=3
  173. SEGINI MMODE
  174. IMODE=MMODE
  175. FMMODD(1)=0.D0
  176. FMMODD(2)=0.D0
  177. FMMODD(2)=0.D0
  178. FMMODD(4)=0.D0
  179. FMMODD(5)=0.D0
  180. IMMODD(1)=IB
  181. MCHPOI=IDEMEN(IB)
  182. SEGACT MCHPOI
  183. IRT=MCHPOI
  184. IF(IFOPOI.NE.1) GOTO 57
  185. CALL NUHARM(IRT,IFO,IHARM)
  186. IF(IFO.NE.1) THEN
  187. IMMODD(2)=0
  188. IMMODD(3)=0
  189. ELSE
  190. IMMODD(2)=IHARM
  191. IF(IHARM.LT.0) IMMODD(3)=1
  192. IF(IHARM.GE.0) IMMODD(3)=2
  193. ENDIF
  194. 57 CONTINUE
  195. MCHPOI=IRT
  196. IF(IIMPI.EQ.0)GOTO 53
  197. WRITE(IOIMP,4447)
  198. 4447 FORMAT(' ***** CHPOINT REPONSE SOLUTION STATIQUE ')
  199. CALL ECCHPO(IRT,0)
  200. 53 CONTINUE
  201. IF(IRT.EQ.0) GO TO 5000
  202. MJONCT=MSOLE1.ISOLEN(IB)
  203. SEGACT MJONCT
  204. IF(MJOTYP.NE.'DEPI') THEN
  205. MCHPOI=ABS(ISOLEN(IB))
  206. SEGACT MCHPOI
  207. NSOUP=IPCHP(/1)
  208. DO 51 I=1,NSOUP
  209. MSOUPO=IPCHP(I)
  210. IF(ISOLEN(IB).GT.0) GO TO 55
  211. SEGACT MSOUPO
  212. MPOVAL=IPOVAL
  213. SEGSUP MPOVAL
  214. 55 CONTINUE
  215. SEGSUP MSOUPO
  216. 51 CONTINUE
  217. SEGSUP MCHPOI
  218. ENDIF
  219. ISOLEN(IB)=IRT
  220. MSOLE2.ISOLEN(IB)=IMODE
  221. 54 CONTINUE
  222. SEGSUP IDEMEN
  223. C
  224. C
  225. IF(IIMPI.NE.0) CALL ECSOLU(MSOLUT,0)
  226. KSOLUT=MSOLUT
  227. 5000 CONTINUE
  228. END
  229.  
  230.  
  231.  
  232.  

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