Changeset 2723 in lmdz_wrf for trunk/tools/module_scientific.f90

Timestamp:

Oct 11, 2019, 2:38:21 PM (5 years ago)

Author:

lfita

Message:

Adding:

• `HistogramRK': Subroutine to provide the histogram of a series of RK values
• `Histogram2D1_RK': Subroutine to provide the histogram of a 2D matrix RK values along the first dimension

File:

• trunk/tools/module_scientific.f90 (modified) (3 diffs)

trunk/tools/module_scientific.f90

@@ -34 +34 @@
 !   following ray casting algorithm
 ! Heron_area_triangle: Subroutine to compute area of a triangle using Heron's formula
+! HistogramRK: Subroutine to provide the histogram of a series of RK values
+! Histogram2D1_RK: Subroutine to provide the histogram of a 2D matrix RK values along the first dimension
 ! intersectfaces: Subroutine to provide if two faces of two polygons intersect
 ! intersection_2Dlines: Subroutine to provide the intersection point between two lines on the plane using Cramer's method
@@ -3742 +3744 @@
 
 END SUBROUTINE quantilesR_K
-
 
 SUBROUTINE StatsR_K(Nvals, vals, minv, maxv, mean, mean2, stdev)
@@ -8042 +8043 @@
   END SUBROUTINE deltat3D
 
+  SUBROUTINE HistogramRK(Nvals, vals, missval, Nbins, Nbins1, bins, hist)
+! Subroutine to provide the histogram of a series of RK values
+!   Histogram will be provided with Nbins+1
+!     1st hist: couns(vals<Nbins(1)) 
+!     2nd hist: couns(Nbins(1)<=vals<Nbins(2))
+!     ...
+!     Nbins hist: couns(Nbins(Nbins)<=vals)
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: Nvals, Nbins, Nbins1
+    REAL(r_k), DIMENSION(Nvals), INTENT(in)              :: vals
+    REAL(r_k), INTENT(in)                                :: missval
+    REAL(r_k), DIMENSION(Nbins), INTENT(in)              :: bins
+    INTEGER, DIMENSION(Nbins1), INTENT(out)              :: hist
+
+! Local
+    INTEGER                                              :: i, ib
+
+!!!!!!! Variables
+! Nvals: number of values
+! vals: values
+! missval: value for the missing value
+! Nbins: number of bins
+! bins: bins of the histogram
+! hist: histogram
+
+    fname = 'HistogramRK'
+
+    hist = 0
+
+    DO i=1, Nvals
+      IF (vals(i) == missval) CYCLE
+      IF (vals(i) < bins(1)) THEN
+        hist(1) = hist(1) + 1
+        CYCLE
+      END IF
+      DO ib=2, Nbins
+        IF ( (vals(i) >= bins(ib-1)) .AND. (vals(i) < bins(ib)) ) THEN
+          hist(ib) = hist(ib) + 1
+          CYCLE
+        END IF
+      END DO
+      IF (vals(i) >= bins(Nbins)) hist(Nbins+1) = hist(Nbins+1) + 1
+    END DO
+
+    RETURN
+
+  END SUBROUTINE HistogramRK
+
+  SUBROUTINE Histogram2D1_RK(d1, d2, vals, missval, Nbins, Nbins1, bins, hist)
+! Subroutine to provide the histogram of a 2D matrix RK values along the first dimension
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: d1, d2, Nbins, Nbins1
+    REAL(r_k),INTENT(in)                                 :: missval
+    REAL(r_k), DIMENSION(d1,d2), INTENT(in)              :: vals
+    REAL(r_k), DIMENSION(Nbins), INTENT(in)              :: bins
+    INTEGER, DIMENSION(d2, Nbins1), INTENT(out)          :: hist
+
+! Local
+    INTEGER                                              :: i, j
+!!!!!!! Variables
+! d1, d2: dimension of values
+! vals: values
+! missval: value for the missing value
+! Nbins: number of bins
+! bins: bins of the histogram
+! hist: histogram
+
+    fname = 'Histogram2D1_RK'
+
+    hist = zeroRK
+
+    DO i=1, d2
+      CALL HistogramRK(d1, vals(:,i), missval, Nbins, Nbins1, bins, hist(i,:))
+    END DO
+
+    RETURN
+
+  END SUBROUTINE Histogram2D1_RK
+
 END MODULE module_scientific