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

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