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

Timestamp:

Jul 24, 2024, 2:54:37 PM (4 months ago)

Author:

abarral

Message:

rename modules properly lmdz_*
move ismin, ismax, minmax into new lmdz_libmath.f90
(lint) uppercase fortran keywords

File:

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

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

@@ -40 +40 @@
     real, dimension(ngrid, nlay + 1) :: fup, fdn, fc, fthu, fthd, fthe, fthtot
     real, dimension(ngrid, nlay) :: tracu, tracd, traci, tracold
-    real :: www, mstar_inv
+    REAL :: www, mstar_inv
     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
+    INTEGER :: iflag_impl = 1 ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement
 
     fdn(:, :) = 0.
@@ -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
@@ -126 +126 @@
     !Boucle pour calculer le flux du traceur flux updraft, flux downdraft, flux compensatoire
     !Methode explicite :
-    if(iflag_impl==0) then
+    IF(iflag_impl==0) THEN
       do ilay = 2, nlay, 1
         do ig = 1, ngrid
           !!!!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)
@@ -152 +152 @@
 
       !!! Reecriture du schéma explicite avec les notations du schéma implicite
-    else if(iflag_impl==-1) then
-      write(*, *) 'nouveau schéma explicite !!!'
+    else IF(iflag_impl==-1) THEN
+      WRITE(*, *) 'nouveau schéma explicite !!!'
       !!! Calcul de s1
       do ilay = 1, nlay
@@ -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
-            write(*, *) 'flux compensatoire montant, cas non traite par thermcell_updown_dq dans le cas d une resolution implicite, ilay : ', ilay
+          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)
           else
@@ -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)