Ignore:
Timestamp:
Mar 5, 2014, 2:19:12 PM (10 years ago)
Author:
lguez
Message:

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/flxtr.F90

    r1988 r1992  
    1 !
     1
    22! $Header$
    3 !
    4       SUBROUTINE flxtr(pdtime,pmfu,pmfd,pen_u,pde_u,pen_d,pde_d,
    5      .                 pt,pplay,paprs,kcbot,kctop,kdtop,x,dx)
    6       USE dimphy
    7       IMPLICIT NONE
    8 c=====================================================================
    9 c Objet : Melange convectif de traceurs a partir des flux de masse
    10 c Date : 13/12/1996 -- 13/01/97
    11 c Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
    12 c         Brinkop et Sausen (1996) et Boucher et al. (1996).
    13 c ATTENTION : meme si cette routine se veut la plus generale possible,
    14 c             elle a herite de certaines notations et conventions du
    15 c             schema de Tiedtke (1993).
    16 c --En particulier, les couches sont numerotees de haut en bas !!!
    17 c   Ceci est valable pour les flux, kcbot, kctop et kdtop
    18 c   mais pas pour les entrees x, pplay, paprs !!!!
    19 c --Un schema amont est choisi pour calculer les flux pour s'assurer
    20 c   de la positivite des valeurs de traceurs, cela implique des eqs
    21 c   differentes pour les flux de traceurs montants et descendants.
    22 c --pmfu est positif, pmfd est negatif
    23 c --Tous les flux d'entrainements et de detrainements sont positifs
    24 c   contrairement au schema de Tiedtke d'ou les changements de signe!!!!
    25 c=====================================================================
    26 c
    27 cym#include "dimensions.h"
    28 cym#include "dimphy.h"
    29 #include "YOMCST.h"
    30 #include "YOECUMF.h"
    31 c
    32       REAL pdtime
    33 c--les flux sont definis au 1/2 niveaux
    34 c--pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
    35       REAL pmfu(klon,klev)  ! flux de masse dans le panache montant
    36       REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
    37       REAL pen_u(klon,klev) ! flux entraine dans le panache montant
    38       REAL pde_u(klon,klev) ! flux detraine dans le panache montant
    39       REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
    40       REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
    41 c--idem mais en variables locales
    42       REAL zpen_u(klon,klev)
    43       REAL zpde_u(klon,klev)
    44       REAL zpen_d(klon,klev)
    45       REAL zpde_d(klon,klev)
    46 c
    47       REAL pplay(klon,klev)    ! pression aux couches (bas en haut)
    48       REAL pap(klon,klev)      ! pression aux couches (haut en bas)
    49       REAL pt(klon,klev)       ! temperature aux couches (bas en haut)
    50       REAL zt(klon,klev)       ! temperature aux couches (haut en bas)
    51       REAL paprs(klon,klev+1)  ! pression aux 1/2 couches (bas en haut)
    52       REAL paph(klon,klev+1)   ! pression aux 1/2 couches (haut en bas)
    53       INTEGER kcbot(klon)      ! niveau de base de la convection
    54       INTEGER kctop(klon)      ! niveau du sommet de la convection +1
    55       INTEGER kdtop(klon)      ! niveau de sommet du panache descendant
    56       REAL x(klon,klev)        ! q de traceur (bas en haut)
    57       REAL zx(klon,klev)       ! q de traceur (haut en bas)
    58       REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
    59 c
    60 c--variables locales     
    61 c--les flux de x sont definis aux 1/2 niveaux
    62 c--xu et xd sont definis aux niveaux complets
    63       REAL xu(klon,klev)        ! q de traceurs dans le panache montant
    64       REAL xd(klon,klev)        ! q de traceurs dans le panache descendant
    65       REAL xe(klon,klev)        ! q de traceurs dans l'environnement
    66       REAL zmfux(klon,klev+1)   ! flux de x dans le panache montant
    67       REAL zmfdx(klon,klev+1)   ! flux de x dans le panache descendant
    68       REAL zmfex(klon,klev+1)   ! flux de x dans l'environnement
    69       INTEGER i, k
    70       REAL zmfmin
    71       PARAMETER (zmfmin=1.E-10)
    72 c
    73 c On remet les taux d'entrainement et de detrainement dans le panache
    74 c descendant a des valeurs positives.
    75 c On ajuste les valeurs de pen_u, pen_d pde_u et pde_d pour que la
    76 c conservation de la masse soit realisee a chaque niveau dans les 2
    77 c panaches.
    78       DO k=1, klev
    79       DO i=1, klon
    80         zpen_u(i,k)= pen_u(i,k)
    81         zpde_u(i,k)= pde_u(i,k)
    82       ENDDO
    83       ENDDO
    84 c
    85       DO k=1, klev-1
    86       DO i=1, klon
    87         zpen_d(i,k)=-pen_d(i,k+1)
    88         zpde_d(i,k)=-pde_d(i,k+1)
    89       ENDDO
    90       ENDDO
    91 c
    92       DO i=1, klon
    93       zpen_d(i,klev)       = 0.0
    94       zpde_d(i,klev)       = -pmfd(i,klev)
    95 c   Correction 03 11 97
    96 c     zpen_d(i,kdtop(i)-1) = pmfd(i,kdtop(i)-1)-pmfd(i,kdtop(i))
    97       IF (kdtop(i).EQ.klev+1) THEN
    98       zpen_d(i,kdtop(i)-1) = pmfd(i,kdtop(i)-1)
     3
     4SUBROUTINE flxtr(pdtime, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, pt, pplay, &
     5    paprs, kcbot, kctop, kdtop, x, dx)
     6  USE dimphy
     7  IMPLICIT NONE
     8  ! =====================================================================
     9  ! Objet : Melange convectif de traceurs a partir des flux de masse
     10  ! Date : 13/12/1996 -- 13/01/97
     11  ! Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
     12  ! Brinkop et Sausen (1996) et Boucher et al. (1996).
     13  ! ATTENTION : meme si cette routine se veut la plus generale possible,
     14  ! elle a herite de certaines notations et conventions du
     15  ! schema de Tiedtke (1993).
     16  ! --En particulier, les couches sont numerotees de haut en bas !!!
     17  ! Ceci est valable pour les flux, kcbot, kctop et kdtop
     18  ! mais pas pour les entrees x, pplay, paprs !!!!
     19  ! --Un schema amont est choisi pour calculer les flux pour s'assurer
     20  ! de la positivite des valeurs de traceurs, cela implique des eqs
     21  ! differentes pour les flux de traceurs montants et descendants.
     22  ! --pmfu est positif, pmfd est negatif
     23  ! --Tous les flux d'entrainements et de detrainements sont positifs
     24  ! contrairement au schema de Tiedtke d'ou les changements de signe!!!!
     25  ! =====================================================================
     26
     27  ! ym#include "dimensions.h"
     28  ! ym#include "dimphy.h"
     29  include "YOMCST.h"
     30  include "YOECUMF.h"
     31
     32  REAL pdtime
     33  ! --les flux sont definis au 1/2 niveaux
     34  ! --pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
     35  REAL pmfu(klon, klev) ! flux de masse dans le panache montant
     36  REAL pmfd(klon, klev) ! flux de masse dans le panache descendant
     37  REAL pen_u(klon, klev) ! flux entraine dans le panache montant
     38  REAL pde_u(klon, klev) ! flux detraine dans le panache montant
     39  REAL pen_d(klon, klev) ! flux entraine dans le panache descendant
     40  REAL pde_d(klon, klev) ! flux detraine dans le panache descendant
     41  ! --idem mais en variables locales
     42  REAL zpen_u(klon, klev)
     43  REAL zpde_u(klon, klev)
     44  REAL zpen_d(klon, klev)
     45  REAL zpde_d(klon, klev)
     46
     47  REAL pplay(klon, klev) ! pression aux couches (bas en haut)
     48  REAL pap(klon, klev) ! pression aux couches (haut en bas)
     49  REAL pt(klon, klev) ! temperature aux couches (bas en haut)
     50  REAL zt(klon, klev) ! temperature aux couches (haut en bas)
     51  REAL paprs(klon, klev+1) ! pression aux 1/2 couches (bas en haut)
     52  REAL paph(klon, klev+1) ! pression aux 1/2 couches (haut en bas)
     53  INTEGER kcbot(klon) ! niveau de base de la convection
     54  INTEGER kctop(klon) ! niveau du sommet de la convection +1
     55  INTEGER kdtop(klon) ! niveau de sommet du panache descendant
     56  REAL x(klon, klev) ! q de traceur (bas en haut)
     57  REAL zx(klon, klev) ! q de traceur (haut en bas)
     58  REAL dx(klon, klev) ! tendance de traceur  (bas en haut)
     59
     60  ! --variables locales
     61  ! --les flux de x sont definis aux 1/2 niveaux
     62  ! --xu et xd sont definis aux niveaux complets
     63  REAL xu(klon, klev) ! q de traceurs dans le panache montant
     64  REAL xd(klon, klev) ! q de traceurs dans le panache descendant
     65  REAL xe(klon, klev) ! q de traceurs dans l'environnement
     66  REAL zmfux(klon, klev+1) ! flux de x dans le panache montant
     67  REAL zmfdx(klon, klev+1) ! flux de x dans le panache descendant
     68  REAL zmfex(klon, klev+1) ! flux de x dans l'environnement
     69  INTEGER i, k
     70  REAL zmfmin
     71  PARAMETER (zmfmin=1.E-10)
     72
     73  ! On remet les taux d'entrainement et de detrainement dans le panache
     74  ! descendant a des valeurs positives.
     75  ! On ajuste les valeurs de pen_u, pen_d pde_u et pde_d pour que la
     76  ! conservation de la masse soit realisee a chaque niveau dans les 2
     77  ! panaches.
     78  DO k = 1, klev
     79    DO i = 1, klon
     80      zpen_u(i, k) = pen_u(i, k)
     81      zpde_u(i, k) = pde_u(i, k)
     82    END DO
     83  END DO
     84
     85  DO k = 1, klev - 1
     86    DO i = 1, klon
     87      zpen_d(i, k) = -pen_d(i, k+1)
     88      zpde_d(i, k) = -pde_d(i, k+1)
     89    END DO
     90  END DO
     91
     92  DO i = 1, klon
     93    zpen_d(i, klev) = 0.0
     94    zpde_d(i, klev) = -pmfd(i, klev)
     95    ! Correction 03 11 97
     96    ! zpen_d(i,kdtop(i)-1) = pmfd(i,kdtop(i)-1)-pmfd(i,kdtop(i))
     97    IF (kdtop(i)==klev+1) THEN
     98      zpen_d(i, kdtop(i)-1) = pmfd(i, kdtop(i)-1)
     99    ELSE
     100      zpen_d(i, kdtop(i)-1) = pmfd(i, kdtop(i)-1) - pmfd(i, kdtop(i))
     101    END IF
     102
     103    zpde_u(i, kctop(i)-2) = pmfu(i, kctop(i)-1)
     104    zpen_u(i, klev) = pmfu(i, klev)
     105  END DO
     106
     107  DO i = 1, klon
     108    DO k = kcbot(i), klev - 1
     109      zpen_u(i, k) = pmfu(i, k) - pmfu(i, k+1)
     110    END DO
     111  END DO
     112
     113  ! conversion des sens de notations bas-haut et haut-bas
     114
     115  DO k = 1, klev + 1
     116    DO i = 1, klon
     117      paph(i, klev+2-k) = paprs(i, k)
     118    END DO
     119  END DO
     120
     121  DO i = 1, klon
     122    DO k = 1, klev
     123      pap(i, klev+1-k) = pplay(i, k)
     124      zt(i, klev+1-k) = pt(i, k)
     125      zx(i, klev+1-k) = x(i, k)
     126    END DO
     127  END DO
     128
     129  ! --initialisations des flux de traceurs aux extremites de la colonne
     130
     131  DO i = 1, klon
     132    zmfux(i, klev+1) = 0.0
     133    zmfdx(i, 1) = 0.0
     134    zmfex(i, 1) = 0.0
     135  END DO
     136
     137  ! --calcul des flux dans le panache montant
     138
     139  DO k = klev, 1, -1
     140    DO i = 1, klon
     141      IF (k>=kcbot(i)) THEN
     142        xu(i, k) = zx(i, k)
     143        zmfux(i, k) = pmfu(i, k)*xu(i, k)
    99144      ELSE
    100       zpen_d(i,kdtop(i)-1) = pmfd(i,kdtop(i)-1)-pmfd(i,kdtop(i))
    101       ENDIF
    102 
    103       zpde_u(i,kctop(i)-2) = pmfu(i,kctop(i)-1)
    104       zpen_u(i,klev)       = pmfu(i,klev)
    105       ENDDO
    106 c
    107       DO i=1, klon
    108       DO k=kcbot(i), klev-1
    109       zpen_u(i,k) = pmfu(i,k) - pmfu(i,k+1)
    110       ENDDO
    111       ENDDO
    112 c
    113 c conversion des sens de notations bas-haut et haut-bas
    114 c
    115       DO k=1, klev+1
    116       DO i=1, klon
    117         paph(i,klev+2-k)=paprs(i,k)
    118       ENDDO
    119       ENDDO
    120 c
    121       DO i=1, klon
    122       DO k=1, klev
    123         pap(i,klev+1-k)=pplay(i,k)
    124         zt(i,klev+1-k) =pt(i,k)
    125         zx(i,klev+1-k) =x(i,k)
    126       ENDDO
    127       ENDDO
    128 c
    129 c--initialisations des flux de traceurs aux extremites de la colonne
    130 c
    131       DO i=1, klon
    132         zmfux(i,klev+1) = 0.0
    133         zmfdx(i,1) = 0.0
    134         zmfex(i,1) = 0.0
    135       ENDDO
    136 c
    137 c--calcul des flux dans le panache montant
    138 c
    139       DO k=klev, 1, -1
    140       DO i=1, klon
    141        IF (k.GE.kcbot(i)) THEN
    142          xu(i,k)=zx(i,k)
    143          zmfux(i,k)=pmfu(i,k)*xu(i,k)
    144        ELSE
    145          zmfux(i,k)= (zmfux(i,k+1) + zpen_u(i,k)*zx(i,k) ) /
    146      .               (1.+zpde_u(i,k)/MAX(zmfmin,pmfu(i,k)))
    147          xu(i,k)=zmfux(i,k)/MAX(zmfmin,pmfu(i,k))
    148        ENDIF
    149       ENDDO
    150       ENDDO
    151 c
    152 c--calcul des flux dans le panache descendant
    153 c
    154       DO k=1, klev-1
    155       DO i=1, klon
    156        IF (k.LE.kdtop(i)-1) THEN
    157          xd(i,k)=( zx(i,k)+xu(i,k) ) / 2.
    158          zmfdx(i,k+1)=pmfd(i,k+1)*xd(i,k)
    159        ELSE
    160          zmfdx(i,k+1)= (zmfdx(i,k) - zpen_d(i,k)*zx(i,k) ) /
    161      .               (1.-zpde_d(i,k)/MIN(-zmfmin,pmfd(i,k+1)))
    162          xd(i,k)=zmfdx(i,k+1)/MIN(-zmfmin,pmfd(i,k+1))
    163        ENDIF
    164       ENDDO
    165       ENDDO
    166       DO i=1, klon
    167          zmfdx(i,klev+1) = 0.0
    168          xd(i,klev) = (zpen_d(i,klev)*zx(i,klev) - zmfdx(i,klev)) /
    169      .                   MAX(zmfmin,zpde_d(i,klev))
    170       ENDDO
    171 c
    172 c--introduction du flux de retour dans l'environnement
    173 c
    174       DO k=1, klev-1
    175       DO i=1, klon
    176        IF (k.LE.kctop(i)-3) THEN
    177          xe(i,k)= zx(i,k)
    178          zmfex(i,k+1)=-(pmfu(i,k+1)+pmfd(i,k+1))*xe(i,k)
    179        ELSE
    180          zmfex(i,k+1)= (zmfex(i,k) -
    181      .      (zpde_u(i,k)*xu(i,k)+zpde_d(i,k)*xd(i,k))) /
    182      .      (1.-(zpen_d(i,k)+zpen_u(i,k))/
    183      .      MIN(-zmfmin,-pmfu(i,k+1)-pmfd(i,k+1)) )
    184          xe(i,k)=zmfex(i,k+1)/MIN(-zmfmin,-pmfu(i,k+1)-pmfd(i,k+1))
    185        ENDIF
    186       ENDDO
    187       ENDDO
    188       DO i=1, klon
    189          zmfex(i,klev+1) = 0.0
    190          xe(i,klev) = (zpde_u(i,klev)*xu(i,klev) +
    191      .                 zpde_d(i,klev)*xd(i,klev) -zmfex(i,klev)) /
    192      .                 MAX(zmfmin,zpen_u(i,klev)+zpen_d(i,klev))
    193       ENDDO
    194 c
    195 c--calcul final des tendances
    196 c
    197       DO k=1 , klev
    198       DO i=1, klon
    199         dx(i,klev+1-k) = RG/(paph(i,k+1)-paph(i,k))*pdtime*
    200      .                      ( zmfux(i,k+1) - zmfux(i,k) +
    201      .                        zmfdx(i,k+1) - zmfdx(i,k) +
    202      .                        zmfex(i,k+1) - zmfex(i,k) )
    203       ENDDO
    204       ENDDO
    205 c
    206       RETURN
    207       END
     145        zmfux(i, k) = (zmfux(i,k+1)+zpen_u(i,k)*zx(i,k))/ &
     146          (1.+zpde_u(i,k)/max(zmfmin,pmfu(i,k)))
     147        xu(i, k) = zmfux(i, k)/max(zmfmin, pmfu(i,k))
     148      END IF
     149    END DO
     150  END DO
     151
     152  ! --calcul des flux dans le panache descendant
     153
     154  DO k = 1, klev - 1
     155    DO i = 1, klon
     156      IF (k<=kdtop(i)-1) THEN
     157        xd(i, k) = (zx(i,k)+xu(i,k))/2.
     158        zmfdx(i, k+1) = pmfd(i, k+1)*xd(i, k)
     159      ELSE
     160        zmfdx(i, k+1) = (zmfdx(i,k)-zpen_d(i,k)*zx(i,k))/ &
     161          (1.-zpde_d(i,k)/min(-zmfmin,pmfd(i,k+1)))
     162        xd(i, k) = zmfdx(i, k+1)/min(-zmfmin, pmfd(i,k+1))
     163      END IF
     164    END DO
     165  END DO
     166  DO i = 1, klon
     167    zmfdx(i, klev+1) = 0.0
     168    xd(i, klev) = (zpen_d(i,klev)*zx(i,klev)-zmfdx(i,klev))/ &
     169      max(zmfmin, zpde_d(i,klev))
     170  END DO
     171
     172  ! --introduction du flux de retour dans l'environnement
     173
     174  DO k = 1, klev - 1
     175    DO i = 1, klon
     176      IF (k<=kctop(i)-3) THEN
     177        xe(i, k) = zx(i, k)
     178        zmfex(i, k+1) = -(pmfu(i,k+1)+pmfd(i,k+1))*xe(i, k)
     179      ELSE
     180        zmfex(i, k+1) = (zmfex(i,k)-(zpde_u(i,k)*xu(i,k)+zpde_d(i,k)*xd(i, &
     181          k)))/(1.-(zpen_d(i,k)+zpen_u(i,k))/min(-zmfmin,-pmfu(i,k+1)-pmfd(i, &
     182          k+1)))
     183        xe(i, k) = zmfex(i, k+1)/min(-zmfmin, -pmfu(i,k+1)-pmfd(i,k+1))
     184      END IF
     185    END DO
     186  END DO
     187  DO i = 1, klon
     188    zmfex(i, klev+1) = 0.0
     189    xe(i, klev) = (zpde_u(i,klev)*xu(i,klev)+zpde_d(i,klev)*xd(i,klev)-zmfex( &
     190      i,klev))/max(zmfmin, zpen_u(i,klev)+zpen_d(i,klev))
     191  END DO
     192
     193  ! --calcul final des tendances
     194
     195  DO k = 1, klev
     196    DO i = 1, klon
     197      dx(i, klev+1-k) = rg/(paph(i,k+1)-paph(i,k))*pdtime* &
     198        (zmfux(i,k+1)-zmfux(i,k)+zmfdx(i,k+1)-zmfdx(i,k)+zmfex(i,k+1)- &
     199        zmfex(i,k))
     200    END DO
     201  END DO
     202
     203  RETURN
     204END SUBROUTINE flxtr
Note: See TracChangeset for help on using the changeset viewer.