Télécharger pressi.eso

Retour à la liste

Numérotation des lignes :

  1. C PRESSI SOURCE PV 17/09/21 21:15:13 9558
  2. SUBROUTINE PRESSI
  3. C_______________________________________________________________________
  4. C
  5. C OPERATEUR PRESSI
  6. C
  7. C-----------------------------------------------------------------------
  8. C 1ere syntaxe : definition d'un CHPOINT de forces nodales equivalentes
  9. C
  10. C FP = PRESSI I MASS MODEL I P MAIL I (CARA)
  11. C I CHPOT I
  12. C I CHAML I
  13. C I COQU MODEL I P I I VECT I (CARA)
  14. C I CHPOT I I NORM I
  15. C I CHAML I
  16. C I FISS MODEL I P I VECT POIN CARA
  17. C I CHPOT I
  18. C
  19. C FP CHPOINT CONTENANT LES FORCES NODALES EQUIVALENTES
  20. C MODEL OBJET MMODEL ,MASSIF ,COQUE OU FISS SUR LEQUEL
  21. C S APPLIQUE LA PRESSION
  22. C P VALEUR ALGEBRIQUE DE LA PRESSION
  23. C MAIL POUR LES MASSIFS ,OBJET MAILLAGE REPRESENTANT
  24. C LA FACE SUR LAQUELLE S'APPLIQUE LA PRESSION
  25. C CHPOT CHPOINT CONTENANT LES VALEURS ALGEBRIQUES
  26. C DES PRESSIONS AUX NOEUDS
  27. C VECT POUR COQUE ET LINESPRING , VECTEUR INDIQUANT LA
  28. C DIRECTION DANS LAQUELLE S APPLIQUE LA PRESSION
  29. C NORM MOT CLE INDIQUANT QUE LA PRESSION EST POSITIVE
  30. C SI ELLE EST PORTEE PAR LA NORMALE POSITIVE
  31. C A L ELEMENT
  32. C CARA POUR LES MASSIFS EN CONTRAINTES PLANES ET
  33. C POUR LES COQUES EPAISSES, MCHAML CONTENANT
  34. C LES VALEURS DES EPAISSEURS AUX POINTS
  35. C D INTEGRATION
  36. C POIN POUR LE LINESPRING , POINT OU SE RAPPORTE
  37. C LE VECTEUR
  38. C CARA POUR LE LINESPRING ,MCHAML CONTENANT LES VALEURS
  39. C DES CARACTERISTIQUES AUX POINTS D INTEGRATION
  40. C
  41. C
  42. C MODIF EBERSOLT MAI 85 PRESSION SUR LES LEVRES DU LINESPRING
  43. C
  44. C PASSAGE AUX NOUVEAU CHAMALEM PAR JM CAMPENON LE 04 08 90
  45. C
  46. C-----------------------------------------------------------------------
  47. C 2e syntaxe : definition d'un MCHAML de pression
  48. C
  49. C CHEL2 = PRES MOD1 | MOT1 VAL1 (MAIL1) ;
  50. C | CHEL1
  51. C
  52. C MOT1 NOM DE LA COMPOSANTE DE PRESSION
  53. C VAL1 VALEUR DE LA PRESSION
  54. C MAIL1 MAILLAGE DE LA SURFACE OU ON APPLIQUE LA PRESSION
  55. C PAR DEFAUT, TOUTE LA SURFACE DE DEFINITION DU MODELE
  56. C
  57. C CHAM1 MCHAML DE PRESSION DE NOM DE COMPOSANTE QUELCONQUE
  58. C_______________________________________________________________________
  59. IMPLICIT INTEGER(I-N)
  60. IMPLICIT REAL*8 (A-H,O-Z)
  61. -INC CCOPTIO
  62. -INC SMCHPOI
  63. -INC SMCHAML
  64. -INC SMMODEL
  65. C
  66. CHARACTER*4 MTYPE(5),MNORM(1)
  67. CHARACTER*(4) MOSCAL,MOPOI1,MOCLE
  68. C
  69. DATA MTYPE/'MASS','COQU','FISS','TUYA','SHB8'/
  70. DATA MNORM/'NORM'/
  71. DATA MOSCAL/'SCAL'/,MOPOI1/'POI1'/
  72. C
  73. IPMODL=0
  74. IPCHE1=0
  75. IPCHM1=0
  76. IPCHE2=0
  77. IPCHA1=0
  78. ICONV=0
  79. IRET=0
  80. C
  81. C ON LIT UN MOT CLE
  82. C
  83. CALL LIRCHA(MOCLE,0,ILONG)
  84. IF (IERR.NE.0) RETURN
  85. C
  86. IMLU=0
  87. IF (ILONG.NE.0) THEN
  88. CALL PLACE(MTYPE,5,IMLU,MOCLE)
  89. IF (IERR.NE.0) RETURN
  90. ELSE
  91. MOCLE=' '
  92. ENDIF
  93. C
  94. C Si pas de mot-cle de la 1ere syntaxe, alors c'est la 2e
  95. IF (IMLU.EQ.0) IMLU=6
  96. C
  97. C ON LIT UN MMODEL
  98. C
  99. CALL LIROBJ('MMODEL ',IPMODL,1,IRETMO)
  100. IF (IERR.NE.0) RETURN
  101.  
  102. C c bp, on verifie qu'il s'agit bien d'un modele mecanique
  103. C MMODEL=IPMODL
  104. C segact,MMODEL
  105. C N1=KMODEL(/1)
  106. C DO 11 I1=1,N1
  107. C IMODEL=KMODEL(I1)
  108. C segact,IMODEL
  109. C N2=FORMOD(/2)
  110. C DO 12 I2=1,N2
  111. C IF(FORMOD(I2).NE.'MECANIQUE') THEN
  112. C MOTERR(1:16)='MECANIQUE '
  113. C call ERREUR(935)
  114. C segdes,IMODEL
  115. C segdes,MMODEL
  116. C return
  117. C ENDIF
  118. C 12 CONTINUE
  119. C segdes,IMODEL
  120. C 11 CONTINUE
  121. C segdes,MMODEL
  122. Cbp : mauvaise idee --> on va tester dans fpmass si il ya le bon nombre
  123. C de composantes de forces
  124. C
  125. C ON LIT UN CHAMP POINT (FACULTATIF)
  126. C
  127. CALL LIROBJ('CHPOINT ',IPCHE1,0,IRETPO)
  128. IF (IERR.NE.0) RETURN
  129. C
  130. IF (IMLU.EQ.1) THEN
  131. C_______________________________________________________________________
  132. C
  133. C ON A LU LE MOT MASSIF
  134. C_______________________________________________________________________
  135. C
  136. C ON LIT SOIT UN FLOTTANT ET UN MAILLAGE
  137. C SOIT UN CHPOINT (IRETPO.NE.0)
  138. C SOIT UN CHAMELEM (IRETEL.NE.0)
  139. C
  140. IPMAIL=0
  141. P=0.D0
  142. IF (IRETPO.EQ.0) THEN
  143. CALL LIROBJ('MCHAML ',IPCHM1,0,IRETEL)
  144. IF (IERR.NE.0) RETURN
  145. IF (IRETEL.EQ.0) THEN
  146. IPCHM1 = 0
  147. CALL LIRREE(XXX,1,IRETOU)
  148. IF (IERR.NE.0) RETURN
  149. P=XXX
  150. CALL LIROBJ('MAILLAGE',IPMAIL,1,IRETMA)
  151. IF (IERR.NE.0) RETURN
  152. ENDIF
  153. ENDIF
  154. C
  155. CALL FPMASS(IPCHE1,IPCHM1,IPMODL,IPTFP,IPMAIL,P,IRET)
  156. IF (IRET.EQ.0.OR.IERR.NE.0) RETURN
  157. GOTO 666
  158. C
  159. ELSE IF (IMLU.EQ.2) THEN
  160. C_______________________________________________________________________
  161. C
  162. C ON A LU LE MOT COQUE
  163. C_______________________________________________________________________
  164. C
  165. C ON LIT SOIT UN FLOTTANT
  166. C SOIT UN CHPOINT (IRETPO.NE.0)
  167. C SOIT UN CHAMELEM (IRETEL.NE.0)
  168. C
  169. P=0.D0
  170. IF (IRETPO.EQ.0) THEN
  171. CALL LIROBJ('MCHAML ',IPCHM1,0,IRETEL)
  172. IF (IERR.NE.0) RETURN
  173. IF (IRETEL.EQ.0) THEN
  174. IPCHM1 = 0
  175. CALL LIRREE(XXX,1,IRETOU)
  176. IF (IERR.NE.0) RETURN
  177. P=XXX
  178. IPCHE1=0
  179. ENDIF
  180. ENDIF
  181. C
  182. C ON LIT LE MOT CLE NORM SINON ON APPELERA PRORIE QUI
  183. C LIRA SES DONN{ES
  184. C
  185. CALL LIRMOT(MNORM,1,JMLU,0)
  186. IF (IERR.NE.0) RETURN
  187. C
  188. ** Comment je fais si je veux donner un vecteur?
  189. ** IF (JMLU.EQ.0) THEN
  190. ** CALL ERREUR(498)
  191. ** IF (IERR.NE.0) RETURN
  192. ** RETURN
  193. ** ENDIF
  194. C
  195. C LA LECTURE D'UN CHAMELEM DE CARACTERISTIQUE (FACULTATIVE
  196. C EST FAITE DANS FPCOQU
  197. C
  198. CALL FPCOQU(P,IPCHE1,IPCHM1,IPMODL,JMLU,IPTFP,IRET,ICONV)
  199. IF (IRET.EQ.0.OR.IERR.NE.0) RETURN
  200. GOTO 666
  201. C
  202. ELSE IF (IMLU.EQ.3) THEN
  203. C_______________________________________________________________________
  204. C
  205. C ON A LU LE MOT FISSURE
  206. C______________________________________________________________________
  207. C
  208. C ON LIT SOIT UN FLOTTANT ,SOIT UN CHPOINT
  209. C
  210. P=0.D0
  211. IF (IRETPO.EQ.0) THEN
  212. CALL LIRREE(XXX,1,IRETOU)
  213. IF (IERR.NE.0) RETURN
  214. P=XXX
  215. IPCHE1=0
  216. ENDIF
  217. C
  218. C ON LIT UN VECTEUR
  219. C
  220. CALL LIROBJ('POINT ',IPVECT,1,IRETVC)
  221. IF (IERR.NE.0) RETURN
  222. C
  223. C ON LIT UN POINT
  224. C
  225. CALL LIROBJ('POINT ',IPPOIN,1,IRETPT)
  226. IF (IERR.NE.0) RETURN
  227. C
  228. C ON LIT UN CHELEM DE CARACTERISTIQUES
  229. C
  230. CALL LIROBJ('MCHAML',IPCHE2,1,IRETCH)
  231. IF (IERR.NE.0) RETURN
  232. C
  233. CALL FPFISS(P,IPCHE1,IPMODL,IPVECT,IPPOIN,IPCHE2,IPTFP,IRET)
  234. IF (IRET.EQ.0.OR.IERR.NE.0) RETURN
  235. GOTO 666
  236. C
  237. ELSE IF (IMLU.EQ.4) THEN
  238. C_______________________________________________________________________
  239. C
  240. C ON A LU LE MOT TUYAU
  241. C______________________________________________________________________
  242. C
  243. C ON LIT UN OBJET CHAMELEM (CARACTERISTIQUES)
  244. C
  245. CALL LIROBJ('MCHAML',IPCHE1,1,IRETC2)
  246. IF (IERR.NE.0) RETURN
  247. C
  248. CALL FPTUYA(IPMODL,IPCHE1,IPTFP,IRET)
  249. IF (IERR.NE.0.OR.IRET.NE.1)THEN
  250. RETURN
  251. ENDIF
  252. GOTO 666
  253.  
  254. ELSE IF (IMLU.EQ.5) THEN
  255. C_______________________________________________________________________
  256. C
  257. C ON A LU LE MOT SHB8
  258. C______________________________________________________________________
  259. C
  260. C ON LIT UN OBJET CHAMELEM (CARACTERISTIQUES)
  261. C
  262. IPMAIL=0
  263. P=0.D0
  264. IF (IRETPO.EQ.0) THEN
  265. CALL LIRREE(XXX,1,IRETOU)
  266. IF (IERR.NE.0) RETURN
  267. P=XXX
  268. ENDIF
  269. C
  270. CALL FPshb8(IPMODL,IPCHE1,P,IPTFP)
  271. IF (IPTFP.EQ.0)THEN
  272. RETURN
  273. ENDIF
  274. GOTO 666
  275. C
  276. ELSE IF (IMLU.EQ.6) THEN
  277. C_______________________________________________________________________
  278. C
  279. C 2e syntaxe : cas du modele CHARGEMENT PRESSION
  280. C_______________________________________________________________________
  281. C
  282. C
  283. C On extrait du MMODEL la formulation CHARGEMENT PRESSSION
  284. C ----------------------------------------------------------------------
  285. MMODEL = IPMODL
  286. SEGACT,MMODEL
  287. NSOUS = KMODEL(/1)
  288. N1 = NSOUS
  289. SEGINI,MMODE1
  290. IMCGP=0
  291. DO isous = 1, NSOUS
  292. IMODEL = KMODEL(isous)
  293. SEGACT,IMODEL
  294. IF (FORMOD(1).EQ.'CHARGEMENT ') THEN
  295. NMAT = MATMOD(/2)
  296. CALL PLACE(MATMOD,NMAT,ipl,'PRESSION')
  297. IF (ipl.NE.0) THEN
  298. IMCGP = IMCGP + 1
  299. MMODE1.KMODEL(IMCGP) = IMODEL
  300. ENDIF
  301. ENDIF
  302. ENDDO
  303. C
  304. C Si pas de modele chargement pression : erreur !
  305. IF (IMCGP.EQ.0) THEN
  306. MOTERR(1:16)='PRESSION '
  307. CALL ERREUR(719)
  308. SEGSUP,MMODE1
  309. RETURN
  310. ELSE
  311. IPMODL=MMODE1
  312. ENDIF
  313. C
  314. C Cas du MCHALM en argument
  315. C ----------------------------------------------------------------------
  316. IF (MOCLE.EQ.' ') THEN
  317. CALL LIROBJ('MCHAML',IPCHE1,1,IRET)
  318. IF (IERR.NE.0) RETURN
  319. C
  320. CALL REDUAF(IPCHE1,IPMODL,IPCHE2,1,IRET,KERRE)
  321. IF (IERR.NE.0) RETURN
  322. C
  323. IF (IRET.EQ.0) THEN
  324. CALL ERREUR(KERRE)
  325. RETURN
  326. ENDIF
  327. IPCHE1=IPCHE2
  328. C
  329. C Y' plus qu'a :
  330. CALL PRCHL1(IPMODL,IPCHE1,IPCHE2)
  331. IF (IERR.NE.0) RETURN
  332. C
  333. IF (IPCHE2.EQ.0) THEN
  334. CALL ERREUR(5)
  335. RETURN
  336. ENDIF
  337. ELSE
  338. C
  339. C Cas avec MOT1, VAL1... en arguments
  340. C ----------------------------------------------------------------------
  341. C
  342. C Lecture optionnelle d'un maillage
  343. CALL LIROBJ('MAILLAGE',IPGEO1,0,IRET)
  344. IF (IERR.NE.0) RETURN
  345. C
  346. C Si un maillage est fourni, on reduit le modele sur le maillage
  347. IF (IRET.NE.0) THEN
  348. CALL REDUMO(IPMODL,IPGEO1,IRET)
  349. IF (IERR.NE.0) RETURN
  350. C
  351. IF (IRET.NE.0) THEN
  352. SEGSUP,MMODE1
  353. IPMODL=IRET
  354. ENDIF
  355. ENDIF
  356. C
  357. C Lecture du FLOTTANT
  358. CALL LIRREE(XP1,1,IRET)
  359. IF (IERR.NE.0) RETURN
  360. C
  361. C Sous-programme PRCHL2 : IPCHE2 contient le MCHAML resultat / 0 si echec
  362. CALL PRCHL2(IPMODL,MOCLE,XP1,IPCHE2)
  363. IF (IERR.NE.0) RETURN
  364. C
  365. IF (IPCHE2.EQ.0) THEN
  366. CALL ERREUR(5)
  367. RETURN
  368. ENDIF
  369. ENDIF
  370. C
  371. C Fin de la 2 syntaxe
  372. C ----------------------------------------------------------------------
  373. CALL ECROBJ('MCHAML',IPCHE2)
  374. RETURN
  375. ENDIF
  376. C
  377. 666 CONTINUE
  378. C
  379. C LE NUMERO DE L HARMONIQUE EST PRIS EGAL A NIFOUR
  380. C POUR TOUTES LES COMPOSANTES DU CHPOINT
  381. C
  382. MCHPOI=IPTFP
  383. SEGACT MCHPOI
  384. NAT = MAX(JATTRI(/1),1)
  385. NSOUPO = IPCHP(/1)
  386. SEGADJ MCHPOI
  387. C le champ de force nodale est discret.
  388. JATTRI(1) = 2
  389. DO 100 IA=1,NSOUPO
  390. MSOUPO=IPCHP(IA)
  391. SEGACT MSOUPO*MOD
  392. DO 101 NC=1,NOHARM(/1)
  393. NOHARM(NC)=NIFOUR
  394. 101 CONTINUE
  395. SEGDES MSOUPO
  396. 100 CONTINUE
  397. C
  398. SEGDES MCHPOI
  399. C
  400. CALL ECROBJ('CHPOINT ',IPTFP)
  401. RETURN
  402. END
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414.  
  415.  
  416.  
  417.  
  418.  

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