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

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