Esope source files

   1 : C CLEBL3    SOURCE    KICH      09/09/11    21:16:06     6505           
   2 :       SUBROUTINE CLEBL3(iwrk52,iele,igau)
   3 : C
   4 : C
   5 : C
   6 : C      Modele de Leblond et Devaux
   7 : C        descente au niveau des points de Gauss
   8 : C          06/97
   9 : C
  10 : C     SOURCE BRIOTTET
  11 : C
  12 : C
  13 : C
  14 :       IMPLICIT INTEGER(I-N)
  15 :       IMPLICIT REAL*8(A-H,O-Z)
  16 : C
  17 : -INC CCOPTIO
  18 : -INC SMCHAML
  19 : -INC CCHAMP
  20 : -INC DECHE
  21 : C
  22 :       REAL*8 VWRK1(7),VWRK2(7)
  23 : 
  24 :            wrk52 = iwrk52
  25 : * DTPS fourni dans caracteristiques
  26 :            DTPS = valma0(14) 
  27 :  10   continue
  28 : C
  29 :            T0=ture0(1)
  30 : C
  31 :            if ((tempf-temp0).gt.0) then
  32 :              TPOINT0=(turef(1) - ture0(1))/(tempf-temp0)
  33 :            else
  34 :              TPOINT0 = 0.
  35 :            endif
  36 : C
  37 :            ZA0=valma0(9)
  38 : C
  39 :            ZF0=valma0(10)
  40 : C
  41 :            ZB0=valma0(11)
  42 : C
  43 :            ZM0=valma0(12)
  44 : C
  45 :            VMS0=valma0(13)
  46 : C
  47 :             VWRK1(1)=T0
  48 :             VWRK1(2)=TPOINT0
  49 :             VWRK1(3)=ZA0
  50 :             VWRK1(4)=ZF0
  51 :             VWRK1(5)=ZB0
  52 :             VWRK1(6)=ZM0
  53 :             VWRK1(7)=VMS0
  54 : C
  55 : C     CALCUL DU NOUVEAU CHAMP DE PHASES
  56 : C
  56 :            CALL CLEBL4(iwrk52,VWRK1,DTPS,VWRK2)
  57 : C
  58 : C sortie
  59 :            xmatf(9)=VWRK2(3)
  60 : C
  61 :            xmatf(10)=VWRK2(4)
  62 : C
  63 :            xmatf(11)=VWRK2(5)
  64 : C
  65 :            xmatf(12)=VWRK2(6)
  66 : C
  67 :            xmatf(13)=VWRK2(7)
  68 : C
  69 :        do ii = 1,8
  70 :          xmatf(ii) = xmat(ii)
  71 :        enddo
  72 : C
  73 :       RETURN
  74 :       END      
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :