/[lmdze]/trunk/phylmd/cvltr.f

Diff of /trunk/phylmd/cvltr.f

Parent Directory | Revision Log | View Patch Patch

-trunk/libf/phylmd/cvltr.f
revision 3 by guez,
Wed Feb 27 13:16:39 2008 UTC
+trunk/phylmd/cvltr.f
revision 254 by guez,
Mon Feb  5 10:39:38 2018 UTC
 Line 1
- c
+ module cvltr_m
- c $Header: /home/cvsroot/LMDZ4/libf/phylmd/cvltr.F,v 1.1 2005/04/15 12:36:17 lmdzadmin Exp $
- c
+   IMPLICIT NONE
-       SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,pplay,x,upd,dnd,dx)
-       use dimens_m
+ contains
-       use dimphy
-       use YOMCST
+   SUBROUTINE cvltr(pdtime, da, phi, mp, paprs, x, upd, dnd, dx)
-       IMPLICIT NONE
- c=====================================================================
+     ! From LMDZ4/libf/phylmd/cvltr.F, version 1.1 2005/04/15 12:36:17
- c Objet : convection des traceurs / KE
- c Auteurs: M-A Filiberti and J-Y Grandpeix
+     USE dimphy, ONLY: klev, klon
- c=====================================================================
+     USE suphec_m, ONLY: rg
- c
-       include "YOECUMF.h"
+     ! Objet : convection des traceurs / Kerry Emanuel
- c
+     ! Authors: M.-A. Filiberti and J.-Y. Grandpeix
-       REAL pdtime
-       REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)
+     REAL, intent(in):: pdtime
-       REAL pplay(klon,klev)  ! pression pour le milieu de chaque couche
+     real, intent(in):: da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
-       REAL x(klon,klev)        ! q de traceur (bas en haut)
+     REAL, intent(in):: paprs(klon, klev + 1) ! pression aux 1/2 couches
-       REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
+     REAL, intent(in):: x(klon, klev) ! q de traceur (bas en haut)
-       real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
+     REAL, intent(in):: upd(klon, klev) ! saturated updraft mass flux
-       REAL upd(klon,klev)      ! saturated updraft mass flux
+     REAL, intent(in):: dnd(klon, klev) ! saturated downdraft mass flux
-       REAL dnd(klon,klev)      ! saturated downdraft mass flux
+     REAL, intent(out):: dx(klon, klev) ! tendance de traceur (bas en haut)
- c
- c--variables locales
+     ! Local:
-       real zed(klon,klev),zmd(klon,klev,klev)
+     real zed(klon, klev), zmd(klon, klev, klev)
-       real za(klon,klev,klev)
+     real za(klon, klev, klev)
-       real zmfd(klon,klev),zmfa(klon,klev)
+     real zmfd(klon, klev), zmfa(klon, klev)
-       real zmfp(klon,klev),zmfu(klon,klev)
+     real zmfp(klon, klev), zmfu(klon, klev)
-       integer i,k,j
+     integer i, k, j
- c test conservation
- c      real conserv
+     !------------------------------------------------------------
- c =========================================
- c calcul des tendances liees au downdraft
+     ! calcul des tendances liees au downdraft
- c =========================================
-       zed(:,:)=0.
+     zed = 0.
-       zmfd(:,:)=0.
+     zmfd = 0.
-       zmfa(:,:)=0.
+     zmfa = 0.
-       zmfu(:,:)=0.
+     zmfu = 0.
-       zmfp(:,:)=0.
+     zmfp = 0.
-       zmd(:,:,:)=0.
+     zmd = 0.
-       za(:,:,:)=0.
+     za = 0.
- c entrainement
+     ! entrainement
-       do k=1,klev-1
+     do k = 1, klev - 1
-         do i=1,klon
+        do i = 1, klon
-           zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
+           zed(i, k) = max(0., mp(i, k) - mp(i, k + 1))
-         end do
+        end do
-       end do
+     end do
- c
- c calcul de la matrice d echange
+     ! calcul de la matrice d echange
- c matrice de distribution de la masse entrainee en k
+     ! matrice de distribution de la masse entrainee en k
- c
-       do k=1,klev
+     do k = 1, klev
-         do i=1,klon
+        do i = 1, klon
-           zmd(i,k,k)=zed(i,k)
+           zmd(i, k, k) = zed(i, k)
-         end do
+        end do
-       end do
+     end do
-       do k=2,klev
+     do k = 2, klev
-         do j=k-1,1,-1
+        do j = k - 1, 1, - 1
-           do i=1,klon
+           do i = 1, klon
-           if(mp(i,j+1).ne.0) then
+              if(mp(i, j + 1) /= 0) then
-           zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
+                 zmd(i, j, k) = zmd(i, j + 1, k) * min(1., mp(i, j)/mp(i, j + 1))
-           endif
+              endif
            end do
