1 : C KGRAV1 SOURCE CHAT 11/03/16 21:26:10 6902 2 : SUBROUTINE KGRAV1 (IPMODL,XRG,IPOIN1,IPRIG,IRET,IDISS,IFLAM) 3 : * 4 : *_______________________________________________________________________ 5 : * 6 : * APPELE PAR KP 7 : * 8 : * ENTREES : 9 : * ======== 10 : * 11 : * IPMODL: POINTEUR SUR UN MMODEL 12 : * IPOIN1: NUMERO DU POINT(VECTEUR) QUI DEFINIT LE SENS 13 : * LA PESANTEUR 14 : * XRG : COEFFICIENT MULTIPLICATEUR DE RIGIDITE 15 : * IDISS : 0 ---> MATRICE SYMETRIQUE 16 : * 1 ---> MATRICE DISSYMETRIQUE 17 : * IFLAM : 0 ---> SOUS TYPE RIGIDITE 18 : * 1 ---> SOUS TYPE MASSE 19 : * 20 : * SORTIES : 21 : * ========= 22 : * 23 : * IPRIG POINTEUR SUR LA RIGIDITE CONSTRUITE 24 : * IRET 1 SI OK, 0 SINON 25 : * 26 : * I. Politopoulos juillet 1995 27 : *_______________________________________________________________________ 28 : IMPLICIT INTEGER(I-N) 29 : IMPLICIT REAL*8(A-H,O-Z) 30 : -INC CCOPTIO 31 : -INC CCREEL 32 : -INC CCHAMP 33 : -INC SMRIGID 34 : -INC SMELEME 35 : -INC SMCOORD 36 : -INC SMINTE 37 : -INC SMMODEL 38 : LOGICAL lsupfo,lsupdp 39 : C 40 : SEGMENT NOTYPE 41 : 42 : CHARACTER*16 TYPE(NBTYPE) 43 : ENDSEGMENT 44 : 45 : C C 46 : NHRM=NIFOUR 47 : IRET=1 48 : 49 : C 50 : C ACTIVATION DU MODELE 51 : C 52 : MMODEL=IPMODL 53 : SEGACT MMODEL 54 : NSOUS=KMODEL(/1) 55 : C 56 : C CREATION DE L'OBJET MATRICE DE RIGIDITE 57 : C 58 : NRIGE=7 59 : NRIGEL=NSOUS 60 : SEGINI MRIGID 61 : IPRIG=MRIGID 62 : IF (IFLAM.EQ.1) THEN 63 : MTYMAT='MASSE' 64 : ELSE 65 : MTYMAT='RIGIDITE' 66 : ENDIF 67 : IFORIG=IFOMOD 68 : ICHOLE=0 69 : IMGEO1=0 70 : IMGEO2=0 71 : ISUPEQ=0 72 : C 73 : C BOUCLE SUR LES SOUS ZONES 74 : C 75 : DO 499 ISOUS=1,NSOUS 76 : IRIGEL(4,ISOUS)=0 77 : COERIG(ISOUS)=1.D0 78 : 499 CONTINUE 79 : C_______________________________________________________________________ 80 : C 81 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES 82 : C_______________________________________________________________________ 83 : C 84 : DO 500 ISOUS=1,NSOUS 85 : C 86 : C ON RECUPERE LINFORMATION GENERALES 87 : C 88 : IMODEL=KMODEL(ISOUS) 89 : SEGACT IMODEL 90 : IPMAIL=IMAMOD 91 : C 92 : C TRAITEMENT DU MODELE 93 : C 94 : MELEME=IMAMOD 95 : MELE=NEFMOD 96 : NFOR=FORMOD(/2) 97 : NMAT=MATMOD(/2) 98 : 99 : C_______________________________________________________________________ 100 : C 101 : C INFORMATION SUR L ELEMENT FINI 102 : C_______________________________________________________________________ 103 : C 103 : * CALL ELQUOI(MELE,0,4,IPINF,IMODEL) 104 : IF (IERR.NE.0) THEN 105 : SEGDES IMODEL,MMODEL 106 : SEGSUP MRIGID 107 : IRET=0 108 : RETURN 109 : ENDIF 110 : * INFO=IPINF 111 : MFR =INFELE(13) 112 : LRE =INFELE(9) 113 : LW =INFELE(7) 114 : NDDL =INFELE(15) 115 : IELE=INFELE(14) 116 : * MINTE=INFELE(11) 117 : MINTE=infmod(6) 118 : IPMINT=MINTE 119 : C 120 : C INITIALISATION DE MINTE 121 : C 122 : SEGACT MINTE 123 : NBPGAU=POIGAU(/1) 124 : 125 : C 126 : C ON RECUPERE LES MELEME 127 : C 128 : MELEME=IPMAIL 129 : SEGACT MELEME 130 : 131 : NBNN =NUM(/1) 132 : NBELEM=NUM(/2) 133 : 134 : C 135 : C ---------------------------------------------------------* 136 : C INITIALISATION DU SEGMENT DESCR, SEGMENT DESCRIPTEUR DES * 137 : C DES INCONNUES RELATIVES A LA MATRICE DE RIGIDITE * 138 : C ---------------------------------------------------------* 139 : NLIGRP = INFELE(9) 140 : NLIGRD = INFELE(9) 141 : SEGINI DESCR 142 : IPDSCR=DESCR 143 : if(lnomid(1).ne.0) then 144 : nomid=lnomid(1) 145 : segact nomid 146 : modepl=nomid 147 : ndepl=lesobl(/2) 148 : ndum=lesfac(/2) 149 : lsupdp=.false. 150 : else 151 : lsupdp=.true. 151 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEPL,NDUM) 152 : endif 153 : if(lnomid(2).ne.0) then 154 : nomid=lnomid(2) 155 : segact nomid 156 : moforc=nomid 157 : nforc=lesobl(/2) 158 : lsupfo=.false. 159 : else 160 : lsupfo=.true. 160 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NDUM) 161 : endif 162 : C 163 : IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN 163 : CALL ERREUR(5) 164 : SEGSUP DESCR,MRIGID 165 : SEGDES MMODEL,MELEME 166 : IRET=0 167 : RETURN 168 : ENDIF 169 : C 170 : C REMPLISSAGE DU SEGMENT DESCRIPTEUR 171 : C 172 : IDDL=1 173 : NCOMP=NDEPL 174 : NBNNS=NBNN 175 : IF (MFR.EQ.33) NCOMP=NDEPL-1 176 : IF (IFOUR.EQ.-3) THEN 177 : NCOMP=NDEPL-3 178 : NBNNS=NBNN-1 179 : ENDIF 180 : IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2 181 : NOMID=MODEPL 182 : SEGACT NOMID 183 : NOMID=MOFORC 184 : SEGACT NOMID 185 : DO 1004 INOEUD=1,NBNNS 186 : DO 1005 ICOMP=1,NCOMP 187 : NOMID=MODEPL 188 : LISINC(IDDL)=LESOBL(ICOMP) 189 : NOMID=MOFORC 190 : LISDUA(IDDL)=LESOBL(ICOMP) 191 : NOELEP(IDDL)=INOEUD 192 : NOELED(IDDL)=INOEUD 193 : IDDL=IDDL+1 194 : 1005 CONTINUE 195 : 1004 CONTINUE 196 : * 197 : 198 : 199 : NOMID=MODEPL 200 : SEGDES NOMID 201 : NOMID=MOFORC 202 : SEGDES NOMID 203 : SEGDES DESCR 204 : 205 : C 206 : C ------------------------------------------------------------* 207 : C INITIALISATION DU SEGMENT IMATRI, CHAPEAU SUR LES SEGMENTS * 208 : C CONTENANT LES MATRICES DE RIGIDITE ELEMENTAIRES * 209 : C ------------------------------------------------------------* 210 : C NBELEM: NB D'ELEMENTS DANS LA SOUS ZONE 211 : NLIGRP=LRE 212 : NLIGRD=LRE C 213 : NELRIG=NBELEM 214 : SEGINI xMATRI 215 : IPMATR=xMATRI 216 : C 217 : C------------------------------------------------------* 218 : C 219 : C TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID * 220 : C------------------------------------------------------* 221 : C 222 : 223 : IRIGEL(1,ISOUS)=IPMAIL 224 : IRIGEL(2,ISOUS)=0 225 : IRIGEL(3,ISOUS)=IPDSCR 226 : IRIGEL(4,ISOUS)=xMATRI 227 : IRIGEL(5,ISOUS)=NHRM 228 : IF (IDISS.EQ.0) IRIGEL(7,ISOUS)= 0 229 : IF (IDISS.EQ.1) IRIGEL(7,ISOUS)= 2 230 : 231 : 232 : C_______________________________________________________________________ 233 : C 234 : C coq3/dkt/dst/coq4 235 : C_______________________________________________________________________ 236 : C 237 : IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.93) THEN 238 : c coq3/dkt/dst 238 : CALL KGRAV3(IPMAIL,XRG,IPOIN1,IPMATR,IDISS) 239 : ELSE IF (MELE.EQ.49) THEN 240 : c coq4 240 : CALL KGRAV2(IPMAIL,XRG,IPOIN1,IPMATR,IDISS,IPMINT) 241 : ELSE 242 : SEGSUP xMATRI 243 : IRIGEL(4,ISOUS)=0 244 : MOTERR(1:4)=NOMTP(MELE) 245 : MOTERR(5:12)='KGRAV1' 245 : CALL ERREUR(86) 246 : GOTO 9990 247 : ENDIF 248 : C 249 : C_______________________________________________________________________ 250 : C_______________________________________________________________________ 251 : C 252 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA 253 : C_______________________________________________________________________ 254 : C 255 : 256 : SEGDES MELEME 257 : SEGDES IMODEL 258 : 259 : C 260 : NOMID=MOFORC 261 : if(lsupfo)SEGSUP NOMID 262 : NOMID=MODEPL 263 : if(lsupdp)SEGSUP NOMID 264 : C 265 : SEGDES MINTE 266 : * INFO=IPINF 267 : * SEGSUP INFO 268 : C 269 : C ERREUR DANS KGRAV3 270 : C 271 : IF (IERR.NE.0) THEN 272 : IRET=0 273 : GOTO 888 274 : ENDIF 275 : 500 CONTINUE 276 : 888 CONTINUE 277 : SEGDES MMODEL 278 : SEGDES MRIGID 279 : GOTO 666 280 : C 281 : 9990 CONTINUE 282 : IRET=0 283 : 284 : C 285 : C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR 286 : C 287 : 288 : NOMID=MOFORC 289 : if(lsupfo)SEGSUP NOMID 290 : NOMID=MODEPL 291 : if(lsupdp)SEGSUP NOMID 292 : C 293 : SEGDES MELEME 294 : SEGDES IMODEL 295 : C 296 : SEGDES MMODEL 297 : SEGSUP MRIGID 298 : C 299 : SEGDES MINTE 300 : * INFO=IPINF 301 : * SEGSUP INFO 302 : RETURN 303 : 666 CONTINUE 304 : RETURN 305 : END 306 : 307 : 308 : 309 :
© Cast3M 2003 - All rights reserved.
Disclaimer