- Timestamp:
- Nov 12, 2018, 1:52:29 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/DYNAMICO-conv/libf/phylmd/surf_land_orchidee_mod.F90
r3411 r3413 4 4 #ifndef ORCHIDEE_NOZ0H 5 5 #ifndef ORCHIDEE_NOFREIN 6 #ifndef ORCHIDEE_NOUNSTRUCT 6 7 ! 7 8 ! This module controles the interface towards the model ORCHIDEE. … … 23 24 USE cpl_mod, ONLY : cpl_send_land_fields 24 25 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 26 27 USE mod_grid_phy_lmdz 27 28 USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master 28 29 USE nrtype, ONLY : PI 30 29 31 IMPLICIT NONE 30 32 … … 170 172 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo 171 173 !$OMP THREADPRIVATE(lalo) 174 ! boundaries of cells 175 REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: bounds_lalo 176 !$OMP THREADPRIVATE(bounds_lalo) 172 177 ! pts voisins 173 178 INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours … … 183 188 !$OMP THREADPRIVATE(lon_scat,lat_scat) 184 189 190 ! area of cells 191 REAL, ALLOCATABLE, DIMENSION (:), SAVE :: area 192 !$OMP THREADPRIVATE(area) 193 185 194 LOGICAL, SAVE :: lrestart_read = .TRUE. 186 195 !$OMP THREADPRIVATE(lrestart_read) … … 214 223 !$OMP THREADPRIVATE(riverflow) 215 224 225 INTEGER :: orch_mpi_rank 226 INTEGER :: orch_mpi_size 216 227 INTEGER :: orch_omp_rank 217 228 INTEGER :: orch_omp_size 229 230 REAL, ALLOCATABLE, DIMENSION(:) :: longitude_glo 231 REAL, ALLOCATABLE, DIMENSION(:) :: latitude_glo 232 REAL, ALLOCATABLE, DIMENSION(:,:) :: boundslon_glo 233 REAL, ALLOCATABLE, DIMENSION(:,:) :: boundslat_glo 234 INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo 235 INTEGER, ALLOCATABLE, SAVE,DIMENSION(:) :: ind_cell 236 !$OMP THREADPRIVATE(ind_cell) 237 INTEGER :: begin, end 218 238 ! 219 239 ! Fin definition … … 258 278 jg(klon) = nbp_lat 259 279 260 IF ((.NOT. ALLOCATED( lalo))) THEN261 ALLOCATE( lalo(knon,2), stat = error)280 IF ((.NOT. ALLOCATED(area))) THEN 281 ALLOCATE(area(knon), stat = error) 262 282 IF (error /= 0) THEN 283 abort_message='Pb allocation area' 284 CALL abort_physic(modname,abort_message,1) 285 ENDIF 286 ENDIF 287 DO igrid = 1, knon 288 area(igrid) = cell_area(knindex(igrid)) 289 ENDDO 290 291 IF (grid_type==unstructured) THEN 292 293 294 IF ((.NOT. ALLOCATED(lon_scat))) THEN 295 ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error) 296 IF (error /= 0) THEN 297 abort_message='Pb allocation lon_scat' 298 CALL abort_physic(modname,abort_message,1) 299 ENDIF 300 ENDIF 301 302 IF ((.NOT. ALLOCATED(lat_scat))) THEN 303 ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error) 304 IF (error /= 0) THEN 305 abort_message='Pb allocation lat_scat' 306 CALL abort_physic(modname,abort_message,1) 307 ENDIF 308 ENDIF 309 CALL Gather(rlon,rlon_g) 310 CALL Gather(rlat,rlat_g) 311 312 IF (is_mpi_root) THEN 313 index = 1 314 DO jj = 2, nbp_lat-1 315 DO ij = 1, nbp_lon 316 index = index + 1 317 lon_scat(ij,jj) = rlon_g(index) 318 lat_scat(ij,jj) = rlat_g(index) 319 ENDDO 320 ENDDO 321 lon_scat(:,1) = lon_scat(:,2) 322 lat_scat(:,1) = rlat_g(1) 323 lon_scat(:,nbp_lat) = lon_scat(:,2) 324 lat_scat(:,nbp_lat) = rlat_g(klon_glo) 325 ENDIF 326 327 CALL bcast(lon_scat) 328 CALL bcast(lat_scat) 329 330 ELSE IF (grid_type==regular_lonlat) THEN 331 332 IF ((.NOT. ALLOCATED(lalo))) THEN 333 ALLOCATE(lalo(knon,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(bounds_lalo))) THEN 341 ALLOCATE(bounds_lalo(knon,nvertex,2), stat = error) 342 IF (error /= 0) THEN 263 343 abort_message='Pb allocation lalo' 264 344 CALL abort_physic(modname,abort_message,1) 265 ENDIF 266 ENDIF 267 IF ((.NOT. ALLOCATED(lon_scat))) THEN 268 ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error) 269 IF (error /= 0) THEN 270 abort_message='Pb allocation lon_scat' 271 CALL abort_physic(modname,abort_message,1) 272 ENDIF 273 ENDIF 274 IF ((.NOT. ALLOCATED(lat_scat))) THEN 275 ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error) 276 IF (error /= 0) THEN 277 abort_message='Pb allocation lat_scat' 278 CALL abort_physic(modname,abort_message,1) 279 ENDIF 280 ENDIF 281 lon_scat = 0. 282 lat_scat = 0. 283 DO igrid = 1, knon 284 index = knindex(igrid) 285 lalo(igrid,2) = rlon(index) 286 lalo(igrid,1) = rlat(index) 287 ENDDO 288 289 290 291 CALL Gather(rlon,rlon_g) 292 CALL Gather(rlat,rlat_g) 293 294 IF (is_mpi_root) THEN 295 index = 1 296 DO jj = 2, nbp_lat-1 297 DO ij = 1, nbp_lon 298 index = index + 1 299 lon_scat(ij,jj) = rlon_g(index) 300 lat_scat(ij,jj) = rlat_g(index) 301 ENDDO 302 ENDDO 303 lon_scat(:,1) = lon_scat(:,2) 304 lat_scat(:,1) = rlat_g(1) 305 lon_scat(:,nbp_lat) = lon_scat(:,2) 306 lat_scat(:,nbp_lat) = rlat_g(klon_glo) 307 ENDIF 345 ENDIF 346 ENDIF 347 348 IF ((.NOT. ALLOCATED(lon_scat))) THEN 349 ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error) 350 IF (error /= 0) THEN 351 abort_message='Pb allocation lon_scat' 352 CALL abort_physic(modname,abort_message,1) 353 ENDIF 354 ENDIF 355 IF ((.NOT. ALLOCATED(lat_scat))) THEN 356 ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error) 357 IF (error /= 0) THEN 358 abort_message='Pb allocation lat_scat' 359 CALL abort_physic(modname,abort_message,1) 360 ENDIF 361 ENDIF 362 lon_scat = 0. 363 lat_scat = 0. 364 DO igrid = 1, knon 365 index = knindex(igrid) 366 lalo(igrid,2) = rlon(index) 367 lalo(igrid,1) = rlat(index) 368 bounds_lalo(igrid,:,2)=boundslon(index,:)*180./PI 369 bounds_lalo(igrid,:,1)=boundslat(index,:)*180./PI 370 ENDDO 371 372 373 374 CALL Gather(rlon,rlon_g) 375 CALL Gather(rlat,rlat_g) 376 377 IF (is_mpi_root) THEN 378 index = 1 379 DO jj = 2, nbp_lat-1 380 DO ij = 1, nbp_lon 381 index = index + 1 382 lon_scat(ij,jj) = rlon_g(index) 383 lat_scat(ij,jj) = rlat_g(index) 384 ENDDO 385 ENDDO 386 lon_scat(:,1) = lon_scat(:,2) 387 lat_scat(:,1) = rlat_g(1) 388 lon_scat(:,nbp_lat) = lon_scat(:,2) 389 lat_scat(:,nbp_lat) = rlat_g(klon_glo) 390 ENDIF 308 391 309 CALL bcast(lon_scat) 310 CALL bcast(lat_scat) 392 CALL bcast(lon_scat) 393 CALL bcast(lat_scat) 394 395 ENDIF 311 396 ! 312 397 ! Allouer et initialiser le tableau des voisins et des fraction de continents 313 398 ! 314 IF ( (.NOT.ALLOCATED(neighbours))) THEN315 ALLOCATE(neighbours(knon,8), stat = error)316 IF (error /= 0) THEN317 abort_message='Pb allocation neighbours'318 CALL abort_physic(modname,abort_message,1)319 ENDIF320 ENDIF321 neighbours = -1.322 399 IF (( .NOT. ALLOCATED(contfrac))) THEN 323 400 ALLOCATE(contfrac(knon), stat = error) … … 334 411 335 412 336 CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter)) 413 IF (grid_type==regular_lonlat) THEN 414 415 IF ( (.NOT.ALLOCATED(neighbours))) THEN 416 ALLOCATE(neighbours(knon,8), stat = error) 417 IF (error /= 0) THEN 418 abort_message='Pb allocation neighbours' 419 CALL abort_physic(modname,abort_message,1) 420 ENDIF 421 ENDIF 422 neighbours = -1. 423 CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter)) 424 425 ELSE IF (grid_type==unstructured) THEN 426 427 IF ( (.NOT.ALLOCATED(neighbours))) THEN 428 ALLOCATE(neighbours(knon,12), stat = error) 429 IF (error /= 0) THEN 430 abort_message='Pb allocation neighbours' 431 CALL abort_physic(modname,abort_message,1) 432 ENDIF 433 ENDIF 434 neighbours = -1. 435 436 ENDIF 437 337 438 338 439 ! … … 345 446 ENDIF 346 447 ENDIF 347 DO igrid = 1, knon 348 ij = knindex(igrid) 349 resolution(igrid,1) = dx(ij) 350 resolution(igrid,2) = dy(ij) 351 ENDDO 352 448 449 IF (grid_type==regular_lonlat) THEN 450 DO igrid = 1, knon 451 ij = knindex(igrid) 452 resolution(igrid,1) = dx(ij) 453 resolution(igrid,2) = dy(ij) 454 ENDDO 455 ENDIF 456 353 457 ALLOCATE(coastalflow(klon), stat = error) 354 458 IF (error /= 0) THEN … … 401 505 IF (debut) THEN 402 506 CALL Init_orchidee_index(knon,knindex,offset,ktindex) 403 CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank) 507 CALL Get_orchidee_communicator(orch_comm,orch_mpi_size,orch_mpi_rank, orch_omp_size,orch_omp_rank) 508 509 IF (grid_type==unstructured) THEN 510 IF (knon==0) THEN 511 begin=1 512 end=0 513 ELSE 514 begin=offset+1 515 end=offset+ktindex(knon) 516 ENDIF 517 518 IF (orch_mpi_rank==orch_mpi_size-1 .AND. orch_omp_rank==orch_omp_size-1) end=nbp_lon*nbp_lat 519 520 ALLOCATE(lalo(end-begin+1,2)) 521 ALLOCATE(bounds_lalo(end-begin+1,nvertex,2)) 522 ALLOCATE(ind_cell(end-begin+1)) 523 524 ALLOCATE(longitude_glo(klon_glo)) 525 CALL gather(longitude,longitude_glo) 526 CALL bcast(longitude_glo) 527 lalo(:,2)=longitude_glo(begin:end)*180./PI 528 529 ALLOCATE(latitude_glo(klon_glo)) 530 CALL gather(latitude,latitude_glo) 531 CALL bcast(latitude_glo) 532 lalo(:,1)=latitude_glo(begin:end)*180./PI 533 534 ALLOCATE(boundslon_glo(klon_glo,nvertex)) 535 CALL gather(boundslon,boundslon_glo) 536 CALL bcast(boundslon_glo) 537 bounds_lalo(:,:,2)=boundslon_glo(begin:end,:)*180./PI 538 539 ALLOCATE(boundslat_glo(klon_glo,nvertex)) 540 CALL gather(boundslat,boundslat_glo) 541 CALL bcast(boundslat_glo) 542 bounds_lalo(:,:,1)=boundslat_glo(begin:end,:)*180./PI 543 544 ALLOCATE(ind_cell_glo_glo(klon_glo)) 545 CALL gather(ind_cell_glo,ind_cell_glo_glo) 546 CALL bcast(ind_cell_glo_glo) 547 ind_cell(:)=ind_cell_glo_glo(begin:end) 548 549 ENDIF 404 550 CALL Init_synchro_omp 405 551 406 552 IF (knon > 0) THEN 407 553 #ifdef CPP_VEGET 408 CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm )554 CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm,grid=grid_type) 409 555 #endif 410 556 ENDIF 411 557 412 558 413 IF (knon > 0) THEN 559 IF (knon > 0) THEN 414 560 415 561 #ifdef CPP_VEGET 562 416 563 CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, & 417 564 lrestart_read, lrestart_write, lalo, contfrac, neighbours, resolution, date0, & … … 421 568 evap, fluxsens, fluxlat, coastalflow, riverflow, & 422 569 tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0m_new, & 423 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) 424 572 #endif 425 573 ENDIF … … 450 598 evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), & 451 599 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),&600 lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon),& 453 601 veget(1:knon,:),lai(1:knon,:),height(1:knon,:),& 454 602 coszang=yrmu0(1:knon)) … … 525 673 ! 526 674 527 SUBROUTINE Get_orchidee_communicator(orch_comm, orch_omp_size,orch_omp_rank)675 SUBROUTINE Get_orchidee_communicator(orch_comm, orch_mpi_size, orch_mpi_rank, orch_omp_size,orch_omp_rank) 528 676 USE mod_surf_para 529 677 … … 533 681 534 682 INTEGER,INTENT(OUT) :: orch_comm 683 INTEGER,INTENT(OUT) :: orch_mpi_size 684 INTEGER,INTENT(OUT) :: orch_mpi_rank 535 685 INTEGER,INTENT(OUT) :: orch_omp_size 536 686 INTEGER,INTENT(OUT) :: orch_omp_rank … … 552 702 #ifdef CPP_MPI 553 703 CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr) 704 CALL MPI_COMM_SIZE(orch_comm,orch_mpi_size,ierr) 705 CALL MPI_COMM_RANK(orch_comm,orch_mpi_rank,ierr) 554 706 #endif 555 707 … … 683 835 #endif 684 836 #endif 837 #endif 685 838 END MODULE surf_land_orchidee_mod
Note: See TracChangeset
for help on using the changeset viewer.
