1 : C ZZOIMP SOURCE PV 09/03/12 21:39:19 6325 2 : SUBROUTINE ZZOIMP(MTABX,MTAB1) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C ----------------------------------------------------------- 7 : C --------- TOIMP ---------------------------------------- 8 : C ----------------------------------------------------------- 9 : C --------- PARAMETRI DELLO OPERATORE (NELLO ORDINE) : ----- 10 : C ----------------------------------------------------------- 11 : C --------- TENSION ( tau et pression ) --------- 12 : C ----------------------------------------------------------- 13 : C 14 : C SYNTAXE : 15 : C 16 : C TOIMP (tau pression) 17 : C 18 : C 1------2 19 : C (R1,AL1) LEF FLUIDE NOEUDS 1 2 20 : C 21 : C 22 : C 23 : C CAS TRIDIMENSIONNEL 24 : C 4 ________ 3 25 : C / FLUIDE / 26 : C 1 /________/2 27 : C 28 : C 29 : C*********************************************************************** 30 : 31 : -INC CCOPTIO 32 : -INC SMCHAML 33 : -INC SMCOORD 34 : -INC SMLENTI 35 : POINTEUR IZIPAD.MLENTI 36 : -INC SMELEME 37 : POINTEUR MELEM1.MELEME 38 : -INC SMCHPOI 39 : POINTEUR IZG1.MCHPOI, IZGG1.MPOVAL 40 : POINTEUR IZTU1.MPOVAL 41 : POINTEUR MZTO.MPOVAL 42 : POINTEUR IZVOL.MPOVAL, IZTCO.MPOVAL 43 : 44 : -INC SMLMOTS 45 : POINTEUR LINCO.MLMOTS 46 : CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,CHAI,TYPC,NOM 47 : LOGICAL LOGI 48 : PARAMETER (NTB=1) 49 : CHARACTER*8 LTAB(NTB) 50 : DIMENSION KTAB(NTB),IXV(3) 51 : SAVE IPAS 52 : DATA LTAB/'KIZX '/,IPAS/0/ 53 : C***************************************************************************** 54 : CTOIMP 55 : C write(6,*)' Debut TOIMP ' 56 : C 57 : C- Récupération de la table INCO (pointeur KINC) 58 : C 58 : CALL LEKTAB(MTAB1,'INCO',KINC) 59 : IF(KINC.EQ.0)THEN 60 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 61 : MOTERR( 1: 8) = ' INCO ' 62 : MOTERR( 9:16) = ' INCO ' 63 : MOTERR(17:24) = ' EQEX ' 63 : CALL ERREUR(786) 64 : RETURN 65 : ENDIF 66 : 67 : C***************************************************************************** 68 : C OPTIONS 69 : C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> SEMI 70 : C KFORM = 0 -> SI 1 -> EF 2 -> VF 3 -> EFMC 71 : C IDCEN = 0-> rien 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG 72 : 73 : IAXI=0 74 : IF(IFOMOD.EQ.0)IAXI=2 75 : C 76 : C- Récupération de la table des options KOPT (pointeur KOPTI) 77 : C 77 : CALL LEKTAB(MTABX,'KOPT',KOPTI) 78 : IF (KOPTI.EQ.0) THEN 79 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 80 : MOTERR( 1: 8) = ' KOPT ' 81 : MOTERR( 9:16) = ' KOPT ' 82 : MOTERR(17:24) = ' KIZX ' 82 : CALL ERREUR(786) 83 : RETURN 84 : ENDIF 85 : 85 : C? CALL ACME(KOPTI,'MTRMASS ',MMPG) 86 : C? IPG=0 87 : C? IF(MMPG.EQ.3)IPG=1 87 : C? CALL ACME(KOPTI,'IDCEN',IDCEN) 87 : CALL ACME(KOPTI,'KIMPL',KIMPL) 87 : CALL ACME(KOPTI,'KFORM',KFORM) 88 : 89 : IF(KFORM.NE.0.AND.KFORM.NE.1)THEN 90 : C Option %m1:8 incompatible avec les données 91 : MOTERR( 1: 8) = 'EF/EFM1 ' 91 : CALL ERREUR(803) 92 : RETURN 93 : ENDIF 94 : IF (IERR.NE.0) RETURN 95 : 96 : C write(6,*)' Apres les options ' 97 : C***************************************************************************** 98 : C 99 : C- Récupération de la table DOMAINE associée au domaine local 100 : C 100 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 100 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 101 : IF(MTABZ.EQ.0)THEN 102 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 103 : MOTERR( 1: 8) = ' DOMZ ' 104 : MOTERR( 9:16) = ' DOMZ ' 105 : MOTERR(17:24) = ' KIZX ' 105 : CALL ERREUR(786) 106 : RETURN 107 : ENDIF 108 : 108 : CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) 108 : CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 108 : CALL LEKTAB(MTABZ,'XXPSOML',MCHELM) 108 : CALL LEKTAB(MTABZ,'XXCOTE',MCHPCO) 109 : IF (IERR.NE.0) RETURN 110 : 111 : SEGACT MELEME 112 : SEGACT MCHELM 112 : CALL LICHT(MCHPCO,IZTCO,TYPC,IGEOM) 113 : NCOT=IZTCO.VPOCHA(/2) 114 : 115 : C************************************************************************* 116 : C VERIFICATIONS SUR LES INCONNUES 117 : C 118 : C- Récupération du nombre d'inconnues et du nom de l'inconnue NOMI 119 : C 120 : TYPE='LISTMOTS' 120 : CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) 121 : IF (IERR.NE.0) RETURN 122 : SEGACT LINCO 123 : NBINC=LINCO.MOTS(/2) 124 : IF(NBINC.NE.1)THEN 125 : C Indice %m1:8 : contient plus de %i1 %m9:16 126 : MOTERR( 1:8) = 'LISTINCO' 127 : INTERR(1) = 1 128 : MOTERR(9:16) = ' MOTS ' 128 : CALL ERREUR(799) 129 : RETURN 130 : ENDIF 131 : 132 : C --> 1 ere Inconnue 133 : 134 : NOMI=LINCO.MOTS(1) 135 : 136 : TYPE=' ' 136 : CALL ACMO(KINC,NOMI,TYPE,MCHPOI) 137 : IF(TYPE.NE.'CHPOINT ')THEN 138 : C Indice %m1:8 : ne contient pas un objet de type %m9:16 139 : MOTERR( 1: 8) = 'INC '//NOMI 140 : MOTERR( 9:16) = 'CHPOINT ' 140 : CALL ERREUR(800) 141 : RETURN 142 : ELSE 142 : CALL LICHT(MCHPOI,IZTU1,TYPC,MELEM1) 143 : ENDIF 144 : 145 : C************************************************************************* 146 : C Le domaine de definition est donne par le SPG de la premiere inconnue 147 : C Les inconnues suivantes devront posseder ce meme pointeur 148 : C On verifie que les points de la zone sont tous inclus dans ce SPG 149 : 149 : CALL KRIPAD(MELEM1,IZIPAD) 150 : 151 : IF(IPAS.EQ.0)THEN 151 : CALL VERPAD(IZIPAD,MELEME,IRET) 152 : IF(IRET.NE.0)THEN 153 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 154 : MOTERR(1: 8) = 'INC '//NOMI 155 : MOTERR(9:16) = 'CHPOINT ' 155 : CALL ERREUR(788) 156 : IPAS=0 157 : RETURN 158 : ENDIF 159 : ENDIF 160 : 161 : C************************************************************************* 162 : C Lecture du coefficient 163 : C Type du coefficient : 164 : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur 165 : 165 : CALL ACME(MTABX,'IARG',IARG) 166 : IF(IARG.NE.1)THEN 167 : WRITE(6,*)'Opérateur TOIMP : nombre d''arguments incorrect' 168 : C Indice %m1:8 : nombre d'arguments incorrect 169 : MOTERR(1:8) = 'IARG ' 169 : CALL ERREUR(804) 170 : RETURN 171 : ENDIF 172 : 173 : IXV(1)=-MELEMC 174 : IXV(2)=0 175 : IXV(3)=1 175 : CALL LEKCOF('Opérateur TOIMP :', 176 : & MTABX,KINC,1,IXV,MTO,MZTO,NTAU,NC1,IKS,IRET) 177 : IF(IRET.EQ.0)RETURN 178 : 179 : IF(IKS.EQ.2)IKS=1 180 : 181 : C write(6,*)' Fin lecture Arguments ' 182 : C Fin lecture Arguments ************************************************ 183 : 184 : 185 : C write(6,*)' Kform=',kform,' KIMPL=',kimpl 186 : IF(KIMPL.EQ.0)THEN 187 : IKIMPL=1 187 : CALL LEKTAB(MTAB1,'KIZG',KIZG) 188 : IF(KIZG.EQ.0)THEN 188 : CALL CRTABL(KIZG) 188 : CALL ECMM(KIZG,'SOUSTYPE','KIZG') 188 : CALL ECMO(MTAB1,'KIZG','TABLE ',KIZG) 189 : ENDIF 190 : 191 : TYPE=' ' 191 : CALL ACMO(KIZG,NOMI,TYPE,IZG1) 192 : IF(TYPE.NE.'CHPOINT ')THEN 193 : NC=IZTU1.VPOCHA(/2) 194 : TYPE='SOMMET' 194 : CALL CRCHPT(TYPE,MELEM1,NC,IZG1) 194 : CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG1) 195 : ENDIF 196 : 197 : ELSE 198 : 199 : IKIMPL=-1 200 : 201 : NAT=2 202 : NSOUPO=1 203 : SEGACT MELEM1 204 : N=MELEM1.NUM(/2) 205 : NC=IZTU1.VPOCHA(/2) 206 : NINKO=NC 207 : SEGINI MCHPO1,MSOUP1,MPOVA1 208 : MCHPO1.IFOPOI=IFOMOD 209 : MCHPO1.MOCHDE=TITREE 210 : MCHPO1.MTYPOI='SMBR' 211 : MCHPO1.JATTRI(1)=2 212 : MCHPO1.IPCHP(1)=MSOUP1 213 : DO 177 N=1,NINKO 214 : WRITE(NOM,FMT='(I1,A7)')N,NOMI(1:7) 215 : MSOUP1.NOCOMP(N)=NOM(1:4) 216 : 177 CONTINUE 217 : MSOUP1.IGEOC=MELEM1 218 : MSOUP1.IPOVAL=MPOVA1 219 : IZG1=MCHPO1 220 : 221 : ENDIF 222 : 222 : CALL LICHT(IZG1,IZGG1,TYPC,IGEOM) 223 : 224 : IF(IGEOM.NE.MELEM1)THEN 225 : WRITE(6,*)' Opérateur TOIM' 226 : WRITE(6,*)' Incompatibilité de SPG entre 1ères inconnues' 227 : RETURN 228 : ENDIF 229 : 230 : SEGACT MELEME 231 : NBSOUS=LISOUS(/1) 232 : IF(NBSOUS.EQ.0)NBSOUS=1 233 : NUTOEL=0 234 : 235 : NPTD=IZGG1.VPOCHA(/1) 236 : 237 : DO 1 L=1,NBSOUS 238 : IPT1=MELEME 239 : IF(NBSOUS.NE.1)IPT1=LISOUS(L) 240 : SEGACT IPT1 241 : 242 : MCHAML=ICHAML(L) 243 : SEGACT MCHAML 244 : MELVAL=IELVAL(1) 245 : SEGACT MELVAL 246 : 247 : NP =IPT1.NUM(/1) 248 : NBEL=IPT1.NUM(/2) 249 : 249 : CALL ZTOIMP(NBEL,NUTOEL,NP,IZIPAD.LECT,IPT1.NUM, 250 : & VELCHE,IZTCO.VPOCHA,NCOT,IKIMPL, 251 : & IZTU1.VPOCHA,IZGG1.VPOCHA,NPTD,MZTO.VPOCHA,NTAU,IKS) 252 : 253 : C write(6,*)' TO ' 254 : C write(6,1002)(IZGG1.VPOCHA(ii,1),ii=1,nptd) 255 : C write(6,*)' TO 2' 256 : C write(6,1002)(IZGG1.VPOCHA(ii,2),ii=1,nptd) 257 : 258 : 259 : 260 : SEGDES MZTO 261 : SEGDES IPT1,MCHAML,MELVAL 262 : NUTOEL=NUTOEL+NBEL 263 : 264 : 1 CONTINUE 265 : 266 : IF(KIMPL.NE.0)THEN 267 : TYPE=' ' 267 : CALL ACMO(MTAB1,'SMBR',TYPE,MCHPO2) 268 : 269 : IF(TYPE.NE.'CHPOINT')THEN 270 : C write(6,*)' IZG1=',izg1 270 : CALL ECMO(MTAB1,'SMBR','CHPOINT',IZG1) 271 : ELSE 271 : CALL ECROBJ('CHPOINT',MCHPO2) 271 : CALL ECROBJ('CHPOINT',IZG1) 271 : CALL PRFUSE 271 : CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) 271 : CALL ECMO(MTAB1,'SMBR','CHPOINT',MCHPOI) 272 : ENDIF 273 : 274 : ENDIF 275 : 276 : SEGDES MELEME 277 : 278 : SEGDES IZTU1 279 : SEGDES IZG1,IZGG1 280 : SEGDES LINCO 281 : SEGSUP IZIPAD 282 : IPAS=1 283 : C write(6,*)' FIN TOIMP ' 284 : RETURN 285 : 90 CONTINUE 286 : WRITE(6,*)' Interuption anormale de TOIMP ' 287 : C Option %m1:8 incompatible avec les données 288 : MOTERR( 1: 8) = ' EF ' 288 : CALL ERREUR(803) 289 : RETURN 290 : 1002 FORMAT(10(1X,1PE11.4)) 291 : END 292 : 293 : 294 : 295 : 296 : 297 : 298 : 299 :
© Cast3M 2003 - All rights reserved.
Disclaimer