source: lmdz_wrf/trunk/tools/module_generic.f90 @ 1628

MODULE module_generic
! Module with generic functions

!!!!!!! Subroutines/Functions
! ErrMsg: Subroutine to stop execution and provide an error message
! ErrWarnMsg: Function to print error/warning message
! index_list_coordsI: Function to provide the index of a given coordinate within a list of integer coordinates
! Index1DArrayI: Function to provide the first index of a given value inside a 1D integer array
! Index1DArrayR: Function to provide the first index of a given value inside a 1D real array
! Index1DArrayR_K: Function to provide the first index of a given value inside a 1D real(r_k) array
! Index2DArrayR: Function to provide the first index of a given value inside a 2D real array
! mat2DPosition: Function to provide the i, j indices of a given value inside a 2D matrix
! Nstrings: Function to repeat a number of times a given string
! RangeI: Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector
! 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
! split: Subroutine which provides the values from a string [String] which has been split by a given 
!   character [charv] a given number of values [Nvalues] is expected
! vectorR_KS: Function to transform a vector of reals to a string of characters

  USE module_definitions

  CONTAINS

  INTEGER FUNCTION index_list_coordsI(Ncoords, coords, icoord)
  ! Function to provide the index of a given coordinate within a list of integer coordinates

    IMPLICIT NONE

    INTEGER, INTENT(in)                                  :: Ncoords
    INTEGER, DIMENSION(Ncoords,2), INTENT(in)            :: coords
    INTEGER, DIMENSION(2), INTENT(in)                    :: icoord

! Local
    INTEGER, DIMENSION(Ncoords)                          :: dist
    INTEGER                                              :: i,mindist
    INTEGER, DIMENSION(1)                                :: iloc

!!!!!!! Variables
! Ncoords: number of coordinates in the list
! coords: list of coordinates
! icoord: coordinate to find

  fname = 'index_list_coordsI'

  dist = (coords(:,1)-icoord(1))**2+(coords(:,2)-icoord(2))**2

  IF (ANY(dist == 0)) THEN
    iloc = MINLOC(dist)
    index_list_coordsI = iloc(1)
  ELSE
    index_list_coordsI = -1
  END IF

  END FUNCTION index_list_coordsI

  CHARACTER(len=1000) FUNCTION vectorR_KS(d1, vector)
  ! Function to transform a vector of reals(r_k) to a string of characters

    IMPLICIT NONE

    INTEGER, INTENT(in)                                  :: d1
    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: vector

! Local
    INTEGER                                              :: iv
    CHARACTER(len=50)                                    :: RS

!!!!!!! Variables
! d1: length of the vector
! vector: values to transform

    fname = 'vectorR_KS'

    vectorR_KS = ''
    DO iv=1, d1
      WRITE(RS, '(F50.25)')vector(iv)
      IF (iv == 1) THEN
        vectorR_KS = TRIM(RS)
      ELSE
        vectorR_KS = TRIM(vectorR_KS) // ', ' // TRIM(RS)
      END IF
    END DO    

  END FUNCTION vectorR_KS

CHARACTER(len=1000) FUNCTION Nstrings(Strval, Ntimes)
! Function to repeat a number of times a given string

  IMPLICIT NONE

  CHARACTER(LEN=50), INTENT(in)                        :: Strval
  INTEGER, INTENT(in)                                  :: Ntimes

! Local
  INTEGER                                              :: i

!!!!!!! Variables
! Strval: String to repeat
! Ntimes: number of repetitions

  fname = 'Nstrings'

  Nstrings = ''
  Do i=1, Ntimes
    Nstrings = TRIM(Nstrings) // TRIM(Strval)
  END DO

END FUNCTION Nstrings

  INTEGER FUNCTION Index1DArrayI(array1D, d1, val)
! Function to provide the first index of a given value inside a 1D integer array

    IMPLICIT NONE

    INTEGER, INTENT(in)                                  :: d1
    INTEGER, INTENT(in)                                  :: val
    INTEGER, DIMENSION(d1), INTENT(in)                   :: array1D

! Local
    INTEGER                                              :: i

    fname = 'Index1DArrayI'

    Index1DArrayI = -1

    DO i=1,d1
      IF (array1d(i) == val) THEN
        Index1DArrayI = i
        EXIT
      END IF
    END DO

  END FUNCTION Index1DArrayI

  INTEGER FUNCTION Index1DArrayR(array1D, d1, val)
! Function to provide the first index of a given value inside a 1D real array

    IMPLICIT NONE

    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    INTEGER, INTENT(in)                                  :: d1
    REAL(r_k), INTENT(in)                                :: val
    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: array1D

! Local
    INTEGER                                              :: i

    fname = 'Index1DArrayR'

    Index1DArrayR = -1

    DO i=1,d1
      IF (array1d(i) == val) THEN
        Index1DArrayR = i
        EXIT
      END IF
    END DO

  END FUNCTION Index1DArrayR

  INTEGER FUNCTION Index1DArrayR_K(array1D, d1, val)
! Function to provide the first index of a given value inside a 1D real(r_k) array

    IMPLICIT NONE

    INTEGER, INTENT(in)                                  :: d1
    REAL(r_k), INTENT(in)                                :: val
    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: array1D

! Local
    INTEGER                                              :: i

    fname = 'Index1DArrayR_K'

    Index1DArrayR_K = -1

    DO i=1,d1
      IF (array1d(i) == val) THEN
        Index1DArrayR_K = i
        EXIT
      END IF
    END DO

  END FUNCTION Index1DArrayR_K

  FUNCTION Index2DArrayR(array2D, d1, d2, val)
