Télécharger pre22.eso

Retour à la liste

Numérotation des lignes :

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

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