Juan 13/01/2014: add header SURFEX_LIC to all SURFEX files
[MNH-git_open_source-lfs.git] / src / SURFEX / pgd_teb.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE PGD_TEB(HPROGRAM,OECOCLIMAP,OGARDEN)
7 !     ##############################################################
8 !
9 !!**** *PGD_TEB* monitor for averaging and interpolations of TEB physiographic fields
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!    METHOD
15 !!    ------
16 !!   
17 !
18 !!    EXTERNAL
19 !!    --------
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!    AUTHOR
28 !!    ------
29 !!
30 !!    V. Masson        Meteo-France
31 !!
32 !!    MODIFICATION
33 !!    ------------
34 !!
35 !!    Original    10/12/97
36 !!    A. Lemonsu      05/2009         Key for garden option
37 !!    G. Pigeon     /09/12: WALL, ROOF, FLOOR, MASS LAYER default to 5
38 !!
39 !----------------------------------------------------------------------------
40 !
41 !*    0.     DECLARATION
42 !            -----------
43 !
44 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
45 USE MODD_TEB_n,          ONLY : XCOVER, LCOVER, XZS,                   &
46                                 NROAD_LAYER, NWALL_LAYER, NROOF_LAYER, &
47                                 LECOCLIMAP, LGARDEN, NTEB_PATCH,       &
48                                 CBLD_ATYPE, CBEM, LGREENROOF, LHYDRO 
49 USE MODD_BEM_n,          ONLY : NFLOOR_LAYER, CCOOL_COIL, CHEAT_COIL, LAUTOSIZE
50 USE MODD_TEB_GRID_n,     ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE, NDIM
51 !
52 USE MODI_GET_SURF_SIZE_n
53 USE MODI_PACK_PGD
54 USE MODI_PGD_TEB_PAR
55 USE MODI_PGD_TEB_VEG
56 USE MODI_GET_LUOUT
57 USE MODI_READ_NAM_PGD_TEB
58 USE MODI_TEST_NAM_VAR_SURF
59 USE MODI_PGD_BEM_PAR
60 USE MODI_ABOR1_SFX
61 !
62 !
63 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
64 USE PARKIND1  ,ONLY : JPRB
65 !
66 USE MODI_WRITE_COVER_TEX_TEB
67 !
68 IMPLICIT NONE
69 !
70 !*    0.1    Declaration of arguments
71 !            ------------------------
72 !
73  CHARACTER(LEN=6), INTENT(IN)  :: HPROGRAM   ! Type of program
74 LOGICAL,          INTENT(IN)  :: OECOCLIMAP ! T if parameters are computed with ecoclimap
75 !                                           ! F if all parameters must be specified
76 LOGICAL,          INTENT(IN)  :: OGARDEN    ! T if urban green areas
77 !
78 !
79 !*    0.2    Declaration of local variables
80 !            ------------------------------
81 !
82 INTEGER         :: ILUOUT    ! output listing logical unit
83 REAL(KIND=JPRB) :: ZHOOK_HANDLE
84 !
85 !-------------------------------------------------------------------------------
86 !
87 !*    1.      Initializations of defaults
88 !             ---------------------------
89 !
90 IF (LHOOK) CALL DR_HOOK('PGD_TEB',0,ZHOOK_HANDLE)
91  CALL GET_LUOUT(HPROGRAM,ILUOUT)
92
93 NROOF_LAYER  = 5
94 NROAD_LAYER  = 5
95 NWALL_LAYER  = 5
96 NFLOOR_LAYER = 5
97 !
98 !-------------------------------------------------------------------------------
99 !
100 !*    2.      Reading of namelist
101 !             -------------------
102 !
103  CALL READ_NAM_PGD_TEB(HPROGRAM,NTEB_PATCH,CBEM,CCOOL_COIL,CHEAT_COIL,LAUTOSIZE,&
104                       NROAD_LAYER,NROOF_LAYER,NWALL_LAYER,NFLOOR_LAYER,        &
105                       LGREENROOF,LHYDRO                                        )
106 !
107 !-------------------------------------------------------------------------------
108 !
109 !*    3.      Coherence of options
110 !             --------------------
111 !
112  CALL TEST_NAM_VAR_SURF(ILUOUT,'CBLD',CBEM,'DEF','BEM ')
113  CALL TEST_NAM_VAR_SURF(ILUOUT,'CCOOL_COIL',CCOOL_COIL,'IDEAL ','DXCOIL')
114  CALL TEST_NAM_VAR_SURF(ILUOUT,'CHEAT_COIL',CHEAT_COIL,'IDEAL ','FINCAP')
115 !
116 IF (.NOT. OGARDEN) THEN
117   IF (LGREENROOF) CALL ABOR1_SFX('ERROR: You cannot activate LGREENROOF if LGARDEN is FALSE')
118   IF (LHYDRO    ) CALL ABOR1_SFX('ERROR: You cannot activate LHYDRO     if LGARDEN is FALSE')
119 ENDIF
120 !
121 !-------------------------------------------------------------------------------
122 !
123 !*    4.      Number of points and packing
124 !             ----------------------------
125 !
126  CALL GET_SURF_SIZE_n('TOWN  ',NDIM)
127 !
128 ALLOCATE(LCOVER     (JPCOVER))
129 ALLOCATE(XCOVER     (NDIM,JPCOVER))
130 ALLOCATE(XZS        (NDIM))
131 ALLOCATE(XLAT       (NDIM))
132 ALLOCATE(XLON       (NDIM))
133 ALLOCATE(XMESH_SIZE (NDIM))
134 !
135  CALL PACK_PGD(HPROGRAM, 'TOWN  ',                    &
136                 CGRID,  XGRID_PAR,                   &
137                 LCOVER, XCOVER, XZS,                 &
138                 XLAT, XLON, XMESH_SIZE               )  
139 !
140 !-------------------------------------------------------------------------------
141 !
142 !*    5.      TEB specific fields
143 !             -------------------
144 !
145 LECOCLIMAP = OECOCLIMAP
146  CALL PGD_TEB_PAR(HPROGRAM,OGARDEN,LGREENROOF,CBLD_ATYPE)
147 !
148 !-------------------------------------------------------------------------------
149 !
150 !*    6.      Prints of cover parameters in a tex file
151 !             ----------------------------------------
152 !
153 IF (OECOCLIMAP) CALL WRITE_COVER_TEX_TEB
154 !
155 !
156 !-------------------------------------------------------------------------------
157 !
158 !*    7.      Case of urban green areas (and hydrology)
159 !             -----------------------------------------
160 !
161 LGARDEN       = OGARDEN
162 !
163 IF (LGARDEN) CALL PGD_TEB_VEG(HPROGRAM)
164 !
165 !-------------------------------------------------------------------------------
166 !
167 !*    8.      Case of Building Energy Model
168 !             -----------------------------
169 !
170 IF (CBEM .EQ. 'BEM') CALL PGD_BEM_PAR(HPROGRAM,LAUTOSIZE)
171 !
172 IF (LHOOK) CALL DR_HOOK('PGD_TEB',1,ZHOOK_HANDLE)
173 !
174 !-------------------------------------------------------------------------------
175 !
176 END SUBROUTINE PGD_TEB