5831db9b542a22aac227fc70b27966997f315599
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_pgd_tebn.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 WRITESURF_PGD_TEB_n(HPROGRAM)
7 !     ###############################################
8 !
9 !!****  *WRITE_PGD_TEB_n* - writes TEB fields
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!**  METHOD
15 !!    ------
16 !!
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!      V. Masson   *Meteo France*      
31 !!
32 !!    MODIFICATIONS
33 !!    -------------
34 !!      Original    01/2003 
35 !!      B. Decharme 07/2011 : delete argument HWRITE
36 !!      M. Moge     02/2015 parallelization using WRITE_LCOVER
37 !-------------------------------------------------------------------------------
38 !
39 !*       0.    DECLARATIONS
40 !              ------------
41 !
42 !
43 USE MODD_TEB_n,          ONLY : CBEM, NROOF_LAYER, NROAD_LAYER, NWALL_LAYER, &
44                                 XZS, XCOVER, LCOVER, LECOCLIMAP, LGARDEN,    &
45                                 LGREENROOF, LHYDRO,                          &
46                                 NTEB_PATCH, CBLD_ATYPE
47 USE MODD_BEM_n,          ONLY : NFLOOR_LAYER, CCOOL_COIL, CHEAT_COIL, LAUTOSIZE
48 USE MODD_TEB_GRID_n,     ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
49 USE MODD_TEB_VEG_n,      ONLY : CISBA, CPEDOTF, CPHOTO, LTR_ML
50 !
51 USE MODI_WRITE_SURF
52 USE MODI_WRITE_GRID
53 !
54 USE MODI_WRITE_LCOVER
55 !
56 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
57 USE PARKIND1  ,ONLY : JPRB
58 !
59 USE MODI_WRITESURF_PGD_TEB_PAR_n
60 USE MODI_WRITESURF_PGD_TEB_VEG_n
61 USE MODI_WRITESURF_PGD_TEB_GREENROOF_n
62 !
63 IMPLICIT NONE
64 !
65 !*       0.1   Declarations of arguments
66 !              -------------------------
67 !
68  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
69 !
70 !*       0.2   Declarations of local variables
71 !              -------------------------------
72 !
73 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
74  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
75  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
76 !
77 REAL(KIND=JPRB) :: ZHOOK_HANDLE
78 !
79 !-------------------------------------------------------------------------------
80 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_TEB_N',0,ZHOOK_HANDLE)
81 !
82 !*       1.     Dimension initializations:
83 !               -------------------------
84 !
85 !
86 !* number of TEB patches
87 !
88 YRECFM='TEB_PATCH'
89 YCOMMENT=YRECFM
90  CALL WRITE_SURF(HPROGRAM,YRECFM,NTEB_PATCH,IRESP,HCOMMENT=YCOMMENT)
91 !
92 !
93 !* number of roof layers
94 !
95 YRECFM='ROOF_LAYER'
96 YCOMMENT=YRECFM
97  CALL WRITE_SURF(HPROGRAM,YRECFM,NROOF_LAYER,IRESP,HCOMMENT=YCOMMENT)
98 !
99 !* number of road layers
100 !
101 YRECFM='ROAD_LAYER'
102 YCOMMENT=YRECFM
103  CALL WRITE_SURF(HPROGRAM,YRECFM,NROAD_LAYER,IRESP,HCOMMENT=YCOMMENT)
104 !
105 !* number of wall layers
106 !
107 YRECFM='WALL_LAYER'
108 YCOMMENT=YRECFM
109  CALL WRITE_SURF(HPROGRAM,YRECFM,NWALL_LAYER,IRESP,HCOMMENT=YCOMMENT)
110 !
111 !* flag indicating if fields are computed from ecoclimap or not
112 !
113 YRECFM='ECOCLIMAP'
114 YCOMMENT=YRECFM
115  CALL WRITE_SURF(HPROGRAM,YRECFM,LECOCLIMAP,IRESP,HCOMMENT=YCOMMENT)
116 !
117 !
118 !* Type of Building Energy Model
119 !
120 YRECFM='BEM'
121 YCOMMENT=YRECFM
122  CALL WRITE_SURF(HPROGRAM,YRECFM,CBEM,IRESP,HCOMMENT=YCOMMENT) 
123 !
124 IF (CBEM=='BEM') THEN
125   YRECFM='COOL_COIL'
126   YCOMMENT=YRECFM
127   CALL WRITE_SURF(HPROGRAM,YRECFM,CCOOL_COIL,IRESP,HCOMMENT=YCOMMENT)
128   !
129   YRECFM='HEAT_COIL'
130   YCOMMENT=YRECFM
131   CALL WRITE_SURF(HPROGRAM,YRECFM,CHEAT_COIL,IRESP,HCOMMENT=YCOMMENT)
132   !
133   YRECFM='AUTOSIZE'
134   YCOMMENT=YRECFM
135   CALL WRITE_SURF(HPROGRAM,YRECFM,LAUTOSIZE,IRESP,HCOMMENT=YCOMMENT)
136 END IF
137 !
138 !* Type of averaging of buildings characteristics
139 !
140 YRECFM='BLD_ATYPE'
141 YCOMMENT=YRECFM
142  CALL WRITE_SURF(HPROGRAM,YRECFM,CBLD_ATYPE,IRESP,HCOMMENT=YCOMMENT)
143 !
144 !
145 !
146 !* number of floor layers
147 !
148 IF (CBEM=="BEM") THEN
149   YRECFM='FLOOR_LAYER'
150   YCOMMENT=YRECFM
151   CALL WRITE_SURF(HPROGRAM,YRECFM,NFLOOR_LAYER,IRESP,HCOMMENT=YCOMMENT)
152 ENDIF
153 !
154 !------------------------------------------------------------------------------
155 !
156 ! * ISBA fields for urban green areas
157
158 IF (LGARDEN) THEN
159 !
160 ! * Greenroofs and hydrology (only activated if LGARDEN)
161 !
162 YRECFM='LGREENROOF'
163 YCOMMENT=YRECFM
164  CALL WRITE_SURF(HPROGRAM,YRECFM,LGREENROOF,IRESP,HCOMMENT=YCOMMENT) 
165 !
166 YRECFM='LHYDRO'
167 YCOMMENT=YRECFM
168  CALL WRITE_SURF(HPROGRAM,YRECFM,LHYDRO,IRESP,HCOMMENT=YCOMMENT) 
169 !
170 ! * General ISBA options for urban vegetation
171 !
172 ! * Pedo-transfert function
173 !
174 YRECFM='GD_PEDOTF'
175 YCOMMENT=YRECFM
176  CALL WRITE_SURF(HPROGRAM,YRECFM,CPEDOTF,IRESP,HCOMMENT=YCOMMENT)
177 !
178 ! * type of photosynthesis
179 !
180 YRECFM='GD_PHOTO'
181 YCOMMENT=YRECFM
182  CALL WRITE_SURF(HPROGRAM,YRECFM,CPHOTO,IRESP,HCOMMENT=YCOMMENT)
183 !
184 !* new radiative transfert
185 !
186 YRECFM='GD_TR_ML'
187 YCOMMENT=YRECFM
188  CALL WRITE_SURF(HPROGRAM,YRECFM,LTR_ML,IRESP,HCOMMENT=YCOMMENT)
189 !
190 ! * ISBA fields specific to urban gardens
191 !
192  CALL WRITESURF_PGD_TEB_VEG_n(HPROGRAM)
193 !
194 ! * ISBA fields specific to urban greenroofs
195 !
196 IF (LGREENROOF) CALL WRITESURF_PGD_TEB_GREENROOF_n(HPROGRAM)
197 !
198 ENDIF
199 !
200 !------------------------------------------------------------------------------
201 !
202 !*       2.     Physiographic data fields:
203 !               -------------------------
204 !
205 !* cover classes
206 !
207 CALL WRITE_LCOVER(HPROGRAM,LCOVER)
208 !
209 YCOMMENT='COVER FIELDS'
210  CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
211 !
212 !* orography
213 !
214 YRECFM='ZS'
215 YCOMMENT='ZS'
216  CALL WRITE_SURF(HPROGRAM,YRECFM,XZS(:),IRESP,HCOMMENT=YCOMMENT)
217 !
218 !* latitude, longitude
219 !
220  CALL WRITE_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP)
221 !
222 !-------------------------------------------------------------------------------
223  CALL WRITESURF_PGD_TEB_PAR_n(HPROGRAM)
224 !
225 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_TEB_N',1,ZHOOK_HANDLE)
226 !-------------------------------------------------------------------------------
227 !
228 END SUBROUTINE WRITESURF_PGD_TEB_n