1 : C CAKIZD SOURCE PV 14/01/30 21:15:05 7931 2 : SUBROUTINE CAKIZD 3 : C************************************************************************ 4 : C OBJET : 5 : C Cet operateur construit une table KIZD 6 : C SYNTAXE 7 : C kdia RV ; 8 : C************************************************************************ 9 : C 10 : C Aout 96 : correction d'erreurs pour le calcul de la matrice masse 11 : C diagonale dans le cas d'un CHPO centre sans C.L 12 : C (testé uniquement dans ce cas : P.Galon) 13 : C 14 : C 26/10/98 : lecture d'une table domaine OU d'un objet modèle 15 : C************************************************************************ 16 : IMPLICIT INTEGER(I-N) 17 : IMPLICIT REAL*8 (A-H,O-Z) 18 : C 19 : CHARACTER*8 NOMI,TYPE,NOM,NOMZ,TYP0,TYPC 20 : CHARACTER*4 NOC,NOM4(9) 21 : C 22 : -INC CCOPTIO 23 : -INC CCREEL 24 : -INC SMTABLE 25 : POINTEUR MTABD.MTABLE,INCO.MTABLE 26 : POINTEUR KIZD.MTABLE 27 : C 28 : -INC SMCHPOI 29 : POINTEUR IPHI.MPOVAL 30 : POINTEUR IZD.MCHPOI ,IZD0.MCHPOI 31 : POINTEUR IZDD.MPOVAL,IZDD0.MPOVAL 32 : C 33 : -INC SMLMOTS 34 : POINTEUR MINCOG.MLMOTS 35 : C 36 : -INC SMELEME 37 : POINTEUR MELEMI.MELEME 38 : C 39 : -INC SMLENTI 40 : POINTEUR IZIPAD.MLENTI 41 : C 42 : PARAMETER (NTB=1) 43 : DIMENSION KTAB(NTB) 44 : CHARACTER*8 LTAB(NTB) 45 : DATA LTAB/'EQEX '/ 46 : C 47 : NTO=1 48 : Cne sert jamais IAXI=0 49 : Cne sert jamais IF(IFOMOD.EQ.0)IAXI=2 50 : C 51 : C ---- Lecture de la Table "RV" 52 : C ----------------------- 52 : CALL LITABS(LTAB,KTAB,NTB,NTO,IRET) 53 : IF(IRET.EQ.0)RETURN 54 : C 55 : MTABLE=KTAB(1) 56 : SEGACT MTABLE 57 : C 58 : C ----- Lecture de la Table DOMINC 59 : C -------------------------- 60 : TYPE=' ' 60 : CALL ACMO(MTABLE,'DOMINC',TYPE,MDOMC) 61 : IF(TYPE.NE.'TABLE')THEN 62 : MOTERR(1:40)='On ne trouve pas DOMINC ds la Table EQEX' 62 : CALL ERREUR(-301) 63 : RETURN 64 : ENDIF 65 : C 66 : C ----- Lecture de la Table INCO 67 : C ------------------------ 68 : TYPE=' ' 68 : CALL ACMO(MTABLE,'INCO',TYPE,INCO) 69 : IF(TYPE.NE.'TABLE')THEN 70 : MOTERR(1:40)='On ne trouve pas INCO ds la Table EQEX ' 70 : CALL ERREUR(-301) 71 : RETURN 72 : ENDIF 73 : C 74 : C ----- Lecture de la liste des inconnues 75 : C --------------------------------- 76 : TYPE=' ' 76 : CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT2) 77 : IF(TYPE.NE.'LISTMOTS')THEN 78 : MOTERR(1:40)='On ne trouve pas LISTINCO dans EQEX ' 78 : CALL ERREUR(-301) 79 : RETURN 80 : ENDIF 81 : C 82 : SEGACT MLMOT2 83 : NBINC1=MLMOT2.MOTS(/2) 84 : C 85 : C ----- Lecture du CHPO des conditions limites (facultatif) 86 : C -------------------------------------- 87 : TYPE=' ' 87 : CALL ACMO(MTABLE,'CLIM',TYPE,MCHPOI) 88 : IF(TYPE.NE.'CHPOINT')THEN 89 : KCLIM=0 90 : ELSE 91 : KCLIM=1 92 : SEGACT MCHPOI 93 : NSOUPO=IPCHP(/1) 94 : ENDIF 95 : C 96 : C ----- Creation de la Table KIZD 97 : C ------------------------- 97 : CALL CRTABL(KIZD) 97 : CALL ECMM(KIZD,'SOUSTYPE','KIZD') 97 : CALL ECMO(MTABLE,'KIZD','TABLE ',KIZD) 98 : C 99 : C ----- On Boucle sur la liste des inconnues 100 : C ==================================== 101 : C 102 : C WRITE(IOIMP,*)' NBINC1=',nbinc1 103 : DO 1 L=1,NBINC1 104 : NOMI=MLMOT2.MOTS(L) 105 : C WRITE(IOIMP,*)' CAKIZD : NOMI=',nomi 106 : C 107 : C ----- lecture de la table domaine ou de l'objet modèle N-Stokes 108 : C --------------------------------------------------------- 109 : TYPE=' ' 109 : CALL ACMO(MDOMC,NOMI,TYPE,MTABD) 110 : * WRITE(IOIMP,*)' KDIA nomi,type=',nomi,type 111 : IF(TYPE.NE.'TABLE')THEN 112 : IF (TYPE.EQ.'MMODEL') THEN 112 : CALL LEKMOD(MTABD,MTABD2,INEFMD) 113 : MTABD=MTABD2 114 : ELSE 115 : MOTERR(1:40)='On ne trouve pas la Table Domaine ' 115 : CALL ERREUR(-301) 116 : RETURN 117 : ENDIF 118 : ENDIF 119 : C 120 : C ----- la table sous table INCO contient elle l'inconnue 121 : C ------------------------------------------------- 122 : 123 : TYPE=' ' 123 : CALL ACMO(INCO,NOMI,TYPE,MCHPHI) 124 : C WRITE(IOIMP,*)' KDIA nomi,type=',nomi,type 125 : IF(TYPE.NE.'CHPOINT ')THEN 126 : MOTERR(1:40)='L inconnue n est pas dans la Table INCO ' 126 : CALL ERREUR(-301) 127 : MOTERR(1:40)='ou l inconnue n est pas un Champoint ' 127 : CALL ERREUR(-301) 128 : GO TO 1 129 : ELSE 129 : CALL LICHT(MCHPHI,IPHI,TYPC,IGEOM) 130 : ENDIF 131 : C 132 : NPT=IPHI.VPOCHA(/1) 133 : NC=IPHI.VPOCHA(/2) 134 : C WRITE(IOIMP,*)' NPT,NC,TYPC=',NPT,NC,TYPC 135 : IF(TYPC.EQ.'SOMMET')THEN 136 : C 137 : C ----- On cree une diagonale 'SOMMET' 138 : C ----------------------------- 138 : CALL ECROBJ('TABLE ',MTABD) 138 : CALL CADGSI 138 : CALL LIROBJ('CHPOINT ',IZD0,1,IRET) 138 : CALL LICHT(IZD0,IZDD0,TYP0,IGEOM0) 139 : ELSEIF(TYPC.EQ.'CENTRE')THEN 140 : C 141 : C ----- On cree une diagonale 'CENTRE' 142 : C ----------------------------- 142 : CALL LEKTAB(MTABD,'XXVOLUM',IZD0) 143 : C 144 : IF(IZD0.EQ.0)RETURN 144 : CALL LICHT(IZD0,IZDD0,TYP0,IGEOM0) 145 : ELSE 146 : MOTERR(1:40)='CHPO CENTRE ou SOMMET pour l inconnue ' 146 : CALL ERREUR(-301) 147 : RETURN 148 : ENDIF 149 : C 150 : SEGDES IPHI 151 : C 152 : C ----- Creation des CHPO de la Table KIZD 153 : C ---------------------------------- 154 : TYPE=' ' 154 : CALL ACMO(KIZD,NOMI,TYPE,IZD) 155 : C 156 : IF(TYPE.NE.'CHPOINT ')THEN 157 : IF(NC.EQ.1)THEN 158 : NOM4(1)=NOMI(1:4) 158 : CALL KRCHPT(TYP0,IGEOM0,NC,IZD,NOM4) 159 : ELSE 160 : DO 15 I=1,NC 161 : WRITE(NOM4(I),FMT='(I1,A3)')I,NOMI(1:3) 162 : 15 CONTINUE 162 : CALL KRCHPT(TYP0,IGEOM0,NC,IZD,NOM4) 163 : ENDIF 163 : CALL LICHT(IZD,IZDD,TYPC,IGEOM) 164 : C 165 : DO 2 I=1,NC 165 : CALL RSETD(IZDD.VPOCHA(1,I),IZDD0.VPOCHA,NPT) 166 : 2 CONTINUE 167 : C 167 : CALL ECMO(KIZD,NOMI,'CHPOINT ',IZD) 168 : ELSE 168 : CALL LICHT(IZD,IZDD,TYPC,IGEOM) 169 : ENDIF 170 : C 170 : CALL KRIPAD(IGEOM,IZIPAD) 171 : C 172 : C ----- Boucle sur les composantes du Champoint 173 : C ======================================= 174 : DO 3 I=1,NC 175 : IF(NC.EQ.1)THEN 176 : NOC=NOMI(1:4) 177 : ELSE 178 : WRITE(NOC,FMT='(I1,A3)')I,NOMI(1:3) 179 : ENDIF 180 : C 181 : C ---- Si pas de condition limite on ne fait rien de plus 182 : C -------------------------------------------------- 183 : IF(KCLIM.EQ.0)GO TO 3 184 : C 185 : DO 10111 NSP=1,NSOUPO 186 : C 187 : MSOUPO=IPCHP(NSP) 188 : SEGACT MSOUPO 189 : NCOMP=NOCOMP(/2) 190 : C 191 : DO 10112 NCP=1,NCOMP 192 : IF(NOCOMP(NCP).EQ.NOC)THEN 193 : MELEMI=IGEOC 194 : SEGACT MELEMI 195 : LONG=MELEMI.NUM(/2) 195 : CALL VERPAD(IZIPAD,MELEMI,IRET) 196 : IF(IRET.NE.0)THEN 197 : MOTERR(1:40) 198 : $ ='C.Limites non incluses dans le domaine ' 198 : CALL ERREUR(-301) 199 : RETURN 200 : ENDIF 200 : CALL RSETX1 201 : & (IZDD.VPOCHA(1,I),MELEMI.NUM,LONG,XGRAND 202 : $ ,IZIPAD.LECT) 203 : SEGDES MELEMI 204 : ENDIF 205 : 10112 CONTINUE 206 : C 207 : SEGDES MSOUPO 208 : C 209 : 10111 CONTINUE 210 : C 211 : 3 CONTINUE 212 : C 213 : SEGSUP IZIPAD 214 : SEGDES IZD,IZDD 215 : SEGDES IZD0,IZDD0 216 : 1 CONTINUE 217 : C 218 : C ---- FIN DE LA BOUCLE SUR LES INCONNUES 219 : C ---------------------------------- 220 : SEGDES KIZD,INCO 221 : C 222 : IF(KCLIM.NE.0)SEGDES MCHPOI 223 : SEGDES MTABLE 224 : C 225 : RETURN 226 : END 227 : 228 : 229 : 230 : 231 : 232 : 233 : 234 : 235 : 236 :
© Cast3M 2003 - All rights reserved.
Disclaimer