Esope source files

   1 : C AMULTM    SOURCE    CHAT      05/01/12    21:21:57     5004           
   2 :       SUBROUTINE AMULTM(EPSPLS,ENDT,XLMD,XLIMT)
   3 : C=====================================================================
   4 : C     CALCUL DU MULTIPLICATEUR (ENDOMMAGEMENT ANISOTROPE ENDUIT)
   5 : C=====================================================================
   6 : C                                         
   7 : C     CREATION : F.CORMERY          
   8 : C                JUIN  1993                            
   9 : C                                         
  10 : C=======================================================================
  11 :       IMPLICIT INTEGER(I-N)
  12 :       IMPLICIT REAL*8 (A-H,O-Z) 
  13 :       REAL*8 LAMB,MUT
  14 : C----------------------------------------------------------------------
  15 : C-------                                             COMMON SPECIFIQUES
  16 : C----------------------------------------------------------------------
  17 :       COMMON/APENTE/ LAMB,MUT,G,ALP1,BETA
  18 :       COMMON/MAED/ B,C0,CPRIME
  19 : C----------------------------------------------------------------------
  20 : C-------                                             DIMENSIONS ET DATA
  21 : C----------------------------------------------------------------------
  22 : CC      DIMENSION EPSPLS(6),ENDT(6)
  23 :       DIMENSION EPSPLS(*),ENDT(*) 
  24 :       DATA ZERO/0.D0/,
  25 :      *     DEUX/2.D0/
  26 : C-----                                         ----------------------
  27 : C-----                                         CALCUL DE COEFFICIENTS
  28 : C-----                                         ----------------------
  29 :       TRAC1=EPSPLS(1)**2+EPSPLS(2)**2+EPSPLS(3)**2+
  30 :      *      (EPSPLS(4)**2+EPSPLS(5)**2+EPSPLS(6)**2)/DEUX
  31 :       TRAC2=EPSPLS(1)*ENDT(1)+EPSPLS(2)*ENDT(2)+EPSPLS(3)*ENDT(3)+
  32 :      *      EPSPLS(4)*ENDT(4)+EPSPLS(5)*ENDT(5)+EPSPLS(6)*ENDT(6)
  33 :       TRAC3=EPSPLS(1)+EPSPLS(2)+EPSPLS(3)
  34 :       TRAC4=ENDT(1)+ENDT(2)+ENDT(3)
  35 : 
  36 :       COEFF1=SQRT((G**2/DEUX)*TRAC1)-B*G*TRAC2-XLIMT
  37 :       COEFF2=(-G/DABS(G))*SQRT(TRAC1/DEUX)+B*TRAC2
  38 :       COEFF3=(-G/DABS(G))*(TRAC3/SQRT(DEUX*TRAC1))+B*TRAC4
  39 : 
  40 : C----------------------------------------------------------------------
  41 : C-------                                              MULTIPLICATEUR
  42 : C----------------------------------------------------------------------
  43 :       XLMD=COEFF1/(B*COEFF1+CPRIME*COEFF3+B*G*COEFF2)
  44 :       IF(XLMD.GE.ZERO)GO TO 999
  45 :       WRITE(10,2010)XLMD
  46 : 2010  FORMAT(15X,'MULTIPLICATEUR NEGATIF XLMD=',G12.5/)
  47 :       STOP
  48 : C----------------------------------------------------------------------
  49 : 999   CONTINUE
  50 :       RETURN
  51 :       END
  52 :  
  53 :  
  54 :