Télécharger pre11.eso

Retour à la liste

Numérotation des lignes :

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

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