source: LMDZ5/trunk/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90 @ 2867

Last change on this file since 2867 was 2572, checked in by jghattas, 8 years ago

Corected bug introduced in rev [2240] : guistiness was added in the subroutine surf_land_orchidee in the default module but the old module were forgotten.

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