Télécharger pre11.eso

Retour à la liste

Numérotation des lignes :

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

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