Changeset 2522 in lmdz_wrf

Timestamp:

May 9, 2019, 11:41:33 AM (6 years ago)

Author:

lfita

Message:

Adding:

• `multi_spaceweightstats_in2DRKno_slc2v2': Subroutine to compute an spatial statistics value from a 2D RK matrix without running one into a matrix of 2-variables slices of rank 2 using spatial weights

File:

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

trunk/tools/module_scientific.f90

@@ -51 +51 @@
 ! multi_spaceweightstats_in2DRKno_slc3v3: Subroutine to compute an spatial statistics value from a 2D RK matrix without
 !   running one into a matrix of 3-variables slices of rank 3 using spatial weights
+! multi_spaceweightstats_in2DRKno_slc2v2: Subroutine to compute an spatial statistics value from a 2D RK matrix without 
+!   running one into a matrix of 2-variables slices of rank 2 using spatial weights
 ! multi_spaceweightstats_in3DRK3_slc3v3: Subroutine to compute an spatial statistics value from a 3D RK matrix using 
 !   3rd dimension as running one into a matrix of 3-variables slices of rank 3 using spatial weights
@@ -6101 +6103 @@
   END SUBROUTINE multi_spaceweightstats_in2DRKno_slc3v3
 
+  SUBROUTINE multi_spaceweightstats_in2DRKno_slc2v2(varin, Ngridsin, gridsin, percentages, varout,    &
+    di1, di2, ds1, ds2, maxNgridsin)
+  ! Subroutine to compute an spatial statistics value from a 2D RK matrix without running one into a 
+  !   matrix of 2-variables slices of rank 2 using spatial weights
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: di1, di2, ds1, ds2
+    INTEGER, INTENT(in)                                  :: maxNgridsin
+    INTEGER, DIMENSION(ds1,ds2), INTENT(in)              :: Ngridsin
+    INTEGER, DIMENSION(ds1,ds2,maxNgridsin,2),                                                        &
+      INTENT(in)                                         :: gridsin
+    REAL(r_k), DIMENSION(di1,di2), INTENT(in)            :: varin
+    REAL(r_k), INTENT(in),                                                                            &
+      DIMENSION(ds1,ds2,maxNgridsin)                     :: percentages
+    REAL(r_k), DIMENSION(ds1,ds2,7), INTENT(out)         :: varout
+
+! Local
+    INTEGER                                              :: i1, i2, i3, s1, s2, iv
+    INTEGER                                              :: ii3, ss1, ss2
+    INTEGER                                              :: Ncounts, Nin
+    CHARACTER(len=3)                                     :: val1S, val2S
+    CHARACTER(len=30)                                    :: val3S
+    REAL(r_k)                                            :: minv, maxv, meanv, mean2v, stdv, medv
+    REAL(r_k), DIMENSION(:), ALLOCATABLE                 :: pin
+    INTEGER, DIMENSION(:,:), ALLOCATABLE                 :: gin
+    REAL(r_k), DIMENSION(:), ALLOCATABLE                 :: svin
+    REAL(r_k), DIMENSION(:), ALLOCATABLE                 :: vin
+
+!!!!!!! Variables
+! di1, di2: length of dimensions of the 2D matrix of values
+! ds[1-2]: length of dimensions of matrix with the slices
+! maxNgridsin: maximum number of grid points from the 2D matrix in any slice
+! varin: 2D RK variable to be used
+! Ngridsin: number of grids from 2D RK matrix for each slice
+! gridsin: coordinates of grids of the 2D RK matrix B to matrix of slices
+! percentages: weights as percentages of space of 2D RK matrix for each slice
+!!!!!
+! Available spatial statistics to compute inside each slice using values from 2D RK matrix
+!   'min': minimum value
+!   'max': maximum value
+!   'mean': space weighted mean value
+!   'mean2': space weighted quadratic mean value
+!   'stddev': space weighted standard deviation value
+!   'median': median value
+!   'count': percentage of the space of matrix A covered by each different value of matrix B
+! varout: output statistical variable
+
+    fname = 'multi_spaceweightstats_in2DRKno_slc2v2'
+
+    ss1 = 8 + 1
+    ss2 = 5 + 1
+    ii3 = 1 + 1
+
+    ! Let's be efficient?
+    varout = fillVal64
+    DO s1 =1, ds1
+      DO s2 =1, ds2
+        Nin = Ngridsin(s1,s2)
+        ! Computing along d2
+        IF (Nin > 1) THEN
+          IF (ALLOCATED(gin)) DEALLOCATE(gin)
+          ALLOCATE(gin(Nin,2))
+          IF (ALLOCATED(pin)) DEALLOCATE(pin)
+          ALLOCATE(pin(Nin))
+          IF (ALLOCATED(vin)) DEALLOCATE(vin)
+          ALLOCATE(vin(Nin))
+          IF (ALLOCATED(svin)) DEALLOCATE(svin)
+          ALLOCATE(svin(Nin))
+          gin = gridsin(s1,s2,1:Nin,:)
+          pin = percentages(s1,s2,1:Nin)
+
+          ! Getting the values
+          DO iv=1, Nin
+            i1 = gin(iv,1)
+            i2 = gin(iv,2)
+            vin(iv) = varin(i1,i2)
+          END DO
+          minv = fillVal64
+          maxv = -fillVal64
+          meanv = zeroRK
+          mean2v = zeroRK
+          stdv = zeroRK
+          minv = MINVAL(vin)
+          maxv = MAXVAL(vin)
+          meanv = SUM(vin*pin)
+          mean2v = SUM(vin**2*pin)
+          DO iv=1,Nin
+            stdv = stdv + ( (meanv - vin(iv))*pin(iv) )**2
+          END DO
+          stdv = SQRT(stdv)
+          svin = vin(:)
+          CALL SortR_K(svin, Nin)
+          medv = svin(INT(Nin/2))
+          varout(s1,s2,1) = minv
+          varout(s1,s2,2) = maxv
+          varout(s1,s2,3) = meanv
+          varout(s1,s2,4) = mean2v
+          varout(s1,s2,5) = stdv
+          varout(s1,s2,6) = medv
+          varout(s1,s2,7) = Nin*1.
+        ELSE IF (Nin == 1) THEN
+          i1 = gridsin(s1,s2,1,1)
+          i2 = gridsin(s1,s2,1,2)
+          varout(s1,s2,1) = varin(i1,i2)
+          varout(s1,s2,2) = varin(i1,i2)
+          varout(s1,s2,3) = varin(i1,i2)
+          varout(s1,s2,4) = varin(i1,i2)*varin(i1,i2)
+          varout(s1,s2,5) = zeroRK
+          varout(s1,s2,6) = varin(i1,i2)
+          varout(s1,s2,7) = Nin*1.
+        ELSE
+          varout(s1,s2,1) = fillval64
+          varout(s1,s2,2) = fillval64
+          varout(s1,s2,3) = fillval64
+          varout(s1,s2,4) = fillval64
+          varout(s1,s2,5) = fillval64
+          varout(s1,s2,6) = fillval64
+          varout(s1,s2,7) = zeroRK
+        END IF
+      END DO
+    END DO
+
+    IF (ALLOCATED(gin)) DEALLOCATE(gin)
+    IF (ALLOCATED(pin)) DEALLOCATE(pin)
+    IF (ALLOCATED(vin)) DEALLOCATE(vin)
+    IF (ALLOCATED(svin)) DEALLOCATE(svin)
+    
+    RETURN
+
+  END SUBROUTINE multi_spaceweightstats_in2DRKno_slc2v2
+
   SUBROUTINE multi_spaceweightstats_in3DRK3_slc3v3(varin, Ngridsin, gridsin, percentages, varout,     &
     di1, di2, di3, ds1, ds2, ds3, maxNgridsin)