Télécharger mpadv.eso

Retour à la liste

Numérotation des lignes :

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

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