Sources Esope | Cast3M

calcrtg1
C CALCRTG1  SOURCE    BR232186  12/10/04    21:15:09     7520
      SUBROUTINE CALCRTG1 (EPSIM,EPSIF,XGAMMT,XGAMMC,XGAMF,XALFA,XLAMM,
     &                     XMUM,XLAMF,XMUF,XD1,XD2,XEPS33,DR1DD1)
C
C====&===1=========2=========3=========4=========5=========6=========7==
C Commentaires :   Subroutine permettant de calculer l'operateur tangent
C                  dR1/dd1
C                  Appelé par la routine lcgldm.eso
C
C Auteur       : B. Richard (Dr - Ing.) - CEA/DEN/DANS/DM2S/SEMT/EMSI
C====&===1=========2=========3=========4=========5=========6=========7==
C
C----DECLARATION GENERALES----------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
      REAL*8 VAPM(3),VEPM(3,3),VAPF(3),VEPF(3,3)
      REAL*8 EPSIM(3,3),EPSIF(3,3)
 
C     Calcul des traces
      XTRA = EPSIM(1,1)+EPSIM(2,2)
      XTRAK = EPSIF(1,1)+EPSIF(2,2)
 
C     Calcul des valeurs propres
      CALL JACOB4(EPSIM,2,VAPM,VEPM)
      CALL JACOB4(EPSIF,2,VAPF,VEPF)
 
C     Calcul des constantes GM, GM1 et GM2
      CALL CALCGM(XTRA,XGAMMT,XGAMMC,XGM)
      CALL CALCGM(VAPM(1),XGAMMT,XGAMMC,XGM1)
      CALL CALCGM(VAPM(2),XGAMMT,XGAMMC,XGM2)
 
C     Calcul de dxim/dd1
      DXIMD1 = -1.0D0*XGM/(2.0D0*(1.0D0+XD1)**2.0D0)
 
C     Calcul de XIM
      CALL CALCXIM(XTRA,XGAMMT,XGAMMC,XD1,XD2,XIM)
 
C     Calcul de deps33/dd1
      DEP33D1 = (2.0D0*XLAMM*XMUM*XTRA)/
     &          ((2.0D0*XMUM+XLAMM*XIM)**2.0D0)
 
      DEP33D1 = DEP33D1*DXIMD1
 
C     Calcul du residu 1 lié à XD1 en trois parties
      XPART11 = 1.0D0/((1.0D0+XD1)**2.0D0)*(XLAMM/2.0D0*
     &         (XTRA+XEPS33)*XGM)*DEP33D1
 
      XPART12 = 2.0D0/((1.0D0+XD1)**3.0D0)*(XLAMM/4.0D0*
     &         (XTRA+XEPS33)**2.0D0)*XGM+XMUM/2.0D0*
     &         (((VAPM(1)**2.0D0)*XGM1)+((VAPM(2)**2.0D0)*XGM2))
 
      IF (XTRAK.GE.0.0D0) THEN
         IF ((VAPF(1).GE.0.0D0).AND.(VAPF(2).GE.0.0D0)) THEN
            XCONS1 = 0.0D0
            XCONS2 = 0.0D0
            XCONS3 = 0.0D0
         ENDIF
 
         IF ((VAPF(1).GE.0.0D0).AND.(VAPF(2).LT.0.0D0)) THEN
            XCONS1 = 0.0D0
            XCONS2 = 0.0D0
            XCONS3 = VAPF(2)**2.0D0
         ENDIF
 
         IF ((VAPF(1).LT.0.0D0).AND.(VAPF(2).GE.0.0D0)) THEN
            XCONS1 = 0.0D0
            XCONS2 = VAPF(1)**2.0D0
            XCONS3 = 0.0D0
         ENDIF
 
         IF ((VAPF(1).LT.0.0D0).AND.(VAPF(2).LT.0.0D0)) THEN
            XCONS1 = 0.0D0
            XCONS2 = VAPF(1)**2.0D0
            XCONS3 = VAPF(2)**2.0D0
         ENDIF
      ELSE
         IF ((VAPF(1).GE.0.0D0).AND.(VAPF(2).GE.0.0D0)) THEN
            XCONS1 = XTRAK**2.0D0
            XCONS2 = 0.0D0
            XCONS3 = 0.0D0
         ENDIF
 
         IF ((VAPF(1).GE.0.0D0).AND.(VAPF(2).LT.0.0D0)) THEN
            XCONS1 = XTRAK**2.0D0
            XCONS2 = 0.0D0
            XCONS3 = VAPF(2)**2.0D0
         ENDIF
 
         IF ((VAPF(1).LT.0.0D0).AND.(VAPF(2).GE.0.0D0)) THEN
            XCONS1 = XTRAK**2.0D0
            XCONS2 = VAPF(1)**2.0D0
            XCONS3 = 0.0D0
         ENDIF
 
         IF ((VAPF(1).LT.0.0D0).AND.(VAPF(2).LT.0.0D0)) THEN
            XCONS1 = XTRAK**2.0D0
            XCONS2 = VAPF(1)**2.0D0
            XCONS3 = VAPF(2)**2.0D0
         ENDIF
      ENDIF
 
      XPART13 = ((2.0D0*XALFA*(1.0D0-XGAMF))/(XALFA+XD1)**3.0D0)*
     &         (XLAMF/2.0D0*XCONS1+XMUF*(XCONS2+XCONS3))
 
      DR1DD1 = XPART11-XPART12-XPART13
 
      RETURN
      END