Esope source files

   1 : C MPADV     SOURCE    BECC      05/12/02    21:15:48     5258           
   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(DABS(ML) .GE. 1.D0) then
  52 :          MPLUS2 = 0.5D0*(ML + DABS(ML))
  53 :       else
  54 :          MPLUS2 = 0.25D0*(ML + 1.D0)**2
  55 :       end if
  56 :       if(DABS(ML) .GE. 1.D0) then
  57 :          MMIN2 = 0.5D0*(ML - DABS(ML))
  58 :       else
  59 :          MMIN2 = -0.25D0*(ML - 1.D0)**2
  60 :       end if
  61 : 
  62 :       if(DABS(ML) .GE. 1) then
  63 :          MPLUS =  0.5D0*(ML + DABS(ML))
  64 :       else
  65 :          MPLUS = MPLUS2*(1.D0 - B_AUSM*16.D0*MMIN2)
  66 :       end if
  67 : 
  68 :       if (DABS(ML) .GE. 1) then
  69 :          PPLUS = (0.5D0*(ML + DABS(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(DABS(MR) .GE. 1.D0) then
  77 :          MPLUS2 = 0.5D0*(MR + DABS(MR))
  78 :       else
  79 :          MPLUS2 = 0.25D0*(MR + 1.D0)**2
  80 :       end if
  81 :       if(DABS(MR) .GE. 1.D0) then
  82 :          MMIN2 = 0.5D0*(MR - DABS(MR))
  83 :       else
  84 :          MMIN2 = -0.25D0*(MR - 1.D0)**2
  85 :       end if
  86 : 
  87 :       if (DABS(MR) .GE. 1) then
  88 :          MMIN = 0.5D0*(MR - DABS(MR))
  89 :       else
  90 :          MMIN = MMIN2*(1.D0 + B_AUSM*16.D0*MPLUS2)
  91 :       end if
  92 : 
  93 :       if (DABS(MR) .GE. 1) then
  94 :          PMIN = (0.5D0*(MR - DABS(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 + DABS(ML))
 100 :       Mkmin  = wkmin*MMIN + (1.D0 - wkmin)* 0.5D0*(MR - DABS(MR))
 101 : 
 102 :       Pkplus = PPLUS
 103 :       Pkmin = PMIN
 104 :       
 105 :       END
 106 : 
 107 :