1 : C CNEQ2 SOURCE CHAT 11/03/16 21:17:02 6902 2 : SUBROUTINE CNEQ2(IPMAIL,LRE,NDDD,IVAFVO,LW,NBPGAU,IVACAR, 3 : & CMATE,NBPTEL,MELE,IPMINT,IPMIN1,IVAMAT,NMATT,NBGMAT,NELMAT, 4 : & IMAT,IVAFOR) 5 : *---------------------------------------------------------------------- 6 : * _______________________________ * 7 : * | | * 8 : * | CALCUL DES FORCES AUX NOEUDS| * 9 : * |______________________________| * 10 : * * 11 : * dkt,coq4 * 12 : * * 13 : *---------------------------------------------------------------------* 14 : * * 15 : * ENTREES : * 16 : * ________ * 17 : * * 18 : * IPMAIL Pointeur sur un segment MELEME * 19 : * LRE Nombre de ddl dans la matrice de rigidite * 20 : * NDDD Nombre de degrE de libertE PAR NOEUD * 21 : * IVAFVO pointeur sur un segment MPTVAL contenant les * 22 : * les melvals de forces volumiques * 23 : * LW Dimension du tableau de travail de l'element * 24 : * NBPGAU Nombre de points d'integration * 25 : * IVACAR Pointeur sur les chamelems de caracteristiques * 26 : * NBPTEL Nombre de points par element * 27 : * MELE Numero de l'element fini * 28 : * IPMINT Pointeur sur un segment MINTE * 29 : * IPMIN1 Pointeur sur un segment MINTE (aux noeuds) * 30 : * * 31 : * SORTIES : * 32 : * ________ * 33 : * * 34 : * IVAFOR pointeur sur un segment MPTVAL contenant les * 35 : * les melvals de forces * 36 : * * 37 : *---------------------------------------------------------------------* 38 : IMPLICIT INTEGER(I-N) 39 : IMPLICIT REAL*8(A-H,O-Z) 40 : * 41 : * 42 : -INC CCOPTIO 43 : -INC CCHAMP 44 : -INC CCREEL 45 : -INC SMCHAML 46 : -INC SMCHPOI 47 : -INC SMELEME 48 : -INC SMCOORD 49 : -INC SMMODEL 50 : -INC SMINTE 51 : -INC SMLREEL 52 : -INC SMRIGID 53 : * 54 : SEGMENT WRK1 55 : REAL*8 XFORC(LRE), FOVOL(NDDD), XE(3,NBBB) 56 : ENDSEGMENT 57 : * 58 : SEGMENT WRK2 59 : REAL*8 SHPWRK(6,NBNO), BGENE(NDDL,LRE) 60 : ENDSEGMENT 61 : * 62 : SEGMENT WRK3 63 : REAL*8 WORK(LW) 64 : ENDSEGMENT 65 : * 66 : SEGMENT WRK4 67 : REAL*8 BPSS(3,3), XEL(3,NBBB), XFOLO(LRE) 68 : ENDSEGMENT 69 : * 70 : SEGMENT MPTVAL 71 : INTEGER IPOS(NS) ,NSOF(NS) 72 : INTEGER IVAL(NCOSOU) 73 : CHARACTER*16 TYVAL(NCOSOU) 74 : ENDSEGMENT 75 : * 76 : CHARACTER*8 CMATE 77 : * 78 : * 79 : MELEME=IPMAIL 80 : NDDL=NDDD 81 : NBNN=NUM(/1) 82 : NBELEM=NUM(/2) 83 : NHRM=NIFOUR 84 : MINTE=IPMINT 85 : C_______________________________________________________________________ 86 : C 87 : C NUMERO DES ETIQUETTES : 88 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 89 : C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR : 90 : C 5 CONTINUE 91 : C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ... 92 : C 44 CONTINUE 93 : C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ... 94 : C_______________________________________________________________________ 95 : C 96 : GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 97 : 1 99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99, 98 : 2 41,99,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99, 99 : 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 100 : 4 99,99,99,99,99,99,99,88,99,99,99,99,93,99,99,99,99),MELE 101 : GOTO 99 102 : C_______________________________________________________________________ 103 : C_______________________________________________________________________ 104 : C 105 : C ELEMENT COQ3 106 : C_______________________________________________________________________ 107 : C 108 : 27 CONTINUE 109 : C 110 : C CAS NON PREVU 111 : GO TO 99 112 : C_______________________________________________________________________ 113 : C 114 : C ELEMENT DKT 115 : C_______________________________________________________________________ 116 : C 117 : 28 CONTINUE 118 : NBNO=NBNN 119 : NBBB=NBNN 120 : NDDL=3 121 : SEGINI WRK1,WRK2,WRK3,WRK4 122 : C 123 : DO 3028 IB=1,NBELEM 124 : C 125 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 126 : C 126 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 127 : C 128 : C MISE A ZERO DES FORCES NODALES 129 : C 129 : CALL ZERO(XFORC,1,LRE) 130 : C 130 : CALL VPAST(XE,BPSS) 130 : CALL VCORLC (XE,XEL,BPSS) 131 : C 132 : C BOUCLE SUR LES POINTS DE GAUSS 133 : C 134 : DO 6028 IGAU=1,NBPGAU 135 : MPTVAL=IVACAR 136 : MELVAL=IVAL(1) 137 : IGMN=MIN(IGAU,VELCHE(/1)) 138 : IBMN=MIN(IB ,VELCHE(/2)) 139 : EPAIST=VELCHE(IGMN,IBMN) 140 : IF (IVAL(2).NE.0) THEN 141 : MELVAL=IVAL(2) 142 : IGMN=MIN(IGAU,VELCHE(/1)) 143 : IBMN=MIN(IB ,VELCHE(/2)) 144 : EXCENT=VELCHE(IGMN,IBMN) 145 : ELSE 146 : EXCENT=0.D0 147 : ENDIF 148 : * 148 : CALL NDKT (IGAU,XEL,EXCENT,SHPTOT,SHPWRK,BGENE,DJAC) 149 : DJAC=DJAC*POIGAU(IGAU)*EPAIST 150 : * 151 : * ON RECUPERE LES FORCES VOLUMIQUES DANS LE REPERE GLOBAL 152 : * 153 : MPTVAL=IVAFVO 154 : ICOSOU=IVAL(/1) 155 : DO 8028 I=1,ICOSOU 156 : IF (IVAL(I).NE.0) THEN 157 : MELVAL=IVAL(I) 158 : IGMN=MIN(IGAU,VELCHE(/1)) 159 : IBMN=MIN(IB ,VELCHE(/2)) 160 : FOVOL(I)=VELCHE(IGMN,IBMN) 161 : ELSE 162 : FOVOL(I)=0.D0 163 : ENDIF 164 : 8028 CONTINUE 165 : * 166 : * ON LES PASSE DANS LE REPERE LOCAL 167 : * 167 : CALL MATVEC(FOVOL,XFOLO,BPSS,1) 168 : C 169 : C CALCUL DES FORCES NODALES 170 : C 171 : DO 7028 J=1,LRE 172 : DO 7028 I=1,NDDL 173 : XFORC(J)=XFORC(J)+BGENE(I,J)*XFOLO(I)*DJAC 174 : 7028 CONTINUE 175 : 6028 CONTINUE 176 : C 177 : C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL 178 : C 178 : CALL TRPOSE(BPSS) 178 : CALL MATVEC(XFORC,XFOLO,BPSS,6) 179 : IE=0 180 : MPTVAL=IVAFOR 181 : DO 9028 IGAU=1,NBNN 182 : DO 9028 ICOMP=1,6 183 : IE=IE+1 184 : MELVAL=IVAL(ICOMP) 185 : VELCHE(IGAU,IB)=XFOLO(IE) 186 : 9028 CONTINUE 187 : 3028 CONTINUE 188 : SEGSUP WRK1,WRK2,WRK3,WRK4 189 : GOTO 510 190 : C_______________________________________________________________________ 191 : C_______________________________________________________________________ 192 : C 193 : C ELEMENTS COQ6 ET COQ8 194 : C_______________________________________________________________________ 195 : C 196 : 41 CONTINUE 197 : C 198 : C CAS NON PREVU 199 : GO TO 99 200 : C 201 : C_______________________________________________________________________ 202 : C_______________________________________________________________________ 203 : C 204 : C ELEMENT COQ2 205 : C_______________________________________________________________________ 206 : C 207 : 44 CONTINUE 208 : C 209 : C CAS NON PREVU 210 : GO TO 99 211 : C 212 : C_______________________________________________________________________ 213 : C_______________________________________________________________________ 214 : C 215 : C ELEMENT COQ4 216 : C_______________________________________________________________________ 217 : C 218 : C 219 : 49 CONTINUE 220 : IG1=0 221 : NBNO=NBNN 222 : NBBB=NBNN 223 : SEGINI WRK1,WRK2,WRK4 224 : C 225 : DO 3049 IB=1,NBELEM 226 : C 227 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 228 : C 228 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 229 : C 230 : C MISE A ZERO DES FORCES NODALES 231 : C 231 : CALL ZERO(XFORC,1,LRE) 232 : C 233 : C CALCUL DE LA MATRICE DE PASSAGE EN REPERE LOCAL 234 : C 234 : CALL CQ4LOC(XE,XEL,BPSS,IERT,1) 235 : C 236 : IF (IERT .EQ. 3) THEN 237 : NOPLAN = 1 238 : ELSE 239 : NOPLAN = 0 240 : END IF 241 : C 242 : MPTVAL=IVACAR 243 : MELVAL=IVAL(1) 244 : IBMN=MIN(IB,VELCHE(/2)) 245 : EP=VELCHE(1,IBMN) 246 : MELVAL=IVAL(2) 247 : IF (MELVAL.NE.0) THEN 248 : IBMN=MIN(IB,VELCHE(/2)) 249 : EXCEN =VELCHE(1,IBMN) 250 : ELSE 251 : EXCEN=0.D0 252 : ENDIF 253 : C 254 : C BOUCLE SUR LES POINTS DE GAUSS 255 : C 256 : NBPGAM=NBPGAU-1 257 : DO 4049 IGAU=1,NBPGAM 257 : CALL NCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,IERT) 258 : * 259 : * IERT=1 JACOBIANO=<0 260 : IF (IERT.NE.0) IG1=IB 261 : * 262 : DJAC=DJAC*POIGAU(IGAU)*EP 263 : * 264 : * ON RECUPERE LES FORCES VOLUMIQUES DANS LE REPERE GLOBAL 265 : * 266 : MPTVAL=IVAFVO 267 : ICOSOU=IVAL(/1) 268 : DO 3549 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 : 3549 CONTINUE 278 : * 279 : * ON LES PASSE DANS LE REPERE LOCAL 280 : * 280 : CALL MATVEC(FOVOL,XFOLO,BPSS,1) 281 : C 282 : C ON CALCULE LES FORCES NODALES 283 : C 284 : DO 3649 J=1,LRE 285 : DO 3649 I=1,3 286 : XFORC(J)=XFORC(J)+BGENE(I,J)*XFOLO(I)*DJAC 287 : 3649 CONTINUE 288 : 4049 CONTINUE 289 : C 290 : C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL 291 : C 291 : CALL TRPOSE(BPSS) 291 : CALL MATVEC(XFORC,XFOLO,BPSS,8) 292 : IE=0 293 : MPTVAL=IVAFOR 294 : DO 9049 NODE=1,4 295 : DO 9049 ICOMP=1,6 296 : IE=IE+1 297 : MELVAL=IVAL(ICOMP) 298 : VELCHE(NODE,IB)=XFOLO(IE) 299 : 9049 CONTINUE 300 : 3049 CONTINUE 301 : C 302 : C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR... 303 : C 304 : IF(IG1.NE.0) THEN 305 : INTERR(1)=IG1 305 : CALL ERREUR(323) 306 : ENDIF 307 : SEGSUP WRK1,WRK2,WRK4 308 : GOTO 510 309 : C_______________________________________________________________________ 310 : C 311 : C ELEMENT JOINT JOI4 312 : C_______________________________________________________________________ 313 : C 314 : 88 CONTINUE 315 : C 316 : C CAS NON PREVU 317 : GO TO 99 318 : C 319 : C_______________________________________________________________________ 320 : C 321 : C ELEMENT DST 322 : C_______________________________________________________________________ 323 : C 324 : 93 CONTINUE 325 : C 326 : C CAS NON PREVU 327 : GO TO 99 328 : C 329 : C_______________________________________________________________________ 330 : * 331 : 99 CONTINUE 332 : MOTERR(1:4)=NOMTP(MELE) 333 : MOTERR(5:9)='CNEQ2' 333 : CALL ERREUR(86) 334 : * 335 : 510 CONTINUE 336 : RETURN 337 : END 338 : 339 : 340 : 341 : 342 : 343 : 344 : 345 : 346 : 347 : 348 : 349 : 350 : 351 : 352 : 353 : 354 : 355 : 356 :
© Cast3M 2003 - All rights reserved.
Disclaimer