Changeset 1992 for LMDZ5/trunk/libf/phylmd/coefkzmin.F90

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:

• LMDZ5/trunk/libf/phylmd/coefkzmin.F90 (moved) (moved from LMDZ5/trunk/libf/phylmd/coefkzmin.F) (1 diff)

LMDZ5/trunk/libf/phylmd/coefkzmin.F90

@@ -1 @@
-!
-       SUBROUTINE coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,yq,ycdragm
-     .   ,km,kn)
 
-      USE dimphy
-      IMPLICIT NONE
+SUBROUTINE coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycdragm, km, kn)
 
-      include "YOMCST.h"
+  USE dimphy
+  IMPLICIT NONE
 
-c.......................................................................
-c  Entrees modifies en attendant une version ou les zlev, et zlay soient
-c  disponibles.
+  include "YOMCST.h"
 
-      REAL  ycdragm(klon)
+  ! .......................................................................
+  ! Entrees modifies en attendant une version ou les zlev, et zlay soient
+  ! disponibles.
 
-      REAL yu(klon,klev), yv(klon,klev)
-      REAL yt(klon,klev), yq(klon,klev)
-      REAL ypaprs(klon,klev+1), ypplay(klon,klev)
-      REAL yustar(klon)
-      real yzlay(klon,klev),yzlev(klon,klev+1),yteta(klon,klev)
+  REAL ycdragm(klon)
 
-      integer i
+  REAL yu(klon, klev), yv(klon, klev)
+  REAL yt(klon, klev), yq(klon, klev)
+  REAL ypaprs(klon, klev+1), ypplay(klon, klev)
+  REAL yustar(klon)
+  REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
 
-c.......................................................................
-c
-c  En entree :
-c  -----------
-c
-c zlev : altitude a chaque niveau (interface inferieure de la couche
-c        de meme indice)
-c ustar : u*
-c
-c teta : temperature potentielle au centre de chaque couche
-c        (en entree : la valeur au debut du pas de temps)
-c
-c  en sortier :
-c  ------------
-c
-c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
-c      couche)
-c      (en sortie : la valeur a la fin du pas de temps)
-c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
-c      (en sortie : la valeur a la fin du pas de temps)
-c
-c.......................................................................
+  INTEGER i
 
-      real ustar(klon)
-      real kmin,qmin,pblhmin(klon),coriol(klon)
-      REAL zlev(klon,klev+1)
-      REAL teta(klon,klev)
+  ! .......................................................................
 
-      REAL km(klon,klev)
-      REAL kn(klon,klev)
-      integer knon
+  ! En entree :
+  ! -----------
+
+  ! zlev : altitude a chaque niveau (interface inferieure de la couche
+  ! de meme indice)
+  ! ustar : u*
+
+  ! teta : temperature potentielle au centre de chaque couche
+  ! (en entree : la valeur au debut du pas de temps)
+
+  ! en sortier :
+  ! ------------
+
+  ! km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+  ! couche)
+  ! (en sortie : la valeur a la fin du pas de temps)
+  ! kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+  ! (en sortie : la valeur a la fin du pas de temps)
+
+  ! .......................................................................
+
+  REAL ustar(klon)
+  REAL kmin, qmin, pblhmin(klon), coriol(klon)
+  REAL zlev(klon, klev+1)
+  REAL teta(klon, klev)
+
+  REAL km(klon, klev)
+  REAL kn(klon, klev)
+  INTEGER knon
 
 
-      integer nlay,nlev
-      integer ig,k
+  INTEGER nlay, nlev
+  INTEGER ig, k
 
-      real,parameter :: kap=0.4
+  REAL, PARAMETER :: kap = 0.4
 
-      nlay=klev
-      nlev=klev+1
-c.......................................................................
-c  en attendant une version ou les zlev, et zlay soient
-c  disponibles.
-c  Debut de la partie qui doit etre unclue a terme dans clmain.
-c
-         do i=1,knon
-            yzlay(i,1)=RD*yt(i,1)/(0.5*(ypaprs(i,1)+ypplay(i,1)))
-     .                *(ypaprs(i,1)-ypplay(i,1))/RG
-         enddo
-         do k=2,klev
-            do i=1,knon
-               yzlay(i,k)=yzlay(i,k-1)+RD*0.5*(yt(i,k-1)+yt(i,k))
-     s                /ypaprs(i,k)*(ypplay(i,k-1)-ypplay(i,k))/RG
-            enddo
-         enddo
-         do k=1,klev
-            do i=1,knon
-cATTENTION:on passe la temperature potentielle virt. pour le calcul de K
-             yteta(i,k)=yt(i,k)*(ypaprs(i,1)/ypplay(i,k))**rkappa
-     s          *(1.+0.61*yq(i,k))
-            enddo
-         enddo
-         do i=1,knon
-            yzlev(i,1)=0.
-            yzlev(i,klev+1)=2.*yzlay(i,klev)-yzlay(i,klev-1)
-         enddo
-         do k=2,klev
-            do i=1,knon
-               yzlev(i,k)=0.5*(yzlay(i,k)+yzlay(i,k-1))
-            enddo
-         enddo
+  nlay = klev
+  nlev = klev + 1
+  ! .......................................................................
+  ! en attendant une version ou les zlev, et zlay soient
+  ! disponibles.
+  ! Debut de la partie qui doit etre unclue a terme dans clmain.
 
