C COMEFF SOURCE PV 17/12/08 21:16:27 9660 *---------------------------------------------------------- * cas des milieux poreux isotropes: * * appele par COMARA et COMSOR * * rearrangement dans XMAT * passage en contraintes effectives et reciproquement * * pb: IRETOU=1 *---------------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO -INC SMMODEL -INC SMCHAML -INC DECHE * * SEGMENT IECOU: sert de fourre-tout pour les initialisations * d'entiers * SEGMENT IECOU INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND, . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT, . LTRAC,MFRbi,IELE,NHRM,NBNNbi,NBELMb,ICARA, . LW2bi,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA, . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME INTEGER NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1, . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 ENDSEGMENT * * imodel = iqmod wrk52 = iwrk52 ****** segact wrk52*mod wrk53 = iwrk53 ******** segact wrk53*mod * write(6,*) 'comeff ', mfrbi, idim,mele, ifour,icara,xcarb(/1) * write(6,*) 'comeff ', MFR, MFRBI, NSTRS ncara = xmat(/1) wrk54=iwrk54 IRETOU=1 NSTMU=2 IF(IFOUR.GE.0) NSTMU=3 * * CAS MODELE EXTERIEUR * IF(INPLAS.LT.0) GO TO 1990 * *--------------------------------------------------------------------- * IF(ICAS.EQ.1) THEN * * * milieu poreux cas elastique isotrope * IF (MFRbi.EQ.33.AND.MATE.EQ.1) THEN * * CAS DES JOINTS * IF(MELE.GE.108.AND.MELE.LE.110)THEN NSTMU=2 IF(IFOUR.GE.0) NSTMU=3 * * rearrangement * LIND=3 COB=XMAT(LIND) XMOB=XMAT(LIND+1) DO 1991 IC=1,NMATT-LIND-1 XMAT(LIND-1+IC)=XMAT(LIND+1+IC) XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC) 1991 CONTINUE * * PRINT *,'NMATT=',NMATT * DO IJ=1,NMATT * WRITE(6,77882) XMAT(IJ) *77882 FORMAT(2X,1PE12.5) * ENDDO XMAT(NMATT-1)=COB XMAT0(NMATT-1)=COB XMAT(NMATT)=XMOB XMAT0(NMATT)=XMOB * * calcul des contraintes effectives * SIG0(NSTMU) =SIG0(NSTMU) + COB* EPST0(NSTRS) C ELSE * * CAS MASSIF ISOTROPE * C IF(IFOUR.EQ.-3.OR.IFOUR.EQ.1) THEN KERR0=99 GO TO 1000 ENDIF * * rearrangement * LIND=5 COB=XMAT(LIND) XMOB=XMAT(LIND+1) DO 1992 IC=1,NMATT-LIND-1 XMAT(LIND-1+IC)=XMAT(LIND+1+IC) XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC) 1992 CONTINUE * XMAT(NMATT-1)=COB XMAT0(NMATT-1)=COB XMAT(NMATT)=XMOB XMAT0(NMATT)=XMOB * PRINT *,'NMATT=',NMATT * DO IJ=1,NMATT * WRITE(6,77882) XMAT(IJ) *77882 FORMAT(2X,1PE12.5) * ENDDO * * calcul des contraintes effectives * DO 1993 IC=1,3 IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1993 SIG0(IC) =SIG0(IC) + COB* EPST0(NSTRS) 1993 continue ENDIF * ELSE * * CAS NON PREVU * GO TO 1000 ENDIF * GO TO 1990 ENDIF * *--------------------------------------------------------------------- * calcul des contraintes totales * IF(ICAS.EQ.2) THEN IF (MFRbi.EQ.33.AND.MATE.EQ.1) THEN * * attention : a prendre dans XMAT0 et pas XMAT * * * CAS DES JOINTS * IF(MELE.GE.108.AND.MELE.LE.110)THEN * NSTMU=2 IF(IFOUR.GE.0) NSTMU=3 COB= XMAT0(NMATT-1) XMOB=XMAT0(NMATT) IF(XMOB.EQ.0.D0) THEN UNSURM=0.D0 ELSE UNSURM=1.D0/XMOB ENDIF * * PRINT *, 'COB=',COB,' XMOB=',XMOB * PRINT *, 'NSTMU=',NSTMU * PRINT *, 'NSTRS=',NSTRS * PRINT *, 'SIG0(NSTRS)=',SIG0(NSTRS) * PRINT *, 'DEPST(NSTRS)=',DEPST(NSTRS) SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM & +COB*DEPST(NSTMU) SIGF(NSTMU) = SIGF(NSTMU) & -COB*(EPST0(NSTRS)+DEPST(NSTRS)) ELSE * * CAS MASSIF ISOTROPE * COB= XMAT0(NMATT-1) XMOB=XMAT0(NMATT) IF(XMOB.EQ.0.D0) THEN UNSURM=0.D0 ELSE UNSURM=1.D0/XMOB ENDIF * PRINT *,' COB=', COB * IRETOU=1 * GO TO 1000 SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM DO 1994 IC=1,3 IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1994 SIGF(IC) = SIGF(IC) & -COB*(EPST0(NSTRS)+DEPST(NSTRS)) * * SIGF(NSTRS) = SIGF(NSTRS) & +COB*DEPST(IC) 1994 CONTINUE ENDIF * ELSE * * CAS NON PREVU * GO TO 1000 ENDIF GO TO 1990 ENDIF * 1000 CONTINUE RETURN * 1990 CONTINUE IRETOU=0 RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales