Ignore:
Timestamp:
Nov 21, 2019, 4:43:45 PM (5 years ago)
Author:
lguez
Message:

Merge revisions 3427:3600 of trunk into branch Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/phylmd/surf_land_orchidee_mod.F90

    r3391 r3605  
    44#ifndef ORCHIDEE_NOZ0H
    55#ifndef ORCHIDEE_NOFREIN
     6#ifndef ORCHIDEE_NOUNSTRUCT
    67!
    78! This module controles the interface towards the model ORCHIDEE.
     
    2324  USE cpl_mod,      ONLY : cpl_send_land_fields
    2425  USE surface_data, ONLY : type_ocean
    25   USE geometry_mod, ONLY : dx, dy
     26  USE geometry_mod, ONLY : dx, dy, boundslon, boundslat,longitude, latitude, cell_area,  ind_cell_glo
    2627  USE mod_grid_phy_lmdz
    2728  USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master
    2829  USE carbon_cycle_mod, ONLY : nbcf_in_orc, nbcf_out, fields_in, yfields_in, yfields_out, cfname_in, cfname_out
    29 
     30  USE nrtype, ONLY : PI
     31 
    3032  IMPLICIT NONE
    3133
     
    165167    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: lalo
    166168    !$OMP THREADPRIVATE(lalo)
     169! boundaries of cells
     170    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE   :: bounds_lalo
     171    !$OMP THREADPRIVATE(bounds_lalo)
    167172! pts voisins
    168173    INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
     
    178183    !$OMP THREADPRIVATE(lon_scat,lat_scat)
    179184
     185! area of cells
     186    REAL, ALLOCATABLE, DIMENSION (:), SAVE  :: area 
     187    !$OMP THREADPRIVATE(area)
     188
    180189    LOGICAL, SAVE                             :: lrestart_read = .TRUE.
    181190    !$OMP THREADPRIVATE(lrestart_read)
     
    209218    !$OMP THREADPRIVATE(riverflow)
    210219   
     220    INTEGER :: orch_mpi_rank
     221    INTEGER :: orch_mpi_size
    211222    INTEGER :: orch_omp_rank
    212223    INTEGER :: orch_omp_size
     224
     225    REAL, ALLOCATABLE, DIMENSION(:)         :: longitude_glo
     226    REAL, ALLOCATABLE, DIMENSION(:)         :: latitude_glo
     227    REAL, ALLOCATABLE, DIMENSION(:,:)       :: boundslon_glo
     228    REAL, ALLOCATABLE, DIMENSION(:,:)       :: boundslat_glo
     229    INTEGER, ALLOCATABLE, DIMENSION(:)      :: ind_cell_glo_glo
     230    INTEGER, ALLOCATABLE, SAVE,DIMENSION(:) :: ind_cell
     231    !$OMP THREADPRIVATE(ind_cell)
     232    INTEGER :: begin, end
    213233!
    214234! Fin definition
     
    253273       jg(klon) = nbp_lat
    254274
    255        IF ((.NOT. ALLOCATED(lalo))) THEN
    256           ALLOCATE(lalo(knon,2), stat = error)
     275       IF ((.NOT. ALLOCATED(area))) THEN
     276          ALLOCATE(area(knon), stat = error)
    257277          IF (error /= 0) THEN
     278             abort_message='Pb allocation area'
     279             CALL abort_physic(modname,abort_message,1)
     280          ENDIF
     281       ENDIF
     282       DO igrid = 1, knon
     283          area(igrid) = cell_area(knindex(igrid))
     284       ENDDO
     285       
     286       IF (grid_type==unstructured) THEN
     287
     288
     289         IF ((.NOT. ALLOCATED(lon_scat))) THEN
     290            ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
     291            IF (error /= 0) THEN
     292               abort_message='Pb allocation lon_scat'
     293               CALL abort_physic(modname,abort_message,1)
     294            ENDIF
     295         ENDIF
     296 
     297         IF ((.NOT. ALLOCATED(lat_scat))) THEN
     298            ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
     299            IF (error /= 0) THEN
     300               abort_message='Pb allocation lat_scat'
     301               CALL abort_physic(modname,abort_message,1)
     302            ENDIF
     303         ENDIF
     304         CALL Gather(rlon,rlon_g)
     305         CALL Gather(rlat,rlat_g)
     306
     307         IF (is_mpi_root) THEN
     308            index = 1
     309            DO jj = 2, nbp_lat-1
     310               DO ij = 1, nbp_lon
     311                  index = index + 1
     312                  lon_scat(ij,jj) = rlon_g(index)
     313                  lat_scat(ij,jj) = rlat_g(index)
     314               ENDDO
     315            ENDDO
     316            lon_scat(:,1) = lon_scat(:,2)
     317            lat_scat(:,1) = rlat_g(1)
     318            lon_scat(:,nbp_lat) = lon_scat(:,2)
     319            lat_scat(:,nbp_lat) = rlat_g(klon_glo)
     320         ENDIF
     321     
     322         CALL bcast(lon_scat)
     323         CALL bcast(lat_scat)
     324               
     325       ELSE IF (grid_type==regular_lonlat) THEN
     326
     327         IF ((.NOT. ALLOCATED(lalo))) THEN
     328            ALLOCATE(lalo(knon,2), stat = error)
     329            IF (error /= 0) THEN
     330               abort_message='Pb allocation lalo'
     331               CALL abort_physic(modname,abort_message,1)
     332            ENDIF
     333         ENDIF
     334       
     335         IF ((.NOT. ALLOCATED(bounds_lalo))) THEN
     336           ALLOCATE(bounds_lalo(knon,nvertex,2), stat = error)
     337           IF (error /= 0) THEN
    258338             abort_message='Pb allocation lalo'
    259339             CALL abort_physic(modname,abort_message,1)
    260           ENDIF
    261        ENDIF
    262        IF ((.NOT. ALLOCATED(lon_scat))) THEN
    263           ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
    264           IF (error /= 0) THEN
    265              abort_message='Pb allocation lon_scat'
    266              CALL abort_physic(modname,abort_message,1)
    267           ENDIF
    268        ENDIF
    269        IF ((.NOT. ALLOCATED(lat_scat))) THEN
    270           ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
    271           IF (error /= 0) THEN
    272              abort_message='Pb allocation lat_scat'
    273              CALL abort_physic(modname,abort_message,1)
    274           ENDIF
    275        ENDIF
    276        lon_scat = 0.
    277        lat_scat = 0.
    278        DO igrid = 1, knon
    279           index = knindex(igrid)
    280           lalo(igrid,2) = rlon(index)
    281           lalo(igrid,1) = rlat(index)
    282        ENDDO
    283 
    284        
    285        
    286        CALL Gather(rlon,rlon_g)
    287        CALL Gather(rlat,rlat_g)
    288 
    289        IF (is_mpi_root) THEN
    290           index = 1
    291           DO jj = 2, nbp_lat-1
    292              DO ij = 1, nbp_lon
    293                 index = index + 1
    294                 lon_scat(ij,jj) = rlon_g(index)
    295                 lat_scat(ij,jj) = rlat_g(index)
    296              ENDDO
    297           ENDDO
    298           lon_scat(:,1) = lon_scat(:,2)
    299           lat_scat(:,1) = rlat_g(1)
    300           lon_scat(:,nbp_lat) = lon_scat(:,2)
    301           lat_scat(:,nbp_lat) = rlat_g(klon_glo)
    302        ENDIF
     340           ENDIF
     341         ENDIF
     342       
     343         IF ((.NOT. ALLOCATED(lon_scat))) THEN
     344            ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
     345            IF (error /= 0) THEN
     346               abort_message='Pb allocation lon_scat'
     347               CALL abort_physic(modname,abort_message,1)
     348            ENDIF
     349         ENDIF
     350         IF ((.NOT. ALLOCATED(lat_scat))) THEN
     351            ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
     352            IF (error /= 0) THEN
     353               abort_message='Pb allocation lat_scat'
     354               CALL abort_physic(modname,abort_message,1)
     355            ENDIF
     356         ENDIF
     357         lon_scat = 0.
     358         lat_scat = 0.
     359         DO igrid = 1, knon
     360            index = knindex(igrid)
     361            lalo(igrid,2) = rlon(index)
     362            lalo(igrid,1) = rlat(index)
     363            bounds_lalo(igrid,:,2)=boundslon(index,:)*180./PI
     364            bounds_lalo(igrid,:,1)=boundslat(index,:)*180./PI
     365         ENDDO
     366
     367       
     368       
     369         CALL Gather(rlon,rlon_g)
     370         CALL Gather(rlat,rlat_g)
     371
     372         IF (is_mpi_root) THEN
     373            index = 1
     374            DO jj = 2, nbp_lat-1
     375               DO ij = 1, nbp_lon
     376                  index = index + 1
     377                  lon_scat(ij,jj) = rlon_g(index)
     378                  lat_scat(ij,jj) = rlat_g(index)
     379               ENDDO
     380            ENDDO
     381            lon_scat(:,1) = lon_scat(:,2)
     382            lat_scat(:,1) = rlat_g(1)
     383            lon_scat(:,nbp_lat) = lon_scat(:,2)
     384            lat_scat(:,nbp_lat) = rlat_g(klon_glo)
     385         ENDIF
    303386   
    304        CALL bcast(lon_scat)
    305        CALL bcast(lat_scat)
     387         CALL bcast(lon_scat)
     388         CALL bcast(lat_scat)
     389       
     390       ENDIF
    306391!
    307392! Allouer et initialiser le tableau des voisins et des fraction de continents
    308393!
    309        IF ( (.NOT.ALLOCATED(neighbours))) THEN
    310           ALLOCATE(neighbours(knon,8), stat = error)
    311           IF (error /= 0) THEN
    312              abort_message='Pb allocation neighbours'
    313              CALL abort_physic(modname,abort_message,1)
    314           ENDIF
    315        ENDIF
    316        neighbours = -1.
    317394       IF (( .NOT. ALLOCATED(contfrac))) THEN
    318395          ALLOCATE(contfrac(knon), stat = error)
     
    329406
    330407
    331        CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
     408       IF (grid_type==regular_lonlat) THEN
     409 
     410         IF ( (.NOT.ALLOCATED(neighbours))) THEN
     411          ALLOCATE(neighbours(knon,8), 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         CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
     419
     420       ELSE IF (grid_type==unstructured) THEN
     421 
     422         IF ( (.NOT.ALLOCATED(neighbours))) THEN
     423          ALLOCATE(neighbours(knon,12), stat = error)
     424          IF (error /= 0) THEN
     425             abort_message='Pb allocation neighbours'
     426             CALL abort_physic(modname,abort_message,1)
     427          ENDIF
     428         ENDIF
     429         neighbours = -1.
     430 
     431       ENDIF
     432         
    332433
    333434!
     
    340441          ENDIF
    341442       ENDIF
    342        DO igrid = 1, knon
    343           ij = knindex(igrid)
    344           resolution(igrid,1) = dx(ij)
    345           resolution(igrid,2) = dy(ij)
    346        ENDDO
    347      
     443       
     444       IF (grid_type==regular_lonlat) THEN
     445         DO igrid = 1, knon
     446            ij = knindex(igrid)
     447            resolution(igrid,1) = dx(ij)
     448           resolution(igrid,2) = dy(ij)
     449         ENDDO
     450       ENDIF
     451       
    348452       ALLOCATE(coastalflow(klon), stat = error)
    349453       IF (error /= 0) THEN
     
    397501    IF (debut) THEN
    398502       CALL Init_orchidee_index(knon,knindex,offset,ktindex)
    399        CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
     503       CALL Get_orchidee_communicator(orch_comm,orch_mpi_size,orch_mpi_rank, orch_omp_size,orch_omp_rank)
     504
     505       IF (grid_type==unstructured) THEN
     506         IF (knon==0) THEN
     507           begin=1
     508           end=0
     509         ELSE
     510           begin=offset+1
     511           end=offset+ktindex(knon)
     512         ENDIF
     513       
     514         IF (orch_mpi_rank==orch_mpi_size-1 .AND. orch_omp_rank==orch_omp_size-1) end=nbp_lon*nbp_lat
     515         
     516         ALLOCATE(lalo(end-begin+1,2))
     517         ALLOCATE(bounds_lalo(end-begin+1,nvertex,2))
     518         ALLOCATE(ind_cell(end-begin+1))
     519         
     520         ALLOCATE(longitude_glo(klon_glo))
     521         CALL gather(longitude,longitude_glo)
     522         CALL bcast(longitude_glo)
     523         lalo(:,2)=longitude_glo(begin:end)*180./PI
     524 
     525         ALLOCATE(latitude_glo(klon_glo))
     526         CALL gather(latitude,latitude_glo)
     527         CALL bcast(latitude_glo)
     528         lalo(:,1)=latitude_glo(begin:end)*180./PI
     529
     530         ALLOCATE(boundslon_glo(klon_glo,nvertex))
     531         CALL gather(boundslon,boundslon_glo)
     532         CALL bcast(boundslon_glo)
     533         bounds_lalo(:,:,2)=boundslon_glo(begin:end,:)*180./PI
     534 
     535         ALLOCATE(boundslat_glo(klon_glo,nvertex))
     536         CALL gather(boundslat,boundslat_glo)
     537         CALL bcast(boundslat_glo)
     538         bounds_lalo(:,:,1)=boundslat_glo(begin:end,:)*180./PI
     539         
     540         ALLOCATE(ind_cell_glo_glo(klon_glo))
     541         CALL gather(ind_cell_glo,ind_cell_glo_glo)
     542         CALL bcast(ind_cell_glo_glo)
     543         ind_cell(:)=ind_cell_glo_glo(begin:end)
     544         
     545       ENDIF
    400546       CALL Init_synchro_omp
     547
     548!$OMP BARRIER
    401549       
    402550       IF (knon > 0) THEN
    403551#ifdef CPP_VEGET
    404          CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
     552         CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm,grid=grid_type)
    405553#endif
    406554       ENDIF
    407555
    408        
    409        IF (knon > 0) THEN
    410 
    411          print *,'OB before intersurf=', SIZE(cfname_in), SIZE(cfname_out)
     556       CALL Synchro_omp
     557
     558       
     559       IF (knon > 0) THEN
     560
    412561#ifdef CPP_VEGET
     562
    413563         CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
    414564               lrestart_read, lrestart_write, lalo, contfrac, neighbours, resolution, date0, &
     
    418568               evap, fluxsens, fluxlat, coastalflow, riverflow, &
    419569               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0m_new, &   
    420 ! >> PC
    421                !lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch)
    422                lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch, &
     570               lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon), nvm_orch, &
     571               grid=grid_type, bounds_latlon=bounds_lalo, cell_area=area, ind_cell_glo=ind_cell, &
    423572               field_out_names=cfname_out, field_in_names=cfname_in(1:nbcf_in_orc))
    424 ! << PC
    425573#endif         
    426574       ENDIF
     
    434582!  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
    435583    swdown_vrai(1:knon) = swdown(1:knon)
     584!$OMP BARRIER
    436585
    437586    IF (knon > 0) THEN
     
    450599            evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
    451600            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0m_new(1:knon), &
    452             lon_scat, lat_scat, q2m, t2m, z0h_new(1:knon),&
     601            lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon),&
    453602            veget(1:knon,:),lai(1:knon,:),height(1:knon,:),&
    454603            fields_out=yfields_out(1:knon,1:nbcf_out),  &
     
    542691!
    543692
    544   SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
     693  SUBROUTINE Get_orchidee_communicator(orch_comm, orch_mpi_size, orch_mpi_rank, orch_omp_size,orch_omp_rank)
    545694  USE  mod_surf_para
    546695     
     
    550699
    551700    INTEGER,INTENT(OUT) :: orch_comm
     701    INTEGER,INTENT(OUT) :: orch_mpi_size
     702    INTEGER,INTENT(OUT) :: orch_mpi_rank
    552703    INTEGER,INTENT(OUT) :: orch_omp_size
    553704    INTEGER,INTENT(OUT) :: orch_omp_rank
     
    568719#ifdef CPP_MPI   
    569720      CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
     721      CALL MPI_COMM_SIZE(orch_comm,orch_mpi_size,ierr)
     722      CALL MPI_COMM_RANK(orch_comm,orch_mpi_rank,ierr)
    570723#endif
    571724   
     
    696849#endif
    697850#endif
     851#endif
    698852END MODULE surf_land_orchidee_mod
Note: See TracChangeset for help on using the changeset viewer.