Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

surf_land_orchidee_nolic_mod.F90 @ 4500

Last change on this file since 4500 was 4447, checked in by Laurent Fairhead, 17 months ago
Added some routines from the trunk that were previously links and that svn did not want to commit on the previous commit (with an "Node filename has unexpectedly changed kind" error)
File size: 29.1 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format