Télécharger clim11.eso

Retour à la liste

Numérotation des lignes :

  1. C CLIM11 SOURCE PV 16/11/17 21:58:50 9180
  2. SUBROUTINE CLIM11(IJAC)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : CLIM11
  8. C
  9. C DESCRIPTION : Subroutine appellée par CLIM1
  10. C
  11. C Modelisation 2D/3D des equations d'Euler
  12. C Calcul de conditions aux bords
  13. C Inlet; Riemann invariants
  14. C
  15. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  18. C
  19. C************************************************************************
  20. C
  21. C APPELES (Calcul) :
  22. C
  23. C************************************************************************
  24. C
  25. C
  26. C************************************************************************
  27. C
  28. C HISTORIQUE (Anomalies et modifications éventuelles)
  29. C
  30. C HISTORIQUE :
  31. C
  32. C************************************************************************
  33. C
  34. IMPLICIT INTEGER(I-N)
  35. -INC CCOPTIO
  36. -INC SMLMOTS
  37. -INC SMELEME
  38. -INC SMLENTI
  39. POINTEUR MLMVIT.MLMOTS
  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, IFICLE, IPREFI
  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
  53. C
  54. INTEGER IJAC, IJACO
  55. & ,IDOMA, IDBOR, IRET, MELEMC, MELEFE, MELEMF, ICHPVO, INORM
  56. & ,ICHPSU, MELECB, NBCOMP, INDIC, MELEFC, MELRES
  57. & ,JGN, JGM, NBELEM, NBNN, NBSOUS, NBREF, NGF, NLC
  58. & ,I1, ICEN, N1, ILIINP
  59. & ,ILIINC, IROC, IVITC, IPC, IGAMC, ICHLIM, NBOPT, ILIM
  60. & ,ICHRES, ICHRLI
  61. & ,NKID,NKMT,NMATRI,NRIGE,MMODEL,INEFMD
  62. PARAMETER (NBOPT=9)
  63. CHARACTER*8 LOPT(NBOPT)
  64. CHARACTER*4 MOT
  65. CHARACTER*8 TYPE
  66. C
  67. DATA LOPT/'INRI ','OUTRI ','INSS ','OUTSS ','OUTP ',
  68. & 'INSU ','INJE ','INJELM ','INSO '/
  69. C
  70. C*******************************
  71. C**** La table domaine *********
  72. C*******************************
  73. C
  74. CALL LIROBJ('MMODEL',MMODEL,1,IRET)
  75. IF(IERR.NE.0)GOTO 9999
  76. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  77. C INEFMD inutilisé
  78. IF(IERR .NE. 0)GOTO 9999
  79. C
  80. CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  81. IF(IERR .NE. 0) GOTO 9999
  82. C
  83. CALL LEKTAB(IDOMA,'FACE',MELEMF)
  84. IF(IERR .NE. 0) GOTO 9999
  85. C
  86. C**** Lecture du CHPOINT contenant les volumes
  87. C
  88. CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  89. IF(IERR .NE. 0) GOTO 9999
  90. INDIC = 1
  91. NBCOMP = 1
  92. MOT = 'SCAL'
  93. CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT)
  94. IF(IERR .NE. 0) GOTO 9999
  95. C
  96. CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  97. IF(IERR .NE. 0) GOTO 9999
  98. INDIC = 1
  99. NBCOMP = 1
  100. MOT = 'SCAL'
  101. CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT)
  102. IF(IERR .NE. 0) GOTO 9999
  103. C
  104. C**** Les normales aux faces
  105. C
  106. IF(IDIM .EQ. 2)THEN
  107. C Que les normales
  108. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  109. IF(IERR .NE. 0) GOTO 9999
  110. JGN = 4
  111. JGM = 2
  112. SEGINI MLMVIT
  113. MLMVIT.MOTS(1) = 'UX '
  114. MLMVIT.MOTS(2) = 'UY '
  115. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  116. SEGSUP MLMVIT
  117. IF(IERR .NE. 0) GOTO 9999
  118. ELSE
  119. C
  120. C**** Les normales ('MX ', ...)
  121. C Les tangentes ('RX ', ...)
  122. C
  123. TYPE = ' '
  124. CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
  125. IF (TYPE .NE. 'CHPOINT ') THEN
  126. CALL MATRAN(IDOMA,INORM)
  127. IF(IERR .NE. 0) GOTO 9999
  128. ENDIF
  129. JGN = 4
  130. JGM = 9
  131. SEGINI MLMVIT
  132. MLMVIT.MOTS(1) = 'MX '
  133. MLMVIT.MOTS(2) = 'MY '
  134. MLMVIT.MOTS(3) = 'MZ '
  135. MLMVIT.MOTS(4) = 'RX '
  136. MLMVIT.MOTS(5) = 'RY '
  137. MLMVIT.MOTS(6) = 'RZ '
  138. MLMVIT.MOTS(7) = 'UX '
  139. MLMVIT.MOTS(8) = 'UY '
  140. MLMVIT.MOTS(9) = 'UZ '
  141. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  142. SEGSUP MLMVIT
  143. ENDIF
  144. C
  145. C**********************************
  146. C**** La table domaine du bord ****
  147. C**********************************
  148. C
  149. CALL LIROBJ('MMODEL',MMODEL,1,IRET)
  150. IF(IERR.NE.0)GOTO 9999
  151. CALL LEKMOD(MMODEL,IDBOR,INEFMD)
  152. C INEFMD inutilisé
  153. IF(IERR .NE. 0)GOTO 9999
  154. C
  155. CALL LEKTAB(IDBOR,'CENTRE',MELECB)
  156. IF(IERR .NE. 0) GOTO 9999
  157. C
  158. TYPE = ' '
  159. CALL ACMO(IDBOR,'FACCEN',TYPE,MELEFC)
  160. IF (TYPE.NE.'MAILLAGE') THEN
  161. C
  162. CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  163. IF(IERR .NE. 0) GOTO 9999
  164. C
  165. C******* On cree la connectivité face-centre
  166. C
  167. IPT1=MELECB
  168. IPT2=MELEFE
  169. SEGACT IPT1
  170. SEGACT IPT2
  171. CALL KRIPAD(IPT1,MLENTI)
  172. C SEGINI MLENTI
  173. NBELEM=IPT1.NUM(/2)
  174. NBNN=2
  175. NBSOUS=0
  176. NBREF=0
  177. SEGINI IPT3
  178. IPT3.ITYPEL=2
  179. N1=IPT2.NUM(/2)
  180. ICEN=0
  181. DO I1=1,N1,1
  182. NGF=IPT2.NUM(2,I1)
  183. NLC=MLENTI.LECT(NGF)
  184. IF(NLC.NE.0)THEN
  185. ICEN=ICEN+1
  186. IPT3.NUM(1,ICEN)=NGF
  187. IPT3.NUM(2,ICEN)=IPT2.NUM(1,I1)
  188. IF(IPT2.NUM(1,I1) .NE. IPT2.NUM(3,I1))THEN
  189. C Interior point
  190. C Donné incompatible
  191. WRITE(IOIMP,*) 'Internal boundary condition!!!'
  192. CALL ERREUR(21)
  193. ENDIF
  194. ENDIF
  195. ENDDO
  196. C
  197. IF(ICEN .NE. NBELEM)THEN
  198. CALL ERREUR(5)
  199. ENDIF
  200. SEGDES IPT1
  201. SEGDES IPT2
  202. SEGDES IPT3
  203. SEGSUP MLENTI
  204. C
  205. MELEFC=IPT3
  206. CALL ECMO(IDBOR,'FACCEN','MAILLAGE',IPT3)
  207. ENDIF
  208. C
  209. C**** Le SPG du residu
  210. C
  211. IPT1=MELEFC
  212. SEGACT IPT1
  213. NBELEM=IPT1.NUM(/2)
  214. NBNN=1
  215. NBSOUS=0
  216. NBREF=0
  217. SEGINI IPT2
  218. IPT2.ITYPEL=1
  219. DO I1=1,NBELEM,1
  220. IPT2.NUM(1,I1)=IPT1.NUM(2,I1)
  221. ENDDO
  222. MELRES=IPT2
  223. SEGDES IPT1
  224. SEGDES IPT2
  225. C
  226. C**** Noms de variables conservatives
  227. C
  228. TYPE='LISTMOTS'
  229. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  230. IF(IERR .NE. 0) GOTO 9999
  231. MLMOTS = ILIINC
  232. SEGACT MLMOTS
  233. NBCOMP = MLMOTS.MOTS(/2)
  234. SEGDES MLMOTS
  235. IF(NBCOMP .NE. (IDIM+2))THEN
  236. MOTERR(1:40) = 'LISTINCO = ???'
  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. ENDIF
  246. C
  247. C**** Noms de variables primitives
  248. C
  249. TYPE='LISTMOTS'
  250. CALL LIROBJ(TYPE,ILIINP,1,IRET)
  251. IF(IERR .NE. 0) GOTO 9999
  252. MLMOTS = ILIINP
  253. SEGACT MLMOTS
  254. NBCOMP = MLMOTS.MOTS(/2)
  255. SEGDES MLMOTS
  256. IF(NBCOMP .NE. (IDIM+2))THEN
  257. MOTERR(1:40) = 'LISTPRIM = ???'
  258. WRITE(IOIMP,*) MOTERR
  259. C
  260. C******* Message d'erreur standard
  261. C 21 2
  262. C Données incompatibles
  263. C
  264. CALL ERREUR(21)
  265. GOTO 9999
  266. ENDIF
  267. C
  268. C**** Lecture du CHPOINT RN
  269. C
  270. TYPE='CHPOINT '
  271. CALL LIROBJ(TYPE,IROC,1,IRET)
  272. IF (IERR.NE.0) GOTO 9999
  273. C
  274. C**** Control du CHPOINT: QUEPOI
  275. C
  276. C INDIC = 1 -> on impose le pointeur du support geometrique
  277. C NBCOMP > 0 -> nombre des composantes
  278. C
  279. INDIC = 1
  280. NBCOMP = 1
  281. MOT = 'SCAL'
  282. CALL QUEPOI(IROC, MELEMC, INDIC, NBCOMP, MOT)
  283. IF(IERR .NE. 0)GOTO 9999
  284. C
  285. C**** Lecture du CHPOINT VITC
  286. C
  287. CALL LIROBJ('CHPOINT',IVITC,1,IRET)
  288. IF (IERR.NE.0) GOTO 9999
  289. C
  290. C**** Control du CHPOINT
  291. C
  292. JGN = 4
  293. JGM = IDIM
  294. SEGINI MLMVIT
  295. MLMVIT.MOTS(1) = 'UX '
  296. MLMVIT.MOTS(2) = 'UY '
  297. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  298. CALL QUEPO1(IVITC, MELEMC, MLMVIT)
  299. SEGSUP MLMVIT
  300. IF(IERR .NE. 0)GOTO 9999
  301. C
  302. C**** Lecture du CHPOINT PC
  303. C
  304. CALL LIROBJ('CHPOINT',IPC,1,IRET)
  305. IF (IERR.NE.0) GOTO 9999
  306. C
  307. C**** Control du CHPOINT
  308. C
  309. INDIC = 1
  310. NBCOMP = 1
  311. MOT = 'SCAL'
  312. CALL QUEPOI(IPC, MELEMC, INDIC, NBCOMP, MOT)
  313. IF(IERR .NE. 0)GOTO 9999
  314. C
  315. C**** Lecture du CHPOINT GAMC
  316. C
  317. CALL LIROBJ('CHPOINT',IGAMC,1,IRET)
  318. IF (IERR.NE.0) GOTO 9999
  319. C
  320. C**** Control du CHPOINT
  321. C
  322. INDIC = 1
  323. NBCOMP = 1
  324. MOT = 'SCAL'
  325. CALL QUEPOI(IGAMC, MELEMC, INDIC, NBCOMP, MOT)
  326. IF(IERR .NE. 0)GOTO 9999
  327. C
  328. C**** CHPOINT condition limite
  329. C
  330. CALL LIROBJ('CHPOINT',ICHLIM,1,IRET)
  331. IF (IERR.NE.0) GOTO 9999
  332. C
  333. C**** Resultats
  334. C
  335. IF(IJAC .EQ.0)THEN
  336. TYPE=' '
  337. CALL KRCHP1(TYPE,MELRES,ICHRES,ILIINC)
  338. C
  339. TYPE=' '
  340. CALL KRCHP1(TYPE,MELECB,ICHRLI,ILIINP)
  341. ELSE
  342. ICHRES=0
  343. ICHRLI=0
  344. ENDIF
  345. C
  346. C**** TYPE DE CONDITION LIMITE
  347. C
  348. CALL LIRMOT(LOPT,NBOPT,ILIM,1)
  349. IF(IERR .NE. 0) GOTO 9999
  350. IF(ILIM .EQ. 1)THEN
  351. C
  352. C******** 'INRI '
  353. C
  354. JGN = 4
  355. JGM = IDIM+2
  356. SEGINI MLMVIT
  357. MLMVIT.MOTS(1) = 'RN '
  358. MLMVIT.MOTS(2) = 'UX '
  359. MLMVIT.MOTS(3) = 'UY '
  360. IF(IDIM .EQ. 3) MLMVIT.MOTS(4) = 'UZ '
  361. MLMVIT.MOTS(2+IDIM)='PN '
  362. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  363. SEGSUP MLMVIT
  364. IF (IERR.NE.0) GOTO 9999
  365. C
  366. IF(IJAC.EQ.0)THEN
  367. CALL CLI111(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  368. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  369. IF(IERR.NE.0)GOTO 9999
  370. ELSE
  371. IF(IDIM.EQ.2)THEN
  372. CALL CLI112(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  373. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  374. $ ,ILIINP,IJAC,IJACO)
  375. ELSE
  376. CALL CLI113(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  377. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  378. $ ,ILIINP,IJAC,IJACO)
  379. ENDIF
  380. IF(IERR.NE.0)GOTO 9999
  381. ENDIF
  382. ELSEIF(ILIM .EQ. 2)THEN
  383. C
  384. C******** 'OUTRI '
  385. C
  386. JGN = 4
  387. JGM = IDIM+2
  388. SEGINI MLMVIT
  389. MLMVIT.MOTS(1) = 'RN '
  390. MLMVIT.MOTS(2) = 'UX '
  391. MLMVIT.MOTS(3) = 'UY '
  392. IF(IDIM .EQ. 3) MLMVIT.MOTS(4) = 'UZ '
  393. MLMVIT.MOTS(2+IDIM)='PN '
  394. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  395. SEGSUP MLMVIT
  396. IF (IERR.NE.0) GOTO 9999
  397. C
  398. IF(IJAC.EQ.0)THEN
  399. CALL CLI121(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  400. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  401. IF(IERR.NE.0)GOTO 9999
  402. ELSE
  403. IF(IDIM.EQ.2)THEN
  404. CALL CLI122(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  405. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  406. $ ,ILIINP,IJAC,IJACO)
  407. ELSE
  408. CALL CLI123(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  409. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  410. $ ,ILIINP,IJAC,IJACO)
  411. ENDIF
  412. IF(IERR.NE.0)GOTO 9999
  413. ENDIF
  414. ELSEIF(ILIM .EQ. 3)THEN
  415. C
  416. C******** 'INSS '
  417. C
  418. JGN = 4
  419. JGM = IDIM+2
  420. SEGINI MLMVIT
  421. MLMVIT.MOTS(1) = 'RN '
  422. MLMVIT.MOTS(2) = 'UX '
  423. MLMVIT.MOTS(3) = 'UY '
  424. IF(IDIM .EQ. 3) MLMVIT.MOTS(4) = 'UZ '
  425. MLMVIT.MOTS(2+IDIM)='PN '
  426. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  427. SEGSUP MLMVIT
  428. IF (IERR.NE.0) GOTO 9999
  429. C
  430. IF(IJAC.EQ.0)THEN
  431. CALL CLI131(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  432. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  433. IF(IERR.NE.0)GOTO 9999
  434. ELSE
  435. * Le Jacobien est une matrik vide
  436. NRIGE=7
  437. NMATRI=0
  438. NKID =9
  439. NKMT =7
  440. SEGINI MATRIK
  441. SEGDES MATRIK
  442. IJACO=MATRIK
  443. ENDIF
  444. ELSEIF(ILIM .EQ. 4)THEN
  445. C
  446. C******** 'OUTSS '
  447. C
  448. C ICHLIM est un CHPOINT vide
  449. C Mais on fait pas de controlle
  450. C
  451. IF(IJAC.EQ.0)THEN
  452. CALL CLI141(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  453. & IROC,IVITC,IPC,IGAMC,ICHRES,ICHRLI)
  454. IF(IERR.NE.0)GOTO 9999
  455. ELSE
  456. IF(IDIM.EQ.2)THEN
  457. CALL CLI142(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  458. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ILIINC
  459. $ ,ILIINP,IJAC,IJACO)
  460. ELSE
  461. CALL CLI143(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  462. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ILIINC
  463. $ ,ILIINP,IJAC,IJACO)
  464. ENDIF
  465. IF(IERR.NE.0)GOTO 9999
  466. ENDIF
  467. ELSEIF(ILIM .EQ. 5)THEN
  468. C
  469. C******** 'OUTP '
  470. C
  471. JGN = 4
  472. JGM = 1
  473. SEGINI MLMVIT
  474. MLMVIT.MOTS(1)='PN '
  475. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  476. SEGSUP MLMVIT
  477. IF (IERR.NE.0) GOTO 9999
  478. C
  479. IF(IJAC.EQ.0)THEN
  480. CALL CLI151(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  481. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  482. IF(IERR.NE.0)GOTO 9999
  483. ELSE
  484. IF(IDIM.EQ.2)THEN
  485. CALL CLI152(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  486. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  487. $ ,ILIINP,IJAC,IJACO)
  488. ELSE
  489. CALL CLI153(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  490. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  491. $ ,ILIINP,IJAC,IJACO)
  492. ENDIF
  493. ENDIF
  494. ELSEIF(ILIM .EQ. 6)THEN
  495. C
  496. C******** 'INSU '
  497. C
  498. JGN = 4
  499. JGM = 2
  500. SEGINI MLMVIT
  501. MLMVIT.MOTS(1) = 'HT '
  502. MLMVIT.MOTS(2) = 'S '
  503. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  504. SEGSUP MLMVIT
  505. IF (IERR.NE.0) GOTO 9999
  506. C
  507. IF(IJAC.EQ.0)THEN
  508. CALL CLI161(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  509. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  510. IF(IERR.NE.0)GOTO 9999
  511. ELSE
  512. IF(IDIM.EQ.2)THEN
  513. CALL CLI162(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  514. & ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  515. & ,ILIINP,IJAC,IJACO)
  516. ELSE
  517. CALL CLI163(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  518. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  519. $ ,ILIINP,IJAC,IJACO)
  520. ENDIF
  521. ENDIF
  522. ELSEIF(ILIM .EQ. 7)THEN
  523. C
  524. C******** 'INJE '
  525. C
  526. JGN = 4
  527. JGM = 2
  528. SEGINI MLMVIT
  529. MLMVIT.MOTS(1) = 'MOME'
  530. MLMVIT.MOTS(2) = 'RT '
  531. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  532. SEGSUP MLMVIT
  533. IF (IERR.NE.0) GOTO 9999
  534. C
  535. IF(IJAC.EQ.0)THEN
  536. CALL CLI181(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  537. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  538. IF(IERR.NE.0)GOTO 9999
  539. ELSE
  540. IF(IDIM.EQ.2)THEN
  541. CALL CLI182(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  542. & ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  543. & ,ILIINP,IJAC,IJACO)
  544. ELSE
  545. CALL CLI183(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  546. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  547. $ ,ILIINP,IJAC,IJACO)
  548. ENDIF
  549. ENDIF
  550. ELSEIF(ILIM .EQ. 8)THEN
  551. C
  552. C******** 'INJELM '
  553. C
  554. JGN = 4
  555. JGM = 2
  556. SEGINI MLMVIT
  557. MLMVIT.MOTS(1) = 'MOME'
  558. MLMVIT.MOTS(2) = 'RT '
  559. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  560. SEGSUP MLMVIT
  561. IF (IERR.NE.0) GOTO 9999
  562. C
  563. IF(IJAC.EQ.0)THEN
  564. CALL CLI171(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  565. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  566. IF(IERR.NE.0)GOTO 9999
  567. ELSE
  568. IF(IDIM.EQ.2)THEN
  569. CALL CLI172(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  570. & ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  571. & ,ILIINP,IJAC,IJACO)
  572. ELSE
  573. CALL CLI173(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM
  574. $ ,ICHPVO,ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC
  575. $ ,ILIINP,IJAC,IJACO)
  576. ENDIF
  577. ENDIF
  578. ELSEIF(ILIM .EQ. 9)THEN
  579. C
  580. C******** 'INSO '
  581. C
  582. JGN = 4
  583. JGM = 2
  584. SEGINI MLMVIT
  585. MLMVIT.MOTS(1) = 'PSTA'
  586. MLMVIT.MOTS(2) = 'RSTA'
  587. CALL QUEPO1(ICHLIM, MELECB, MLMVIT)
  588. SEGSUP MLMVIT
  589. IF (IERR.NE.0) GOTO 9999
  590. C
  591. IF(IJAC.EQ.0)THEN
  592. CALL CLI191(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  593. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  594. IF(IERR.NE.0)GOTO 9999
  595. ENDIF
  596. ENDIF
  597. C
  598. IF(IJAC.EQ.0)THEN
  599. CALL ECROBJ('CHPOINT ',ICHRES)
  600. CALL ECROBJ('CHPOINT ',ICHRLI)
  601. ELSE
  602. CALL ECROBJ('MATRIK ',IJACO)
  603. ENDIF
  604. C
  605. 9999 CONTINUE
  606. RETURN
  607. END
  608.  
  609.  
  610.  
  611.  
  612.  
  613.  
  614.  
  615.  
  616.  
  617.  
  618.  
  619.  
  620.  
  621.  
  622.  
  623.  

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