Changeset 5158 for LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90

Timestamp:

Aug 2, 2024, 2:12:03 PM (3 months ago)

Author:

abarral

Message:

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

File:

• LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90 (modified) (20 diffs)

LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90

@@ -133 +133 @@
 
     !------------Test sur le LCL des thermiques
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       ok_lcl(ig) = .FALSE.
       IF ((pcon(ig) > pplay(ig, nlay - 1)) .AND. (pcon(ig) < pplay(ig, 1))) ok_lcl(ig) = .TRUE.
@@ -139 +139 @@
 
     !------------Localisation des niveaux entourant le LCL et du coef d'interpolation
-    do l = 1, nlay - 1
-      do ig = 1, ngrid
+    DO l = 1, nlay - 1
+      DO ig = 1, ngrid
         IF (ok_lcl(ig)) THEN
           !ATTENTION,zw2 calcule en pplev
@@ -155 +155 @@
     enddo
 
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       !CR:REHABILITATION ZMAX CONTINU
       IF (ok_lcl(ig)) THEN
@@ -173 +173 @@
 
       !-----Initialisation de la TKE moyenne
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           pbl_tke_max(ig, l) = 0.
         enddo
@@ -180 +180 @@
 
       !-----Calcul de la TKE moyenne
-      do nsrf = 1, nbsrf
-        do l = 1, nlay
-          do ig = 1, ngrid
+      DO nsrf = 1, nbsrf
+        DO l = 1, nlay
+          DO ig = 1, ngrid
             pbl_tke_max(ig, l) = pctsrf(ig, nsrf) * pbl_tke(ig, l, nsrf) + pbl_tke_max(ig, l)
           enddo
@@ -189 +189 @@
 
       !-----Initialisations des TKE dans et hors des thermiques
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           therm_tke_max(ig, l) = pbl_tke_max(ig, l)
           env_tke_max(ig, l) = pbl_tke_max(ig, l)
@@ -202 +202 @@
 
       !-----Calcul des profils verticaux de TKE hors thermiques : env_tke_max, et de la vitesse verticale grande échelle : W_ls
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           pbl_tke_max(ig, l) = fraca(ig, l) * therm_tke_max(ig, l) + (1. - fraca(ig, l)) * env_tke_max(ig, l)         !  Recalcul de TKE moyenne après transport de TKE_TH
           env_tke_max(ig, l) = (pbl_tke_max(ig, l) - fraca(ig, l) * therm_tke_max(ig, l)) / (1. - fraca(ig, l))       !  Recalcul de TKE dans  l'environnement après transport de TKE_TH
@@ -211 +211 @@
       !    print *,' apres w_ls = '   !!jyg
 
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (ok_lcl(ig)) THEN
           fraca0(ig) = fraca(ig, klcl(ig)) + (fraca(ig, klcl(ig) + 1) &
@@ -252 +252 @@
 
       !-----Epaisseur du nuage (depth) et détermination de la queue du spectre de panaches (n2,s2) et du panache le plus gros (s_max)
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         zmax_moy(ig) = zlcl(ig) + zmax_moy_coef * (zmax(ig) - zlcl(ig))
         depth(ig) = zmax_moy(ig) - zlcl(ig)
@@ -276 +276 @@
         strig(:) = s_trig
       ELSE IF (iflag_strig==1) THEN
-        do ig = 1, ngrid
+        DO ig = 1, ngrid
           !         zcong_moy(ig)=zlcl(ig)+zmax_moy_coef*(zcong(ig)-zlcl(ig))
           !         strig(ig)=(hcoef*(zcong_moy(ig)-zlcl(ig))+hmin(ig))**2
@@ -282 +282 @@
         enddo
       ELSE IF (iflag_strig==2) THEN
-        do ig = 1, ngrid
+        DO ig = 1, ngrid
           IF (h_trig>zlcl(ig)) THEN
             strig(ig) = (h_trig - zlcl(ig))**2
@@ -293 +293 @@
       susqr2pi = su_cst * sqrt(2. * Rpi)
       reuler = exp(1.)
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF ((depth(ig)>=10.) .AND. (s_max(ig)>susqr2pi * reuler)) THEN
           w_max(ig) = w0(ig) * (1. + sqrt(2. * log(s_max(ig) / susqr2pi) - log(2. * log(s_max(ig) / susqr2pi))))
@@ -311 +311 @@
 
       !-----Calcul de ALP_BL_STAT
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         alp_bl_det(ig) = 0.5 * coef_m * rhobarz0(ig) * (w0(ig)**3) * fraca0(ig) * (1. - 2. * fraca0(ig)) / ((1. - fraca0(ig))**2)
         alp_bl_fluct_m(ig) = 1.5 * rhobarz0(ig) * fraca0(ig) * (w_conv(ig) + coef_m * w0(ig)) * &
@@ -327 +327 @@
 
       !-----Sécurité ALP infinie
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (fraca0(ig)>0.98) alp_bl_stat(ig) = 2.
       enddo
@@ -340 +340 @@
     ale_bl(:) = 0.
     !          PRINT*,'ALE,ALP ,l,zw2(ig,l),ale_bl(ig),alp_bl(ig)'
-    do l = 1, nlay
-      do ig = 1, ngrid
+    DO l = 1, nlay
+      DO ig = 1, ngrid
         alp_bl(ig) = max(alp_bl(ig), 0.5 * rhobarz(ig, l) * wth3(ig, l))
         ale_bl(ig) = max(ale_bl(ig), 0.5 * zw2(ig, l)**2)
@@ -359 +359 @@
     lalim_conv(:) = lalim(:)
 
-    do k = 1, nlay
-      do ig = 1, ngrid
+    DO k = 1, nlay
+      DO ig = 1, ngrid
         IF (k<=lalim_conv(ig)) fm_tot(ig) = fm_tot(ig) + fm(ig, k)
       enddo
@@ -367 +367 @@
     ! assez bizarre car, si on est dans la couche d'alim et que alim_star et
     ! plus petit que 1.e-10, on prend wght_th=1.
-    do k = 1, nlay
-      do ig = 1, ngrid
+    DO k = 1, nlay
+      DO ig = 1, ngrid
         IF (k<=lalim_conv(ig).AND.alim_star(ig, k)>1.e-10) THEN
           wght_th(ig, k) = alim_star(ig, k)
@@ -377 +377 @@
     !      PRINT*,'apres wght_th'
     !test pour prolonger la convection
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       !v1d  if ((alim_star(ig,1).lt.1.e-10).AND.(therm)) THEN
       IF ((alim_star(ig, 1)<1.e-10)) THEN
@@ -395 +395 @@
     alp_int(:) = 0.
     dp_int(:) = 0.
-    do l = 2, nlay
-      do ig = 1, ngrid
+    DO l = 2, nlay
+      DO ig = 1, ngrid
         IF(l<=lmax(ig)) THEN
           zdp = pplay(ig, l - 1) - pplay(ig, l)
@@ -406 +406 @@
 
     IF (iflag_coupl>=3 .AND. iflag_coupl<=5) THEN
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         !valeur integree de alp_bl * 0.5:
         IF (dp_int(ig)>0.) THEN