Télécharger pre12.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE12 SOURCE CB215821 19/07/31 21:16:17 10277
  2. SUBROUTINE PRE12(ORDTEM)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRE12
  8. C
  9. C DESCRIPTION : Voir PRE1
  10. C
  11. C Gas gaz ideal, mono espece.
  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
  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 QUEPOI, ECROBJ
  27. C
  28. C
  29. C APPELES (Calcul) : PRE121 (2D)
  30. C
  31. C
  32. C************************************************************************
  33. C
  34. C HISTORIQUE (Anomalies et modifications éventuelles)
  35. C
  36. C HISTORIQUE : Créée le 11.6.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, INEFMD, JGN, JGM
  63. & ,MMODEL
  64. REAL*8 VALER, VAL1, VAL2, DELTAT
  65. CHARACTER*(4) NOMTOT(9)
  66. CHARACTER*(8) MTYPR, TYPE
  67. CHARACTER*(40) MESERR
  68. LOGICAL LOGAN,LOGNEG, LOGBOR,LOGTEM
  69. C
  70. C**** Les Includes
  71. C
  72.  
  73. -INC PPARAM
  74. -INC CCOPTIO
  75. -INC SMLMOTS
  76. POINTEUR MLMVIT.MLMOTS
  77. C
  78. C
  79. C**** Initialisation des parametres d'erreur
  80. C
  81. LOGAN = .FALSE.
  82. LOGNEG = .FALSE.
  83. LOGBOR = .FALSE.
  84. MESERR = ' '
  85. MOTERR(1:40) = MESERR(1:40)
  86. VALER = 0.0D0
  87. VAL1 = 0.0D0
  88. VAL2 = 0.0D0
  89. C
  90. C**** Initialisation des NOMTOT
  91. C
  92. NOMTOT(1) = ' '
  93. NOMTOT(2) = ' '
  94. NOMTOT(3) = ' '
  95. NOMTOT(4) = ' '
  96. NOMTOT(5) = ' '
  97. NOMTOT(6) = ' '
  98. NOMTOT(7) = ' '
  99. NOMTOT(8) = ' '
  100. NOMTOT(9) = ' '
  101. C
  102. C**** Lecture de l'objet MODELE
  103. C
  104. ICOND = 1
  105. CALL QUETYP(TYPE,ICOND,IRETOU)
  106.  
  107. IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  108. WRITE(6,*)' On attend un objet MMODEL'
  109. RETURN
  110. ENDIF
  111. CALL LIROBJ('MMODEL ',MMODEL,ICOND,IRETOU)
  112. CALL ACTOBJ('MMODEL ',MMODEL,1)
  113. IF(IERR.NE.0)GOTO 9999
  114. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  115. IF(IERR.NE.0)GOTO 9999
  116. C
  117. C**** Lecture du MELEME SPG des points CENTRE.
  118. C
  119. C
  120. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  121. C
  122. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  123. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  124. C -> la correspondance global des noeuds saut!
  125. C
  126. C On peut utilizer ACCTAB ou ACMO
  127. C
  128. MTYPR = 'MAILLAGE'
  129. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  130. IF(IERR.NE.0)GOTO 9999
  131. C
  132. C**** Lecture du MELEME 'FACE'
  133. C
  134. MTYPR = 'MAILLAGE'
  135. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  136. IF(IERR.NE.0)GOTO 9999
  137. C
  138. C**** Lecture du MELEME 'FACEL'
  139. C
  140. MTYPR = 'MAILLAGE'
  141. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  142. IF(IERR.NE.0)GOTO 9999
  143. C
  144. C**** Lecture du CHPOINT contenant les normales aux faces
  145. C
  146. IF(IDIM .EQ. 2)THEN
  147. C Que les normales
  148. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  149. IF(IERR .NE. 0) GOTO 9999
  150. JGN = 4
  151. JGM = 2
  152. SEGINI MLMVIT
  153. MLMVIT.MOTS(1) = 'UX '
  154. MLMVIT.MOTS(2) = 'UY '
  155. CALL QUEPO1(INORM, IFACE, MLMVIT)
  156. SEGSUP MLMVIT
  157. ELSE
  158. C Les normales et les tangentes
  159. MTYPR = ' '
  160. CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
  161. IF (MTYPR .NE. 'CHPOINT ') THEN
  162. CALL MATRAN(IDOMA,INORM)
  163. IF(IERR .NE. 0) GOTO 9999
  164. ENDIF
  165. JGN = 4
  166. JGM = 9
  167. SEGINI MLMVIT
  168. MLMVIT.MOTS(1) = 'UX '
  169. MLMVIT.MOTS(2) = 'UY '
  170. MLMVIT.MOTS(3) = 'UZ '
  171. MLMVIT.MOTS(4) = 'RX '
  172. MLMVIT.MOTS(5) = 'RY '
  173. MLMVIT.MOTS(6) = 'RZ '
  174. MLMVIT.MOTS(7) = 'MX '
  175. MLMVIT.MOTS(8) = 'MY '
  176. MLMVIT.MOTS(9) = 'MZ '
  177. CALL QUEPO1(INORM, IFACE, MLMVIT)
  178. SEGSUP MLMVIT
  179. IF(IERR .NE. 0) GOTO 9999
  180. ENDIF
  181. C
  182. C**** N.B. On veut lire les objets sequentiellement.
  183. C Donc on utilise QUETYP pour controler que
  184. C le type de l'objet soit le bon.
  185. C
  186. C**** Lecture du CHPOINT ROC
  187. C
  188. ICOND = 1
  189. CALL QUETYP(MTYPR,ICOND,IRETOU)
  190. IF(IERR .NE. 0)GOTO 9999
  191. IF(MTYPR .NE. 'CHPOINT ')THEN
  192. C
  193. C******* Message d'erreur standard
  194. C 37 2
  195. C On ne trouve pas d'objet de type %m1:8
  196. C
  197. MOTERR(1:8) = 'CHPOINT '
  198. CALL ERREUR(37)
  199. GOTO 9999
  200. ELSE
  201. ICOND = 1
  202. CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU)
  203. CALL ACTOBJ(MTYPR,IROC,1)
  204. IF(IERR .NE. 0)GOTO 9999
  205. ENDIF
  206. C
  207. C**** Control du CHPOINT: QUEPOI
  208. C
  209. C INDIC = 1 -> on impose le pointeur du support geometrique (IM1)
  210. C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1)
  211. C
  212. C NBCOMP > 0 -> numero des composantes
  213. C
  214. C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  215. C
  216. INDIC = 1
  217. NBCOMP = 1
  218. NOMTOT(1) = 'SCAL'
  219. CALL QUEPOI(IROC, ICEN, INDIC, NBCOMP, NOMTOT)
  220. IF(IERR .NE. 0)THEN
  221. IERR0 = IERR
  222.  
  223. C
  224. C******* Message d'erreur standard
  225. C -301 0 %m1:40
  226. C
  227. MOTERR(1:40) = 'CHPO1 = ??? '
  228. CALL ERREUR(-301)
  229.  
  230. GOTO 9999
  231. ENDIF
  232. C
  233. C**** Lecture du CHPOINT GRADROC
  234. C
  235. ICOND = 1
  236. CALL QUETYP(MTYPR,ICOND,IRETOU)
  237. IF(IERR .NE. 0)GOTO 9999
  238. IF(MTYPR .NE. 'CHPOINT ')THEN
  239. C
  240. C******* Message d'erreur standard
  241. C 37 2
  242. C On ne trouve pas d'objet de type %m1:8
  243. C
  244. MOTERR(1:8) = 'CHPOINT '
  245. CALL ERREUR(37)
  246. GOTO 9999
  247. ELSE
  248. ICOND = 1
  249. CALL LIROBJ(MTYPR,IGRROC,ICOND,IRETOU)
  250. CALL ACTOBJ(MTYPR,IGRROC,1)
  251. IF (IERR.NE.0) GOTO 9999
  252. ENDIF
  253. C
  254. C**** Control du CHPOINT: QUEPOI
  255. C
  256. C INDIC = 1 -> on impose le pointeur du support geometrique (IM1)
  257. C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1)
  258. C
  259. C NBCOMP = 2 -> on teste le noms des composantes
  260. C
  261. C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  262. C
  263. INDIC = 1
  264. NBCOMP = IDIM
  265. NOMTOT(1) = 'P1DX'
  266. NOMTOT(2) = 'P1DY'
  267. IF(IDIM .EQ. 3) NOMTOT(3) = 'P1DZ'
  268. CALL QUEPOI(IGRROC, ICEN, INDIC, NBCOMP, NOMTOT)
  269. IF(IERR .NE. 0)THEN
  270. IERR0 = IERR
  271.  
  272. C
  273. C******* Message d'erreur standard
  274. C -301 0 %m1:40
  275. C
  276. MOTERR(1:40) = 'CHPO2 = ??? '
  277. CALL ERREUR(-301)
  278.  
  279. GOTO 9999
  280. ENDIF
  281. C
  282. C**** Lecture du CHPOINT IALROC
  283. C
  284. ICOND = 1
  285. CALL QUETYP(MTYPR,ICOND,IRETOU)
  286. IF(IERR .NE. 0)GOTO 9999
  287. IF(MTYPR .NE. 'CHPOINT ')THEN
  288. C
  289. C******* Message d'erreur standard
  290. C 37 2
  291. C On ne trouve pas d'objet de type %m1:8
  292. C
  293. MOTERR(1:8) = 'CHPOINT '
  294. CALL ERREUR(37)
  295. GOTO 9999
  296. ELSE
  297. ICOND = 1
  298. CALL LIROBJ(MTYPR,IALROC,ICOND,IRETOU)
  299. CALL ACTOBJ(MTYPR,IALROC,1)
  300. IF (IERR.NE.0) GOTO 9999
  301. ENDIF
  302. C
  303. C**** Control du CHPOINT: QUEPOI
  304. C
  305. INDIC = 1
  306. NBCOMP = 1
  307. NOMTOT(1) = 'P1'
  308. CALL QUEPOI(IALROC, ICEN, INDIC, NBCOMP, NOMTOT)
  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) = 'CHPO3 = ??? '
  317. CALL ERREUR(-301)
  318.  
  319. GOTO 9999
  320. ENDIF
  321. C
  322. C
  323. C**** Lecture du CHPOINT VITC
  324. C
  325. ICOND = 1
  326. CALL QUETYP(MTYPR,ICOND,IRETOU)
  327. IF(IERR .NE. 0)GOTO 9999
  328. IF(MTYPR .NE. 'CHPOINT ')THEN
  329. C
  330. C******* Message d'erreur standard
  331. C 37 2
  332. C On ne trouve pas d'objet de type %m1:8
  333. C
  334. MOTERR(1:8) = 'CHPOINT '
  335. CALL ERREUR(37)
  336. GOTO 9999
  337. ELSE
  338. ICOND = 1
  339. CALL LIROBJ(MTYPR,IVITC,ICOND,IRETOU)
  340. CALL ACTOBJ(MTYPR,IVITC,1)
  341. IF (IERR.NE.0) GOTO 9999
  342. ENDIF
  343. C
  344. C**** Control du CHPOINT
  345. C
  346. INDIC = 1
  347. NBCOMP = IDIM
  348. NOMTOT(1) = 'UX '
  349. NOMTOT(2) = 'UY '
  350. IF(IDIM .EQ. 3) NOMTOT(3) = 'UZ '
  351. CALL QUEPOI(IVITC, 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) = 'CHPO4 = ??? '
  360. CALL ERREUR(-301)
  361.  
  362. GOTO 9999
  363. ENDIF
  364. C
  365. C**** Lecture du CHPOINT GRADVITC
  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,IGRVC,ICOND,IRETOU)
  382. CALL ACTOBJ(MTYPR,IGRVC,1)
  383. IF (IERR.NE.0) GOTO 9999
  384. ENDIF
  385. C
  386. C**** Control du CHPOINT: QUEPOI
  387. C
  388. INDIC = 1
  389. IF(IDIM .EQ.2)THEN
  390. NBCOMP = 4
  391. NOMTOT(1) = 'P1DX'
  392. NOMTOT(2) = 'P1DY'
  393. NOMTOT(3) = 'P2DX'
  394. NOMTOT(4) = 'P2DY'
  395. ELSE
  396. NBCOMP = 9
  397. NOMTOT(1) = 'P1DX'
  398. NOMTOT(2) = 'P1DY'
  399. NOMTOT(3) = 'P1DZ'
  400. NOMTOT(4) = 'P2DX'
  401. NOMTOT(5) = 'P2DY'
  402. NOMTOT(6) = 'P2DZ'
  403. NOMTOT(7) = 'P3DX'
  404. NOMTOT(8) = 'P3DY'
  405. NOMTOT(9) = 'P3DZ'
  406. ENDIF
  407. CALL QUEPOI(IGRVC, ICEN, INDIC, NBCOMP, NOMTOT)
  408. IF(IERR .NE. 0)THEN
  409. IERR0 = IERR
  410.  
  411. C
  412. C******* Message d'erreur standard
  413. C -301 0 %m1:40
  414. C
  415. MOTERR(1:40) = 'CHPO5 = ??? '
  416. CALL ERREUR(-301)
  417.  
  418. GOTO 9999
  419. ENDIF
  420. C
  421. C**** Lecture du CHPOINT IALVC
  422. C
  423. ICOND = 1
  424. CALL QUETYP(MTYPR,ICOND,IRETOU)
  425. IF(IERR .NE. 0)GOTO 9999
  426. IF(MTYPR .NE. 'CHPOINT ')THEN
  427. C
  428. C******* Message d'erreur standard
  429. C 37 2
  430. C On ne trouve pas d'objet de type %m1:8
  431. C
  432. MOTERR(1:8) = 'CHPOINT '
  433. CALL ERREUR(37)
  434. GOTO 9999
  435. ELSE
  436. ICOND = 1
  437. CALL LIROBJ(MTYPR,IALVC,ICOND,IRETOU)
  438. CALL ACTOBJ(MTYPR,IALVC,1)
  439. IF (IERR.NE.0) GOTO 9999
  440. ENDIF
  441. C
  442. C**** Control du CHPOINT: QUEPOI
  443. C
  444. INDIC = 1
  445. NBCOMP = IDIM
  446. NOMTOT(1) = 'P1'
  447. NOMTOT(2) = 'P2'
  448. IF(IDIM .EQ. 3) NOMTOT(3) = 'P3 '
  449. CALL QUEPOI(IALVC, ICEN, INDIC, NBCOMP, NOMTOT)
  450. IF(IERR .NE. 0)THEN
  451. IERR0 = IERR
  452.  
  453. C
  454. C******* Message d'erreur standard
  455. C -301 0 %m1:40
  456. C
  457. MOTERR(1:40) = 'CHPO6 = ??? '
  458. CALL ERREUR(-301)
  459.  
  460. GOTO 9999
  461. ENDIF
  462. C
  463. C**** Lecture du CHPOINT PC
  464. C
  465. ICOND = 1
  466. CALL QUETYP(MTYPR,ICOND,IRETOU)
  467. IF(IERR .NE. 0)GOTO 9999
  468. IF(MTYPR .NE. 'CHPOINT ')THEN
  469. C
  470. C******* Message d'erreur standard
  471. C 37 2
  472. C On ne trouve pas d'objet de type %m1:8
  473. C
  474. MOTERR(1:8) = 'CHPOINT '
  475. CALL ERREUR(37)
  476. GOTO 9999
  477. ELSE
  478. ICOND = 1
  479. CALL LIROBJ(MTYPR,IPC,ICOND,IRETOU)
  480. CALL ACTOBJ(MTYPR,IPC,1)
  481. IF (IERR.NE.0) GOTO 9999
  482. ENDIF
  483. C
  484. C**** Control du CHPOINT
  485. C
  486. INDIC = 1
  487. NBCOMP = 1
  488. NOMTOT(1) = 'SCAL'
  489. CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT)
  490. IF(IERR .NE. 0)THEN
  491. IERR0 = IERR
  492.  
  493. C
  494. C******* Message d'erreur standard
  495. C -301 0 %m1:40
  496. C
  497. MOTERR(1:40) = 'CHPO7 = ??? '
  498. CALL ERREUR(-301)
  499.  
  500. GOTO 9999
  501. ENDIF
  502. C
  503. C**** Lecture du CHPOINT GRADPC
  504. C
  505. ICOND = 1
  506. CALL QUETYP(MTYPR,ICOND,IRETOU)
  507. IF(IERR .NE. 0)GOTO 9999
  508. IF(MTYPR .NE. 'CHPOINT ')THEN
  509. C
  510. C******* Message d'erreur standard
  511. C 37 2
  512. C On ne trouve pas d'objet de type %m1:8
  513. C
  514. MOTERR(1:8) = 'CHPOINT '
  515. CALL ERREUR(37)
  516. GOTO 9999
  517. ELSE
  518. ICOND = 1
  519. CALL LIROBJ(MTYPR,IGRPC,ICOND,IRETOU)
  520. CALL ACTOBJ(MTYPR,IGRPC,1)
  521. IF (IERR.NE.0) GOTO 9999
  522. ENDIF
  523. C
  524. C**** Control du CHPOINT: QUEPOI
  525. C
  526. C
  527. INDIC = 1
  528. NBCOMP = IDIM
  529. NOMTOT(1) = 'P1DX'
  530. NOMTOT(2) = 'P1DY'
  531. IF( IDIM .EQ. 3) NOMTOT(3) = 'P1DZ'
  532. CALL QUEPOI(IGRPC, ICEN, INDIC, NBCOMP, NOMTOT)
  533. IF(IERR .NE. 0)THEN
  534. IERR0 = IERR
  535.  
  536. C
  537. C******* Message d'erreur standard
  538. C -301 0 %m1:40
  539. C
  540. MOTERR(1:40) = 'CHPO8 = ??? '
  541. CALL ERREUR(-301)
  542.  
  543. GOTO 9999
  544. ENDIF
  545. C
  546. C**** Lecture du CHPOINT IALPC
  547. C
  548. ICOND = 1
  549. CALL QUETYP(MTYPR,ICOND,IRETOU)
  550. IF(IERR .NE. 0)GOTO 9999
  551. IF(MTYPR .NE. 'CHPOINT ')THEN
  552. C
  553. C******* Message d'erreur standard
  554. C 37 2
  555. C On ne trouve pas d'objet de type %m1:8
  556. C
  557. MOTERR(1:8) = 'CHPOINT '
  558. CALL ERREUR(37)
  559. GOTO 9999
  560. ELSE
  561. ICOND = 1
  562. CALL LIROBJ(MTYPR,IALPC,ICOND,IRETOU)
  563. CALL ACTOBJ(MTYPR,IALPC,1)
  564. IF (IERR.NE.0) GOTO 9999
  565. ENDIF
  566. C
  567. C**** Control du CHPOINT: QUEPOI
  568. C
  569. INDIC = 1
  570. NBCOMP = 1
  571. NOMTOT(1) = 'P1'
  572. CALL QUEPOI(IALPC, ICEN, INDIC, NBCOMP, NOMTOT)
  573. IF(IERR .NE. 0)THEN
  574. IERR0 = IERR
  575.  
  576. C
  577. C******* Message d'erreur standard
  578. C -301 0 %m1:40
  579. C
  580. MOTERR(1:40) = 'CHPO9 = ??? '
  581. CALL ERREUR(-301)
  582.  
  583. GOTO 9999
  584. ENDIF
  585. C
  586. C**** Lecture du CHPOINT GAMC
  587. C
  588. ICOND = 1
  589. CALL QUETYP(MTYPR,ICOND,IRETOU)
  590. IF(IERR .NE. 0)GOTO 9999
  591. IF(MTYPR .NE. 'CHPOINT ')THEN
  592. C
  593. C******* Message d'erreur standard
  594. C 37 2
  595. C On ne trouve pas d'objet de type %m1:8
  596. C
  597. MOTERR(1:8) = 'CHPOINT '
  598. CALL ERREUR(37)
  599. GOTO 9999
  600. ELSE
  601. ICOND = 1
  602. CALL LIROBJ(MTYPR,IGAMC,ICOND,IRETOU)
  603. CALL ACTOBJ(MTYPR,IGAMC,1)
  604. IF (IERR.NE.0) GOTO 9999
  605. ENDIF
  606. C
  607. C**** Control du CHPOINT
  608. C
  609. INDIC = 1
  610. NBCOMP = 1
  611. NOMTOT(1) = 'SCAL'
  612. CALL QUEPOI(IGAMC, ICEN, INDIC, NBCOMP, NOMTOT)
  613. IF(IERR .NE. 0)THEN
  614. IERR0 = IERR
  615.  
  616. C
  617. C******* Message d'erreur standard
  618. C -301 0 %m1:40
  619. C
  620. MOTERR(1:40) = 'CHPO10 = ??? '
  621. CALL ERREUR(-301)
  622.  
  623. GOTO 9999
  624. ENDIF
  625. IF(ORDTEM .EQ. 1)THEN
  626. C
  627. C******* Deux Dimensions, Une Espece, 2er ordre en espace, 1er ordre en
  628. C temps
  629. C
  630. LOGTEM = .FALSE.
  631. DELTAT = 0.0D0
  632. ELSE
  633. LOGTEM = .TRUE.
  634. ICOND = 1
  635. CALL LIRREE(DELTAT,ICOND,IRETOU)
  636. IF(IERR .NE. 0)GOTO 9999
  637. ENDIF
  638. IF(IDIM .EQ. 2)THEN
  639. C
  640. C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  641. C temps
  642. C
  643. CALL PRE121(LOGTEM,
  644. & ICEN,IFACE,IFACEL,INORM,
  645. & IROC, IGRROC, IALROC,
  646. & IVITC, IGRVC, IALVC,
  647. & IPC ,IGRPC, IALPC,
  648. & IGAMC,
  649. & DELTAT,
  650. & IROF,IVITF,IPF,IGAMF,
  651. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  652. ELSE
  653. C
  654. C******* Trois Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  655. C temps
  656. C
  657. CALL PRE122(LOGTEM,
  658. & ICEN,IFACE,IFACEL,INORM,
  659. & IROC, IGRROC, IALROC,
  660. & IVITC, IGRVC, IALVC,
  661. & IPC ,IGRPC, IALPC,
  662. & IGAMC,
  663. & DELTAT,
  664. & IROF,IVITF,IPF,IGAMF,
  665. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  666. ENDIF
  667. C
  668. C
  669. C**** Messages d'erreur
  670. C
  671. IF(LOGAN)THEN
  672. C
  673. C******* Anomalie detectée
  674. C
  675. C
  676. C******* Message d'erreur standard
  677. C -301 0
  678. C %m1:40
  679. C
  680. MOTERR(1:40) = MESERR(1:40)
  681. CALL ERREUR(-301)
  682. C
  683. C******* Message d'erreur standard
  684. C 5 3
  685. C Erreur anormale.contactez votre support
  686. C
  687. CALL ERREUR(5)
  688. GOTO 9999
  689. C
  690. ELSEIF(LOGNEG)THEN
  691. C
  692. C******* Message d'erreur standard
  693. C 41 2
  694. C %m1:8 = %r1 inférieur à %r2
  695. C
  696. MOTERR(1:8) = MESERR(1:8)
  697. REAERR(1) = REAL(VALER)
  698. REAERR(2) = 0.0
  699. CALL ERREUR(41)
  700. GOTO 9999
  701. ELSEIF(LOGBOR)THEN
  702. C
  703. C******* Message d'erreur standard
  704. C 42 2
  705. C %m1:8 = %r1 non compris entre %r2 et %r3
  706. C
  707. MOTERR(1:8) = MESERR(1:8)
  708. REAERR(1) = REAL(VALER)
  709. REAERR(2) = REAL(VAL1)
  710. REAERR(3) = REAL(VAL2)
  711. CALL ERREUR(42)
  712. GOTO 9999
  713. ELSE
  714. C
  715. C******* Ecriture de ROF, VITF, PF
  716. C
  717. MTYPR = 'MCHAML '
  718. CALL ACTOBJ(MTYPR,IGAMF,1)
  719. CALL ACTOBJ(MTYPR,IPF,1)
  720. CALL ACTOBJ(MTYPR,IVITF,1)
  721. CALL ACTOBJ(MTYPR,IROF,1)
  722.  
  723. CALL ECROBJ(MTYPR,IGAMF)
  724. CALL ECROBJ(MTYPR,IPF)
  725. CALL ECROBJ(MTYPR,IVITF)
  726. CALL ECROBJ(MTYPR,IROF)
  727. ENDIF
  728. C
  729. 9999 CONTINUE
  730.  
  731. END
  732.  
  733.  
  734.  

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