1 : C SQTP1 SOURCE CHAT 09/10/09 21:24:33 6519 2 : SUBROUTINE SQTP1(IPMAHY,IPFACE,IPFORC,IPMATP, 3 : S IFORC,IORIE,INORM,ISURF,MCHPOI) 4 : C----------------------------------------------------------------------- 5 : C Calcul de la contribution au systeme en trace de charge d'une force 6 : C volumique dans le cas de la résolution des équations de Darcy par EFMH 7 : C avec le modèle DARCY. 8 : C----------------------------------------------------------------------- 9 : C 10 : C--------------------------- 11 : C Parametres Entree/Sortie : 12 : C--------------------------- 13 : C 14 : C E/ IPMAHY : Segment contenant le pointeur vers le meleme des 15 : C connectivites elements/faces pour les zones du MMODEL 16 : C ou on a defini DARCY. 17 : C E/ IPFACE : MELEME de type POI1 des faces 18 : C E/ IPFORC : RIGIDITE de sous type 'MASSE' 19 : C E/ IPMATP : RIGIDITE de sous type 'HYBTP' 20 : C E/ IFORC : CHPO centre des sources de composantes FX, FY, (FZ) 21 : C E/ IORIE : MCHAML orientation des normales 22 : C E/ INORM : CHPO face des normales 23 : C E/ ISURF : CHPO face des surfaces 24 : C /S MCHPOI : CHPOINT face de composante FLUX 25 : C 26 : C---------------------- 27 : C Variables en COMMON : 28 : C---------------------- 29 : C 30 : C E/ IFOMOD : cf CCOPTIO 31 : C E/ NIFOUR : cf CCOPTIO 32 : C E/ IDIM : cf CCOPTIO 33 : C 34 : C 35 : C----------------------------------------------------------------------- 36 : C 37 : C Langage : ESOPE + FORTRAN77 38 : C 39 : C Auteurs : 02/96 L.V.BENET - Cas permanent 40 : C 41 : C----------------------------------------------------------------------- 42 : IMPLICIT INTEGER(I-N) 43 : IMPLICIT REAL*8 (A-H,O-Z) 44 : * 45 : -INC CCOPTIO 46 : -INC CCHAMP 47 : -INC SMCOORD 48 : -INC SMCHPOI 49 : -INC SMCHAML 50 : -INC SMELEME 51 : -INC SMRIGID 52 : * 53 : SEGMENT IPMAHY 54 : INTEGER MAHYBR(NSOUS) 55 : ENDSEGMENT 56 : SEGMENT ICCPR 57 : INTEGER ICPR(NNGOT) 58 : ENDSEGMENT 59 : SEGMENT MTRAV 60 : REAL*8 RLIGN1(NBDDL),RLIGN2(NBDDL) 61 : ENDSEGMENT 62 : * 63 : *- Initialisations 64 : * 65 : MCHPOI = 0 66 : *- Creation du tableau ICPR pour le MELEME POI1 IPFACE 67 : * 68 : IK = 0 69 : NNGOT = XCOOR(/1)/(IDIM+1) 70 : SEGINI ICCPR 71 : MELEME = IPFACE 72 : SEGACT MELEME 73 : N2 = NUM(/2) 74 : DO 10 I2=1,N2 75 : K = NUM(1,I2) 76 : IF (ICPR(K).EQ.0) THEN 77 : IK = IK + 1 78 : ICPR(K) = IK 79 : ENDIF 80 : 10 CONTINUE 81 : SEGDES MELEME 82 : * 83 : *- Creation du CHAMPOINT face - On laisse actif le MPOVAL du CHPOINT 84 : * 85 : NSOUPO = 1 86 : NAT = 1 87 : SEGINI MCHPOI 88 : IRET = MCHPOI 89 : MTYPOI = 'FACE ' 90 : IFOPOI = IFOMOD 91 : JATTRI(1) = 2 92 : NC = 1 93 : SEGINI MSOUPO 94 : IPCHP(1) = MSOUPO 95 : SEGDES MCHPOI 96 : NOHARM(1) = NIFOUR 97 : IGEOC = IPFACE 98 : NOCOMP(1) = 'FLUX' 99 : N = N2 100 : SEGINI MPOVAL 101 : IPOVAL = MPOVAL 102 : SEGDES MSOUPO 103 : * 104 : *- Recuperation du nombre de zone NBMAIL du MMODEL a partir IPMAHY 105 : * 106 : SEGACT IPMAHY 107 : NBMAIL = MAHYBR(/1) 108 : * 109 : *- Activation des segments RIGIDITE masse hybride et MATP 110 : * 111 : RI1 = IPFORC 112 : SEGACT RI1 113 : RI2 = IPMATP 114 : SEGACT RI2 115 : * 116 : *- Activation du segment MPOVAL du CHAMPOINT centre de composantes FX FY FZ 117 : * 118 : MCHPO1 = IFORC 119 : SEGACT MCHPO1 120 : MSOUP1 = MCHPO1.IPCHP(1) 121 : SEGDES MCHPO1 122 : SEGACT MSOUP1 123 : MPOVA1 = MSOUP1.IPOVAL 124 : SEGDES MSOUP1 125 : SEGACT MPOVA1 126 : * 127 : * Activation du MCHAML d'orientation des normales 128 : * 129 : MCHEL1 = IORIE 130 : SEGACT MCHEL1 131 : 132 : * 133 : * Activation du CHPO des vecteurs normales 134 : * 135 : MCHPO2 = INORM 136 : SEGACT MCHPO2 137 : MSOUP2 = MCHPO2.IPCHP(1) 138 : SEGDES MCHPO2 139 : SEGACT MSOUP2 140 : MPOVA2 = MSOUP2.IPOVAL 141 : SEGDES MSOUP2 142 : SEGACT MPOVA2 143 : * 144 : * Activation du CHPO des surfaces 145 : * 146 : MCHPO3 = ISURF 147 : SEGACT MCHPO3 148 : MSOUP3 = MCHPO3.IPCHP(1) 149 : SEGDES MCHPO3 150 : SEGACT MSOUP3 151 : MPOVA3 = MSOUP3.IPOVAL 152 : SEGDES MSOUP3 153 : SEGACT MPOVA3 154 : * 155 : *-------------------------------------------------- 156 : *= BOUCLE SUR LES MAILLAGES ELEMENTAIRES,ZONE IMAIL 157 : *-------------------------------------------------- 158 : * 159 : * WRITE(*,*)' NBMAIL ',NBMAIL 160 : ITELEM = 0 161 : DO 110 IMAIL=1,NBMAIL 162 : C 163 : C- Activation de l'objet maillage ELTFA pour la zone IMAIL 164 : C 165 : MELEME = MAHYBR(IMAIL) 166 : IF (MELEME.EQ.0) GOTO 110 167 : SEGACT MELEME 168 : * 169 : *- Recuperation des caracteristiques de RIGIDITE de sous type MASSE 170 : *- pour la zone IMAIL en cours de traitement 171 : * 172 : xMATR1 = RI1.IRIGEL(4,IMAIL) 173 : SEGACT xMATR1 174 : NBELEM = xMATR1.re(/3) 175 : NELRIG = NBELEM 176 : * XMATR1 = IMATR1.IMATTT(1) 177 : * SEGACT XMATR1 178 : NBDDL = XMATR1.RE(/1) 179 : NLIGRP = NBDDL 180 : NLIGRD = NBDDL 181 : * SEGDES XMATR1 182 : * 183 : *- Recuperation des caracteristiques de RIGIDITE de sous type HYBTP 184 : *- pour la zone IMAIL en cours de traitement 185 : * 186 : xMATR2 = RI2.IRIGEL(4,IMAIL) 187 : SEGACT xMATR2 188 : NBELEM = xMATR2.re(/3) 189 : NELRIG = NBELEM 190 : * XMATR2 = IMATR2.IMATTT(1) 191 : * SEGACT XMATR2 192 : NBDDL = XMATR2.RE(/1) 193 : NLIGRP = NBDDL 194 : NLIGRD = NBDDL 195 : * SEGDES XMATR2 196 : SEGINI MTRAV 197 : * 198 : * Activation du segment contenant les valeurs du MCHAML d'orientation 199 : * des normales par face pour la zone IMAIL 200 : * 201 : MCHAM1 = MCHEL1.ICHAML(IMAIL) 202 : SEGACT MCHAM1 203 : MELVA1 = MCHAM1.IELVAL(1) 204 : SEGDES MCHAM1 205 : SEGACT MELVA1 206 : * 207 : *------------------------------------------------------- 208 : * BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL 209 : *------------------------------------------------------- 210 : * 211 : DO 100 IEL=1,NBELEM 212 : ITELEM = ITELEM + 1 213 : * 214 : *- calcul des flux de forces aux faces de l'element 215 : * 216 : DO 35 IDDL=1,NBDDL 217 : RLIGN1(IDDL)= 0.D0 218 : IPOPTS = ICPR(NUM(IDDL,IEL)) 219 : DO 40 I=1,IDIM 220 : RLIGN1(IDDL) = RLIGN1(IDDL) + MPOVA2.VPOCHA(IPOPTS,I) * 221 : S MELVA1.VELCHE(IDDL,IEL) * MPOVA1.VPOCHA(ITELEM,I) * 222 : S MPOVA3.VPOCHA(IPOPTS,1) 223 : 40 CONTINUE 224 : 35 CONTINUE 225 : * 226 : *- Construction du tableau aux faces M.FORCE 227 : * 228 : * XMATR1 = IMATR1.IMATTT(IEL) 229 : * SEGACT XMATR1 230 : DO 45 I=1,NBDDL 231 : RLIGN2(I)= 0.D0 232 : DO 50 J=1,NBDDL 233 : RLIGN2(I)= RLIGN2(I) + XMATR1.RE(I,J,iel)*RLIGN1(J) 234 : 50 CONTINUE 235 : 45 CONTINUE 236 : * SEGDES XMATR1 237 : * 238 : *- Construction du CHPOINT aux faces HYBTP.(M.FORCE) 239 : * 240 : * XMATR2 = IMATR2.IMATTT(IEL) 241 : * SEGACT XMATR2 242 : DO 55 I=1,NBDDL 243 : IPOPTS = ICPR(NUM(I,IEL)) 244 : DO 60 J=1,NBDDL 245 : VPOCHA(IPOPTS,1)=VPOCHA(IPOPTS,1) + 246 : S XMATR2.RE(I,J,iel)*RLIGN2(J) 247 : 60 CONTINUE 248 : 55 CONTINUE 249 : * SEGDES XMATR2 250 : 100 CONTINUE 251 : SEGDES xMATR1 , xMATR2 252 : SEGDES MELEME 253 : SEGDES MELVA1 254 : SEGSUP MTRAV 255 : 110 CONTINUE 256 : * 257 : *- Desactivation des segments 258 : * 259 : SEGDES MCHEL1 260 : SEGDES MPOVAL , MPOVA1 , MPOVA2 , MPOVA3 261 : SEGDES IPMAHY 262 : SEGDES RI1 , RI2 263 : SEGSUP ICCPR 264 : RETURN 265 : END 266 : 267 : 268 : 269 : 270 : 271 : 272 : 273 : 274 : 275 : 276 : 277 : 278 : 279 :
© Cast3M 2003 - All rights reserved.
Disclaimer