Télécharger mpausm.eso

Retour à la liste

Numérotation des lignes :

  1. C MPAUSM SOURCE CB215821 16/04/21 21:17:50 8920
  2. SUBROUTINE mpAUSM(ML, MR, Mkplus, Mkmin, Pkplus, Pkmin)
  3. C***********************************************************************
  4. C NOM : mpAUSM
  5. C DESCRIPTION :
  6. C
  7. C
  8. C
  9. C LANGAGE : ESOPE
  10. C AUTEUR : José R. Garcia Cascales (CEA/DEN/DM2S/SFME/LTMF)
  11. C mél : fd1@semt2.smts.cea.fr
  12. C***********************************************************************
  13. C APPELES :
  14. C APPELES (E/S) :
  15. C INPUTS: ML, MR
  16. C OUTPUTS: MPLUS, MMINUS, PPLUS, PMINUS
  17. C APPELES (BLAS) :
  18. C APPELES (CALCUL) :
  19. C APPELE PAR :
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE :
  22. C ENTREES :
  23. C ENTREES/SORTIES :
  24. C SORTIES :
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION : v1, 19/02/2001, version initiale
  28. C***********************************************************************
  29. *
  30. * Executable statements
  31. *
  32. real*8 ML, MR, Mkplus, Mkmin, Pkplus, Pkmin
  33.  
  34. real*8 Mm, MPLUS, MMIN, PPLUS, PMIN,
  35. & MPLUS2, MMIN2,
  36. & A_AUSM, B_AUSM
  37. parameter(A_AUSM = 0.1875D0)
  38. parameter(B_AUSM = 0.125D0)
  39.  
  40. C Calculation of MPLUS and PPLUS
  41.  
  42. if(ABS(ML) .GE. 1.D0) then
  43. MPLUS2 = 0.5D0*(ML + ABS(ML))
  44. else
  45. MPLUS2 = 0.25D0*(ML + 1.D0)**2
  46. end if
  47. if(ABS(ML) .GE. 1.D0) then
  48. MMIN2 = 0.5D0*(ML - ABS(ML))
  49. else
  50. MMIN2 = -0.25D0*(ML - 1.D0)**2
  51. end if
  52.  
  53. if(ABS(ML) .GE. 1) then
  54. MPLUS = 0.5D0*(ML + ABS(ML))
  55. else
  56. MPLUS = MPLUS2*(1.D0 - B_AUSM*16.D0*MMIN2)
  57. end if
  58.  
  59. if (ABS(ML) .GE. 1) then
  60. PPLUS = (0.5D0*(ML + ABS(ML)))/ML
  61. else
  62. PPLUS = MPLUS2*(2.D0 - ML - A_AUSM*16.D0*ML*MMIN2)
  63. end if
  64.  
  65. C Calculation of MMIN
  66.  
  67. if(ABS(MR) .GE. 1.D0) then
  68. MPLUS2 = 0.5D0*(MR + ABS(MR))
  69. else
  70. MPLUS2 = 0.25D0*(MR + 1.D0)**2
  71. end if
  72. if(ABS(MR) .GE. 1.D0) then
  73. MMIN2 = 0.5D0*(MR - ABS(MR))
  74. else
  75. MMIN2 = -0.25D0*(MR - 1.D0)**2
  76. end if
  77.  
  78. if (ABS(MR) .GE. 1) then
  79. MMIN = 0.5D0*(MR - ABS(MR))
  80. else
  81. MMIN = MMIN2*(1.D0 + B_AUSM*16.D0*MPLUS2)
  82. end if
  83.  
  84. if (ABS(MR) .GE. 1) then
  85. PMIN = (0.5D0*(MR - ABS(MR)))/MR
  86. else
  87. PMIN = -MMIN2*(2.D0 + MR - A_AUSM*16.D0*MR*MPLUS2)
  88. end if
  89.  
  90. Mm = MPLUS + MMIN
  91.  
  92. Mkplus = 0.5D0*(Mm + ABS(Mm))
  93. Mkmin = 0.5D0*(Mm - ABS(Mm))
  94.  
  95. Pkplus = PPLUS
  96. Pkmin = PMIN
  97.  
  98. END
  99.  
  100.  
  101.  
  102.  
  103.  

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