Changeset 2354 in lmdz_wrf

Timestamp:

Feb 19, 2019, 10:07:39 PM (6 years ago)

Author:

lfita

Message:

Adding:

• `spaceweight_Icount': Subroutine to compute the percentage of a series of categories using weights
• `multi_spaceweightcount_in3DRK3_slc3v3': Subroutine to compute an spatial percentage of coverture of categories from a 3D RK matrix using 3rd dimension as running one into a matrix of 3-variables slices of rank 3 using spatial weights

File:

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

trunk/tools/module_scientific.f90

@@ -44 +44 @@
 ! multi_index_mat3DRK: Subroutine to provide the indices of the different locations of a value inside a 3D RK matrix
 ! multi_index_mat4DRK: Subroutine to provide the indices of the different locations of a value inside a 4D RK matrix
+! multi_spaceweightcount_in3DRK3_slc3v3: Subroutine to compute an spatial percentage of coverture of 
+!   categories from a 3D RK matrix using 3rd dimension as running one into a matrix of 3-variables 
+!   slices of rank 3 using spatial weights
 ! multi_spaceweightstats_in1DRKno_slc3v3: Subroutine to compute an spatial statistics value from a 1D RK matrix without
 !   running one into a matrix of 3-variables slices of rank 3 using spatial weights
@@ -84 +87 @@
 ! SortR_K*: Subroutine receives an array x() r_K and sorts it into ascending order.
 ! spacepercen: Subroutine to compute the space-percentages of a series of grid cells (B) into another series of grid-cells (A)
+! spaceweight_Icount: Subroutine to compute the percentage of a series of categories using weights
 ! spaceweightstats: Subroutine to compute an spatial statistics value from a matrix B into a matrix A using weights
 ! StatsR_K: Subroutine to provide the minmum, maximum, mean, the quadratic mean, and the standard deviation of a 
@@ -5671 +5675 @@
 ! percentages: weights as percentages of space of grid in matrix A covered by grid of matrix B
 ! stats: name of the spatial statistics to compute inside each grid of matrix A using values from 
-!     matrix B. Avaialbe ones:
+!     matrix B. Available ones:
 !   'min': minimum value
 !   'max': maximum value
@@ -5780 +5784 @@
   END SUBROUTINE spaceweightstats
 
+  SUBROUTINE spaceweight_Icount(Ncat, cats, varin, Ngridsin, percentages, varout)
+  ! Subroutine to compute the percentage of a series of categories using weights
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: Ncat, Ngridsin
+    INTEGER, DIMENSION(Ncat), INTENT(in)                 :: cats
+    INTEGER, DIMENSION(Ngridsin), INTENT(in)             :: varin
+    REAL(r_k), DIMENSION(Ngridsin), INTENT(in)           :: percentages
+    REAL(r_k), DIMENSION(Ncat), INTENT(out)              :: varout
+
+! Local
+    INTEGER                                              :: iv, ic
+
+!!!!!!! Variables
+! Ncat: number of categories
+! cats: categories to use
+! varin: variable with the integer values
+! Ngridsin: number of grids
+! percentages: weights as percentages of the grids to use
+! varout: output statistical variable
+
+    fname = 'spaceweight_Icount'
+
+    varout = zeroRK
+    DO iv=1, Ngridsin
+      DO ic=1, Ncat
+        IF (varin(iv) == cats(ic)) THEN
+          varout(ic) = varout(ic) + percentages(iv)
+        END IF
+      END DO
+    END DO
+
+  END SUBROUTINE spaceweight_Icount
+
   SUBROUTINE multi_spaceweightstats_in1DRKno_slc3v3(varin, idv, Ngridsin, gridsin, percentages,       &
     varout, di1, ds1, ds2, ds3, maxNgridsin)
@@ -5831 +5870 @@
 
     fname = 'multi_spaceweightstats_in1DRKno_slc3v3'
-
-    varout = fillval64
 
     ss1 = 8 + 1
@@ -5979 +6016 @@
     fname = 'multi_spaceweightstats_in2DRKno_slc3v3'
 
-    varout = fillval64
-
     ss1 = 8 + 1
     ss2 = 5 + 1
@@ -6115 +6150 @@
 
     fname = 'multi_spaceweightstats_in3DRK3_slc3v3'
