Télécharger la plaquette Cast3M


fr en

Télécharger fluo3d.eso

Retour à la liste

Numérotation des lignes : 

fluo3d

  1. C FLUO3D    SOURCE    FD218221  24/02/07    21:15:12     11834          
  2.        SUBROUTINE FLUO3D(XMAT,NMAT,SIG0,SIGF,DEPST,NSTRS,VAR0,VARF,
  3.      # NVARI,TETA1,TETA2,DT,KERRE,MFR,IFOURB,ISTEP,EPST0,
  4.      # EPSTF,TREFB,NBVIA3d,INLVIA3d,NBNMAX3D,NBNB3D,IDIMB3D,XE3D)
  5.  
  6. c     A Sellier Nov 2023
  7.  
  8. C     MFR           =  NUMERO DE LA FORMULATION DE L'ELEMENT FINI
  9. C                   = 1       MASSIF
  10. C                   = 33      POREUX
  11. C     IFOU    INDICE DU TYPE DE PROBLEME                                     
  12. C            -1  DEFORMATIONS PLANES                                       
  13. C             0  AXISYMETRIQUE                                                                                     
  14. C             2  TRIDIMENSIONNEL 
  15.  
  16. C     ISTEP=0 : CALCUL LOCAL
  17. C     ISTEP=1 : PREPARATION DU 1ER PASSGE NON LOCAL
  18. C     ISTEP=2 : DERNIER PASSAGE NON LOCAL EFFECTUE
  19. C     ISTEP=3 : PASSAGE NON LOCAL INTERMEDIAIRE EN NON LOCAL ITERATIF
  20.  
  21. C     TABLES DE DIMENSION FIXE POUR RESOLUTION DES SYTEMES LINEAIRES 
  22.       IMPLICIT REAL*8 (A-H,O-Z)
  23.       IMPLICIT INTEGER (I-N)
  24.  
  25. C******** DECLARATION DES VARIABLES EXTERNES *************************** 
  26.       INTEGER NMAT,NVAR0,NVAR1,NVAR2,NVAR3,NVARI,NBVIA,ISTEP
  27.       INTEGER NSTRS,KERRE,MFR,IFOURB
  28.       REAL*8 XMAT(NMAT),SIG0(NSTRS),SIGF(NSTRS),DEPST(NSTRS)
  29.       REAL*8 EPST0(NSTRS),EPSTF(NSTRS)
  30.       REAL*8 VAR0(NVARI),VARF(NVARI)
  31.       REAL*8 DT,TETA1,TETA2,TREFB  
  32. C     LIGNE A INCLURE DANS LES MODELES UTILISANT LES NOEUDS     
  33.       INTEGER NBNMAX3D,NBNB3D,IDIMB3D
  34.       REAL*8  XE3D(3,NBNMAX3D)
  35. C     VARIABLE LOGIQUE POUR MATRICE INIT ISOTROPE
  36.       LOGICAL ISO,ORTHO
  37.       PARAMETER(ISO=.false.,ORTHO=.true.)      
  38.  
  39. c********DECLARATION DES VARIABLES LOCALES *****************************
  40.  
  41. c     nombre de parametre elastiques obligatoire en debut de xmat
  42.       integer NBELAS3D
  43. c     nombre de sous type de modele et de variable par tenseur (cf idvar4)
  44.       integer NSTYPE,NDTENS
  45.       parameter (NSTYPE=4,NDTENS=12)
  46. c     nombre de parametres scalaires par sous type de modele
  47.       integer VNMAT(NSTYPE) 
  48. c     nombre de vari scalaires par sous type de modele
  49.       integer VNVARI(NSTYPE,2)
  50.  
  51. c     declarations locales
  52. c     indicateur 1er pas
  53.       logical PPAS
  54. c     teneur en eau3d
  55.       real*8 vw0,vwf
  56. c     module 1er passage
  57.       real*8 E,nu,E1,nu12,k0,mu0,k1,mu1
  58. c     numero vari
  59.       integer ivar,numx,numk,numm,nx
  60. c     matrices de Hoocke base d orthotropie
  61.       real*8 raideuro66(6,6),souplesseo66(6,6),Po33(3,3),TPo33(3,3)
  62. c     matrices de Hoocke base fixe
  63.       real*8 raideurf66(6,6),souplessef66(6,6),Pf33(3,3),TPf33(3,3)
  64. c     matrices de Hoockebase quelconque     
  65.       real*8 raideurb66(6,6),souplesseb66(6,6),Pb33(3,3),TPb33(3,3)      
  66. c     contraintes initiales dans la matrice
  67.       real*8 sigm03(3),vsigm033(3,3),Tvsigm033(3,3)
  68.       real*8 dsigm06(6),dsigm16(6)
  69. c     invariant contraintes initiales
  70.       real*8 sigm0d3(3),devis0,tracs0
  71. c     contraintes effectives
  72.       real*8 sigeff6(6)
  73. c     influence de la temperature 
  74.       real*8 dtherm,kthermv,kthermp
  75. c     increment total de deformation mecanique
  76.       real*8 epst06(6),epstf6(6),deps6(6)
  77. c     influence de l eau capillaire et nano
  78.       real*8 keau,knanov,kmecap
  79. c     coeff de fluage de Maxwell
  80.       real*8 kflum
  81. c     consolidation et temps de maxwell
  82.       real*8 taumc3(3),taum,CC3(3)
  83. c     increment deformation totale
  84.       real*8 deps33(3,3),deps3(3),Vdeps33(3,3),TVdeps33(3,3)
  85. c     tenseur d orientations
  86.       real*8 O333(3,3,3),DX3(3),VDX33(3,3)
  87. c     increment de deformations elastiques et de contraintes
  88.       real*8 depse3(3),dsig3(3)
  89. c     contraintes
  90.       real*8 sigm06(6),sigmf6(6)
  91. c     increments de deformations anelastiques
  92.       real*8 depsx3(NSTYPE,3)
  93. c     coeff de fluage
  94.       real*8 cflux3(NSTYPE,3)
  95. c     def elastiques
  96.       real*8 epse3(3),Vepse33(3,3),TVepse33(3,3)
  97.  
  98.  
  99. C************* PARAMETRES POUR LES RENFORTS ****************************
  100. C-INC HNBRREN
  101. C     ADAPTE POUR FLUOR3D
  102.       PARAMETER(NB_RENF=0)
  103.       PARAMETER(NB_PARA_PAR_RENF=0)
  104.       PARAMETER(NB_PARA_RENF=0)
  105.       PARAMETER(NB_VARI_PAR_RENF=0)
  106.       PARAMETER(NB_VARI_RENF=0)
  107. c     declaration des renforts du fluendo3d si on veut les utiliser
  108. C-INC HDECREN
  109. C***********************************************************************
  110.  
  111.  
  112. C************** DECLARATIONS POUR LES FIBRES ROMAIN ********************
  113. c      declaration des fibres de romain gontero si on veut les utiliser
  114. C-INC HDECFIB
  115. C***********************************************************************
  116.  
  117.  
  118. C************** PARAMETRES POUR HELMHOLTZ ******************************
  119. c     lignes a inclure dans les modeles utilisant helmholtz
  120. c     recuperation des dimensions des tableaux pour helmholtz
  121. -INC HNBRHEL
  122. c     declaration des tableaux pour helmholtz
  123. -INC HDECHEL
  124. C c     recuperation des variables d helmholtz
  125. C -INC HMATHEL
  126. C c     attention il faut NVAR3 debut de la zone de Helmholtz dans les vari
  127. C       NVAR3=NVARI-(NB_VARI_RENF+NB_VARI_HELM)
  128. C       DO NL=1,NB_HELM
  129. C c       lecture des variable internes et rangements dans helm0(nl,ii)
  130. C c       et helm1(nl,ii) avec ii=1,nb_vari_par_helm
  131. C -INC HLVIHEL
  132. C       END DO
  133. C***********************************************************************
  134.  
  135.  
  136. c******recuperation des parametres pour les fibres si modele de fibre*** 
  137. C-INC HMATFIB
  138. c***********************************************************************
  139.  
  140.  
  141. c*************** recuperation des parametres pour les renforts *********
  142. c-INC HMATREN
  143. c***********************************************************************
  144.  
  145.  
  146. c*************** NOMBRE DE PARAMETRES PAR SOUS TYPE ********************
  147.  
  148. c     a actualiser en fonction du contenu de idvisc
  149. c     numero du sous type de modele  1   2   3   4   5   6  7  
  150. c     type de sous modele :          ELA,MAX,FLU,KEL,TRA,DP,CC 
  151.                          data VNMAT /8  ,6  ,4  ,2  /
  152. c                         ,5  ,6 ,3 /
  153.  
  154. c************** NOMBRE DE VARI ET TYPE DE VARI PAR SOUS TYPE ***********
  155.  
  156. c     nombre de variables scalaire par sous type
  157. c     numero du sous type de modele  1   2   3   4   5   6  7  
  158. c     type de sous modele :          ELA,MAX,FLU,KEL,TRA,DP,CC 
  159.       data (VNVARI(I,1),I=1,NSTYPE) /9  ,0  ,2  ,0 /
  160. c      ,3  ,2 ,3 /,
  161. c     nombre de variables tensorielles par sous type
  162. c     numero du sous type de modele  1   2   3   4   5   6  7  
  163. c     type de sous modele :          ELA,MAX,FLU,KEL,TRA,DP,CC 
  164.      #     (VNVARI(I,2),I=1,NSTYPE) /1  ,1  ,1  ,1 /
  165. c     ,1  ,1 ,1 /
  166.  
  167. c      print*,'debut de FLUOR3D'
  168. c      verification des varf
  169. C      do i=1,nvari
  170. c         print*,'var0',10,'=',var0(10)
  171. C      end do
  172. c      read*
  173.  
  174.  
  175. c******* INITIALISATIONS ***********************************************
  176.  
  177. c     indicateur d erreur     
  178.       KERRE=0 
  179. c     dimension de la zone des parametres elastiques dans xmat
  180.       if(mfr.eq.1)then
  181. c         milieu elastique
  182.           if(iso) then
  183.             print*,'Verifier ces valeurs dans fluor3d'
  184.             NBELAS3D=4
  185. c           YOUN NU RHO ALP
  186.             NBFAC3D=3
  187. c           VISQ TREF TALP            
  188.             kerre=1
  189.             return
  190.           else if (ortho) then
  191.             NBELAS3D=15
  192. c           E1 E2 E3 nu12 n23 nu 13 G12 G23 G13 V1X V1Y V1Z V2X V2Y V2Z            
  193.             NBFAC3D=6
  194. c           RHO ALP1 ALP2 ALP3 TREF TALP          
  195.           else
  196.             print*,'Erreur formulation 0 dans fluor3d.eso'
  197.             kerre=1
  198.             return
  199.           end if
  200.       else if (mfr.eq.33) then
  201. c         milieu poro elastique
  202.           print*,'Erreur formulation 1 dans fluor3d.eso'
  203.           kerre=1
  204.           return
  205.       else
  206. c       cas imprevu
  207.         print*,'Erreur formulation 2 dans fluor3d.eso'
  208.         kerre=1
  209.         return
  210.       end if
  211.  
  212. c     copie des var0 sur les varf avec dilution des vari scalaires
  213.       call init3d(xmat,nmat,vnmat,nstype,nbelas3d,var0,varf,
  214.      # nvari,vnvari,ndtens,KERRE)
  215. c      print*, 'varf apres init'
  216. c      print*,'varf',10,'=',varf(10)
  217.  
  218. c     initialisation de l indicateur de premier passage dans le modele
  219.       if (var0(1).ne.1.) then
  220.          ppas=.true.
  221.       else
  222.          ppas=.false.
  223.       end if 
  224. c     traitements particuliers lors du premier passage
  225.       if(ppas) then
  226. c         controle des dimensions des listes de parametres 
  227.           ntest=nbelas3d
  228.           do i=1,NSTYPE
  229.             ntest=ntest+VNMAT(i)
  230.           end do
  231. c         on a supprimer les parametres de Helmholtz pour ne pas avoir
  232. c         de pb de lecture des donnees          
  233.           ntest=ntest+0*NB_PARA_HELM+NB_PARA_RENF+NBFAC3D
  234.           if(ntest.ne.nmat) then
  235.              print*,'ERREUR nmat dans FLUOR3D.ESO'
  236.              print*,'nmat',nmat
  237.              print*,'ntest',ntest
  238.              KERRE=1
  239.              do i=1,nmat
  240.                  print*,'xmat(',i,')=',xmat(i)
  241.              end do
  242.              return
  243.           end if
  244. c         controle des dimensions des listes de variables internes
  245.           ntest=0
  246.           do i=1,NSTYPE
  247.             ntest=ntest+VNvari(i,1)+VNvari(i,2)*ndtens
  248.           end do
  249.           ntest=ntest+NB_VARI_HELM+NB_VARI_PAR_RENF
  250.           if(ntest.ne.nvari) then
  251.              print*,'ERREUR nvari dans FLUOR3D.ESO'
  252.              print*,'nvari',nvari
  253.              print*,'ntest',ntest
  254.              do i=1,nvari
  255.                 print*,'var0(',i,')=',var0(i)
  256.              end do          
  257.              KERRE=1
  258.              return
  259.           end if
  260.           if(iso) then
  261. c           initialisation des module dans les vari pour le suivi d hydratation
  262.             call xmat3d(E,xmat,nmat,vnmat,nstype,nbelas3d,0,1)
  263.             call xmat3d(nu,xmat,nmat,vnmat,nstype,nbelas3d,0,2)
  264.             k1=E/(3.d0*(1.d0-2.d0*nu))
  265.             mu1=E/(2.d0*(1.d0+nu))
  266. c           print*,E,nu,k1,mu1
  267.             call xvar3d(k0,numk,var0,nvari,vnvari,nstype,ndtens,1,7)
  268.             call xvar3d(mu0,numm,var0,nvari,vnvari,nstype,ndtens,1,8)
  269.             var0(numk)=k1
  270.             var0(numm)=mu1
  271.           else if (ortho) then
  272. c           initialisation des module dans les vari pour le suivi d hydratation
  273.             call xmat3d(E1,xmat,nmat,vnmat,nstype,nbelas3d,0,1)
  274.             call xmat3d(nu12,xmat,nmat,vnmat,nstype,nbelas3d,0,4)
  275.             k1=E1/(3.d0*(1.d0-2.d0*nu12))
  276.             mu1=E1/(2.d0*(1.d0+nu12))
  277. c           print*,E,nu,k1,mu1
  278.             call xvar3d(k0,numk,var0,nvari,vnvari,nstype,ndtens,1,7)
  279.             call xvar3d(mu0,numm,var0,nvari,vnvari,nstype,ndtens,1,8)
  280.             var0(numk)=k1
  281.             var0(numm)=mu1
  282.           else
  283.             print*,'Erreur formulation 3 dans fluor3d.eso'
  284.             kerre=1
  285.             return
  286.           end if
  287.       end if
  288.  
  289. c******* MATRICE DE RIGIDITE EN BASE D ORTHTROPIE et FIXE **************
  290.  
  291. c     matrice de Hoocke en base fixe
  292.       if(iso)then
  293. c        matrices de raideur et de souplesse en base fixe cas isotrope
  294.          call hook3d(iso,xmat,nmat,nbelas3d,KERRE,
  295.      #   raideurf66,souplessef66)
  296.       else if(ortho) then
  297. c       matrice en base d orthotropie
  298.         call rior3d(xmat,nmat,nbelas,ierr1,
  299.      #  raideuro66,souplesseo66,Po33,TPo33)
  300. c       matrice de rigidite en base fixe
  301.         do i=1,3
  302.             do j=1,3
  303.                 if(i.eq.j) then
  304.                     Pf33(i,j)=1.d0
  305.                 else
  306.                     Pf33(i,j)=0.d0
  307.                 end if
  308.             end do
  309.         end do
  310.         call traps1(TPf33,Pf33,3)
  311.         call chre66(raideuro66,raideurf66,Po33,TPo33,Pf33,TPf33)
  312.         call chre66(souplesseo66,souplessef66,Po33,TPo33,Pf33,TPf33)
  313.       else
  314.          print*,'Erreur 4 fluor3d formulation imprevue'
  315.       end if
  316.  
  317. C******* TENEUR EN EAU ************************************************* 
  318.  
  319.       if(mfr.ne.33) then
  320. c       actualisation de la teneur en eau debut de pas pour le fluage
  321. c       et la capillarite
  322.         call xvar3d(vw0,numx,var0,nvari,vnvari,nstype,ndtens,1,2)
  323.         call xmat3d(vwf,xmat,nmat,vnmat,nstype,nbelas3d,1,3)
  324.         if (ppas) then
  325. c           on initialise la teneur en eau pour le 1er pas
  326.             var0(numx)=vwf
  327.             vw0=vwf
  328.         end if
  329.       else
  330.         call xvar3d(vw0,numx,var0,nvari,vnvari,nstype,ndtens,1,2)
  331.         print*,'ERREUR2 Implementation poreux / calcul vw ds FLUOR3D'
  332.         print*,'Actualiser la vari numro:', numx,' avec vwf'
  333.         KERRE=1
  334.         return
  335.       end if
  336. c     stockage pour le prochain pas
  337.       varf(numx)=vwf
  338.  
  339. c******* CONTRAINTES INITIALES *****************************************
  340.  
  341. c     contraintes principales en fonction des deformations elastiques
  342. c     calcul en base fixe
  343.       call sigp3d(nstype,var0,nvari,vnvari,ndtens,iso,raideurf66,
  344.      # sigm03,vsigm033)
  345. c     matrice de passage inverse     
  346.       call traps1(Tvsigm033,vsigm033,3)
  347.  
  348. c      print*,'FLUOR3D sigm03 av relaxation',sigm03
  349. c      print*,'FLUOR3D vsigm033'
  350. c      call afic33(vsigm033)
  351.  
  352. c     relaxation de la nouvelle contrainte principale en cas 
  353. c     d augmentation des modules et actualisation des def visco elastiques
  354.       if(iso) then 
  355.          call hydr3d(xmat,nmat,vnmat,nstype,nbelas3d,var0,varf,
  356.      #   nvari,vnvari,ndtens,iso,sigm03,souplessef66)
  357.       else if (ortho) then
  358. c        matrice de souplesse en base principale des contraintes
  359.          call chre66(souplesseo66,souplessef66,Po33,TPo33,
  360.      #   vsigm033,Tvsigm033)      
  361.          call hydr3d(xmat,nmat,vnmat,nstype,nbelas3d,var0,varf,
  362.      #   nvari,vnvari,ndtens,iso,sigm03,souplessef66)     
  363.       else
  364.          print*,'Erreur 5 fluor3d formulation imprevue'
  365.       end if
  366.  
  367. c      print*,'FLUOR3D sigm03 apres relaxation chimique',sigm03
  368.  
  369. c     ** 1-1 actualisation des parametres de fluage ********************
  370.  
  371. c     prise en compte de la temperature
  372.       call ther3d(xmat,nmat,vnmat,nstype,var0,varf,nvari,vnvari,
  373.      # ndtens,nbelas3d,teta1,teta2,TREFB,dtherm,kthermv,kthermp)
  374.  
  375. c     prise en compte de l eau capillaire
  376.       call eau3d(xmat,nmat,vnmat,nstype,var0,varf,nvari,vnvari,
  377.      # ndtens,nbelas3d,teta1,teta2,TREFB,mfr,keau)
  378.  
  379. c     prise en compte de la surpression dans la nanoporosité
  380.       call nano3d(xmat,nmat,vnmat,nstype,var0,varf,nvari,vnvari,
  381.      # ndtens,nbelas3d,teta1,teta2,TREFB,ppas,dt,kthermv,knanov)
  382.  
  383. c     Amplification non lineaire du fluage entre Rc/3 et Rc
  384.       call kmkf3d(xmat,nmat,vnmat,nstype,nbelas3d,sigm03,kmecap)
  385.  
  386. c     ** 1-2 relaxation visco elastique a deformation constante ********
  387.  
  388. c     deformations elastiques initiales principales
  389.       call tvar3d(epse3,Vepse33,nE,varf,nvari,vnvari,nstype,ndtens,1,1)
  390.       call traps1(TVepse33,Vepse33,3)
  391.  
  392. c     coeff de fluage dans les directions elastiques principales initiales      
  393.       call cofl3d(xmat,nmat,vnmat,nstype,var0,varf,nvari,vnvari,
  394.      # ndtens,nbelas3d,Vepse33,dt,kthermv,kthermp,kmecap,keau,
  395.      # knanov,cflux3)
  396. C       print*,'FLUOR3D avant rela coeff de fluage '
  397. C       do ityp=1,4
  398. C         do j=1,3
  399. C             print*,ityp,j,cflux3(ityp,j)
  400. C         end do
  401. C       end do
  402.  
  403. c     raideur en base principale des deformations elastiques
  404.       call chre66(raideuro66,raideurb66,Po33,TPo33,Vepse33,TVepse33)
  405. c     relaxation visco elastique
  406. c      print*, 'varf avant relaxation'
  407.       call rela3d(xmat,nmat,vnmat,nstype,nbelas3d,var0,varf,nvari,
  408.      # vnvari,ndtens,KERRE,iso,cflux3,raideurb66,sigm03,vsigm033)
  409.  
  410. c     expression de sigm0 en base fixe
  411.       call orie3d(vsigm033,O333)
  412.       do i=1,6
  413.         sigm06(i)=0.d0
  414.       end do
  415. c      print*,'aff0 ds FLUOR3D',sigm06,sigm03,O333
  416.       call incv3d(sigm06,sigm03,O333)
  417. c      print*,'FLUOR3D sigm03 ap relaxation des contraintes init',sigm03
  418. c      read*
  419. c      print*, 'varf apres reeevaluation contrainte 1'
  420. c      print*,'varf',10,'=',varf(10)
  421.  
  422.  
  423. c******* INCREMENT TOTAL DE DEFORMATION MECANIQUE **********************
  424.  
  425. c     chargement increment de deformation imposee et deformation finale
  426. c     remarque 4-5-6 sont des gama jusqu ici, ensuite des epsilons
  427.       if(nstrs.lt.6) then
  428.          do i=1,nstrs
  429.              deps6(i)=DEPST(i)
  430.              epstf6(i)=epstf(i)
  431.              epst06(i)=epst0(i)             
  432.          end do
  433.          do i=nstrs+1,6
  434.              deps6(i)=0.d0
  435.              epstf6(i)=0.d0
  436.              epst06(i)=0.d0
  437.          end do
  438.       else
  439.          do i=1,6
  440.              deps6(i)=DEPST(i)
  441.              epstf6(i)=epstf(i)
  442.              epst06(i)=epst0(i)
  443.          end do      
  444.       end if
  445. c     passage gama en epsilon
  446.       do i=4,6
  447.          deps6(i)=0.5d0*deps6(i)
  448.          epstf6(i)=0.5d0*epstf6(i)
  449.          epst06(i)=0.5d0*epst06(i)         
  450.       end do
  451.  
  452. c******* TIR VISCO ELASTIQUE *******************************************
  453.  
  454. c     diagonalisation du tenseur des increments de deformation
  455.       call x6x33(deps6,deps33)
  456. c     valeurs principales des increments
  457.       call b3_v33(deps33,deps3,Vdeps33)
  458. c     matrice de passage inverse      
  459.       call traps1(TVdeps33,Vdeps33,3)
  460. c     tenseurs d orientations des increments
  461.       call orie3d(Vdeps33,O333)
  462. c      print*,'aff1 cm3d',deps33,deps3,Vdeps33
  463.  
  464. c     coeff visco elastique dans la base principele de l increment
  465.       call cofl3d(xmat,nmat,vnmat,nstype,var0,varf,nvari,vnvari,
  466.      # ndtens,nbelas3d,Vdeps33,dt,kthermv,kthermp,kmecap,keau,
  467.      # knanov,cflux3)
  468. C       print*,'aff2 cm3d'
  469. C       do ityp=1,4
  470. C         do j=1,3
  471. C             print*,ityp,j,cflux3(ityp,j)
  472. C         end do
  473. C       end do
  474. C       read*
  475.  
  476. c     resolution visco elastique en base principales
  477.       do i=1,3
  478. c        deformation elastique (ityp=1)
  479.          depsx3(1,i)=deps3(i)/(1.d0+cflux3(1,i))
  480. c        deformations visqueuses (itype=2,3,4)
  481.          do ityp=2,4
  482.             depsx3(ityp,i)=depsx3(1,i)*cflux3(ityp,i)
  483.          end do
  484. c        deformations plastiques (itype=5,..,nstype)
  485.          do ityp=5,nstype
  486.             depsx3(ityp,i)=0.d0
  487.          end do
  488.       end do
  489. c     mise a jour des increments de deformation visco elastiques
  490.       do ityp=1,4
  491.         do i=1,3
  492.             dx3(i)=depsx3(ityp,i)
  493.         end do
  494. c        print*,'info envoyee a majt3d',ityp,1
  495. c        print*,'valeurs',DX3
  496. c        print*,'orientatio',O333
  497.         call majt3d(DX3,O333,varf,nvari,vnvari,nstype,
  498.      #  ndtens,ityp,1)
  499.       end do
  500. c      print*, 'varf apres increment visco elastique'
  501. c      print*,'varf',10,'=',varf(10)
  502. c     increments de contraintes
  503.       if(iso) then
  504.         do i=1,3
  505.             dsig3(i)=0.d0
  506.             do j=1,3
  507.                 dsig3(i)=dsig3(i)+raideur66f(i,j)*depsx3(1,j)
  508.             end do
  509.         end do
  510. c       nouvelle valeur des contraintes
  511.         do i=1,6
  512.             sigmf6(i)=sigm06(i)
  513.         end do
  514.         call incv3d(sigmf6,dsig3,O333)          
  515.       else 
  516. c        print*,'base des increments deps'
  517. c        call afic33(Vdeps33)      
  518. c       passage matrice de raideur base principale de l increment
  519.         call chre66(raideuro66,raideurb66,Po33,TPo33,Vdeps33,TVdeps33)
  520. c       calcul des 6 increments de contraintes en fonction des 3 depse
  521. C         print*,'raideuro'
  522. C         call afic66(raideuro66)
  523. C         print*,'raideurb'
  524. C         call afic66(raideurb66)        
  525. C         print*,'depse'
  526. C         do i=1,3
  527. C             print*,'depse(',i,')=',depsx3(1,i)
  528. C         end do
  529.         do i=1,6
  530.             dsigm16(i)=0.d0
  531.             do j=1,3
  532.                 dsigm16(i)=dsigm16(i)+raideurb66(i,j)*depsx3(1,j)
  533.             end do
  534.         end do 
  535. c       retour de  l increment de contrainte en base fixe
  536.         call chrep6(dsigm16,TVdeps33,.false.,dsigm06)
  537.         do i=1,6
  538.             sigmf6(i)=sigm06(i)+dsigm06(i)
  539. c            print*,'fluo3d sigmf(',i,')=',sigmf6(i)
  540.         end do   
  541. c        read*        
  542.       end if
  543.  
  544.  
  545. c     print*,'aff3 FLUOR3D apres tir visco elastique sigmf6',sigmf6
  546. c     print*, 'varf apres increment contrainte visco elastique'
  547. c     print*,'varf',10,'=',varf(10)
  548.  
  549. c******* EVALUATION DES CRITERES ***************************************
  550.  
  551. c     chargement des tenseurs de plasticité pour les ecrouissages
  552. c      do ityp=5,nstype
  553. c        call tvar3d(dx3,vdx33,nx,var0,nvari,vnvari,nstype,ndtens,ityp,1)        
  554. c      end do
  555.  
  556. c     *** re-mise a zero de tous les increments de deformation *********
  557.       do ityp=1,nstype
  558.         do i=1,3
  559.             depsx3(ityp,i)=0.d0
  560.         end do
  561.       end do
  562.  
  563. c     *** evaluation et tri des criteres actifs ************************
  564.       na=0
  565.  
  566. c     *** gestion de l ecoulement plastique ****************************
  567.       if(na.ne.0) then
  568. c       *** ecoulement plastique ***************************************
  569.         print*,'Ecoulement plastique'
  570.  
  571. c       *** mise a jour des deformations *******************************
  572.         do ityp=1,nstype
  573.             do i=1,3
  574.                 dx3(j)=depsx3(ityp,i)
  575.             end do
  576.             call majt3d(dx3,O333,varf,nvari,vnvari,nstype,
  577.      #      ndtens,ityp,1)
  578.         end do
  579.       end if
  580. c     print*,'varf apres plasticite'
  581. c     print*,'varf',10,'=',varf(10)
  582.  
  583. c****** FIN DE L ECOULEMENT PLASTIQUE **********************************
  584.  
  585. c****** TRANSFERT DES CONTRAINTES VERS LES POINTS DE GAUSS *************
  586.       do i=1,nstrs
  587.              sigf(i)=sigmf6(i)
  588. c             print*,'sigf(',i,')=',sigf(i)
  589.       end do 
  590. c      read*
  591.  
  592.  
  593. c     indicateur de fin de 1er pas 
  594.       if(ppas.and.((istep.eq.2).or.(istep.eq.0))) then     
  595.              varf(1)=1.d0
  596.       else
  597.              if(ppas) then
  598.                  varf(1)=0.d0
  599.              else
  600.                  varf(1)=var0(1)
  601.              end if
  602.       end if
  603.  
  604. c***********************************************************************
  605. c     VARIABLES INTERNES A ACTUALISER POUR LES FORMULATIONS DE HELMHOLTZ
  606. C***********************************************************************
  607. c     sauvegarde des vari de helmholtz HELM1(NL,ii=1..NBR_VARI_HELM) 
  608. C       do NL=1,NB_HELM
  609. C -INC HEVIHEL   
  610. C       end do
  611. c      print*,'fin de FLUOR3D'
  612. c      verification des varf
  613. C       do i=1,nvari
  614. c         print*,'varf',10,'=',varf(10)
  615. C       end do
  616. c       read*
  617.  
  618.       return
  619.       end
  620. c     fin         
  621. c*********************************************************************** 
  622.  
  623.  
  624.  
  625.  
  626.  

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