SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
vegtype_to_patch.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  FUNCTION vegtype_to_patch(IVEGTYPE,INPATCH ) RESULT(IPATCH_NB)
7 ! ####################################################
8 !!
9 !! PURPOSE
10 !! -------
11 !
12 ! Calculation of patch indices coresponding to different vegtype
13 ! according to the number of patch (NPATCH).
14 !
15 !!** METHOD
16 !! ------
17 !!
18 !! EXTERNAL
19 !! --------
20 !! none
21 !!
22 !! IMPLICIT ARGUMENTS
23 !! ------------------
24 !!
25 !! none
26 !!
27 !! REFERENCE
28 !! ---------
29 !!
30 !!
31 !! AUTHOR
32 !! ------
33 ! F.Solmon/V.Masson 06/00
34 !
35 !! MODIFICATIONS
36 !! -------------
37 ! R. Alkama 05/2012 : new vegtypes (19 rather than 12)
38 !-------------------------------------------------------------------------------
39 !
40 !* 0. DECLARATIONS
41 ! ------------
42 !
43 USE modd_data_cover_par, ONLY : nvt_no, nvt_rock, nvt_snow, nvt_tebd, &
44  nvt_bone, nvt_trbe, nvt_c3, nvt_c4, &
45  nvt_irr, nvt_gras, nvt_trog,nvt_park, &
46  nvt_trbd, nvt_tebe, nvt_tene, nvt_bobd, &
47  nvt_bond, nvt_bogr, nvt_shrb
48 !
49 !
50 !
51 USE yomhook ,ONLY : lhook, dr_hook
52 USE parkind1 ,ONLY : jprb
53 !
54 USE modi_abor1_sfx
55 !
56 IMPLICIT NONE
57 !
58 !* 0.1 declarations of arguments
59 !
60 INTEGER, INTENT(IN) :: ivegtype !indices of vegetation type
61 INTEGER, INTENT(IN) :: inpatch !total number of PATCHES used
62 INTEGER :: ipatch_nb! PATCH index corresponding to the vegtype IVEGTYPE
63 REAL(KIND=JPRB) :: zhook_handle
64 !
65 !* 0.2 declarations of local variables
66 !
67 !-----------------------------------------------------------------
68 
69 IF (lhook) CALL dr_hook('VEGTYPE_TO_PATCH',0,zhook_handle)
70 IF (inpatch==1) THEN
71 ipatch_nb = 1 ! default case
72 END IF
73 
74 !forest
75 IF (inpatch==2) THEN
76  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
77  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb .OR. ivegtype== nvt_bone .OR. &
78  ivegtype== nvt_tene .OR. ivegtype== nvt_bond .OR. ivegtype== nvt_trbe) THEN
79  ipatch_nb=2
80  ELSE
81  ipatch_nb=1
82  END IF
83 END IF
84 
85 !forest + low vegeation differenciation
86 IF (inpatch==3) THEN
87  IF (ivegtype== nvt_no .OR. ivegtype== nvt_rock .OR. ivegtype== nvt_snow ) ipatch_nb= 1
88  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
89  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb .OR. ivegtype== nvt_bone .OR. &
90  ivegtype== nvt_tene .OR. ivegtype== nvt_bond .OR. ivegtype== nvt_trbe) &
91  ipatch_nb=2
92  IF (ivegtype== nvt_gras .OR. ivegtype== nvt_bogr .OR. ivegtype== nvt_trog .OR. &
93  ivegtype== nvt_park .OR. ivegtype== nvt_c3 .OR. ivegtype== nvt_c4 .OR. &
94  ivegtype== nvt_irr ) ipatch_nb=3
95 END IF
96 !
97 !differenciation between irrigated crops and grassland and other low vegetation
98 IF (inpatch==4) THEN
99  IF (ivegtype== nvt_no .OR. ivegtype== nvt_rock .OR. ivegtype== nvt_snow ) ipatch_nb= 1
100  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
101  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb .OR. ivegtype== nvt_bone .OR. &
102  ivegtype== nvt_tene .OR. ivegtype== nvt_bond .OR. ivegtype== nvt_trbe) &
103  ipatch_nb=2
104  IF (ivegtype== nvt_gras .OR. ivegtype== nvt_bogr .OR. ivegtype== nvt_trog .OR. &
105  ivegtype== nvt_c3 .OR. ivegtype== nvt_c4 ) ipatch_nb=3
106  IF (ivegtype == nvt_irr .OR. ivegtype == nvt_park) ipatch_nb=4
107 END IF
108 !
109 !differenciation between crops and other low vegetation
110 IF (inpatch==5) THEN
111  IF (ivegtype== nvt_no .OR. ivegtype== nvt_rock .OR. ivegtype== nvt_snow ) &
112  ipatch_nb= 1
113  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
114  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb .OR. ivegtype== nvt_bone .OR. &
115  ivegtype== nvt_tene .OR. ivegtype== nvt_bond .OR. ivegtype== nvt_trbe) &
116  ipatch_nb=2
117  IF (ivegtype == nvt_c3 .OR. ivegtype== nvt_c4 ) ipatch_nb=3
118  IF (ivegtype == nvt_irr .OR. ivegtype == nvt_park) ipatch_nb=4
119  IF (ivegtype == nvt_gras .OR. ivegtype== nvt_bogr .OR. ivegtype== nvt_trog ) &
120  ipatch_nb=5
121 END IF
122 !
123 !differenciation between irrigated crops and gardens
124 IF (inpatch==6) THEN
125  IF (ivegtype== nvt_no .OR. ivegtype== nvt_rock .OR. ivegtype== nvt_snow ) ipatch_nb= 1
126  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
127  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb .OR. ivegtype== nvt_bone .OR. &
128  ivegtype== nvt_tene .OR. ivegtype== nvt_bond .OR. ivegtype== nvt_trbe) &
129  ipatch_nb=2
130  IF (ivegtype == nvt_c3 .OR. ivegtype== nvt_c4 ) ipatch_nb=3
131  IF (ivegtype == nvt_irr ) ipatch_nb=4
132  IF (ivegtype == nvt_gras .OR. ivegtype== nvt_bogr .OR. ivegtype== nvt_trog) ipatch_nb=5
133  IF (ivegtype == nvt_park) ipatch_nb=6
134 END IF
135 !
136 !differenciation between snow and other bare soils
137 IF (inpatch==7) THEN
138  IF (ivegtype == nvt_no .OR. ivegtype== nvt_rock ) ipatch_nb= 1
139  IF (ivegtype == nvt_snow) ipatch_nb=2
140  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
141  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb .OR. ivegtype== nvt_bone .OR. &
142  ivegtype== nvt_tene .OR. ivegtype== nvt_bond .OR. ivegtype== nvt_trbe) &
143  ipatch_nb=3
144  IF (ivegtype == nvt_c3 .OR. ivegtype== nvt_c4 ) ipatch_nb=4
145  IF (ivegtype == nvt_irr ) ipatch_nb=5
146  IF (ivegtype == nvt_gras .OR. ivegtype== nvt_bogr .OR. ivegtype== nvt_trog) ipatch_nb=6
147  IF (ivegtype == nvt_park) ipatch_nb=7
148 END IF
149 !
150 !differenciation between C3 and C4 crops
151 IF (inpatch==8) THEN
152  IF (ivegtype == nvt_no .OR. ivegtype== nvt_rock ) ipatch_nb= 1
153  IF (ivegtype == nvt_snow) ipatch_nb=2
154  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
155  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb .OR. ivegtype== nvt_bone .OR. &
156  ivegtype== nvt_tene .OR. ivegtype== nvt_bond .OR. ivegtype== nvt_trbe) &
157  ipatch_nb=3
158  IF (ivegtype == nvt_c3 ) ipatch_nb=4
159  IF (ivegtype == nvt_c4 ) ipatch_nb=5
160  IF (ivegtype == nvt_irr ) ipatch_nb=6
161  IF (ivegtype == nvt_gras .OR. ivegtype== nvt_bogr .OR. ivegtype== nvt_trog) ipatch_nb=7
162  IF (ivegtype == nvt_park) ipatch_nb=8
163 END IF
164 
165 !
166 !differenciation between coniferous and broadleaf forests
167 IF (inpatch==9) THEN
168  IF (ivegtype == nvt_no .OR. ivegtype== nvt_rock ) ipatch_nb= 1
169  IF (ivegtype == nvt_snow) ipatch_nb=2
170  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
171  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb .OR. ivegtype== nvt_trbe )ipatch_nb=3
172  IF (ivegtype== nvt_bone .OR. ivegtype== nvt_tene .OR. ivegtype== nvt_bond) ipatch_nb=4
173  IF (ivegtype == nvt_c3 ) ipatch_nb=5
174  IF (ivegtype == nvt_c4 ) ipatch_nb=6
175  IF (ivegtype == nvt_irr ) ipatch_nb=7
176  IF (ivegtype == nvt_gras .OR. ivegtype== nvt_bogr .OR. ivegtype== nvt_trog) ipatch_nb=8
177  IF (ivegtype == nvt_park) ipatch_nb=9
178 END IF
179 
180 !
181 !differenciation between evergreen and deciduous broadleaf forests
182 IF (inpatch==10) THEN
183  IF (ivegtype == nvt_no .OR. ivegtype== nvt_rock ) ipatch_nb= 1
184  IF (ivegtype == nvt_snow) ipatch_nb=2
185  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
186  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb) ipatch_nb=3
187  IF (ivegtype== nvt_bone .OR. ivegtype== nvt_tene .OR. ivegtype== nvt_bond) ipatch_nb=4
188  IF (ivegtype== nvt_trbe ) ipatch_nb=5
189  IF (ivegtype == nvt_c3 ) ipatch_nb=6
190  IF (ivegtype == nvt_c4 ) ipatch_nb=7
191  IF (ivegtype == nvt_irr ) ipatch_nb=8
192  IF (ivegtype == nvt_gras .OR. ivegtype== nvt_bogr .OR. ivegtype== nvt_trog) ipatch_nb=9
193  IF (ivegtype == nvt_park) ipatch_nb=10
194 END IF
195 
196 !
197 !differenciation between rocks and flat bare soil
198 IF (inpatch==11) THEN
199  IF (ivegtype == nvt_no ) ipatch_nb=1
200  IF (ivegtype == nvt_rock ) ipatch_nb=2
201  IF (ivegtype == nvt_snow ) ipatch_nb=3
202  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
203  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb) ipatch_nb=4
204  IF (ivegtype== nvt_bone .OR. ivegtype== nvt_tene .OR. ivegtype== nvt_bond) ipatch_nb=5
205  IF (ivegtype== nvt_trbe ) ipatch_nb=6
206  IF (ivegtype == nvt_c3 ) ipatch_nb=7
207  IF (ivegtype == nvt_c4 ) ipatch_nb=8
208  IF (ivegtype == nvt_irr ) ipatch_nb=9
209  IF (ivegtype == nvt_gras .OR. ivegtype== nvt_bogr .OR. ivegtype== nvt_trog) ipatch_nb=10
210  IF (ivegtype == nvt_park) ipatch_nb=11
211 END IF
212 !
213 !differenciation between tropical and temperate grasslands
214 IF (inpatch==12) THEN
215  IF (ivegtype == nvt_no ) ipatch_nb=1
216  IF (ivegtype == nvt_rock ) ipatch_nb=2
217  IF (ivegtype == nvt_snow ) ipatch_nb=3
218  IF (ivegtype== nvt_tebd .OR. ivegtype== nvt_trbd .OR. ivegtype== nvt_tebe .OR. &
219  ivegtype== nvt_bobd .OR. ivegtype== nvt_shrb) ipatch_nb=4
220  IF (ivegtype== nvt_bone .OR. ivegtype== nvt_tene .OR. ivegtype== nvt_bond) ipatch_nb=5
221  IF (ivegtype== nvt_trbe ) ipatch_nb=6
222  IF (ivegtype == nvt_c3 ) ipatch_nb=7
223  IF (ivegtype == nvt_c4 ) ipatch_nb=8
224  IF (ivegtype == nvt_irr ) ipatch_nb=9
225  IF (ivegtype == nvt_gras .OR. ivegtype== nvt_bogr) ipatch_nb=10
226  IF (ivegtype == nvt_trog ) ipatch_nb=11
227  IF (ivegtype == nvt_park) ipatch_nb=12
228 END IF
229 !
230 IF (inpatch==19) THEN
231  IF (ivegtype == nvt_no ) ipatch_nb=1
232  IF (ivegtype == nvt_rock ) ipatch_nb=2
233  IF (ivegtype == nvt_snow ) ipatch_nb=3
234  IF (ivegtype == nvt_tebd ) ipatch_nb=4
235  IF (ivegtype == nvt_bone ) ipatch_nb=5
236  IF (ivegtype == nvt_trbe ) ipatch_nb=6
237  IF (ivegtype == nvt_c3 ) ipatch_nb=7
238  IF (ivegtype == nvt_c4 ) ipatch_nb=8
239  IF (ivegtype == nvt_irr ) ipatch_nb=9
240  IF (ivegtype == nvt_gras ) ipatch_nb=10
241  IF (ivegtype == nvt_trog ) ipatch_nb=11
242  IF (ivegtype == nvt_park ) ipatch_nb=12
243  IF (ivegtype == nvt_trbd ) ipatch_nb=13
244  IF (ivegtype == nvt_tebe ) ipatch_nb=14
245  IF (ivegtype == nvt_tene ) ipatch_nb=15
246  IF (ivegtype == nvt_bobd ) ipatch_nb=16
247  IF (ivegtype == nvt_bond ) ipatch_nb=17
248  IF (ivegtype == nvt_bogr ) ipatch_nb=18
249  IF (ivegtype == nvt_shrb ) ipatch_nb=19
250 END IF
251 !
252 IF (inpatch>12.AND.inpatch<19) THEN
253  CALL abor1_sfx('VEGTYPE_TO_PATCH: NPATCH MUST BE INFERIOR OR EQUAL TO 12 OR EQUAL TO 19')
254 END IF
255 IF (inpatch>19) THEN
256  CALL abor1_sfx('VEGTYPE_TO_PATCH: NPATCH BIGGER THAN 19 IS TOO LARGE')
257 END IF
258 IF (lhook) CALL dr_hook('VEGTYPE_TO_PATCH',1,zhook_handle)
259 
260 !
261 END FUNCTION vegtype_to_patch
modd_data_cover_par
Definition: modd_data_cover_par.F90:6
vegtype_to_patch
integer function vegtype_to_patch(IVEGTYPE, INPATCH)
Definition: vegtype_to_patch.F90:6
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
Generated on Fri May 13 2016 09:31:06 for SURFEX by   doxygen 1.8.5