Télécharger pressi.eso

Retour à la liste

Numérotation des lignes :

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

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