1 : C CALSIG SOURCE FANDEUR 11/04/12 21:15:08 6938 2 : SUBROUTINE CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT, 3 : 1 VALCAR,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST, 4 : 2 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR, 5 : 3 XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD) 6 : *_______________________________________________________________________ 7 : * 8 : * 9 : * ENTREES : 10 : * --------- 11 : * 12 : * DEPST = INCREMENT DE DEFORMATIONS TOTALES 13 : * DDAUX = MATRICE DE HOOKE ELASTIQUE 14 : * NSTRS = NBRE DE COMPOSANTES DES DEFORMATIONS 15 : * CMATE = NOM DU MATERIAU 16 : * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU 17 : * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES 18 : * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE 19 : * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE 20 : * MFR = NUMERO DE LA FORMULATION 21 : * IFOU = OPTION DE CALCUL 22 : * IB = NUMERO DE L ELEMENT COURANT 23 : * IGAU = NUMERO DU POINT COURANT 24 : * EPAIST= EPAISSEUR 25 : * NBPGAU= NBRE DE POINTS DE GAUSS 26 : * MELE = NUMERO DE L ELEMENT FINI 27 : * NPINT = NBRE DE POINTS D INTEGRATION 28 : * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES 29 : * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES 30 : * SECT = SECTION 31 : * LHOOK = TAILLE DE LA MATRICE DE HOOKE 32 : * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES 33 : * POUR LE CALCUL DE LA MATRICE DE HOOKE 34 : * 35 : * SORTIE : 36 : * -------- 37 : * 38 : * DSIGT = INCREMENT DE CONTRAINTES TOTALES 39 : * 40 : *_______________________________________________________________________ 41 : * 42 : IMPLICIT INTEGER(I-N) 43 : IMPLICIT REAL*8(A-H,O-Z) 44 : * 45 : -INC CCREEL 46 : -INC CCOPTIO 47 : * 48 : *_______________________________________________________________________ 49 : * 50 : DIMENSION VALMAT(*),VALCAR(*),VAR(1) 51 : DIMENSION TXR(IDIM,*),CRIGI(*),S(3) 52 : DIMENSION DEPST(*),DSIGT(*) 53 : DIMENSION COBMA(20),DDAUX(LHOOK,LHOOK) 54 : DIMENSION DDHOMU(LHOOK,LHOOK) 55 : DIMENSION XLOC(IDIM,*),XGLOB(IDIM,*) 56 : DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*) 57 : * 58 : PARAMETER(DEUX=2.D0,UNDEMI=.5D0) 59 : PARAMETER(X774=.774596669241483D0) 60 : PARAMETER(SIX=6.D0) 61 : * 62 : CHARACTER*8 CMATE 63 : C 64 : C 65 : IRTD=1 65 : CALL ZERO(COBMA,LHOOK,1) 65 : CALL ZERO(DSIGT,NSTRS,1) 66 : * 67 : IF(MFR.EQ.15.AND.NBPGAU.EQ.1) THEN 68 : S(1)= XZERO 69 : ELSE IF(MFR.EQ.15.AND.NBPGAU.EQ.3) THEN 70 : S(1)=-X774 71 : S(2)= XZERO 72 : S(3)= X774 73 : ENDIF 74 : * 75 : IF (IB.EQ.1.AND.IGAU.EQ.1) THEN 76 : GOTO 1000 77 : * 78 : ELSEIF (N2PTEL.EQ.1.AND.N2EL.EQ.1) THEN 79 : GOTO 2000 80 : * 81 : ELSEIF (N2PTEL.EQ.1.AND.N2EL.NE.1) THEN 82 : IF (IGAU.EQ.1) THEN 83 : GOTO 1000 84 : ELSE 85 : GOTO 2000 86 : ENDIF 87 : * 88 : ELSE 89 : GOTO 1000 90 : * 91 : ENDIF 92 : C 93 : 1000 CONTINUE 94 : * 95 : * write(6,*) ' calsi , nstrs mfr, nbgmat,nelmat mele , lhook' 96 : * write(6,*) ' calsig' , nstrs ,mfr, nbgmat,nelmat, mele ,lhook 97 : IRET=1 97 : CALL ZERO(DDAUX,LHOOK,LHOOK) 98 : * 99 : IF (CMATE.EQ.'ISOTROPE') THEN 100 : * Les modeles de comportement necessaitant l'appel a CALSIG ne 101 : * correspondent pas aux modeles de comportement dont la valeur 102 : * de INAT est referencee dans HOOKIS. Par consequent, nous 103 : * CHOISISSONS de fixer ARBITRAIREMENT INAT a 0 dans le present 104 : * sous-programme ! 105 : INAT = 0 105 : CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,0.D0,EPAIST, 106 : + INAT,MELE,NPINT,IFOU,1,NBGMAT,NELMAT, 107 : + S,SECT,LHOOK,DDHOMU,DDAUX, 108 : + COBMA,XMOB,IRET) 109 : * write(6,*) ' calsig apres hookis iret ' , iret 110 : C 111 : ELSE IF (CMATE.EQ.'ORTHOTRO') THEN 111 : CALL HOOKOR(VALMAT,IB,IGAU,MFR,0.D0,EPAIST, 112 : + MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK, 113 : + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX, 114 : + COBMA,XMOB,IRET) 115 : C 116 : ELSE IF (CMATE.EQ.'ANISOTRO') THEN 116 : CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOU,1,NBGMAT,NELMAT, 117 : + SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDAUX, 118 : + MELE,COBMA,XMOB,IRET) 119 : C 120 : ELSE IF (CMATE.EQ.'UNIDIREC') THEN 120 : CALL HOOKUN(VALMAT,IB,IGAU,MFR,0.D0,EPAIST, 121 : + MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK, 122 : + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX, 123 : + COBMA,XMOB,IRET) 124 : C 125 : ELSE IF (CMATE.EQ.'HOMOGENE') THEN 125 : CALL HOOKHO(VALMAT,IB,IGAU,MFR,NBGMAT,NELMAT,SECT, 126 : + LHOOK,DDAUX,IRET) 127 : C 128 : ELSE IF (CMATE.EQ.'SECTION') THEN 128 : CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOU, 129 : + NBGMAT,NELMAT,SECT,LHOOK,DDAUX,IRET) 130 : C 131 : ENDIF 132 : * 133 : IF (IRET.LE.0 ) GOTO 9990 134 : C 135 : * 136 : * cas des champs uniformes -> on ne recalcule pas DDAUX 137 : * 138 : 2000 CONTINUE 139 : * 140 : * cas des milieux poreux : 2 cas selon la valeur de NSTRS 141 : * 142 : IF(MFR.EQ.33.AND.LHOOK.LT.NSTRS) THEN 143 : * 144 : * cas sigeff 145 : * 146 : IF(XMOB.EQ.0.D0) THEN 147 : UNSURM=0.D0 148 : ELSE 149 : UNSURM=1.D0/XMOB 150 : ENDIF 151 : * 152 : DO 4500 I=1,LHOOK 153 : DSIGT(I)=-COBMA(I)*DEPST(NSTRS) 154 : DO 45001 J=1,LHOOK 155 : DSIGT(I)=DSIGT(I)+DDAUX(I,J)*DEPST(J) 156 : 45001 CONTINUE 157 : 4500 CONTINUE 158 : DSIGT(NSTRS)=DEPST(NSTRS)*UNSURM 159 : DO 4502 I=1,LHOOK 160 : DSIGT(NSTRS)=DSIGT(NSTRS)+COBMA(I)*DEPST(I) 161 : 4502 CONTINUE 162 : * 163 : * autres cas 164 : * 165 : ELSE 166 : DO 5500 I=1,LHOOK 167 : DSIGT(I)=0.D0 168 : DO 55001 J=1,LHOOK 169 : DSIGT(I)=DSIGT(I)+DDAUX(I,J)*DEPST(J) 170 : 55001 CONTINUE 171 : 5500 CONTINUE 172 : ENDIF 173 : * 174 : * CAS DES TUYAUX FISSURES 175 : * 176 : IF (MFR.EQ.17) THEN 177 : * 178 : YOU=VALMAT(1) 179 : RAYO=VALCAR(1) 180 : EPAI=VALCAR(2) 181 : TETA1=VALCAR(9)*UNDEMI 182 : C CONVERSION DE TETA1 EN RADIAN 183 : TETA = (TETA1 * XPI)/180.D0 184 : TESPI = TETA/XPI 185 : C ON MET DANS 'RAYMO' LE RAYON MOYEN DU TUYAU. 186 : RAYMO =RAYO - (EPAI/DEUX) 187 : C CALCUL DE A COEFIICIENT ZAHOR 188 : RSURT=RAYMO / EPAI 189 : IF(RSURT.LE.10.D0.AND.RSURT.GE.4.9D0) THEN 190 : AXX = ( .125D0*RSURT - .25D0 ) **.25D0 191 : ELSE IF(RSURT.GT.10.D0.AND.RSURT.LE.35.D0) THEN 192 : AXX = ( .4D0*RSURT - 3.D0 ) **.25D0 193 : ELSE 194 : KERRE=3 195 : ENDIF 195 : CALL TUFIFP(TESPI,AXX,FP,FM,FMP,FOP,FOM) 196 : C 197 : C 198 : C FACTEUR D INTENSITE DES CONTRAINTES 199 : C 200 : IF(TETA1.LE.(0.5D0))THEN 201 : DSIGT(7)=XZERO 202 : DSIGT(8)=XZERO 203 : GOTO 9992 204 : ENDIF 205 : SQQ= XPI * RAYMO * TETA 206 : SQQ= SQRT(SQQ) 207 : XEX= SQQ * FOP/(DEUX * XPI * RAYMO *EPAI) 208 : XFL= SQQ * FOM/(XPI * RAYMO * RAYMO *EPAI) 209 : DSIGT(7)=XEX * DSIGT(1) - XFL * DSIGT(6) 210 : C 211 : C CALCUL DES AIRES DE BRECHE NOTE TECHNIQUE DRE/STRE/LMA 85/695 212 : C 213 : SIGM=DSIGT(1)/( DEUX * XPI * RAYMO * EPAI ) 214 : SIGF=DSIGT(6)/( XPI * RAYMO * RAYMO * EPAI ) 215 : XIM= XPI * RAYMO * RAYMO * DEUX * TETA * TETA * FP /YOU 216 : XIF= XIM * ( .75D0 +(.25D0 * COS ( TETA ))) 217 : DSIGT(8)=XIM * SIGM - XIF * SIGF 218 : ENDIF 219 : C 220 : * 221 : * CAS DES LISP ET LISM 222 : * 223 : IF (MFR.EQ.15) THEN 224 : EPA1=VALCAR(1) 225 : EPA2=VALCAR(6) 226 : FISS1=VALCAR(2) 227 : FISS2=VALCAR(7) 228 : FISS1 = (FISS1*(UNDEMI +UNDEMI/X774))+ 229 : + (FISS2*(UNDEMI-UNDEMI/X774)) 230 : FISS2 = (FISS1*(UNDEMI -UNDEMI/X774))+ 231 : + (FISS2*(UNDEMI+UNDEMI/X774)) 232 : W=(EPA1+EPA2)*UNDEMI 233 : H1=UNDEMI-UNDEMI*S(IGAU) 234 : H2=UNDEMI+UNDEMI*S(IGAU) 235 : A= H1*FISS1+H2*FISS2 236 : ASURW=(H1*FISS1+H2*FISS2)/W 236 : CALL LISPFI(ASURW,FM,FF) 237 : X1=DSIGT(1)/W 238 : X4=DSIGT(4)*SIX/(W*W) 239 : XXX=XPI*A 240 : XXX=SQRT(XXX) 241 : XKIE=(X1*FM+X4*FF)*XXX 242 : DSIGT(6)= XKIE 243 : * 244 : ENDIF 245 : * 246 : GOTO 9992 247 : * 248 : * ERREUR , RETOUR 249 : * 250 : 9990 CONTINUE 251 : IRTD=0 252 : * 253 : 9992 RETURN 254 : END 255 : 256 : 257 : 258 : 259 : 260 : 261 : 262 : 263 : 264 : 265 : 266 : 267 : 268 : 269 :
© Cast3M 2003 - All rights reserved.
Disclaimer