source: lmdz_wrf/trunk/tools/module_generic.F90 @ 964

MODULE module_generic
! Module with generic functions

  CONTAINS

  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
    CHARACTER(LEN=50)                                    :: fname

    fname = 'Index1DArrayR'

    Index1DArrayR = -1

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

  END FUNCTION Index1DArrayR

  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
    CHARACTER(LEN=50)                                    :: fname

    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

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

    IMPLICIT NONE

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

    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