- Timestamp:
- 2020-06-03T16:36:09+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modinterp.F90
r7752 r13027 127 127 ! 128 128 INTEGER :: i,j,k,l,m,n 129 integer :: i1,j1,k1 129 130 INTEGER, DIMENSION(nbdim) :: pttruetab,cetruetab 130 131 INTEGER, DIMENSION(nbdim) :: indmin, indmax … … 132 133 #if defined AGRIF_MPI 133 134 INTEGER, DIMENSION(nbdim) :: indminglob2,indmaxglob2 135 INTEGER, DIMENSION(nbdim) :: indminglob3,indmaxglob3 136 INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob_chunks, indmaxglob_chunks 137 INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob2_chunks,indmaxglob2_chunks 138 INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob3_chunks,indmaxglob3_chunks 134 139 #endif 135 140 LOGICAL, DIMENSION(nbdim) :: noraftab … … 138 143 INTEGER, DIMENSION(nbdim,2,2), INTENT(OUT) :: childarray 139 144 INTEGER, DIMENSION(nbdim,2,2) :: parentarray 145 INTEGER, DIMENSION(nbdim,2,2) :: parentarray_decal 140 146 LOGICAL :: member 147 LOGICAL,DIMENSION(:),ALLOCATABLE :: member_chuncks 148 INTEGER,DIMENSION(:,:),ALLOCATABLE :: decal_chunks 141 149 LOGICAL :: find_list_interp 142 150 ! … … 148 156 INTEGER, DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4 149 157 INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 158 INTEGER, DIMENSION(nbdim,2) :: tab5 159 INTEGER, DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: tab6 160 INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,2) :: tab5t 150 161 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall 151 162 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1, recvfromproc1 … … 154 165 ! 155 166 #endif 167 ! CHUNK (periodicity) 168 INTEGER :: nb_chunks 169 INTEGER :: agrif_external_switch_index 170 INTEGER, DIMENSION(2) :: test_orientation 171 !INTEGER, DIMENSION(2,nbdim,2,2) :: parentarray_chunk 172 INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: parentarray_chunk 173 INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: parentarray_chunk_decal 174 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: bounds_chunks 175 logical,dimension(:),allocatable :: correction_required 156 176 ! 157 177 type(Agrif_Variable), pointer, save :: tempC => NULL() ! Temporary child grid variable … … 168 188 pttab, petab, pttab_Child, pttab_Parent, nbdim, & 169 189 indmin, indmax, indminglob, indmaxglob, & 170 pttruetab, cetruetab, memberin & 190 pttruetab, cetruetab, memberin, & 191 parentarray_chunk,parentarray_chunk_decal,decal_chunks, & 192 correction_required,member_chuncks,nb_chunks & 171 193 #if defined AGRIF_MPI 172 194 ,indminglob2, indmaxglob2, parentarray, & … … 181 203 pttab, petab, Agrif_Procrank, coords, & 182 204 pttruetab, cetruetab, memberin) 205 206 if (agrif_debug_interp) then 207 print *,'************CHILDBOUNDS*********************************' 208 #ifdef AGRIF_MPI 209 print *,'Processeur ',Agrif_Procrank 210 #endif 211 print *,'memberin ',memberin 212 do i = 1 , nbdim 213 print *,'Direction ',i,' indices debut: ',pttab(i),pttruetab(i) 214 print *,'Direction ',i,' indices fin : ',petab(i),cetruetab(i) 215 enddo 216 print *,'*********************************************' 217 endif 218 183 219 call Agrif_Parentbounds(type_interp,nbdim,indminglob,indmaxglob, & 184 220 s_Parent_temp,s_Child_temp, & … … 188 224 pttab_Child,pttab_Parent, & 189 225 child%root_var % posvar, coords) 226 227 if (agrif_debug_interp) then 228 print *,'************PARENTBOUNDS*********************************' 229 #ifdef AGRIF_MPI 230 print *,'Processeur ',Agrif_Procrank 231 #endif 232 do i = 1 , nbdim 233 print *,'Direction ',i,' indices debut: ',pttab(i),indminglob(i) 234 print *,'Direction ',i,' indices fin : ',petab(i),indmaxglob(i) 235 enddo 236 237 do i = 1 , nbdim 238 print *,'Direction ',i,' s_parent_temp: ',s_parent_temp(i) 239 print *,'Direction ',i,' s_Child_temp : ',s_Child_temp(i) 240 enddo 241 print *,'*********************************************' 242 endif 243 190 244 #if defined AGRIF_MPI 191 245 if (memberin) then … … 197 251 pttab_Child,pttab_Parent, & 198 252 child%root_var % posvar, coords) 253 254 endif 255 if (agrif_debug_interp) then 256 print *,'************PARENTBOUNDSMPI*********************************' 257 #ifdef AGRIF_MPI 258 print *,'Processeur ',Agrif_Procrank 259 #endif 260 do i = 1 , nbdim 261 print *,'Direction ',i,' indices debut: ',pttruetab(i),indmin(i) 262 print *,'Direction ',i,' indices fin : ',cetruetab(i),indmax(i) 263 enddo 264 265 do i = 1 , nbdim 266 print *,'Direction ',i,' s_parent_temp: ',s_parent_temp(i) 267 print *,'Direction ',i,' s_Child_temp : ',s_Child_temp(i) 268 enddo 269 print *,'*********************************************' 199 270 endif 200 271 … … 202 273 call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim) 203 274 call Agrif_ChildGrid_to_ParentGrid() 204 ! 205 call Agrif_Childbounds(nbdim,lowerbound,upperbound, & 206 indminglob,indmaxglob, local_proc, coords, & 207 indminglob2,indmaxglob2,member) 208 ! 209 if (member) then 210 call Agrif_GlobalToLocalBounds(parentarray, & 211 lowerbound, upperbound, & 212 indminglob2, indmaxglob2, coords,& 213 nbdim, local_proc, member) 275 276 parentarray(:,1,1) = indminglob 277 parentarray(:,2,1) = indmaxglob 278 parentarray(:,1,2) = indminglob 279 parentarray(:,2,2) = indmaxglob 280 281 if (associated(agrif_external_mapping)) then 282 283 call agrif_external_mapping(nbdim,child%root_var % posvar(1),child%root_var % posvar(2), & 284 parentarray,parentarray_chunk,correction_required,nb_chunks) 285 allocate(decal_chunks(nb_chunks,nbdim)) 286 do i=1,nb_chunks 287 decal_chunks(i,:)=parentarray_chunk(i,:,1,1)-parentarray_chunk(i,:,1,2) 288 enddo 289 else 290 nb_chunks=1 291 allocate(correction_required(nb_chunks)) 292 correction_required=.FALSE. 293 allocate(parentarray_chunk(nb_chunks,nbdim,2,2)) 294 parentarray_chunk(1,:,:,:)=parentarray 295 allocate(decal_chunks(nb_chunks,nbdim)) 296 decal_chunks=0 214 297 endif 298 if (agrif_debug_interp) then 299 print *,'AVANT PARENTCHILDBOUNDS' 300 print *,'nombre de chunks ',nb_chunks 301 do i=1,nb_chunks 302 print *,'CHUNK Number : ',i 303 do j=1,nbdim 304 print *,'Direction ',j 305 print *,'MIN MAX (2) = ',parentarray_chunk(i,j,1,2),parentarray_chunk(i,j,2,2) 306 print *,'MIN MAX (1) = ',parentarray_chunk(i,j,1,1),parentarray_chunk(i,j,2,1) 307 enddo 308 enddo 309 print *,'APRES PARENTCHILDBOUNDS' 310 endif 311 312 allocate(indminglob_chunks(nb_chunks,nbdim)) 313 allocate(indmaxglob_chunks(nb_chunks,nbdim)) 314 allocate(indminglob2_chunks(nb_chunks,nbdim)) 315 allocate(indmaxglob2_chunks(nb_chunks,nbdim)) 316 allocate(indminglob3_chunks(nb_chunks,nbdim)) 317 allocate(indmaxglob3_chunks(nb_chunks,nbdim)) 318 allocate(member_chuncks(nb_chunks)) 319 320 do i=1,nb_chunks 321 indminglob_chunks(i,:) = parentarray_chunk(i,:,1,2) 322 indmaxglob_chunks(i,:) = parentarray_chunk(i,:,2,2) 323 enddo 324 325 do i=1,nb_chunks 326 327 call Agrif_Childbounds(nbdim,lowerbound,upperbound, & 328 indminglob_chunks(i,:),indmaxglob_chunks(i,:), local_proc, coords, & 329 indminglob2_chunks(i,:),indmaxglob2_chunks(i,:),member_chuncks(i), & 330 indminglob3_chunks(i,:),indmaxglob3_chunks(i,:)) 331 enddo 332 ! 333 ! call Agrif_Childbounds(nbdim,lowerbound,upperbound, & 334 ! indminglob,indmaxglob, local_proc, coords, & 335 ! indminglob2,indmaxglob2,member, & 336 ! indminglob3,indmaxglob3,check_perio=.TRUE.) 337 338 if (agrif_debug_interp) then 339 print *,'************CHILDBOUNDSPARENTMPI*********************************' 340 #ifdef AGRIF_MPI 341 print *,'Processeur ',Agrif_Procrank 342 #endif 343 do j=1,nb_chunks 344 print *,'Chunk number ',j 345 346 do i = 1 , nbdim 347 print *,'Direction ',i,' indices debut: ',indminglob_chunks(j,i),indminglob2_chunks(j,i),indminglob3_chunks(j,i) 348 print *,'Direction ',i,' indices fin : ',indmaxglob_chunks(j,i),indmaxglob2_chunks(j,i),indmaxglob3_chunks(j,i) 349 enddo 350 enddo 351 print *,'*********************************************' 352 endif 353 ! 354 ! if (member) then 355 ! call Agrif_GlobalToLocalBounds(parentarray, & 356 ! lowerbound, upperbound, & 357 ! indminglob2, indmaxglob2, coords,& 358 ! nbdim, local_proc, member,check_perio=.TRUE.) 359 ! if (agrif_debug_interp) then 360 ! do i=1,nbdim 361 ! print *,'parentarray = ',i,parentarray(i,1,1),parentarray(i,2,1), & 362 ! parentarray(i,1,2),parentarray(i,2,2) 363 ! enddo 364 ! endif 365 ! endif 366 367 allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2)) 368 do j=1,nb_chunks 369 if (agrif_debug_interp) print *,'CHUNK = ',j 370 if (member_chuncks(j)) then 371 ! call Agrif_GlobalToLocalBounds(parentarray_chunk(j,:,:,:), & 372 ! lowerbound, upperbound, & 373 ! indminglob2_chunks(j,:), indmaxglob2_chunks(j,:), coords, & 374 ! nbdim, local_proc, member_chuncks(j),check_perio=.TRUE.) 375 376 call Agrif_GlobalToLocalBounds(parentarray_chunk(j,:,:,:), & 377 lowerbound, upperbound, & 378 indminglob2_chunks(j,:), indmaxglob2_chunks(j,:), coords, & 379 nbdim, local_proc, member_chuncks(j)) 380 381 if (correction_required(j)) then 382 do i=1,2 383 test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 384 parentarray_chunk(j,i,1,1),i) 385 test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 386 parentarray_chunk(j,i,2,1),i) 387 parentarray_chunk_decal(j,i,1,1)=minval(test_orientation) 388 parentarray_chunk_decal(j,i,2,1)=maxval(test_orientation) 389 enddo 390 do i=3,nbdim 391 parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)+decal_chunks(j,i) 392 enddo 393 else 394 do i=1,nbdim 395 parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)+decal_chunks(j,i) 396 enddo 397 endif 398 399 if (agrif_debug_interp) then 400 do i=1,nbdim 401 print *,'parentarray = ',i,parentarray_chunk(j,i,1,1),parentarray_chunk(j,i,2,1), & 402 parentarray_chunk(j,i,1,2),parentarray_chunk(j,i,2,2) 403 print *,'parentarraydecal = ',i,parentarray_chunk_decal(j,i,1,1),parentarray_chunk_decal(j,i,2,1) 404 enddo 405 endif 406 endif 407 enddo 408 409 parentarray(:,1,:)=Huge(1) 410 parentarray(:,2,:)=-Huge(1) 411 indminglob2=Huge(1) 412 indmaxglob2=-Huge(1) 413 indminglob3=Huge(1) 414 indmaxglob3=-Huge(1) 415 member = .FALSE. 416 do j=1,nb_chunks 417 if (member_chuncks(j)) then 418 do i=1,nbdim 419 parentarray(i,1,1) = min(parentarray(i,1,1),parentarray_chunk_decal(j,i,1,1)) 420 parentarray(i,1,2) = min(parentarray(i,1,2),parentarray_chunk(j,i,1,2)) 421 parentarray(i,2,1) = max(parentarray(i,2,1),parentarray_chunk_decal(j,i,2,1)) 422 parentarray(i,2,2) = max(parentarray(i,2,2),parentarray_chunk(j,i,2,2)) 423 enddo 424 if (correction_required(j)) then 425 if (agrif_debug_interp) then 426 do i=1,nbdim 427 print *,'direction ',i 428 print *,'glob2_chuk = ',indminglob2_chunks(j,i),indmaxglob2_chunks(j,i) 429 print *,'glob3_chuk = ',indminglob3_chunks(j,i),indmaxglob3_chunks(j,i) 430 enddo 431 endif 432 do i=1,2 433 test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 434 indminglob2_chunks(j,i),i) 435 test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 436 indmaxglob2_chunks(j,i),i) 437 indminglob2(i)=min(indminglob2(i),minval(test_orientation)) 438 indmaxglob2(i)=max(indmaxglob2(i),maxval(test_orientation)) 439 enddo 440 441 do i=1,2 442 test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 443 indminglob3_chunks(j,i),i) 444 test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 445 indmaxglob3_chunks(j,i),i) 446 indminglob3(i)=min(indminglob3(i),minval(test_orientation)) 447 indmaxglob3(i)=max(indmaxglob3(i),maxval(test_orientation)) 448 enddo 449 450 do i=3,nbdim 451 indminglob2(i)=min(indminglob2(i),indminglob2_chunks(j,i)+decal_chunks(j,i)) 452 indmaxglob2(i)=max(indmaxglob2(i),indmaxglob2_chunks(j,i)+decal_chunks(j,i)) 453 indminglob3(i)=min(indminglob3(i),indminglob3_chunks(j,i)+decal_chunks(j,i)) 454 indmaxglob3(i)=max(indmaxglob3(i),indmaxglob3_chunks(j,i)+decal_chunks(j,i)) 455 enddo 456 else 457 do i=1,nbdim 458 indminglob2(i)=min(indminglob2(i),indminglob2_chunks(j,i)+decal_chunks(j,i)) 459 indmaxglob2(i)=max(indmaxglob2(i),indmaxglob2_chunks(j,i)+decal_chunks(j,i)) 460 indminglob3(i)=min(indminglob3(i),indminglob3_chunks(j,i)+decal_chunks(j,i)) 461 indmaxglob3(i)=max(indmaxglob3(i),indmaxglob3_chunks(j,i)+decal_chunks(j,i)) 462 enddo 463 endif 464 465 member = .TRUE. 466 endif 467 enddo 215 468 216 469 call Agrif_ParentGrid_to_ChildGrid() 470 471 if (agrif_debug_interp) then 472 print *,'************ FINAL PARENTARRAY *****************' 473 #ifdef AGRIF_MPI 474 print *,'Processeur ',Agrif_Procrank,' MEMBER = ',member 475 do i=1,nbdim 476 print *,'Direction ',i,' indices debut = ',parentarray(i,1,1),parentarray(i,1,2) 477 print *,'Direction ',i,' indices fin = ',parentarray(i,2,1),parentarray(i,2,2) 478 enddo 479 #endif 480 endif 481 482 if (agrif_debug_interp) then 483 print *,'************ FINAL INDMINGLOB *****************' 484 #ifdef AGRIF_MPI 485 print *,'Processeur ',Agrif_Procrank,' MEMBER = ',member 486 do i=1,nbdim 487 print *,'Direction ',i,' indices debut = ',indminglob2(i),indminglob3(i) 488 print *,'Direction ',i,' indices fin = ',indmaxglob2(i),indmaxglob3(i) 489 enddo 490 #endif 491 endif 492 217 493 #else 218 494 parentarray(:,1,1) = indminglob … … 220 496 parentarray(:,1,2) = indminglob 221 497 parentarray(:,2,2) = indmaxglob 498 499 500 if (associated(agrif_external_mapping)) then 501 call Agrif_ChildGrid_to_ParentGrid() 502 call agrif_external_mapping(nbdim,child%root_var % posvar(1),child%root_var % posvar(2), & 503 parentarray,parentarray_chunk,correction_required,nb_chunks) 504 call Agrif_ParentGrid_to_ChildGrid() 505 allocate(decal_chunks(nb_chunks,nbdim)) 506 do i=1,nb_chunks 507 decal_chunks(i,:)=parentarray_chunk(i,:,1,1)-parentarray_chunk(i,:,1,2) 508 enddo 509 else 510 nb_chunks=1 511 allocate(correction_required(nb_chunks)) 512 correction_required=.FALSE. 513 allocate(parentarray_chunk(nb_chunks,nbdim,2,2)) 514 parentarray_chunk(1,:,:,:)=parentarray 515 endif 516 if (agrif_debug_interp) then 517 print *,'AVANT PARENTCHILDBOUNDS' 518 print *,'nombre de chunks ',nb_chunks 519 do i=1,nb_chunks 520 print *,'CHUNK Number : ',i 521 do j=1,nbdim 522 print *,'Direction ',j 523 print *,'MIN MAX (2) = ',parentarray_chunk(i,j,1,2),parentarray_chunk(i,j,2,2) 524 print *,'MIN MAX (1) = ',parentarray_chunk(i,j,1,1),parentarray_chunk(i,j,2,1) 525 enddo 526 enddo 527 print *,'APRES PARENTCHILDBOUNDS' 528 endif 529 allocate(member_chuncks(nb_chunks)) 530 allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2)) 531 member_chuncks = .TRUE. 532 member = .TRUE. 533 do j=1,nb_chunks 534 if (agrif_debug_interp) print *,'CHUNK = ',j 535 if (member_chuncks(j)) then 536 do i=1,nbdim 537 parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1) !+decal_chunks(j,i) 538 if (agrif_debug_interp) then 539 print *,'ENCORE = ',parentarray_chunk(j,i,:,1),parentarray_chunk_decal(j,i,:,1) 540 endif 541 enddo 542 if (agrif_debug_interp) then 543 do i=1,nbdim 544 print *,'parentarray = ',i,parentarray_chunk(j,i,1,1),parentarray_chunk(j,i,2,1), & 545 parentarray_chunk(j,i,1,2),parentarray_chunk(j,i,2,2) 546 print *,'parentarraydecal = ',i,parentarray_chunk_decal(j,i,1,1),parentarray_chunk_decal(j,i,2,1) 547 enddo 548 endif 549 endif 550 enddo 551 552 222 553 indmin = indminglob 223 554 indmax = indmaxglob 224 555 member = .TRUE. 225 556 #endif 557 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 558 ! Correct for non refined directions 559 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 560 do i=1,nbdim 561 if (coords(i) == 0) then 562 indmin(i) = indminglob(i) 563 indmax(i) = indmaxglob(i) 564 pttruetab(i) = indminglob(i) 565 cetruetab(i) = indmaxglob(i) 566 endif 567 enddo 226 568 227 569 else … … 241 583 s_Child_temp = s_Child + (pttab - pttab_Child) * ds_Child 242 584 #endif 585 243 586 endif 587 588 if (agrif_debug_interp) then 589 print *,'************SPARENTCHILD*********************************' 590 #ifdef AGRIF_MPI 591 print *,'Processeur ',Agrif_Procrank 592 #endif 593 do i = 1 , nbdim 594 print *,'Direction ',i,' s_Parent_temp : ',s_Parent_temp(i),indmin(i) 595 print *,'Direction ',i,' s_Child_temp : ',s_Child_temp(i),pttruetab(i) 596 enddo 597 print *,'*********************************************' 598 endif 599 600 call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim) 244 601 ! 245 602 if (member) then … … 248 605 call Agrif_array_allocate(tempP,parentarray(:,1,1),parentarray(:,2,1),nbdim) 249 606 call Agrif_var_set_array_tozero(tempP,nbdim) 250 251 call Agrif_ChildGrid_to_ParentGrid() 252 ! 607 endif 608 Agrif_CurChildgrid=>Agrif_Curgrid 609 call Agrif_ChildGrid_to_ParentGrid() 610 do i=1,nb_chunks 611 if (agrif_debug_interp) then 612 print *,'PROCNAME POUR CHUCNK ',i 613 endif 614 615 if (member_chuncks(i)) then 253 616 select case (nbdim) 254 617 case(1) 255 call procname(tempP%array1, & 256 parentarray(1,1,2),parentarray(1,2,2),.TRUE.,nb,ndir) 618 ! call procname(tempP%array1, & 619 ! parentarray(1,1,2),parentarray(1,2,2),.TRUE.,nb,ndir) 620 621 call procname(tempP%array1(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1)), & 622 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),.TRUE.,nb,ndir) 623 257 624 case(2) 258 call procname(tempP%array2, & 259 parentarray(1,1,2),parentarray(1,2,2), & 260 parentarray(2,1,2),parentarray(2,2,2),.TRUE.,nb,ndir) 625 ! call procname(tempP%array2, & 626 ! parentarray(1,1,2),parentarray(1,2,2), & 627 ! parentarray(2,1,2),parentarray(2,2,2),.TRUE.,nb,ndir) 628 629 call procname(tempP%array2(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 630 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1)), & 631 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 632 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),.TRUE.,nb,ndir) 633 if (agrif_debug_interp) print *,'SORTIE DE PROCNAME' 634 if (correction_required(i)) then 635 call correct_field(tempP%array2(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 636 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1)), & 637 parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), & 638 parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)) 639 endif 640 261 641 case(3) 262 call procname(tempP%array3, & 263 parentarray(1,1,2),parentarray(1,2,2), & 264 parentarray(2,1,2),parentarray(2,2,2), & 265 parentarray(3,1,2),parentarray(3,2,2),.TRUE.,nb,ndir) 642 call procname(tempP%array3(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 643 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), & 644 parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1)), & 645 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 646 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2), & 647 parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),.TRUE.,nb,ndir) 648 649 if (agrif_debug_interp) then 650 print *,'CHUNK = ',i 651 print *,'NBNDIR = ',nb,ndir,correction_required(i) 652 print *,'TEMPARRAY3 INDEX LOCAUX PUIS GLOBAUX' 653 print *,parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1) 654 print *,parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1) 655 print *,parentarray_chunk_decal(i,3,1,1),parentarray_chunk_decal(i,3,2,1) 656 print *,parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2) 657 print *,parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2) 658 print *,parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2) 659 do j1=parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1) 660 do i1=parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1) 661 print *,'valprocname = ',i1,j1,tempP%array3(i1,j1,1) 662 enddo 663 enddo 664 endif 665 if (correction_required(i)) then 666 do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2) 667 call correct_field(tempP%array3(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 668 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k), & 669 parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), & 670 parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)) 671 enddo 672 if (agrif_debug_interp) then 673 do j1=parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1) 674 do i1=parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1) 675 print *,'valprocname apres correction = ',i1,j1,tempP%array3(i1,j1,1) 676 enddo 677 enddo 678 endif 679 endif 680 681 ! call procname(tempP%array3, & 682 ! parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 683 ! parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2), & 684 ! parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),.TRUE.,nb,ndir) 266 685 case(4) 267 call procname(tempP%array4, & 268 parentarray(1,1,2),parentarray(1,2,2), & 269 parentarray(2,1,2),parentarray(2,2,2), & 270 parentarray(3,1,2),parentarray(3,2,2), & 271 parentarray(4,1,2),parentarray(4,2,2),.TRUE.,nb,ndir) 686 687 call procname(tempP%array4(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 688 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), & 689 parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), & 690 parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1)), & 691 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 692 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2), & 693 parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2), & 694 parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2),.TRUE.,nb,ndir) 695 696 if (correction_required(i)) then 697 do l=parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2) 698 do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2) 699 call correct_field(tempP%array4(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 700 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k,l), & 701 parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), & 702 parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)) 703 enddo 704 enddo 705 endif 706 707 ! call procname(tempP%array4, & 708 ! parentarray(1,1,2),parentarray(1,2,2), & 709 ! parentarray(2,1,2),parentarray(2,2,2), & 710 ! parentarray(3,1,2),parentarray(3,2,2), & 711 ! parentarray(4,1,2),parentarray(4,2,2),.TRUE.,nb,ndir) 272 712 case(5) 273 call procname(tempP%array5, & 274 parentarray(1,1,2),parentarray(1,2,2), & 275 parentarray(2,1,2),parentarray(2,2,2), & 276 parentarray(3,1,2),parentarray(3,2,2), & 277 parentarray(4,1,2),parentarray(4,2,2), & 278 parentarray(5,1,2),parentarray(5,2,2),.TRUE.,nb,ndir) 713 714 call procname(tempP%array5(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 715 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), & 716 parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), & 717 parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1), & 718 parentarray_chunk_decal(i,5,1,1):parentarray_chunk_decal(i,5,2,1)), & 719 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 720 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2), & 721 parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2), & 722 parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2), & 723 parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2),.TRUE.,nb,ndir) 724 725 if (correction_required(i)) then 726 do m=parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2) 727 do l=parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2) 728 do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2) 729 call correct_field(tempP%array5(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 730 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k,l,m), & 731 parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), & 732 parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)) 733 enddo 734 enddo 735 enddo 736 endif 737 738 ! call procname(tempP%array5, & 739 ! parentarray(1,1,2),parentarray(1,2,2), & 740 ! parentarray(2,1,2),parentarray(2,2,2), & 741 ! parentarray(3,1,2),parentarray(3,2,2), & 742 ! parentarray(4,1,2),parentarray(4,2,2), & 743 ! parentarray(5,1,2),parentarray(5,2,2),.TRUE.,nb,ndir) 279 744 case(6) 280 call procname(tempP%array6, & 281 parentarray(1,1,2),parentarray(1,2,2), & 282 parentarray(2,1,2),parentarray(2,2,2), & 283 parentarray(3,1,2),parentarray(3,2,2), & 284 parentarray(4,1,2),parentarray(4,2,2), & 285 parentarray(5,1,2),parentarray(5,2,2), & 286 parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir) 745 746 call procname(tempP%array6(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 747 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), & 748 parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), & 749 parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1), & 750 parentarray_chunk_decal(i,5,1,1):parentarray_chunk_decal(i,5,2,1), & 751 parentarray_chunk_decal(i,6,1,1):parentarray_chunk_decal(i,6,2,1)), & 752 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 753 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2), & 754 parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2), & 755 parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2), & 756 parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2), & 757 parentarray_chunk(i,6,1,2),parentarray_chunk(i,6,2,2),.TRUE.,nb,ndir) 758 759 ! call procname(tempP%array6, & 760 ! parentarray(1,1,2),parentarray(1,2,2), & 761 ! parentarray(2,1,2),parentarray(2,2,2), & 762 ! parentarray(3,1,2),parentarray(3,2,2), & 763 ! parentarray(4,1,2),parentarray(4,2,2), & 764 ! parentarray(5,1,2),parentarray(5,2,2), & 765 ! parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir) 287 766 end select 288 767 ! 289 call Agrif_ParentGrid_to_ChildGrid()290 768 ! 291 769 endif 770 enddo 771 call Agrif_ParentGrid_to_ChildGrid() 772 nullify(Agrif_CurChildgrid) 292 773 293 774 #if defined AGRIF_MPI … … 298 779 tab3(:,3) = indmin(:) 299 780 tab3(:,4) = indmax(:) 781 tab5(:,1) = indminglob3(:) 782 tab5(:,2) = indmaxglob3(:) 783 if (agrif_debug_interp) then 784 print *,'********************' 785 print *,'MPI VARIABLES' 786 print *,'INDMINGLOB2' 787 do i=1,nbdim 788 print *,'Direction ',i,indminglob2(i),indmaxglob2(i) 789 enddo 790 print *,'INDMIN' 791 do i=1,nbdim 792 print *,'Direction ',i,indmin(i),indmax(i) 793 enddo 794 print *,'INDMINGLOB3' 795 do i=1,nbdim 796 print *,'Direction ',i,indminglob3(i),indmaxglob3(i) 797 enddo 798 endif 300 799 ! 301 800 call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code) 302 801 call MPI_ALLGATHER(tab5,2*nbdim,MPI_INTEGER,tab6,2*nbdim,MPI_INTEGER,Agrif_mpi_comm,code) 303 802 if (.not.associated(tempPextend)) allocate(tempPextend) 304 803 … … 309 808 enddo 310 809 enddo 810 enddo 811 812 do k=0,Agrif_Nbprocs-1 813 do j=1,2 814 do i=1,nbdim 815 tab5t(i,k,j) = tab6(i,j,k) 816 enddo 817 enddo 311 818 enddo 312 819 … … 319 826 sendtoproc1,recvfromproc1, & 320 827 tab4t(:,:,5),tab4t(:,:,6), & 321 tab4t(:,:,7),tab4t(:,:,8) ) 828 tab4t(:,:,7),tab4t(:,:,8), & 829 tab5t(:,:,1),tab5t(:,:,2)) 322 830 endif 323 831 … … 335 843 indminglob,indmaxglob, & 336 844 pttruetab,cetruetab, & 337 memberin,nbdim & 845 memberin,nbdim, & 846 parentarray_chunk,parentarray_chunk_decal,decal_chunks,& 847 correction_required,member_chuncks,nb_chunks & 338 848 #if defined AGRIF_MPI 339 849 ,indminglob2,indmaxglob2, & … … 391 901 ds_Child(1:2), ds_Parent(1:2) ) 392 902 case(3) 903 if (agrif_debug_interp) then 904 print *,'APRES ECHANGE' 905 print *,'nombre de chunks ',nb_chunks 906 print *,'indmin = ',indmin 907 print *,'indmax = ',indmax 908 do i=1,nb_chunks 909 print *,'CHUNK Number : ',i 910 print *,'MEMBER = ',member_chuncks(i) 911 print *,'Correction = ',correction_required(i) 912 enddo 913 endif 914 915 if (agrif_debug_interp) then 916 ! if ((nb==1).AND.(ndir==1)) then 917 print *,'valeur parent = ' 918 do j=indmin(2),indmax(2) 919 do i=indmin(1),indmax(1) 920 print *,'par = ',i,j,tempPextend%array3(i,j,1) 921 enddo 922 enddo 923 924 ! endif 925 endif 393 926 call Agrif_Interp_3D_recursive( type_interp(1:3), & 394 927 tempPextend % array3, & … … 398 931 s_Child_temp(1:3), s_Parent_temp(1:3), & 399 932 ds_Child(1:3), ds_Parent(1:3) ) 933 if (agrif_debug_interp) then 934 ! if ((nb==1).AND.(ndir==1)) then 935 print *,'valeur enfnat = ' 936 do j=pttruetab(2),cetruetab(2) 937 do i=pttruetab(1),cetruetab(1) 938 print *,'par = ',i,j,tempC%array3(i,j,1) 939 enddo 940 enddo 941 942 ! endif 943 endif 400 944 case(4) 401 945 call Agrif_Interp_4D_recursive( type_interp(1:4), & … … 676 1220 childarray(2,1,1):childarray(2,2,1), & 677 1221 childarray(3,1,1):childarray(3,2,1)) 1222 if (agrif_debug_interp) then 1223 if ((nb==1).AND.(ndir==1)) then 1224 print *,'valeur enfnat2 = ' 1225 do j=childarray(2,1,2),childarray(2,2,2) 1226 do i=childarray(1,1,2),childarray(1,2,2) 1227 print *,'par = ',i,j,parray3(i,j,1) 1228 enddo 1229 enddo 1230 1231 endif 1232 endif 678 1233 case (4) 679 1234 parray4(childarray(1,1,2):childarray(1,2,2), & … … 723 1278 #if defined AGRIF_MPI 724 1279 if (member) then 1280 if (agrif_debug_interp) then 1281 print *,'ALLCOATED 0 = ',allocated(tempP%array3),size(tempP%array3) 1282 endif 725 1283 call Agrif_array_deallocate(tempP,nbdim) 726 1284 endif … … 774 1332 indmin(i) = indmin(i) - 2 775 1333 indmax(i) = indmax(i) + 2 776 777 if (Agrif_UseSpecialValue) then778 indmin(i) = indmin(i)-MaxSearch779 indmax(i) = indmax(i)+MaxSearch780 endif781 782 1334 elseif ( (type_interp(i) /= Agrif_constant) .and. & 783 1335 (type_interp(i) /= Agrif_linear) ) then 784 1336 indmin(i) = indmin(i) - 1 785 1337 indmax(i) = indmax(i) + 1 786 787 if (Agrif_UseSpecialValue) then788 indmin(i) = indmin(i)-MaxSearch789 indmax(i) = indmax(i)+MaxSearch790 endif791 792 elseif ( (type_interp(i) == Agrif_constant) .or. &793 (type_interp(i) == Agrif_linear) ) then794 if (Agrif_UseSpecialValue) then795 indmin(i) = indmin(i)-MaxSearch796 indmax(i) = indmax(i)+MaxSearch797 endif798 799 1338 endif 800 1339 ! … … 1372 1911 function Agrif_Find_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent, & 1373 1912 nbdim, indmin, indmax, indminglob, indmaxglob, & 1374 pttruetab, cetruetab, memberin & 1913 pttruetab, cetruetab, memberin, & 1914 parentarray_chunk,parentarray_chunk_decal,decal_chunks, & 1915 correction_required,member_chuncks,nb_chunks & 1375 1916 #if defined AGRIF_MPI 1376 1917 ,indminglob2, indmaxglob2, parentarray, & … … 1386 1927 integer, dimension(nbdim), intent(out) :: pttruetab, cetruetab 1387 1928 logical, intent(out) :: memberin 1929 integer :: nb_chunks 1930 integer, dimension(:,:,:,:), allocatable :: parentarray_chunk 1931 integer, dimension(:,:,:,:), allocatable :: parentarray_chunk_decal 1932 integer, dimension(:,:),allocatable :: decal_chunks 1933 logical, dimension(:),allocatable :: correction_required 1934 logical, dimension(:),allocatable :: member_chuncks 1388 1935 #if defined AGRIF_MPI 1389 1936 integer, dimension(nbdim), intent(out) :: indminglob2, indmaxglob2 … … 1441 1988 #endif 1442 1989 memberin = pil % memberin 1990 1991 ! chunks 1992 nb_chunks = pil % nb_chunks 1993 Allocate(parentarray_chunk(nb_chunks,nbdim,2,2)) 1994 parentarray_chunk = pil % parentarray_chunk 1995 Allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2)) 1996 parentarray_chunk_decal = pil % parentarray_chunk_decal 1997 Allocate(correction_required(nb_chunks)) 1998 correction_required = pil % correction_required 1999 Allocate(decal_chunks(nb_chunks,nbdim)) 2000 decal_chunks = pil % decal_chunks 2001 Allocate(member_chuncks(nb_chunks)) 2002 member_chuncks = pil % member_chuncks 2003 1443 2004 find_list_interp = .true. 1444 2005 exit find_loop … … 1454 2015 indmin, indmax, indminglob, indmaxglob, & 1455 2016 pttruetab, cetruetab, & 1456 memberin, nbdim & 2017 memberin, nbdim, & 2018 parentarray_chunk,parentarray_chunk_decal,decal_chunks, & 2019 correction_required,member_chuncks,nb_chunks & 1457 2020 #if defined AGRIF_MPI 1458 2021 ,indminglob2, indmaxglob2, & … … 1470 2033 integer, dimension(nbdim) :: pttruetab, cetruetab 1471 2034 logical :: memberin 2035 integer :: nb_chunks 2036 integer, dimension(:,:,:,:), allocatable :: parentarray_chunk 2037 integer, dimension(:,:,:,:), allocatable :: parentarray_chunk_decal 2038 integer, dimension(:,:),allocatable :: decal_chunks 2039 logical, dimension(:),allocatable :: correction_required 2040 logical, dimension(:),allocatable :: member_chuncks 1472 2041 #if defined AGRIF_MPI 1473 2042 integer, dimension(nbdim,2,2) :: parentarray … … 1518 2087 pil % cetruetab(1:nbdim) = cetruetab(1:nbdim) 1519 2088 2089 ! chunks 2090 pil % nb_chunks = nb_chunks 2091 allocate(pil % parentarray_chunk(nb_chunks,nbdim,2,2)) 2092 allocate(pil % parentarray_chunk_decal(nb_chunks,nbdim,2,2)) 2093 allocate(pil % correction_required(nb_chunks)) 2094 allocate(pil % decal_chunks(nb_chunks,nbdim)) 2095 allocate(pil % member_chuncks(nb_chunks)) 2096 2097 pil % parentarray_chunk = parentarray_chunk 2098 pil % parentarray_chunk_decal = parentarray_chunk_decal 2099 pil % correction_required = correction_required 2100 pil % decal_chunks = decal_chunks 2101 pil % member_chuncks = member_chuncks 2102 2103 1520 2104 parcours % suiv => list_interp 1521 2105 list_interp => parcours
Note: See TracChangeset
for help on using the changeset viewer.
