1 : C SQTP SOURCE CHAT 11/03/16 21:31:46 6902 2 : SUBROUTINE SQTP 3 : C----------------------------------------------------------------------- 4 : C Calcul de la contribution au systeme en trace de charge d'une force 5 : C volumique dans le cas de la résolution des équations de Darcy par EFMH 6 : C avec le modèle DARCY. 7 : C----------------------------------------------------------------------- 8 : C 9 : C--------------------------- 10 : C Phrase d'appel (GIBIANE) : 11 : C--------------------------- 12 : C 13 : C CHP2 = 'SQTP' MMODEL RIG1 RIG2 CHP1 ; 14 : C 15 : C------------------------ 16 : C Operandes et resultat : 17 : C------------------------ 18 : C 19 : C MMODEL : Objet modele décrivant la formulation. 20 : C TABLE1 : TABLE DOMAINE contenant les maillages et les connectivités. 21 : C RIG1 : Matrices masses hybrides elementaires de sous-type MASSE. 22 : C RIG2 : Matrices elementaires de type HYBTP 23 : C CHP1 : CHPO centre de composante FX,FY(,FZ), 24 : C densite de force moyenne par élément. 25 : C 26 : C----------------------------------------------------------------------- 27 : C 28 : C Langage : ESOPE + FORTRAN77 29 : C 30 : C Auteurs : 02/96 L.V.BENET - Cas permanent 31 : C 32 : C----------------------------------------------------------------------- 33 : IMPLICIT INTEGER(I-N) 34 : IMPLICIT REAL*8 (A-H,O-Z) 35 : * 36 : -INC CCOPTIO 37 : -INC SMCHAML 38 : -INC SMCHPOI 39 : -INC SMELEME 40 : -INC SMMODEL 41 : -INC SMRIGID 42 : -INC SMTABLE 43 : * 44 : SEGMENT IPMAHY 45 : INTEGER MAHYBR(NSOUS) 46 : * CHARACTER*4 NOMTOT(IDIM) 47 : ENDSEGMENT 48 : * 49 : LOGICAL LOGRE,LOGIN 50 : CHARACTER*4 NOMTO3(3) 51 : CHARACTER*4 NOMTO2(2) 52 : CHARACTER*6 CHAR6 53 : CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,LETYPE,LETYP1,LETYP2 54 : * 55 : * Initialisations 56 : * 57 : ISOU1 = 0 58 : IHN1 = 0 59 : ITPN1 = 0 60 : IVALIN = 0 61 : XVALIN = 0.D0 62 : LOGIN = .TRUE. 63 : IOBIN = 0 64 : TAPIND = 'MOT ' 65 : * 66 : * Lecture du MMODEL 67 : * 67 : CALL LIROBJ('MMODEL',IPMODE,1,IRET) 68 : IF (IERR.NE.0) RETURN 69 : MMODEL = IPMODE 70 : * 71 : * Lecture de la TABLE domaine 72 : * 73 : IPTABL = 0 73 : CALL LEKMOD(IPMODE,IPTABL,IRET) 74 : IF (IERR.NE.0) RETURN 75 : CHARIN = 'MAILLAGE' 76 : TYPOBJ = 'MAILLAGE' 76 : CALL LEKTAB(IPTABL,CHARIN,IOBRE) 77 : IF (IERR.NE.0) RETURN 78 : IPGEOM = IOBRE 78 : CALL LEKTAB(IPTABL,'ELTFA',IOBRE) 79 : IF (IERR.NE.0) RETURN 80 : IELTFA = IOBRE 80 : CALL LEKTAB(IPTABL,'CENTRE',IOBRE) 81 : IF (IERR.NE.0) RETURN 82 : ICENTR = IOBRE 82 : CALL LEKTAB(IPTABL,'FACE',IOBRE) 83 : IF (IERR.NE.0) RETURN 84 : IPFACE = IOBRE 85 : * 86 : * Lecture de RIGIDITE 87 : * 87 : CALL LIROBJ('RIGIDITE',IPRIGI,1,IRET) 88 : IF (IERR.NE.0) RETURN 89 : RI1 = IPRIGI 90 : * 91 : * Lecture de RIGIDITE 92 : * 92 : CALL LIROBJ('RIGIDITE',IPRIGI,1,IRET) 93 : IF (IERR.NE.0) RETURN 94 : RI2 = IPRIGI 95 : * 96 : * Lecture du champoint FORCE 97 : * 97 : CALL LIROBJ('CHPOINT',IFORC,1,IRET) 98 : IF (IERR.NE.0) RETURN 99 : * 100 : * récup. MCHAML orientation normale 101 : * 101 : CALL LEKTAB(IPTABL,'XXNORMAE',IORIE) 102 : IF (IERR.NE.0) RETURN 103 : * 104 : * récup. CHPO orientation normale 105 : * 105 : CALL LEKTAB(IPTABL,'XXNORMAF',INORM) 106 : IF (IERR.NE.0) RETURN 107 : * 108 : * récup. CHPO surface des faces 109 : * 109 : CALL LEKTAB(IPTABL,'XXSURFAC',ISURF) 110 : IF (IERR.NE.0) RETURN 111 : * 112 : * Test du CHAMPOINT FORCE de spg CENTRE 113 : * 114 : NBCOMP = IDIM 115 : INDIC = 1 116 : IF(IDIM.EQ.2)THEN 117 : NOMTO2(1) = 'FX' 118 : NOMTO2(2) = 'FY' 118 : CALL QUEPOI(IFORC,ICENTR,INDIC,NBCOMP,NOMTO2) 119 : IF (IERR.NE.0) RETURN 120 : ELSE IF(IDIM.EQ.3)THEN 121 : NOMTO3(1) = 'FX' 122 : NOMTO3(2) = 'FY' 123 : NOMTO3(3) = 'FZ' 123 : CALL QUEPOI(IFORC,ICENTR,INDIC,NBCOMP,NOMTO3) 124 : IF (IERR.NE.0) RETURN 125 : ENDIF 126 : * 127 : * Test de la formulation 128 : * 129 : SEGACT MMODEL 130 : NSOUS = KMODEL(/1) 131 : SEGINI IPMAHY 132 : IDARCY = 0 133 : IPT1=IPGEOM 134 : IPT2=IPGEOM 135 : DO 10 ISOUS=1,NSOUS 136 : IF(NSOUS.GT.1)THEN 137 : SEGACT IPT2 138 : IPT1=IPT2.LISOUS(ISOUS) 139 : SEGDES IPT2 140 : ENDIF 141 : IMODEL = KMODEL(ISOUS) 142 : SEGACT IMODEL 143 : LETYPE = FORMOD(1) 144 : IF (LETYPE.EQ.'DARCY') THEN 145 : IDARCY = IDARCY + 1 146 : MAHYBR(ISOUS) = IPT1 147 : ENDIF 148 : SEGDES IMODEL 149 : 10 CONTINUE 150 : SEGDES MMODEL 151 : IF (IDARCY.EQ.0) THEN 152 : MOTERR = LETYPE 152 : CALL ERREUR(193) 153 : GOTO 100 154 : ENDIF 155 : * 156 : * Recuperation des pointeurs ELTFA pour les zones ou DARCY est defini 157 : * 158 : MELEME = IELTFA 159 : SEGACT MELEME 160 : LZONES = LISOUS(/1) 161 : IF (LZONES.EQ.0) LZONES = 1 162 : IPT1 = IPGEOM 163 : SEGACT IPT1 164 : DO 30 ISOUS=1,NSOUS 165 : IMAMEL = MAHYBR(ISOUS) 166 : IF (IMAMEL.NE.0) THEN 167 : DO 20 ISZ=1,LZONES 168 : IF (LZONES.EQ.1) THEN 169 : IPT2 = IPT1 170 : IPT3 = MELEME 171 : ELSE 172 : IPT2 = IPT1.LISOUS(ISZ) 173 : IPT3 = LISOUS(ISZ) 174 : ENDIF 175 : IF (IPT2.EQ.IMAMEL) THEN 176 : MAHYBR(ISOUS) = IPT3 177 : GOTO 30 178 : ENDIF 179 : 20 CONTINUE 180 : IF (IMAMEL.EQ.MAHYBR(ISOUS)) THEN 181 : INTERR(1) = ISOUS 181 : CALL ERREUR(698) 182 : SEGDES IPT1 183 : SEGDES MELEME 184 : GOTO 100 185 : ENDIF 186 : ENDIF 187 : 30 CONTINUE 188 : SEGDES IPT1 189 : SEGDES MELEME 190 : * 191 : * Test du sous-type des matrices de rigiditée MASSE et HYBTP récupérées 192 : * 193 : SEGACT RI1 194 : LETYP1 = RI1.MTYMAT 195 : SEGACT RI2 196 : LETYP2 = RI2.MTYMAT 197 : IF (LETYP1.NE.'MASSE') THEN 198 : IF (LETYP2.NE.'MASSE') THEN 199 : MOTERR(1:8) = 'RIGIDITE' 200 : MOTERR(9:16) = 'MASSE' 200 : CALL ERREUR(79) 201 : SEGDES RI1 202 : SEGDES RI2 203 : GOTO 100 204 : ELSE 205 : IPFORC=RI2 206 : IF (LETYP1.NE.'HYBTP') THEN 207 : MOTERR(1:8) = 'RIGIDITE' 208 : MOTERR(9:16) = 'HYBTP' 208 : CALL ERREUR(79) 209 : SEGDES RI1 210 : SEGDES RI2 211 : GOTO 100 212 : ELSE 213 : IPMATP=RI1 214 : ENDIF 215 : ENDIF 216 : ELSE 217 : IPFORC=RI1 218 : IF (LETYP2.NE.'HYBTP') THEN 219 : MOTERR(1:8) = 'RIGIDITE' 220 : MOTERR(9:16) = 'HYBTP' 220 : CALL ERREUR(79) 221 : SEGDES RI1 222 : SEGDES RI2 223 : GOTO 100 224 : ELSE 225 : IPMATP=RI2 226 : ENDIF 227 : ENDIF 228 : * 229 : * Controle des pointeurs de MELEME des deux rigidités 230 : * 231 : DO 40 ISOUS=1,NSOUS 232 : IMAMEL = MAHYBR(ISOUS) 233 : IF (IMAMEL.NE.0) THEN 234 : IPTEST = RI1.IRIGEL(1,ISOUS) 235 : IF (MAHYBR(ISOUS).NE.IPTEST) THEN 236 : MOTERR(1:8) = LETYP1 237 : MOTERR(9:16) = 'ELTFA ' 238 : INTERR(1) = ISOUS 238 : CALL ERREUR(698) 239 : SEGDES RI1 240 : GOTO 100 241 : ENDIF 242 : IPTEST = RI2.IRIGEL(1,ISOUS) 243 : IF (MAHYBR(ISOUS).NE.IPTEST) THEN 244 : MOTERR(1:8) = LETYP2 245 : MOTERR(9:16) = 'ELTFA ' 246 : INTERR(1) = ISOUS 246 : CALL ERREUR(698) 247 : SEGDES RI2 248 : GOTO 100 249 : ENDIF 250 : ENDIF 251 : 40 CONTINUE 252 : SEGDES RI1 253 : SEGDES RI2 254 : * 255 : * Construction de MCHPOI 256 : * 257 : SEGDES IPMAHY 257 : CALL SQTP1(IPMAHY,IPFACE,IPFORC,IPMATP,IFORC, 258 : S IORIE,INORM,ISURF,MCHPOI) 259 : * 259 : CALL ECROBJ('CHPOINT',MCHPOI) 260 : * 261 : * Ménage 262 : * 263 : 100 CONTINUE 264 : SEGSUP IPMAHY 265 : RETURN 266 : END 267 : 268 : 269 : 270 : 271 : 272 : 273 : 274 : 275 : 276 : 277 : 278 : 279 : 280 : 281 :
© Cast3M 2003 - All rights reserved.
Disclaimer