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.  
  69. -INC PPARAM
  70. -INC CCOPTIO
  71. -INC SMLMOTS
  72. POINTEUR MLMVIT.MLMOTS
  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. 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(IRETOU .EQ. 1) CALL ACTOBJ(MTYPR,IROC,1)
  189. IF (IERR.NE.0) GOTO 9999
  190. ENDIF
  191. C
  192. C**** Control du CHPOINT: QUEPOI
  193. C
  194. C INDIC = 1 -> on impose le pointeur du support geometrique (IM1)
  195. C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1)
  196. C
  197. C NBCOMP > 0 -> numero des composantes
  198. C
  199. C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  200. C
  201. INDIC = 1
  202. NBCOMP = 1
  203. NOMTOT(1) = 'SCAL'
  204. CALL QUEPOI(IROC, ICEN, INDIC, NBCOMP, NOMTOT)
  205. IF(IERR .NE. 0)THEN
  206. IERR0 = IERR
  207.  
  208. C
  209. C******* Message d'erreur standard
  210. C -301 0 %m1:40
  211. C
  212. MOTERR(1:40) = 'CHPO1 = ??? '
  213. WRITE(IOIMP,*) MOTERR
  214.  
  215. GOTO 9999
  216. ENDIF
  217. C
  218. C**** Lecture du CHPOINT VITC
  219. C
  220. ICOND = 1
  221. CALL QUETYP(MTYPR,ICOND,IRETOU)
  222. IF(IERR .NE. 0)GOTO 9999
  223. IF(MTYPR .NE. 'CHPOINT ')THEN
  224. C
  225. C******* Message d'erreur standard
  226. C 37 2
  227. C On ne trouve pas d'objet de type %m1:8
  228. C
  229. MOTERR(1:8) = 'CHPOINT '
  230. CALL ERREUR(37)
  231. GOTO 9999
  232. ELSE
  233. ICOND = 1
  234. CALL LIROBJ('CHPOINT ',IVITC,ICOND,IRETOU)
  235. CALL ACTOBJ('CHPOINT ',IVITC,1)
  236. IF (IERR.NE.0) GOTO 9999
  237. ENDIF
  238. C
  239. C**** Control du CHPOINT
  240. C
  241. JGN = 4
  242. JGM = IDIM
  243. SEGINI MLMVIT
  244. MLMVIT.MOTS(1) = 'UX '
  245. MLMVIT.MOTS(2) = 'UY '
  246. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  247. CALL QUEPO1(IVITC, ICEN, MLMVIT)
  248. SEGSUP MLMVIT
  249. IF(IERR .NE. 0)THEN
  250. IERR0 = IERR
  251.  
  252. C
  253. C******* Message d'erreur standard
  254. C -301 0 %m1:40
  255. C
  256. MOTERR(1:40) = 'CHPO2 = ??? '
  257. WRITE(IOIMP,*) MOTERR
  258.  
  259. GOTO 9999
  260. ENDIF
  261. C
  262. C**** Lecture du CHPOINT PC
  263. C
  264. ICOND = 1
  265. CALL QUETYP(MTYPR,ICOND,IRETOU)
  266. IF(IERR .NE. 0)GOTO 9999
  267. IF(MTYPR .NE. 'CHPOINT ')THEN
  268. C
  269. C******* Message d'erreur standard
  270. C 37 2
  271. C On ne trouve pas d'objet de type %m1:8
  272. C
  273. MOTERR(1:8) = 'CHPOINT '
  274. CALL ERREUR(37)
  275. GOTO 9999
  276. ELSE
  277. ICOND = 1
  278. CALL LIROBJ('CHPOINT ',IPC,ICOND,IRETOU)
  279. CALL ACTOBJ('CHPOINT ',IPC,1)
  280. IF (IERR.NE.0) GOTO 9999
  281. ENDIF
  282. C
  283. C**** Control du CHPOINT
  284. C
  285. INDIC = 1
  286. NBCOMP = 1
  287. NOMTOT(1) = 'SCAL'
  288. CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT)
  289. IF(IERR .NE. 0)THEN
  290. IERR0 = IERR
  291.  
  292. C
  293. C******* Message d'erreur standard
  294. C -301 0 %m1:40
  295. C
  296. MOTERR(1:40) = 'CHPO3 = ??? '
  297. WRITE(IOIMP,*) MOTERR
  298.  
  299. GOTO 9999
  300. ENDIF
  301. C
  302. C**** Lecture du CHPOINT GAMC
  303. C
  304. ICOND = 1
  305. CALL QUETYP(MTYPR,ICOND,IRETOU)
  306. IF(IERR .NE. 0)GOTO 9999
  307. IF(MTYPR .NE. 'CHPOINT ')THEN
  308. C
  309. C******* Message d'erreur standard
  310. C 37 2
  311. C On ne trouve pas d'objet de type %m1:8
  312. C
  313. MOTERR(1:8) = 'CHPOINT '
  314. CALL ERREUR(37)
  315. GOTO 9999
  316. ELSE
  317. ICOND = 1
  318. CALL LIROBJ('CHPOINT',IGAMC,ICOND,IRETOU)
  319. CALL ACTOBJ('CHPOINT',IGAMC,1)
  320. IF (IERR.NE.0) GOTO 9999
  321. ENDIF
  322. C
  323. C**** Control du CHPOINT
  324. C
  325. INDIC = 1
  326. NBCOMP = 1
  327. NOMTOT(1) = 'SCAL'
  328. CALL QUEPOI(IGAMC, ICEN, INDIC, NBCOMP, NOMTOT)
  329. IF(IERR .NE. 0)THEN
  330. IERR0 = IERR
  331.  
  332. C
  333. C******* Message d'erreur standard
  334. C -301 0 %m1:40
  335. C
  336. MOTERR(1:40) = 'CHPO4 = ??? '
  337. WRITE(IOIMP,*) MOTERR
  338.  
  339. GOTO 9999
  340. ENDIF
  341. C
  342. C**** Centre -> Face
  343. C
  344. IF(IDIM .EQ. 2)THEN
  345. C
  346. C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  347. C temps
  348. C
  349. CALL PRE111(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IGAMC,
  350. & IROF,IVITF,IPF,IGAMF,
  351. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  352. ELSE
  353. C
  354. C******* Trois Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  355. C temps
  356. C
  357. C
  358. CALL PRE112(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IGAMC,
  359. & IROF,IVITF,IPF,IGAMF,
  360. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  361. ENDIF
  362. C
  363. C**** Messages d'erreur
  364. C
  365. IF(LOGAN)THEN
  366. C
  367. C******* Anomalie detectée
  368. C
  369. C
  370. C******* Message d'erreur standard
  371. C -301 0
  372. C %m1:40
  373. C
  374. MOTERR(1:40) = MESERR(1:40)
  375. WRITE(IOIMP,*) MOTERR
  376. C
  377. C******* Message d'erreur standard
  378. C 5 3
  379. C Erreur anormale.contactez votre support
  380. C
  381. CALL ERREUR(5)
  382. GOTO 9999
  383. C
  384. ELSEIF(LOGNEG)THEN
  385. C
  386. C******* Message d'erreur standard
  387. C 41 2
  388. C %m1:8 = %r1 inférieur à %r2
  389. C
  390. MOTERR(1:8) = MESERR(1:8)
  391. REAERR(1) = REAL(VALER)
  392. REAERR(2) = 0.0
  393. CALL ERREUR(41)
  394. GOTO 9999
  395. ELSEIF(LOGBOR)THEN
  396. C
  397. C******* Message d'erreur standard
  398. C 42 2
  399. C %m1:8 = %r1 non compris entre %r2 et %r3
  400. C
  401. MOTERR(1:8) = MESERR(1:8)
  402. REAERR(1) = REAL(VALER)
  403. REAERR(2) = REAL(VAL1)
  404. REAERR(3) = REAL(VAL2)
  405. CALL ERREUR(42)
  406. GOTO 9999
  407. ELSE
  408. C
  409. C******* Ecriture de ROF, VITF, PF
  410. C
  411. MTYPR = 'MCHAML'
  412. CALL ECROBJ(MTYPR,IGAMF)
  413. CALL ECROBJ(MTYPR,IPF)
  414. CALL ECROBJ(MTYPR,IVITF)
  415. CALL ECROBJ(MTYPR,IROF)
  416. ENDIF
  417. C
  418. 9999 CONTINUE
  419. C
  420. RETURN
  421. END
  422.  
  423.  
  424.  

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