Télécharger la plaquette Cast3M


fr en

Télécharger sste2.eso

Retour à la liste

Numérotation des lignes : 

sste2

  1. C SSTE2     SOURCE    OF166741  24/10/07    21:15:48     12016          
  2.  
  3.       SUBROUTINE SSTE2 (MATE,INPLAS,MELE,MELEME,MINTE,xMATRI,
  4.      .     NBELEM,NBPTEL,NBNN,LRE,MFR,
  5.      .     IVASTR,IVARI,IVADS,IVAMAT,NSTRS,NVARI,NMATT,
  6.      .     IVASTF,IVARIF,IVADEP,LHOOK,IRIGE7,
  7.      .     PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,KERRE)
  8.  
  9. *************************************************************************
  10. * entrees :
  11. *  mate   = numero de materiau elastique
  12. *  inplas = numero de materiau inelastique
  13. *  mele   = numero element fini
  14. *  meleme = pointeur du maillage
  15. *  minte
  16. *  nbelem = numero de elementos
  17. *  nbptel = nombre de points par element
  18. *  nbnn
  19. *  lre
  20. *  mfr
  21. *  ivastr =pointeur sur un segment mptval de contraintes
  22. *  ivari  =pointeur sur un segment mptval de variables internes
  23. *  ivads  =pointeur sur un segment mptval de increments deformations
  24. *  ivamat =pointeur sur un segment mptval de materiau
  25. *  lhook  =taille de la matrice de hooke
  26. *  nstrs  =nombre de composantes de contraintes
  27. *  nvari  =nombre de composantes de variables internes
  28. *  nmatt  =nombre de composnates de proprietes de materiau
  29. *  precis =precision dans les iterations internes
  30. * sorties :
  31. *  ivastf  =pointeur sur un segment mptval de contraintes
  32. *  ivarif  =pointeur sur un segment mptval de variables internes
  33. *  ivadep  =pointeur sur un segment mptval de deformations inelastiques
  34. *  kerre   =indicateur d'erreur
  35. ************************************************************************
  36.       IMPLICIT INTEGER(I-N)
  37.       IMPLICIT REAL*8(A-H,O-Z)
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. c-INC CCHAMP
  42.  
  43. -INC SMCHAML
  44. -INC SMELEME
  45. -INC SMCOORD
  46. -INC SMMODEL
  47. -INC SMINTE
  48. -INC SMRIGID
  49.  
  50.       SEGMENT MPTVAL
  51.         INTEGER      IPOS(NS)
  52.         INTEGER      NSOF(NS)
  53.         INTEGER      IVAL(NCOSOU)
  54.         CHARACTER*16 TYVAL(NCOSOU)
  55.       ENDSEGMENT
  56.       SEGMENT WRK0
  57.         REAL*8 XMAT(NMATT)
  58.       ENDSEGMENT
  59.       SEGMENT WRK1
  60.         REAL*8 DDHOOK(LHOOK,LHOOK)
  61.         REAL*8 SIG0(NSTRS)
  62.         REAL*8 DEPST(NSTRS)
  63.         REAL*8 DSIGT(NSTRS)
  64.         REAL*8 SIGF(NSTRS)
  65.         REAL*8 VAR0(NVARI)
  66.         REAL*8 VARF(NVARI)
  67.         REAL*8 DEFP(NSTRS)
  68.       ENDSEGMENT
  69.       SEGMENT WRK3
  70.         REAL*8 DDHOOK2(LHOOK,LHOOK)
  71.         REAL*8 SIGini(NSTRS)
  72.         REAL*8 DSIGTr(NSTRS)
  73.         REAL*8 VARini(NVARI)
  74.       ENDSEGMENT
  75.       SEGMENT WRK2
  76.         REAL*8 REL(LRE,LRE)
  77.         REAL*8 SHPWRK(6,NBNN)
  78.         REAL*8 BGENE(NSTRS,LRE)
  79.         REAL*8 XE(3,NBNN)
  80.       ENDSEGMENT
  81.       DIMENSION E(6,6)
  82.       call zero(E ,6,6 )
  83.       SEGINI WRK0,WRK1,WRK2,WRK3
  84. ****************************************
  85.       nescri   =0
  86.       nues     =6
  87.       if (inplas.eq.111) then
  88. c MODELE MRS_LADE
  89.          nmodel   =21
  90.          ndimv    =4
  91.          nsubpos  =5
  92.          if (NNUMER.eq.0) THEN
  93.            nnumer=3
  94.            deltax=2.D0**(int(log10(1.D-6)/log10(2.D0)))
  95.          endif
  96.       else if (inplas.eq.112) then
  97. c MODELE J2
  98.          nmodel   =1
  99.          ndimv    =2
  100.          nsubpos  =3
  101.       else if (inplas.eq.113) then
  102. c MODELE RH_COULOMB
  103.          nmodel   =2
  104.          ndimv    =2
  105.          nsubpos  =3
  106.       endif
  107.  
  108. ****************************************
  109. *  bucle elementos
  110.       SEGACT,MCOORD
  111.       DO 1000 IB=1,NBELEM
  112.        DO IA1=1,NBNN
  113.         JA=(IDIM+1)*(MELEME.NUM(IA1,IB)-1)
  114.         DO IA2=1,IDIM
  115.           wrk2.XE(IA2,IA1)=MCOORD.XCOOR(JA+IA2)
  116.         ENDDO
  117.         wrk2.XE(3,IA1)=0.D0
  118.        ENDDO
  119.        CALL ZERO(REL,LRE,LRE)
  120. ****************************************
  121. *  bucle puntos de gauss
  122.       DO 1100 IGAU=1,NBPTEL
  123. *  sig0 = tensiones iniciales
  124.             MPTVAL=IVASTR
  125.             DO IC=1,NSTRS
  126.                MELVAL=IVAL(IC)
  127.                IBMN=MIN(IB,VELCHE(/2))
  128.                IGMN=MIN(IGAU,VELCHE(/1))
  129.                SIG0(IC)=VELCHE(IGMN,IBMN)
  130.             enddo
  131. *  var0 = variables internas iniciales
  132.             MPTVAL=IVARI
  133.             DO IC=1,NVARI
  134.                MELVAL=IVAL(IC)
  135.                IBMN=MIN(IB,VELCHE(/2))
  136.                IGMN=MIN(IGAU,VELCHE(/1))
  137.                VAR0(IC)=VELCHE(IGMN,IBMN)
  138.             enddo
  139. *  depst = incremento de deformacion total
  140.             MPTVAL=IVADS
  141.             DO IC=1,NSTRS
  142.                MELVAL=IVAL(IC)
  143.                IBMN=MIN(IB,VELCHE(/2))
  144.                IGMN=MIN(IGAU,VELCHE(/1))
  145.                DEPST(IC)=VELCHE(IGMN,IBMN)
  146.             enddo
  147. *  xmat = caracteristicas materiales
  148.              MPTVAL=IVAMAT
  149.              DO IC=1,2
  150.                MELVAL=IVAL(IC)
  151.                IGMN=MIN(IGAU,VELCHE(/1))
  152.                IBMN=MIN(IB  ,VELCHE(/2))
  153.                XMAT(IC)=VELCHE(IGMN,IBMN)
  154.              ENDDO
  155.              XMAT(3)=0.D0
  156.              XMAT(4)=0.D0
  157.              DO IC=3,NMATT-5
  158.                MELVAL=IVAL(IC)
  159.                IGMN=MIN(IGAU,VELCHE(/1))
  160.                IBMN=MIN(IB  ,VELCHE(/2))
  161.                XMAT(IC+2)=VELCHE(IGMN,IBMN)
  162.              ENDDO
  163. ****************************************
  164.              call MatHok(E,6,NSTRS,1)
  165.              do i=1,NSTRS
  166.               r_z =0.D0
  167.               do j=1,NSTRS
  168.                r_z = r_z+E(i,j)*DEPST(j)
  169.               enddo
  170.               DSIGT(i)=r_z
  171.              enddo
  172.              iincre=nint(VAR0(nsubpos+1))
  173.              if (iincre.le.0) iincre=NMAXSSTEPS
  174.              iincreold = iincre
  175.              iincreold2 = iincre
  176.              iflagrec=0
  177. 100          continue
  178.              nsub=0
  179.                 call substep (SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,
  180.      .               DDHOOK,NSTRS,ndimv,LHOOK,
  181.      .               XMAT,KERRE,PRECIS,NITMAX,nescri,
  182.      .               nues,nmodel,NNUMER,DELTAX,NMAXSSTEPS,
  183.      .               nsub,ntotiter,iincre)
  184.  
  185. c numero de substeps hechos:   nsub
  186. c numero total de iteraciones: ntotiter
  187. c tamaño del ultimo step !!:   iincre
  188.  
  189.              if (kerre.eq.1) then
  190.                write(*,*)' Error tras substepping'
  191.                if ((inplas.eq.111).and.
  192.      .         ((nsub.ge.NMAXSSTEPS).or.(iflagrec.eq.1))) then
  193.                 write(*,9998)'STOP',IB,IGAU,iincre,nsub,ntotiter
  194.                 call DeterzonaMAC(sig0,4,var0,iplcon,iplcap,
  195.      .                            iplapex,1,6)
  196.                 do i=1,NSTRS
  197.                   DSIGT(i)=SIG0(i)+DSIGT(i)
  198.                 enddo
  199.                 call DeterzonaMAC(dsigt,4,var0,iplcon,iplcap,
  200.      .                            iplapex,1,6)
  201.                 iflagrec=0
  202.                 return
  203.                else
  204.                 write(*,9998)'Recompute',IB,IGAU,iincre,nsub,ntotiter
  205.                 call DeterzonaMAC(sig0,4,var0,iplcon,iplcap,
  206.      .                            iplapex,1,6)
  207.                 iincre=1
  208.                 iflagrec=1
  209.                 goto 100
  210.                endif
  211.              endif
  212.  
  213. C             if (iincre.ne.iincreold)
  214. C     .          write(*,9999)'CHANGED',IB,IGAU,iincre,nsub
  215.  
  216.              ratio = float(ntotiter)/float(nsub)
  217.              if (ratio.gt.NITMAX) then
  218.                iincren=max(nint(iincre/(ratio-4.D0)),1)
  219.                write(*,9999)'More iincre',IB,IGAU,iincre,iincren,ratio
  220.                iincre=iincren
  221.              else if ((ratio.lt.4.).and.(nsub.gt.1)) then
  222.                iincren=min(nint(iincre*(5.D0-ratio)),NMAXSSTEPS)
  223.                write(*,9999)'Less iincre',IB,IGAU,iincre,iincren,ratio
  224.                iincre=iincren
  225.              endif
  226.              VARF(nsubpos)  =nsub
  227.              VARF(nsubpos+1)=iincre
  228. 9998         format(1x,a10,1x,5I9)
  229. 9999         format(1x,a10,1x,4I9,2x,E10.4)
  230. ****************************************
  231. *  sigf = tensiones finales
  232.             MPTVAL=IVASTF
  233.             DO IC=1,NSTRS
  234.                MELVAL=MPTVAL.IVAL(IC)
  235.                MELVAL.VELCHE(IGAU,IB)=SIGF(IC)
  236.             enddo
  237. *  varf = variables internas finales
  238.             MPTVAL=IVARIF
  239.             DO IC=1,NVARI
  240.                MELVAL=MPTVAL.IVAL(IC)
  241.                MELVAL.VELCHE(IGAU,IB)=VARF(IC)
  242.             enddo
  243. *  defp = incremento de deformations plasticas
  244.             MPTVAL=IVADEP
  245.             DO IC=1,NSTRS
  246.                MELVAL=MPTVAL.IVAL(IC)
  247.                MELVAL.VELCHE(IGAU,IB)=DEFP(IC)
  248.             enddo
  249. c calcula la matriz b = BGENE y el jacobiano DJAC
  250.             XDPGE=0.D0
  251.             YDPGE=0.D0
  252.             DIM3=1.D0
  253.             CALL BMATST(IGAU,NBPTEL,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  254.      1                  MELE,MFR,NBNN,LRE,IFOUR,NSTRS,NIFOUR,DIM3,
  255.      2                  XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  256.             IF(abs(DJAC).LT.1.E-17) then
  257.                write(*,*)' Jacobiano cero, en elem', ib,' gauss',igau
  258.             endif
  259.             DJAC=ABS(DJAC)*MINTE.POIGAU(IGAU)
  260.             IF (IRIGE7.EQ.2)THEN
  261.                CALL BDBSTS(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  262.             ELSE
  263.                CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  264.             ENDIF
  265. ****************************************
  266. c  fin bucle puntos de gauss
  267. 1100  continue
  268. c guarda la matriz de rigidez elemental REL en XMATRI.RE
  269.          IF (IRIGE7.EQ.2)THEN
  270.             CALL REMPMS(REL,LRE,RE(1,1,ib))
  271.          ELSE
  272.             CALL REMPMT(REL,LRE,RE(1,1,ib))
  273.          ENDIF
  274. ****************************************
  275. c  fin bucle elementos
  276. 1000  continue
  277.       segdes,mcoord
  278. c desactivar segmentos de trabajo
  279.       SEGSUP WRK0,WRK1,WRK2
  280.       RETURN
  281.       END
  282.  
  283.  
  284.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales