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

Timestamp:

Feb 11, 2019, 2:47:36 PM (6 years ago)

Author:

lfita

Message:

Adding:

• `zones_homogenization': Subroutine to homogenize 2D contiguous zones, zones might be contiguous, but with different number assigned !

File:

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

trunk/tools/module_scientific.f90

@@ -90 +90 @@
 ! write_overlap_polys_ascii: Subroutine to write to an ASCII file the associated polygons at a given time-step
 ! write_overlap_tracks_ascii: Subroutine to write to an ASCII the polygons associated to a trajectory at a given time step
+! zones_homogenization: Subroutine to homogenize 2D contiguous zones, zones might be contiguous, but 
+!   with different number assigned !
 
 !!! *Functions/Subroutines to sort values adpated. The method used is usually referred to as "selection" method.
@@ -6703 +6705 @@
   END SUBROUTINE coincident_gridsin2D
 
+  SUBROUTINE zones_homogenization(dx, dy, inzones, outzones)
+! Subroutine to homogenize 2D contiguous zones, zones might be contiguous, but with different number assigned !
+!   Here we have a 2D matrix of integers, with contiguous integer filled zones, zero outside any zone
+!   It might be, that within the same zone, might be lines which do not share the same integer
+!     0 0 0 0 0          0 0 0 0 0 
+!     0 1 1 0 0          0 1 1 0 0
+!     0 2 0 0 1    == >  0 1 0 0 2
+!     0 1 1 0 0          0 1 1 0 0 
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: dx, dy
+    INTEGER, DIMENSION(dx,dy), INTENT(in)                :: inzones
+    INTEGER, DIMENSION(dx,dy), INTENT(out)               :: outzones
+
+! Local
+    INTEGER                                              :: i,j,k
+    INTEGER                                              :: Nmaxzones, TOTzones
+    LOGICAL                                              :: assigned
+    INTEGER, DIMENSION(dy)                               :: prevline
+    INTEGER, DIMENSION(dx)                               :: Nyzones
+    INTEGER, DIMENSION(:,:,:), ALLOCATABLE               :: zones
+
+!!!!!!! Variables
+! dx, dy: Shape of the 2D space
+! inzones: zones to homogenize
+! outzones: zones homogenized
+
+    fname = 'zones_homogenization'
+
+    ! Maximum possible number of zones
+    Nmaxzones = INT((dx/2)*(dy/2))
+
+    ! Matrix with [i,j,Nzone,izone/ezone]
+    IF (ALLOCATED(zones)) DEALLOCATE(zones)
+    ALLOCATE(zones(dx,Nmaxzones,3))
+
+    zones = 0
+    Nyzones = 0
+    ! Getting beginning/end of y-bands
+    DO i=1, dx
+      k = 0
+      j = 1
+      IF (inzones(i,j) /= 0) THEN
+        k = k + 1
+        zones(i,k,1) = j
+        zones(i,k,3) = k
+      END IF
+      DO j=2, dy
+        IF ( (inzones(i,j) /= 0) .AND. (inzones(i,j-1) == 0)) THEN
+          k = k+1
+          zones(i,k,1) = j
+          zones(i,k,3) = k
+        ELSE IF ( (inzones(i,j-1) /= 0) .AND. (inzones(i,j) == 0)) THEN
+          zones(i,k,2) = j-1
+          zones(i,k,3) = k
+        END IF
+      END DO
+      IF (k > 0) THEN
+        IF (zones(i,k,2) == 0) zones(i,k,2) = dy
+      END IF
+      Nyzones(i) = k
+    END DO
+
+    ! Homogenizing contigous zones
+    outzones = 0
+    TOTzones = 0
+    i = 1
+    DO k = 1, Nyzones(i)
+      TOTzones = TOTzones + 1
+      DO j=zones(i,k,1), zones(i,k,2)
+        outzones(i,j) = TOTzones
+      END DO
+    END DO
+
+    DO i=2, dx
+      prevline = outzones(i-1,:)
+      DO k = 1, Nyzones(i)
+        assigned = .FALSE.
+        DO j=zones(i,k,1), zones(i,k,2)
+          IF (prevline(j) /= 0) THEN
+            outzones(i,zones(i,k,1):zones(i,k,2)) = prevline(j)
+            assigned = .TRUE.
+            EXIT
+          END IF
+        END DO
+        IF (.NOT.assigned) THEN
+          TOTzones = TOTzones + 1
+          DO j=zones(i,k,1), zones(i,k,2)
+            outzones(i,j) = TOTzones
+          END DO
+        END IF
+      END DO
+    END DO
+
+    IF (ALLOCATED(zones)) DEALLOCATE(zones)
+
+  END SUBROUTINE zones_homogenization
+
 END MODULE module_scientific