Changeset 5099 for LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/tiedqneg.f90

Timestamp:

Jul 22, 2024, 9:29:09 PM (4 months ago)

Author:

abarral

Message:

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

File:

• LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/tiedqneg.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/tiedqneg.F) (1 diff)

LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/tiedqneg.f90

@@ -1 @@
-      SUBROUTINE tiedqneg (pres_h,q,d_q)
-c
-      USE dimphy
-      IMPLICIT none
-c======================================================================
-c Auteur(s): CG (LGGE/CNRS) date: 19950201
-c            O. Boucher (LOA/CNRS) date 19961125
-c Objet:  Correction eventuelle des valeurs negatives d'humidite
-c induites par le schema de convection de Tiedke 
-c======================================================================
-c Arguments:
-c pres_h--input-R-la valeur de la pression aux interfaces
-c q-------input-R-quantite de traceur
-c d_q-----input-output-R-increment du traceur
-c======================================================================
-c
-      INCLUDE "dimensions.h"
-c       INCLUDE "dimphy.h"
-      REAL pres_h(klon,klev+1)
-      REAL q(klon,klev)
-      REAL d_q(klon,klev)
-      INTEGER nb_neg
-      INTEGER i, l
-c
-      REAL qmin
-      PARAMETER (qmin=0.0)
-c
-      DO l = klev,2,-1
-        nb_neg = 0
-        DO i = 1,klon
-          IF (q(i,l)+d_q(i,l)<qmin) THEN
-          nb_neg = nb_neg + 1
-          d_q(i,l-1) = d_q(i,l-1) + (q(i,l)+d_q(i,l)-qmin)
-     .       *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l-1)-pres_h(i,l))
-            d_q(i,l) = qmin - q(i,l)
-          ENDIF
-        ENDDO
-c        IF (nb_neg.NE.0) THEN 
-c        PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
-c        ENDIF
-      ENDDO
-c
-      DO l = 1, klev-1
-        nb_neg = 0
-        DO i = 1,klon
-          IF (q(i,l)+d_q(i,l)<qmin) THEN
-          nb_neg = nb_neg + 1
-          d_q(i,l+1) = d_q(i,l+1) + (q(i,l)+d_q(i,l)-qmin)
-     .      *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l+1)-pres_h(i,l+2))
-          d_q(i,l) = qmin - q(i,l)
-          ENDIF
-        ENDDO
-c        IF (nb_neg.NE.0) THEN 
-c        PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
-c        ENDIF
-      ENDDO
-c
-      l = klev
-      DO i = 1,klon
-        IF (q(i,l)+d_q(i,l)<qmin) THEN
-          d_q(i,l) = qmin - q(i,l)
-        ENDIF
-      ENDDO
-c
-      RETURN
-      END
+SUBROUTINE tiedqneg (pres_h, q, d_q)
+
+  USE dimphy
+  IMPLICIT none
+  !======================================================================
+  ! Auteur(s): CG (LGGE/CNRS) date: 19950201
+  ! O. Boucher (LOA/CNRS) date 19961125
+  ! Objet:  Correction eventuelle des valeurs negatives d'humidite
+  ! induites par le schema de convection de Tiedke
+  !======================================================================
+  ! Arguments:
+  ! pres_h--input-R-la valeur de la pression aux interfaces
+  ! q-------input-R-quantite de traceur
+  ! d_q-----input-output-R-increment du traceur
+  !======================================================================
+
+  INCLUDE "dimensions.h"
+  ! INCLUDE "dimphy.h"
+  REAL :: pres_h(klon, klev + 1)
+  REAL :: q(klon, klev)
+  REAL :: d_q(klon, klev)
+  INTEGER :: nb_neg
+  INTEGER :: i, l
+
+  REAL :: qmin
+  PARAMETER (qmin = 0.0)
+
+  DO l = klev, 2, -1
+    nb_neg = 0
+    DO i = 1, klon
+      IF (q(i, l) + d_q(i, l)<qmin) THEN
+        nb_neg = nb_neg + 1
+        d_q(i, l - 1) = d_q(i, l - 1) + (q(i, l) + d_q(i, l) - qmin) &
+                * (pres_h(i, l) - pres_h(i, l + 1)) / (pres_h(i, l - 1) - pres_h(i, l))
+        d_q(i, l) = qmin - q(i, l)
+      ENDIF
+    ENDDO
+    ! IF (nb_neg.NE.0) THEN
+    ! PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
+    ! ENDIF
+  ENDDO
+
+  DO l = 1, klev - 1
+    nb_neg = 0
+    DO i = 1, klon
+      IF (q(i, l) + d_q(i, l)<qmin) THEN
+        nb_neg = nb_neg + 1
+        d_q(i, l + 1) = d_q(i, l + 1) + (q(i, l) + d_q(i, l) - qmin) &
+                * (pres_h(i, l) - pres_h(i, l + 1)) / (pres_h(i, l + 1) - pres_h(i, l + 2))
+        d_q(i, l) = qmin - q(i, l)
+      ENDIF
+    ENDDO
+    ! IF (nb_neg.NE.0) THEN
+    ! PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
+    ! ENDIF
+  ENDDO
+
+  l = klev
+  DO i = 1, klon
+    IF (q(i, l) + d_q(i, l)<qmin) THEN
+      d_q(i, l) = qmin - q(i, l)
+    ENDIF
+  ENDDO
+
+  RETURN
+END SUBROUTINE tiedqneg