Télécharger la plaquette Cast3M


fr en

Télécharger mpausm.eso

Retour à la liste

Numérotation des lignes : 

mpausm

  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