Line |
Branch |
Exec |
Source |
1 |
|
|
! |
2 |
|
|
MODULE surf_land_orchidee_mod |
3 |
|
|
! |
4 |
|
|
! This module controles the interface towards the model ORCHIDEE. |
5 |
|
|
! |
6 |
|
|
! Compatibility with ORCHIDIEE : |
7 |
|
|
! The current version can be used with ORCHIDEE/trunk from revision 4465. |
8 |
|
|
! This interface is used if none of the cpp keys ORCHIDEE_NOOPENMP, |
9 |
|
|
! ORCHIDEE_NOZ0H or ORCHIDEE_NOFREIN is set. |
10 |
|
|
! |
11 |
|
|
! Subroutines in this module : surf_land_orchidee |
12 |
|
|
! Init_orchidee_index |
13 |
|
|
! Get_orchidee_communicator |
14 |
|
|
! Init_neighbours |
15 |
|
|
|
16 |
|
|
USE dimphy |
17 |
|
|
USE cpl_mod, ONLY : cpl_send_land_fields |
18 |
|
|
USE surface_data, ONLY : type_ocean |
19 |
|
|
USE geometry_mod, ONLY : dx, dy, boundslon, boundslat,longitude, latitude, cell_area, ind_cell_glo |
20 |
|
|
USE mod_grid_phy_lmdz |
21 |
|
|
USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master |
22 |
|
|
USE carbon_cycle_mod, ONLY : nbcf_in_orc, nbcf_out, fields_in, yfields_in, yfields_out, cfname_in, cfname_out |
23 |
|
|
USE nrtype, ONLY : PI |
24 |
|
|
|
25 |
|
|
IMPLICIT NONE |
26 |
|
|
|
27 |
|
|
PRIVATE |
28 |
|
|
PUBLIC :: surf_land_orchidee |
29 |
|
|
|
30 |
|
|
CONTAINS |
31 |
|
|
! |
32 |
|
|
!**************************************************************************************** |
33 |
|
|
! |
34 |
|
✗ |
SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, & |
35 |
|
✗ |
knindex, rlon, rlat, yrmu0, pctsrf, & |
36 |
|
|
debut, lafin, & |
37 |
|
|
plev, u1_lay, v1_lay, gustiness, temp_air, spechum, epot_air, ccanopy, & |
38 |
|
|
tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, & |
39 |
|
|
precip_rain, precip_snow, lwdown, swnet, swdown, & |
40 |
|
|
ps, q2m, t2m, & |
41 |
|
|
evap, fluxsens, fluxlat, & |
42 |
|
|
tsol_rad, tsurf_new, alb1_new, alb2_new, & |
43 |
|
|
emis_new, z0m_new, z0h_new, qsurf, & |
44 |
|
|
veget, lai, height ) |
45 |
|
|
|
46 |
|
|
USE mod_surf_para |
47 |
|
|
USE mod_synchro_omp |
48 |
|
|
USE carbon_cycle_mod |
49 |
|
|
USE indice_sol_mod |
50 |
|
|
USE print_control_mod, ONLY: lunout |
51 |
|
|
USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat |
52 |
|
|
! |
53 |
|
|
! Cette routine sert d'interface entre le modele atmospherique et le |
54 |
|
|
! modele de sol continental. Appel a sechiba |
55 |
|
|
! |
56 |
|
|
! L. Fairhead 02/2000 |
57 |
|
|
! |
58 |
|
|
! input: |
59 |
|
|
! itime numero du pas de temps |
60 |
|
|
! dtime pas de temps de la physique (en s) |
61 |
|
|
! nisurf index de la surface a traiter (1 = sol continental) |
62 |
|
|
! knon nombre de points de la surface a traiter |
63 |
|
|
! knindex index des points de la surface a traiter |
64 |
|
|
! rlon longitudes de la grille entiere |
65 |
|
|
! rlat latitudes de la grille entiere |
66 |
|
|
! pctsrf tableau des fractions de surface de chaque maille |
67 |
|
|
! debut logical: 1er appel a la physique (lire les restart) |
68 |
|
|
! lafin logical: dernier appel a la physique (ecrire les restart) |
69 |
|
|
! (si false calcul simplifie des fluxs sur les continents) |
70 |
|
|
! plev hauteur de la premiere couche (Pa) |
71 |
|
|
! u1_lay vitesse u 1ere couche |
72 |
|
|
! v1_lay vitesse v 1ere couche |
73 |
|
|
! temp_air temperature de l'air 1ere couche |
74 |
|
|
! spechum humidite specifique 1ere couche |
75 |
|
|
! epot_air temp pot de l'air |
76 |
|
|
! ccanopy concentration CO2 canopee, correspond au co2_send de |
77 |
|
|
! carbon_cycle_mod ou valeur constant co2_ppm |
78 |
|
|
! tq_cdrag cdrag |
79 |
|
|
! petAcoef coeff. A de la resolution de la CL pour t |
80 |
|
|
! peqAcoef coeff. A de la resolution de la CL pour q |
81 |
|
|
! petBcoef coeff. B de la resolution de la CL pour t |
82 |
|
|
! peqBcoef coeff. B de la resolution de la CL pour q |
83 |
|
|
! precip_rain precipitation liquide |
84 |
|
|
! precip_snow precipitation solide |
85 |
|
|
! lwdown flux IR descendant a la surface |
86 |
|
|
! swnet flux solaire net |
87 |
|
|
! swdown flux solaire entrant a la surface |
88 |
|
|
! ps pression au sol |
89 |
|
|
! radsol rayonnement net aus sol (LW + SW) |
90 |
|
|
! |
91 |
|
|
! output: |
92 |
|
|
! evap evaporation totale |
93 |
|
|
! fluxsens flux de chaleur sensible |
94 |
|
|
! fluxlat flux de chaleur latente |
95 |
|
|
! tsol_rad |
96 |
|
|
! tsurf_new temperature au sol |
97 |
|
|
! alb1_new albedo in visible SW interval |
98 |
|
|
! alb2_new albedo in near IR interval |
99 |
|
|
! emis_new emissivite |
100 |
|
|
! z0m_new surface roughness for momentum |
101 |
|
|
! z0h_new surface roughness for heat |
102 |
|
|
! qsurf air moisture at surface |
103 |
|
|
! |
104 |
|
|
INCLUDE "YOMCST.h" |
105 |
|
|
INCLUDE "dimpft.h" |
106 |
|
|
! |
107 |
|
|
! Parametres d'entree |
108 |
|
|
!**************************************************************************************** |
109 |
|
|
INTEGER, INTENT(IN) :: itime |
110 |
|
|
REAL, INTENT(IN) :: dtime |
111 |
|
|
REAL, INTENT(IN) :: date0 |
112 |
|
|
INTEGER, INTENT(IN) :: knon |
113 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
114 |
|
|
LOGICAL, INTENT(IN) :: debut, lafin |
115 |
|
|
REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf |
116 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat |
117 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: yrmu0 ! cosine of solar zenith angle |
118 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: plev |
119 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay, gustiness |
120 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum |
121 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: epot_air, ccanopy |
122 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag |
123 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef |
124 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef |
125 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow |
126 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: lwdown, swnet, swdown, ps |
127 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: q2m, t2m |
128 |
|
|
|
129 |
|
|
! Parametres de sortie |
130 |
|
|
!**************************************************************************************** |
131 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat, qsurf |
132 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: tsol_rad, tsurf_new |
133 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new |
134 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: emis_new, z0m_new, z0h_new |
135 |
|
|
REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget |
136 |
|
|
REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: lai |
137 |
|
|
REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height |
138 |
|
|
|
139 |
|
|
! Local |
140 |
|
|
!**************************************************************************************** |
141 |
|
|
INTEGER :: ij, jj, igrid, ireal, index, nb |
142 |
|
|
INTEGER :: error |
143 |
|
✗ |
REAL, DIMENSION(klon) :: swdown_vrai |
144 |
|
|
CHARACTER (len = 20) :: modname = 'surf_land_orchidee' |
145 |
|
|
CHARACTER (len = 80) :: abort_message |
146 |
|
|
LOGICAL,SAVE :: check = .FALSE. |
147 |
|
|
!$OMP THREADPRIVATE(check) |
148 |
|
|
|
149 |
|
|
! type de couplage dans sechiba |
150 |
|
|
! character (len=10) :: coupling = 'implicit' |
151 |
|
|
! drapeaux controlant les appels dans SECHIBA |
152 |
|
|
! type(control_type), save :: control_in |
153 |
|
|
! Preserved albedo |
154 |
|
|
REAL, ALLOCATABLE, DIMENSION(:), SAVE :: albedo_keep, zlev |
155 |
|
|
!$OMP THREADPRIVATE(albedo_keep,zlev) |
156 |
|
|
! coordonnees geographiques |
157 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo |
158 |
|
|
!$OMP THREADPRIVATE(lalo) |
159 |
|
|
! boundaries of cells |
160 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: bounds_lalo |
161 |
|
|
!$OMP THREADPRIVATE(bounds_lalo) |
162 |
|
|
! pts voisins |
163 |
|
|
INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours |
164 |
|
|
!$OMP THREADPRIVATE(neighbours) |
165 |
|
|
! fractions continents |
166 |
|
|
REAL,ALLOCATABLE, DIMENSION(:), SAVE :: contfrac |
167 |
|
|
!$OMP THREADPRIVATE(contfrac) |
168 |
|
|
! resolution de la grille |
169 |
|
|
REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: resolution |
170 |
|
|
!$OMP THREADPRIVATE(resolution) |
171 |
|
|
|
172 |
|
|
REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: lon_scat, lat_scat |
173 |
|
|
!$OMP THREADPRIVATE(lon_scat,lat_scat) |
174 |
|
|
|
175 |
|
|
! area of cells |
176 |
|
|
REAL, ALLOCATABLE, DIMENSION (:), SAVE :: area |
177 |
|
|
!$OMP THREADPRIVATE(area) |
178 |
|
|
|
179 |
|
|
LOGICAL, SAVE :: lrestart_read = .TRUE. |
180 |
|
|
!$OMP THREADPRIVATE(lrestart_read) |
181 |
|
|
LOGICAL, SAVE :: lrestart_write = .FALSE. |
182 |
|
|
!$OMP THREADPRIVATE(lrestart_write) |
183 |
|
|
|
184 |
|
✗ |
REAL, DIMENSION(knon,2) :: albedo_out |
185 |
|
|
|
186 |
|
|
! Pb de nomenclature |
187 |
|
✗ |
REAL, DIMENSION(klon) :: petA_orc, peqA_orc |
188 |
|
✗ |
REAL, DIMENSION(klon) :: petB_orc, peqB_orc |
189 |
|
|
! Pb de correspondances de grilles |
190 |
|
|
INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: ig, jg |
191 |
|
|
!$OMP THREADPRIVATE(ig,jg) |
192 |
|
|
INTEGER :: indi, indj |
193 |
|
|
INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex |
194 |
|
|
!$OMP THREADPRIVATE(ktindex) |
195 |
|
|
|
196 |
|
|
! Essai cdrag |
197 |
|
✗ |
REAL, DIMENSION(klon) :: cdrag |
198 |
|
|
INTEGER,SAVE :: offset |
199 |
|
|
!$OMP THREADPRIVATE(offset) |
200 |
|
|
|
201 |
|
✗ |
REAL, DIMENSION(klon_glo) :: rlon_g,rlat_g |
202 |
|
|
INTEGER, SAVE :: orch_comm |
203 |
|
|
!$OMP THREADPRIVATE(orch_comm) |
204 |
|
|
|
205 |
|
|
REAL, ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow |
206 |
|
|
!$OMP THREADPRIVATE(coastalflow) |
207 |
|
|
REAL, ALLOCATABLE, DIMENSION(:), SAVE :: riverflow |
208 |
|
|
!$OMP THREADPRIVATE(riverflow) |
209 |
|
|
|
210 |
|
|
INTEGER :: orch_mpi_rank |
211 |
|
|
INTEGER :: orch_mpi_size |
212 |
|
|
INTEGER :: orch_omp_rank |
213 |
|
|
INTEGER :: orch_omp_size |
214 |
|
|
|
215 |
|
✗ |
REAL, ALLOCATABLE, DIMENSION(:) :: longitude_glo |
216 |
|
✗ |
REAL, ALLOCATABLE, DIMENSION(:) :: latitude_glo |
217 |
|
✗ |
REAL, ALLOCATABLE, DIMENSION(:,:) :: boundslon_glo |
218 |
|
✗ |
REAL, ALLOCATABLE, DIMENSION(:,:) :: boundslat_glo |
219 |
|
✗ |
INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo |
220 |
|
|
INTEGER, ALLOCATABLE, SAVE,DIMENSION(:) :: ind_cell |
221 |
|
|
!$OMP THREADPRIVATE(ind_cell) |
222 |
|
|
INTEGER :: begin, end |
223 |
|
|
! |
224 |
|
|
! Fin definition |
225 |
|
|
!**************************************************************************************** |
226 |
|
|
|
227 |
|
✗ |
IF (check) WRITE(lunout,*)'Entree ', modname |
228 |
|
|
|
229 |
|
|
! Initialisation |
230 |
|
|
|
231 |
|
✗ |
IF (debut) THEN |
232 |
|
|
! Test of coherence between variable ok_veget and cpp key CPP_VEGET |
233 |
|
✗ |
abort_message='Pb de coherence: ok_veget = .true. mais CPP_VEGET = .false.' |
234 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
235 |
|
|
|
236 |
|
✗ |
CALL Init_surf_para(knon) |
237 |
|
✗ |
ALLOCATE(ktindex(knon)) |
238 |
|
✗ |
IF ( .NOT. ALLOCATED(albedo_keep)) THEN |
239 |
|
|
!ym ALLOCATE(albedo_keep(klon)) |
240 |
|
|
!ym bizarre que non allou� en knon precedement |
241 |
|
✗ |
ALLOCATE(albedo_keep(knon)) |
242 |
|
✗ |
ALLOCATE(zlev(knon)) |
243 |
|
|
ENDIF |
244 |
|
|
! Pb de correspondances de grilles |
245 |
|
✗ |
ALLOCATE(ig(klon)) |
246 |
|
✗ |
ALLOCATE(jg(klon)) |
247 |
|
✗ |
ig(1) = 1 |
248 |
|
✗ |
jg(1) = 1 |
249 |
|
|
indi = 0 |
250 |
|
|
indj = 2 |
251 |
|
✗ |
DO igrid = 2, klon - 1 |
252 |
|
✗ |
indi = indi + 1 |
253 |
|
✗ |
IF ( indi > nbp_lon) THEN |
254 |
|
|
indi = 1 |
255 |
|
✗ |
indj = indj + 1 |
256 |
|
|
ENDIF |
257 |
|
✗ |
ig(igrid) = indi |
258 |
|
✗ |
jg(igrid) = indj |
259 |
|
|
ENDDO |
260 |
|
✗ |
ig(klon) = 1 |
261 |
|
✗ |
jg(klon) = nbp_lat |
262 |
|
|
|
263 |
|
✗ |
IF ((.NOT. ALLOCATED(area))) THEN |
264 |
|
✗ |
ALLOCATE(area(knon), stat = error) |
265 |
|
✗ |
IF (error /= 0) THEN |
266 |
|
✗ |
abort_message='Pb allocation area' |
267 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
268 |
|
|
ENDIF |
269 |
|
|
ENDIF |
270 |
|
✗ |
DO igrid = 1, knon |
271 |
|
✗ |
area(igrid) = cell_area(knindex(igrid)) |
272 |
|
|
ENDDO |
273 |
|
|
|
274 |
|
✗ |
IF (grid_type==unstructured) THEN |
275 |
|
|
|
276 |
|
|
|
277 |
|
✗ |
IF ((.NOT. ALLOCATED(lon_scat))) THEN |
278 |
|
✗ |
ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error) |
279 |
|
✗ |
IF (error /= 0) THEN |
280 |
|
✗ |
abort_message='Pb allocation lon_scat' |
281 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
282 |
|
|
ENDIF |
283 |
|
|
ENDIF |
284 |
|
|
|
285 |
|
✗ |
IF ((.NOT. ALLOCATED(lat_scat))) THEN |
286 |
|
✗ |
ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error) |
287 |
|
✗ |
IF (error /= 0) THEN |
288 |
|
✗ |
abort_message='Pb allocation lat_scat' |
289 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
290 |
|
|
ENDIF |
291 |
|
|
ENDIF |
292 |
|
✗ |
CALL Gather(rlon,rlon_g) |
293 |
|
✗ |
CALL Gather(rlat,rlat_g) |
294 |
|
|
|
295 |
|
✗ |
IF (is_mpi_root) THEN |
296 |
|
|
index = 1 |
297 |
|
✗ |
DO jj = 2, nbp_lat-1 |
298 |
|
✗ |
DO ij = 1, nbp_lon |
299 |
|
✗ |
index = index + 1 |
300 |
|
✗ |
lon_scat(ij,jj) = rlon_g(index) |
301 |
|
✗ |
lat_scat(ij,jj) = rlat_g(index) |
302 |
|
|
ENDDO |
303 |
|
|
ENDDO |
304 |
|
✗ |
lon_scat(:,1) = lon_scat(:,2) |
305 |
|
✗ |
lat_scat(:,1) = rlat_g(1) |
306 |
|
✗ |
lon_scat(:,nbp_lat) = lon_scat(:,2) |
307 |
|
✗ |
lat_scat(:,nbp_lat) = rlat_g(klon_glo) |
308 |
|
|
ENDIF |
309 |
|
|
|
310 |
|
✗ |
CALL bcast(lon_scat) |
311 |
|
✗ |
CALL bcast(lat_scat) |
312 |
|
|
|
313 |
|
✗ |
ELSE IF (grid_type==regular_lonlat) THEN |
314 |
|
|
|
315 |
|
✗ |
IF ((.NOT. ALLOCATED(lalo))) THEN |
316 |
|
✗ |
ALLOCATE(lalo(knon,2), stat = error) |
317 |
|
✗ |
IF (error /= 0) THEN |
318 |
|
✗ |
abort_message='Pb allocation lalo' |
319 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
320 |
|
|
ENDIF |
321 |
|
|
ENDIF |
322 |
|
|
|
323 |
|
✗ |
IF ((.NOT. ALLOCATED(bounds_lalo))) THEN |
324 |
|
✗ |
ALLOCATE(bounds_lalo(knon,nvertex,2), stat = error) |
325 |
|
✗ |
IF (error /= 0) THEN |
326 |
|
✗ |
abort_message='Pb allocation lalo' |
327 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
328 |
|
|
ENDIF |
329 |
|
|
ENDIF |
330 |
|
|
|
331 |
|
✗ |
IF ((.NOT. ALLOCATED(lon_scat))) THEN |
332 |
|
✗ |
ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error) |
333 |
|
✗ |
IF (error /= 0) THEN |
334 |
|
✗ |
abort_message='Pb allocation lon_scat' |
335 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
336 |
|
|
ENDIF |
337 |
|
|
ENDIF |
338 |
|
✗ |
IF ((.NOT. ALLOCATED(lat_scat))) THEN |
339 |
|
✗ |
ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error) |
340 |
|
✗ |
IF (error /= 0) THEN |
341 |
|
✗ |
abort_message='Pb allocation lat_scat' |
342 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
343 |
|
|
ENDIF |
344 |
|
|
ENDIF |
345 |
|
✗ |
lon_scat = 0. |
346 |
|
✗ |
lat_scat = 0. |
347 |
|
✗ |
DO igrid = 1, knon |
348 |
|
✗ |
index = knindex(igrid) |
349 |
|
✗ |
lalo(igrid,2) = rlon(index) |
350 |
|
✗ |
lalo(igrid,1) = rlat(index) |
351 |
|
✗ |
bounds_lalo(igrid,:,2)=boundslon(index,:)*180./PI |
352 |
|
✗ |
bounds_lalo(igrid,:,1)=boundslat(index,:)*180./PI |
353 |
|
|
ENDDO |
354 |
|
|
|
355 |
|
|
|
356 |
|
|
|
357 |
|
✗ |
CALL Gather(rlon,rlon_g) |
358 |
|
✗ |
CALL Gather(rlat,rlat_g) |
359 |
|
|
|
360 |
|
✗ |
IF (is_mpi_root) THEN |
361 |
|
|
index = 1 |
362 |
|
✗ |
DO jj = 2, nbp_lat-1 |
363 |
|
✗ |
DO ij = 1, nbp_lon |
364 |
|
✗ |
index = index + 1 |
365 |
|
✗ |
lon_scat(ij,jj) = rlon_g(index) |
366 |
|
✗ |
lat_scat(ij,jj) = rlat_g(index) |
367 |
|
|
ENDDO |
368 |
|
|
ENDDO |
369 |
|
✗ |
lon_scat(:,1) = lon_scat(:,2) |
370 |
|
✗ |
lat_scat(:,1) = rlat_g(1) |
371 |
|
✗ |
lon_scat(:,nbp_lat) = lon_scat(:,2) |
372 |
|
✗ |
lat_scat(:,nbp_lat) = rlat_g(klon_glo) |
373 |
|
|
ENDIF |
374 |
|
|
|
375 |
|
✗ |
CALL bcast(lon_scat) |
376 |
|
✗ |
CALL bcast(lat_scat) |
377 |
|
|
|
378 |
|
|
ENDIF |
379 |
|
|
! |
380 |
|
|
! Allouer et initialiser le tableau des voisins et des fraction de continents |
381 |
|
|
! |
382 |
|
✗ |
IF (( .NOT. ALLOCATED(contfrac))) THEN |
383 |
|
✗ |
ALLOCATE(contfrac(knon), stat = error) |
384 |
|
✗ |
IF (error /= 0) THEN |
385 |
|
✗ |
abort_message='Pb allocation contfrac' |
386 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
387 |
|
|
ENDIF |
388 |
|
|
ENDIF |
389 |
|
|
|
390 |
|
✗ |
DO igrid = 1, knon |
391 |
|
✗ |
ireal = knindex(igrid) |
392 |
|
✗ |
contfrac(igrid) = pctsrf(ireal,is_ter) |
393 |
|
|
ENDDO |
394 |
|
|
|
395 |
|
|
|
396 |
|
✗ |
IF (grid_type==regular_lonlat) THEN |
397 |
|
|
|
398 |
|
✗ |
IF ( (.NOT.ALLOCATED(neighbours))) THEN |
399 |
|
✗ |
ALLOCATE(neighbours(knon,8), stat = error) |
400 |
|
✗ |
IF (error /= 0) THEN |
401 |
|
✗ |
abort_message='Pb allocation neighbours' |
402 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
403 |
|
|
ENDIF |
404 |
|
|
ENDIF |
405 |
|
✗ |
neighbours = -1. |
406 |
|
✗ |
CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter)) |
407 |
|
|
|
408 |
|
✗ |
ELSE IF (grid_type==unstructured) THEN |
409 |
|
|
|
410 |
|
✗ |
IF ( (.NOT.ALLOCATED(neighbours))) THEN |
411 |
|
✗ |
ALLOCATE(neighbours(knon,12), stat = error) |
412 |
|
✗ |
IF (error /= 0) THEN |
413 |
|
✗ |
abort_message='Pb allocation neighbours' |
414 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
415 |
|
|
ENDIF |
416 |
|
|
ENDIF |
417 |
|
✗ |
neighbours = -1. |
418 |
|
|
|
419 |
|
|
ENDIF |
420 |
|
|
|
421 |
|
|
|
422 |
|
|
! |
423 |
|
|
! Allocation et calcul resolutions |
424 |
|
✗ |
IF ( (.NOT.ALLOCATED(resolution))) THEN |
425 |
|
✗ |
ALLOCATE(resolution(knon,2), stat = error) |
426 |
|
✗ |
IF (error /= 0) THEN |
427 |
|
✗ |
abort_message='Pb allocation resolution' |
428 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
429 |
|
|
ENDIF |
430 |
|
|
ENDIF |
431 |
|
|
|
432 |
|
✗ |
IF (grid_type==regular_lonlat) THEN |
433 |
|
✗ |
DO igrid = 1, knon |
434 |
|
✗ |
ij = knindex(igrid) |
435 |
|
✗ |
resolution(igrid,1) = dx(ij) |
436 |
|
✗ |
resolution(igrid,2) = dy(ij) |
437 |
|
|
ENDDO |
438 |
|
|
ENDIF |
439 |
|
|
|
440 |
|
✗ |
ALLOCATE(coastalflow(klon), stat = error) |
441 |
|
✗ |
IF (error /= 0) THEN |
442 |
|
✗ |
abort_message='Pb allocation coastalflow' |
443 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
444 |
|
|
ENDIF |
445 |
|
|
|
446 |
|
✗ |
ALLOCATE(riverflow(klon), stat = error) |
447 |
|
✗ |
IF (error /= 0) THEN |
448 |
|
✗ |
abort_message='Pb allocation riverflow' |
449 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
450 |
|
|
ENDIF |
451 |
|
|
! |
452 |
|
|
! carbon_cycle_cpl not possible with this interface and version of ORHCHIDEE |
453 |
|
|
! |
454 |
|
|
! >> PC |
455 |
|
|
! IF (carbon_cycle_cpl) THEN |
456 |
|
|
! abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE' |
457 |
|
|
! CALL abort_physic(modname,abort_message,1) |
458 |
|
|
! END IF |
459 |
|
|
! << PC |
460 |
|
|
|
461 |
|
|
ENDIF ! (fin debut) |
462 |
|
|
|
463 |
|
|
! |
464 |
|
|
! Appel a la routine sols continentaux |
465 |
|
|
! |
466 |
|
✗ |
IF (lafin) lrestart_write = .TRUE. |
467 |
|
✗ |
IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write |
468 |
|
|
|
469 |
|
✗ |
petA_orc(1:knon) = petBcoef(1:knon) * dtime |
470 |
|
✗ |
petB_orc(1:knon) = petAcoef(1:knon) |
471 |
|
✗ |
peqA_orc(1:knon) = peqBcoef(1:knon) * dtime |
472 |
|
✗ |
peqB_orc(1:knon) = peqAcoef(1:knon) |
473 |
|
|
|
474 |
|
✗ |
cdrag = 0. |
475 |
|
✗ |
cdrag(1:knon) = tq_cdrag(1:knon) |
476 |
|
|
|
477 |
|
|
! zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/287.05*temp_air(1:knon))*9.80665) |
478 |
|
|
! zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/RD*temp_air(1:knon))*RG) |
479 |
|
✗ |
zlev(1:knon) = plev(1:knon)*RD*temp_air(1:knon)/((ps(1:knon)*100.0)*RG) |
480 |
|
|
|
481 |
|
|
|
482 |
|
|
! PF et PASB |
483 |
|
|
! where(cdrag > 0.01) |
484 |
|
|
! cdrag = 0.01 |
485 |
|
|
! endwhere |
486 |
|
|
! write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag) |
487 |
|
|
|
488 |
|
|
|
489 |
|
✗ |
IF (debut) THEN |
490 |
|
✗ |
CALL Init_orchidee_index(knon,knindex,offset,ktindex) |
491 |
|
✗ |
CALL Get_orchidee_communicator(orch_comm,orch_mpi_size,orch_mpi_rank, orch_omp_size,orch_omp_rank) |
492 |
|
|
|
493 |
|
✗ |
IF (grid_type==unstructured) THEN |
494 |
|
✗ |
IF (knon==0) THEN |
495 |
|
|
begin=1 |
496 |
|
|
end=0 |
497 |
|
|
ELSE |
498 |
|
✗ |
begin=offset+1 |
499 |
|
✗ |
end=offset+ktindex(knon) |
500 |
|
|
ENDIF |
501 |
|
|
|
502 |
|
✗ |
IF (orch_mpi_rank==orch_mpi_size-1 .AND. orch_omp_rank==orch_omp_size-1) end=nbp_lon*nbp_lat |
503 |
|
|
|
504 |
|
✗ |
ALLOCATE(lalo(end-begin+1,2)) |
505 |
|
✗ |
ALLOCATE(bounds_lalo(end-begin+1,nvertex,2)) |
506 |
|
✗ |
ALLOCATE(ind_cell(end-begin+1)) |
507 |
|
|
|
508 |
|
✗ |
ALLOCATE(longitude_glo(klon_glo)) |
509 |
|
✗ |
CALL gather(longitude,longitude_glo) |
510 |
|
✗ |
CALL bcast(longitude_glo) |
511 |
|
✗ |
lalo(:,2)=longitude_glo(begin:end)*180./PI |
512 |
|
|
|
513 |
|
✗ |
ALLOCATE(latitude_glo(klon_glo)) |
514 |
|
✗ |
CALL gather(latitude,latitude_glo) |
515 |
|
✗ |
CALL bcast(latitude_glo) |
516 |
|
✗ |
lalo(:,1)=latitude_glo(begin:end)*180./PI |
517 |
|
|
|
518 |
|
✗ |
ALLOCATE(boundslon_glo(klon_glo,nvertex)) |
519 |
|
✗ |
CALL gather(boundslon,boundslon_glo) |
520 |
|
✗ |
CALL bcast(boundslon_glo) |
521 |
|
✗ |
bounds_lalo(:,:,2)=boundslon_glo(begin:end,:)*180./PI |
522 |
|
|
|
523 |
|
✗ |
ALLOCATE(boundslat_glo(klon_glo,nvertex)) |
524 |
|
✗ |
CALL gather(boundslat,boundslat_glo) |
525 |
|
✗ |
CALL bcast(boundslat_glo) |
526 |
|
✗ |
bounds_lalo(:,:,1)=boundslat_glo(begin:end,:)*180./PI |
527 |
|
|
|
528 |
|
✗ |
ALLOCATE(ind_cell_glo_glo(klon_glo)) |
529 |
|
✗ |
CALL gather(ind_cell_glo,ind_cell_glo_glo) |
530 |
|
✗ |
CALL bcast(ind_cell_glo_glo) |
531 |
|
✗ |
ind_cell(:)=ind_cell_glo_glo(begin:end) |
532 |
|
|
|
533 |
|
|
ENDIF |
534 |
|
✗ |
CALL Init_synchro_omp |
535 |
|
|
|
536 |
|
|
!$OMP BARRIER |
537 |
|
|
|
538 |
|
|
IF (knon > 0) THEN |
539 |
|
|
ENDIF |
540 |
|
|
|
541 |
|
✗ |
CALL Synchro_omp |
542 |
|
|
|
543 |
|
|
|
544 |
|
|
IF (knon > 0) THEN |
545 |
|
|
|
546 |
|
|
ENDIF |
547 |
|
|
|
548 |
|
✗ |
CALL Synchro_omp |
549 |
|
|
|
550 |
|
✗ |
albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2. |
551 |
|
|
|
552 |
|
|
ENDIF |
553 |
|
|
|
554 |
|
|
! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon)) |
555 |
|
✗ |
swdown_vrai(1:knon) = swdown(1:knon) |
556 |
|
|
!$OMP BARRIER |
557 |
|
|
|
558 |
|
|
IF (knon > 0) THEN |
559 |
|
|
ENDIF |
560 |
|
|
|
561 |
|
✗ |
CALL Synchro_omp |
562 |
|
|
|
563 |
|
✗ |
albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2. |
564 |
|
|
|
565 |
|
|
!* Send to coupler |
566 |
|
|
! |
567 |
|
✗ |
IF (type_ocean=='couple') THEN |
568 |
|
|
CALL cpl_send_land_fields(itime, knon, knindex, & |
569 |
|
✗ |
riverflow, coastalflow) |
570 |
|
|
ENDIF |
571 |
|
|
|
572 |
|
✗ |
alb1_new(1:knon) = albedo_out(1:knon,1) |
573 |
|
✗ |
alb2_new(1:knon) = albedo_out(1:knon,2) |
574 |
|
|
|
575 |
|
|
! Convention orchidee: positif vers le haut |
576 |
|
✗ |
fluxsens(1:knon) = -1. * fluxsens(1:knon) |
577 |
|
✗ |
fluxlat(1:knon) = -1. * fluxlat(1:knon) |
578 |
|
|
|
579 |
|
|
! evap = -1. * evap |
580 |
|
|
|
581 |
|
✗ |
IF (debut) lrestart_read = .FALSE. |
582 |
|
|
|
583 |
|
✗ |
IF (debut) CALL Finalize_surf_para |
584 |
|
|
|
585 |
|
|
! >> PC |
586 |
|
|
! Decompressing variables into LMDz for the module carbon_cycle_mod |
587 |
|
|
! nbcf_in can be zero, in which case the loop does not operate |
588 |
|
|
! fields_in can then used elsewhere in the model |
589 |
|
|
|
590 |
|
✗ |
fields_in(:,:)=0.0 |
591 |
|
|
|
592 |
|
✗ |
DO nb=1, nbcf_in_orc |
593 |
|
✗ |
DO igrid = 1, knon |
594 |
|
✗ |
ireal = knindex(igrid) |
595 |
|
✗ |
fields_in(ireal,nb)=yfields_in(igrid,nb) |
596 |
|
|
ENDDO |
597 |
|
✗ |
WRITE(*,*) 'surf_land_orchidee_mod --- yfields_in :',cfname_in(nb) |
598 |
|
|
ENDDO |
599 |
|
|
! >> PC |
600 |
|
|
|
601 |
|
✗ |
END SUBROUTINE surf_land_orchidee |
602 |
|
|
! |
603 |
|
|
!**************************************************************************************** |
604 |
|
|
! |
605 |
|
✗ |
SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex) |
606 |
|
|
USE mod_surf_para |
607 |
|
|
USE mod_grid_phy_lmdz |
608 |
|
|
|
609 |
|
|
INTEGER,INTENT(IN) :: knon |
610 |
|
|
INTEGER,INTENT(IN) :: knindex(klon) |
611 |
|
|
INTEGER,INTENT(OUT) :: offset |
612 |
|
|
INTEGER,INTENT(OUT) :: ktindex(klon) |
613 |
|
|
|
614 |
|
✗ |
INTEGER :: ktindex_glo(knon_glo) |
615 |
|
✗ |
INTEGER :: offset_para(0:omp_size*mpi_size-1) |
616 |
|
|
INTEGER :: LastPoint |
617 |
|
|
INTEGER :: task |
618 |
|
|
|
619 |
|
✗ |
ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1 |
620 |
|
|
|
621 |
|
✗ |
CALL gather_surf(ktindex(1:knon),ktindex_glo) |
622 |
|
|
|
623 |
|
✗ |
IF (is_mpi_root .AND. is_omp_root) THEN |
624 |
|
|
LastPoint=0 |
625 |
|
✗ |
DO Task=0,mpi_size*omp_size-1 |
626 |
|
✗ |
IF (knon_glo_para(Task)>0) THEN |
627 |
|
✗ |
offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon) |
628 |
|
✗ |
LastPoint=ktindex_glo(knon_glo_end_para(task)) |
629 |
|
|
ENDIF |
630 |
|
|
ENDDO |
631 |
|
|
ENDIF |
632 |
|
|
|
633 |
|
✗ |
CALL bcast(offset_para) |
634 |
|
|
|
635 |
|
✗ |
offset=offset_para(omp_size*mpi_rank+omp_rank) |
636 |
|
|
|
637 |
|
✗ |
ktindex(1:knon)=ktindex(1:knon)-offset |
638 |
|
|
|
639 |
|
✗ |
END SUBROUTINE Init_orchidee_index |
640 |
|
|
|
641 |
|
|
! |
642 |
|
|
!************************* *************************************************************** |
643 |
|
|
! |
644 |
|
|
|
645 |
|
✗ |
SUBROUTINE Get_orchidee_communicator(orch_comm, orch_mpi_size, orch_mpi_rank, orch_omp_size,orch_omp_rank) |
646 |
|
|
USE mod_surf_para |
647 |
|
|
|
648 |
|
|
|
649 |
|
|
INTEGER,INTENT(OUT) :: orch_comm |
650 |
|
|
INTEGER,INTENT(OUT) :: orch_mpi_size |
651 |
|
|
INTEGER,INTENT(OUT) :: orch_mpi_rank |
652 |
|
|
INTEGER,INTENT(OUT) :: orch_omp_size |
653 |
|
|
INTEGER,INTENT(OUT) :: orch_omp_rank |
654 |
|
|
INTEGER :: color |
655 |
|
|
INTEGER :: i,ierr |
656 |
|
|
! |
657 |
|
|
! End definition |
658 |
|
|
!**************************************************************************************** |
659 |
|
|
|
660 |
|
|
IF (is_omp_root) THEN |
661 |
|
|
|
662 |
|
|
IF (knon_mpi==0) THEN |
663 |
|
|
color = 0 |
664 |
|
|
ELSE |
665 |
|
|
color = 1 |
666 |
|
|
ENDIF |
667 |
|
|
|
668 |
|
|
|
669 |
|
|
ENDIF |
670 |
|
✗ |
CALL bcast_omp(orch_comm) |
671 |
|
|
|
672 |
|
✗ |
IF (knon_mpi /= 0) THEN |
673 |
|
✗ |
orch_omp_size=0 |
674 |
|
✗ |
DO i=0,omp_size-1 |
675 |
|
✗ |
IF (knon_omp_para(i) /=0) THEN |
676 |
|
✗ |
orch_omp_size=orch_omp_size+1 |
677 |
|
✗ |
IF (i==omp_rank) orch_omp_rank=orch_omp_size-1 |
678 |
|
|
ENDIF |
679 |
|
|
ENDDO |
680 |
|
|
ENDIF |
681 |
|
|
|
682 |
|
✗ |
END SUBROUTINE Get_orchidee_communicator |
683 |
|
|
! |
684 |
|
|
!**************************************************************************************** |
685 |
|
|
! |
686 |
|
|
|
687 |
|
✗ |
SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf) |
688 |
|
|
USE mod_grid_phy_lmdz |
689 |
|
|
USE mod_surf_para |
690 |
|
|
USE indice_sol_mod |
691 |
|
|
|
692 |
|
|
|
693 |
|
|
! Input arguments |
694 |
|
|
!**************************************************************************************** |
695 |
|
|
INTEGER, INTENT(IN) :: knon |
696 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
697 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: pctsrf |
698 |
|
|
|
699 |
|
|
! Output arguments |
700 |
|
|
!**************************************************************************************** |
701 |
|
|
INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours |
702 |
|
|
|
703 |
|
|
! Local variables |
704 |
|
|
!**************************************************************************************** |
705 |
|
|
INTEGER :: i, igrid, jj, ij, iglob |
706 |
|
|
INTEGER :: ierr, ireal, index |
707 |
|
|
INTEGER, DIMENSION(8,3) :: off_ini |
708 |
|
|
INTEGER, DIMENSION(8) :: offset |
709 |
|
✗ |
INTEGER, DIMENSION(nbp_lon,nbp_lat) :: correspond |
710 |
|
✗ |
INTEGER, DIMENSION(knon_glo) :: ktindex_glo |
711 |
|
✗ |
INTEGER, DIMENSION(knon_glo,8) :: neighbours_glo |
712 |
|
✗ |
REAL, DIMENSION(klon_glo) :: pctsrf_glo |
713 |
|
✗ |
INTEGER :: ktindex(klon) |
714 |
|
|
! |
715 |
|
|
! End definition |
716 |
|
|
!**************************************************************************************** |
717 |
|
|
|
718 |
|
✗ |
ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1 |
719 |
|
|
|
720 |
|
✗ |
CALL gather_surf(ktindex(1:knon),ktindex_glo) |
721 |
|
✗ |
CALL gather(pctsrf,pctsrf_glo) |
722 |
|
|
|
723 |
|
✗ |
IF (is_mpi_root .AND. is_omp_root) THEN |
724 |
|
✗ |
neighbours_glo(:,:)=-1 |
725 |
|
|
! Initialisation des offset |
726 |
|
|
! |
727 |
|
|
! offset bord ouest |
728 |
|
✗ |
off_ini(1,1) = - nbp_lon ; off_ini(2,1) = - nbp_lon + 1 ; off_ini(3,1) = 1 |
729 |
|
✗ |
off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon ; off_ini(6,1) = 2 * nbp_lon - 1 |
730 |
|
✗ |
off_ini(7,1) = nbp_lon -1 ; off_ini(8,1) = - 1 |
731 |
|
|
! offset point normal |
732 |
|
✗ |
off_ini(1,2) = - nbp_lon ; off_ini(2,2) = - nbp_lon + 1 ; off_ini(3,2) = 1 |
733 |
|
✗ |
off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon ; off_ini(6,2) = nbp_lon - 1 |
734 |
|
✗ |
off_ini(7,2) = -1 ; off_ini(8,2) = - nbp_lon - 1 |
735 |
|
|
! offset bord est |
736 |
|
✗ |
off_ini(1,3) = - nbp_lon ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1 |
737 |
|
✗ |
off_ini(4,3) = 1 ; off_ini(5,3) = nbp_lon ; off_ini(6,3) = nbp_lon - 1 |
738 |
|
✗ |
off_ini(7,3) = -1 ; off_ini(8,3) = - nbp_lon - 1 |
739 |
|
|
! |
740 |
|
|
! Attention aux poles |
741 |
|
|
! |
742 |
|
✗ |
DO igrid = 1, knon_glo |
743 |
|
✗ |
index = ktindex_glo(igrid) |
744 |
|
✗ |
jj = INT((index - 1)/nbp_lon) + 1 |
745 |
|
✗ |
ij = index - (jj - 1) * nbp_lon |
746 |
|
✗ |
correspond(ij,jj) = igrid |
747 |
|
|
ENDDO |
748 |
|
|
!sonia : Les mailles des voisines doivent etre toutes egales (pour couplage orchidee) |
749 |
|
✗ |
IF (knon_glo == 1) THEN |
750 |
|
|
igrid = 1 |
751 |
|
✗ |
DO i = 1,8 |
752 |
|
✗ |
neighbours_glo(igrid, i) = igrid |
753 |
|
|
ENDDO |
754 |
|
|
ELSE |
755 |
|
|
|
756 |
|
✗ |
DO igrid = 1, knon_glo |
757 |
|
✗ |
iglob = ktindex_glo(igrid) |
758 |
|
|
|
759 |
|
✗ |
IF (MOD(iglob, nbp_lon) == 1) THEN |
760 |
|
✗ |
offset = off_ini(:,1) |
761 |
|
✗ |
ELSE IF(MOD(iglob, nbp_lon) == 0) THEN |
762 |
|
✗ |
offset = off_ini(:,3) |
763 |
|
|
ELSE |
764 |
|
✗ |
offset = off_ini(:,2) |
765 |
|
|
ENDIF |
766 |
|
|
|
767 |
|
✗ |
DO i = 1, 8 |
768 |
|
✗ |
index = iglob + offset(i) |
769 |
|
✗ |
ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo)) |
770 |
|
✗ |
IF (pctsrf_glo(ireal) > EPSFRA) THEN |
771 |
|
✗ |
jj = INT((index - 1)/nbp_lon) + 1 |
772 |
|
✗ |
ij = index - (jj - 1) * nbp_lon |
773 |
|
✗ |
neighbours_glo(igrid, i) = correspond(ij, jj) |
774 |
|
|
ENDIF |
775 |
|
|
ENDDO |
776 |
|
|
ENDDO |
777 |
|
|
ENDIF !fin knon_glo == 1 |
778 |
|
|
|
779 |
|
|
ENDIF |
780 |
|
|
|
781 |
|
✗ |
DO i = 1, 8 |
782 |
|
✗ |
CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i)) |
783 |
|
|
ENDDO |
784 |
|
✗ |
END SUBROUTINE Init_neighbours |
785 |
|
|
|
786 |
|
|
! |
787 |
|
|
!**************************************************************************************** |
788 |
|
|
! |
789 |
|
|
END MODULE surf_land_orchidee_mod |
790 |
|
|
|