-         end do
+        end do
-       end do
+     end do
-       do k=1,klev
+     do k = 1, klev
-         do j=1,klev-1
+        do j = 1, klev - 1
-           do i=1,klon
+           do i = 1, klon
-           za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
+              za(i, j, k) = max(0., zmd(i, j + 1, k) - zmd(i, j, k))
            end do
-         end do
+        end do
-       end do
+     end do
- c
- c rajout du terme lie a l ascendance induite
+     ! rajout du terme lie a l'ascendance induite
- c
-         do j=2,klev
+     do j = 2, klev
-          do i=1,klon
+        do i = 1, klon
-           za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
+           za(i, j, j - 1) = za(i, j, j - 1) + mp(i, j)
-          end do
+        end do
-         end do
+     end do
- C
- c tendances
+     ! tendances
- c
-       do k=1,klev
+     do k = 1, klev
-         do j=1,klev
+        do j = 1, klev
-           do i=1,klon
+           do i = 1, klon
-           zmfd(i,j)=zmfd(i,j)+za(i,j,k)*(x(i,k)-x(i,j))
+              zmfd(i, j) = zmfd(i, j) + za(i, j, k) * (x(i, k) - x(i, j))
            end do
-         end do
+        end do
-       end do
+     end do
- c
- c =========================================
+     ! calcul des tendances liees aux flux satures
- c calcul des tendances liees aux flux satures
- c =========================================
+     do j = 1, klev
-       do j=1,klev
+        do i = 1, klon
-         do i=1,klon
+           zmfa(i, j) = da(i, j) * (x(i, 1) - x(i, j))
-           zmfa(i,j)=da(i,j)*(x(i,1)-x(i,j))
+        end do
-         end do
+     end do
-       end do
+     do k = 1, klev
-       do k=1,klev
+        do j = 1, klev
-         do j=1,klev
+           do i = 1, klon
-           do i=1,klon
+              zmfp(i, j) = zmfp(i, j) + phi(i, j, k) * (x(i, k) - x(i, j))
-           zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k)-x(i,j))
            end do
-         end do
+        end do
-       end do
+     end do
-       do j=1,klev-1
+     do j = 1, klev - 1
-         do i=1,klon
+        do i = 1, klon
-           zmfu(i,j)=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1)-x(i,j))
+           zmfu(i, j) = max(0., upd(i, j + 1) + dnd(i, j + 1)) &
-         end do
+                * (x(i, j + 1) - x(i, j))
-       end do
+        end do
-       do j=2,klev
+     end do
-         do i=1,klon
+     do j = 2, klev
-           zmfu(i,j)=zmfu(i,j)
+        do i = 1, klon
-      .             +min(0.,upd(i,j)+dnd(i,j))*(x(i,j)-x(i,j-1))
+           zmfu(i, j) = zmfu(i, j) &
-         end do
+                + min(0., upd(i, j) + dnd(i, j)) * (x(i, j) - x(i, j - 1))
-       end do
+        end do
+     end do
- c =========================================
- c--calcul final des tendances
+     ! calcul final des tendances
- c =========================================
-       do k=1, klev
+     do k = 1, klev
-         do i=1, klon
+        do i = 1, klon
-           dx(i,k)=(zmfd(i,k)+zmfu(i,k)
+           dx(i, k) = (zmfd(i, k) + zmfu(i, k) &
-      .      +zmfa(i,k)+zmfp(i,k))*pdtime
+                + zmfa(i, k) + zmfp(i, k)) * pdtime &
-      .      *RG/(paprs(i,k)-paprs(i,k+1))
+                * RG/(paprs(i, k) - paprs(i, k + 1))
- c          print*,'dx',k,dx(i,k)
+        enddo
-         enddo
+     enddo
-       enddo
- c
+   end SUBROUTINE cvltr
- c test de conservation du traceur
- c      conserv=0.
+ end module cvltr_m
- c      do k=1, klev
- c        do i=1, klon
- c         conserv=conserv+dx(i,k)*
- c     .     (paprs(i,k)-paprs(i,k+1))/RG
- C
- c        enddo
- c      enddo
- c      print *,'conserv',conserv
-       return
-       end

 Legend:



Removed from v.3
 


changed lines


 
Added in v.254
 Legend:



Removed from v.3
 


changed lines


 
Added in v.254
-Removed from v.3
+Added in v.254

	ViewVC Help
Powered by ViewVC 1.1.21