Télécharger pre32.eso

Retour à la liste

Numérotation des lignes :

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

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