Télécharger la plaquette Cast3M


fr en

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