Télécharger pressi.eso

Retour à la liste

Numérotation des lignes :

pressi
  1. C PRESSI SOURCE OF166741 24/10/07 21:15:40 12016
  2.  
  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-----------------------------------------------------------------------
  45. C 2e syntaxe : definition d'un MCHAML de pression
  46. C
  47. C CHEL2 = PRES MOD1 | MOT1 VAL1 (MAIL1) ;
  48. C | CHEL1
  49. C
  50. C MOT1 NOM DE LA COMPOSANTE DE PRESSION
  51. C VAL1 VALEUR DE LA PRESSION
  52. C MAIL1 MAILLAGE DE LA SURFACE OU ON APPLIQUE LA PRESSION
  53. C PAR DEFAUT, TOUTE LA SURFACE DE DEFINITION DU MODELE
  54. C
  55. C CHAM1 MCHAML DE PRESSION DE NOM DE COMPOSANTE QUELCONQUE
  56. C_______________________________________________________________________
  57. SUBROUTINE PRESSI
  58.  
  59. IMPLICIT INTEGER(I-N)
  60. IMPLICIT REAL*8 (A-H,O-Z)
  61.  
  62. -INC PPARAM
  63. -INC CCOPTIO
  64.  
  65. -INC SMCHPOI
  66. -INC SMCHAML
  67. -INC SMMODEL
  68. -INC SMCOORD
  69.  
  70. PARAMETER (NBTYP=5)
  71. CHARACTER*4 MTYPE(NBTYP),MNORM(1)
  72. CHARACTER*(4) MOSCAL,MOPOI1
  73. CHARACTER*(LOCHAI) MOTLU
  74.  
  75. DATA MTYPE/'MASS','COQU','FISS','TUYA','SHB8'/
  76. DATA MNORM/'NORM'/
  77. DATA MOSCAL/'SCAL'/,MOPOI1/'POI1'/
  78.  
  79. MACRO,(MASSE,COQUE,FISSURE,TUYAU,COQUES_SHB8,SYNTAXE_2)
  80.  
  81. segact mcoord
  82. IPMODL = 0
  83. IPCHE1 = 0
  84. IPCHM1 = 0
  85. IPCHE2 = 0
  86. IPCHA1 = 0
  87. IRET = 0
  88.  
  89. C ON LIT UN MOT CLE
  90. CALL LIRMOT(MTYPE,NBTYP,IMLU,0)
  91. IF(IERR.NE.0) RETURN
  92. C Si pas de mot-cle de la 1ere syntaxe, alors c'est la 2e
  93. IF(IMLU.EQ.0) THEN
  94. CALL LIRCHA(MOTLU,0,ILONG)
  95. IF(IERR.NE.0) RETURN
  96. IF(ILONG .EQ. 0) MOTLU =' '
  97. IMLU =6
  98. ELSE
  99. MOTLU =MTYPE(IMLU)
  100. ENDIF
  101.  
  102. C ON LIT UN MMODEL
  103. CALL LIROBJ('MMODEL ',IPMODL,1,IRETMO)
  104. IF(IERR.NE.0) RETURN
  105. CALL ACTOBJ('MMODEL ',IPMODL,1)
  106. IF(IERR.NE.0) RETURN
  107.  
  108. C ON LIT UN CHAMP POINT (FACULTATIF)
  109. CALL LIROBJ('CHPOINT ',IPCHE1,0,IRETPO)
  110. IF(IERR.NE.0) RETURN
  111. IF(IRETPO .EQ. 1) CALL ACTOBJ('CHPOINT ',IPCHE1,1)
  112. IF(IERR.NE.0) RETURN
  113.  
  114.  
  115. CASE, IMLU
  116. C----------------------------------------------------------------------
  117. WHEN, MASSE
  118. C----------------------------------------------------------------------
  119. C ON LIT SOIT UN FLOTTANT ET UN MAILLAGE
  120. C SOIT UN CHPOINT (IRETPO.NE.0)
  121. C SOIT UN CHAMELEM (IRETEL.NE.0)
  122. C
  123. IPMAIL=0
  124. P=0.D0
  125. IF(IRETPO.EQ.0) THEN
  126. CALL LIROBJ('MCHAML ',IPCHM1,0,IRETEL)
  127. IF(IERR.NE.0) RETURN
  128. IF(IRETEL.EQ.1) THEN
  129. CALL ACTOBJ('MCHAML ',IPCHM1,1)
  130. ELSE
  131. IPCHM1 = 0
  132. CALL LIRREE(XXX,1,IRETOU)
  133. IF(IERR.NE.0) RETURN
  134. P=XXX
  135. CALL LIROBJ('MAILLAGE',IPMAIL,1,IRETMA)
  136. IF(IERR.NE.0) RETURN
  137. CALL ACTOBJ('MAILLAGE',IPMAIL,1)
  138. IF(IERR.NE.0) RETURN
  139. ENDIF
  140. ENDIF
  141. C
  142. CALL FPMASS(IPCHE1,IPCHM1,IPMODL,IPTFP,IPMAIL,P,IRET)
  143. IF(IRET.EQ.0.OR.IERR.NE.0) RETURN
  144. GOTO 666
  145.  
  146. C----------------------------------------------------------------------
  147. WHEN, COQUE
  148. C----------------------------------------------------------------------
  149. C ON LIT SOIT UN FLOTTANT
  150. C SOIT UN CHPOINT (IRETPO.NE.0)
  151. C SOIT UN CHAMELEM (IRETEL.NE.0)
  152. C
  153. P=0.D0
  154. IF(IRETPO.EQ.0) THEN
  155. CALL LIROBJ('MCHAML ',IPCHM1,0,IRETEL)
  156. IF(IERR.NE.0) RETURN
  157. IF(IRETEL.EQ.1) THEN
  158. CALL ACTOBJ('MCHAML ',IPCHM1,1)
  159. ELSE
  160. IPCHM1 = 0
  161. CALL LIRREE(XXX,1,IRETOU)
  162. IF(IERR.NE.0) RETURN
  163. P=XXX
  164. IPCHE1=0
  165. ENDIF
  166. ENDIF
  167. C
  168. C ON LIT LE MOT CLE NORM SINON ON APPELERA PRORIE QUI
  169. C LIRA SES DONNEES
  170. C
  171. CALL LIRMOT(MNORM,1,JMLU,0)
  172. IF(IERR.NE.0) RETURN
  173. C
  174. ** Comment je fais si je veux donner un vecteur?
  175. ** IF(JMLU.EQ.0) THEN
  176. ** CALL ERREUR(498)
  177. ** IF(IERR.NE.0) RETURN
  178. ** RETURN
  179. ** ENDIF
  180. C
  181. C LA LECTURE D'UN CHAMELEM DE CARACTERISTIQUE (FACULTATIVE
  182. C EST FAITE DANS FPCOQU
  183. C
  184. CALL FPCOQU(P,IPCHE1,IPCHM1,IPMODL,JMLU,IPTFP,IRET)
  185. IF(IRET.EQ.0 .OR. IERR.NE.0) RETURN
  186. GOTO 666
  187.  
  188. C----------------------------------------------------------------------
  189. WHEN, FISSURE
  190. C----------------------------------------------------------------------
  191. C ON LIT SOIT UN FLOTTANT ,SOIT UN CHPOINT
  192. C
  193. P=0.D0
  194. IF(IRETPO.EQ.0) THEN
  195. CALL LIRREE(XXX,1,IRETOU)
  196. IF(IERR.NE.0) RETURN
  197. P=XXX
  198. IPCHE1=0
  199. ENDIF
  200. C
  201. C ON LIT UN VECTEUR
  202. C
  203. CALL LIROBJ('POINT ',IPVECT,1,IRETVC)
  204. IF(IERR.NE.0) RETURN
  205. C
  206. C ON LIT UN POINT
  207. C
  208. CALL LIROBJ('POINT ',IPPOIN,1,IRETPT)
  209. IF(IERR.NE.0) RETURN
  210. C
  211. C ON LIT UN CHELEM DE CARACTERISTIQUES
  212. C
  213. CALL LIROBJ('MCHAML ',IPCHE2,1,IRETCH)
  214. IF(IERR.NE.0) RETURN
  215. CALL ACTOBJ('MCHAML ',IPCHE2,1)
  216. IF(IERR.NE.0) RETURN
  217. C
  218. CALL FPFISS(P,IPCHE1,IPMODL,IPVECT,IPPOIN,IPCHE2,IPTFP,IRET)
  219. IF (IRET.EQ.0.OR.IERR.NE.0) RETURN
  220. GOTO 666
  221.  
  222. C----------------------------------------------------------------------
  223. WHEN, TUYAU
  224. C----------------------------------------------------------------------
  225. C ON LIT UN OBJET CHAMELEM (CARACTERISTIQUES)
  226. C
  227. CALL LIROBJ('MCHAML ',IPCHE1,1,IRETC2)
  228. IF(IERR.NE.0) RETURN
  229. CALL ACTOBJ('MCHAML ',IPCHE1,1)
  230. IF(IERR.NE.0) RETURN
  231. C
  232. CALL FPTUYA(IPMODL,IPCHE1,IPTFP,IRET)
  233. IF (IERR.NE.0.OR.IRET.NE.1) RETURN
  234. GOTO 666
  235.  
  236. C----------------------------------------------------------------------
  237. WHEN, COQUES_SHB8
  238. C----------------------------------------------------------------------
  239. C ON LIT UN OBJET CHAMELEM (CARACTERISTIQUES)
  240. C
  241. IPMAIL=0
  242. P=0.D0
  243. IF(IRETPO.EQ.0) THEN
  244. CALL LIRREE(XXX,1,IRETOU)
  245. IF(IERR.NE.0) RETURN
  246. P = XXX
  247. ENDIF
  248. C
  249. CALL FPSHB8(IPMODL,IPCHE1,P,IPTFP)
  250. IF(IPTFP.EQ.0) RETURN
  251. GOTO 666
  252.  
  253. C----------------------------------------------------------------------
  254. WHEN, SYNTAXE_2
  255. C----------------------------------------------------------------------C
  256. C On extrait du MMODEL la formulation CHARGEMENT PRESSSION
  257. C --------------------------------------------------------
  258. MMODEL = IPMODL
  259. NSOUS = KMODEL(/1)
  260. N1 = NSOUS
  261. SEGINI,MMODE1
  262. IMCGP=0
  263. DO isous = 1, NSOUS
  264. IMODEL = KMODEL(isous)
  265. IF(FORMOD(1).EQ.'CHARGEMENT ') THEN
  266. NMAT = MATMOD(/2)
  267. CALL PLACE(MATMOD,NMAT,ipl,'PRESSION')
  268. IF(ipl.NE.0) THEN
  269. IMCGP = IMCGP + 1
  270. MMODE1.KMODEL(IMCGP) = IMODEL
  271. ENDIF
  272. ENDIF
  273. ENDDO
  274. C
  275. C Si pas de modele chargement pression : erreur !
  276. IF(IMCGP.EQ.0) THEN
  277. MOTERR(1:16)='PRESSION '
  278. CALL ERREUR(719)
  279. RETURN
  280. ELSE
  281. IPMODL=MMODE1
  282. ENDIF
  283. C
  284. C Cas du MCHALM en argument
  285. C -------------------------
  286. IF(MOTLU.EQ.' ') THEN
  287. CALL LIROBJ('MCHAML ',IPCHE1,1,IRET)
  288. IF(IERR.NE.0) RETURN
  289. CALL ACTOBJ('MCHAML ',IPCHE1,1)
  290. IF(IERR.NE.0) RETURN
  291. CALL REDUAF(IPCHE1,IPMODL,IPCHE2,1,IRET,KERRE)
  292. IF(IERR.NE.0) RETURN
  293. C
  294. IF(IRET.EQ.0) THEN
  295. CALL ERREUR(KERRE)
  296. RETURN
  297. ENDIF
  298. IPCHE1=IPCHE2
  299. C
  300. C Y' plus qu'a :
  301. CALL PRCHL1(IPMODL,IPCHE1,IPCHE2)
  302. IF(IERR.NE.0) RETURN
  303. C
  304. IF(IPCHE2.EQ.0) THEN
  305. CALL ERREUR(5)
  306. RETURN
  307. ENDIF
  308.  
  309. ELSE
  310. C Cas avec MOT1, VAL1... en arguments
  311. C -----------------------------------
  312. C
  313. C Lecture optionnelle d'un maillage
  314. CALL LIROBJ('MAILLAGE',IPGEO1,0,IRET)
  315. IF(IERR.NE.0) RETURN
  316. C
  317. C Si un maillage est fourni, on reduit le modele sur le maillage
  318. IF(IRET.EQ.1) THEN
  319. CALL ACTOBJ('MAILLAGE',IPGEO1,1)
  320. CALL REDUMO(IPMODL,IPGEO1,IRET)
  321. IF(IERR.NE.0) RETURN
  322. C
  323. IF(IRET.NE.0) THEN
  324. SEGSUP,MMODE1
  325. IPMODL=IRET
  326. ENDIF
  327. ENDIF
  328. C
  329. C Lecture du FLOTTANT
  330. CALL LIRREE(XP1,1,IRET)
  331. IF(IERR.NE.0) RETURN
  332. C
  333. C Sous-programme PRCHL2 : IPCHE2 contient le MCHAML resultat / 0 si echec
  334. CALL PRCHL2(IPMODL,MOTLU,XP1,IPCHE2)
  335. IF(IERR.NE.0) RETURN
  336. C
  337. IF(IPCHE2.EQ.0) THEN
  338. CALL ERREUR(5)
  339. RETURN
  340. ENDIF
  341. ENDIF
  342.  
  343. CALL ACTOBJ('MCHAML ',IPCHE2,1)
  344. CALL ECROBJ('MCHAML ',IPCHE2)
  345.  
  346. ENDCASE
  347. RETURN
  348.  
  349. 666 CONTINUE
  350. C LE NUMERO DE L HARMONIQUE EST PRIS EGAL A NIFOUR
  351. C POUR TOUTES LES COMPOSANTES DU CHPOINT
  352. MCHPOI = IPTFP
  353. NSOUPO = IPCHP(/1)
  354. NAT =JATTRI(/1)
  355. NAT2=MAX(NAT,1)
  356. IF(NAT .NE. NAT2)THEN
  357. C SEGADJ seulement si necessaire (reduit l'acces ESOPE)
  358. NAT=NAT2
  359. SEGADJ MCHPOI
  360. ENDIF
  361.  
  362. C Le champ de force nodale est discret.
  363.  
  364. JATTRI(1) = 2
  365. DO 100 IA=1,NSOUPO
  366. MSOUPO=IPCHP(IA)
  367. segact msoupo*mod
  368. DO 101 NC=1,NOHARM(/1)
  369. NOHARM(NC)=NIFOUR
  370. 101 CONTINUE
  371. 100 CONTINUE
  372.  
  373. CALL ACTOBJ('CHPOINT ',IPTFP,1)
  374. CALL ECROBJ('CHPOINT ',IPTFP)
  375.  
  376. END
  377.  
  378.  
  379.  

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