! Function to provide the first index of a given value inside a 2D real array

    IMPLICIT NONE

    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    INTEGER, INTENT(in)                                  :: d1, d2
    REAL(r_k), INTENT(in)                                :: val
    REAL(r_k), DIMENSION(d1,d2), INTENT(in)              :: array2D
    INTEGER, DIMENSION(2)                                :: Index2DArrayR

! Local
    INTEGER                                              :: i, j

    fname = 'Index2DArrayR'

    Index2DArrayR = -1

    DO i=1,d1
      DO j=1,d2
        IF (array2d(i,j) == val) THEN
          Index2DArrayR(1) = i
          Index2DArrayR(2) = j
          EXIT
        END IF
      END DO
    END DO

  END FUNCTION Index2DArrayR

  FUNCTION RangeI(d1, iniv, endv)
! Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector

    IMPLICIT NONE

    INTEGER, INTENT(in)                                  :: d1, iniv, endv
    INTEGER, DIMENSION(d1)                               :: RangeI

! Local
    INTEGER                                              :: i, intv

    fname = 'RangeI'

    intv = (endv - iniv) / (d1*1 - 1)

    RangeI(1) = iniv
    DO i=2,d1
      RangeI(i) = RangeI(i-1) + intv
    END DO

  END FUNCTION RangeI 

  FUNCTION RangeR(d1, iniv, endv)
! Function to provide a range of d1 from 'iniv' to 'endv', of real values in a vector

    IMPLICIT NONE

    INTEGER, INTENT(in)                                  :: d1
    REAL, INTENT(in)                                     :: iniv, endv
    REAL, DIMENSION(d1)                                  :: RangeR

! Local
    INTEGER                                              :: i
    REAL                                                 :: intv

    fname = 'RangeR'

    intv = (endv - iniv) / (d1*1. - 1.)

    RangeR(1) = iniv
    DO i=2,d1
      RangeR(i) = RangeR(i-1) + intv
    END DO

  END FUNCTION RangeR


  FUNCTION RangeR_K(d1, iniv, endv)
! Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector

    IMPLICIT NONE

    INTEGER, INTENT(in)                                  :: d1
    REAL(r_k), INTENT(in)                                :: iniv, endv
    REAL(r_k), DIMENSION(d1)                             :: RangeR_K

! Local
    INTEGER                                              :: i
    REAL(r_k)                                            :: intv

    fname = 'RangeR_K'

    intv = (endv - iniv) / (d1*oneRK-oneRK)

    RangeR_K(1) = iniv
    DO i=2,d1
      RangeR_K(i) = RangeR_K(i-1) + intv
    END DO

  END FUNCTION RangeR_K

  SUBROUTINE split(String,charv,Nvalues,values)
! Subroutine which provides the values from a string [String] which has been split by a given 
!   character [charv] a given number of values [Nvalues] is expected

    IMPLICIT NONE

    CHARACTER(LEN=1000), INTENT(IN)                        :: String
    CHARACTER(LEN=1), INTENT(IN)                           :: charv
    INTEGER, INTENT(IN)                                    :: Nvalues
    CHARACTER(LEN=200), INTENT(OUT), DIMENSION(Nvalues)    :: values

! Local
    INTEGER                                                :: i, ibeg, iend, Lstring
    CHARACTER(LEN=3)                                       :: numS
    CHARACTER(LEN=1000)                                    :: newString

!!!!!!! Variables
! String: String to split
! charv: Character to use
! Nvalues: number of values
! values: vector with the given values (up to 200 characters)

    fname = 'split'

    newString = String
    ibeg = 1
    Lstring = LEN_TRIM(String)

    DO i=1,Nvalues-1
      iend = INDEX(newString(ibeg:Lstring), charv)

      IF (iend == 0) THEN
        WRITE (numS,"(I3)")Nvalues - 1
        msg = "String '" // TRIM(String) // "' does not have " // TRIM(numS) // " '" // charv // "' !!"
        CALL ErrMsg(msg, fname, -1)
      END IF

      values(i) = newString(ibeg:ibeg+iend-2)
      ibeg = ibeg+iend
    END DO
    values(Nvalues) = newString(ibeg:Lstring)

  END SUBROUTINE split

SUBROUTINE ErrMsg(msg, funcn, errN)
! Subroutine to stop execution and provide an error message

  IMPLICIT NONE

  CHARACTER(LEN=*), INTENT(in)                           :: msg, funcn
  INTEGER, INTENT(in)                                    :: errN

! Local
  CHARACTER(LEN=50)                                      :: emsg

!!!!!!! Variables
! msg: message to print with the error
! funcn: name of the funciton, section to localize the error
! errN: number of the error provided for a given FORTRAN function

  emsg = 'ERORR -- error -- ERROR -- error'

  IF (errN /= 0) THEN
    PRINT *,TRiM(emsg)
    PRINT *,'  ' // TRIM(funcn) // ': ' // TRIM(msg) // ' !!'
    PRINT *,'    error number:', errN
    STOP
  END IF

  RETURN

END SUBROUTINE ErrMsg

  CHARACTER(LEN=50) FUNCTION ErrWarnMsg(msg)
! Function to print error/warning message

    IMPLICIT NONE

    CHARACTER(LEN=3), INTENT(in)                         :: msg
! Local

    fname = 'ErrWarnMsg'

    IF (msg == 'err') THEN
      ErrWarnMsg = 'ERROR -- error -- ERROR -- error'
    ELSE IF (msg == 'wrn') THEN
      ErrWarnMsg = 'WARNING -- warning -- WARNING -- warning'
    ELSE
      PRINT *,'ERROR -- error -- ERROR -- error'
      PRINT *,'  ' // TRIM(fname) // ": '" // TRIM(msg) // "' does not exist!!" 
      STOP
    END IF
  END FUNCTION ErrWarnMsg

END MODULE module_generic