SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
prep_watflux_unif.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 ! #########
6 SUBROUTINE prep_watflux_unif(KLUOUT,HSURF,PFIELD)
7 ! #################################################################################
8 !
9 !!**** *PREP_WATFLUX_UNIF* - prepares WATFLUX field from prescribed values
10 !!
11 !! PURPOSE
12 !! -------
13 !
14 !!** METHOD
15 !! ------
16 !!
17 !! REFERENCE
18 !! ---------
19 !!
20 !!
21 !! AUTHOR
22 !! ------
23 !! S. Malardel
24 !!
25 !! MODIFICATIONS
26 !! -------------
27 !! Original 01/2004
28 !!------------------------------------------------------------------
29 !
30 !
31 USE modd_prep, ONLY : cinterp_type
32 USE modd_prep_watflux, ONLY : xts_water_unif
33 !
34 !
35 USE yomhook ,ONLY : lhook, dr_hook
36 USE parkind1 ,ONLY : jprb
37 !
38 IMPLICIT NONE
39 !
40 !* 0.1 declarations of arguments
41 !
42 INTEGER, INTENT(IN) :: kluout ! output listing logical unit
43  CHARACTER(LEN=7), INTENT(IN) :: hsurf ! type of field
44 REAL, POINTER, DIMENSION(:,:) :: pfield ! field to interpolate horizontally
45 REAL(KIND=JPRB) :: zhook_handle
46 !
47 !* 0.2 declarations of local variables
48 !
49 !
50 !-------------------------------------------------------------------------------------
51 !
52 IF (lhook) CALL dr_hook('PREP_WATFLUX_UNIF',0,zhook_handle)
53 SELECT CASE(hsurf)
54 !
55 !* 3.0 Orography
56 !
57  CASE('ZS ')
58  ALLOCATE(pfield(1,1))
59  pfield = 0.
60 !
61 !* 3.1 Lake temperature
62 !
63  CASE('TSWATER')
64  ALLOCATE(pfield(1,1))
65  pfield = xts_water_unif
66 !
67 END SELECT
68 !
69 !* 4. Interpolation method
70 ! --------------------
71 !
72  cinterp_type='UNIF '
73 IF (lhook) CALL dr_hook('PREP_WATFLUX_UNIF',1,zhook_handle)
74 !
75 !
76 !-------------------------------------------------------------------------------------
77 END SUBROUTINE prep_watflux_unif
subroutine prep_watflux_unif(KLUOUT, HSURF, PFIELD)