-      yustar(1:knon) =SQRT(ycdragm(1:knon)*
-     $       (yu(1:knon,1)*yu(1:knon,1)+yv(1:knon,1)*yv(1:knon,1)))
+  DO i = 1, knon
+    yzlay(i, 1) = rd*yt(i, 1)/(0.5*(ypaprs(i,1)+ypplay(i, &
+      1)))*(ypaprs(i,1)-ypplay(i,1))/rg
+  END DO
+  DO k = 2, klev
+    DO i = 1, knon
+      yzlay(i, k) = yzlay(i, k-1) + rd*0.5*(yt(i,k-1)+yt(i,k))/ypaprs(i, k)*( &
+        ypplay(i,k-1)-ypplay(i,k))/rg
+    END DO
+  END DO
+  DO k = 1, klev
+    DO i = 1, knon
+      ! ATTENTION:on passe la temperature potentielle virt. pour le calcul de
+      ! K
+      yteta(i, k) = yt(i, k)*(ypaprs(i,1)/ypplay(i,k))**rkappa* &
+        (1.+0.61*yq(i,k))
+    END DO
+  END DO
+  DO i = 1, knon
+    yzlev(i, 1) = 0.
+    yzlev(i, klev+1) = 2.*yzlay(i, klev) - yzlay(i, klev-1)
+  END DO
+  DO k = 2, klev
+    DO i = 1, knon
+      yzlev(i, k) = 0.5*(yzlay(i,k)+yzlay(i,k-1))
+    END DO
+  END DO
 
-c  Fin de la partie qui doit etre unclue a terme dans clmain.
+  yustar(1:knon) = sqrt(ycdragm(1:knon)*(yu(1:knon,1)*yu(1:knon,1)+yv(1:knon, &
+    1)*yv(1:knon,1)))
 
-Cette routine est ecrite pour avoir en entree ustar, teta et zlev
-c  Ici, on a inclut le calcul de ces trois variables dans la routine
-c  coefkzmin en attendant une nouvelle version de la couche limite
-c  ou ces variables seront disponibles.
+  ! Fin de la partie qui doit etre unclue a terme dans clmain.
 
-c Debut de la routine coefkzmin proprement dite.
+  ! ette routine est ecrite pour avoir en entree ustar, teta et zlev
+  ! Ici, on a inclut le calcul de ces trois variables dans la routine
+  ! coefkzmin en attendant une nouvelle version de la couche limite
+  ! ou ces variables seront disponibles.
 
-      ustar=yustar
-      teta=yteta
-      zlev=yzlev
+  ! Debut de la routine coefkzmin proprement dite.
 
-      do ig=1,knon
-         coriol(ig)=1.e-4
-         pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
-      enddo
-         
-      do k=2,klev
-         do ig=1,knon
-            if (teta(ig,2).gt.teta(ig,1)) then
-               qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
-               kmin=kap*zlev(ig,k)*qmin
-            else
-               kmin=0. ! kmin n'est utilise que pour les SL stables.
-            endif 
-            kn(ig,k)=kmin
-            km(ig,k)=kmin
-         enddo
-      enddo
+  ustar = yustar
+  teta = yteta
+  zlev = yzlev
+
+  DO ig = 1, knon
+    coriol(ig) = 1.E-4
+    pblhmin(ig) = 0.07*ustar(ig)/max(abs(coriol(ig)), 2.546E-5)
+  END DO
+
+  DO k = 2, klev
+    DO ig = 1, knon
+      IF (teta(ig,2)>teta(ig,1)) THEN
+        qmin = ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
+        kmin = kap*zlev(ig, k)*qmin
+      ELSE
+        kmin = 0. ! kmin n'est utilise que pour les SL stables.
+      END IF
+      kn(ig, k) = kmin
+      km(ig, k) = kmin
+    END DO
+  END DO
 
 
-      return
-      end
+  RETURN
+END SUBROUTINE coefkzmin