- Timestamp:
- Nov 21, 2019, 4:43:45 PM (4 years ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/surf_land_orchidee_mod.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
-
LMDZ6/branches/Ocean_skin/libf/phylmd/surf_land_orchidee_mod.F90
r3391 r3605 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 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 30 32 IMPLICIT NONE 31 33 … … 165 167 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo 166 168 !$OMP THREADPRIVATE(lalo) 169 ! boundaries of cells 170 REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: bounds_lalo 171 !$OMP THREADPRIVATE(bounds_lalo) 167 172 ! pts voisins 168 173 INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours … … 178 183 !$OMP THREADPRIVATE(lon_scat,lat_scat) 179 184 185 ! area of cells 186 REAL, ALLOCATABLE, DIMENSION (:), SAVE :: area 187 !$OMP THREADPRIVATE(area) 188 180 189 LOGICAL, SAVE :: lrestart_read = .TRUE. 181 190 !$OMP THREADPRIVATE(lrestart_read) … … 209 218 !$OMP THREADPRIVATE(riverflow) 210 219 220 INTEGER :: orch_mpi_rank 221 INTEGER :: orch_mpi_size 211 222 INTEGER :: orch_omp_rank 212 223 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 213 233 ! 214 234 ! Fin definition … … 253 273 jg(klon) = nbp_lat 254 274 255 IF ((.NOT. ALLOCATED( lalo))) THEN256 ALLOCATE( lalo(knon,2), stat = error)275 IF ((.NOT. ALLOCATED(area))) THEN 276 ALLOCATE(area(knon), stat = error) 257 277 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 258 338 abort_message='Pb allocation lalo' 259 339 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 303 386 304 CALL bcast(lon_scat) 305 CALL bcast(lat_scat) 387 CALL bcast(lon_scat) 388 CALL bcast(lat_scat) 389 390 ENDIF 306 391 ! 307 392 ! Allouer et initialiser le tableau des voisins et des fraction de continents 308 393 ! 309 IF ( (.NOT.ALLOCATED(neighbours))) THEN310 ALLOCATE(neighbours(knon,8), stat = error)311 IF (error /= 0) THEN312 abort_message='Pb allocation neighbours'313 CALL abort_physic(modname,abort_message,1)314 ENDIF315 ENDIF316 neighbours = -1.317 394 IF (( .NOT. ALLOCATED(contfrac))) THEN 318 395 ALLOCATE(contfrac(knon), stat = error) … … 329 406 330 407 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 332 433 333 434 ! … … 340 441 ENDIF 341 442 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 348 452 ALLOCATE(coastalflow(klon), stat = error) 349 453 IF (error /= 0) THEN … … 397 501 IF (debut) THEN 398 502 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 400 546 CALL Init_synchro_omp 547 548 !$OMP BARRIER 401 549 402 550 IF (knon > 0) THEN 403 551 #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) 405 553 #endif 406 554 ENDIF 407 555 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 412 561 #ifdef CPP_VEGET 562 413 563 CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, & 414 564 lrestart_read, lrestart_write, lalo, contfrac, neighbours, resolution, date0, & … … 418 568 evap, fluxsens, fluxlat, coastalflow, riverflow, & 419 569 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, & 423 572 field_out_names=cfname_out, field_in_names=cfname_in(1:nbcf_in_orc)) 424 ! << PC425 573 #endif 426 574 ENDIF … … 434 582 ! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon)) 435 583 swdown_vrai(1:knon) = swdown(1:knon) 584 !$OMP BARRIER 436 585 437 586 IF (knon > 0) THEN … … 450 599 evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), & 451 600 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),& 453 602 veget(1:knon,:),lai(1:knon,:),height(1:knon,:),& 454 603 fields_out=yfields_out(1:knon,1:nbcf_out), & … … 542 691 ! 543 692 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) 545 694 USE mod_surf_para 546 695 … … 550 699 551 700 INTEGER,INTENT(OUT) :: orch_comm 701 INTEGER,INTENT(OUT) :: orch_mpi_size 702 INTEGER,INTENT(OUT) :: orch_mpi_rank 552 703 INTEGER,INTENT(OUT) :: orch_omp_size 553 704 INTEGER,INTENT(OUT) :: orch_omp_rank … … 568 719 #ifdef CPP_MPI 569 720 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) 570 723 #endif 571 724 … … 696 849 #endif 697 850 #endif 851 #endif 698 852 END MODULE surf_land_orchidee_mod
Note: See TracChangeset
for help on using the changeset viewer.
