Télécharger pre21.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE21 SOURCE CB215821 19/07/31 21:16:20 10277
  2. SUBROUTINE PRE21()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRE21
  8. C
  9. C DESCRIPTION : Voir PRE2
  10. C
  11. C Cas gaz parfait multiespeces
  12. C
  13. C 1er ordre en espace, 1er ordre en temps
  14. C
  15. C Creations des object MCHAML IROF, IVITF, IPF, IYF
  16. C IGAMF
  17. C
  18. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  19. C
  20. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  21. C
  22. C************************************************************************
  23. C
  24. C
  25. C APPELES (Outils) : LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ,
  26. C QUEPOI, ECROBJ
  27. C
  28. C APPELES (Calcul) : PRE211 (2D)
  29. C
  30. C
  31. C************************************************************************
  32. C
  33. C HISTORIQUE (Anomalies et modifications éventuelles)
  34. C
  35. C HISTORIQUE : Créée le 11.6.98.
  36. C
  37. C************************************************************************
  38. C
  39. C
  40. C**** Variables de COOPTIO
  41. C
  42. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  43. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  44. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  45. C & ,IECHO, IIMPI, IOSPI
  46. C & ,IDIM
  47. C & ,MCOORD
  48. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  49. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  50. C & ,NORINC,NORVAL,NORIND,NORVAD
  51. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  52. C
  53. C**** Les variables
  54. C
  55. IMPLICIT INTEGER(I-N)
  56. INTEGER ICOND, IRETOU, IERR0, INDIC, NBCOMP
  57. & ,IDOMA, ICEN, IFACE, IFACEL, INORM, IROC, IVITC, IPC
  58. & ,IYC, IGAMC, IROF, IVITF, IPF, IYF, IGAMF, INEFMD
  59. & ,JGM,JGN,MMODEL
  60. C
  61. REAL*8 VALER, VAL1, VAL2
  62. CHARACTER*(4) NOMTOT(3)
  63. CHARACTER*(8) MTYPR, TYPE
  64. CHARACTER*(40) MESERR
  65. LOGICAL LOGAN,LOGNEG, LOGBOR
  66. C
  67. C**** Les Includes
  68. C
  69.  
  70. -INC PPARAM
  71. -INC CCOPTIO
  72. -INC SMLMOTS
  73. POINTEUR MLMVIT.MLMOTS
  74. C
  75. C**** Initialisation des parametres d'erreur
  76. C
  77. LOGAN = .FALSE.
  78. LOGNEG = .FALSE.
  79. LOGBOR = .FALSE.
  80. MESERR = ' '
  81. MOTERR(1:40) = MESERR(1:40)
  82. VALER = 0.0D0
  83. VAL1 = 0.0D0
  84. VAL2 = 0.0D0
  85. C
  86. C**** Initialisation des NOMTOT
  87. C
  88. NOMTOT(1) = ' '
  89. NOMTOT(2) = ' '
  90. NOMTOT(3) = ' '
  91. C
  92. C**** Lecture de l'objet MODELE
  93. C
  94. ICOND = 1
  95. CALL QUETYP(TYPE,ICOND,IRETOU)
  96.  
  97. IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  98. WRITE(6,*)' On attend un objet MMODEL'
  99. RETURN
  100. ENDIF
  101. CALL LIROBJ('MMODEL ',MMODEL,ICOND,IRETOU)
  102. CALL ACTOBJ('MMODEL ',MMODEL,1)
  103. IF(IERR.NE.0)GOTO 9999
  104. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  105. IF(IERR.NE.0)GOTO 9999
  106. C
  107. C**** Lecture du MELEME SPG des points CENTRE.
  108. C
  109. C
  110. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  111. C
  112. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  113. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  114. C -> la correspondance global des noeuds saut!
  115. C
  116. C On peut utilizer ACCTAB ou ACMO
  117. C
  118. MTYPR = 'MAILLAGE'
  119. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  120. IF(IERR.NE.0)GOTO 9999
  121. C
  122. C**** Lecture du MELEME 'FACE'
  123. C
  124. MTYPR = 'MAILLAGE'
  125. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  126. IF(IERR.NE.0)GOTO 9999
  127. C
  128. C**** Lecture du MELEME 'FACEL'
  129. C
  130. MTYPR = 'MAILLAGE'
  131. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  132. IF(IERR.NE.0)GOTO 9999
  133. C
  134. C**** Lecture du CHPOINT contenant les normales aux faces
  135. C
  136. IF(IDIM .EQ. 2)THEN
  137. C Que les normales
  138. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  139. IF(IERR .NE. 0) GOTO 9999
  140. JGN = 4
  141. JGM = 2
  142. SEGINI MLMVIT
  143. MLMVIT.MOTS(1) = 'UX '
  144. MLMVIT.MOTS(2) = 'UY '
  145. CALL QUEPO1(INORM, IFACE, MLMVIT)
  146. SEGSUP MLMVIT
  147. IF(IERR.NE.0)GOTO 9999
  148. ELSE
  149. C Les normales et les tangentes
  150. MTYPR = ' '
  151. CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
  152. IF (MTYPR .NE. 'CHPOINT ') THEN
  153. CALL MATRAN(IDOMA,INORM)
  154. IF(IERR .NE. 0) GOTO 9999
  155. ENDIF
  156. C UX UY UZ RX RY RZ MX MY MZ
  157. JGN = 4
  158. JGM = 9
  159. SEGINI MLMVIT
  160. MLMVIT.MOTS(1) = 'UX '
  161. MLMVIT.MOTS(2) = 'UY '
  162. MLMVIT.MOTS(3) = 'UZ '
  163. MLMVIT.MOTS(4) = 'RX '
  164. MLMVIT.MOTS(5) = 'RY '
  165. MLMVIT.MOTS(6) = 'RZ '
  166. MLMVIT.MOTS(7) = 'MX '
  167. MLMVIT.MOTS(8) = 'MY '
  168. MLMVIT.MOTS(9) = 'MZ '
  169. CALL QUEPO1(INORM, IFACE, MLMVIT)
  170. SEGSUP MLMVIT
  171. IF(IERR.NE.0)GOTO 9999
  172. ENDIF
  173. C
  174. C**** Lecture du CHPOINT ROC
  175. C
  176. ICOND = 1
  177. CALL QUETYP(MTYPR,ICOND,IRETOU)
  178. IF(IERR .NE. 0)GOTO 9999
  179. IF(MTYPR .NE. 'CHPOINT ')THEN
  180. C
  181. C******* Message d'erreur standard
  182. C 37 2
  183. C On ne trouve pas d'objet de type %m1:8
  184. C
  185. MOTERR(1:8) = 'CHPOINT '
  186. CALL ERREUR(37)
  187. GOTO 9999
  188. ELSE
  189. ICOND = 1
  190. CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU)
  191. CALL ACTOBJ(MTYPR,IROC,1)
  192. IF (IERR.NE.0) GOTO 9999
  193. ENDIF
  194. C
  195. C**** Control du CHPOINT: QUEPOI
  196. C
  197. C INDIC = 1 -> on impose le pointeur du support geometrique (IM1)
  198. C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1)
  199. C
  200. C NBCOMP > 0 -> numero des composantes
  201. C
  202. C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  203. C
  204. INDIC = 1
  205. NBCOMP = 1
  206. NOMTOT(1) = 'SCAL'
  207. CALL QUEPOI(IROC, ICEN, INDIC, NBCOMP, NOMTOT)
  208. IF(IERR .NE. 0)THEN
  209. IERR0 = IERR
  210.  
  211. C
  212. C******* Message d'erreur standard
  213. C -301 0 %m1:40
  214. C
  215. MOTERR(1:40) = 'CHPO1 = ??? '
  216. CALL ERREUR(-301)
  217.  
  218. GOTO 9999
  219. ENDIF
  220. C
  221. C**** Lecture du CHPOINT VITC
  222. C
  223. ICOND = 1
  224. CALL QUETYP(MTYPR,ICOND,IRETOU)
  225. IF(IERR .NE. 0)GOTO 9999
  226. IF(MTYPR .NE. 'CHPOINT ')THEN
  227. C
  228. C******* Message d'erreur standard
  229. C 37 2
  230. C On ne trouve pas d'objet de type %m1:8
  231. C
  232. MOTERR(1:8) = 'CHPOINT '
  233. CALL ERREUR(37)
  234. GOTO 9999
  235. ELSE
  236. ICOND = 1
  237. CALL LIROBJ('CHPOINT ',IVITC,ICOND,IRETOU)
  238. CALL ACTOBJ('CHPOINT ',IVITC,1)
  239. IF (IERR.NE.0) GOTO 9999
  240. ENDIF
  241. C
  242. C**** Control du CHPOINT
  243. C
  244. INDIC = 1
  245. NBCOMP = IDIM
  246. NOMTOT(1) = 'UX '
  247. NOMTOT(2) = 'UY '
  248. IF(IDIM .EQ. 3) NOMTOT(3) = 'UZ '
  249. CALL QUEPOI(IVITC, ICEN, INDIC, NBCOMP, NOMTOT)
  250. IF(IERR .NE. 0)THEN
  251. IERR0 = IERR
  252.  
  253. C
  254. C******* Message d'erreur standard
  255. C -301 0 %m1:40
  256. C
  257. MOTERR(1:40) = 'CHPO2 = ??? '
  258. CALL ERREUR(-301)
  259.  
  260. GOTO 9999
  261. ENDIF
  262. C
  263. C**** Lecture du CHPOINT PC
  264. C
  265. ICOND = 1
  266. CALL QUETYP(MTYPR,ICOND,IRETOU)
  267. IF(IERR .NE. 0)GOTO 9999
  268. IF(MTYPR .NE. 'CHPOINT ')THEN
  269. C
  270. C******* Message d'erreur standard
  271. C 37 2
  272. C On ne trouve pas d'objet de type %m1:8
  273. C
  274. MOTERR(1:8) = 'CHPOINT '
  275. CALL ERREUR(37)
  276. GOTO 9999
  277. ELSE
  278. ICOND = 1
  279. CALL LIROBJ('CHPOINT ',IPC,ICOND,IRETOU)
  280. CALL ACTOBJ('CHPOINT ',IPC,1)
  281. IF (IERR.NE.0) GOTO 9999
  282. ENDIF
  283. C
  284. C**** Control du CHPOINT
  285. C
  286. INDIC = 1
  287. NBCOMP = 1
  288. NOMTOT(1) = 'SCAL'
  289. CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT)
  290. IF(IERR .NE. 0)THEN
  291. IERR0 = IERR
  292.  
  293. C
  294. C******* Message d'erreur standard
  295. C -301 0 %m1:40
  296. C
  297. MOTERR(1:40) = 'CHPO3 = ??? '
  298. CALL ERREUR(-301)
  299.  
  300. GOTO 9999
  301. ENDIF
  302. C
  303. C**** Lecture du CHPOINT YC
  304. C
  305. ICOND = 1
  306. CALL QUETYP(MTYPR,ICOND,IRETOU)
  307. IF(IERR .NE. 0)GOTO 9999
  308. IF(MTYPR .NE. 'CHPOINT ')THEN
  309. C
  310. C******* Message d'erreur standard
  311. C 37 2
  312. C On ne trouve pas d'objet de type %m1:8
  313. C
  314. MOTERR(1:8) = 'CHPOINT '
  315. CALL ERREUR(37)
  316. GOTO 9999
  317. ELSE
  318. ICOND = 1
  319. CALL LIROBJ('CHPOINT ',IYC,ICOND,IRETOU)
  320. CALL ACTOBJ('CHPOINT ',IYC,1)
  321. IF (IERR.NE.0) GOTO 9999
  322. ENDIF
  323. C
  324. C**** Control du CHPOINT (on ne controlle que le maillage)
  325. C
  326. INDIC = 1
  327. NBCOMP = -1
  328. NOMTOT(1) = ' '
  329. CALL QUEPOI(IYC, ICEN, INDIC, NBCOMP, NOMTOT)
  330. IF(IERR .NE. 0)THEN
  331. IERR0 = IERR
  332.  
  333. C
  334. C******* Message d'erreur standard
  335. C -301 0 %m1:40
  336. C
  337. MOTERR(1:40) = 'CHPO4 = ??? '
  338. CALL ERREUR(-301)
  339.  
  340. GOTO 9999
  341. ENDIF
  342. C
  343. C**** Lecture du CHPOINT GAMC
  344. C
  345. ICOND = 1
  346. CALL QUETYP(MTYPR,ICOND,IRETOU)
  347. IF(IERR .NE. 0)GOTO 9999
  348. IF(MTYPR .NE. 'CHPOINT ')THEN
  349. C
  350. C******* Message d'erreur standard
  351. C 37 2
  352. C On ne trouve pas d'objet de type %m1:8
  353. C
  354. MOTERR(1:8) = 'CHPOINT '
  355. CALL ERREUR(37)
  356. GOTO 9999
  357. ELSE
  358. ICOND = 1
  359. CALL LIROBJ('CHPOINT ',IGAMC,ICOND,IRETOU)
  360. CALL ACTOBJ('CHPOINT ',IGAMC,1)
  361. IF (IERR.NE.0) GOTO 9999
  362. ENDIF
  363. C
  364. C**** Control du CHPOINT
  365. C
  366. INDIC = 1
  367. NBCOMP = 1
  368. NOMTOT(1) = 'SCAL'
  369. CALL QUEPOI(IGAMC, ICEN, INDIC, NBCOMP, NOMTOT)
  370. IF(IERR .NE. 0)THEN
  371. IERR0 = IERR
  372.  
  373. C
  374. C******* Message d'erreur standard
  375. C -301 0 %m1:40
  376. C
  377. MOTERR(1:40) = 'CHPO5 = ??? '
  378. CALL ERREUR(-301)
  379.  
  380. GOTO 9999
  381. ENDIF
  382. C
  383. C**** Centre -> Face
  384. C
  385. IF(IDIM .EQ. 2)THEN
  386. C
  387. C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  388. C temps
  389. C
  390. CALL PRE211(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,IGAMC,
  391. & IROF,IVITF,IPF,IYF,IGAMF,
  392. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  393. ELSE
  394. C
  395. C******* Trois Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  396. C temps
  397. C
  398. CALL PRE212(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,IGAMC,
  399. & IROF,IVITF,IPF,IYF,IGAMF,
  400. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  401. ENDIF
  402. C
  403. C**** Messages d'erreur
  404. C
  405. IF(LOGAN)THEN
  406. C
  407. C******* Anomalie detectée
  408. C
  409. C
  410. C******* Message d'erreur standard
  411. C -301 0
  412. C %m1:40
  413. C
  414. MOTERR(1:40) = MESERR(1:40)
  415. CALL ERREUR(-301)
  416. C
  417. C******* Message d'erreur standard
  418. C 5 3
  419. C Erreur anormale.contactez votre support
  420. C
  421. CALL ERREUR(5)
  422. GOTO 9999
  423. C
  424. ELSEIF(LOGNEG)THEN
  425. C
  426. C******* Message d'erreur standard
  427. C 41 2
  428. C %m1:8 = %r1 inférieur à %r2
  429. C
  430. MOTERR(1:8) = MESERR(1:8)
  431. REAERR(1) = REAL(VALER)
  432. REAERR(2) = 0.0
  433. CALL ERREUR(41)
  434. GOTO 9999
  435. ELSEIF(LOGBOR)THEN
  436. C
  437. C******* Message d'erreur standard
  438. C 42 2
  439. C %m1:8 = %r1 non compris entre %r2 et %r3
  440. C
  441. MOTERR(1:8) = MESERR(1:8)
  442. REAERR(1) = REAL(VALER)
  443. REAERR(2) = REAL(VAL1)
  444. REAERR(3) = REAL(VAL2)
  445. CALL ERREUR(42)
  446. GOTO 9999
  447. ELSE
  448. C
  449. C******* Ecriture de ROF, VITF, PF, YF, GAMMAF
  450. C
  451. MTYPR = 'MCHAML '
  452. CALL ACTOBJ(MTYPR,IGAMF,1)
  453. CALL ACTOBJ(MTYPR,IYF,1)
  454. CALL ACTOBJ(MTYPR,IPF,1)
  455. CALL ACTOBJ(MTYPR,IVITF,1)
  456. CALL ACTOBJ(MTYPR,IROF,1)
  457.  
  458. CALL ECROBJ(MTYPR,IGAMF)
  459. CALL ECROBJ(MTYPR,IYF)
  460. CALL ECROBJ(MTYPR,IPF)
  461. CALL ECROBJ(MTYPR,IVITF)
  462. CALL ECROBJ(MTYPR,IROF)
  463. ENDIF
  464. C
  465. 9999 CONTINUE
  466. END
  467.  
  468.  
  469.  

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