C CAKIZD SOURCE GOUNAND 23/07/31 21:15:03 11713 SUBROUTINE CAKIZD C************************************************************************ C OBJET : C Cet operateur construit une table KIZD C SYNTAXE C kdia RV ; C************************************************************************ C C Aout 96 : correction d'erreurs pour le calcul de la matrice masse C diagonale dans le cas d'un CHPO centre sans C.L C (testé uniquement dans ce cas : P.Galon) C C 26/10/98 : lecture d'une table domaine OU d'un objet modèle C************************************************************************ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC SMCOORD -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMTABLE POINTEUR MTABD.MTABLE,INCO.MTABLE POINTEUR KIZD.MTABLE C -INC SMCHPOI POINTEUR IPHI.MPOVAL POINTEUR IZD.MCHPOI ,IZD0.MCHPOI POINTEUR IZDD.MPOVAL,IZDD0.MPOVAL C -INC SMLMOTS POINTEUR MINCOG.MLMOTS C -INC SMELEME POINTEUR MELEMI.MELEME C -INC SMLENTI POINTEUR IZIPAD.MLENTI C PARAMETER (NTB=1) DIMENSION KTAB(NTB) CHARACTER*8 LTAB(NTB) DATA LTAB/'EQEX '/ C CHARACTER*8 TYPE,TYP0,TYPC CHARACTER*(LOCOMP) NOC,NOMCP(9),NOMI,NOM,NOMZ C NTO=1 Cne sert jamais IAXI=0 Cne sert jamais IF(IFOMOD.EQ.0)IAXI=2 C C ---- Lecture de la Table "RV" C ----------------------- CALL LITABS(LTAB,KTAB,NTB,NTO,IRET) IF(IRET.EQ.0)RETURN C MTABLE=KTAB(1) SEGACT MTABLE C C ----- Lecture de la Table DOMINC C -------------------------- TYPE=' ' CALL ACMO(MTABLE,'DOMINC',TYPE,MDOMC) IF(TYPE.NE.'TABLE')THEN MOTERR(1:40)='On ne trouve pas DOMINC ds la Table EQEX' CALL ERREUR(-301) RETURN ENDIF C C ----- Lecture de la Table INCO C ------------------------ TYPE=' ' CALL ACMO(MTABLE,'INCO',TYPE,INCO) IF(TYPE.NE.'TABLE')THEN MOTERR(1:40)='On ne trouve pas INCO ds la Table EQEX ' CALL ERREUR(-301) RETURN ENDIF C C ----- Lecture de la liste des inconnues C --------------------------------- TYPE=' ' CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT2) IF(TYPE.NE.'LISTMOTS')THEN MOTERR(1:40)='On ne trouve pas LISTINCO dans EQEX ' CALL ERREUR(-301) RETURN ENDIF C SEGACT MLMOT2 NBINC1=MLMOT2.MOTS(/2) C C ----- Lecture du CHPO des conditions limites (facultatif) C -------------------------------------- TYPE=' ' CALL ACMO(MTABLE,'CLIM',TYPE,MCHPOI) IF(TYPE.NE.'CHPOINT')THEN KCLIM=0 ELSE KCLIM=1 SEGACT MCHPOI NSOUPO=IPCHP(/1) ENDIF C C ----- Creation de la Table KIZD C ------------------------- CALL CRTABL(KIZD) CALL ECMM(KIZD,'SOUSTYPE','KIZD') CALL ECMO(MTABLE,'KIZD','TABLE ',KIZD) C C ----- On Boucle sur la liste des inconnues C ==================================== C C WRITE(IOIMP,*)' NBINC1=',nbinc1 SEGACT,MCOORD DO 1 L=1,NBINC1 NOMI=MLMOT2.MOTS(L) C WRITE(IOIMP,*)' CAKIZD : NOMI=',nomi C C ----- lecture de la table domaine ou de l'objet modèle N-Stokes C --------------------------------------------------------- TYPE=' ' CALL ACMO(MDOMC,NOMI,TYPE,MTABD) * WRITE(IOIMP,*)' KDIA nomi,type=',nomi,type IF(TYPE.NE.'TABLE')THEN IF (TYPE.EQ.'MMODEL') THEN CALL LEKMOD(MTABD,MTABD2,INEFMD) MTABD=MTABD2 ELSE MOTERR(1:40)='On ne trouve pas la Table Domaine ' CALL ERREUR(-301) RETURN ENDIF ENDIF C C ----- la table sous table INCO contient elle l'inconnue C ------------------------------------------------- TYPE=' ' CALL ACMO(INCO,NOMI,TYPE,MCHPHI) * WRITE(IOIMP,*)' KDIA nomi,type=',nomi,type IF(TYPE.NE.'CHPOINT ')THEN MOTERR(1:40)='L inconnue n est pas dans la Table INCO ' CALL ERREUR(-301) MOTERR(1:40)='ou l inconnue n est pas un Champoint ' CALL ERREUR(-301) GO TO 1 ELSE CALL LICHT(MCHPHI,IPHI,TYPC,IGEOM) ENDIF C NPT=IPHI.VPOCHA(/1) NC=IPHI.VPOCHA(/2) * WRITE(IOIMP,*)' NPT,NC,TYPC=',NPT,NC,TYPC IF(TYPC.EQ.'SOMMET')THEN C C ----- On cree une diagonale 'SOMMET' C ----------------------------- CALL ECROBJ('TABLE ',MTABD) SEGACT,MCOORD CALL CADGSI SEGDES,MCOORD CALL LIROBJ('CHPOINT ',IZD0,1,IRET) CALL LICHT(IZD0,IZDD0,TYP0,IGEOM0) ELSEIF(TYPC.EQ.'CENTRE')THEN C C ----- On cree une diagonale 'CENTRE' C ----------------------------- CALL LEKTAB(MTABD,'XXVOLUM',IZD0) C IF(IZD0.EQ.0)RETURN CALL LICHT(IZD0,IZDD0,TYP0,IGEOM0) ELSE MOTERR(1:40)='CHPO CENTRE ou SOMMET pour l inconnue ' CALL ERREUR(-301) RETURN ENDIF C C ----- Creation des CHPO de la Table KIZD C ---------------------------------- TYPE=' ' CALL ACMO(KIZD,NOMI,TYPE,IZD) C IF(TYPE.NE.'CHPOINT ')THEN IF(NC.EQ.1)THEN NOMCP(1)=NOMI CALL KRCHPT(TYP0,IGEOM0,NC,IZD,NOMCP) ELSE DO 15 I=1,NC WRITE(NOMCP(I),FMT='(I1)')I NOMCP(I)=NOMCP(I)(1:1)//NOMI(1:LOCOMP-1) 15 CONTINUE CALL KRCHPT(TYP0,IGEOM0,NC,IZD,NOMCP) ENDIF CALL LICHT(IZD,IZDD,TYPC,IGEOM) C DO 2 I=1,NC CALL RSETD(IZDD.VPOCHA(1,I),IZDD0.VPOCHA,NPT) 2 CONTINUE C CALL ECMO(KIZD,NOMI,'CHPOINT ',IZD) ELSE CALL LICHT(IZD,IZDD,TYPC,IGEOM) ENDIF C CALL KRIPAD(IGEOM,IZIPAD) C C ----- Boucle sur les composantes du Champoint C ======================================= DO 3 I=1,NC IF(NC.EQ.1)THEN NOC=NOMI ELSE WRITE(NOC,FMT='(I1)')I NOC=NOC(1:1)//NOMI(1:LOCOMP-1) ENDIF C C ---- Si pas de condition limite on ne fait rien de plus C -------------------------------------------------- IF(KCLIM.EQ.0)GO TO 3 C Grande valeur de penalisation mais pas trop grande car sinon on C peut depasser la valeur max. XBIG=SQRT(XGRAND) DO 10111 NSP=1,NSOUPO C MSOUPO=IPCHP(NSP) SEGACT MSOUPO NCOMP=NOCOMP(/2) C DO 10112 NCP=1,NCOMP IF(NOCOMP(NCP).EQ.NOC)THEN MELEMI=IGEOC SEGACT MELEMI LONG=MELEMI.NUM(/2) CALL VERPAD(IZIPAD,MELEMI,IRET) IF(IRET.NE.0)THEN MOTERR(1:40) $ ='C.Limites non incluses dans le domaine ' CALL ERREUR(-301) RETURN ENDIF CALL RSETX1 & (IZDD.VPOCHA(1,I),MELEMI.NUM,LONG,XBIG $ ,IZIPAD.LECT) ENDIF 10112 CONTINUE C 10111 CONTINUE C 3 CONTINUE C SEGSUP IZIPAD 1 CONTINUE SEGDES,MCOORD C C ---- FIN DE LA BOUCLE SUR LES INCONNUES C ---------------------------------- SEGDES KIZD,INCO SEGDES MTABLE END