Télécharger pre32.eso

Retour à la liste

Numérotation des lignes :

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

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