SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
test_nam_var_surf.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 !############################
7 !############################
8 !
10 !
11  SUBROUTINE test_nam_varc0_surf(KLUOUT,HNAME,HVAR, &
12  hvalue1,hvalue2,hvalue3, &
13  hvalue4,hvalue5,hvalue6, &
14  hvalue7,hvalue8,hvalue9 )
15 !
16 INTEGER, INTENT(IN) ::kluout ! output listing logical unit
17  CHARACTER(LEN=*) ,INTENT(IN) ::hname ! name of the variable to test
18  CHARACTER(LEN=*) ,INTENT(IN) ::hvar ! variable to test
19 
20  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue1 ! first possible value
21  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue2 ! second possible value
22  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue3 ! third possible value
23  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue4 ! fourth possible value
24  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue5 ! fiveth possible value
25  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue6 ! sixth possible value
26  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue7 ! seventh possible value
27  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue8 ! eightth possible value
28  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue9 ! nineth possible value
29 !
30 END SUBROUTINE test_nam_varc0_surf
31 !
32  SUBROUTINE test_nam_varl0_surf(KLUOUT,HNAME,OVAR,OVALUE)
33 !
34 INTEGER, INTENT(IN) ::kluout ! output listing logical unit
35  CHARACTER(LEN=*) ,INTENT(IN) ::hname ! name of the variable to test
36 LOGICAL ,INTENT(IN) ::ovar ! variable to test
37 
38 LOGICAL ,INTENT(IN), OPTIONAL ::ovalue ! possible value
39 !
40 END SUBROUTINE test_nam_varl0_surf
41 !
42  SUBROUTINE test_nam_varn0_surf(KLUOUT,HNAME,KVAR, &
43  kvalue1,kvalue2,kvalue3, &
44  kvalue4,kvalue5,kvalue6, &
45  kvalue7,kvalue8,kvalue9 )
46 !
47 INTEGER, INTENT(IN) ::kluout ! output listing logical unit
48  CHARACTER(LEN=*) ,INTENT(IN) ::hname ! name of the variable to test
49 INTEGER ,INTENT(IN) ::kvar ! variable to test
50 
51 INTEGER ,INTENT(IN), OPTIONAL ::kvalue1 ! first possible value
52 INTEGER ,INTENT(IN), OPTIONAL ::kvalue2 ! second possible value
53 INTEGER ,INTENT(IN), OPTIONAL ::kvalue3 ! third possible value
54 INTEGER ,INTENT(IN), OPTIONAL ::kvalue4 ! fourth possible value
55 INTEGER ,INTENT(IN), OPTIONAL ::kvalue5 ! fiveth possible value
56 INTEGER ,INTENT(IN), OPTIONAL ::kvalue6 ! sixth possible value
57 INTEGER ,INTENT(IN), OPTIONAL ::kvalue7 ! seventh possible value
58 INTEGER ,INTENT(IN), OPTIONAL ::kvalue8 ! eightth possible value
59 INTEGER ,INTENT(IN), OPTIONAL ::kvalue9 ! nineth possible value
60 !
61 END SUBROUTINE test_nam_varn0_surf
62 !
63  SUBROUTINE test_nam_varx0_surf(KLUOUT,HNAME,PVAR, &
64  pvalue1,pvalue2,pvalue3, &
65  pvalue4,pvalue5,pvalue6, &
66  pvalue7,pvalue8,pvalue9 )
67 !
68 INTEGER, INTENT(IN) ::kluout ! output listing logical unit
69  CHARACTER(LEN=*) ,INTENT(IN) ::hname ! name of the variable to test
70 REAL ,INTENT(IN) ::pvar ! variable to test
71 
72 REAL ,INTENT(IN), OPTIONAL ::pvalue1 ! first possible value
73 REAL ,INTENT(IN), OPTIONAL ::pvalue2 ! second possible value
74 REAL ,INTENT(IN), OPTIONAL ::pvalue3 ! third possible value
75 REAL ,INTENT(IN), OPTIONAL ::pvalue4 ! fourth possible value
76 REAL ,INTENT(IN), OPTIONAL ::pvalue5 ! fiveth possible value
77 REAL ,INTENT(IN), OPTIONAL ::pvalue6 ! sixth possible value
78 REAL ,INTENT(IN), OPTIONAL ::pvalue7 ! seventh possible value
79 REAL ,INTENT(IN), OPTIONAL ::pvalue8 ! eightth possible value
80 REAL ,INTENT(IN), OPTIONAL ::pvalue9 ! nineth possible value
81 !
82 END SUBROUTINE test_nam_varx0_surf
83 !
84 END INTERFACE
85 !
86 END MODULE modi_test_nam_var_surf
87 !
88 !
89 ! #########################################################
90  SUBROUTINE test_nam_varc0_surf(KLUOUT,HNAME,HVAR, &
91  hvalue1,hvalue2,hvalue3, &
92  hvalue4,hvalue5,hvalue6, &
93  hvalue7,hvalue8,hvalue9 )
94 ! #########################################################
95 !
96 !!**** *TEST_NAM_VARC0* - routine to test the value of a character var.
97 !!
98 !! PURPOSE
99 !! -------
100 !
101 !
102 !!** METHOD
103 !! ------
104 !!
105 !! EXTERNAL
106 !! --------
107 !!
108 !! FM_READ
109 !!
110 !! IMPLICIT ARGUMENTS
111 !! ------------------
112 !!
113 !!
114 !! REFERENCE
115 !! ---------
116 !!
117 !!
118 !! AUTHOR
119 !! ------
120 !!
121 !! V. MASSON *METEO-FRANCE*
122 !!
123 !! MODIFICATIONS
124 !! -------------
125 !!
126 !! original 17/04/98
127 !----------------------------------------------------------------------------
128 !
129 !* 0. DECLARATIONS
130 ! ------------
131 !
132 !
133 USE yomhook ,ONLY : lhook, dr_hook
134 USE parkind1 ,ONLY : jprb
135 !
136 USE modi_abor1_sfx
137 !
138 IMPLICIT NONE
139 !
140 !* 0.1 Declarations of arguments
141 !
142 INTEGER, INTENT(IN) ::kluout ! output listing logical unit
143  CHARACTER(LEN=*) ,INTENT(IN) ::hname ! name of the variable to test
144  CHARACTER(LEN=*) ,INTENT(IN) ::hvar ! variable to test
145 
146  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue1 ! first possible value
147  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue2 ! second possible value
148  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue3 ! third possible value
149  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue4 ! fourth possible value
150  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue5 ! fiveth possible value
151  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue6 ! sixth possible value
152  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue7 ! seventh possible value
153  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue8 ! eightth possible value
154  CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::hvalue9 ! nineth possible value
155 REAL(KIND=JPRB) :: zhook_handle
156 !
157 !* 0.2 Declarations of local variables
158 !
159 !
160 !-------------------------------------------------------------------------------
161 !
162 IF (lhook) CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',0,zhook_handle)
163 IF ( present(hvalue1) ) THEN
164  IF ( hvar==hvalue1 .AND. lhook) &
165  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
166  IF ( hvar==hvalue1 ) RETURN
167 END IF
168 !
169 IF ( present(hvalue2) ) THEN
170  IF ( hvar==hvalue2 .AND. lhook) &
171  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
172  IF ( hvar==hvalue2 ) RETURN
173 END IF
174 !
175 IF ( present(hvalue3) ) THEN
176  IF ( hvar==hvalue3 .AND. lhook) &
177  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
178  IF ( hvar==hvalue3 ) RETURN
179 END IF
180 !
181 IF ( present(hvalue4) ) THEN
182  IF ( hvar==hvalue4 .AND. lhook) &
183  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
184  IF ( hvar==hvalue4 ) RETURN
185 END IF
186 !
187 IF ( present(hvalue5) ) THEN
188  IF ( hvar==hvalue5 .AND. lhook) &
189  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
190  IF ( hvar==hvalue5 ) RETURN
191 END IF
192 !
193 IF ( present(hvalue6) ) THEN
194  IF ( hvar==hvalue6 .AND. lhook) &
195  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
196  IF ( hvar==hvalue6 ) RETURN
197 END IF
198 !
199 IF ( present(hvalue7) ) THEN
200  IF ( hvar==hvalue7 .AND. lhook) &
201  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
202  IF ( hvar==hvalue7 ) RETURN
203 END IF
204 !
205 IF ( present(hvalue8) ) THEN
206  IF ( hvar==hvalue8 .AND. lhook) &
207  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
208  IF ( hvar==hvalue8 ) RETURN
209 END IF
210 !
211 IF ( present(hvalue9) ) THEN
212  IF ( hvar==hvalue9 .AND. lhook) &
213  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
214  IF ( hvar==hvalue9 ) RETURN
215 END IF
216 !
217 !-------------------------------------------------------------------------------
218 !
219 WRITE (kluout,*) ' '
220 WRITE (kluout,*) 'FATAL ERROR:'
221 WRITE (kluout,*) '-----------'
222 WRITE (kluout,*) ' '
223 WRITE (kluout,*) 'Value "',hvar,'" is not allowed for variable ',hname
224 WRITE (kluout,*) ' '
225 WRITE (kluout,*) 'Possible values are:'
226 IF ( present(hvalue1) ) WRITE (kluout,*) '"',hvalue1,'"'
227 IF ( present(hvalue2) ) WRITE (kluout,*) '"',hvalue2,'"'
228 IF ( present(hvalue3) ) WRITE (kluout,*) '"',hvalue3,'"'
229 IF ( present(hvalue4) ) WRITE (kluout,*) '"',hvalue4,'"'
230 IF ( present(hvalue5) ) WRITE (kluout,*) '"',hvalue5,'"'
231 IF ( present(hvalue6) ) WRITE (kluout,*) '"',hvalue6,'"'
232 IF ( present(hvalue7) ) WRITE (kluout,*) '"',hvalue7,'"'
233 IF ( present(hvalue8) ) WRITE (kluout,*) '"',hvalue8,'"'
234 IF ( present(hvalue9) ) WRITE (kluout,*) '"',hvalue9,'"'
235 !
236  CALL abor1_sfx('TEST_NAM_VAR_SURF: (1) CHARACTER VALUE NOT ALLOWED')
237 IF (lhook) CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,zhook_handle)
238 !-------------------------------------------------------------------------------
239 END SUBROUTINE test_nam_varc0_surf
240 ! #########################################################
241  SUBROUTINE test_nam_varl0_surf(KLUOUT,HNAME,OVAR,OVALUE)
242 ! #########################################################
243 !
244 !!**** *TEST_NAM_VARL0* - routine to test the value of a logical
245 !!
246 !! PURPOSE
247 !! -------
248 !
249 !
250 !!** METHOD
251 !! ------
252 !!
253 !! EXTERNAL
254 !! --------
255 !!
256 !! FM_READ
257 !!
258 !! IMPLICIT ARGUMENTS
259 !! ------------------
260 !!
261 !!
262 !! REFERENCE
263 !! ---------
264 !!
265 !!
266 !! AUTHOR
267 !! ------
268 !!
269 !! P. Le Moigne *METEO-FRANCE*
270 !!
271 !! MODIFICATIONS
272 !! -------------
273 !!
274 !! original 04/07
275 !----------------------------------------------------------------------------
276 !
277 !* 0. DECLARATIONS
278 ! ------------
279 !
280 !
281 USE yomhook ,ONLY : lhook, dr_hook
282 USE parkind1 ,ONLY : jprb
283 !
284 USE modi_abor1_sfx
285 !
286 IMPLICIT NONE
287 !
288 !* 0.1 Declarations of arguments
289 !
290 INTEGER, INTENT(IN) ::kluout ! output listing logical unit
291  CHARACTER(LEN=*) ,INTENT(IN) ::hname ! name of the variable to test
292 LOGICAL ,INTENT(IN) ::ovar ! variable to test
293 
294 LOGICAL ,INTENT(IN), OPTIONAL ::ovalue ! possible value
295 REAL(KIND=JPRB) :: zhook_handle
296 !
297 !* 0.2 Declarations of local variables
298 !
299 !
300 !-------------------------------------------------------------------------------
301 !
302 IF (lhook) CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARL0_SURF',0,zhook_handle)
303 IF ( present(ovalue) ) THEN
304  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARL0_SURF',1,zhook_handle)
305  IF ( ( ovar .AND. ovalue ) .OR. ( .NOT.ovar .AND. .NOT.ovalue) .AND. lhook) &
306  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARL0_SURF',1,zhook_handle)
307  IF ( ( ovar .AND. ovalue ) .OR. ( .NOT.ovar .AND. .NOT.ovalue) ) RETURN
308 END IF
309 !
310 !-------------------------------------------------------------------------------
311 !
312 WRITE (kluout,*) ' '
313 WRITE (kluout,*) 'FATAL ERROR:'
314 WRITE (kluout,*) '-----------'
315 WRITE (kluout,*) ' '
316 WRITE (kluout,*) 'Value "',ovar,'" is not allowed for variable ',hname
317 WRITE (kluout,*) ' '
318 WRITE (kluout,*) 'Possible values are:'
319 IF ( present(ovalue) ) WRITE (kluout,*) '"',ovalue,'"'
320 !
321  CALL abor1_sfx('TEST_NAM_VAR_SURF: (2) LOGICAL VALUE NOT ALLOWED')
322 IF (lhook) CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARL0_SURF',1,zhook_handle)
323 !-------------------------------------------------------------------------------
324 END SUBROUTINE test_nam_varl0_surf
325 ! #########################################################
326  SUBROUTINE test_nam_varn0_surf(KLUOUT,HNAME,KVAR, &
327  kvalue1,kvalue2,kvalue3, &
328  kvalue4,kvalue5,kvalue6, &
329  kvalue7,kvalue8,kvalue9 )
330 ! #########################################################
331 !
332 !!**** *TEST_NAM_VARN0* - routine to test the value of an integer var.
333 !!
334 !! PURPOSE
335 !! -------
336 !
337 !
338 !!** METHOD
339 !! ------
340 !!
341 !! EXTERNAL
342 !! --------
343 !!
344 !! FM_READ
345 !!
346 !! IMPLICIT ARGUMENTS
347 !! ------------------
348 !!
349 !!
350 !! REFERENCE
351 !! ---------
352 !!
353 !!
354 !! AUTHOR
355 !! ------
356 !!
357 !! P. Le Moigne *METEO-FRANCE*
358 !!
359 !! MODIFICATIONS
360 !! -------------
361 !!
362 !! original 04/2007
363 !----------------------------------------------------------------------------
364 !
365 !* 0. DECLARATIONS
366 ! ------------
367 !
368 !
369 USE yomhook ,ONLY : lhook, dr_hook
370 USE parkind1 ,ONLY : jprb
371 !
372 USE modi_abor1_sfx
373 !
374 IMPLICIT NONE
375 !
376 !* 0.1 Declarations of arguments
377 !
378 INTEGER, INTENT(IN) ::kluout ! output listing logical unit
379  CHARACTER(LEN=*) ,INTENT(IN) ::hname ! name of the variable to test
380 INTEGER ,INTENT(IN) ::kvar ! variable to test
381 
382 INTEGER ,INTENT(IN), OPTIONAL ::kvalue1 ! first possible value
383 INTEGER ,INTENT(IN), OPTIONAL ::kvalue2 ! second possible value
384 INTEGER ,INTENT(IN), OPTIONAL ::kvalue3 ! third possible value
385 INTEGER ,INTENT(IN), OPTIONAL ::kvalue4 ! fourth possible value
386 INTEGER ,INTENT(IN), OPTIONAL ::kvalue5 ! fiveth possible value
387 INTEGER ,INTENT(IN), OPTIONAL ::kvalue6 ! sixth possible value
388 INTEGER ,INTENT(IN), OPTIONAL ::kvalue7 ! seventh possible value
389 INTEGER ,INTENT(IN), OPTIONAL ::kvalue8 ! eightth possible value
390 INTEGER ,INTENT(IN), OPTIONAL ::kvalue9 ! nineth possible value
391 REAL(KIND=JPRB) :: zhook_handle
392 !
393 !* 0.2 Declarations of local variables
394 !
395 !
396 !-------------------------------------------------------------------------------
397 !
398 IF (lhook) CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',0,zhook_handle)
399 IF ( present(kvalue1) ) THEN
400  IF ( kvar==kvalue1 .AND. lhook) &
401  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
402  IF ( kvar==kvalue1 ) RETURN
403 END IF
404 !
405 IF ( present(kvalue2) ) THEN
406  IF ( kvar==kvalue2 .AND. lhook) &
407  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
408  IF ( kvar==kvalue2 ) RETURN
409 END IF
410 !
411 IF ( present(kvalue3) ) THEN
412  IF ( kvar==kvalue3 .AND. lhook) &
413  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
414  IF ( kvar==kvalue3 ) RETURN
415 END IF
416 !
417 IF ( present(kvalue4) ) THEN
418  IF ( kvar==kvalue4 .AND. lhook) &
419  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
420  IF ( kvar==kvalue4 ) RETURN
421 END IF
422 !
423 IF ( present(kvalue5) ) THEN
424  IF ( kvar==kvalue5 .AND. lhook) &
425  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
426  IF ( kvar==kvalue5 ) RETURN
427 END IF
428 !
429 IF ( present(kvalue6) ) THEN
430  IF ( kvar==kvalue6 .AND. lhook) &
431  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
432  IF ( kvar==kvalue6 ) RETURN
433 END IF
434 !
435 IF ( present(kvalue7) ) THEN
436  IF ( kvar==kvalue7 .AND. lhook) &
437  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
438  IF ( kvar==kvalue7 ) RETURN
439 END IF
440 !
441 IF ( present(kvalue8) ) THEN
442  IF ( kvar==kvalue8 .AND. lhook) &
443  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
444  IF ( kvar==kvalue8 ) RETURN
445 END IF
446 !
447 IF ( present(kvalue9) ) THEN
448  IF ( kvar==kvalue9 .AND. lhook) &
449  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
450  IF ( kvar==kvalue9 ) RETURN
451 END IF
452 !
453 !-------------------------------------------------------------------------------
454 !
455 WRITE (kluout,*) ' '
456 WRITE (kluout,*) 'FATAL ERROR:'
457 WRITE (kluout,*) '-----------'
458 WRITE (kluout,*) ' '
459 WRITE (kluout,*) 'Value "',kvar,'" is not allowed for variable ',hname
460 WRITE (kluout,*) ' '
461 WRITE (kluout,*) 'Possible values are:'
462 IF ( present(kvalue1) ) WRITE (kluout,*) '"',kvalue1,'"'
463 IF ( present(kvalue2) ) WRITE (kluout,*) '"',kvalue2,'"'
464 IF ( present(kvalue3) ) WRITE (kluout,*) '"',kvalue3,'"'
465 IF ( present(kvalue4) ) WRITE (kluout,*) '"',kvalue4,'"'
466 IF ( present(kvalue5) ) WRITE (kluout,*) '"',kvalue5,'"'
467 IF ( present(kvalue6) ) WRITE (kluout,*) '"',kvalue6,'"'
468 IF ( present(kvalue7) ) WRITE (kluout,*) '"',kvalue7,'"'
469 IF ( present(kvalue8) ) WRITE (kluout,*) '"',kvalue8,'"'
470 IF ( present(kvalue9) ) WRITE (kluout,*) '"',kvalue9,'"'
471 !
472  CALL abor1_sfx('TEST_NAM_VAR_SURF: (3) INTEGER VALUE NOT ALLOWED')
473 IF (lhook) CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
474 !-------------------------------------------------------------------------------
475 END SUBROUTINE test_nam_varn0_surf
476 
477 ! #########################################################
478  SUBROUTINE test_nam_varx0_surf(KLUOUT,HNAME,PVAR, &
479  pvalue1,pvalue2,pvalue3, &
480  pvalue4,pvalue5,pvalue6, &
481  pvalue7,pvalue8,pvalue9 )
482 ! #########################################################
483 !
484 !!**** *TEST_NAM_VARN0* - routine to test the value of an integer var.
485 !!
486 !! PURPOSE
487 !! -------
488 !
489 !
490 !!** METHOD
491 !! ------
492 !!
493 !! EXTERNAL
494 !! --------
495 !!
496 !! FM_READ
497 !!
498 !! IMPLICIT ARGUMENTS
499 !! ------------------
500 !!
501 !!
502 !! REFERENCE
503 !! ---------
504 !!
505 !!
506 !! AUTHOR
507 !! ------
508 !!
509 !! B. Decharme *METEO-FRANCE*
510 !!
511 !! MODIFICATIONS
512 !! -------------
513 !!
514 !! original 01/2014
515 !----------------------------------------------------------------------------
516 !
517 !* 0. DECLARATIONS
518 ! ------------
519 !
520 !
521 USE yomhook ,ONLY : lhook, dr_hook
522 USE parkind1 ,ONLY : jprb
523 !
524 USE modi_abor1_sfx
525 !
526 IMPLICIT NONE
527 !
528 !* 0.1 Declarations of arguments
529 !
530 INTEGER, INTENT(IN) ::kluout ! output listing logical unit
531  CHARACTER(LEN=*) ,INTENT(IN) ::hname ! name of the variable to test
532 REAL ,INTENT(IN) ::pvar ! variable to test
533 
534 REAL ,INTENT(IN), OPTIONAL ::pvalue1 ! first possible value
535 REAL ,INTENT(IN), OPTIONAL ::pvalue2 ! second possible value
536 REAL ,INTENT(IN), OPTIONAL ::pvalue3 ! third possible value
537 REAL ,INTENT(IN), OPTIONAL ::pvalue4 ! fourth possible value
538 REAL ,INTENT(IN), OPTIONAL ::pvalue5 ! fiveth possible value
539 REAL ,INTENT(IN), OPTIONAL ::pvalue6 ! sixth possible value
540 REAL ,INTENT(IN), OPTIONAL ::pvalue7 ! seventh possible value
541 REAL ,INTENT(IN), OPTIONAL ::pvalue8 ! eightth possible value
542 REAL ,INTENT(IN), OPTIONAL ::pvalue9 ! nineth possible value
543 REAL(KIND=JPRB) :: zhook_handle
544 !
545 !* 0.2 Declarations of local variables
546 !
547 !
548 !-------------------------------------------------------------------------------
549 !
550 IF (lhook) CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',0,zhook_handle)
551 IF ( present(pvalue1) ) THEN
552  IF ( pvar==pvalue1 .AND. lhook) &
553  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
554  IF ( pvar==pvalue1 ) RETURN
555 END IF
556 !
557 IF ( present(pvalue2) ) THEN
558  IF ( pvar==pvalue2 .AND. lhook) &
559  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
560  IF ( pvar==pvalue2 ) RETURN
561 END IF
562 !
563 IF ( present(pvalue3) ) THEN
564  IF ( pvar==pvalue3 .AND. lhook) &
565  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
566  IF ( pvar==pvalue3 ) RETURN
567 END IF
568 !
569 IF ( present(pvalue4) ) THEN
570  IF ( pvar==pvalue4 .AND. lhook) &
571  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
572  IF ( pvar==pvalue4 ) RETURN
573 END IF
574 !
575 IF ( present(pvalue5) ) THEN
576  IF ( pvar==pvalue5 .AND. lhook) &
577  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
578  IF ( pvar==pvalue5 ) RETURN
579 END IF
580 !
581 IF ( present(pvalue6) ) THEN
582  IF ( pvar==pvalue6 .AND. lhook) &
583  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
584  IF ( pvar==pvalue6 ) RETURN
585 END IF
586 !
587 IF ( present(pvalue7) ) THEN
588  IF ( pvar==pvalue7 .AND. lhook) &
589  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
590  IF ( pvar==pvalue7 ) RETURN
591 END IF
592 !
593 IF ( present(pvalue8) ) THEN
594  IF ( pvar==pvalue8 .AND. lhook) &
595  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
596  IF ( pvar==pvalue8 ) RETURN
597 END IF
598 !
599 IF ( present(pvalue9) ) THEN
600  IF ( pvar==pvalue9 .AND. lhook) &
601  CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
602  IF ( pvar==pvalue9 ) RETURN
603 END IF
604 !
605 !-------------------------------------------------------------------------------
606 !
607 WRITE (kluout,*) ' '
608 WRITE (kluout,*) 'FATAL ERROR:'
609 WRITE (kluout,*) '-----------'
610 WRITE (kluout,*) ' '
611 WRITE (kluout,*) 'Value "',pvar,'" is not allowed for variable ',hname
612 WRITE (kluout,*) ' '
613 WRITE (kluout,*) 'Possible values are:'
614 IF ( present(pvalue1) ) WRITE (kluout,*) '"',pvalue1,'"'
615 IF ( present(pvalue2) ) WRITE (kluout,*) '"',pvalue2,'"'
616 IF ( present(pvalue3) ) WRITE (kluout,*) '"',pvalue3,'"'
617 IF ( present(pvalue4) ) WRITE (kluout,*) '"',pvalue4,'"'
618 IF ( present(pvalue5) ) WRITE (kluout,*) '"',pvalue5,'"'
619 IF ( present(pvalue6) ) WRITE (kluout,*) '"',pvalue6,'"'
620 IF ( present(pvalue7) ) WRITE (kluout,*) '"',pvalue7,'"'
621 IF ( present(pvalue8) ) WRITE (kluout,*) '"',pvalue8,'"'
622 IF ( present(pvalue9) ) WRITE (kluout,*) '"',pvalue9,'"'
623 !
624  CALL abor1_sfx('TEST_NAM_VAR_SURF: (4) REAL VALUE NOT ALLOWED')
625 IF (lhook) CALL dr_hook('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,zhook_handle)
626 !-------------------------------------------------------------------------------
627 END SUBROUTINE test_nam_varx0_surf
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
subroutine test_nam_varn0_surf(KLUOUT, HNAME, KVAR, KVALUE1, KVALUE2, KVALUE3, KVALUE4, KVALUE5, KVALUE6, KVALUE7, KVALUE8, KVALUE9)
subroutine test_nam_varl0_surf(KLUOUT, HNAME, OVAR, OVALUE)
subroutine test_nam_varc0_surf(KLUOUT, HNAME, HVAR, HVALUE1, HVALUE2, HVALUE3, HVALUE4, HVALUE5, HVALUE6, HVALUE7, HVALUE8, HVALUE9)
subroutine test_nam_varx0_surf(KLUOUT, HNAME, PVAR, PVALUE1, PVALUE2, PVALUE3, PVALUE4, PVALUE5, PVALUE6, PVALUE7, PVALUE8, PVALUE9)