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

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