Changeset 2524 in lmdz_wrf for trunk/tools

Timestamp:

May 9, 2019, 5:29:40 PM (6 years ago)

Author:

lfita

Message:

Adding:

• `multi_spaceweightstats_in3DRK3_slc2v2': Subroutine to compute an spatial statistics value from a 3D RK matrix using 3rd dimension as 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

@@ -53 +53 @@
 ! 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_slc2v2: Subroutine to compute an spatial statistics value from a 3D RK matrix using 
+!   3rd dimension as 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
@@ -6235 +6237 @@
   END SUBROUTINE multi_spaceweightstats_in2DRKno_slc2v2
 
+  SUBROUTINE multi_spaceweightstats_in3DRK3_slc2v2(varin, Ngridsin, gridsin, percentages, varout,     &
+    di1, di2, di3, ds1, ds2, maxNgridsin)
+  ! Subroutine to compute an spatial statistics value from a 3D RK matrix using 3rd dimension as 
+  !   running one into a matrix of 2-variables slices of rank 2 using spatial weights
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: di1, di2, di3, 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,di3), INTENT(in)        :: varin
+    REAL(r_k), INTENT(in),                                                                            &
+      DIMENSION(ds1,ds2,maxNgridsin)                     :: percentages
+    REAL(r_k), DIMENSION(ds1,ds2,di3,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, di3: length of dimensions of the 3D matrix of values
+! ds[1-2]: 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
+!!!!!
+! Available spatial statistics to compute inside each slice using values from 3D 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_in3DRK3_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 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,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
+          DO i3=1, di3
+            minv = fillVal64
+            maxv = -fillVal64
+            meanv = zeroRK
+            mean2v = zeroRK
+            stdv = zeroRK
+            minv = MINVAL(vin(:,i3))
+            maxv = MAXVAL(vin(:,i3))
+            meanv = SUM(vin(:,i3)*pin)
+            mean2v = SUM(vin(:,i3)**2*pin)
+            DO iv=1,Nin
+              stdv = stdv + ( (meanv - vin(iv,i3))*pin(iv) )**2
+            END DO
+            stdv = SQRT(stdv)
+            svin = vin(:,i3)
+            CALL SortR_K(svin, Nin)
+            medv = svin(INT(Nin/2))
+            varout(s1,s2,i3,1) = minv
+            varout(s1,s2,i3,2) = maxv
+            varout(s1,s2,i3,3) = meanv
+            varout(s1,s2,i3,4) = mean2v
+            varout(s1,s2,i3,5) = stdv
+            varout(s1,s2,i3,6) = medv
+            varout(s1,s2,i3,7) = Nin*1.
+          END DO
+        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_in3DRK3_slc2v2
+
   SUBROUTINE multi_spaceweightstats_in3DRK3_slc3v3(varin, Ngridsin, gridsin, percentages, varout,     &
     di1, di2, di3, ds1, ds2, ds3, maxNgridsin)