Télécharger pre21.eso

Retour à la liste

Numérotation des lignes :

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

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