-
-    varout = fillval64
 
     ss1 = 8 + 1
@@ -6255 +6288 @@
 
     fname = 'multi_spaceweightstats_in4DRK3_4_slc3v3'
-
-    varout = fillval64
 
     ! Let's be efficient?
@@ -6392 +6423 @@
     fname = 'multi_spaceweightstats_in3DRK3_slc3v4'
 
-    varout = fillval64
-
     ! Let's be efficient?
     varout = fillVal64
@@ -7018 +7047 @@
   END SUBROUTINE coincident_gridsin2D
 
+  SUBROUTINE multi_spaceweightcount_in3DRK3_slc3v3(varin, Ngridsin, gridsin, percentages, Ncat,       &
+    categories, varout, di1, di2, di3, ds1, ds2, ds3, maxNgridsin)
+  ! Subroutine to compute an spatial percentage of coverture of categories from a 3D RK matrix using 
+  !   3rd dimension as running one into a matrix of 3-variables slices of rank 3 using spatial weights
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: di1, di2, di3, ds1, ds2, ds3
+    INTEGER, INTENT(in)                                  :: Ncat, maxNgridsin
+    INTEGER, DIMENSION(ds1,ds2,ds3), INTENT(in)          :: Ngridsin
+    INTEGER, DIMENSION(ds1,ds2,ds3,maxNgridsin,2),                                                    &
+      INTENT(in)                                         :: gridsin
+    INTEGER, DIMENSION(di1,di2,di3), INTENT(in)          :: varin
+    REAL(r_k), INTENT(in),                                                                            &
+      DIMENSION(ds1,ds2,ds3,maxNgridsin)                 :: percentages
+    INTEGER, DIMENSION(Ncat), INTENT(in)                 :: categories
+    REAL(r_k), DIMENSION(ds1,ds2,ds3,di3,Ncat),                                                       &
+      INTENT(out)                                        :: varout
+
+! Local
+    INTEGER                                              :: i1, i2, i3, s1, s2, s3, iv
+    INTEGER                                              :: ii3, ss1, ss2, ss3, Nin
+    REAL(r_k), DIMENSION(:), ALLOCATABLE                 :: pin
+    INTEGER, DIMENSION(:,:), ALLOCATABLE                 :: gin
+    REAL(r_k), DIMENSION(:), ALLOCATABLE                 :: svin
+    INTEGER, DIMENSION(:,:), ALLOCATABLE                 :: vin
+
+!!!!!!! Variables
+! di1, di2, di3: length of dimensions of the 3D matrix of values
+! ds[1-3]: length of dimensions of matrix with the slices
+! maxNgridsin: maximum number of grid points from the 3D matrix in any slice
+! varin: 3D RK variable to be used
+! Ngridsin: number of grids from 3D RK matrix for each slice
+! gridsin: coordinates of grids of the 3D RK matrix B to matrix of slices
+! percentages: weights as percentages of space of 3D RK matrix for each slice
+! Ncat: number of categories
+! categories: category values to classify with
+! varout: percentage of each category at each point along d3
+
+    fname = 'multi_spaceweightcount_in3DRK3_slc3v3'
+
+    ! Let's be efficient?
+    varout = fillVal64
+    DO s1 =1, ds1
+      DO s2 =1, ds2
+        DO s3 =1, ds3
+          Nin = Ngridsin(s1,s2,s3)
+          ! Computing along d3
+          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,di3))
+            IF (ALLOCATED(svin)) DEALLOCATE(svin)
+            ALLOCATE(svin(Nin))
+            gin = gridsin(s1,s2,s3,1:Nin,:)
+            pin = percentages(s1,s2,s3,1:Nin)
+
+            ! Getting the values
+            DO iv=1, Nin
+              i1 = gin(iv,1)
+              i2 = gin(iv,2)
+              vin(iv,:) = varin(i1,i2,:)
+            END DO
+            DO i3=1, di3
+              CALL spaceweight_Icount(Ncat, categories, vin(:,i3), Nin, pin, varout(s1,s2,s3,i3,:))
+            END DO
+          ELSE
+            varout(s1,s2,s3,:,1) = fillval64
+          END IF
+        END DO
+      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_spaceweightcount_in3DRK3_slc3v3
+
 END MODULE module_scientific