Changeset 2618 in lmdz_wrf for trunk/tools

Timestamp:

Jun 19, 2019, 5:09:15 PM (6 years ago)

Author:

lfita

Message:

Adding:

• `rm_values_vecRK': Subroutine to remove a given value (e.g. fill_Value) from a RK vector

File:

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

trunk/tools/module_generic.f90

@@ -29 +29 @@
 ! RangeR: Function to provide a range of d1 values from 'iniv' to 'endv', of real values in a vector
 ! RangeR_K: Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
+! rm_values_vecRK: Subroutine to remove a given value (e.g. fill_Value) from a RK vector
 ! stoprun: Subroutine to stop running and print a message
 ! vectorI_S: Function to transform a vector of integers to a string of characters
@@ -1193 +1194 @@
   END SUBROUTINE GDATE
 
+  SUBROUTINE rm_values_vecRK(d1, vector, rmvalue, rmd1, rmvector)
+  ! Subroutine to remove a given value (e.g. fill_Value) from a RK vector
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(in)                                  :: d1
+    REAL(r_k), INTENT(in)                                :: rmvalue
+    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: vector
+    INTEGER, INTENT(out)                                 :: rmd1
+    REAL(r_k), DIMENSION(d1), INTENT(out)                :: rmvector
+
+! Local
+    INTEGER                                              :: i
+
+!!!!!!! Variables
+! d1: length of the vector
+! vector: vector with values
+! rmvalue: RK value to remove
+! rmd1: length of the new vector
+! rmvector: new vector
+
+    fname = 'rm_values_vecRK'
+
+    rmd1 = 0
+    rmvector = zeroRK
+
+    DO i=1, d1
+      IF (vector(i) /= rmvalue) THEN
+        rmd1 = rmd1 + 1
+        rmvector(rmd1) = vector(i)
+      END IF
+    END DO
+
+  END SUBROUTINE rm_values_vecRK
+
 END MODULE module_generic