Télécharger clim11.eso

Retour à la liste

Numérotation des lignes :

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

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