Newer
Older
!MNH_LIC Copyright 1994-2013 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENCE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
! MASDEV4_7 init 2006/05/18 13:07:25
!-----------------------------------------------------------------
!############################
MODULE MODI_TEST_NAM_VAR
!############################
!
INTERFACE TEST_NAM_VAR
!
SUBROUTINE TEST_NAM_VARC0(KLUOUT,HNAME,HVAR, &
HVALUE1,HVALUE2,HVALUE3, &
HVALUE4,HVALUE5,HVALUE6, &
HVALUE7,HVALUE8,HVALUE9,HVALUE10 )
!
INTEGER, INTENT(IN) ::KLUOUT ! 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
CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE10 ! tenth possible value
!
END SUBROUTINE TEST_NAM_VARC0
!
END INTERFACE
!
END MODULE MODI_TEST_NAM_VAR
!
!
! #########################################################
SUBROUTINE TEST_NAM_VARC0(KLUOUT,HNAME,HVAR, &
HVALUE1,HVALUE2,HVALUE3, &
HVALUE4,HVALUE5,HVALUE6, &
HVALUE7,HVALUE8,HVALUE9,HVALUE10 )
! #########################################################
!
!!**** *TEST_NAM_VARC0* - routine to test the value of a character var.
!!
!! PURPOSE
!! -------
!
!
!!** METHOD
!! ------
!!
!! EXTERNAL
!! --------
!!
!! FM_READ
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!!
!! V. MASSON *METEO-FRANCE*
!!
!! MODIFICATIONS
!! -------------
!!
!! original 17/04/98
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
INTEGER, INTENT(IN) ::KLUOUT ! 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
CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE10 ! tenth possible value
!
!* 0.2 Declarations of local variables
!
!
!-------------------------------------------------------------------------------
!
IF ( PRESENT (HVALUE1) ) THEN
IF ( HVAR==HVALUE1 ) RETURN
END IF
!
IF ( PRESENT (HVALUE2) ) THEN
IF ( HVAR==HVALUE2 ) RETURN
END IF
!
IF ( PRESENT (HVALUE3) ) THEN
IF ( HVAR==HVALUE3 ) RETURN
END IF
!
IF ( PRESENT (HVALUE4) ) THEN
IF ( HVAR==HVALUE4 ) RETURN
END IF
!
IF ( PRESENT (HVALUE5) ) THEN
IF ( HVAR==HVALUE5 ) RETURN
END IF
!
IF ( PRESENT (HVALUE6) ) THEN
IF ( HVAR==HVALUE6 ) RETURN
END IF
!
IF ( PRESENT (HVALUE7) ) THEN
IF ( HVAR==HVALUE7 ) RETURN
END IF
!
IF ( PRESENT (HVALUE8) ) THEN
IF ( HVAR==HVALUE8 ) RETURN
END IF
!
IF ( PRESENT (HVALUE9) ) THEN
IF ( HVAR==HVALUE9 ) RETURN
END IF
!
IF ( PRESENT (HVALUE10) ) THEN
IF ( HVAR==HVALUE10 ) RETURN
END IF
!
!
!-------------------------------------------------------------------------------
!
WRITE (KLUOUT,*) ' '
WRITE (KLUOUT,*) 'FATAL ERROR:'
WRITE (KLUOUT,*) '-----------'
WRITE (KLUOUT,*) ' '
WRITE (KLUOUT,*) 'Value "',HVAR,'" is not allowed for variable ',HNAME
WRITE (KLUOUT,*) ' '
WRITE (KLUOUT,*) 'Possible values are:'
IF ( PRESENT (HVALUE1) ) WRITE (KLUOUT,*) '"',HVALUE1,'"'
IF ( PRESENT (HVALUE2) ) WRITE (KLUOUT,*) '"',HVALUE2,'"'
IF ( PRESENT (HVALUE3) ) WRITE (KLUOUT,*) '"',HVALUE3,'"'
IF ( PRESENT (HVALUE4) ) WRITE (KLUOUT,*) '"',HVALUE4,'"'
IF ( PRESENT (HVALUE5) ) WRITE (KLUOUT,*) '"',HVALUE5,'"'
IF ( PRESENT (HVALUE6) ) WRITE (KLUOUT,*) '"',HVALUE6,'"'
IF ( PRESENT (HVALUE7) ) WRITE (KLUOUT,*) '"',HVALUE7,'"'
IF ( PRESENT (HVALUE8) ) WRITE (KLUOUT,*) '"',HVALUE8,'"'
IF ( PRESENT (HVALUE9) ) WRITE (KLUOUT,*) '"',HVALUE9,'"'
IF ( PRESENT (HVALUE10) ) WRITE (KLUOUT,*) '"',HVALUE10,'"'
!
!callabortstop
CALL ABORT
STOP
!-------------------------------------------------------------------------------
END SUBROUTINE TEST_NAM_VARC0