Télécharger pre32.eso

Retour à la liste

Numérotation des lignes :

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

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