SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
init_isba_landuse.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 init_isba_landuse (DTCO, IG, I, UG, U, &
7  hprogram)
8 !#############################################################
9 !
10 !!**** *INIT_ISBA_LANDUSE* - routine to initialize land use for ISBA field
11 !!
12 !! PURPOSE
13 !! -------
14 ! Extrapolation from existing surounding cells with same patch properties:
15 !! (1) IPTS=n interpol field with n pts
16 !! (2) IPTS=0 conserve cells mass
17 !! Case 2 : simple extrapolation based on the inside cell informations.
18 !! this is donne before conserving cell or global mass
19 !!
20 !!
21 !!** METHOD
22 !! ------
23 !!
24 !! EXTERNAL
25 !! --------
26 !!
27 !!
28 !! IMPLICIT ARGUMENTS
29 !! ------------------
30 !!
31 !! REFERENCE
32 !! ---------
33 !!
34 !!
35 !! AUTHOR
36 !! ------
37 !! B. Decharme *Meteo France*
38 !!
39 !! MODIFICATIONS
40 !! -------------
41 !! Original 07/2011
42 !!
43 !-------------------------------------------------------------------------------
44 !
45 !* 0. DECLARATIONS
46 ! ------------
47 !
48 !
49 !
50 !
51 USE modd_data_cover_n, ONLY : data_cover_t
52 USE modd_isba_grid_n, ONLY : isba_grid_t
53 USE modd_isba_n, ONLY : isba_t
54 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
55 USE modd_surf_atm_n, ONLY : surf_atm_t
56 !
57 USE modd_type_snow
58 USE modd_surf_par,ONLY : xundef
59 !
60 USE modi_get_luout
61 USE modi_ini_var_from_patch
62 USE modi_conserv_global_mass
63 !
64 USE yomhook ,ONLY : lhook, dr_hook
65 USE parkind1 ,ONLY : jprb
66 !
67 IMPLICIT NONE
68 !
69 !* 0.1 Declarations of arguments
70 ! -------------------------
71 !
72 !
73 TYPE(data_cover_t), INTENT(INOUT) :: dtco
74 TYPE(isba_grid_t), INTENT(INOUT) :: ig
75 TYPE(isba_t), INTENT(INOUT) :: i
76 TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
77 TYPE(surf_atm_t), INTENT(INOUT) :: u
78 !
79  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! program calling surf. schemes
80 !
81 !
82 !* 0.2 Declarations of local variables
83 ! -------------------------------
84 !
85 REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2),SIZE(I%XDG,3)) :: zzdg ! Actual layer thicknesses
86 REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2),SIZE(I%XDG,3)) :: zzdg_old ! Old layer thicknesses
87 REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2),SIZE(I%XDG,3)) :: zwg_old ! Old XWG
88 REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2),SIZE(I%XDG,3)) :: zwgi_old ! Old XWGI
89 REAL, DIMENSION(SIZE(I%XDG,1),1,SIZE(I%XDG,3)) :: ztest
90 !
91 INTEGER :: iluout
92 INTEGER :: jlayer, jnbiomass, jnlitter, jnlittlevs, jnsoilcarb
93 REAL(KIND=JPRB) :: zhook_handle
94 !
95 !-------------------------------------------------------------------------------
96 !
97 IF (lhook) CALL dr_hook('INIT_ISBA_LANDUSE',0,zhook_handle)
98  CALL get_luout(hprogram,iluout)
99 !
100 !-------------------------------------------------------------------------------
101 !
102 IF(all(i%XDG(:,i%NGROUND_LAYER,:)==i%XDG_OLD(:,i%NGROUND_LAYER,:)))THEN
103  IF (lhook) CALL dr_hook('INIT_ISBA_LANDUSE',1,zhook_handle)
104  RETURN
105 ENDIF
106 !
107 !-------------------------------------------------------------------------------
108 ! Conserve mass in the cell
109 !-------------------------------------------------------------------------------
110 !
111  CALL ini_var_from_patch(dtco, i, ug, u, &
112  hprogram,iluout,'WR ', i%XWR (:,:),0)
113 
114 IF (i%LGLACIER) CALL ini_var_from_patch(dtco, i, ug, u, &
115  hprogram,iluout,'ICE_STO ', i%XICE_STO(:,:),0)
116 !
117 DO jlayer=1,SIZE(i%XTG,2)
118  CALL ini_var_from_patch(dtco, i, ug, u, &
119  hprogram,iluout,'TEMP GRO', i%XTG(:,jlayer,:),0)
120 END DO
121 !
122 !
123  CALL ini_var_from_patch(dtco, i, ug, u, &
124  hprogram,iluout,'ALBSNOW ', i%TSNOW%ALB(:,:),0)
125 !
126 IF (i%TSNOW%SCHEME=='1-L' .OR. i%TSNOW%SCHEME=='3-L' .OR. i%TSNOW%SCHEME=='CRO') THEN
127  CALL ini_var_from_patch(dtco, i, ug, u, &
128  hprogram,iluout,'EMISSNOW', i%TSNOW%EMIS(:,:),0)
129  CALL ini_var_from_patch(dtco, i, ug, u, &
130  hprogram,iluout,'TSSNOW ', i%TSNOW%TS (:,:),0)
131 ENDIF
132 !
133 DO jlayer=1,i%TSNOW%NLAYER
134  !
135  CALL ini_var_from_patch(dtco, i, ug, u, &
136  hprogram,iluout,'WSNOW ', i%TSNOW%WSNOW(:,jlayer,:),0)
137  !
138  IF (i%TSNOW%SCHEME=='3-L' .OR. i%TSNOW%SCHEME=='CRO') THEN
139  CALL ini_var_from_patch(dtco, i, ug, u, &
140  hprogram,iluout,'TEMPSNOW', i%TSNOW%TEMP(:,jlayer,:),0)
141  CALL ini_var_from_patch(dtco, i, ug, u, &
142  hprogram,iluout,'HEATSNOW', i%TSNOW%HEAT(:,jlayer,:),0)
143  CALL ini_var_from_patch(dtco, i, ug, u, &
144  hprogram,iluout,'AGESNOW ', i%TSNOW%AGE (:,jlayer,:),0)
145  ENDIF
146  !
147  IF (i%TSNOW%SCHEME=='1-L') THEN
148  CALL ini_var_from_patch(dtco, i, ug, u, &
149  hprogram,iluout,'TSNOW ', i%TSNOW%T(:,jlayer,:),0)
150  ENDIF
151  !
152  IF(i%TSNOW%SCHEME=='CRO') THEN
153  CALL ini_var_from_patch(dtco, i, ug, u, &
154  hprogram,iluout,'GRANSNOW', i%TSNOW%GRAN1(:,jlayer,:),0)
155  CALL ini_var_from_patch(dtco, i, ug, u, &
156  hprogram,iluout,'GRANSNOW', i%TSNOW%GRAN2(:,jlayer,:),0)
157  CALL ini_var_from_patch(dtco, i, ug, u, &
158  hprogram,iluout,'HISTSNOW', i%TSNOW%HIST (:,jlayer,:),0)
159  ENDIF
160  !
161 ENDDO
162 !
163 !-------------------------------------------------------------------------------
164 ! Conserve mass globaly because soil depth change
165 !-------------------------------------------------------------------------------
166 !
167 zwg_old(:,:,:) =i%XWG (:,:,:)
168 zwgi_old(:,:,:)=i%XWGI(:,:,:)
169 !
170 DO jlayer=1,i%NGROUND_LAYER
171  CALL ini_var_from_patch(dtco, i, ug, u, &
172  hprogram,iluout,'WG ', i%XWG (:,jlayer,:),0)
173  CALL ini_var_from_patch(dtco, i, ug, u, &
174  hprogram,iluout,'WGI ', i%XWGI(:,jlayer,:),0)
175 ENDDO
176 !
177 zzdg(:,1,:)=i%XDG (:,1,:)
178 zzdg_old(:,1,:)=i%XDG_OLD(:,1,:)
179 IF(i%CISBA=='DIF')THEN
180  DO jlayer=2,i%NGROUND_LAYER
181  zzdg(:,jlayer,:)=i%XDG (:,jlayer,:)-i%XDG (:,jlayer-1,:)
182  zzdg_old(:,jlayer,:)=i%XDG_OLD(:,jlayer,:)-i%XDG_OLD(:,jlayer-1,:)
183  ENDDO
184 ELSE
185  zzdg(:,2,:)=i%XDG (:,2,:)
186  zzdg_old(:,2,:)=i%XDG_OLD(:,2,:)
187  IF(i%CISBA=='3-L' )THEN
188  zzdg(:,3,:)=i%XDG (:,3,:)-i%XDG (:,2,:)
189  zzdg_old(:,3,:)=i%XDG_OLD(:,3,:)-i%XDG_OLD(:,2,:)
190  ENDIF
191 ENDIF
192 !
193 WHERE(zzdg(:,:,:) >1.e+10)zzdg(:,:,:)=0.
194 WHERE(zzdg_old(:,:,:)>1.e+10)zzdg_old(:,:,:)=0.
195 !
196  CALL conserv_global_mass(dtco, ig, i, u, &
197  iluout,zzdg,zzdg_old,i%XWG, zwg_old )
198  CALL conserv_global_mass(dtco, ig, i, u, &
199  iluout,zzdg,zzdg_old,i%XWGI,zwgi_old)
200 !
201 !-------------------------------------------------------------------------------
202 ! Extrapolation with 3 pts
203 !-------------------------------------------------------------------------------
204 !
205  CALL ini_var_from_patch(dtco, i, ug, u, &
206  hprogram,iluout,'RESA ', i%XRESA(:,:),3)
207 !
208 DO jlayer=1,i%TSNOW%NLAYER
209  CALL ini_var_from_patch(dtco, i, ug, u, &
210  hprogram,iluout,'RHOSNOW ', i%TSNOW%RHO (:,jlayer,:),3)
211 ENDDO
212 !
213 IF (i%CPHOTO/='NON') THEN
214  !
215  CALL ini_var_from_patch(dtco, i, ug, u, &
216  hprogram,iluout,'AN ', i%XAN (:,:),3)
217  CALL ini_var_from_patch(dtco, i, ug, u, &
218  hprogram,iluout,'ANDAY ', i%XANDAY(:,:),3)
219  CALL ini_var_from_patch(dtco, i, ug, u, &
220  hprogram,iluout,'ANFM ', i%XANFM (:,:),3)
221  CALL ini_var_from_patch(dtco, i, ug, u, &
222  hprogram,iluout,'LE ', i%XLE (:,:),3)
223  !
224  DO jnbiomass=1,i%NNBIOMASS
225  CALL ini_var_from_patch(dtco, i, ug, u, &
226  hprogram,iluout,'RESPBIOM', i%XRESP_BIOMASS(:,jnbiomass,:),3)
227  CALL ini_var_from_patch(dtco, i, ug, u, &
228  hprogram,iluout,'BIOMASS ', i%XBIOMASS (:,jnbiomass,:),3)
229  ENDDO
230  !
231  IF (i%CRESPSL=='CNT') THEN
232  !
233  DO jnlittlevs=1,i%NNLITTLEVS
234  CALL ini_var_from_patch(dtco, i, ug, u, &
235  hprogram,iluout,'LIGNINST',i%XLIGNIN_STRUC(:,jnlittlevs,:),3)
236  DO jnlitter=1,i%NNLITTER
237  CALL ini_var_from_patch(dtco, i, ug, u, &
238  hprogram,iluout,'LITTER ',i%XLITTER(:,jnlitter,jnlittlevs,:),3)
239  ENDDO
240  ENDDO
241  !
242  DO jnsoilcarb=1,i%NNSOILCARB
243  CALL ini_var_from_patch(dtco, i, ug, u, &
244  hprogram,iluout,'SOILCARB',i%XSOILCARB(:,jnsoilcarb,:),3)
245  ENDDO
246  !
247  ENDIF
248  !
249 ENDIF
250 !
251 !-------------------------------------------------------------------------------
252 !
253 IF (lhook) CALL dr_hook('INIT_ISBA_LANDUSE',1,zhook_handle)
254 !
255 END SUBROUTINE init_isba_landuse
modd_surf_atm_n::surf_atm_t
Definition: modd_surf_atmn.F90:42
modd_isba_n
Definition: modd_isban.F90:6
modd_surf_atm_grid_n
Definition: modd_surf_atm_gridn.F90:6
modd_type_snow
Definition: modd_type_snow.F90:6
init_isba_landuse
subroutine init_isba_landuse(DTCO, IG, I, UG, U, HPROGRAM)
Definition: init_isba_landuse.F90:6
modd_data_cover_n
Definition: modd_data_covern.F90:6
conserv_global_mass
subroutine conserv_global_mass(DTCO, IG, I, U, ILUOUT, PZDG, PZDG_OLD, PFIELD, PFIELD_OLD)
Definition: conserv_global_mass.F90:5
modd_surf_atm_grid_n::surf_atm_grid_t
Definition: modd_surf_atm_gridn.F90:39
get_luout
subroutine get_luout(HPROGRAM, KLUOUT)
Definition: get_luout.F90:6
ini_var_from_patch
subroutine ini_var_from_patch(DTCO, I, UG, U, HPROGRAM, KLUOUT, HNAME, PFIELD, KPTS, PDEF)
Definition: ini_var_from_patch.F90:5
modd_data_cover_n::data_cover_t
Definition: modd_data_covern.F90:43
modd_surf_par
Definition: modd_surf_par.F90:6
modd_isba_grid_n
Definition: modd_isba_gridn.F90:6
modd_surf_atm_n
Definition: modd_surf_atmn.F90:6
Generated on Fri May 13 2016 09:31:04 for SURFEX by   doxygen 1.8.5