Télécharger la plaquette Cast3M


fr en

Télécharger sicsic.eso

Retour à la liste

Numérotation des lignes : 

sicsic

  1. C SICSIC    SOURCE    PV        22/04/27    21:15:10     11355          
  2.       SUBROUTINE SICSIC(WRK0,WRK1,WRK22,WRK5,WTRAV,CMATE,N2EL,
  3.      &                 N2PTEL,IB,IGAU,EPAIST,NVARI,NBPGAU,MELE,NPINT,
  4.      &                   SECT,LHOOK,CRIGI,NMATT,ISTEP,KERRE)
  5. C
  6. C
  7. C
  8. C     variables en entree
  9. C
  10. C     WRK0,KRK1,WRK5  pointeurs sur des segments de travail
  11. C
  12. C
  13. C     WRK0:
  14. C            XMAT(NMATT): tableau composantes materiaux
  15. C
  16. C     WRK1:
  17. C            SIG0(NSTRS) : contraintes au debut du pas
  18. C            VAR0(NVARI) : variables internes au debut du pas
  19. C            DEPST(NSTRS): increment de deformation totale
  20. C
  21. C     WRK22:
  22. C            XXE: coordonnees de l'element en double precison
  23. C
  24. C     WTRAV:
  25. C            TXR: cosinus directeurs des axes locaux de l'element massif
  26. C
  27. C
  28. C     WRK5:
  29. C
  30. C
  31. C
  32. C     NSTRS      nombre de composantes dans les vecteurs des contraintes
  33. C                                        et les vecteurs des deformations
  34. C
  35. C     NVARI      nombre de variables internes (doit etre egal a 3)
  36. C
  37. C     NMATT      nombre de constantes du materiau
  38. C
  39. C
  40. C
  41. C     variables en sortie
  42. C
  43. C     VARF      variables internes finales dans WRK0
  44. C
  45. C     SIGF      contraintes finales dans WRK0
  46. C
  47.       IMPLICIT INTEGER(I-N)
  48.       IMPLICIT REAL*8(A-H,O-Z)
  49.  
  50. -INC PPARAM
  51. -INC CCOPTIO
  52. -INC CCREEL
  53. -INC CECOU
  54. *
  55.       SEGMENT WRK0
  56.         REAL*8 XMAT(NMATT)
  57.       ENDSEGMENT
  58. *
  59.       SEGMENT WRK1
  60.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  61.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  62.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  63.       ENDSEGMENT
  64. *
  65.       SEGMENT WRK22
  66.       REAL*8 XXE(3,NBNN)
  67.       ENDSEGMENT
  68. *
  69.       SEGMENT WRK5
  70.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  71.       ENDSEGMENT
  72.       SEGMENT WRK6
  73.         REAL*8 SIG0S(NSTRS),DEPSTS(NSTRS)
  74.       END SEGMENT
  75. *
  76.       SEGMENT WTRAV
  77.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  78.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  79.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  80.         REAL*8 XLOC(3,3),XGLOB(3,3)
  81.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  82.       ENDSEGMENT
  83. *
  84.       CHARACTER*8 CMATE
  85.       INTEGER NSTRS,NVARI,NMATT
  86.       INTEGER KCAS,IRTD,ISTRS,KERRE,MFR
  87.  
  88.       REAL*8 IDAUX(6,6)
  89.       REAL*8 DOR1(3), DOR2(3), DOR3(3)
  90.       REAL*8 MORTH (3,3), IORTH (3,3), AEQ (3,3)
  91.       REAL*8 H1 (6,6), H2(6,6), H3(6,6)
  92.       REAL*8 H01 (6,6), H02(6,6), H03(6,6)
  93.       REAL*8 K01 (6,6), K02(6,6), K03(6,6), KW(6,6)
  94.       REAL*8 KEFF1(6,6), KEFF2(6,6), KEFF3(6,6)
  95.       REAL*8 RIG0 (6,6), CED0 (6,6)
  96.       REAL*8 SORTH(6), SIG0V(6), SIGFV(6),
  97.      &       DEFI(6), DEPSTV(6), DORTH(6)
  98.       REAL*8 VARTMP
  99.       INTEGER HCLO1, HCLO2, HCLO3
  100.       REAL*8 crigi(12)
  101.  
  102.  
  103.       DATA H1
  104.      &    /1.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  105.      &     0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  106.      &     0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  107.      &     0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  108.      &     0.0, 0.0, 0.0, 0.0, 0.7, 0.0,
  109.      &     0.0, 0.0, 0.0, 0.0, 0.0, 0.7/
  110.  
  111.       DATA H2
  112.      &    /0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  113.      &     0.0, 1.0, 0.0, 0.0, 0.0, 0.0,
  114.      &     0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  115.      &     0.0, 0.0, 0.0, 0.7, 0.0, 0.0,
  116.      &     0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  117.      &     0.0, 0.0, 0.0, 0.0, 0.0, 0.7/
  118. *
  119.       DATA H3
  120.      &    /0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  121.      &     0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
  122.      &     0.0, 0.0, 1.0, 0.0, 0.0, 0.0,
  123.      &     0.0, 0.0, 0.0, 0.7, 0.0, 0.0,
  124.      &     0.0, 0.0, 0.0, 0.0, 0.7, 0.0,
  125.      &     0.0, 0.0, 0.0, 0.0, 0.0, 0.0/
  126. *
  127.       DATA AEQ
  128.      &    /1.0, 0.0, 0.0,
  129.      &     0.0, 1.0, 0.0,
  130.      &     0.0, 0.0, 1.0/
  131. *
  132. *    PHENOMENOLOGICAL COEFFICIENTS
  133. *
  134. * deactivation parameter (scalars)
  135.       REAL*8 ETADS
  136.       DATA ETADS /1/
  137. * closure stress
  138. *      REAL*8 SIGCLO (NSTRSS)
  139. *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  140. *ON NE LE PREND PAS EN COMPTE!!!!
  141. *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  142.  
  143.  
  144.  
  145.  
  146. * scalar damage law parameters
  147.       REAL*8 G1DC, G1Y0, G1YC, G1P
  148.       REAL*8 G2DC, G2Y0, G2YC, G2P
  149.       REAL*8 G3DC, G3Y0, G3YC, G3P
  150.  
  151. * Passes comme param. materiau
  152. *      DATA G1DC, G1Y0, G1YC, G1P
  153. *     &    / 0.6,  130.0,  400.0, 1.0/
  154. *      DATA G2DC, G2Y0, G2YC, G2P
  155. *     &    / 0.6,  130.0,  400.0, 1.0/
  156. *      DATA G3DC, G3Y0, G3YC, G3P
  157. *     &    / 0.6,  130.0,  400.0, 1.0/
  158.  
  159. * scalar damage indicators
  160.       REAL*8 DOM1, DOM2, DOM3
  161.       REAL*8 YGR1, YGR2, YGR3, YW(6)
  162.       REAL*8 YEQ1, YEQ2, YEQ3
  163.  
  164. ***** INITIALIZATION VARIABLES
  165.  
  166.  
  167.  
  168. * Proprietes materiau
  169.        YG1   = XMAT(1)
  170.        YG2   = XMAT(2)
  171.        YG3   = XMAT(3)
  172.        XNU12 = XMAT(4)
  173.        XNU23 = XMAT(5)
  174.        XNU13 = XMAT(6)
  175.        G12   = XMAT(7)
  176.        G23   = XMAT(8)
  177.        G13   = XMAT(9)
  178.  
  179.  
  180.        G1DC  = XMAT(16)
  181.        G1Y0  = XMAT(17)
  182.        G1YC  = XMAT(18)
  183.        G1P   = XMAT(19)
  184.        G2DC  = XMAT(20)
  185.        G2Y0  = XMAT(21)
  186.        G2YC  = XMAT(22)
  187.        G2P   = XMAT(23)
  188.        G3DC  = XMAT(24)
  189.        G3Y0  = XMAT(25)
  190.        G3YC  = XMAT(26)
  191.        G3P   = XMAT(27)
  192.  
  193.  
  194.  
  195.        H1(5,5)= XMAT(29)
  196.        H3(5,5)= XMAT(29)
  197.  
  198.        H1(6,6)= XMAT(30)
  199.        H2(6,6)= XMAT(30)
  200.  
  201.        H2(4,4)= XMAT(28)
  202.        H3(4,4)= XMAT(28)
  203.  
  204.        AEQ(1,2)= XMAT(35)
  205.        AEQ(2,1)= XMAT(35)
  206.  
  207.        AEQ(1,3)= XMAT(37)
  208.        AEQ(3,1)= XMAT(37)
  209.  
  210.        AEQ(2,3)= XMAT(36)
  211.        AEQ(3,2)= XMAT(36)
  212.  
  213.  
  214. * Pour debougage
  215.       PARAM=0
  216.  
  217.  
  218. * Variables internes du modele
  219.       DOM1=VAR0(2)
  220.       DOM2=VAR0(3)
  221.       DOM3=VAR0(4)
  222.  
  223.  
  224. * Mise a zero des matrices
  225.       CALL ZERO (RIG0,6,6)
  226.       CALL ZERO (CED0,6,6)
  227.       CALL ZERO (DEFI,6,1)
  228.  
  229.  
  230. ****** CALCUL DE LA DEFORMATION INITIALE A PARTIR
  231. ****** DES CONTRAINTES INITIALES
  232.  
  233.  
  234.  
  235. **********Debougage
  236.       IF (PARAM.EQ.1) THEN
  237.          WRITE(IOIMP,66770) IB,IGAU
  238. 66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  239.  
  240.          WRITE (IOIMP,*) 'Increment des deformations '
  241.          WRITE (IOIMP,99999) (DEPST(ILOOP), ILOOP=1,6)
  242.  
  243.          WRITE (IOIMP,*) 'Contraintes au debut de l''iteration'
  244.          WRITE (IOIMP,99999) (SIG0(ILOOP), ILOOP=1,6)
  245.       ENDIF
  246. **********Debougage
  247.  
  248.  
  249. * Controle si il faut calculer la matrice de hook
  250.  
  251.  
  252.       IF (IB.EQ.1.AND.IGAU.EQ.1) THEN
  253.          GOTO 100
  254.  
  255.       ELSEIF (N2PTEL.EQ.1.AND.N2EL.EQ.1) THEN
  256.          GOTO 200
  257.  
  258.       ELSEIF (N2PTEL.EQ.1.AND.N2EL.NE.1)  THEN
  259.          IF (IGAU.EQ.1) THEN
  260.             GOTO 100
  261.          ELSE
  262.             GOTO 200
  263.          ENDIF
  264.  
  265.       ELSE
  266.          GOTO 100
  267.       ENDIF
  268.  
  269.  
  270. * Calcul de la matrice de hook pour un materiau orthotrope
  271. 100   CONTINUE
  272. *      WRITE (IOIMP,*) 'Calcul de la matrice de Hook, CMATE=', CMATE
  273.  
  274.       IPERR=1
  275.       CALL ZERO (DDAUX,LHOOK,LHOOK)
  276.  
  277.  
  278.  
  279.  
  280.       XNU21=(YG2/YG1)*XNU12
  281.       XNU32=(YG3/YG2)*XNU23
  282.       XNU31=(YG3/YG1)*XNU13
  283.       AUX=(1.D0-XNU12*XNU21-XNU23*XNU32-XNU13*XNU31
  284.      &    -2.D0*XNU21*XNU32*XNU13)
  285.       AUX1=AUX/YG1
  286.       AUX2=AUX/YG2
  287.       AUX3=AUX/YG3
  288.  
  289.  
  290.       DDAUX(1,1)=(1.D0-XNU23*XNU32)/AUX1
  291.       DDAUX(1,2)=(XNU21+XNU31*XNU23)/AUX1
  292.       DDAUX(2,1)=DDAUX(1,2)
  293.       DDAUX(1,3)=(XNU31+XNU21*XNU32)/AUX1
  294.       DDAUX(3,1)=DDAUX(1,3)
  295.       DDAUX(2,2)=(1.D0-XNU13*XNU31)/AUX2
  296.       DDAUX(2,3)=(XNU32+XNU12*XNU31)/AUX2
  297.       DDAUX(3,2)=DDAUX(2,3)
  298.       DDAUX(3,3)=(1.D0-XNU12*XNU21)/AUX3
  299.       DDAUX(4,4)=G23
  300.       DDAUX(5,5)=G13
  301.       DDAUX(6,6)=G12
  302.  
  303. *      WRITE (IOIMP,*) 'Valeurs calculees:'
  304. *      DO 110 ILOOP= 1,LHOOK
  305. *         WRITE (IOIMP, 99999 ) (DDAUX (ILOOP,J), J=1,LHOOK)
  306. *110   CONTINUE
  307.  
  308. * On recopie la matrice de hook pour l'inversee
  309. 200   DO  ILOOP=1,LHOOK
  310.          DO  JLOOP=1,LHOOK
  311.             IDAUX(ILOOP,JLOOP)= DDAUX(ILOOP,JLOOP)
  312.          enddo
  313.       enddo
  314.  
  315.  
  316.  
  317. * Inversion de la matrice de hook
  318. *      WRITE (IOIMP,*) 'Inversion de la matrice de Hook'
  319.       TPREC= 0.D1
  320.       IPERR=0
  321.       CALL INVALM(IDAUX,LHOOK,LHOOK,IPERR,TPREC)
  322.       IF (IPERR.NE.0) THEN
  323.         WRITE (IOIMP,*) 'ERREUR DANS L''INVERSION DE LA MATRICE DE HOOK'
  324.       ENDIF
  325.  
  326. *      WRITE (IOIMP,*) 'Matrice de Hook inverse'
  327. *      DO 210 ILOOP= 1,LHOOK
  328. *         WRITE (IOIMP,99999) (IDAUX (ILOOP,J), J=1,LHOOK)
  329. *210   CONTINUE
  330.  
  331.  
  332.  
  333.  
  334. * Calcul des tenseurs d'endommagement H01, H02, H03
  335.       CALL SICTEN (H1,IDAUX,H01)
  336.       CALL SICTEN (H2,IDAUX,H02)
  337.       CALL SICTEN (H3,IDAUX,H03)
  338.  
  339. **********Debougage
  340.       IF (PARAM.EQ.1) THEN
  341.        WRITE (IOIMP,*) 'Matrice H01'
  342.        DO 250 ILOOP= 1,LHOOK
  343.           WRITE (IOIMP, 99999 ) (H01(ILOOP,J), J=1,LHOOK)
  344. 250    CONTINUE
  345.  
  346.        WRITE (IOIMP,*) 'Matrice H02'
  347.        DO 251 ILOOP= 1,LHOOK
  348.           WRITE (IOIMP, 99999 ) (H02(ILOOP,J), J=1,LHOOK)
  349. 251    CONTINUE
  350.  
  351.        WRITE (IOIMP,*) 'Matrice H03'
  352.        DO 252 ILOOP= 1,LHOOK
  353.           WRITE (IOIMP, 99999 ) (H03(ILOOP,J), J=1,LHOOK)
  354. 252    CONTINUE
  355.       ENDIF
  356.  
  357. * Calcul des matrices K01,K02,K03
  358.       CALL MULMAT (KW,H01,DDAUX,LHOOK,LHOOK,LHOOK)
  359.       CALL MULMAT (K01,DDAUX,KW,LHOOK,LHOOK,LHOOK)
  360.  
  361.       CALL MULMAT (KW,H02,DDAUX,LHOOK,LHOOK,LHOOK)
  362.       CALL MULMAT (K02,DDAUX,KW,LHOOK,LHOOK,LHOOK)
  363.  
  364.       CALL MULMAT (KW,H03,DDAUX,LHOOK,LHOOK,LHOOK)
  365.       CALL MULMAT (K03,DDAUX,KW,LHOOK,LHOOK,LHOOK)
  366.  
  367. *      WRITE (IOIMP,*) 'Matrice K01'
  368. *      DO 300 ILOOP= 1,LHOOK
  369. *         WRITE (IOIMP, 99999 ) (K01(ILOOP,J), J=1,LHOOK)
  370. *300   CONTINUE
  371. *
  372. *      WRITE (IOIMP,*) 'Matrice K02'
  373. *      DO 301 ILOOP= 1,LHOOK
  374. *         WRITE (IOIMP, 99999 ) (K02(ILOOP,J), J=1,LHOOK)
  375. *301   CONTINUE
  376. *
  377. *      WRITE (IOIMP,*) 'Matrice K03'
  378. *      DO 302 ILOOP= 1,LHOOK
  379. *         WRITE (IOIMP, 99999 ) (K03(ILOOP,J), J=1,LHOOK)
  380. *302   CONTINUE
  381.  
  382.  
  383.  
  384. ***** Recuperation deformation initiale dans le repere orth.
  385.  
  386.       DEFI(1)=VAR0(5)
  387.       DEFI(2)=VAR0(6)
  388.       DEFI(3)=VAR0(7)
  389.       DEFI(4)=VAR0(8)
  390.       DEFI(5)=VAR0(9)
  391.       DEFI(6)=VAR0(10)
  392.  
  393.       IF (PARAM.EQ.1) THEN
  394.          WRITE (IOIMP,*) 'DEFORMATION RECUPEREE'
  395.          WRITE (IOIMP,99999) (DEFI(ILOOP), ILOOP=1,6)
  396.       ENDIF
  397.  
  398.  
  399.  
  400. * Calcul de l'increment de deformation dans le repere orthotrope
  401.       DO 451 ILOOP=1,6
  402.          DEPSTV(ILOOP)=DEPST(ILOOP)
  403. 451   CONTINUE
  404.  
  405.       CALL SICROT (WRK0,WTRAV,1,DEPSTV,DORTH,kerre)
  406.  
  407.       IF (PARAM.EQ.1) THEN
  408.         WRITE (IOIMP,*) 'Increment des deformations orth. '
  409.         WRITE (IOIMP,99999) (DORTH(ILOOP), ILOOP=1,6)
  410.       ENDIF
  411.  
  412.  
  413. * Reorganisation dans SICDEF selon la valeur de iAXEP
  414. *  tc  iaxep nest pas initialise je le mets à 0 !!!
  415.       iaxep=0
  416.       CALL SICDEF (DORTH,iAXEP,kerre)
  417. * Reorganisation supplementaire pour le contraintes en cisaillement
  418.       VARTMP= DORTH(4)
  419.       DORTH(4)= DORTH(6)
  420.       DORTH(6)= VARTMP
  421.       DORTH(5)= DORTH(5)
  422.  
  423.  
  424.       IF (PARAM.EQ.1) THEN
  425.         WRITE (IOIMP,*) 'Apres SICDEF et reorg.'
  426.         WRITE (IOIMP,*) 'Increment des deformations orth. reorganise'
  427.         WRITE (IOIMP,99999) (DORTH(ILOOP), ILOOP=1,6)
  428.       ENDIF
  429.  
  430.  
  431. * On calcule les deformation totales.
  432.       DO 500 ILOOP=1,NSTRSS
  433.         DORTH(ILOOP)=DEFI(ILOOP)+DORTH(ILOOP)
  434. *       On garde le deformations totales dans le var. internes
  435.         VARF(ILOOP+4)=DORTH(ILOOP)
  436. 500   CONTINUE
  437.  
  438.       IF (PARAM.EQ.1) THEN
  439.         WRITE (IOIMP,*) 'Calcul des def. totales (rep. orth. reorg.)'
  440.         WRITE (IOIMP,99999) (DORTH(ILOOP), ILOOP=1,6)
  441.       ENDIF
  442.  
  443. ******************
  444.  
  445.  
  446.  
  447.  
  448. ********************************************************
  449. **           ON A LES DEFORMATIONS TOTALES            **
  450. **  ON PEUT CALCULER LES CONTRAINTES A LA FIN DU PAS  **
  451. ********************************************************
  452.  
  453.  
  454. *      WRITE (IOIMP,*) 'Calcul contraintes'
  455.  
  456.  
  457. * Calcul des noveaux HCLO
  458.  
  459.       IF (DORTH(1).LT.0) THEN
  460.          HCLO1=1
  461.       ELSE
  462.          HCLO1=0
  463.       ENDIF
  464.       IF (DORTH(2).LT.0) THEN
  465.          HCLO2=1
  466.       ELSE
  467.          HCLO2=0
  468.       ENDIF
  469.       IF (DORTH(3).LT.0) THEN
  470.          HCLO3=1
  471.       ELSE
  472.          HCLO3=0
  473.       ENDIF
  474.  
  475.       IF (PARAM.EQ.1) THEN
  476.          WRITE (IOIMP,*) 'HCLO'
  477.          WRITE (IOIMP,*) HCLO1,HCLO2,HCLO3
  478.       ENDIF
  479.  
  480.  
  481. * Calcul des nouvelles KEFF
  482.       DO  ILOOP=1,LHOOK
  483.         DO  JLOOP=1,LHOOK
  484.            KEFF1(ILOOP,JLOOP)=K01(ILOOP,JLOOP)
  485.            KEFF2(ILOOP,JLOOP)=K02(ILOOP,JLOOP)
  486.            KEFF3(ILOOP,JLOOP)=K03(ILOOP,JLOOP)
  487.         enddo
  488.       enddo
  489.       KEFF1(1,1)=K01(1,1)*(1-ETADS*HCLO1)
  490.       KEFF2(2,2)=K02(2,2)*(1-ETADS*HCLO2)
  491.       KEFF3(3,3)=K03(3,3)*(1-ETADS*HCLO3)
  492.  
  493.  
  494.  
  495.  
  496.  
  497.  
  498. *      WRITE (IOIMP,*) 'Matrice KEFF1'
  499. *      DO 502 ILOOP= 1,LHOOK
  500. *         WRITE (IOIMP, 99999 ) (KEFF1(ILOOP,J), J=1,LHOOK)
  501. *502   CONTINUE
  502. *
  503. *      WRITE (IOIMP,*) 'Matrice KEFF2'
  504. *      DO 503 ILOOP= 1,LHOOK
  505. *         WRITE (IOIMP, 99999 ) (KEFF2(ILOOP,J), J=1,LHOOK)
  506. *503   CONTINUE
  507. *
  508. *      WRITE (IOIMP,*) 'Matrice KEFF3'
  509. *      DO 504 ILOOP= 1,LHOOK
  510. *         WRITE (IOIMP, 99999 ) (KEFF3(ILOOP,J), J=1,LHOOK)
  511. *504   CONTINUE
  512.  
  513.  
  514.  
  515.  
  516. * Calcul des YGR
  517. *      WRITE (IOIMP,*) 'YW1'
  518.       CALL ZERO (YW,6,1)
  519.       CALL MULMAT (YW,KEFF1,DORTH,6,1,6)
  520. *      WRITE (IOIMP,*) (YW(ILOOP), ILOOP=1,6)
  521.       YGR1=0
  522.       DO 510 ILOOP=1,6
  523.          YGR1=YGR1+YW(ILOOP)*DORTH(ILOOP)
  524. 510   CONTINUE
  525.       YGR1=0.5D0*YGR1
  526. *      WRITE (IOIMP,*) 'YGR1=',YGR1
  527.  
  528.       CALL ZERO (YW,6,1)
  529.       CALL MULMAT (YW,KEFF2,DORTH,6,1,6)
  530. *      WRITE (IOIMP,*) 'YW2'
  531. *      WRITE (IOIMP,*) (YW(ILOOP), ILOOP=1,6)
  532.       YGR2=0
  533.       DO 520 ILOOP=1,6
  534.          YGR2=YGR2+YW(ILOOP)*DORTH(ILOOP)
  535. 520   CONTINUE
  536.       YGR2=0.5D0*YGR2
  537.  
  538.       CALL ZERO (YW,6,1)
  539.       CALL MULMAT (YW,KEFF3,DORTH,6,1,6)
  540.       YGR3=0
  541.       DO 530 ILOOP=1,6
  542.          YGR3=YGR3+YW(ILOOP)*DORTH(ILOOP)
  543. 530   CONTINUE
  544.       YGR3=0.5D0*YGR3
  545.  
  546.       IF (PARAM.EQ.1) THEN
  547.          WRITE (IOIMP,*) 'YGR1=',YGR1
  548.          WRITE (IOIMP,*) 'YGR2=',YGR2
  549.          WRITE (IOIMP,*) 'YGR3=',YGR3
  550.       ENDIF
  551.  
  552.       IF (YGR1.LT.0) THEN
  553.          YGR1=0
  554.       ENDIF
  555.       IF (YGR2.LT.0) THEN
  556.          YGR2=0
  557.       ENDIF
  558.       IF (YGR3.LT.0) THEN
  559.          YGR3=0
  560.       ENDIF
  561.  
  562.  
  563.  
  564.  
  565. *Calcul des YEQ
  566.       YEQ1= AEQ(1,1)*YGR1+AEQ(1,2)*YGR2+AEQ(1,3)*YGR3
  567.       YEQ2= AEQ(2,1)*YGR1+AEQ(2,2)*YGR2+AEQ(2,3)*YGR3
  568.       YEQ3= AEQ(3,1)*YGR1+AEQ(3,2)*YGR2+AEQ(3,3)*YGR3
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  
  575. *Calcul des DOM
  576.  
  577.       DD1= ((SQRT(YEQ1) - G1Y0)/ G1YC )
  578.       DD2= ((SQRT(YEQ2) - G2Y0)/ G2YC )
  579.       DD3= ((SQRT(YEQ3) - G3Y0)/ G3YC )
  580.  
  581.       IF (DD1.LT.0) THEN
  582.          DD1=0
  583.       ENDIF
  584.       IF (DD2.LT.0) THEN
  585.          DD2=0
  586.       ENDIF
  587.       IF (DD3.LT.0) THEN
  588.          DD3=0
  589.       ENDIF
  590.  
  591.  
  592.       DOM1= G1DC*(1.D0 - EXP(-1*
  593.      &         ( DD1**G1P ) ) )
  594.       DOM2= G2DC*(1.D0 - EXP(-1*
  595.      &         ( DD2**G2P ) ) )
  596.       DOM3= G3DC*(1.D0 - EXP(-1*
  597.      &         ( DD3**G3P ) ) )
  598.  
  599.  
  600.  
  601.       DOM1= MAX(DOM1,VAR0(2))
  602.       DOM2= MAX(DOM2,VAR0(3))
  603.       DOM3= MAX(DOM3,VAR0(4))
  604.  
  605.       IF (PARAM.EQ.1) THEN
  606.          WRITE (IOIMP,*) 'DOM1=',DOM1
  607.          WRITE (IOIMP,*) 'DOM2=',DOM2
  608.          WRITE (IOIMP,*) 'DOM3=',DOM3
  609.       ENDIF
  610.  
  611. *Calcul de la matrice de rigidite
  612.  
  613.  
  614.       DO  ILOOP=1,LHOOK
  615.         DO  JLOOP=1,LHOOK
  616.            RIG0(ILOOP,JLOOP)=DDAUX(ILOOP,JLOOP)
  617.      &                       -DOM1*KEFF1(ILOOP,JLOOP)
  618.      &                       -DOM2*KEFF2(ILOOP,JLOOP)
  619.      &                       -DOM3*KEFF3(ILOOP,JLOOP)
  620.         enddo
  621.       enddo
  622.  
  623.  
  624. *      WRITE (IOIMP, *) 'Matrice RIG0 finale'
  625. *      DO 610 ILOOP= 1,LHOOK
  626. *         WRITE (IOIMP,99999) (RIG0 (ILOOP,J), J=1,LHOOK)
  627. *610   CONTINUE
  628.  
  629.  
  630. * Calcul des contraintes a la fin du pas
  631. * SORTH contient les contraintes a la fin du pas
  632. * dans le repere orthotrope
  633.       CALL MULMAT (SORTH,RIG0,DORTH,6,1,6)
  634.  
  635.       IF (PARAM.EQ.1) THEN
  636.          WRITE (IOIMP,*) 'Contraintes calculees (repere orth.)'
  637.          WRITE (IOIMP,99999) (SORTH(ILOOP), ILOOP=1,6)
  638.       ENDIF
  639.  
  640.  
  641.  
  642. * ATTENTION:
  643. * On reorganise les contraintes en cisaillement pour
  644. * calculer les contraintes dans le repere global
  645.       SIGFV(1)=SORTH(1)
  646.       SIGFV(2)=SORTH(2)
  647.       SIGFV(3)=SORTH(3)
  648.  
  649.       SIGFV(4)=SORTH(6)
  650.       SIGFV(5)=SORTH(5)
  651.       SIGFV(6)=SORTH(4)
  652.  
  653.  
  654.       CALL SICCNT (SIGFV,iAXEP,kerre)
  655.  
  656.       IF (PARAM.EQ.1) THEN
  657.          WRITE (IOIMP,*) 'Apres SICCNT e reorg'
  658.          WRITE (IOIMP,*) 'Contraintes reorganisees'
  659.          WRITE (IOIMP,99999) (SIGFV(ILOOP), ILOOP=1,6)
  660.       ENDIF
  661.  
  662. * On appele SICROT pour trouver le contraintes dans le repere global
  663. * On utilise SORTH pour garder le resultat
  664. * (on peut pas passer SIGF a la subroutine car il est dans un segment)
  665.       CALL SICROT (WRK0,WTRAV,0,SIGFV,SORTH,kerre)
  666.  
  667.  
  668. * On recopie SORTH in SIGF
  669.       DO 1000 ILOOP=1,6
  670.          SIGF(ILOOP)=SORTH(ILOOP)
  671. 1000  CONTINUE
  672.  
  673.  
  674.  
  675.       IF (PARAM.EQ.1) THEN
  676.          WRITE (IOIMP,*) 'Contraintes calculees'
  677.          WRITE (IOIMP,99999) (SIGF(ILOOP), ILOOP=1,6)
  678.       ENDIF
  679.  
  680.  
  681.  
  682.       VARF(2)=  DOM1
  683.       VARF(3)=  DOM2
  684.       VARF(4)=  DOM3
  685.  
  686.  
  687.  
  688.  
  689. 99999    format(2x,'  ',(6(1x,3pe12.5),/))
  690. 99998    format(2x,'  ',(4(1x,3pe12.5),/))
  691. 99997    format(2x,'  ',(1x,3pe12.5),/)
  692. 99996    format(2x,'  ',(3(1x,1pe12.3),/))
  693.  
  694.  
  695.  
  696.       RETURN
  697.       END
  698.  
  699.  
  700.  
  701.  
  702.  
  703.  
  704.  
  705.  
  706.  
  707.  
  708.  
  709.  
  710.  
  711.  
  712.  
  713.  

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