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  25/02/21    21:18:41     12166          
  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. -INC TMPTVAL
  51.  
  52.       SEGMENT WRK0
  53.         REAL*8 XMAT(NMATT)
  54.       ENDSEGMENT
  55.       SEGMENT WRK1
  56.         REAL*8 DDHOOK(LHOOK,LHOOK)
  57.         REAL*8 SIG0(NSTRS)
  58.         REAL*8 DEPST(NSTRS)
  59.         REAL*8 DSIGT(NSTRS)
  60.         REAL*8 SIGF(NSTRS)
  61.         REAL*8 VAR0(NVARI)
  62.         REAL*8 VARF(NVARI)
  63.         REAL*8 DEFP(NSTRS)
  64.       ENDSEGMENT
  65.       SEGMENT WRK3
  66.         REAL*8 DDHOOK2(LHOOK,LHOOK)
  67.         REAL*8 SIGini(NSTRS)
  68.         REAL*8 DSIGTr(NSTRS)
  69.         REAL*8 VARini(NVARI)
  70.       ENDSEGMENT
  71.       SEGMENT WRK2
  72.         REAL*8 REL(LRE,LRE)
  73.         REAL*8 SHPWRK(6,NBNN)
  74.         REAL*8 BGENE(NSTRS,LRE)
  75.         REAL*8 XE(3,NBNN)
  76.       ENDSEGMENT
  77.       DIMENSION E(6,6)
  78.       call zero(E ,6,6 )
  79.       SEGINI WRK0,WRK1,WRK2,WRK3
  80. ****************************************
  81.       nescri   =0
  82.       nues     =6
  83.       if (inplas.eq.111) then
  84. c MODELE MRS_LADE
  85.          nmodel   =21
  86.          ndimv    =4
  87.          nsubpos  =5
  88.          if (NNUMER.eq.0) THEN
  89.            nnumer=3
  90.            deltax=2.D0**(int(log10(1.D-6)/log10(2.D0)))
  91.          endif
  92.       else if (inplas.eq.112) then
  93. c MODELE J2
  94.          nmodel   =1
  95.          ndimv    =2
  96.          nsubpos  =3
  97.       else if (inplas.eq.113) then
  98. c MODELE RH_COULOMB
  99.          nmodel   =2
  100.          ndimv    =2
  101.          nsubpos  =3
  102.       endif
  103.  
  104. ****************************************
  105. *  bucle elementos
  106.       SEGACT,MCOORD
  107.       DO 1000 IB=1,NBELEM
  108.        DO IA1=1,NBNN
  109.         JA=(IDIM+1)*(MELEME.NUM(IA1,IB)-1)
  110.         DO IA2=1,IDIM
  111.           wrk2.XE(IA2,IA1)=MCOORD.XCOOR(JA+IA2)
  112.         ENDDO
  113.         wrk2.XE(3,IA1)=0.D0
  114.        ENDDO
  115.        CALL ZERO(REL,LRE,LRE)
  116. ****************************************
  117. *  bucle puntos de gauss
  118.       DO 1100 IGAU=1,NBPTEL
  119. *  sig0 = tensiones iniciales
  120.             MPTVAL=IVASTR
  121.             DO IC=1,NSTRS
  122.                MELVAL=IVAL(IC)
  123.                IBMN=MIN(IB,VELCHE(/2))
  124.                IGMN=MIN(IGAU,VELCHE(/1))
  125.                SIG0(IC)=VELCHE(IGMN,IBMN)
  126.             enddo
  127. *  var0 = variables internas iniciales
  128.             MPTVAL=IVARI
  129.             DO IC=1,NVARI
  130.                MELVAL=IVAL(IC)
  131.                IBMN=MIN(IB,VELCHE(/2))
  132.                IGMN=MIN(IGAU,VELCHE(/1))
  133.                VAR0(IC)=VELCHE(IGMN,IBMN)
  134.             enddo
  135. *  depst = incremento de deformacion total
  136.             MPTVAL=IVADS
  137.             DO IC=1,NSTRS
  138.                MELVAL=IVAL(IC)
  139.                IBMN=MIN(IB,VELCHE(/2))
  140.                IGMN=MIN(IGAU,VELCHE(/1))
  141.                DEPST(IC)=VELCHE(IGMN,IBMN)
  142.             enddo
  143. *  xmat = caracteristicas materiales
  144.              MPTVAL=IVAMAT
  145.              DO IC=1,2
  146.                MELVAL=IVAL(IC)
  147.                IGMN=MIN(IGAU,VELCHE(/1))
  148.                IBMN=MIN(IB  ,VELCHE(/2))
  149.                XMAT(IC)=VELCHE(IGMN,IBMN)
  150.              ENDDO
  151.              XMAT(3)=0.D0
  152.              XMAT(4)=0.D0
  153.              DO IC=3,NMATT-5
  154.                MELVAL=IVAL(IC)
  155.                IGMN=MIN(IGAU,VELCHE(/1))
  156.                IBMN=MIN(IB  ,VELCHE(/2))
  157.                XMAT(IC+2)=VELCHE(IGMN,IBMN)
  158.              ENDDO
  159. ****************************************
  160.              call MatHok(E,6,NSTRS,1)
  161.              do i=1,NSTRS
  162.               r_z =0.D0
  163.               do j=1,NSTRS
  164.                r_z = r_z+E(i,j)*DEPST(j)
  165.               enddo
  166.               DSIGT(i)=r_z
  167.              enddo
  168.              iincre=nint(VAR0(nsubpos+1))
  169.              if (iincre.le.0) iincre=NMAXSSTEPS
  170.              iincreold = iincre
  171.              iincreold2 = iincre
  172.              iflagrec=0
  173. 100          continue
  174.              nsub=0
  175.                 call substep (SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,
  176.      .               DDHOOK,NSTRS,ndimv,LHOOK,
  177.      .               XMAT,KERRE,PRECIS,NITMAX,nescri,
  178.      .               nues,nmodel,NNUMER,DELTAX,NMAXSSTEPS,
  179.      .               nsub,ntotiter,iincre)
  180.  
  181. c numero de substeps hechos:   nsub
  182. c numero total de iteraciones: ntotiter
  183. c tamaño del ultimo step !!:   iincre
  184.  
  185.              if (kerre.eq.1) then
  186.                write(*,*)' Error tras substepping'
  187.                if ((inplas.eq.111).and.
  188.      .         ((nsub.ge.NMAXSSTEPS).or.(iflagrec.eq.1))) then
  189.                 write(*,9998)'STOP',IB,IGAU,iincre,nsub,ntotiter
  190.                 call DeterzonaMAC(sig0,4,var0,iplcon,iplcap,
  191.      .                            iplapex,1,6)
  192.                 do i=1,NSTRS
  193.                   DSIGT(i)=SIG0(i)+DSIGT(i)
  194.                 enddo
  195.                 call DeterzonaMAC(dsigt,4,var0,iplcon,iplcap,
  196.      .                            iplapex,1,6)
  197.                 iflagrec=0
  198.                 return
  199.                else
  200.                 write(*,9998)'Recompute',IB,IGAU,iincre,nsub,ntotiter
  201.                 call DeterzonaMAC(sig0,4,var0,iplcon,iplcap,
  202.      .                            iplapex,1,6)
  203.                 iincre=1
  204.                 iflagrec=1
  205.                 goto 100
  206.                endif
  207.              endif
  208.  
  209. C             if (iincre.ne.iincreold)
  210. C     .          write(*,9999)'CHANGED',IB,IGAU,iincre,nsub
  211.  
  212.              ratio = float(ntotiter)/float(nsub)
  213.              if (ratio.gt.NITMAX) then
  214.                iincren=max(nint(iincre/(ratio-4.D0)),1)
  215.                write(*,9999)'More iincre',IB,IGAU,iincre,iincren,ratio
  216.                iincre=iincren
  217.              else if ((ratio.lt.4.).and.(nsub.gt.1)) then
  218.                iincren=min(nint(iincre*(5.D0-ratio)),NMAXSSTEPS)
  219.                write(*,9999)'Less iincre',IB,IGAU,iincre,iincren,ratio
  220.                iincre=iincren
  221.              endif
  222.              VARF(nsubpos)  =nsub
  223.              VARF(nsubpos+1)=iincre
  224. 9998         format(1x,a10,1x,5I9)
  225. 9999         format(1x,a10,1x,4I9,2x,E10.4)
  226. ****************************************
  227. *  sigf = tensiones finales
  228.             MPTVAL=IVASTF
  229.             DO IC=1,NSTRS
  230.                MELVAL=MPTVAL.IVAL(IC)
  231.                MELVAL.VELCHE(IGAU,IB)=SIGF(IC)
  232.             enddo
  233. *  varf = variables internas finales
  234.             MPTVAL=IVARIF
  235.             DO IC=1,NVARI
  236.                MELVAL=MPTVAL.IVAL(IC)
  237.                MELVAL.VELCHE(IGAU,IB)=VARF(IC)
  238.             enddo
  239. *  defp = incremento de deformations plasticas
  240.             MPTVAL=IVADEP
  241.             DO IC=1,NSTRS
  242.                MELVAL=MPTVAL.IVAL(IC)
  243.                MELVAL.VELCHE(IGAU,IB)=DEFP(IC)
  244.             enddo
  245. c calcula la matriz b = BGENE y el jacobiano DJAC
  246.             XDPGE=0.D0
  247.             YDPGE=0.D0
  248.             DIM3=1.D0
  249.             CALL BMATST(IGAU,NBPTEL,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  250.      1                  MELE,MFR,NBNN,LRE,IFOUR,NSTRS,NIFOUR,DIM3,
  251.      2                  XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  252.             IF(abs(DJAC).LT.1.E-17) then
  253.                write(*,*)' Jacobiano cero, en elem', ib,' gauss',igau
  254.             endif
  255.             DJAC=ABS(DJAC)*MINTE.POIGAU(IGAU)
  256.             IF (IRIGE7.EQ.2)THEN
  257.                CALL BDBSTS(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  258.             ELSE
  259.                CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  260.             ENDIF
  261. ****************************************
  262. c  fin bucle puntos de gauss
  263. 1100  continue
  264. c guarda la matriz de rigidez elemental REL en XMATRI.RE
  265.          IF (IRIGE7.EQ.2)THEN
  266.             CALL REMPMS(REL,LRE,RE(1,1,ib))
  267.          ELSE
  268.             CALL REMPMT(REL,LRE,RE(1,1,ib))
  269.          ENDIF
  270. ****************************************
  271. c  fin bucle elementos
  272. 1000  continue
  273.       segdes,mcoord
  274. c desactivar segmentos de trabajo
  275.       SEGSUP WRK0,WRK1,WRK2
  276.  
  277.       RETURN
  278.       END
  279.  
  280.  
  281.  

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