Changeset 5117 for LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_down.F90

Timestamp:

Jul 24, 2024, 4:23:34 PM (4 months ago)

Author:

abarral

Message:

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

File:

• LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_down.F90 (modified) (11 diffs)

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

@@ -23 +23 @@
     ! input/output
 
-    integer, intent(in) :: ngrid ! number of horizontal grid points
-    integer, intent(in) :: nlay  ! number of vertical layers
-    real, intent(in) :: ptimestep ! time step of the physics [s]
-    real, intent(in), dimension(ngrid, nlay) :: eup ! entrainment to updrafts * dz [same unit as flux]
-    real, intent(in), dimension(ngrid, nlay) :: dup ! detrainment from updrafts * dz [same unit as flux]
-    real, intent(in), dimension(ngrid, nlay) :: edn ! entrainment to downdrafts * dz [same unit as flux]
-    real, intent(in), dimension(ngrid, nlay) :: ddn ! detrainment from downdrafts * dz [same unit as flux]
-    real, intent(in), dimension(ngrid, nlay) :: masse ! mass of layers = rho dz
-    real, intent(in), dimension(ngrid, nlay) :: trac ! tracer
-    integer, intent(in), dimension(ngrid) :: lmax ! max level index at which downdraft are present
-    real, intent(out), dimension(ngrid, nlay) :: dtrac ! tendance du traceur
+    INTEGER, INTENT(IN) :: ngrid ! number of horizontal grid points
+    INTEGER, INTENT(IN) :: nlay  ! number of vertical layers
+    REAL, INTENT(IN) :: ptimestep ! time step of the physics [s]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: eup ! entrainment to updrafts * dz [same unit as flux]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: dup ! detrainment from updrafts * dz [same unit as flux]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: edn ! entrainment to downdrafts * dz [same unit as flux]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: ddn ! detrainment from downdrafts * dz [same unit as flux]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: masse ! mass of layers = rho dz
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: trac ! tracer
+    INTEGER, INTENT(IN), DIMENSION(ngrid) :: lmax ! max level index at which downdraft are present
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: dtrac ! tendance du traceur
 
 
     ! Local
 
-    real, dimension(ngrid, nlay + 1) :: fup, fdn, fc, fthu, fthd, fthe, fthtot
-    real, dimension(ngrid, nlay) :: tracu, tracd, traci, tracold
+    REAL, DIMENSION(ngrid, nlay + 1) :: fup, fdn, fc, fthu, fthd, fthe, fthtot
+    REAL, DIMENSION(ngrid, nlay) :: tracu, tracd, traci, tracold
     REAL :: www, mstar_inv
-    integer ig, ilay
-    real, dimension(ngrid, nlay) :: s1, s2, num !coefficients pour la resolution implicite
+    INTEGER ig, ilay
+    REAL, DIMENSION(ngrid, nlay) :: s1, s2, num !coefficients pour la resolution implicite
     INTEGER :: iflag_impl = 1 ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement
 
@@ -60 +60 @@
     num(:, :) = 1.
 
-    if (iflag_thermals_down < 10) THEN
+    IF (iflag_thermals_down < 10) THEN
       CALL abort_physic("thermcell_updown_dq", &
               'thermcell_down_dq = 0 or >= 10', 1)
@@ -74 +74 @@
       do ig = 1, ngrid
         !if ( lmax(ig) > nlay - 2 ) stop "les thermiques montent trop haut"
-        if (ilay<=lmax(ig) .and. lmax(ig)>1) THEN
+        IF (ilay<=lmax(ig) .AND. lmax(ig)>1) THEN
           fdn(ig, ilay) = fdn(ig, ilay + 1) + edn(ig, ilay) - ddn(ig, ilay)
-          if (fdn(ig, ilay) + ddn(ig, ilay) > 0.) THEN
+          IF (fdn(ig, ilay) + ddn(ig, ilay) > 0.) THEN
             www = fdn(ig, ilay + 1) / (fdn(ig, ilay) + ddn(ig, ilay))
           else
@@ -90 +90 @@
     do ilay = 1, nlay, 1
       do ig = 1, ngrid
