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

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