Télécharger echimp.eso

Retour à la liste

Numérotation des lignes :

  1. C ECHIMP SOURCE CHAT 06/08/24 21:27:19 5529
  2. SUBROUTINE ECHIMP
  3. C=======================================================================
  4. C L'opérateur ECHIMP discrétise un échange surfacique ou volumique
  5. C avec un milieu exterieur. Le terme d'échange est de la forme
  6. * h(T-T0) où h est un coefficient d'échange, T une des inconnues du
  7. C problème traité et T0 "un champ exterieur connu".
  8. C-----------------------------------------------------------------------
  9. C La convention de signe associée à ce terme est la suivante : lorsque
  10. C h est positif et T0<T, le terme d'échange tant à faire diminuer la
  11. C quantité T présente dans le domaine.
  12. C D'un point de vue numérique, ce terme est dans l'équation traitée du
  13. C meme coté que le terme de dérivée en temps.
  14. C-----------------------------------------------------------------------
  15. C
  16. C-------------------------
  17. C Phrase d'appel GIBIANE :
  18. C-------------------------
  19. C
  20. C 'ECHI' KIZX ;
  21. C
  22. C KIZX : Table de sous-type KIZX associée à l'opérateur ECHI
  23. C
  24. C--------------------------------
  25. C Construction de KIZX via EQEX :
  26. C--------------------------------
  27. C
  28. C 'ZONE' TAB1 'OPER' 'ECHI' CHPO1 CHPO2 'INCO' MOT1 (MOT2) ;
  29. C
  30. C TAB1 : TABLE DOMAINE associée à la zone d'échange. On trouvera
  31. C à l'indice MAILLAGE de cette table la surface ou le volume
  32. C sur lequel à lieu l'échange avec le milieu exterieur.
  33. C CHPO1 : Coefficient d'échange (par unité de surface ou de volume
  34. C suivant le type d'échange traité) (CHPO, FLOTTANT ou MOT).
  35. C (spg du CHPO : CENTRE)
  36. C CHPO2 : Champ scalaire exterieur connu (CHPO, FLOTTANT ou MOT)
  37. C (spg du CHPO : CENTRE ou SOMMET)
  38. C MOT1 : Nom de l'inconnue scalaire primale sur laquelle porte
  39. C l'échange surfacique ou volumique (MOT).
  40. C MOT2 : Nom de l'inconnue scalaire duale (facultatif - MOT).
  41. C Indique l'équation dans laquelle le terme d'échange est à
  42. C considérer. Si MOT2 est omis, les inconnues primales et
  43. C duale sont identiques (obligatoire en explicite).
  44. C
  45. C------------
  46. C Résultats :
  47. C------------
  48. C On crée une partie implicite correspondant à la linéarisation
  49. C du terme h*T et un second membre correspondant au terme h*T0.
  50. C
  51. C
  52. C-> En explicite :
  53. C
  54. C On suppose que les inconnues primales et duales sont identiques
  55. C afin de pouvoir impliciter l'échange avec le milieu exterieur.
  56. C Pour cela, on condense la matrice masse, quelle que soit la
  57. C formulation utilisée (donc EF -> EFM1).
  58. C 1) La matrice diagonale est stockée dans un CHPO et rangée dans la
  59. C table KIZG1 à l'indice de type MOT MOT1 (nom de l'inconnue).
  60. C 2) Le second membre est stocké dans un CHPO et rangé dans la
  61. C table KIZG à l'indice de type MOT MOT1 (nom de l'inconnue).
  62. C
  63. C-> En implicite
  64. C
  65. C Les inconnues primales et duales peuvent etre différentes et de
  66. C spg CENTRE ou SOMMET. En implicite, on ne condense pas les matrices
  67. C masse (donc EFM1 -> EF).
  68. C 1) La matrice "masse" est stockée dans un MATRIK et rangée dans la
  69. C table KIZX à l'indice de type MOT MATELM.
  70. C 2) Le second membre est stocké dans un CHPO et assemblé dans la
  71. C table EQEX à l'indice de type MOT SMBR. Le nom de l'inconnue
  72. C duale MOT2 étant le nom de la composante du CHPO créé.
  73. C
  74. C-------------------------
  75. C Formulations acceptées :
  76. C-------------------------
  77. C 0) Défaut : EFM1 explicite.
  78. C 1) EFM1 en explicite (en implicite, assimilé à EF)
  79. C 2) EF en implicite (en explicite, assimilé à EFM1)
  80. C 3) VF en explicite et en implicite.
  81. C
  82. C----------------------
  83. C Support des données :
  84. C----------------------
  85. C H : SCAL ou CHPO SCAL CENTRE
  86. C T0 : SCAL ou CHPO SCAL CENTRE ou CHPO SCAL SOMMET
  87. C
  88. C------------------------------------------
  89. C Indices de table utilisés (racine KIZX) :
  90. C------------------------------------------
  91. C 'DOMZ' : Table domaine associé à l'opérateur (domaine local)
  92. C E/ 'MAILLAGE' -> Maillage du domaine local
  93. C E/ 'CENTRE' -> Points centre du domaine local
  94. C E/ 'XXPSOML' -> Intégrale des fonctions de base par élément (MCHAML)
  95. C E/ 'IARG' : Nombre d'arguments de l'opérateur
  96. C E/ 'ARG1' : Premier argument (coefficient d'échange)
  97. C E/ 'ARG2' : Deuxième argument (champ exterieur)
  98. C E/ 'LISTINCO' : Listmot contenant le nom de l'inconnue
  99. C 'KOPT' : Table des options
  100. C E/ 'KFORM' -> Formulation spatiale
  101. C E/ 'KIMPL' -> Formulation temporelle
  102. C 'EQEX' : Table décrivant la modélisation (modèle fluide)
  103. C E/ 'INCO' -> Table des inconnues et des données
  104. C /S 'KIZG' -> Table des seconds membres (cas explicite)
  105. C /S 'KIZG1' -> Table des matrices diagonales (cas explicite)
  106. C-----------------------------------------------------------------------
  107. C
  108. IMPLICIT INTEGER(I-N)
  109. IMPLICIT REAL*8 (A-H,O-Z)
  110. C
  111. -INC CCOPTIO
  112. -INC SMCHPOI
  113. -INC SMLENTI
  114. -INC SMELEME
  115. POINTEUR MELEMC.MELEME
  116. -INC SMLMOTS
  117. C
  118. CHARACTER*8 NOMD,NOMP,TYPE,TYPC,MTYP,CHAI
  119. PARAMETER (NTB=1)
  120. CHARACTER*8 LTAB(NTB)
  121. DIMENSION KTAB(NTB),IXV(4)
  122. DATA LTAB/'KIZX '/
  123.  
  124.  
  125. C Nouvelle directive EQUA de EQEX
  126. MTYP=' '
  127. CALL QUETYP(MTYP,0,IRET)
  128. IF(IRET.EQ.0)THEN
  129. C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40
  130. MOTERR( 1: 8) = 'CHAI '
  131. MOTERR( 9:16) = 'MMODEL '
  132. MOTERR(17:24) = 'TABLE '
  133. CALL ERREUR(472)
  134. RETURN
  135. ENDIF
  136.  
  137. IF(MTYP.EQ.'MMODEL')THEN
  138. CALL YTCLSF('E ','ECHI ')
  139. RETURN
  140. ELSEIF(MTYP.EQ.'MOT ')THEN
  141. CALL LIRCHA(CHAI,1,IRET)
  142. CALL YTCLSF(CHAI,'ECHI ')
  143. RETURN
  144. ENDIF
  145. C Fin Nouvelle directive EQUA de EQEX
  146.  
  147. C
  148. C- Lecture de la table KIZX (pointeur MTABX) associée à ECHIMP
  149. C
  150. CALL LITABS(LTAB,KTAB,NTB,1,IRET)
  151. IF (IERR.NE.0) RETURN
  152. MTABX = KTAB(1)
  153. C
  154. C- Récupération de la table EQEX (pointeur MTAB1)
  155. C
  156. CALL LEKTAB(MTABX,'EQEX',MTAB1)
  157. IF (MTAB1.EQ.0)THEN
  158. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  159. MOTERR( 1: 8) = ' EQEX '
  160. MOTERR( 9:16) = ' EQEX '
  161. MOTERR(17:24) = ' KIZX '
  162. CALL ERREUR(786)
  163. RETURN
  164. ENDIF
  165. CALL ACME(MTAB1,'NAVISTOK',NASTOK)
  166. IF(NASTOK.EQ.0)THEN
  167. CALL ZCHIMP(MTABX,MTAB1)
  168. RETURN
  169. ENDIF
  170. C
  171. C- Récupération de la table DOMAINE associée au domaine local
  172. C
  173. CALL LEKTAB(MTABX,'DOMZ',MTABZ)
  174. IF (MTABZ.EQ.0) THEN
  175. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  176. MOTERR( 1: 8) = ' DOMZ '
  177. MOTERR( 9:16) = ' DOMZ '
  178. MOTERR(17:24) = ' KIZX '
  179. CALL ERREUR(786)
  180. RETURN
  181. ENDIF
  182. C
  183. C- Récupération de la table INCO (pointeur KINC)
  184. C
  185. CALL LEKTAB(MTAB1,'INCO',KINC)
  186. IF (KINC.EQ.0) THEN
  187. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  188. MOTERR( 1: 8) = ' INCO '
  189. MOTERR( 9:16) = ' INCO '
  190. MOTERR(17:24) = ' EQEX '
  191. CALL ERREUR(786)
  192. RETURN
  193. ENDIF
  194. C
  195. C- Récupération de la table des options KOPT (pointeur KOPTI)
  196. C- et initialisations des options (par défaut SI et EXPL)
  197. C- KFORM = 0 -> SI 1 -> EF 2 -> VF
  198. C- KIMPL = 0 -> EXPL 1 -> IMPL 2 -> CN
  199. C
  200. KFORM = 0
  201. KIMPL = 0
  202. TYPE = ' '
  203. CALL ACMO(MTABX,'KOPT',TYPE,KOPTI)
  204. IF (TYPE.EQ.'TABLE') THEN
  205. TYPE = ' '
  206. CALL ACMO(KOPTI,'KFORM',TYPE,IENT)
  207. IF (TYPE.EQ.'ENTIER') CALL ACME(KOPTI,'KFORM',KFORM)
  208. TYPE = ' '
  209. CALL ACMO(KOPTI,'KIMPL',TYPE,IENT)
  210. IF (TYPE.EQ.'ENTIER') CALL ACME(KOPTI,'KIMPL',KIMPL)
  211. ENDIF
  212. C
  213. C- Identification du type d'échange :
  214. C- Surfacique (ISURF1=1) ou volumique (IVOL1=1).
  215. C
  216. ISURF1 = 0
  217. IVOL1 = 0
  218. CALL LEKTAB(MTABZ,'MAILLAGE',MELEME)
  219. IF (IERR.NE.0) RETURN
  220. SEGACT MELEME
  221. NBSOUS = LISOUS(/1)
  222. IF (NBSOUS.EQ.0) NBSOUS=1
  223. DO 10 I=1,NBSOUS
  224. IPT1=MELEME
  225. IF (NBSOUS.NE.1) IPT1=LISOUS(I)
  226. SEGACT IPT1
  227. ITYPL=IPT1.ITYPEL
  228. c write(6,*) '***************************',itypl
  229. IF (IDIM.EQ.2) THEN
  230. * - L'échange est surfacique (un flux est échangé) si
  231. * en 2D, les éléments sont de type SEG2 ou SEG3,
  232. IF (ITYPL.EQ.2.OR.ITYPL.EQ.3) THEN
  233. ISURF1 = 1
  234. * - L'échange est volumique (une source volumique est échangée) si
  235. * en 2D, les éléments sont de type TRI3, QUA4, TRI6, TRI7
  236. * ou QUA9.
  237. ELSEIF (ITYPL.EQ.4.OR.ITYPL.EQ.8.OR.
  238. $ ITYPL.EQ.6.OR.ITYPL.EQ.7.OR.
  239. $ ITYPL.EQ.11) THEN
  240. IVOL1 = 1
  241. ELSE
  242. C Type d'élément incorrect
  243. CALL ERREUR(16)
  244. RETURN
  245. ENDIF
  246. ELSEIF (IDIM.EQ.3) THEN
  247. * - L'échange est surfacique (un flux est échangé) si
  248. * en 3D, les éléments sont de type TRI3, QUA4, TRI6, TRI7
  249. * ou QUA9.
  250. IF (ITYPL.EQ.4.OR.ITYPL.EQ.8.OR.
  251. $ ITYPL.EQ.6.OR.ITYPL.EQ.7.OR.
  252. $ ITYPL.EQ.11) THEN
  253. ISURF1 = 1
  254. * - L'échange est volumique (une source volumique est échangée) si
  255. * en 3D, les éléments sont de type CUB8, PRI6, TET4,
  256. * CU27, PR21, TE15,
  257. * PR18 ou TE10.
  258. ELSEIF (ITYPL.EQ.14.OR.ITYPL.EQ.16.OR.
  259. $ ITYPL.EQ.23.OR.ITYPL.EQ.33.OR.
  260. $ ITYPL.EQ.34.OR.ITYPL.EQ.35.OR.
  261. $ ITYPL.EQ.40.OR.ITYPL.EQ.24) THEN
  262. IVOL1 = 1
  263. ELSE
  264. C Type d'élément incorrect
  265. CALL ERREUR(16)
  266. RETURN
  267. ENDIF
  268. ENDIF
  269. SEGDES IPT1
  270. 10 CONTINUE
  271. IF (IVOL1.EQ.1.AND.ISURF1.EQ.1) THEN
  272. C Maillage incorrect : contient des éléments 1D et 2D
  273. CALL ERREUR(798)
  274. RETURN
  275. ENDIF
  276. IF (NBSOUS.NE.1) SEGDES MELEME
  277. C
  278. C- Récupération du nom des inconnues (primale et duale)
  279. C
  280. TYPE = 'LISTMOTS'
  281. CALL ACMO(MTABX,'LISTINCO',TYPE,MLMOTS)
  282. IF (IERR.NE.0) RETURN
  283. SEGACT MLMOTS
  284. NBINC = MOTS(/2)
  285. IF (NBINC.LE.0.OR.NBINC.GE.3) THEN
  286. C Indice %m1:8 : contient plus de %i1 %m9:16
  287. MOTERR( 1:8) = 'LISTINCO'
  288. INTERR(1) = 2
  289. MOTERR(9:16) = ' MOTS '
  290. CALL ERREUR(799)
  291. RETURN
  292. ENDIF
  293. NOMP = MOTS(1)
  294. IF (NBINC.EQ.1) THEN
  295. NOMD = MOTS(1)
  296. ELSE
  297. NOMD = MOTS(2)
  298. ENDIF
  299. SEGDES MLMOTS
  300. C
  301. C- Informations géométriques locales associées à l'opérateur
  302. C
  303. CALL LEKTAB(MTABZ,'CENTRE',MELEMC)
  304. IF (IERR.NE.0) RETURN
  305. CALL LEKTAB(MTABZ,'SOMMET',MELEMS)
  306. IF (IERR.NE.0) RETURN
  307. C
  308. C- Identification du spg de l'inconnue duale
  309. C- Trois cas sont possible (identifier par IKAS)
  310. C- 1) spg contenant melems -> formulation EF
  311. C- 2) spg contenant melemc -> formulation VF si IVOL1=1; ERREUR sinon
  312. C- 3) ni 2) ni 3) -> formulation VF si IVOL1=0; ERREUR sinon
  313. C
  314. TYPE = ' '
  315. IKAS = 0
  316. CALL ACMO(KINC,NOMD,TYPE,MCHPOI)
  317. IF (TYPE.NE.'CHPOINT ') THEN
  318. C Indice %m1:8 : ne contient pas un objet de type %m9:16
  319. MOTERR(1: 8) = 'INCO'//NOMD(1:4)
  320. MOTERR(9:16) = 'CHPOINT '
  321. CALL ERREUR(800)
  322. RETURN
  323. ELSE
  324. CALL LICHT(MCHPOI,MPOVAL,TYPC,MELEMD)
  325. NC = VPOCHA(/2)
  326. SEGDES MPOVAL
  327. IF (NC.NE.1) THEN
  328. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon nombre de composantes
  329. MOTERR(1: 8) = 'INCO'//NOMD(1:4)
  330. MOTERR(9:16) = 'CHPOINT '
  331. CALL ERREUR(784)
  332. RETURN
  333. ENDIF
  334. ENDIF
  335. CALL KRIPAD(MELEMD,MLENTI)
  336. CALL VERPAD(MLENTI,MELEMS,IRET1)
  337. CALL VERPAD(MLENTI,MELEMC,IRET2)
  338. IF (IRET1.EQ.0.AND.IRET2.EQ.1) THEN
  339. IKAS = 1
  340. ELSEIF (IRET1.EQ.1.AND.IRET2.EQ.0) THEN
  341. IKAS = 2
  342. IF (IVOL1.EQ.0) THEN
  343. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  344. MOTERR(1: 8) = 'INCO'//NOMD(1:4)
  345. MOTERR(9:16) = 'CHPOINT '
  346. CALL ERREUR(788)
  347. RETURN
  348. ENDIF
  349. ELSEIF (IRET1.EQ.1.AND.IRET2.EQ.1) THEN
  350. IKAS = 3
  351. IF (IVOL1.EQ.1) THEN
  352. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  353. MOTERR(1: 8) = 'INCO'//NOMD(1:4)
  354. MOTERR(9:16) = 'CHPOINT '
  355. CALL ERREUR(788)
  356. RETURN
  357. ENDIF
  358. SEGINI,IPT4=MELEMC
  359. ELSEIF (IRET1.EQ.0.AND.IRET2.EQ.0) THEN
  360. IKAS = 1
  361. ELSE
  362. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  363. MOTERR(1: 8) = 'INCO'//NOMD(1:4)
  364. MOTERR(9:16) = 'CHPOINT '
  365. CALL ERREUR(788)
  366. RETURN
  367. ENDIF
  368. C
  369. C- Identification du spg de l'inconnue primale
  370. C- Deux cas sont possibles (identifier par IKP)
  371. C- 1) spg contenant melemc -> IKP=0
  372. C- 2) spg contenant melems -> IKP=4
  373. C
  374. IF (NBINC.EQ.1) THEN
  375. IF (IKAS.EQ.1) THEN
  376. IKP = 4
  377. ELSE
  378. IKP = 0
  379. ENDIF
  380. ELSE
  381. TYPE = ' '
  382. CALL ACMO(KINC,NOMP,TYPE,MCHPOI)
  383. IF (TYPE.NE.'CHPOINT ') THEN
  384. C Indice %m1:8 : ne contient pas un objet de type %m9:16
  385. MOTERR(1: 8) = 'INCO'//NOMP(1:4)
  386. MOTERR(9:16) = 'CHPOINT '
  387. CALL ERREUR(800)
  388. RETURN
  389. ELSE
  390. CALL LICHT(MCHPOI,MPOVAL,TYPC,MELEMP)
  391. NC = VPOCHA(/2)
  392. SEGDES MPOVAL
  393. IF (NC.NE.1) THEN
  394. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon nombre de composantes
  395. MOTERR(1: 8) = 'INCO'//NOMP(1:4)
  396. MOTERR(9:16) = 'CHPOINT '
  397. CALL ERREUR(784)
  398. RETURN
  399. ENDIF
  400. ENDIF
  401. CALL KRIPAD(MELEMP,MLENT3)
  402. CALL VERPAD(MLENT3,MELEMS,IRET1)
  403. CALL VERPAD(MLENT3,MELEMC,IRET2)
  404. SEGSUP MLENT3
  405. IF (IRET1.EQ.0.AND.IRET2.EQ.1) THEN
  406. IKP = 4
  407. ELSEIF (IRET1.EQ.1.AND.IRET2.EQ.0) THEN
  408. IKP = 0
  409. ELSEIF (IRET1.EQ.0.AND.IRET2.EQ.0) THEN
  410. IKP = 4
  411. ELSE
  412. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  413. MOTERR(1: 8) = 'INCO'//NOMP(1:4)
  414. MOTERR(9:16) = 'CHPOINT '
  415. CALL ERREUR(788)
  416. RETURN
  417. ENDIF
  418. ENDIF
  419. C
  420. C- On vérifie dans le cas surfacique que la surface est une frontière
  421. C- du domaine global dont la table DOMAINE est à l'indice 'PERE' de
  422. C- la table domaine locale.
  423. C
  424. C- Si IKAS=3, récupération des points CENTREs du maillage volumique
  425. C- associés aux points CENTREs du maillage surfacique.
  426. C
  427. IF (IVOL1.EQ.0.AND.KFORM.EQ.2) THEN
  428. TYPE = 'TABLE '
  429. CALL ACMO(MTABZ,'PERE',TYPE,KPERE)
  430. IF (IERR.NE.0) RETURN
  431. CALL LEKTAB(KPERE,'FACE ',IPT2)
  432. CALL KRIPAD(IPT2,MLENT2)
  433. CALL VERPAD(MLENT2,MELEMC,IRET)
  434. IF (IRET.EQ.1) THEN
  435. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  436. MOTERR(1: 8) = 'INCO'//NOMD(1:4)
  437. MOTERR(9:16) = 'CHPOINT '
  438. CALL ERREUR(788)
  439. RETURN
  440. ENDIF
  441. CALL LEKTAB(KPERE,'FACEL ',IPT3)
  442. IF (IERR.NE.0) RETURN
  443. SEGACT MELEMC
  444. SEGACT IPT3
  445. SEGACT MLENT2
  446. NBC = MELEMC.NUM(/2)
  447. DO 20 I=1,NBC
  448. J = MLENT2.LECT(MELEMC.NUM(1,I))
  449. IF (IPT3.NUM(2,J) .NE. MELEMC.NUM(1,I)) THEN
  450. C Incohérence entre tables DOMAINE
  451. CALL ERREUR(801)
  452. RETURN
  453. ELSE
  454. IF ( IPT3.NUM(1,J) .NE. IPT3.NUM(3,J)) THEN
  455. C La face %i1 n'est pas une frontière
  456. INTERR(1) = IPT3.NUM(2,J)
  457. CALL ERREUR(802)
  458. RETURN
  459. ENDIF
  460. IF (IKAS.EQ.3) THEN
  461. IPT4.NUM(1,I) = IPT3.NUM(1,J)
  462. ENDIF
  463. ENDIF
  464. 20 CONTINUE
  465. SEGDES MELEMC
  466. SEGDES IPT3
  467. IF (IVOL1.EQ.0 .AND. IKAS.EQ.3) SEGDES IPT4
  468. SEGDES MLENT2
  469. ENDIF
  470. C
  471. C- Cohérance des options avec le support de l'inconnue duale et IKAS
  472. C Option %m1:8 incompatible avec les données
  473. IF (IKAS.EQ.1 .AND. KFORM.EQ.2) THEN
  474. MOTERR(1:8) = ' VF '
  475. CALL ERREUR(803)
  476. RETURN
  477. ENDIF
  478. IF (IKAS.NE.1 .AND. KFORM.NE.2) THEN
  479. MOTERR(1:8) = ' EF '
  480. CALL ERREUR(803)
  481. RETURN
  482. ENDIF
  483. IF (NBINC.NE.1 .AND. KIMPL.EQ.0) THEN
  484. MOTERR(1:8) = ' EXPL '
  485. CALL ERREUR(803)
  486. RETURN
  487. ENDIF
  488. C
  489. C- Récupération des arguments (2 arguments attendus) :
  490. C- 1) Coefficient d'échange
  491. C- 2) Champ exterieur connu
  492. C
  493. CALL ACME(MTABX,'IARG',IARG)
  494. IF (IERR.NE.0) RETURN
  495. IF (IARG.NE.2) THEN
  496. C Indice %m1:8 : nombre d'arguments incorrect
  497. MOTERR(1:8) = 'IARG '
  498. CALL ERREUR(804)
  499. RETURN
  500. ENDIF
  501. IXV(1) = MELEMC
  502. IXV(2) = 1
  503. IXV(3) = 0
  504. IXV(4) = MELEMS
  505. IRET = 4
  506. CALL LEKCOF('Opérateur ECHI :',
  507. & MTABX,KINC,1,IXV,MCHPO1,MPOVA1,NPT1,NC1,IKH,IRET)
  508. IF (IRET.EQ.0) RETURN
  509. IXV(1) = MELEMC
  510. IXV(2) = 1
  511. IXV(3) = 0
  512. IXV(4) = MELEMS
  513. IRET = 4
  514. CALL LEKCOF('Opérateur ECHI :',
  515. & MTABX,KINC,2,IXV,MCHPO2,MPOVA2,NPT2,NC2,IKT,IRET)
  516. IF (IRET.EQ.0) RETURN
  517. IF (IKT.EQ.0) THEN
  518. MELEME = MELEMC
  519. ELSE
  520. MELEME = MELEMS
  521. ENDIF
  522. CALL KRIPAD(MELEME,MLENT1)
  523. C
  524. C- Calcul de la discrétisation du terme d'échange
  525. C
  526. IF(IKAS.EQ.1)THEN
  527. MELEMD=MELEMS
  528. ELSEIF(IKAS.EQ.2)THEN
  529. MELEMD=MELEMC
  530. ELSEIF(IKAS.EQ.3)THEN
  531. MELEMD=IPT4
  532. ENDIF
  533. SEGSUP MLENTI
  534. CALL KRIPAD(MELEMD,MLENTI)
  535.  
  536. IF (KIMPL.EQ.0) THEN
  537. CALL ECHI1(IKAS,IVOL1,MTAB1,MTABZ,MPOVA1,MPOVA2,IKH,IKT,
  538. & MELEMD,IPT4,MLENTI,MLENT1,NOMD)
  539. ELSE
  540. CALL ECHI2(IKAS,IVOL1,MTAB1,MTABZ,MTABX,MPOVA1,MPOVA2,
  541. & IKH,IKT,IKP,IPT4,MLENT1,NOMP,NOMD)
  542. ENDIF
  543. RETURN
  544. END
  545.  
  546.  
  547.  
  548.  
  549.  
  550.  
  551.  
  552.  

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