-        if (ilay<lmax(ig) .and. lmax(ig)>1) THEN
+        IF (ilay<lmax(ig) .AND. lmax(ig)>1) THEN
           fup(ig, ilay + 1) = fup(ig, ilay) + eup(ig, ilay) - dup(ig, ilay)
-          if (fup(ig, ilay + 1) + dup(ig, ilay) > 0.) THEN
+          IF (fup(ig, ilay + 1) + dup(ig, ilay) > 0.) THEN
             www = fup(ig, ilay) / (fup(ig, ilay + 1) + dup(ig, ilay))
           else
             www = 0.
           endif
-          if (ilay == 1) THEN
+          IF (ilay == 1) THEN
             tracu(ig, ilay) = trac(ig, ilay)
           else
@@ -131 +131 @@
           !!!!ATTENTION HYPOTHESE de FLUX COMPENSATOIRE DESCENDANT ET DONC comme schema amont on va chercher trac au dessus!!!!!
           !!!! tentative de prise en compte d'un flux compensatoire montant  !!!!
-          if (fup(ig, ilay) - fdn(ig, ilay) < 0.) THEN
+          IF (fup(ig, ilay) - fdn(ig, ilay) < 0.) THEN
             CALL abort_physic("thermcell_updown_dq", 'flux compensatoire '&
                     // 'montant, cas non traite par thermcell_updown_dq', 1)
@@ -164 +164 @@
       do ilay = 2, nlay, 1
         do ig = 1, ngrid
-          if (fup(ig, ilay) - fdn(ig, ilay) < 0.) THEN
+          IF (fup(ig, ilay) - fdn(ig, ilay) < 0.) THEN
             CALL abort_physic("thermcell_updown_dq", 'flux compensatoire ' &
                     // 'montant, cas non traite par thermcell_updown_dq', 1)
@@ -183 +183 @@
       enddo !fin du calculer de la tendance du traceur avec la methode explicite
 
-    else if (iflag_impl==1) THEN
+    ELSE IF (iflag_impl==1) THEN
       do ilay = 1, nlay
         do ig = 1, ngrid
@@ -193 +193 @@
       do ilay = nlay - 1, 1, -1
         do ig = 1, ngrid
-          if((fup(ig, ilay) - fdn(ig, ilay)) < 0) THEN
+          IF((fup(ig, ilay) - fdn(ig, ilay)) < 0) THEN
             WRITE(*, *) 'flux compensatoire montant, cas non traite par thermcell_updown_dq dans le cas d une resolution implicite, ilay : ', ilay
             CALL abort_physic("thermcell_updown_dq", "", 1)
@@ -230 +230 @@
     ! arguments
 
-    integer, intent(in) :: ngrid, nlay
-    real, intent(in), dimension(ngrid, nlay) :: po, pt, pu, pv, pplay, eup, dup
-    real, intent(in), dimension(ngrid, nlay) :: theta
-    real, intent(in), dimension(ngrid, nlay + 1) :: pplev, fup
-    integer, intent(in), dimension(ngrid) :: lmax
+    INTEGER, INTENT(IN) :: ngrid, nlay
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: po, pt, pu, pv, pplay, eup, dup
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: theta
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: pplev, fup
+    INTEGER, INTENT(IN), DIMENSION(ngrid) :: lmax
 
 
@@ -240 +240 @@
     ! Local
 
-    real, dimension(ngrid, nlay) :: edn, ddn, thetad
-    real, dimension(ngrid, nlay + 1) :: fdn
-
-    integer ig, ilay
-    real dqsat_dT
-    logical mask(ngrid, nlay)
+    REAL, DIMENSION(ngrid, nlay) :: edn, ddn, thetad
+    REAL, DIMENSION(ngrid, nlay + 1) :: fdn
+
+    INTEGER ig, ilay
+    REAL dqsat_dT
+    LOGICAL mask(ngrid, nlay)
 
     edn(:, :) = 0.
@@ -271 +271 @@
     do ilay = nlay, 1, -1
       do ig = 1, ngrid
-        if (ilay<=lmax(ig).and.lmax(ig)>1) THEN
+        IF (ilay<=lmax(ig).AND.lmax(ig)>1) THEN
           edn(ig, ilay) = fact_thermals_down * dup(ig, ilay)
           ddn(ig, ilay) = fact_thermals_down * eup(ig, ilay)