Télécharger clebl3.eso

Retour à la liste

Numérotation des lignes :

  1. C CLEBL3 SOURCE BP208322 17/03/01 21:15:38 9325
  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
  57. CALL CLEBL4(iwrk52,VWRK1,DTPS,VWRK2)
  58. C
  59. C sortie
  60. xmatf(9)=VWRK2(3)
  61. C
  62. xmatf(10)=VWRK2(4)
  63. C
  64. xmatf(11)=VWRK2(5)
  65. C
  66. xmatf(12)=VWRK2(6)
  67. C
  68. xmatf(13)=VWRK2(7)
  69. C
  70. do ii = 1,8
  71. xmatf(ii) = xmat(ii)
  72. enddo
  73. C
  74. RETURN
  75. END
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  

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