1 : C VTIMP SOURCE MAGN 10/05/18 21:16:39 6675 2 : SUBROUTINE VTIMP 3 : C************************************************************************ 4 : C CALCUL DE LA MATRICE M ( P*DIV(U) ) --> AM(NP,IES,NEL) 5 : C 6 : C IKAS=1 V NORMALE IMPOSEE 7 : C IKAS=-1 V TANGENTE IMPOSEE 8 : C 9 : C************************************************************************ 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8 (A-H,O-Z) 12 : 13 : -INC CCOPTIO 14 : -INC CCGEOME 15 : -INC SIZFFB 16 : POINTEUR IZF1.IZFFM 17 : 18 : -INC SMCOORD 19 : -INC SMLENTI 20 : POINTEUR IPADI.MLENTI 21 : -INC SMELEME 22 : POINTEUR MELEM1.MELEME,MELEMC.MELEME,MELEMS.MELEME,MELEML.MELEME 23 : -INC SMCHPOI 24 : POINTEUR IZTU1.MPOVAL,VTANG.MPOVAL 25 : 26 : -INC SMMATRIK 27 : 28 : -INC SMLMOTS 29 : POINTEUR LINCO.MLMOTS 30 : CHARACTER*8 NOMZ,NOMI,TYPE,TYPC,NOM0,NOMA,NOM 31 : PARAMETER (NTB=1) 32 : CHARACTER*8 LTAB(NTB) 33 : DIMENSION KTAB(NTB),IXV(3),RO(1) 34 : DATA LTAB/'KIZX '/,RO/1.D0/ 35 : C***************************************************************************** 36 : CVTIMP 37 : C write(6,*)' DEBUT VTIMP ' 38 : 38 : CALL LITABS(LTAB,KTAB,NTB,1,IRET) 39 : IF (IERR.NE.0) RETURN 40 : MTABX=KTAB(1) 41 : C 42 : C- Récupération de la table EQEX (pointeur MTAB1) 43 : C 43 : CALL LEKTAB(MTABX,'EQEX',MTAB1) 44 : IF(MTAB1.EQ.0)THEN 45 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 46 : MOTERR( 1: 8) = ' EQEX ' 47 : MOTERR( 9:16) = ' EQEX ' 48 : MOTERR(17:24) = ' KIZX ' 48 : CALL ERREUR(786) 49 : RETURN 50 : ENDIF 51 : 52 : C 53 : C- Récupération de la table INCO (pointeur KINC) 54 : C 54 : CALL LEKTAB(MTAB1,'INCO',KINC) 55 : IF(KINC.EQ.0)THEN 56 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 57 : MOTERR( 1: 8) = ' INCO ' 58 : MOTERR( 9:16) = ' INCO ' 59 : MOTERR(17:24) = ' EQEX ' 59 : CALL ERREUR(786) 60 : RETURN 61 : ENDIF 62 : 63 : C***************************************************************************** 64 : C OPTIONS 65 : C KIMPL = 0 -> EXPL 1 -> IMPL 2 -> SEMI 66 : C KFORM = 0 -> SI 1 -> EF 2 -> VF 3 -> EFMC 67 : C IDCEN = 0-> rien 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG 68 : 69 : IAXI=0 70 : IF(IFOMOD.EQ.0)IAXI=2 71 : C 72 : C- Récupération de la table des options KOPT (pointeur KOPTI) 73 : C 73 : CALL LEKTAB(MTABX,'KOPT',KOPTI) 74 : IF (KOPTI.EQ.0) THEN 75 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 76 : MOTERR( 1: 8) = ' KOPT ' 77 : MOTERR( 9:16) = ' KOPT ' 78 : MOTERR(17:24) = ' KIZX ' 78 : CALL ERREUR(786) 79 : RETURN 80 : ENDIF 81 : 81 : CALL ACME(KOPTI,'KIMPL',KIMPL) 81 : CALL ACME(KOPTI,'KPOIN',KPRE) 81 : CALL ACME(KOPTI,'KFORM',KFORM) 82 : 83 : IF(KFORM.NE.0.AND.KFORM.NE.1)THEN 84 : C Option %m1:8 incompatible avec les données 85 : MOTERR( 1: 8) = 'EF/EFM1 ' 85 : CALL ERREUR(803) 86 : RETURN 87 : ENDIF 88 : IF (IERR.NE.0) RETURN 89 : 90 : C write(6,*)' Apres les options ' 91 : C***************************************************************************** 92 : C 93 : C- Récupération de la table DOMAINE associée au domaine local 94 : C 94 : CALL ACMM(MTABX,'NOMZONE',NOMZ) 94 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 95 : IF(MTABZ.EQ.0)THEN 96 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 97 : MOTERR( 1: 8) = ' DOMZ ' 98 : MOTERR( 9:16) = ' DOMZ ' 99 : MOTERR(17:24) = ' KIZX ' 99 : CALL ERREUR(786) 100 : RETURN 101 : ENDIF 102 : 102 : CALL LEKTAB(MTABZ,'MAILLAGE',MELEME) 102 : CALL LEKTAB(MTABZ,'SOMMET',MELEMS) 102 : CALL LEKTAB(MTABZ,'CENTRE',MELEMC) 102 : CALL LEKTAB(MTABZ,'MLGVTIMP',MELEML) 103 : 104 : C************************************************************************* 105 : C VERIFICATIONS SUR LES INCONNUES 106 : C 107 : C- Récupération du nombre d'inconnues et du nom de l'inconnue NOMI 108 : C 109 : TYPE='LISTMOTS' 109 : CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO) 110 : IF (IERR.NE.0) RETURN 111 : SEGACT LINCO 112 : NBINC=LINCO.MOTS(/2) 113 : IF(NBINC.NE.1)THEN 114 : C Indice %m1:8 : contient plus de %i1 %m9:16 115 : MOTERR( 1:8) = 'LISTINCO' 116 : INTERR(1) = 1 117 : MOTERR(9:16) = ' MOTS ' 117 : CALL ERREUR(799) 118 : RETURN 119 : ENDIF 120 : 121 : NOMI=LINCO.MOTS(1) 122 : C 123 : C- Récupération de l'inconnue 124 : C 125 : TYPE=' ' 125 : CALL ACMO(KINC,NOMI,TYPE,MCHPOI) 126 : IF(TYPE.NE.'CHPOINT ')THEN 127 : C Indice %m1:8 : ne contient pas un objet de type %m9:16 128 : MOTERR( 1: 8) = 'INC '//NOMI 129 : MOTERR( 9:16) = 'CHPOINT ' 129 : CALL ERREUR(800) 130 : RETURN 131 : ELSE 131 : CALL LICHT(MCHPOI,IZTU1,TYPC,MELEM1) 132 : NINKO = IZTU1.VPOCHA(/2) 133 : IF (NINKO.NE.IDIM) THEN 134 : C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes 135 : MOTERR( 1: 8) = 'INC '//NOMI 136 : MOTERR( 9:16) = 'CHPOINT ' 136 : CALL ERREUR(784) 137 : RETURN 138 : ENDIF 139 : C On fait pointer ces deux tableaux sur le champ U inconu (tjs présent) pour 140 : C eviter de les enlever lors de l'appel FORTRAN si les options sont absentes 141 : ENDIF 142 : 143 : C***************************************************************************** 144 : C Le domaine de definition est donne par le SPG de la premiere inconnue 145 : C Les inconnues suivantes devront posseder ce meme pointeur 146 : C On verifie que les points de la zone sont tous inclus dans ce SPG 147 : 147 : CALL KRIPAD(MELEM1,IPADI) 148 : 148 : CALL VERPAD(IPADI,MELEME,IRET) 149 : IF(IRET.NE.0)THEN 150 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 151 : MOTERR(1: 8) = 'INC '//NOMI 152 : MOTERR(9:16) = 'CHPOINT ' 152 : CALL ERREUR(788) 153 : RETURN 154 : ENDIF 155 : 156 : C***************************************************************************** 157 : 158 : 159 : 160 : C************************************************************************* 161 : C Lecture des coefficients 162 : C Type du coefficient : 163 : C IK1=0 CHPOINT IK1=1 scalaire IK1=2 vecteur 164 : C write(6,*)' Lecture des coefficients ' 165 : 165 : CALL ACME(MTABX,'IARG',IARG) 166 : IF(IARG.NE.1)THEN 167 : C Indice %m1:8 : nombre d'arguments incorrect 168 : MOTERR(1:8) = 'IARG ' 168 : CALL ERREUR(804) 169 : RETURN 170 : ENDIF 171 : 172 : IXV(1)=MELEMS 173 : IXV(2)=1 174 : IXV(3)=0 174 : CALL LEKCOF('Opérateur VTIMP :', 175 : & MTABX,KINC,1,IXV,IZTG1,VTANG,NPT1,NC1,IK1,IRET) 176 : IF(IRET.EQ.0)RETURN 177 : 178 : 179 : C write(6,*)' Operateur VTIMP : Fin lecture Arguments ' 180 : C Fin lecture Arguments ************************************************ 181 : 182 : NAT=2 183 : NSOUPO=1 184 : SEGACT MELEML 185 : N=MELEML.NUM(/2) 186 : NC=1 187 : SEGINI MCHPO1,MSOUP1,MPOVA1 188 : MCHPO1.IFOPOI=IFOMOD 189 : MCHPO1.MOCHDE=' ' 190 : MCHPO1.MTYPOI='SMBR' 191 : MCHPO1.JATTRI(1)=2 192 : MCHPO1.IPCHP(1)=MSOUP1 193 : MSOUP1.NOCOMP(1)='LVTP' 194 : MSOUP1.IGEOC=MELEML 195 : MSOUP1.IPOVAL=MPOVA1 196 : 197 : 198 : NRIGE=7 199 : NKID =9 200 : NKMT =7 201 : NMATRI=1 202 : SEGINI MATRIK 203 : 204 : NBSOUS=1 205 : IRIGEL(1,1)=MELEMS 206 : IRIGEL(2,1)=MELEML 207 : IRIGEL(7,1)=4 208 : NBME=NINKO 209 : SEGINI IMATRI 210 : IRIGEL(4,1)=IMATRI 211 : KSPGP=MELEMS 212 : KSPGD=MELEML 213 : DO 102 I=1,NBME 214 : WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7) 215 : LISPRI(I)=NOM(1:4)//' ' 216 : LISDUA(I)='LVTP'//' ' 217 : 102 CONTINUE 218 : 219 : SEGACT MELEMS 220 : NP =1 221 : MP =1 222 : NBEL=MELEMS.NUM(/2) 223 : 224 : SEGINI IPM1,IPM2 225 : LIZAFM(1,1)=IPM1 226 : LIZAFM(1,2)=IPM2 227 : IF(NBME.EQ.3)THEN 228 : SEGINI IPM3 229 : LIZAFM(1,3)=IPM3 230 : ENDIF 231 : 231 : CALL KRIPAD(MELEMS,MLENTI) 232 : 233 : SEGACT MELEME 234 : 235 : NBSOU1=LISOUS(/1) 236 : IF(NBSOU1.EQ.0)NBSOU1=1 237 : 238 : NUTOEL=0 239 : DO 101 L=1,NBSOU1 240 : IPT1=MELEME 241 : IF(NBSOU1.NE.1)IPT1=LISOUS(L) 242 : SEGACT IPT1 243 : NOM0=NOMS(IPT1.ITYPEL)//' ' 243 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 244 : SEGACT IZFFM*MOD 245 : IZHR=KZHR(1) 246 : SEGACT IZHR*MOD 247 : NES=GR(/1) 248 : NPG=GR(/3) 249 : NP=IPT1.NUM(/1) 250 : NBELEM=IPT1.NUM(/2) 251 : 252 : DO 301 K=1,NBELEM 253 : DO 20 I=1,NP 254 : J1 = IPT1.NUM(I,K) 255 : DO 10 N=1,IDIM 256 : XYZ(N,I) = XCOOR((J1-1)*(IDIM+1)+N) 257 : 10 CONTINUE 258 : 20 CONTINUE 258 : CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG, 259 : & NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) 260 : 261 : 262 : U0=1.D0 263 : DO 302 I=1,NP 264 : K1=LECT(IPT1.NUM(I,K)) 265 : UX=0.D0 266 : UY=0.D0 267 : UZ=0.D0 268 : UT=0.D0 269 : DO 304 LG=1,NPG 270 : UX=UX+FN(I,LG)*AJ(1,1,LG) 271 : UY=UY+FN(I,LG)*AJ(2,1,LG) 272 : IF(IDIM.EQ.3)UZ=UZ+FN(I,LG)*AJ(3,1,LG) 273 : UNL=0.D0 274 : DO 321 J=1,NP 275 : K2=LECT(IPT1.NUM(J,K)) 276 : NK=(K2-1)*(1-IK1)+1 277 : UNL=UNL+VTANG.VPOCHA(NK,1)*FN(J,L) 278 : 321 CONTINUE 279 : UT=UT+FN(I,LG)*UNL 280 : 304 CONTINUE 281 : IPM1.AM(K1,1,1)=IPM1.AM(K1,1,1)-UX 282 : IPM2.AM(K1,1,1)=IPM2.AM(K1,1,1)-UY 283 : IF(IDIM.EQ.3)IPM3.AM(K1,1,1)=IPM3.AM(K1,1,1)-UZ 284 : MPOVA1.VPOCHA(K1,1)=MPOVA1.VPOCHA(K1,1)-UT 285 : 302 CONTINUE 286 : 301 CONTINUE 287 : 288 : 101 CONTINUE 289 : 290 : 291 : 291 : CALL ECROBJ('MATRIK',MATRIK) 291 : CALL ECROBJ('CHPOINT',MCHPO1) 292 : 293 : RETURN 294 : 1001 FORMAT(20(1X,I5)) 295 : 1002 FORMAT(10(1X,1PE11.4)) 296 : END 297 : 298 : 299 : 300 : 301 : 302 : 303 : 304 :
© Cast3M 2003 - All rights reserved.
Disclaimer