Changeset 2351 in lmdz_wrf for trunk/tools

Timestamp:

Feb 19, 2019, 5:47:15 PM (6 years ago)

Author:

lfita

Message:

Adding:

• `multi_spaceweightstats_in4DRK3_4_slc3v3': Subroutine to compute an spatial statistics value from a 4D RK matrix using 3rd and 4th dimensions as running ones into a matrix of 3-variables slices of rank 3 using spatial weights

File:

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

trunk/tools/module_scientific.f90

@@ -52 +52 @@
 ! multi_spaceweightstats_in3DRK3_slc3v4: 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 4 using spatial weights
+! multi_spaceweightstats_in4DRK3_4_slc3v3: Subroutine to compute an spatial statistics value from a 4D RK matrix using 
+!   3rd and 4th dimensions as running ones into a matrix of 3-variables slices of rank 3 using spatial weights
 ! NcountR: Subroutine to count real values
 ! paths_border: Subroutine to search the paths of a border field.
@@ -6171 +6173 @@
   END SUBROUTINE multi_spaceweightstats_in3DRK3_slc3v3
 
+  SUBROUTINE multi_spaceweightstats_in4DRK3_4_slc3v3(varin, Ngridsin, gridsin, percentages, varout,   &
+    di1, di2, di3, di4, ds1, ds2, ds3, maxNgridsin)
+  ! Subroutine to compute an spatial statistics value from a 4D RK matrix using 3rd and 4th dimensions
+  !   as running ones into a matrix of 3-variables slices of rank 3 using spatial weights
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: di1, di2, di3, di4, ds1, ds2, ds3
+    INTEGER, INTENT(in)                                  :: maxNgridsin
+    INTEGER, DIMENSION(ds1,ds2,ds3), INTENT(in)          :: Ngridsin
+    INTEGER, DIMENSION(ds1,ds2,ds3,maxNgridsin,2),                                                    &
+      INTENT(in)                                         :: gridsin
+    REAL(r_k), DIMENSION(di1,di2,di3,di4), INTENT(in)    :: varin
+    REAL(r_k), INTENT(in),                                                                            &
+      DIMENSION(ds1,ds2,ds3,maxNgridsin)                 :: percentages
+    REAL(r_k), DIMENSION(ds1,ds2,ds3,di3,di4,7),                                                      &
+      INTENT(out)                                        :: varout
+
+! Local
+    INTEGER                                              :: i1, i2, i3, i4, s1, s2, s3, iv
+    INTEGER                                              :: ii3, ss1, ss2, ss3
+    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, di4: length of dimensions of the 4D 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
+!!!!!
+! 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_in4DRK3_4_slc3v3'
+
+    varout = fillval64
+
+    ! 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 and d4
+          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,di4))
+            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
+              DO i4=1, di4
+                minv = fillVal64
+                maxv = -fillVal64
+                meanv = zeroRK
+                mean2v = zeroRK
+                stdv = zeroRK
+                minv = MINVAL(vin(:,i3,i4))
+                maxv = MAXVAL(vin(:,i3,i4))
+                meanv = SUM(vin(:,i3,i4)*pin)
+                mean2v = SUM(vin(:,i3,i4)**2*pin)
+                DO iv=1,Nin
+                  stdv = stdv + ( (meanv - vin(iv,i3,i4))*pin(iv) )**2
+                END DO
+                stdv = SQRT(stdv)
+                svin = vin(:,i3,i4)
+                CALL SortR_K(svin, Nin)
+                medv = svin(INT(Nin/2))
+                varout(s1,s2,s3,i3,i4,1) = minv
+                varout(s1,s2,s3,i3,i4,2) = maxv
+                varout(s1,s2,s3,i3,i4,3) = meanv
+                varout(s1,s2,s3,i3,i4,4) = mean2v
+                varout(s1,s2,s3,i3,i4,5) = stdv
+                varout(s1,s2,s3,i3,i4,6) = medv
+                varout(s1,s2,s3,i3,i4,7) = Nin*1.
+              END DO
+            END DO
+          ELSE IF (Nin == 1) THEN
+            i1 = gridsin(s1,s2,s3,1,1)
+            i2 = gridsin(s1,s2,s3,1,2)
+            varout(s1,s2,s3,:,:,1) = varin(i1,i2,:,:)
+            varout(s1,s2,s3,:,:,2) = varin(i1,i2,:,:)
+            varout(s1,s2,s3,:,:,3) = varin(i1,i2,:,:)
+            varout(s1,s2,s3,:,:,4) = varin(i1,i2,:,:)*varin(i1,i2,:,:)
+            varout(s1,s2,s3,:,:,5) = zeroRK
+            varout(s1,s2,s3,:,:,6) = varin(i1,i2,:,:)
+            varout(s1,s2,s3,:,:,7) = Nin*1.
+          ELSE
+            varout(s1,s2,s3,:,:,1) = fillval64
+            varout(s1,s2,s3,:,:,2) = fillval64
+            varout(s1,s2,s3,:,:,3) = fillval64
+            varout(s1,s2,s3,:,:,4) = fillval64
+            varout(s1,s2,s3,:,:,5) = fillval64
+            varout(s1,s2,s3,:,:,6) = fillval64
+            varout(s1,s2,s3,:,:,7) = zeroRK
+          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_spaceweightstats_in4DRK3_4_slc3v3
+
   SUBROUTINE multi_spaceweightstats_in3DRK3_slc3v4(varin, Ngridsin, gridsin, percentages, varout,     &
     di1, di2, di3, ds1, ds2, ds3, ds4, maxNgridsin)