Télécharger pre22.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE22 SOURCE CB215821 19/07/31 21:16:21 10277
  2. SUBROUTINE PRE22(ORDTEM)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRE22
  8. C
  9. C DESCRIPTION : Voir PRE2
  10. C
  11. C Gas gaz parfait, multi-especes.
  12. C
  13. C 2me ordre en espace (1er ou 2me ordre en temps)
  14. C
  15. C Creations des object MCHAML IROF, IVITF, IPF,
  16. C IGAMF, IYF
  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 ACMM, ACCTAB, QUEPOI, ECROBJ
  27. C
  28. C
  29. C APPELES (Calcul) : PRE221 (2D)
  30. C
  31. C
  32. C************************************************************************
  33. C
  34. C HISTORIQUE (Anomalies et modifications éventuelles)
  35. C
  36. C HISTORIQUE : Créée le 10.7.98.
  37. C
  38. C************************************************************************
  39. C
  40. C
  41. C**** Variables de COOPTIO
  42. C
  43. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  44. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  45. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  46. C & ,IECHO, IIMPI, IOSPI
  47. C & ,IDIM
  48. C & ,MCOORD
  49. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  50. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  51. C & ,NORINC,NORVAL,NORIND,NORVAD
  52. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  53. C
  54. C**** Les variables
  55. C
  56. IMPLICIT INTEGER(I-N)
  57. INTEGER ORDTEM, ICOND, IRETOU, IERR0, INDIC, NBCOMP
  58. & ,IDOMA, ICEN, IFACE, IFACEL, INORM
  59. & ,IROC, IGRROC, IALROC
  60. & ,IVITC, IGRVC, IALVC
  61. & ,IPC ,IGRPC, IALPC
  62. & ,IGAMC, IROF, IVITF, IPF, IGAMF
  63. & ,IPGAS, ICP, ICV, NESP, I1, JG
  64. & ,IYC, IGRYC, IALYC, IYF
  65. & ,JGM,JGN,MMODEL, I2, ICEL
  66. REAL*8 VALER, VAL1, VAL2, DELTAT, CP, CV
  67. CHARACTER*(4) NOMTOT(9), CELLCH
  68. CHARACTER*(8) MTYPR, TYPE
  69. CHARACTER*(40) MESERR
  70. CHARACTER*(4) NOMGRA(27),NOMLIM(9)
  71. LOGICAL LOGAN,LOGNEG, LOGBOR,LOGTEM
  72. C
  73. C**** Variables en ACCTAB
  74. C
  75. INTEGER IVALI, IRETI,IVALR, IRETR, INEFMD
  76. REAL*8 XVALI,XVALR
  77. LOGICAL LOGII, LOGIR
  78. CHARACTER*(8) CHARR,MTYPI
  79. C
  80. C**** Nom de composantes de gradients (HP. <= 9 composantes)
  81. C
  82. DATA NOMGRA /'P1DX','P1DY','P1DZ',
  83. & 'P2DX','P2DY','P2DZ',
  84. & 'P3DX','P3DY','P3DZ',
  85. & 'P4DX','P4DY','P4DZ',
  86. & 'P5DX','P5DY','P5DZ',
  87. & 'P6DX','P6DY','P6DZ',
  88. & 'P7DX','P7DY','P7DZ',
  89. & 'P8DX','P8DY','P8DZ',
  90. & 'P9DX','P9DY','P9DZ'/
  91. C
  92. DATA NOMLIM /'P1 ',
  93. & 'P2 ',
  94. & 'P3 ',
  95. & 'P4 ',
  96. & 'P5 ',
  97. & 'P6 ',
  98. & 'P7 ',
  99. & 'P8 ',
  100. & 'P9 '/
  101. C
  102. C**** Les Includes
  103. C
  104. -INC CCOPTIO
  105. -INC SMLMOTS
  106. -INC SMLREEL
  107. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  108. POINTEUR MLMVIT.MLMOTS, MLMCOM.MLMOTS
  109. POINTEUR MLMESP.MLMOTS
  110. C
  111. C**** Initialisation des parametres d'erreur
  112. C
  113. LOGAN = .FALSE.
  114. LOGNEG = .FALSE.
  115. LOGBOR = .FALSE.
  116. MESERR = ' '
  117. MOTERR(1:40) = MESERR(1:40)
  118. VALER = 0.0D0
  119. VAL1 = 0.0D0
  120. VAL2 = 0.0D0
  121. C
  122. C**** Initialisation des NOMTOT
  123. C
  124. NOMTOT(1) = ' '
  125. NOMTOT(2) = ' '
  126. NOMTOT(3) = ' '
  127. NOMTOT(4) = ' '
  128. NOMTOT(5) = ' '
  129. NOMTOT(6) = ' '
  130. NOMTOT(7) = ' '
  131. NOMTOT(8) = ' '
  132. NOMTOT(9) = ' '
  133. C
  134. C**** Lecture de l'objet MODELE
  135. C
  136. ICOND = 1
  137. CALL QUETYP(TYPE,ICOND,IRETOU)
  138. CALL LIROBJ('MMODEL ',MMODEL,ICOND,IRETOU)
  139. CALL ACTOBJ('MMODEL ',MMODEL,1)
  140. IF(IERR.NE.0)GOTO 9999
  141. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  142. IF(IERR.NE.0)GOTO 9999
  143. C
  144. C**** Lecture du MELEME SPG des points CENTRE.
  145. C
  146. C
  147. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  148. C
  149. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  150. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  151. C -> la correspondance global des noeuds saut!
  152. C
  153. C On peut utilizer ACCTAB ou ACMO
  154. C
  155. MTYPR = 'MAILLAGE'
  156. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  157. IF(IERR.NE.0)GOTO 9999
  158. C
  159. C**** Lecture du MELEME 'FACE'
  160. C
  161. MTYPR = 'MAILLAGE'
  162. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  163. IF(IERR.NE.0)GOTO 9999
  164. C
  165. C**** Lecture du MELEME 'FACEL'
  166. C
  167. MTYPR = 'MAILLAGE'
  168. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  169. IF(IERR.NE.0)GOTO 9999
  170. C
  171. C**** Lecture du CHPOINT contenant les normales aux faces
  172. C
  173. IF(IDIM .EQ. 2)THEN
  174. C Que les normales
  175. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  176. IF(IERR .NE. 0) GOTO 9999
  177. JGN = 4
  178. JGM = 2
  179. SEGINI MLMVIT
  180. MLMVIT.MOTS(1) = 'UX '
  181. MLMVIT.MOTS(2) = 'UY '
  182. CALL QUEPO1(INORM, IFACE, MLMVIT)
  183. SEGSUP MLMVIT
  184. IF(IERR.NE.0)GOTO 9999
  185. ELSE
  186. C Les normales et les tangentes
  187. MTYPR = ' '
  188. CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
  189. IF (MTYPR .NE. 'CHPOINT ') THEN
  190. CALL MATRAN(IDOMA,INORM)
  191. IF(IERR .NE. 0) GOTO 9999
  192. ENDIF
  193. JGN = 4
  194. JGM = 9
  195. SEGINI MLMVIT
  196. MLMVIT.MOTS(1) = 'UX '
  197. MLMVIT.MOTS(2) = 'UY '
  198. MLMVIT.MOTS(3) = 'UZ '
  199. MLMVIT.MOTS(4) = 'RX '
  200. MLMVIT.MOTS(5) = 'RY '
  201. MLMVIT.MOTS(6) = 'RZ '
  202. MLMVIT.MOTS(7) = 'MX '
  203. MLMVIT.MOTS(8) = 'MY '
  204. MLMVIT.MOTS(9) = 'MZ '
  205. CALL QUEPO1(INORM, IFACE, MLMVIT)
  206. SEGSUP MLMVIT
  207. IF(IERR.NE.0)GOTO 9999
  208. C
  209. ENDIF
  210. C
  211. C**** N.B. On veut lire les objets sequentiellement.
  212. C Donc on utilise QUETYP pour controler que
  213. C le type de l'objet soit le bon.
  214. C
  215. C**** Lecture de la table des proprietes du gaz
  216. C
  217. ICOND = 1
  218. CALL QUETYP(MTYPR,ICOND,IRETOU)
  219. IF(IERR .NE. 0)GOTO 9999
  220. IF(MTYPR .NE. 'TABLE ')THEN
  221. C
  222. C******* Message d'erreur standard
  223. C 37 2
  224. C On ne trouve pas d'objet de type %m1:8
  225. C
  226. MOTERR(1:8) = 'TABLE '
  227. CALL ERREUR(37)
  228. GOTO 9999
  229. ELSE
  230. ICOND = 1
  231. CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
  232. CALL ACTOBJ(MTYPR,IPGAS,1)
  233. IF(IERR .NE. 0)GOTO 9999
  234. ENDIF
  235. C
  236. C N.B: la table des propietes des gaz a ete deja controlle en PRIMIT
  237. C donc on ne la controlle pas ici!!!
  238. C
  239. C**** Les CPs
  240. C
  241. MTYPR = ' '
  242. CALL ACMO(IPGAS,'CP',MTYPR,ICP)
  243. IF(IERR .NE. 0)GOTO 9999
  244. C
  245. C**** Les CVs
  246. C
  247. MTYPR = ' '
  248. CALL ACMO(IPGAS,'CV',MTYPR,ICV)
  249. IF(IERR .NE. 0)GOTO 9999
  250. C
  251. C**** Les especes qui sont dans les Equations d'Euler
  252. C
  253. MTYPR = ' '
  254. CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMESP)
  255. IF(IERR .NE. 0)GOTO 9999
  256. C
  257. C**** Nom de l'espece qui n'est pas dans les equations d'Euler
  258. C
  259. MTYPI = 'MOT '
  260. MTYPR = 'MOT '
  261. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE',LOGII,IRETI,
  262. & MTYPR,IVALR,XVALR,CELLCH,LOGIR,IRETR)
  263. IF(IERR .NE. 0)GOTO 9999
  264. C
  265. C**** Control de compatibilite des donnes de la table
  266. C et creation des LISTREELs avec CP et CV
  267. C
  268. SEGACT MLMESP
  269. C
  270. C**** NESP = nombre d'especes dans lesequation d'Euler
  271. C
  272. NESP = MLMESP.MOTS(/2)
  273. C
  274. C**** List de CP et CV
  275. C
  276. JG = NESP+1
  277. SEGINI MLRECP
  278. SEGINI MLRECV
  279. DO I1 = 1, NESP
  280. C
  281. C******* N.B. NOMTOT est un CHARACTER*(4)
  282. C
  283. NOMTOT(1) = MLMESP.MOTS(I1)
  284. C
  285. C******* CALL ACMF(ICP,NOMC,CP) ne marche pas parce que on a
  286. C des blanches dans nos composantes
  287. C
  288. MTYPI = 'MOT '
  289. MTYPR = ' '
  290. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,NOMTOT(1), LOGII,IRETI,
  291. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  292. IF(IERR .NE. 0)GOTO 9999
  293. MLRECP.PROG(I1) = CP
  294. C
  295. MTYPI = 'MOT '
  296. MTYPR = ' '
  297. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,NOMTOT(1), LOGII,IRETI,
  298. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  299. IF(IERR .NE. 0)GOTO 9999
  300. MLRECV.PROG(I1) = CV
  301. ENDDO
  302. MTYPI = 'MOT '
  303. MTYPR = ' '
  304. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  305. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  306. IF(IERR .NE. 0)GOTO 9999
  307. MLRECP.PROG(JG) = CP
  308. C
  309. MTYPI = 'MOT '
  310. MTYPR = ' '
  311. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  312. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  313. IF(IERR .NE. 0)GOTO 9999
  314. MLRECV.PROG(JG) = CV
  315. C
  316. C**** Lecture du CHPOINT ROC
  317. C
  318. ICOND = 1
  319. CALL QUETYP(MTYPR,ICOND,IRETOU)
  320. IF(IERR .NE. 0)GOTO 9999
  321. IF(MTYPR .NE. 'CHPOINT ')THEN
  322. C
  323. C******* Message d'erreur standard
  324. C 37 2
  325. C On ne trouve pas d'objet de type %m1:8
  326. C
  327. MOTERR(1:8) = 'CHPOINT '
  328. CALL ERREUR(37)
  329. GOTO 9999
  330. ELSE
  331. ICOND = 1
  332. CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU)
  333. CALL ACTOBJ(MTYPR,IROC,1)
  334. IF(IERR .NE. 0)GOTO 9999
  335. ENDIF
  336. C
  337. C**** Control du CHPOINT: QUEPOI
  338. C
  339. C INDIC = 1 -> on impose le pointeur du support geometrique (IM1)
  340. C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1)
  341. C
  342. C NBCOMP > 0 -> numero des composantes
  343. C
  344. C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  345. C
  346. INDIC = 1
  347. NBCOMP = 1
  348. NOMTOT(1) = 'SCAL'
  349. CALL QUEPOI(IROC, ICEN, INDIC, NBCOMP, NOMTOT)
  350. IF(IERR .NE. 0)THEN
  351. IERR0 = IERR
  352.  
  353. C
  354. C******* Message d'erreur standard
  355. C -301 0 %m1:40
  356. C
  357. MOTERR(1:40) = 'CHPO1 = ??? '
  358. CALL ERREUR(-301)
  359.  
  360. GOTO 9999
  361. ENDIF
  362. C
  363. C**** Lecture du CHPOINT GRADROC
  364. C
  365. ICOND = 1
  366. CALL QUETYP(MTYPR,ICOND,IRETOU)
  367. IF(IERR .NE. 0)GOTO 9999
  368. IF(MTYPR .NE. 'CHPOINT ')THEN
  369. C
  370. C******* Message d'erreur standard
  371. C 37 2
  372. C On ne trouve pas d'objet de type %m1:8
  373. C
  374. MOTERR(1:8) = 'CHPOINT '
  375. CALL ERREUR(37)
  376. GOTO 9999
  377. ELSE
  378. ICOND = 1
  379. CALL LIROBJ(MTYPR,IGRROC,ICOND,IRETOU)
  380. CALL ACTOBJ(MTYPR,IGRROC,1)
  381. IF (IERR.NE.0) GOTO 9999
  382. ENDIF
  383. C
  384. C**** Control du CHPOINT: QUEPOI
  385. C
  386. C INDIC = 1 -> on impose le pointeur du support geometrique (IM1)
  387. C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1)
  388. C
  389. C NBCOMP = 2 -> on teste le noms des composantes
  390. C
  391. C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  392. C
  393. JGN=4
  394. JGM=IDIM
  395. SEGINI MLMCOM
  396. MLMCOM.MOTS(1)='P1DX'
  397. MLMCOM.MOTS(2)='P1DY'
  398. IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P1DZ'
  399. CALL QUEPO1(IGRROC, ICEN, MLMCOM)
  400. SEGSUP MLMCOM
  401. IF(IERR .NE. 0)THEN
  402. IERR0 = IERR
  403.  
  404. C
  405. C******* Message d'erreur standard
  406. C -301 0 %m1:40
  407. C
  408. MOTERR(1:40) = 'CHPO2 = ??? '
  409. CALL ERREUR(-301)
  410.  
  411. GOTO 9999
  412. ENDIF
  413. C
  414. C**** Lecture du CHPOINT IALROC
  415. C
  416. ICOND = 1
  417. CALL QUETYP(MTYPR,ICOND,IRETOU)
  418. IF(IERR .NE. 0)GOTO 9999
  419. IF(MTYPR .NE. 'CHPOINT ')THEN
  420. C
  421. C******* Message d'erreur standard
  422. C 37 2
  423. C On ne trouve pas d'objet de type %m1:8
  424. C
  425. MOTERR(1:8) = 'CHPOINT '
  426. CALL ERREUR(37)
  427. GOTO 9999
  428. ELSE
  429. ICOND = 1
  430. CALL LIROBJ(MTYPR,IALROC,ICOND,IRETOU)
  431. CALL ACTOBJ(MTYPR,IALROC,1)
  432. IF (IERR.NE.0) GOTO 9999
  433. ENDIF
  434. C
  435. C**** Control du CHPOINT: QUEPOI
  436. C
  437. INDIC = 1
  438. NBCOMP = 1
  439. NOMTOT(1) = 'P1'
  440. CALL QUEPOI(IALROC, ICEN, INDIC, NBCOMP, NOMTOT)
  441. IF(IERR .NE. 0)THEN
  442. IERR0 = IERR
  443.  
  444. C
  445. C******* Message d'erreur standard
  446. C -301 0 %m1:40
  447. C
  448. MOTERR(1:40) = 'CHPO3 = ??? '
  449. CALL ERREUR(-301)
  450.  
  451. GOTO 9999
  452. ENDIF
  453. C
  454. C
  455. C**** Lecture du CHPOINT VITC
  456. C
  457. ICOND = 1
  458. CALL QUETYP(MTYPR,ICOND,IRETOU)
  459. IF(IERR .NE. 0)GOTO 9999
  460. IF(MTYPR .NE. 'CHPOINT ')THEN
  461. C
  462. C******* Message d'erreur standard
  463. C 37 2
  464. C On ne trouve pas d'objet de type %m1:8
  465. C
  466. MOTERR(1:8) = 'CHPOINT '
  467. CALL ERREUR(37)
  468. GOTO 9999
  469. ELSE
  470. ICOND = 1
  471. CALL LIROBJ(MTYPR,IVITC,ICOND,IRETOU)
  472. CALL ACTOBJ(MTYPR,IVITC,1)
  473. IF (IERR.NE.0) GOTO 9999
  474. ENDIF
  475. C
  476. C**** Control du CHPOINT
  477. C
  478. JGN=4
  479. JGM=IDIM
  480. SEGINI MLMCOM
  481. MLMCOM.MOTS(1) = 'UX '
  482. MLMCOM.MOTS(2) = 'UY '
  483. IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'UZ '
  484. CALL QUEPO1(IVITC, ICEN, MLMCOM)
  485. SEGSUP MLMCOM
  486. IF(IERR .NE. 0)THEN
  487. IERR0 = IERR
  488.  
  489. C
  490. C******* Message d'erreur standard
  491. C -301 0 %m1:40
  492. C
  493. MOTERR(1:40) = 'CHPO4 = ??? '
  494. CALL ERREUR(-301)
  495.  
  496. GOTO 9999
  497. ENDIF
  498. C
  499. C**** Lecture du CHPOINT GRADVITC
  500. C
  501. ICOND = 1
  502. CALL QUETYP(MTYPR,ICOND,IRETOU)
  503. IF(IERR .NE. 0)GOTO 9999
  504. IF(MTYPR .NE. 'CHPOINT ')THEN
  505. C
  506. C******* Message d'erreur standard
  507. C 37 2
  508. C On ne trouve pas d'objet de type %m1:8
  509. C
  510. MOTERR(1:8) = 'CHPOINT '
  511. CALL ERREUR(37)
  512. GOTO 9999
  513. ELSE
  514. ICOND = 1
  515. CALL LIROBJ(MTYPR,IGRVC,ICOND,IRETOU)
  516. CALL ACTOBJ(MTYPR,IGRVC,1)
  517. IF (IERR.NE.0) GOTO 9999
  518. ENDIF
  519. C
  520. C**** Control du CHPOINT: QUEPOI
  521. C
  522. JGN=4
  523. IF(IDIM .EQ. 2)THEN
  524. JGM=4
  525. SEGINI MLMCOM
  526. MLMCOM.MOTS(1) = 'P1DX'
  527. MLMCOM.MOTS(2) = 'P1DY'
  528. MLMCOM.MOTS(3) = 'P2DX'
  529. MLMCOM.MOTS(4) = 'P2DY'
  530. ELSE
  531. JGM=9
  532. SEGINI MLMCOM
  533. MLMCOM.MOTS(1) = 'P1DX'
  534. MLMCOM.MOTS(2) = 'P1DY'
  535. MLMCOM.MOTS(3) = 'P1DZ'
  536. MLMCOM.MOTS(4) = 'P2DX'
  537. MLMCOM.MOTS(5) = 'P2DY'
  538. MLMCOM.MOTS(6) = 'P2DZ'
  539. MLMCOM.MOTS(7) = 'P3DX'
  540. MLMCOM.MOTS(8) = 'P3DY'
  541. MLMCOM.MOTS(9) = 'P3DZ'
  542. ENDIF
  543. CALL QUEPO1(IGRVC, ICEN, MLMCOM)
  544. SEGSUP MLMCOM
  545. IF(IERR .NE. 0)THEN
  546. IERR0 = IERR
  547.  
  548. C
  549. C******* Message d'erreur standard
  550. C -301 0 %m1:40
  551. C
  552. MOTERR(1:40) = 'CHPO5 = ??? '
  553. CALL ERREUR(-301)
  554.  
  555. GOTO 9999
  556. ENDIF
  557. C
  558. C**** Lecture du CHPOINT IALVC
  559. C
  560. ICOND = 1
  561. CALL QUETYP(MTYPR,ICOND,IRETOU)
  562. IF(IERR .NE. 0)GOTO 9999
  563. IF(MTYPR .NE. 'CHPOINT ')THEN
  564. C
  565. C******* Message d'erreur standard
  566. C 37 2
  567. C On ne trouve pas d'objet de type %m1:8
  568. C
  569. MOTERR(1:8) = 'CHPOINT '
  570. CALL ERREUR(37)
  571. GOTO 9999
  572. ELSE
  573. ICOND = 1
  574. CALL LIROBJ(MTYPR,IALVC,ICOND,IRETOU)
  575. CALL ACTOBJ(MTYPR,IALVC,1)
  576. IF (IERR.NE.0) GOTO 9999
  577. ENDIF
  578. C
  579. C**** Control du CHPOINT: QUEPOI
  580. C
  581. JGN=4
  582. JGM=IDIM
  583. SEGINI MLMCOM
  584. MLMCOM.MOTS(1) = 'P1 '
  585. MLMCOM.MOTS(2) = 'P2 '
  586. IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P3 '
  587. CALL QUEPO1(IALVC, ICEN, MLMCOM)
  588. SEGSUP MLMCOM
  589. IF(IERR .NE. 0)THEN
  590. IERR0 = IERR
  591.  
  592. C
  593. C******* Message d'erreur standard
  594. C -301 0 %m1:40
  595. C
  596. MOTERR(1:40) = 'CHPO6 = ??? '
  597. CALL ERREUR(-301)
  598.  
  599. GOTO 9999
  600. ENDIF
  601. C
  602. C**** Lecture du CHPOINT PC
  603. C
  604. ICOND = 1
  605. CALL QUETYP(MTYPR,ICOND,IRETOU)
  606. IF(IERR .NE. 0)GOTO 9999
  607. IF(MTYPR .NE. 'CHPOINT ')THEN
  608. C
  609. C******* Message d'erreur standard
  610. C 37 2
  611. C On ne trouve pas d'objet de type %m1:8
  612. C
  613. MOTERR(1:8) = 'CHPOINT '
  614. CALL ERREUR(37)
  615. GOTO 9999
  616. ELSE
  617. ICOND = 1
  618. CALL LIROBJ(MTYPR,IPC,ICOND,IRETOU)
  619. CALL ACTOBJ(MTYPR,IPC,1)
  620. IF (IERR.NE.0) GOTO 9999
  621. ENDIF
  622. C
  623. C**** Control du CHPOINT
  624. C
  625. INDIC = 1
  626. NBCOMP = 1
  627. NOMTOT(1) = 'SCAL'
  628. CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT)
  629. IF(IERR .NE. 0)THEN
  630. IERR0 = IERR
  631.  
  632. C
  633. C******* Message d'erreur standard
  634. C -301 0 %m1:40
  635. C
  636. MOTERR(1:40) = 'CHPO7 = ??? '
  637. CALL ERREUR(-301)
  638.  
  639. GOTO 9999
  640. ENDIF
  641. C
  642. C**** Lecture du CHPOINT GRADPC
  643. C
  644. ICOND = 1
  645. CALL QUETYP(MTYPR,ICOND,IRETOU)
  646. IF(IERR .NE. 0)GOTO 9999
  647. IF(MTYPR .NE. 'CHPOINT ')THEN
  648. C
  649. C******* Message d'erreur standard
  650. C 37 2
  651. C On ne trouve pas d'objet de type %m1:8
  652. C
  653. MOTERR(1:8) = 'CHPOINT '
  654. CALL ERREUR(37)
  655. GOTO 9999
  656. ELSE
  657. ICOND = 1
  658. CALL LIROBJ(MTYPR,IGRPC,ICOND,IRETOU)
  659. CALL ACTOBJ(MTYPR,IGRPC,1)
  660. IF (IERR.NE.0) GOTO 9999
  661. ENDIF
  662. C
  663. C**** Control du CHPOINT: QUEPOI
  664. C
  665. C
  666. JGN=4
  667. JGM=IDIM
  668. SEGINI MLMCOM
  669. MLMCOM.MOTS(1)='P1DX'
  670. MLMCOM.MOTS(2)='P1DY'
  671. IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P1DZ'
  672. CALL QUEPO1(IGRPC, ICEN, MLMCOM)
  673. IF(IERR .NE. 0)THEN
  674. IERR0 = IERR
  675.  
  676. C
  677. C******* Message d'erreur standard
  678. C -301 0 %m1:40
  679. C
  680. MOTERR(1:40) = 'CHPO8 = ??? '
  681. CALL ERREUR(-301)
  682.  
  683. GOTO 9999
  684. ENDIF
  685. C
  686. C**** Lecture du CHPOINT IALPC
  687. C
  688. ICOND = 1
  689. CALL QUETYP(MTYPR,ICOND,IRETOU)
  690. IF(IERR .NE. 0)GOTO 9999
  691. IF(MTYPR .NE. 'CHPOINT ')THEN
  692. C
  693. C******* Message d'erreur standard
  694. C 37 2
  695. C On ne trouve pas d'objet de type %m1:8
  696. C
  697. MOTERR(1:8) = 'CHPOINT '
  698. CALL ERREUR(37)
  699. GOTO 9999
  700. ELSE
  701. ICOND = 1
  702. CALL LIROBJ(MTYPR,IALPC,ICOND,IRETOU)
  703. CALL ACTOBJ(MTYPR,IALPC,1)
  704. IF (IERR.NE.0) GOTO 9999
  705. ENDIF
  706. C
  707. C**** Control du CHPOINT: QUEPOI
  708. C
  709. INDIC = 1
  710. NBCOMP = 1
  711. NOMTOT(1) = 'P1'
  712. CALL QUEPOI(IALPC, ICEN, INDIC, NBCOMP, NOMTOT)
  713. IF(IERR .NE. 0)THEN
  714. IERR0 = IERR
  715.  
  716. C
  717. C******* Message d'erreur standard
  718. C -301 0 %m1:40
  719. C
  720. MOTERR(1:40) = 'CHPO9 = ??? '
  721. CALL ERREUR(-301)
  722.  
  723. GOTO 9999
  724. ENDIF
  725. C
  726. C**** Lecture du CHPOINT YC
  727. C
  728. ICOND = 1
  729. CALL QUETYP(MTYPR,ICOND,IRETOU)
  730. IF(IERR .NE. 0)GOTO 9999
  731. IF(MTYPR .NE. 'CHPOINT ')THEN
  732. C
  733. C******* Message d'erreur standard
  734. C 37 2
  735. C On ne trouve pas d'objet de type %m1:8
  736. C
  737. MOTERR(1:8) = 'CHPOINT '
  738. CALL ERREUR(37)
  739. GOTO 9999
  740. ELSE
  741. ICOND = 1
  742. CALL LIROBJ(MTYPR,IYC,ICOND,IRETOU)
  743. CALL ACTOBJ(MTYPR,IYC,1)
  744. IF (IERR.NE.0) GOTO 9999
  745. ENDIF
  746. C
  747. C**** Control du CHPOINT
  748. C
  749. CALL QUEPO1(IYC, ICEN, MLMESP)
  750. IF(IERR .NE. 0)THEN
  751. IERR0 = IERR
  752.  
  753. C
  754. C******* Message d'erreur standard
  755. C -301 0 %m1:40
  756. C
  757. MOTERR(1:40) = 'CHPO10 = ??? '
  758. CALL ERREUR(-301)
  759.  
  760. GOTO 9999
  761. ENDIF
  762. C
  763. C**** Lecture du CHPOINT GRADYC
  764. C
  765. ICOND = 1
  766. CALL QUETYP(MTYPR,ICOND,IRETOU)
  767. IF(IERR .NE. 0)GOTO 9999
  768. IF(MTYPR .NE. 'CHPOINT ')THEN
  769. C
  770. C******* Message d'erreur standard
  771. C 37 2
  772. C On ne trouve pas d'objet de type %m1:8
  773. C
  774. MOTERR(1:8) = 'CHPOINT '
  775. CALL ERREUR(37)
  776. GOTO 9999
  777. ELSE
  778. ICOND = 1
  779. CALL LIROBJ(MTYPR,IGRYC,ICOND,IRETOU)
  780. CALL ACTOBJ(MTYPR,IGRYC,1)
  781. IF (IERR.NE.0) GOTO 9999
  782. ENDIF
  783. C
  784. C**** Control du CHPOINT: QUEPOI
  785. C
  786. JGN=4
  787. JGM=IDIM*NESP
  788. SEGINI MLMCOM
  789. C NESP < 10
  790. IF(NESP .GE. 10)THEN
  791. WRITE(IOIMP,*) 'NESP >= 10!'
  792. C
  793. C******* Message d'erreur standard
  794. C 21 2
  795. C Données incompatibles
  796. C
  797. CALL ERREUR(21)
  798. GOTO 9999
  799. ENDIF
  800. C
  801. ICEL = 0
  802. DO I1 = 1, NESP, 1
  803. DO I2 = 1, IDIM
  804. ICEL = ICEL + 1
  805. ICOM = 3 * (I1 -1) + I2
  806. MLMCOM.MOTS(ICEL) = NOMGRA(ICOM)
  807. ENDDO
  808. ENDDO
  809. CALL QUEPO1(IGRYC, ICEN, MLMCOM)
  810. SEGSUP MLMCOM
  811. IF(IERR .NE. 0)THEN
  812. IERR0 = IERR
  813.  
  814. C
  815. C******* Message d'erreur standard
  816. C -301 0 %m1:40
  817. C
  818. MOTERR(1:40) = 'CHPO11 = ??? '
  819. CALL ERREUR(-301)
  820.  
  821. GOTO 9999
  822. ENDIF
  823. C
  824. C**** Lecture du CHPOINT IALYC
  825. C
  826. ICOND = 1
  827. CALL QUETYP(MTYPR,ICOND,IRETOU)
  828. IF(IERR .NE. 0)GOTO 9999
  829. IF(MTYPR .NE. 'CHPOINT ')THEN
  830. C
  831. C******* Message d'erreur standard
  832. C 37 2
  833. C On ne trouve pas d'objet de type %m1:8
  834. C
  835. MOTERR(1:8) = 'CHPOINT '
  836. CALL ERREUR(37)
  837. GOTO 9999
  838. ELSE
  839. ICOND = 1
  840. CALL LIROBJ(MTYPR,IALYC,ICOND,IRETOU)
  841. CALL ACTOBJ(MTYPR,IALYC,1)
  842. IF (IERR.NE.0) GOTO 9999
  843. ENDIF
  844. C
  845. C**** Control du CHPOINT: QUEPOI
  846. C
  847. JGN = 4
  848. JGM = NESP
  849. SEGINI MLMCOM
  850. DO I1 = 1, NESP, 1
  851. MLMCOM.MOTS(I1)=NOMLIM(I1)
  852. ENDDO
  853. CALL QUEPO1(IALYC, ICEN, MLMCOM)
  854. SEGSUP MLMCOM
  855. IF(IERR .NE. 0)THEN
  856. IERR0 = IERR
  857.  
  858. C
  859. C******* Message d'erreur standard
  860. C -301 0 %m1:40
  861. C
  862. MOTERR(1:40) = 'CHPO12 = ??? '
  863. CALL ERREUR(-301)
  864.  
  865. GOTO 9999
  866. ENDIF
  867. C
  868. C**** Lecture du CHPOINT GAMC
  869. C
  870. ICOND = 1
  871. CALL QUETYP(MTYPR,ICOND,IRETOU)
  872. IF(IERR .NE. 0)GOTO 9999
  873. IF(MTYPR .NE. 'CHPOINT ')THEN
  874. C
  875. C******* Message d'erreur standard
  876. C 37 2
  877. C On ne trouve pas d'objet de type %m1:8
  878. C
  879. MOTERR(1:8) = 'CHPOINT '
  880. CALL ERREUR(37)
  881. GOTO 9999
  882. ELSE
  883. ICOND = 1
  884. CALL LIROBJ(MTYPR,IGAMC,ICOND,IRETOU)
  885. CALL ACTOBJ(MTYPR,IGAMC,1)
  886. IF (IERR.NE.0) GOTO 9999
  887. ENDIF
  888. C
  889. C**** Control du CHPOINT
  890. C
  891. INDIC = 1
  892. NBCOMP = 1
  893. NOMTOT(1) = 'SCAL'
  894. CALL QUEPOI(IGAMC, ICEN, INDIC, NBCOMP, NOMTOT)
  895. IF(IERR .NE. 0)THEN
  896. IERR0 = IERR
  897.  
  898. C
  899. C******* Message d'erreur standard
  900. C -301 0 %m1:40
  901. C
  902. MOTERR(1:40) = 'CHPO10 = ??? '
  903. CALL ERREUR(-301)
  904.  
  905. GOTO 9999
  906. ENDIF
  907. IF(ORDTEM .EQ. 1)THEN
  908. C
  909. C******* Deux Dimensions, Une Espece, 2er ordre en espace, 1er ordre en
  910. C temps
  911. C
  912. LOGTEM = .FALSE.
  913. DELTAT = 0.0D0
  914. ELSE
  915. LOGTEM = .TRUE.
  916. ICOND = 1
  917. CALL LIRREE(DELTAT,ICOND,IRETOU)
  918. IF(IERR .NE. 0)GOTO 9999
  919. ENDIF
  920. IF(IDIM .EQ. 2)THEN
  921. C
  922. C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  923. C temps
  924. C
  925. CALL PRE221(LOGTEM,
  926. & ICEN,IFACE,IFACEL,INORM,
  927. & IROC, IGRROC, IALROC,
  928. & IVITC, IGRVC, IALVC,
  929. & IPC ,IGRPC, IALPC,
  930. & MLRECV, MLRECP, MLMESP,
  931. & IYC ,IGRYC, IALYC,
  932. & IGAMC,
  933. & DELTAT,
  934. & IROF,IVITF,IPF,IGAMF,IYF,
  935. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  936. ELSE
  937. C
  938. C******* Trois Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  939. C temps
  940. C
  941. CALL PRE222(LOGTEM,
  942. & ICEN,IFACE,IFACEL,INORM,
  943. & IROC, IGRROC, IALROC,
  944. & IVITC, IGRVC, IALVC,
  945. & IPC ,IGRPC, IALPC,
  946. & MLRECV, MLRECP, MLMESP,
  947. & IYC ,IGRYC, IALYC,
  948. & IGAMC,
  949. & DELTAT,
  950. & IROF,IVITF,IPF,IGAMF,IYF,
  951. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  952. ENDIF
  953. C
  954. C**** Messages d'erreur
  955. C
  956. IF(LOGAN)THEN
  957. C
  958. C******* Anomalie detectée
  959. C
  960. C
  961. C******* Message d'erreur standard
  962. C -301 0
  963. C %m1:40
  964. C
  965. MOTERR(1:40) = MESERR(1:40)
  966. CALL ERREUR(-301)
  967. C
  968. C******* Message d'erreur standard
  969. C 5 3
  970. C Erreur anormale.contactez votre support
  971. C
  972. CALL ERREUR(5)
  973. GOTO 9999
  974. C
  975. ELSEIF(LOGNEG)THEN
  976. C
  977. C******* Message d'erreur standard
  978. C 41 2
  979. C %m1:8 = %r1 inférieur à %r2
  980. C
  981. MOTERR(1:8) = MESERR(1:8)
  982. REAERR(1) = REAL(VALER)
  983. REAERR(2) = 0.0
  984. CALL ERREUR(41)
  985. GOTO 9999
  986. ELSEIF(LOGBOR)THEN
  987. C
  988. C******* Message d'erreur standard
  989. C 42 2
  990. C %m1:8 = %r1 non compris entre %r2 et %r3
  991. C
  992. MOTERR(1:8) = MESERR(1:8)
  993. REAERR(1) = REAL(VALER)
  994. REAERR(2) = REAL(VAL1)
  995. REAERR(3) = REAL(VAL2)
  996. CALL ERREUR(42)
  997. GOTO 9999
  998. ELSE
  999. C
  1000. C******* Ecriture de ROF, VITF, PF, YF, GAMMAF
  1001. C
  1002. MTYPR = 'MCHAML '
  1003. CALL ACTOBJ(MTYPR,IGAMF,1)
  1004. CALL ACTOBJ(MTYPR,IYF,1)
  1005. CALL ACTOBJ(MTYPR,IPF,1)
  1006. CALL ACTOBJ(MTYPR,IVITF,1)
  1007. CALL ACTOBJ(MTYPR,IROF,1)
  1008.  
  1009. CALL ECROBJ(MTYPR,IGAMF)
  1010. CALL ECROBJ(MTYPR,IYF)
  1011. CALL ECROBJ(MTYPR,IPF)
  1012. CALL ECROBJ(MTYPR,IVITF)
  1013. CALL ECROBJ(MTYPR,IROF)
  1014. ENDIF
  1015. C
  1016. 9999 CONTINUE
  1017. END
  1018.  
  1019.  
  1020.  

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