test_nam_var_trip.F90

Go to the documentation of this file.

!     #########################################################
      SUBROUTINE test_nam_var_trip(KLISTING,HNAME,HVAR,       &
                                     HVALUE1,HVALUE2,HVALUE3, &
                                     HVALUE4,HVALUE5,HVALUE6, &
                                     HVALUE7,HVALUE8,HVALUE9  )  
!     #########################################################
!
!!****  *TEST_NAM_VARC0* - routine to test the value of a character var.
!!
!!    PURPOSE
!!    -------
!
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!      FM_READ
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      B. Decharme      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original form V. Masson         17/04/98
!-------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abort_trip
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
INTEGER,          INTENT(IN)           ::KLISTING   ! output listing logical unit
 CHARACTER(LEN=*) ,INTENT(IN)           ::HNAME    ! name of the variable to test
 CHARACTER(LEN=*) ,INTENT(IN)           ::HVAR     ! variable to test

 CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE1  ! first possible value
 CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE2  ! second possible value
 CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE3  ! third possible value
 CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE4  ! fourth possible value
 CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE5  ! fiveth possible value
 CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE6  ! sixth possible value
 CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE7  ! seventh possible value
 CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE8  ! eightth possible value
 CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE9  ! nineth possible value
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      0.2   Declarations of local variables
!
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('TEST_NAM_VAR_TRIP',0,zhook_handle)
IF ( PRESENT (hvalue1) ) THEN
  IF ( hvar==hvalue1  .AND. lhook) &
        CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
  IF ( hvar==hvalue1 ) RETURN
END IF
!
IF ( PRESENT (hvalue2) ) THEN
  IF ( hvar==hvalue2  .AND. lhook) &
        CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
  IF ( hvar==hvalue2 ) RETURN
END IF
!
IF ( PRESENT (hvalue3) ) THEN
  IF ( hvar==hvalue3  .AND. lhook) &
        CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
  IF ( hvar==hvalue3 ) RETURN
END IF
!
IF ( PRESENT (hvalue4) ) THEN
  IF ( hvar==hvalue4  .AND. lhook) &
        CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
  IF ( hvar==hvalue4 ) RETURN
END IF
!
IF ( PRESENT (hvalue5) ) THEN
  IF ( hvar==hvalue5  .AND. lhook) &
        CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
  IF ( hvar==hvalue5 ) RETURN
END IF
!
IF ( PRESENT (hvalue6) ) THEN
  IF ( hvar==hvalue6  .AND. lhook) &
        CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
  IF ( hvar==hvalue6 ) RETURN
END IF
!
IF ( PRESENT (hvalue7) ) THEN
  IF ( hvar==hvalue7  .AND. lhook) &
        CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
  IF ( hvar==hvalue7 ) RETURN
END IF
!
IF ( PRESENT (hvalue8) ) THEN
  IF ( hvar==hvalue8  .AND. lhook) &
        CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
  IF ( hvar==hvalue8 ) RETURN
END IF
!
IF ( PRESENT (hvalue9) ) THEN
  IF ( hvar==hvalue9  .AND. lhook) &
        CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
  IF ( hvar==hvalue9 ) RETURN
END IF
!
!-------------------------------------------------------------------------------
!
WRITE (klisting,*) ' '
WRITE (klisting,*) 'FATAL ERROR:'
WRITE (klisting,*) '-----------'
WRITE (klisting,*) ' '
WRITE (klisting,*) 'Value "',hvar,'" is not allowed for variable ',hname
WRITE (klisting,*) ' '
WRITE (klisting,*) 'Possible values are:'
IF ( PRESENT (hvalue1) ) WRITE (klisting,*) '"',hvalue1,'"'
IF ( PRESENT (hvalue2) ) WRITE (klisting,*) '"',hvalue2,'"'
IF ( PRESENT (hvalue3) ) WRITE (klisting,*) '"',hvalue3,'"'
IF ( PRESENT (hvalue4) ) WRITE (klisting,*) '"',hvalue4,'"'
IF ( PRESENT (hvalue5) ) WRITE (klisting,*) '"',hvalue5,'"'
IF ( PRESENT (hvalue6) ) WRITE (klisting,*) '"',hvalue6,'"'
IF ( PRESENT (hvalue7) ) WRITE (klisting,*) '"',hvalue7,'"'
IF ( PRESENT (hvalue8) ) WRITE (klisting,*) '"',hvalue8,'"'
IF ( PRESENT (hvalue9) ) WRITE (klisting,*) '"',hvalue9,'"'
!
 CALL abort_trip('TEST_NAM_VAR_TRIP: (1) CHARACTER VALUE NOT ALLOWED')
IF (lhook) CALL dr_hook('TEST_NAM_VAR_TRIP',1,zhook_handle)
!-------------------------------------------------------------------------------
END SUBROUTINE test_nam_var_trip