1 : C CNEQ1 SOURCE CHAT 11/03/16 21:17:00 6902 2 : SUBROUTINE CNEQ1(IPMAIL,LRE,NDDL,NBPGAU,MELE,MFR,IVAFVO,IPMINT, 3 : & IVACAR,IPORE,NCOMP,IVAFOR,IIPDPG) 4 : *---------------------------------------------------------------------- 5 : * _______________________________ * 6 : * | | * 7 : * | CALCUL DES FORCES AUX NOEUDS| * 8 : * |______________________________| * 9 : * * 10 : * massif * 11 : * * 12 : *---------------------------------------------------------------------* 13 : * * 14 : * ENTREES : * 15 : * ________ * 16 : * * 17 : * IPMAIL Pointeur sur un segment MELEME * 18 : * LRE Nombre de ddl dans la matrice de rigidite * 19 : * NDDL Nombre de degré de liberté * 20 : * NBPGAU Nombre de points d'integration pour les contraintes * 21 : * MELE Numero de l'element fini * 22 : * MFR Numero de la formulation * 23 : * IVAFVO pointeur sur un segment MPTVAL contenant les * 24 : * les melvals de FORCES VOLUMIQUES * 25 : * IPMINT Pointeur sur un segment MINTE * 26 : * IVACAR Pointeur sur un melval de caractéristiques * 27 : * IPORE Nombre de fonctions de forme * * 28 : * NCOMP Nombre de composantes de forces * 29 : * * 30 : 31 : * SORTIES : * 32 : * ________ * 33 : * * 34 : * IVAFOR pointeur sur un segment MPTVAL contenant les * 35 : * les melvals de forces NODALES * 36 : * * 37 : *---------------------------------------------------------------------* 38 : * F CAFFIN INSPIRE DE BSIGM1 39 : *---------------------------------------------------------------------* 40 : IMPLICIT INTEGER(I-N) 41 : IMPLICIT REAL*8(A-H,O-Z) 42 : * 43 : -INC CCOPTIO 44 : -INC CCHAMP 45 : -INC SMCHAML 46 : -INC SMCHPOI 47 : -INC SMELEME 48 : -INC SMCOORD 49 : -INC SMMODEL 50 : -INC SMINTE 51 : -INC CCGEOME 52 : -INC CCREEL 53 : -INC SMRIGID 54 : * 55 : SEGMENT WRK1 56 : REAL*8 XFORC(LRE),FOVOL(NDDL),XE(3,NBBB) 57 : ENDSEGMENT 58 : * 59 : SEGMENT WRK2 60 : REAL*8 SHPWRK(6,NBNO),BGENE(NSTB,LRE) 61 : ENDSEGMENT 62 : * 63 : SEGMENT WRK5 64 : REAL*8 XGENE(NSTN,LRN) 65 : ENDSEGMENT 66 : * 67 : SEGMENT MPTVAL 68 : INTEGER IPOS(NS) , NSOF(NS) 69 : INTEGER IVAL(NCOSOU) 70 : CHARACTER*16 TYVAL(NCOSOU) 71 : ENDSEGMENT 72 : * 73 : * INTRODUCTION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT 74 : * DE LA SECTION EN DEFO PLANE GENERALISEE 75 : * Pas de rotation en modes 1D generalises 76 : IF (IFOUR.EQ.-3)THEN 77 : IP=IIPDPG 78 : SEGACT MCOORD 79 : IREF=(IP-1)*(IDIM+1) 80 : XDPGE=XCOOR(IREF+1) 81 : YDPGE=XCOOR(IREF+2) 82 : ELSE 83 : XDPGE=0.D0 84 : YDPGE=0.D0 85 : ENDIF 86 : * 87 : MELEME=IPMAIL 88 : NBNN=NUM(/1) 89 : NBELEM=NUM(/2) 90 : NHRM=NIFOUR 91 : MINTE=IPMINT 92 : IELE=NUMGEO(MELE) 93 : * 94 : C_______________________________________________________________________ 95 : C 96 : C NUMERO DES ETIQUETTES : 97 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 98 : C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR : 99 : C 5 CONTINUE 100 : C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ... 101 : C 44 CONTINUE 102 : C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ... 103 : C_______________________________________________________________________ 104 : C 105 : GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 106 : 1 99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 107 : 2 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 108 : 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,79,79, 109 : 4 79,79,79,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 110 : 5 99,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 111 : 6 4, 4),MELE 112 : IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4 113 : GOTO 99 114 : C_______________________________________________________________________ 115 : C_______________________________________________________________________ 116 : C 117 : C SECTEUR DE CALCUL POUR LES ELEMENTS MASSIFS 118 : C_______________________________________________________________________ 119 : C 120 : 4 CONTINUE 121 : C 122 : DIM3=1.D0 123 : NBNO=NBNN 124 : NBBB=NBNN 125 : NSTB=NDDL 126 : SEGINI WRK1,WRK2 127 : I195=0 128 : I259=0 129 : * 130 : C 131 : DO 3004 IB=1,NBELEM 132 : C 133 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 134 : C 134 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 135 : C 136 : C MISE A 0 DES FORCES NODALES 137 : C 137 : CALL ZERO(XFORC,1,LRE) 138 : C 139 : C BOUCLE SUR LES POINTS DE GAUSS 140 : C 141 : ISDJC=0 142 : DO 5004 IGAU=1,NBPGAU 143 : C 144 : C RECUPERATION DE L'EPAISSEUR 145 : C 146 : IF (IFOUR.EQ.-2)THEN 147 : MPTVAL=IVACAR 148 : IF (IVACAR.NE.0) THEN 149 : MELVAL=IVAL(1) 150 : IF (MELVAL.NE.0) THEN 151 : IGMN=MIN(IGAU,VELCHE(/1)) 152 : IBMN=MIN(IB,VELCHE(/2)) 153 : DIM3=VELCHE(IGMN,IBMN) 154 : ELSE 155 : DIM3=1.D0 156 : ENDIF 157 : ENDIF 158 : ENDIF 159 : C 159 : CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,DIM3, 160 : 1 XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 161 : * 162 : IF(DJAC.LT.0.D0) ISDJC=ISDJC+1 163 : IF(DJAC.EQ.0.D0) I259=IB 164 : DJAC=ABS(DJAC)*POIGAU(IGAU) 165 : C 166 : C ON RECUPERE LES FORCES VOLUMIQUES 167 : C 168 : MPTVAL=IVAFVO 169 : ICOSOU=IVAL(/1) 170 : DO 8004 I=1,ICOSOU 171 : IF (IVAL(I).NE.0) THEN 172 : MELVAL=IVAL(I) 173 : IGMN=MIN(IGAU,VELCHE(/1)) 174 : IBMN=MIN(IB ,VELCHE(/2)) 175 : FOVOL(I)=VELCHE(IGMN,IBMN) 176 : ELSE 177 : FOVOL(I)=0.D0 178 : ENDIF 179 : 8004 CONTINUE 180 : * 181 : * CALCUL DES FORCES NODALES EQUIVALENTES 182 : * 183 : DO 9004 J=1,LRE 184 : DO 9004 I=1,NDDL 185 : XFORC(J)=XFORC(J)+BGENE(I,J)*FOVOL(I)*DJAC 186 : 9004 CONTINUE 187 : * 188 : 5004 CONTINUE 189 : * 190 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB 191 : * 192 : C 193 : C ON RANGE XFORC DANS MELVAL 194 : C 195 : IE=0 196 : MPTVAL=IVAFOR 197 : DO 7004 IGAU=1,NBNN 198 : DO 7004 ICOMP=1,NCOMP 199 : IE=IE+1 200 : MELVAL=IVAL(ICOMP) 201 : VELCHE(IGAU,IB)=XFORC(IE) 202 : 7004 CONTINUE 203 : C 204 : 3004 CONTINUE 205 : IF(I195.NE.0) INTERR(1)=I195 205 : IF(I195.NE.0) CALL ERREUR(195) 206 : IF(I259.NE.0) INTERR(1)=I259 206 : IF(I259.NE.0) CALL ERREUR(259) 207 : SEGSUP WRK1,WRK2 208 : GOTO 510 209 : C_______________________________________________________________________ 210 : C 211 : C MILIEUX POREUX 212 : C_______________________________________________________________________ 213 : C 214 : 79 CONTINUE 215 : C 216 : C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS 217 : C NBNO = NOMBRE DE FONCTIONS DE FORME 218 : C 219 : DIM3=1.D0 220 : NBNO=IPORE 221 : NBBB=NBNN 222 : LRN = NBNO-NBBB 223 : LRB=LRE-LRN 224 : NSTN=1 225 : NSTB=NDDL-1 226 : SEGINI WRK1,WRK2,WRK5 227 : I195=0 228 : I259=0 229 : C 230 : DO 3079 IB=1,NBELEM 231 : C 232 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 233 : C 233 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 234 : C 235 : C MISE A 0 DES FORCES NODALES 236 : C 236 : CALL ZERO(XFORC,1,LRE) 237 : C 238 : C BOUCLE SUR LES POINTS DE GAUSS 239 : C 240 : ISDJC=0 241 : DO 5079 IGAU=1,NBPGAU 242 : C 243 : C RECUPERATION DE L'EPAISSEUR 244 : C 245 : IF (IFOUR.EQ.-2)THEN 246 : MPTVAL=IVACAR 247 : IF (IVACAR.NE.0) THEN 248 : MELVAL=IVAL(1) 249 : IF (MELVAL.NE.0) THEN 250 : IGMN=MIN(IGAU,VELCHE(/1)) 251 : IBMN=MIN(IB,VELCHE(/2)) 252 : DIM3=VELCHE(IGMN,IBMN) 253 : ELSE 254 : DIM3=1.D0 255 : ENDIF 256 : ENDIF 257 : ENDIF 258 : C 258 : CALL BNPORE(IGAU,NBNO,NBNN,LRE,IFOUR,NSTB,NSTN,NHRM,DIM3, 259 : . XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,5) 260 : IF(DJAC.LT.0.D0) ISDJC=ISDJC+1 261 : IF(DJAC.EQ.0.D0) I259=IB 262 : DJAC=ABS(DJAC)*POIGAU(IGAU) 263 : C 264 : C ON RECUPERE LES FORCES VOLUMIQUES 265 : C 266 : MPTVAL=IVAFVO 267 : ICOSOU=IVAL(/1) 268 : DO 8079 I=1,ICOSOU 269 : IF (IVAL(I).NE.0) THEN 270 : MELVAL=IVAL(I) 271 : IGMN=MIN(IGAU,VELCHE(/1)) 272 : IBMN=MIN(IB ,VELCHE(/2)) 273 : FOVOL(I)=VELCHE(IGMN,IBMN) 274 : ELSE 275 : FOVOL(I)=0.D0 276 : ENDIF 277 : 8079 CONTINUE 278 : * 279 : * CALCUL DES FORCES NODALES EQUIVALENTES 280 : * D'ABORD LA MECANIQUE 281 : * 282 : DO 9079 J=1,LRB 283 : DO 9079 I=1,NSTB 284 : XFORC(J)=XFORC(J)+BGENE(I,J)*FOVOL(I)*DJAC 285 : 9079 CONTINUE 286 : * 287 : * PUIS LA PRESSION 288 : * 289 : DO 6079 J=1,LRN 290 : JJ=LRB+J 291 : XFORC(JJ)=XFORC(JJ)+XGENE(1,J)*FOVOL(NDDL)*DJAC 292 : 6079 CONTINUE 293 : * 294 : 5079 CONTINUE 295 : * 296 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB 297 : * 298 : C 299 : C ON RANGE XFORC DANS MELVAL 300 : C D'ABORD LES FORCES 301 : C 302 : IE=0 303 : MPTVAL=IVAFOR 304 : DO 7079 IGAU=1,NBNN 305 : DO 7079 ICOMP=1,NCOMP-1 306 : IE=IE+1 307 : MELVAL=IVAL(ICOMP) 308 : VELCHE(IGAU,IB)=XFORC(IE) 309 : 7079 CONTINUE 310 : C 311 : C PUIS LES DEBITS 312 : C 313 : DO 4079 IGAU=1,NBSOM(IELE) 314 : IE=IE+1 315 : MELVAL=IVAL(NCOMP) 316 : IGAV = IBSOM(NSPOS(IELE)+IGAU-1) 317 : VELCHE(IGAV,IB)=XFORC(IE) 318 : 4079 CONTINUE 319 : C 320 : 3079 CONTINUE 321 : IF(I195.NE.0) INTERR(1)=I195 321 : IF(I195.NE.0) CALL ERREUR(195) 322 : IF(I259.NE.0) INTERR(1)=I259 322 : IF(I259.NE.0) CALL ERREUR(259) 323 : SEGSUP WRK1,WRK2,WRK5 324 : GOTO 510 325 : C 326 : C_______________________________________________________________________ 327 : C 328 : C 329 : 99 CONTINUE 330 : MOTERR(1:4)=NOMTP(MELE) 331 : MOTERR(5:8)='CNEQ' 331 : CALL ERREUR(86) 332 : C 333 : 510 CONTINUE 334 : RETURN 335 : END 336 : 337 : 338 : 339 : 340 : 341 : 342 : 343 : 344 : 345 : 346 : 347 : 348 : 349 : 350 : 351 : 352 : 353 : 354 : 355 : 356 : 357 : 358 : 359 : 360 : 361 : 362 :
© Cast3M 2003 - All rights reserved.
Disclaimer