Ignore:
Timestamp:
Jul 29, 2024, 11:01:04 PM (3 months ago)
Author:
abarral
Message:

Put YOMCST.h into modules

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/nflxtr.F90

    r5142 r5144  
    1 
    21! $Id $
    32
    4 SUBROUTINE nflxtr(pdtime,pmfu,pmfd,pen_u,pde_u,pen_d,pde_d,pplay,paprs,x,dx)
     3SUBROUTINE nflxtr(pdtime, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, pplay, paprs, x, dx)
    54  USE dimphy
    65  USE lmdz_YOECUMF
     6  USE lmdz_yomcst
    77
    8   IMPLICIT NONE 
    9 !=====================================================================
    10 ! Objet : Melange convectif de traceurs a partir des flux de masse
    11 ! Date : 13/12/1996 -- 13/01/97
    12 ! Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
    13 !         Brinkop et Sausen (1996) et Boucher et al. (1996).
    14 ! ATTENTION : meme si cette routine se veut la plus generale possible,
    15 !             elle a herite de certaines notations et conventions du
    16 !             schema de Tiedtke (1993).
    17 ! 1. En particulier, les couches sont numerotees de haut en bas !!!
    18 !    Ceci est valable pour les flux
    19 !    mais pas pour les entrees x, pplay, paprs !!!!
    20 ! 2. pmfu est positif, pmfd est negatif
    21 ! 3. Tous les flux d'entrainements et de detrainements sont positifs
    22 !    contrairement au schema de Tiedtke d'ou les changements de signe!!!!
    23 !=====================================================================
     8  IMPLICIT NONE
     9  !=====================================================================
     10  ! Objet : Melange convectif de traceurs a partir des flux de masse
     11  ! Date : 13/12/1996 -- 13/01/97
     12  ! Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
     13  !         Brinkop et Sausen (1996) et Boucher et al. (1996).
     14  ! ATTENTION : meme si cette routine se veut la plus generale possible,
     15  !             elle a herite de certaines notations et conventions du
     16  !             schema de Tiedtke (1993).
     17  ! 1. En particulier, les couches sont numerotees de haut en bas !!!
     18  !    Ceci est valable pour les flux
     19  !    mais pas pour les entrees x, pplay, paprs !!!!
     20  ! 2. pmfu est positif, pmfd est negatif
     21  ! 3. Tous les flux d'entrainements et de detrainements sont positifs
     22  !    contrairement au schema de Tiedtke d'ou les changements de signe!!!!
     23  !=====================================================================
    2424
    25   include "YOMCST.h"
     25  REAL, INTENT(IN) :: pdtime  ! pdtphys
    2626
    27   REAL,INTENT(IN) :: pdtime  ! pdtphys
     27  ! les flux sont definis au 1/2 niveaux
     28  ! => pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
    2829
    29 ! les flux sont definis au 1/2 niveaux
    30 ! => pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
     30  REAL, DIMENSION(klon, klev), INTENT(IN) :: pmfu  ! flux de masse dans le panache montant
     31  REAL, DIMENSION(klon, klev), INTENT(IN) :: pmfd  ! flux de masse dans le panache descendant
     32  REAL, DIMENSION(klon, klev), INTENT(IN) :: pen_u ! flux entraine dans le panache montant
     33  REAL, DIMENSION(klon, klev), INTENT(IN) :: pde_u ! flux detraine dans le panache montant
     34  REAL, DIMENSION(klon, klev), INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
     35  REAL, DIMENSION(klon, klev), INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
    3136
    32   REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu  ! flux de masse dans le panache montant
    33   REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd  ! flux de masse dans le panache descendant
    34   REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant
    35   REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant
    36   REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
    37   REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
     37  REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay ! pression aux couches (bas en haut)
     38  REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs ! pression aux 1/2 couches (bas en haut)
     39  REAL, DIMENSION(klon, klev), INTENT(IN) :: x     ! q de traceur (bas en haut)
     40  REAL, DIMENSION(klon, klev), INTENT(INOUT) :: dx   ! tendance de traceur  (bas en haut)
    3841
    39   REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay ! pression aux couches (bas en haut)
    40   REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression aux 1/2 couches (bas en haut)
    41   REAL,DIMENSION(klon,klev),INTENT(IN)   :: x     ! q de traceur (bas en haut)
    42   REAL,DIMENSION(klon,klev),INTENT(INOUT) :: dx   ! tendance de traceur  (bas en haut)
     42  ! flux convectifs mais en variables locales
     43  REAL, DIMENSION(klon, klev + 1) :: zmfu  ! copie de pmfu avec klev+1 = 0
     44  REAL, DIMENSION(klon, klev + 1) :: zmfd  ! copie de pmfd avec klev+1 = 0
     45  REAL, DIMENSION(klon, klev) :: zen_u
     46  REAL, DIMENSION(klon, klev) :: zde_u
     47  REAL, DIMENSION(klon, klev) :: zen_d
     48  REAL, DIMENSION(klon, klev) :: zde_d
     49  REAL :: zmfe
    4350
    44 ! flux convectifs mais en variables locales
    45   REAL,DIMENSION(klon,klev+1) :: zmfu  ! copie de pmfu avec klev+1 = 0
    46   REAL,DIMENSION(klon,klev+1) :: zmfd  ! copie de pmfd avec klev+1 = 0
    47   REAL,DIMENSION(klon,klev)   :: zen_u
    48   REAL,DIMENSION(klon,klev)   :: zde_u
    49   REAL,DIMENSION(klon,klev)   :: zen_d
    50   REAL,DIMENSION(klon,klev)   :: zde_d
    51   REAL                        :: zmfe
     51  ! variables locales
     52  ! les flux de x sont definis aux 1/2 niveaux
     53  ! xu et xd sont definis aux niveaux complets
     54  REAL, DIMENSION(klon, klev) :: xu      ! q de traceurs dans le panache montant
     55  REAL, DIMENSION(klon, klev) :: xd      ! q de traceurs dans le panache descendant
     56  REAL, DIMENSION(klon, klev + 1) :: zmfux   ! flux de x dans le panache montant
     57  REAL, DIMENSION(klon, klev + 1) :: zmfdx   ! flux de x dans le panache descendant
     58  REAL, DIMENSION(klon, klev + 1) :: zmfex   ! flux de x dans l'environnement
     59  INTEGER :: i, k
     60  REAL, PARAMETER :: zmfmin = 1.E-10
    5261
    53 ! variables locales     
    54 ! les flux de x sont definis aux 1/2 niveaux
    55 ! xu et xd sont definis aux niveaux complets
    56   REAL,DIMENSION(klon,klev)   :: xu      ! q de traceurs dans le panache montant
    57   REAL,DIMENSION(klon,klev)   :: xd      ! q de traceurs dans le panache descendant
    58   REAL,DIMENSION(klon,klev+1) :: zmfux   ! flux de x dans le panache montant
    59   REAL,DIMENSION(klon,klev+1) :: zmfdx   ! flux de x dans le panache descendant
    60   REAL,DIMENSION(klon,klev+1) :: zmfex   ! flux de x dans l'environnement
    61   INTEGER                     :: i, k
    62   REAL,PARAMETER              :: zmfmin=1.E-10
     62  ! ==============================================
     63  ! Extension des flux UP et DN sur klev+1 niveaux
     64  ! ==============================================
     65  DO k = 1, klev
     66    DO i = 1, klon
     67      zmfu(i, k) = pmfu(i, k)
     68      zmfd(i, k) = pmfd(i, k)
     69    ENDDO
     70  ENDDO
     71  DO i = 1, klon
     72    zmfu(i, klev + 1) = 0.
     73    zmfd(i, klev + 1) = 0.
     74  ENDDO
     75  ! ==========================================
     76  ! modif pour diagnostiquer les detrainements
     77  ! ==========================================
     78  !   on privilegie l'ajustement de l'entrainement dans l'ascendance.
    6379
    64 ! ==============================================
    65 ! Extension des flux UP et DN sur klev+1 niveaux
    66 ! ==============================================
    67   DO k=1,klev
    68      DO i=1,klon
    69         zmfu(i,k)=pmfu(i,k)
    70         zmfd(i,k)=pmfd(i,k)
    71      ENDDO
     80  DO k = 1, klev
     81    DO i = 1, klon
     82      zen_d(i, k) = pen_d(i, k)
     83      zde_u(i, k) = pde_u(i, k)
     84      zde_d(i, k) = -zmfd(i, k + 1) + zmfd(i, k) + zen_d(i, k)
     85      zen_u(i, k) = zmfu(i, k + 1) - zmfu(i, k) + zde_u(i, k)
     86    ENDDO
    7287  ENDDO
    73   DO i=1,klon
    74      zmfu(i,klev+1)=0.
    75      zmfd(i,klev+1)=0.
    76   ENDDO
    77 ! ==========================================
    78 ! modif pour diagnostiquer les detrainements
    79 ! ==========================================
    80 !   on privilegie l'ajustement de l'entrainement dans l'ascendance.
     88  ! =========================================
     89  ! calcul des flux dans le panache montant
     90  ! =========================================
    8191
    82   DO k=1, klev
    83      DO i=1, klon
    84         zen_d(i,k)=pen_d(i,k)
    85         zde_u(i,k)=pde_u(i,k)
    86         zde_d(i,k) =-zmfd(i,k+1)+zmfd(i,k)+zen_d(i,k)
    87         zen_u(i,k) = zmfu(i,k+1)-zmfu(i,k)+zde_u(i,k)
    88      ENDDO
    89   ENDDO
    90 ! =========================================
    91 ! calcul des flux dans le panache montant
    92 ! =========================================
     92  ! Dans la premiere couche, on prend q comme valeur de qu
    9393
    94 ! Dans la premiere couche, on prend q comme valeur de qu
    95 
    96   DO i=1, klon
    97      zmfux(i,1)=0.0
     94  DO i = 1, klon
     95    zmfux(i, 1) = 0.0
    9896  ENDDO
    9997
    100 ! Autres couches
    101   DO k=1,klev
    102      DO i=1, klon
    103         IF ((zmfu(i,k+1)+zde_u(i,k))<zmfmin) THEN
    104            xu(i,k)=x(i,k)
    105         ELSE
    106            xu(i,k)=(zmfux(i,k)+zen_u(i,k)*x(i,k))/(zmfu(i,k+1)+zde_u(i,k))
    107         ENDIF
    108         zmfux(i,k+1)=zmfu(i,k+1)*xu(i,k)
    109      ENDDO
     98  ! Autres couches
     99  DO k = 1, klev
     100    DO i = 1, klon
     101      IF ((zmfu(i, k + 1) + zde_u(i, k))<zmfmin) THEN
     102        xu(i, k) = x(i, k)
     103      ELSE
     104        xu(i, k) = (zmfux(i, k) + zen_u(i, k) * x(i, k)) / (zmfu(i, k + 1) + zde_u(i, k))
     105      ENDIF
     106      zmfux(i, k + 1) = zmfu(i, k + 1) * xu(i, k)
     107    ENDDO
    110108  ENDDO
    111 ! ==========================================
    112 ! calcul des flux dans le panache descendant
    113 ! ==========================================
    114    
    115   DO i=1, klon
    116      zmfdx(i,klev+1)=0.0
     109  ! ==========================================
     110  ! calcul des flux dans le panache descendant
     111  ! ==========================================
     112
     113  DO i = 1, klon
     114    zmfdx(i, klev + 1) = 0.0
    117115  ENDDO
    118116
    119   DO k=klev,1,-1
    120      DO i=1, klon
    121         IF ((zde_d(i,k)-zmfd(i,k))<zmfmin) THEN
    122            xd(i,k)=x(i,k)
    123         ELSE
    124            xd(i,k)=(zmfdx(i,k+1)-zen_d(i,k)*x(i,k))/(zmfd(i,k)-zde_d(i,k))
    125         ENDIF
    126         zmfdx(i,k)=zmfd(i,k)*xd(i,k)
    127      ENDDO
     117  DO k = klev, 1, -1
     118    DO i = 1, klon
     119      IF ((zde_d(i, k) - zmfd(i, k))<zmfmin) THEN
     120        xd(i, k) = x(i, k)
     121      ELSE
     122        xd(i, k) = (zmfdx(i, k + 1) - zen_d(i, k) * x(i, k)) / (zmfd(i, k) - zde_d(i, k))
     123      ENDIF
     124      zmfdx(i, k) = zmfd(i, k) * xd(i, k)
     125    ENDDO
    128126  ENDDO
    129 ! ===================================================
    130 ! introduction du flux de retour dans l'environnement
    131 ! ===================================================
     127  ! ===================================================
     128  ! introduction du flux de retour dans l'environnement
     129  ! ===================================================
    132130
    133   DO k=2, klev
    134      DO i=1, klon
    135         zmfe=-zmfu(i,k)-zmfd(i,k)
    136         IF (zmfe<=0.) THEN
    137            zmfex(i,k)= zmfe*x(i,k)
    138         ELSE
    139            zmfex(i,k)= zmfe*x(i,k-1)
    140         ENDIF
    141      ENDDO
     131  DO k = 2, klev
     132    DO i = 1, klon
     133      zmfe = -zmfu(i, k) - zmfd(i, k)
     134      IF (zmfe<=0.) THEN
     135        zmfex(i, k) = zmfe * x(i, k)
     136      ELSE
     137        zmfex(i, k) = zmfe * x(i, k - 1)
     138      ENDIF
     139    ENDDO
    142140  ENDDO
    143141
    144   DO i=1, klon
    145      zmfex(i,1)=0.
    146      zmfex(i,klev+1)=0.
     142  DO i = 1, klon
     143    zmfex(i, 1) = 0.
     144    zmfex(i, klev + 1) = 0.
    147145  ENDDO
    148 ! ==========================
    149 ! calcul final des tendances
    150 ! ==========================
    151   DO k=1, klev
    152      DO i=1, klon
    153         dx(i,k)=RG/(paprs(i,k)-paprs(i,k+1))*pdtime* &
    154              ( zmfux(i,k) - zmfux(i,k+1) +            &
    155              zmfdx(i,k) - zmfdx(i,k+1) +              &
    156              zmfex(i,k) - zmfex(i,k+1) )
    157      ENDDO
     146  ! ==========================
     147  ! calcul final des tendances
     148  ! ==========================
     149  DO k = 1, klev
     150    DO i = 1, klon
     151      dx(i, k) = RG / (paprs(i, k) - paprs(i, k + 1)) * pdtime * &
     152              (zmfux(i, k) - zmfux(i, k + 1) + &
     153                      zmfdx(i, k) - zmfdx(i, k + 1) + &
     154                      zmfex(i, k) - zmfex(i, k + 1))
     155    ENDDO
    158156  ENDDO
    159  
     157
    160158END SUBROUTINE nflxtr
Note: See TracChangeset for help on using the changeset viewer.