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

Timestamp:

Jan 29, 2019, 5:29:33 PM (6 years ago)

Author:

lfita

Message:

Implementing the calculation of the weighted statistics

File:

• trunk/tools/module_scientific.f90 (modified) (1 diff)

trunk/tools/module_scientific.f90

@@ -5634 +5634 @@
   END SUBROUTINE spaceweightstats
 
+  SUBROUTINE multi_spacewightstats_in3DRK3_slc3v(varin, rundim, Ngridsin, gridsin, percentages,       &
+    varout, di1, di2, di3, ds1, ds2, ds3, ds4, ds5, ds6, maxNgridsin, Lstats)
+  ! Subroutine to compute an spatial statistics value from a 3D RK matrix using 3rd dimension as 
+  !   running one into a matrix of slices using spatial weights
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: di1, di2, di3, ds1, ds2, ds3, ds4, ds5, ds6
+    INTEGER, INTENT(in)                                  :: rundim, maxNgridsin
+    CHARACTER(len=*), INTENT(in)                         :: stats
+    INTEGER, DIMENSION(ds1,ds2,ds3,ds4,ds5,ds6),                                                      &
+      INTENT(in)                                         :: Ngridsin
+    INTEGER, INTENT(in)                                                                               &
+      DIMENSION(ds1,ds2,ds3,ds4,ds5,ds6,maxNgridsin,2)   :: gridsin
+    REAL(r_k), DIMENSION(di1,di2,di3), INTENT(in)        :: varin
+    REAL(r_k), INTENT(in)                                                                             &
+      DIMENSION(ds1,ds2,ds3,ds4,ds5,ds6,maxNgridsin)     :: percentages
+    REAL(r_k), DIMENSION(ds1,ds2,ds3,ds4,ds5,ds6,di3,7),                                              &
+      INTENT(out)                                        :: varout
+
+! Local
+    INTEGER                                              :: i1, i2, i3, s1, s2, s3, s4, s5, s6
+    INTEGER                                              :: Ncounts, Nin
+    CHARACTER(len=3)                                     :: val1S, val2S
+    CHARACTER(len=30)                                    :: val3S
+    REAL(r_k)                                            :: val1, val2
+    REAL(r_k), DIMENSION(Lstats)                         :: icounts
+    INTEGER, DIMENSION(:), ALLOCATABLE                   :: pin
+    INTEGER, DIMENSION(:,:), ALLOCATABLE                 :: gin
+
+!!!!!!! Variables
+! di1, di2, di3: length of dimensions of the 3D matrix of values
+! ds[1-6]: 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
+! stats: name of the spatial statistics to compute inside each slice using values from 3D RK matrix
+!   Avaialbe ones:
+!   '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_spacewightstats_in3DRK3_slc3v'
+
+    ! Let's be efficient?
+    varout = fillVal64
+    DO s1 =1, ds1
+      DO s2 =1, ds2
+        DO s3 =1, ds3
+          DO s4 =1, ds4
+            DO s5 =1, ds5
+              DO s5 =1, ds6
+                Nin = Ngridsin(s1,s2,s3,s4,s5,s6)
+                IF (ALLOCATED(gin)) DEALLOCATE(gin)
+                ALLOCATE(gin(Nin,2))
+                IF (ALLOCATED(pin)) DEALLOCATE(pin)
+                ALLOCATE(pin(Nin))
+                gin = gridsin(s1,s2,s3,s4,s5,s6,1:Nin,:)
+                pin = percentages(s1,s2,s3,s4,s5,s6,1:Nin)
+
+                DO i1=1, di1
+                  DO i2=1, di2
+
+        DO iv=1, Ngridsin(ix,iy)
+              ii = gridsin(ix,iy,iv,1)
+              jj = gridsin(ix,iy,iv,2)
+              IF (varin(ii,jj) < varout(ix,iy,Lstats)) varout(ix,iy,1) = varin(ii,jj)
+            END DO
+          END DO
+        END DO
+
+      CASE DEFAULT
+        msg = "statisitcs '" // TRIM(stats) // "' not ready !!" // CHAR(44) // " available ones: " // &
+          "'min', 'max', 'mean', 'mean2', 'stddev', 'count'" 
+        CALL ErrMsg(msg, fname, -1)
+    END SELECT statn
+
+
+  END SUBROUTINE multi_spacewightstats_in3DRK3_slc3v
+
   SUBROUTINE multi_index_mat2DI(d1, d2, d12, mat, value, Nindices, indices)
   ! Subroutine to provide the indices of the different locations of a value inside a 2D integer matrix