Télécharger psevo1.eso

Retour à la liste

Numérotation des lignes :

  1. C PSEVO1 SOURCE FANDEUR 10/12/14 21:18:57 6812
  2.  
  3. SUBROUTINE PSEVO1(IMODE,IPSMO,IBOO,IPX,ILEX,ICHAR,ICONT)
  4.  
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. ************************************************************************
  9. *
  10. * P S E V O 1
  11. * -----------
  12. *
  13. * FONCTION:
  14. * ---------
  15. *
  16. * AJOUTE LA CONTRIBUTION DES MODES NEGLIGES
  17. * POUR LES DEPLACEMENTS SI ICONT=0
  18. * POUR LES CONTRAINTES SI ICONT=1
  19. *
  20. * MODULES UTILISES:
  21. * -----------------
  22. *
  23. -INC CCOPTIO
  24. -INC SMATTAC
  25. -INC SMCHARG
  26. -INC SMCHPOI
  27. -INC SMELEME
  28. -INC SMLREEL
  29. -INC SMSOLUT
  30. *
  31. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  32. * -----------
  33. *
  34. * IMODE (E) OBJET SOLUTION DE SOUS-TYPE MODE.
  35. * IPSMO (E) OBJET SOLUTION DE SOUS-TYPE PSEUMODE.
  36. * IBOO (E) POINTEUR SUR LE SEGMENT NUMOO.
  37. * (S) POINTEUR SUR LE SEGMENT NUMOO.
  38. * IPX (E) POINTEUR SUR LE LISTREEL.
  39. * ILEX (E) CONTIENT LES FORCES DE LIAISON AUX TEMPS DEMANDES.
  40. * ICHAR (E) POINTEUR SUR LE CHARGEMENT.
  41. *
  42. SEGMENT NUMOO
  43. INTEGER NUMO(N),KLIST(N)
  44. CHARACTER*4 NUDDL(N)
  45. ENDSEGMENT
  46. *
  47. * VARIABLES:
  48. * ----------
  49. *
  50. CHARACTER*4 COMP,COMP2,MONTYP,DIRECT
  51. PARAMETER (TOLER = 1.D-6)
  52. *
  53. *
  54. * AUTEUR, DATE DE CREATION:
  55. * -------------------------
  56. *
  57. * LIONEL VIVAN SEPTEMBRE 1988
  58. *
  59. * LANGAGE:
  60. * --------
  61. *
  62. * ESOPE + FORTRAN77
  63. *
  64. ************************************************************************
  65. *
  66. IF (ICHAR.EQ.0 .AND. ILEX.EQ.0) THEN
  67. CALL ERREUR(430)
  68. RETURN
  69. ENDIF
  70. *
  71. NUMOO = IBOO
  72. SEGACT NUMOO
  73. NP = NUMO(/1)
  74. DO 2 I = 1,NP
  75. MLREE3 = KLIST(I)
  76. SEGACT MLREE3
  77. 2 CONTINUE
  78. *
  79. MLREEL= IPX
  80. SEGACT MLREEL
  81. LDIM = PROG(/1)
  82. *
  83. IF (ICHAR.NE.0) THEN
  84. MCHARG = ICHAR
  85. SEGACT MCHARG
  86. NCH = KCHARG(/1)
  87. ENDIF
  88. *
  89. MSOLUT = IPSMO
  90. SEGACT MSOLUT
  91. *
  92. MSOLEN = MSOLIS(10)
  93. SEGACT MSOLEN
  94. NPS = ISOLEN(/1)
  95. *
  96. IF (ICONT.EQ.0) MSOLE1 = MSOLIS(5)
  97. IF (ICONT.EQ.1) MSOLE1 = MSOLIS(6)
  98. SEGACT MSOLE1
  99. *
  100. IF (ILEX.NE.0) THEN
  101. MSOLE2 = ILEX
  102. SEGACT MSOLE2
  103. ENDIF
  104. *
  105. DO 10 IP = 1,NPS
  106. MJONCT = ISOLEN(IP)
  107. SEGACT MJONCT
  108. MONTYP = MJOTYP
  109. *
  110. * PSEUDO-MODE D'UNE STRUCTURE MULTISUPPORTEE
  111. *
  112. IF (MONTYP.EQ.'DEPL') THEN
  113. IF (ICHAR.EQ.0) THEN
  114. SEGDES MJONCT
  115. GOTO 10
  116. ENDIF
  117. ICHM = IPCHJO(1)
  118. * RECHERCHE DU CHARGEMENT
  119. DO 12 IC = 1,NCH
  120. ICHARG = KCHARG(IC)
  121. SEGACT ICHARG
  122. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT'
  123. & .OR.CHALIE(IC).NE.'LIE ') THEN
  124. SEGDES ICHARG
  125. GOTO 12
  126. ENDIF
  127. ICHC = ICHPO1
  128. IF (ICHC.EQ.ICHM) THEN
  129. * ON A TROUVE LE CHARGEMENT
  130. GOTO 100
  131. ENDIF
  132. SEGDES ICHARG
  133. 12 CONTINUE
  134. *
  135. * MANQUE LE CHARGEMENT POUR LE PSEUDO-MODE
  136. *
  137. INTERR(1) = IP
  138. CALL ERREUR(428)
  139. SEGDES MJONCT
  140. GOTO 10
  141. *
  142. * PSEUDO-MODE D'UNE FORCE CONCENTREE
  143. *
  144. ELSE IF (MONTYP.EQ.'FORC') THEN
  145. IF (ICHAR.EQ.0) THEN
  146. SEGDES MJONCT
  147. GOTO 10
  148. ENDIF
  149. ICHM = IPCHJO(1)
  150. * RECHERCHE DU CHARGEMENT
  151. DO 22 IC = 1,NCH
  152. ICHARG = KCHARG(IC)
  153. SEGACT ICHARG
  154. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT'
  155. & .OR.CHALIE(IC).NE.'LIE ') THEN
  156. SEGDES ICHARG
  157. GOTO 22
  158. ENDIF
  159. ICHC = ICHPO1
  160. IF (ICHC.EQ.ICHM) THEN
  161. * ON A TROUVE LE CHARGEMENT
  162. GOTO 100
  163. ENDIF
  164. SEGDES ICHARG
  165. 22 CONTINUE
  166. *
  167. * IL N'Y A PAS DE CHARGEMENT POUR CE TYPE DE PSEUDO-MODE
  168. *
  169. INTERR(1) = IP
  170. CALL ERREUR(428)
  171. SEGDES MJONCT
  172. GOTO 10
  173. *
  174. * PSEUDO-MODE D'UNE EXCITATION SISMIQUE D'ENSEMBLE
  175. *
  176. ELSE IF (MONTYP.EQ.'SEIS') THEN
  177. IF (ICHAR.EQ.0) THEN
  178. SEGDES MJONCT
  179. GOTO 10
  180. ENDIF
  181. DIRECT = MJODDL
  182. IF (DIRECT.EQ.'UX ') THEN
  183. IPLAC = 3
  184. ELSE IF (DIRECT.EQ.'UY ') THEN
  185. IPLAC = 4
  186. ELSE
  187. IPLAC = 5
  188. ENDIF
  189. MSO1 = IMODE
  190. SEGACT MSO1
  191. MSOLE2 = MSO1.MSOLIS(4)
  192. SEGDES MSO1
  193. SEGACT MSOLE2
  194. MMODE = MSOLE2.ISOLEN(1)
  195. SEGDES MSOLE2
  196. SEGACT MMODE
  197. QPS = -1.D0 * FMMODD(IPLAC)
  198. SEGDES MMODE
  199. * RECHERCHE DU CHARGEMENT
  200. DO 32 IC = 1,NCH
  201. ICHARG = KCHARG(IC)
  202. SEGACT ICHARG
  203. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(IC).NE.'STAT'
  204. & .OR.CHALIE(IC).NE.'LIE ') THEN
  205. SEGDES ICHARG
  206. GOTO 32
  207. ENDIF
  208. MCHPOI = ICHPO1
  209. SEGACT MCHPOI
  210. MSOUPO = IPCHP(1)
  211. SEGDES MCHPOI
  212. SEGACT MSOUPO
  213. MPOVAL = IPOVAL
  214. SEGDES MSOUPO
  215. SEGACT MPOVAL
  216. QXYZ = VPOCHA(1,1)
  217. SEGDES MPOVAL
  218. EPS = ABS(QPS - QXYZ)
  219. IF (EPS.LT.TOLER) THEN
  220. * ON A TROUVE LE CHARGEMENT
  221. GOTO 100
  222. ENDIF
  223. SEGDES ICHARG
  224. 32 CONTINUE
  225. *
  226. * IL N'Y A PAS DE CHARGEMENT CORRESPONDANT AU PSEUDO-MODE
  227. *
  228. INTERR(1) = IP
  229. CALL ERREUR(428)
  230. SEGDES MJONCT
  231. GOTO 10
  232. *
  233. * PSEUDO-MODE D'UNE FORCE DE CHOC
  234. *
  235. ELSE IF (MONTYP.EQ.'CHOC') THEN
  236. IF (ILEX.EQ.0) THEN
  237. SEGDES MJONCT
  238. GOTO 10
  239. ENDIF
  240. GOTO 100
  241. ENDIF
  242. *
  243. 100 CONTINUE
  244. IF (ICONT.EQ.0) THEN
  245. ICHP = MSOLE1.ISOLEN(IP)
  246. ELSE
  247. ICCC = MSOLE1.ISOLEN(IP)
  248. CALL PELPO(ICCC,ICHP,IRETOU)
  249. IF (IRETOU.EQ.0) THEN
  250. INTERR(1) = IP
  251. CALL ERREUR(428)
  252. SEGDES MJONCT
  253. GOTO 10
  254. ENDIF
  255. ENDIF
  256. *
  257. IF (ICHAR.NE.0) THEN
  258. MLREE1 = ICHPO2
  259. SEGACT MLREE1
  260. NF = MLREE1.PROG(/1)
  261. MLREE2 = ICHPO3
  262. SEGACT MLREE2
  263. ENDIF
  264. *
  265. N1 = 1
  266. N2 = 2
  267. DO 110 IT = 1,LDIM
  268. TEM1 = PROG(IT)
  269. IF (MONTYP.EQ.'CHOC') THEN
  270. FTEM1 = 0.D0
  271. IPOINP = MJOPOI
  272. COMP = MJODDL
  273. * RECHERCHE DANS LE CHPOINT DES FORCES DE LIAISON
  274. ICHLIA = MSOLE2.ISOLEN(IT)
  275. CALL EXTRA9(ICHLIA,IPOINP,COMP,KERRE,FTEM1)
  276. IF (KERRE.NE.0) THEN
  277. INTERR(1) = IP
  278. CALL ERREUR(428)
  279. SEGDES MJONCT
  280. GOTO 10
  281. ENDIF
  282. ELSE
  283. CALL INTLIN(TEM1,ICHPO2,ICHPO3,NF,N1,N2,FTEM1,IRETOU)
  284. IF (IRETOU.EQ.0) THEN
  285. INTERR(1) = IP
  286. CALL ERREUR(428)
  287. SEGDES MLREE1
  288. SEGDES MLREE2
  289. SEGDES ICHARG
  290. SEGDES MJONCT
  291. GOTO 10
  292. ENDIF
  293. ENDIF
  294. *
  295. DO 120 I3 = 1,NP
  296. IPOIN = NUMO(I3)
  297. COMP = NUDDL(I3)
  298. CALL EXTRA9(ICHP,IPOIN,COMP,KERRE,XFLOT1)
  299. IF (KERRE.NE.0) THEN
  300. IF (ICHAR.NE.0) THEN
  301. SEGDES MLREE1
  302. SEGDES MLREE2
  303. SEGDES ICHARG
  304. ENDIF
  305. INTERR(1) = IP
  306. CALL ERREUR(428)
  307. SEGDES MJONCT
  308. GOTO 10
  309. ENDIF
  310. XVAL = XFLOT1 * FTEM1
  311. *
  312. IF (IIMPI.EQ.1804) THEN
  313. PRINT*,'-- PRISE EN COMPTE DES PSEUDO-MODES -- XVAL :',XVAL
  314. ENDIF
  315. *
  316. MLREE3 = KLIST(I3)
  317. MLREE3.PROG(IT) = MLREE3.PROG(IT) + XVAL
  318. 120 CONTINUE
  319. *
  320. 110 CONTINUE
  321. IF (ICONT.EQ.1) THEN
  322. MCHPO1=ICHP
  323. SEGSUP MCHPO1
  324. ENDIF
  325. IF (ICHAR.NE.0) THEN
  326. SEGDES MLREE1
  327. SEGDES MLREE2
  328. SEGDES ICHARG
  329. ENDIF
  330. SEGDES MJONCT
  331. *
  332. 10 CONTINUE
  333. *
  334. SEGDES MLREEL
  335. SEGDES MSOLE1
  336. SEGDES MSOLEN
  337. SEGDES MSOLUT
  338. IF (ILEX.NE.0) THEN
  339. SEGDES MSOLE2
  340. ENDIF
  341. IF (ICHAR.NE.0) THEN
  342. SEGDES MCHARG
  343. ENDIF
  344. DO 4 I = 1,NP
  345. MLREE3 = KLIST(I)
  346. SEGDES MLREE3
  347. 4 CONTINUE
  348. *
  349. * SEGDES NUMOO
  350. IBOO = NUMOO
  351. *
  352. RETURN
  353. END
  354.  
  355.  
  356.  

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