- 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/modupdate.F90
r5656 r13027 279 279 real, dimension(nbdim), intent(in) :: ds_parent !< Space steps of the parent grid 280 280 procedure() :: procname !< Data recovery procedure 281 integer, dimension(6) :: loctab_child ! Indicates if the child grid has a common border 282 ! with the root grid 283 type(Agrif_Variable), pointer :: root_var ! Variable on the root grid 281 284 ! 282 285 integer,dimension(nbdim) :: type_update ! Type of update (copy or average) … … 288 291 integer :: nb, ndir 289 292 integer :: coeffraf 290 ! 293 integer :: n 294 ! 295 root_var => child % root_var 296 loctab_child(1:nbdim) = 0 297 ! 298 do n = 1,nbdim 299 ! 300 select case(root_var % interptab(n)) 301 ! 302 case('x') ! x DIMENSION 303 ! 304 if (Agrif_Curgrid % NearRootBorder(1)) loctab_child(n) = -1 305 if (Agrif_Curgrid % DistantRootBorder(1)) loctab_child(n) = -2 306 if ((Agrif_Curgrid % NearRootBorder(1)) .AND. & 307 (Agrif_Curgrid % DistantRootBorder(1))) loctab_child(n) = -3 308 ! 309 case('y') ! y DIMENSION 310 ! 311 if (Agrif_Curgrid % NearRootBorder(2)) loctab_child(n) = -1 312 if (Agrif_Curgrid % DistantRootBorder(2)) loctab_child(n) = -2 313 if ((Agrif_Curgrid % NearRootBorder(2)) .AND. & 314 (Agrif_Curgrid % DistantRootBorder(2))) loctab_child(n) = -3 315 ! 316 case('z') ! z DIMENSION 317 ! 318 if (Agrif_Curgrid % NearRootBorder(3)) loctab_child(n) = -1 319 if (Agrif_Curgrid % DistantRootBorder(3)) loctab_child(n) = -2 320 if ((Agrif_Curgrid % NearRootBorder(3)) .AND. & 321 (Agrif_Curgrid % DistantRootBorder(3))) loctab_child(n) = -3 322 ! 323 case('N') ! No space DIMENSION 324 ! 325 loctab_child(n) = -3 326 ! 327 end select 328 ! 329 enddo 330 291 331 type_update = child % root_var % type_update(1:nbdim) 292 332 ! … … 330 370 if ( do_update(nb) ) then 331 371 do ndir = 1,2 372 if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 332 373 ptres(nb,1,ndir,nb) = indtruetab(nb,ndir,1) 333 374 ptres(nb,2,ndir,nb) = indtruetab(nb,ndir,2) … … 348 389 endif 349 390 enddo 391 endif 350 392 enddo 351 393 endif … … 355 397 if ( do_update(nb) ) then 356 398 do ndir = 1,2 399 if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 357 400 call Agrif_UpdatenD(type_update, parent, child, & 358 401 ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb), & … … 364 407 #endif 365 408 nbdim,procname,nb,ndir) 409 endif 366 410 enddo 367 411 endif … … 390 434 #endif 391 435 ! 392 integer, dimension(6), intent(in) :: type_update !< Type of update (copy or average)393 436 type(Agrif_Variable), pointer :: parent !< Variable of the parent grid 394 437 type(Agrif_Variable), pointer :: child !< Variable of the child grid 395 438 integer, intent(in) :: nbdim 439 integer, dimension(nbdim), intent(in) :: type_update !< Type of update (copy or average) 396 440 integer, dimension(nbdim), intent(in) :: pttab !< Index of the first point inside the domain 397 441 integer, dimension(nbdim), intent(in) :: petab !< Index of the first point inside the domain … … 423 467 logical :: memberin, member 424 468 integer :: nbin, ndirin 469 integer :: i, j,k,l,m 470 LOGICAL,DIMENSION(:),ALLOCATABLE :: member_chuncks 471 INTEGER,DIMENSION(:,:),ALLOCATABLE :: decal_chunks 472 INTEGER :: agrif_external_switch_index 473 INTEGER, DIMENSION(2) :: test_orientation 425 474 ! 426 475 #if defined AGRIF_MPI 427 476 ! 428 477 integer,dimension(nbdim) :: indminglob2,indmaxglob2 478 INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob_chunks, indmaxglob_chunks 479 INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob2_chunks,indmaxglob2_chunks 480 INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob3_chunks,indmaxglob3_chunks 429 481 logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 430 482 logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2 431 483 integer :: code, local_proc 432 integer :: i,j,k433 484 integer, dimension(nbdim,4) :: tab3 434 485 integer, dimension(nbdim,4,0:Agrif_Nbprocs-1) :: tab4 … … 444 495 type(Agrif_Variable), pointer, save :: tempP => NULL() ! Temporary parent grid variable 445 496 type(Agrif_Variable), pointer, save :: tempCextend => NULL() ! Temporary child 497 446 498 type(Agrif_Variable), pointer, save :: tempPextend => NULL() ! Temporary parent 499 type(Agrif_Variable), pointer, save :: tempPextend_chunk => NULL() ! Temporary parent 447 500 type(Agrif_Variable), pointer :: tempP_indic, tempP_average 448 501 type(Agrif_Variable), pointer :: tempC_indic … … 450 503 real :: coeff_multi 451 504 integer :: nb_dimensions 505 506 ! CHUNK (e.g. periodicity) 507 508 INTEGER :: nb_chunks 509 INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: parentarray_chunk 510 INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: parentarray_chunk_decal 511 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: bounds_chunks 512 logical,dimension(:),allocatable :: correction_required 513 ! 514 452 515 ! 453 516 ! Get local lower and upper bound of the child variable … … 459 522 coords = child % root_var % coords 460 523 ! 524 461 525 call Agrif_Childbounds( nbdim, lowerbound, upperbound, pttab, petab, Agrif_Procrank, & 462 526 coords, pttruetab, cetruetab, memberin ) 527 528 if (agrif_debug_update) then 529 print *,'************CHILDBOUNDS*********************************' 530 #ifdef AGRIF_MPI 531 print *,'Processeur ',Agrif_Procrank 532 #endif 533 print *,'memberin ',memberin 534 do i = 1 , nbdim 535 print *,'Direction ',i,' indices debut: ',pttab(i),pttruetab(i) 536 print *,'Direction ',i,' indices fin : ',petab(i),cetruetab(i) 537 enddo 538 print *,'*********************************************' 539 endif 540 463 541 call Agrif_Prtbounds( nbdim, indminglob, indmaxglob, s_Parent_temp, s_Child_temp, & 464 542 s_child, ds_child, s_parent, ds_parent, & … … 469 547 ) 470 548 549 if (agrif_debug_update) then 550 print *,'************PRTBOUNDS*********************************' 551 #ifdef AGRIF_MPI 552 print *,'Processeur ',Agrif_Procrank 553 #endif 554 do i = 1 , nbdim 555 print *,'Direction ',i,' indminglob : ',indminglob(i) 556 print *,'Direction ',i,' indmaxglob : ',indmaxglob(i) 557 enddo 558 559 do i = 1 , nbdim 560 print *,'Direction ',i,' s_Parent_temp : ',s_Parent_temp(i) 561 print *,'Direction ',i,' s_Child_temp : ',s_Child_temp(i) 562 enddo 563 print *,'*********************************************' 564 endif 565 471 566 #if defined AGRIF_MPI 472 567 ! … … 476 571 nbdim, Agrif_Procrank, member) 477 572 ENDIF 573 574 if (agrif_debug_update) then 575 print *,'************GlobalToLocalBounds******************' 576 #ifdef AGRIF_MPI 577 print *,'Processeur ',Agrif_Procrank 578 #endif 579 do i = 1 , nbdim 580 print *,'Direction ',i,' childarray global : ',childarray(i,1,1),childarray(i,2,1) 581 print *,'Direction ',i,' childarray local : ',childarray(i,1,2),childarray(i,2,2) 582 enddo 583 584 print *,'*********************************************' 585 endif 478 586 479 587 call Agrif_Prtbounds(nbdim, indmin, indmax, & … … 483 591 posvar, type_update, do_update, & 484 592 pttruetabwhole, cetruetabwhole) 593 594 if (agrif_debug_update) then 595 print *,'************PRTBOUNDS II *********************************' 596 #ifdef AGRIF_MPI 597 print *,'Processeur ',Agrif_Procrank 598 #endif 599 do i = 1 , nbdim 600 print *,'Direction ',i,' indmin : ',indmin(i) 601 print *,'Direction ',i,' indmax : ',indmax(i) 602 enddo 603 604 do i = 1 , nbdim 605 print *,'Direction ',i,' s_Parent_temp : ',s_Parent_temp(i) 606 print *,'Direction ',i,' s_Child_temp : ',s_Child_temp(i) 607 enddo 608 print *,'*********************************************' 609 endif 485 610 ! 486 611 #else … … 582 707 nbdim, memberinall, coords, & 583 708 sendtoproc1,recvfromproc1, & 584 tab4t(:,:,5),tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8)) 709 tab4t(:,:,5),tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8), & 710 tab4t(:,:,1),tab4t(:,:,2)) 585 711 endif 586 712 … … 610 736 s_Child_temp(1), s_Parent_temp(1), & 611 737 ds_child(1), ds_parent(1) ) 612 738 613 739 IF (Agrif_UseSpecialValueInUpdate) THEN 614 740 allocate(tempC_indic) … … 638 764 enddo 639 765 ENDIF 640 766 641 767 WHERE (tempCextend%array1 == Agrif_SpecialValueFineGrid) 642 768 tempC_indic%array1 = 0. … … 644 770 tempC_indic%array1 = 1. 645 771 END WHERE 646 772 647 773 Agrif_UseSpecialValueInUpdate = .FALSE. 648 774 Agrif_Update_Weights = .TRUE. 649 775 650 776 call Agrif_Update_1D_Recursive( type_update_temp(1), & 651 777 tempP_indic%array1, & … … 675 801 END WHERE 676 802 ENDIF 677 803 678 804 deallocate(tempP_indic%array1) 679 805 deallocate(tempC_indic%array1) … … 685 811 ENDIF 686 812 ENDIF 687 813 688 814 endif 689 815 if ( nbdim == 2 ) then … … 701 827 call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array2),ubound(tempCextend%array2),nbdim) 702 828 call Agrif_array_allocate(tempP_indic,lbound(tempP%array2),ubound(tempP%array2),nbdim) 703 829 704 830 compute_average = .FALSE. 705 831 type_update_temp(1:nbdim) = type_update(1:nbdim) … … 723 849 enddo 724 850 ENDIF 725 851 726 852 WHERE (tempCextend%array2 == Agrif_SpecialValueFineGrid) 727 853 tempC_indic%array2 = 0. … … 729 855 tempC_indic%array2 = 1. 730 856 END WHERE 731 857 732 858 Agrif_UseSpecialValueInUpdate = .FALSE. 733 859 Agrif_Update_Weights = .TRUE. 734 860 735 861 call Agrif_Update_2D_Recursive( type_update_temp(1:2), & 736 862 tempP_indic%array2, & … … 760 886 END WHERE 761 887 ENDIF 762 888 763 889 deallocate(tempP_indic%array2) 764 890 deallocate(tempC_indic%array2) … … 770 896 ENDIF 771 897 ENDIF 772 898 773 899 endif 774 900 if ( nbdim == 3 ) then … … 780 906 s_Child_temp(1:3), s_Parent_temp(1:3), & 781 907 ds_child(1:3), ds_parent(1:3) ) 782 908 783 909 IF (Agrif_UseSpecialValueInUpdate) THEN 784 910 allocate(tempC_indic) … … 808 934 enddo 809 935 ENDIF 810 936 811 937 WHERE (tempCextend%array3 == Agrif_SpecialValueFineGrid) 812 938 tempC_indic%array3 = 0. … … 814 940 tempC_indic%array3 = 1. 815 941 END WHERE 816 942 817 943 Agrif_UseSpecialValueInUpdate = .FALSE. 818 944 Agrif_Update_Weights = .TRUE. 819 945 820 946 call Agrif_Update_3D_Recursive( type_update_temp(1:3), & 821 947 tempP_indic%array3, & … … 845 971 END WHERE 846 972 ENDIF 847 973 848 974 deallocate(tempP_indic%array3) 849 975 deallocate(tempC_indic%array3) … … 855 981 ENDIF 856 982 ENDIF 857 983 858 984 endif 859 985 if ( nbdim == 4 ) then … … 865 991 s_Child_temp(1:4), s_Parent_temp(1:4), & 866 992 ds_child(1:4), ds_parent(1:4) ) 867 993 868 994 IF (Agrif_UseSpecialValueInUpdate) THEN 869 995 870 996 allocate(tempC_indic) 871 997 allocate(tempP_indic) 872 998 call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array4),ubound(tempCextend%array4),nbdim) 873 999 call Agrif_array_allocate(tempP_indic,lbound(tempP%array4),ubound(tempP%array4),nbdim) 874 1000 875 1001 compute_average = .FALSE. 876 1002 type_update_temp(1:nbdim) = type_update(1:nbdim) … … 894 1020 enddo 895 1021 ENDIF 896 1022 897 1023 WHERE (tempCextend%array4 == Agrif_SpecialValueFineGrid) 898 1024 tempC_indic%array4 = 0. … … 900 1026 tempC_indic%array4 = 1. 901 1027 END WHERE 902 1028 903 1029 Agrif_UseSpecialValueInUpdate = .FALSE. 904 1030 Agrif_Update_Weights = .TRUE. 905 1031 906 1032 call Agrif_Update_4D_Recursive( type_update_temp(1:4), & 907 1033 tempP_indic%array4, & … … 914 1040 Agrif_UseSpecialValueInUpdate = .TRUE. 915 1041 Agrif_Update_Weights = .FALSE. 916 1042 917 1043 IF (compute_average) THEN 918 1044 WHERE (tempP_indic%array4 == 0.) … … 940 1066 ENDIF 941 1067 ENDIF 942 1068 943 1069 endif 944 1070 if ( nbdim == 5 ) then … … 950 1076 s_Child_temp(1:5), s_Parent_temp(1:5), & 951 1077 ds_child(1:5), ds_parent(1:5) ) 952 1078 953 1079 IF (Agrif_UseSpecialValueInUpdate) THEN 954 1080 allocate(tempC_indic) … … 978 1104 enddo 979 1105 ENDIF 980 1106 981 1107 WHERE (tempCextend%array5 == Agrif_SpecialValueFineGrid) 982 1108 tempC_indic%array5 = 0. … … 984 1110 tempC_indic%array5 = 1. 985 1111 END WHERE 986 1112 987 1113 Agrif_UseSpecialValueInUpdate = .FALSE. 988 1114 Agrif_Update_Weights = .TRUE. 989 1115 990 1116 call Agrif_Update_5D_Recursive( type_update_temp(1:5), & 991 1117 tempP_indic%array5, & … … 1015 1141 END WHERE 1016 1142 ENDIF 1017 1143 1018 1144 deallocate(tempP_indic%array5) 1019 1145 deallocate(tempC_indic%array5) … … 1025 1151 ENDIF 1026 1152 ENDIF 1027 1153 1028 1154 endif 1029 1155 if ( nbdim == 6 ) then … … 1080 1206 END WHERE 1081 1207 ENDIF 1082 1208 1083 1209 Agrif_UseSpecialValueInUpdate = .FALSE. 1084 1210 Agrif_Update_Weights = .TRUE. 1085 1211 1086 1212 call Agrif_Update_6D_Recursive( type_update_temp(1:6), & 1087 1213 tempP_indic%array6, & … … 1094 1220 Agrif_UseSpecialValueInUpdate = .TRUE. 1095 1221 Agrif_Update_Weights = .FALSE. 1096 1222 1097 1223 WHERE (tempP_indic%array6 == 0.) 1098 1224 tempP%array6 = Agrif_SpecialValueFineGrid … … 1100 1226 tempP%array6 = tempP%array6 /tempP_indic%array6 1101 1227 END WHERE 1102 1228 1103 1229 deallocate(tempP_indic%array6) 1104 1230 deallocate(tempC_indic%array6) … … 1116 1242 ENDIF 1117 1243 1244 if (agrif_debug_update .and. nbdim==2) then 1245 print *,'MINMAXUPDATE = ',minval(tempP%array2),maxval(tempP%array2) 1246 endif 1247 1118 1248 #if defined AGRIF_MPI 1119 1249 local_proc = Agrif_Procrank 1120 1250 call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim) 1121 1251 call Agrif_ChildGrid_to_ParentGrid() 1122 call Agrif_Childbounds(nbdim, lowerbound, upperbound, & 1123 indminglob, indmaxglob, local_proc, coords, & 1124 indminglob2, indmaxglob2, member) 1125 ! 1126 IF (member) THEN 1127 call Agrif_GlobalToLocalBounds(parentarray, lowerbound, upperbound, & 1128 indminglob2, indmaxglob2, coords, & 1129 nbdim, local_proc, member) 1130 ENDIF 1131 1132 call Agrif_ParentGrid_to_ChildGrid() 1252 1253 parentarray(:,1,1) = indminglob 1254 parentarray(:,2,1) = indmaxglob 1255 parentarray(:,1,2) = indminglob 1256 parentarray(:,2,2) = indmaxglob 1257 if (associated(agrif_external_mapping)) then 1258 call agrif_external_mapping(nbdim,child%root_var % posvar(1),child%root_var % posvar(2), & 1259 parentarray,parentarray_chunk,correction_required,nb_chunks) 1260 allocate(decal_chunks(nb_chunks,nbdim)) 1261 do i=1,nb_chunks 1262 decal_chunks(i,:)=parentarray_chunk(i,:,1,1)-parentarray_chunk(i,:,1,2) 1263 enddo 1264 else 1265 nb_chunks=1 1266 allocate(correction_required(nb_chunks)) 1267 correction_required=.FALSE. 1268 allocate(parentarray_chunk(nb_chunks,nbdim,2,2)) 1269 parentarray_chunk(1,:,:,:)=parentarray 1270 allocate(decal_chunks(nb_chunks,nbdim)) 1271 decal_chunks=0 1272 endif 1273 if (agrif_debug_update) then 1274 print *,'AVANT PARENTCHILDBOUNDS' 1275 print *,'nombre de chunks ',nb_chunks 1276 do i=1,nb_chunks 1277 print *,'CHUNK Number : ',i 1278 do j=1,nbdim 1279 print *,'Direction ',j 1280 print *,'MIN MAX (2) = ',parentarray_chunk(i,j,1,2),parentarray_chunk(i,j,2,2) 1281 print *,'MIN MAX (1) = ',parentarray_chunk(i,j,1,1),parentarray_chunk(i,j,2,1) 1282 enddo 1283 enddo 1284 print *,'APRES PARENTCHILDBOUNDS' 1285 endif 1286 1287 allocate(indminglob_chunks(nb_chunks,nbdim)) 1288 allocate(indmaxglob_chunks(nb_chunks,nbdim)) 1289 allocate(indminglob2_chunks(nb_chunks,nbdim)) 1290 allocate(indmaxglob2_chunks(nb_chunks,nbdim)) 1291 allocate(indminglob3_chunks(nb_chunks,nbdim)) 1292 allocate(indmaxglob3_chunks(nb_chunks,nbdim)) 1293 allocate(member_chuncks(nb_chunks)) 1294 1295 do i=1,nb_chunks 1296 indminglob_chunks(i,:) = parentarray_chunk(i,:,1,2) 1297 indmaxglob_chunks(i,:) = parentarray_chunk(i,:,2,2) 1298 enddo 1299 1300 do i=1,nb_chunks 1301 call Agrif_Childbounds(nbdim,lowerbound,upperbound, & 1302 indminglob_chunks(i,:),indmaxglob_chunks(i,:), local_proc, coords, & 1303 indminglob2_chunks(i,:),indmaxglob2_chunks(i,:),member_chuncks(i)) 1304 enddo 1305 1306 if (agrif_debug_update) then 1307 print *,'************CHILDBOUNDSPARENTMPI*********************************' 1308 #ifdef AGRIF_MPI 1309 print *,'Processeur ',Agrif_Procrank 1310 #endif 1311 do j=1,nb_chunks 1312 print *,'Chunk number ',j 1313 1314 do i = 1 , nbdim 1315 print *,'Direction ',i,' indices debut: ',indminglob_chunks(j,i),indminglob2_chunks(j,i) 1316 print *,'Direction ',i,' indices fin : ',indmaxglob_chunks(j,i),indmaxglob2_chunks(j,i) 1317 enddo 1318 enddo 1319 print *,'*********************************************' 1320 endif 1321 1322 allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2)) 1323 do j=1,nb_chunks 1324 if (agrif_debug_update) print *,'CHUNK = ',j 1325 if (member_chuncks(j)) then 1326 ! call Agrif_GlobalToLocalBounds(parentarray_chunk(j,:,:,:), & 1327 ! lowerbound, upperbound, & 1328 ! indminglob2_chunks(j,:), indmaxglob2_chunks(j,:), coords, & 1329 ! nbdim, local_proc, member_chuncks(j),check_perio=.TRUE.) 1330 1331 call Agrif_GlobalToLocalBounds(parentarray_chunk(j,:,:,:), & 1332 lowerbound, upperbound, & 1333 indminglob2_chunks(j,:), indmaxglob2_chunks(j,:), coords, & 1334 nbdim, local_proc, member_chuncks(j)) 1335 1336 if (correction_required(j)) then 1337 do i=1,2 1338 test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 1339 parentarray_chunk(j,i,1,1),i) 1340 test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 1341 parentarray_chunk(j,i,2,1),i) 1342 parentarray_chunk_decal(j,i,1,1)=minval(test_orientation) 1343 parentarray_chunk_decal(j,i,2,1)=maxval(test_orientation) 1344 enddo 1345 do i=3,nbdim 1346 parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)+decal_chunks(j,i) 1347 enddo 1348 else 1349 do i=1,nbdim 1350 parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)+decal_chunks(j,i) 1351 enddo 1352 endif 1353 1354 if (agrif_debug_update) then 1355 do i=1,nbdim 1356 print *,'parentarray = ',i,parentarray_chunk(j,i,1,1),parentarray_chunk(j,i,2,1), & 1357 parentarray_chunk(j,i,1,2),parentarray_chunk(j,i,2,2) 1358 print *,'parentarraydecal = ',i,parentarray_chunk_decal(j,i,1,1),parentarray_chunk_decal(j,i,2,1) 1359 enddo 1360 endif 1361 endif 1362 enddo 1363 1364 ! call Agrif_Childbounds(nbdim, lowerbound, upperbound, & 1365 ! indminglob, indmaxglob, local_proc, coords, & 1366 ! indminglob2, indmaxglob2, member) 1367 1368 ! if (agrif_debug_update) then 1369 ! print *,'************CHILDBOUNDS PARENT*********************************' 1370 ! #ifdef AGRIF_MPI 1371 ! print *,'Processeur ',Agrif_Procrank 1372 ! #endif 1373 ! print *,'member ',member 1374 ! do i = 1 , nbdim 1375 ! print *,'Direction ',i,' indminglob2 : ',indminglob2(i) 1376 ! print *,'Direction ',i,' indmaxglob2 : ',indmaxglob2(i) 1377 ! enddo 1378 ! print *,'*********************************************' 1379 ! endif 1380 ! 1381 ! IF (member) THEN 1382 ! call Agrif_GlobalToLocalBounds(parentarray, lowerbound, upperbound, & 1383 ! indminglob2, indmaxglob2, coords, & 1384 ! nbdim, local_proc, member,check_perio=.TRUE.) 1385 ! ENDIF 1386 1387 ! if (agrif_debug_update) then 1388 ! print *,'************GlobalToLocalBounds II******************' 1389 ! #ifdef AGRIF_MPI 1390 ! print *,'Processeur ',Agrif_Procrank 1391 ! #endif 1392 ! do i = 1 , nbdim 1393 ! print *,'Direction ',i,' parentarray global : ',parentarray(i,1,1),parentarray(i,2,1) 1394 ! print *,'Direction ',i,' parentarray local : ',parentarray(i,1,2),parentarray(i,2,2) 1395 ! enddo 1396 1397 ! print *,'*********************************************' 1398 ! endif 1399 1400 1401 parentarray(:,1,:)=Huge(1) 1402 parentarray(:,2,:)=-Huge(1) 1403 indminglob2=Huge(1) 1404 indmaxglob2=-Huge(1) 1405 member = .FALSE. 1406 do j=1,nb_chunks 1407 if (member_chuncks(j)) then 1408 do i=1,nbdim 1409 parentarray(i,1,1) = min(parentarray(i,1,1),parentarray_chunk_decal(j,i,1,1)) 1410 parentarray(i,1,2) = min(parentarray(i,1,2),parentarray_chunk(j,i,1,2)) 1411 parentarray(i,2,1) = max(parentarray(i,2,1),parentarray_chunk_decal(j,i,2,1)) 1412 parentarray(i,2,2) = max(parentarray(i,2,2),parentarray_chunk(j,i,2,2)) 1413 enddo 1414 1415 if (correction_required(j)) then 1416 do i=1,2 1417 test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 1418 indminglob2_chunks(j,i),i) 1419 test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), & 1420 indmaxglob2_chunks(j,i),i) 1421 indminglob2(i)=min(indminglob2(i),minval(test_orientation)) 1422 indmaxglob2(i)=max(indmaxglob2(i),maxval(test_orientation)) 1423 enddo 1424 1425 do i=3,nbdim 1426 indminglob2(i)=min(indminglob2(i),indminglob2_chunks(j,i)+decal_chunks(j,i)) 1427 indmaxglob2(i)=max(indmaxglob2(i),indmaxglob2_chunks(j,i)+decal_chunks(j,i)) 1428 enddo 1429 else 1430 do i=1,nbdim 1431 indminglob2(i)=min(indminglob2(i),indminglob2_chunks(j,i)+decal_chunks(j,i)) 1432 indmaxglob2(i)=max(indmaxglob2(i),indmaxglob2_chunks(j,i)+decal_chunks(j,i)) 1433 enddo 1434 endif 1435 1436 member = .TRUE. 1437 endif 1438 enddo 1439 1440 call Agrif_ParentGrid_to_ChildGrid() 1441 1442 if (agrif_debug_update) then 1443 print *,'************ FINAL PARENTARRAY *****************' 1444 #ifdef AGRIF_MPI 1445 print *,'Processeur ',Agrif_Procrank,' MEMBER = ',member 1446 do i=1,nbdim 1447 print *,'Direction ',i,' indices debut = ',parentarray(i,1,1),parentarray(i,1,2) 1448 print *,'Direction ',i,' indices fin = ',parentarray(i,2,1),parentarray(i,2,2) 1449 enddo 1450 #endif 1451 endif 1452 1453 if (agrif_debug_update) then 1454 print *,'************ FINAL INDMINGLOB *****************' 1455 #ifdef AGRIF_MPI 1456 print *,'Processeur ',Agrif_Procrank,' MEMBER = ',member 1457 do i=1,nbdim 1458 print *,'Direction ',i,' indices debut = ',indminglob2(i) 1459 print *,'Direction ',i,' indices fin = ',indmaxglob2(i) 1460 enddo 1461 #endif 1462 endif 1133 1463 1134 1464 if (.not.find_list_update) then … … 1154 1484 nbdim, memberinall2, coords, & 1155 1485 sendtoproc2, recvfromproc2, & 1156 tab5t(:,:,5),tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8)) 1486 tab5t(:,:,5),tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8), & 1487 tab5t(:,:,1),tab5t(:,:,2)) 1157 1488 1158 1489 call Agrif_Addto_list_update(child%list_update,pttab,petab,lb_child,lb_parent, & … … 1171 1502 parentarray(:,1,2) = indmin 1172 1503 parentarray(:,2,2) = indmax 1504 1505 if (associated(agrif_external_mapping)) then 1506 call Agrif_ChildGrid_to_ParentGrid() 1507 call agrif_external_mapping(nbdim,child%root_var % posvar(1),child%root_var % posvar(2), & 1508 parentarray,parentarray_chunk,correction_required,nb_chunks) 1509 call Agrif_ParentGrid_to_ChildGrid() 1510 allocate(decal_chunks(nb_chunks,nbdim)) 1511 do i=1,nb_chunks 1512 decal_chunks(i,:)=parentarray_chunk(i,:,1,1)-parentarray_chunk(i,:,1,2) 1513 enddo 1514 else 1515 nb_chunks=1 1516 allocate(correction_required(nb_chunks)) 1517 correction_required=.FALSE. 1518 allocate(parentarray_chunk(nb_chunks,nbdim,2,2)) 1519 parentarray_chunk(1,:,:,:)=parentarray 1520 endif 1521 if (agrif_debug_update) then 1522 print *,'AVANT PARENTCHILDBOUNDS' 1523 print *,'nombre de chunks ',nb_chunks 1524 do i=1,nb_chunks 1525 print *,'CHUNK Number : ',i 1526 do j=1,nbdim 1527 print *,'Direction ',j 1528 print *,'MIN MAX (2) = ',parentarray_chunk(i,j,1,2),parentarray_chunk(i,j,2,2) 1529 print *,'MIN MAX (1) = ',parentarray_chunk(i,j,1,1),parentarray_chunk(i,j,2,1) 1530 enddo 1531 enddo 1532 print *,'APRES PARENTCHILDBOUNDS' 1533 endif 1534 allocate(member_chuncks(nb_chunks)) 1535 allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2)) 1536 member_chuncks = .TRUE. 1537 member = .TRUE. 1538 do j=1,nb_chunks 1539 if (agrif_debug_update) print *,'CHUNK = ',j 1540 if (member_chuncks(j)) then 1541 do i=1,nbdim 1542 parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1) !+decal_chunks(j,i) 1543 enddo 1544 if (agrif_debug_update) then 1545 do i=1,nbdim 1546 print *,'parentarray = ',i,parentarray_chunk(j,i,1,1),parentarray_chunk(j,i,2,1), & 1547 parentarray_chunk(j,i,1,2),parentarray_chunk(j,i,2,2) 1548 print *,'parentarraydecal = ',i,parentarray_chunk_decal(j,i,1,1),parentarray_chunk_decal(j,i,2,1) 1549 enddo 1550 endif 1551 endif 1552 enddo 1553 1173 1554 member = .TRUE. 1174 1555 #endif 1556 1557 if (agrif_debug_update .and. nbdim==2) then 1558 print *,'MINMAXUPDATEEXTND = ',minval(tempPextend%array2),maxval(tempPextend%array2) 1559 endif 1175 1560 ! 1176 1561 ! Special values on the child grid … … 1230 1615 endif 1231 1616 ! 1232 IF (member) THEN 1617 1233 1618 1234 1619 call Agrif_ChildGrid_to_ParentGrid() 1620 1621 if (nb_chunks > 1) then 1622 allocate(tempPextend_chunk) 1623 SELECT CASE(nbdim) 1624 CASE(1) 1625 call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array1),ubound(tempPextend%array1),nbdim) 1626 CASE(2) 1627 call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array2),ubound(tempPextend%array2),nbdim) 1628 CASE(3) 1629 call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array3),ubound(tempPextend%array3),nbdim) 1630 CASE(4) 1631 call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array4),ubound(tempPextend%array4),nbdim) 1632 CASE(5) 1633 call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array5),ubound(tempPextend%array5),nbdim) 1634 CASE(6) 1635 call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array6),ubound(tempPextend%array6),nbdim) 1636 END SELECT 1637 else 1638 tempPextend_chunk => tempPextend 1639 endif 1640 1641 do i=1,nb_chunks 1642 1643 if (member_chuncks(i)) then 1644 1645 if (nb_chunks > 1) then 1646 call Agrif_var_copy_array (tempPextend_chunk, parentarray_chunk_decal(i,:,1,1), parentarray_chunk_decal(i,:,2,1), & 1647 tempPextend, parentarray_chunk_decal(i,:,1,1), parentarray_chunk_decal(i,:,2,1), nbdim ) 1648 endif 1235 1649 ! 1236 1650 SELECT CASE(nbdim) 1237 1651 CASE(1) 1238 call procname( tempPextend % array1( & 1239 parentarray(1,1,1):parentarray(1,2,1)), & 1240 parentarray(1,1,2),parentarray(1,2,2),.FALSE.,nbin,ndirin) 1652 ! call procname( tempPextend % array1( & 1653 ! parentarray(1,1,1):parentarray(1,2,1)), & 1654 ! parentarray(1,1,2),parentarray(1,2,2),.FALSE.,nbin,ndirin) 1655 1656 call procname(tempPextend_chunk%array1(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1)), & 1657 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),.FALSE.,nbin,ndirin) 1658 1241 1659 CASE(2) 1242 call procname( tempPextend % array2( & 1243 parentarray(1,1,1):parentarray(1,2,1), & 1244 parentarray(2,1,1):parentarray(2,2,1)), & 1245 parentarray(1,1,2),parentarray(1,2,2), & 1246 parentarray(2,1,2),parentarray(2,2,2),.FALSE.,nbin,ndirin) 1660 1661 if (correction_required(i)) then 1662 call correct_field(tempPextend_chunk%array2(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 1663 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1)), & 1664 parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), & 1665 parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)) 1666 endif 1667 1668 call procname(tempPextend_chunk%array2(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 1669 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1)), & 1670 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 1671 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),.FALSE.,nbin,ndirin) 1672 1247 1673 CASE(3) 1248 call procname( tempPextend % array3( & 1249 parentarray(1,1,1):parentarray(1,2,1), & 1250 parentarray(2,1,1):parentarray(2,2,1), & 1251 parentarray(3,1,1):parentarray(3,2,1)), & 1252 parentarray(1,1,2),parentarray(1,2,2), & 1253 parentarray(2,1,2),parentarray(2,2,2), & 1254 parentarray(3,1,2),parentarray(3,2,2),.FALSE.,nbin,ndirin) 1674 1675 if (correction_required(i)) then 1676 do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2) 1677 call correct_field(tempPextend_chunk%array3(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 1678 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k), & 1679 parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), & 1680 parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)) 1681 enddo 1682 endif 1683 1684 call procname(tempPextend_chunk%array3(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 1685 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), & 1686 parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1)), & 1687 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 1688 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2), & 1689 parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),.FALSE.,nbin,ndirin) 1690 1691 1692 1693 1255 1694 CASE(4) 1256 call procname( tempPextend % array4( & 1257 parentarray(1,1,1):parentarray(1,2,1), & 1258 parentarray(2,1,1):parentarray(2,2,1), & 1259 parentarray(3,1,1):parentarray(3,2,1), & 1260 parentarray(4,1,1):parentarray(4,2,1)), & 1261 parentarray(1,1,2),parentarray(1,2,2), & 1262 parentarray(2,1,2),parentarray(2,2,2), & 1263 parentarray(3,1,2),parentarray(3,2,2), & 1264 parentarray(4,1,2),parentarray(4,2,2),.FALSE.,nbin,ndirin) 1695 1696 if (correction_required(i)) then 1697 do l=parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2) 1698 do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2) 1699 call correct_field(tempPextend_chunk%array4(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 1700 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k,l), & 1701 parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), & 1702 parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)) 1703 enddo 1704 enddo 1705 endif 1706 1707 call procname(tempPextend_chunk%array4(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 1708 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), & 1709 parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), & 1710 parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1)), & 1711 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 1712 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2), & 1713 parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2), & 1714 parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2),.FALSE.,nbin,ndirin) 1715 1265 1716 CASE(5) 1266 call procname( tempPextend % array5( & 1267 parentarray(1,1,1):parentarray(1,2,1), & 1268 parentarray(2,1,1):parentarray(2,2,1), & 1269 parentarray(3,1,1):parentarray(3,2,1), & 1270 parentarray(4,1,1):parentarray(4,2,1), & 1271 parentarray(5,1,1):parentarray(5,2,1)), & 1272 parentarray(1,1,2),parentarray(1,2,2), & 1273 parentarray(2,1,2),parentarray(2,2,2), & 1274 parentarray(3,1,2),parentarray(3,2,2), & 1275 parentarray(4,1,2),parentarray(4,2,2), & 1276 parentarray(5,1,2),parentarray(5,2,2),.FALSE.,nbin,ndirin) 1717 1718 if (correction_required(i)) then 1719 do m=parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2) 1720 do l=parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2) 1721 do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2) 1722 call correct_field(tempPextend_chunk%array5(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 1723 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k,l,m), & 1724 parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), & 1725 parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)) 1726 enddo 1727 enddo 1728 enddo 1729 endif 1730 1731 call procname(tempPextend_chunk%array5(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 1732 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), & 1733 parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), & 1734 parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1), & 1735 parentarray_chunk_decal(i,5,1,1):parentarray_chunk_decal(i,5,2,1)), & 1736 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 1737 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2), & 1738 parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2), & 1739 parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2), & 1740 parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2),.FALSE.,nbin,ndirin) 1741 1277 1742 CASE(6) 1278 call procname( tempPextend % array6( & 1279 parentarray(1,1,1):parentarray(1,2,1), & 1280 parentarray(2,1,1):parentarray(2,2,1), & 1281 parentarray(3,1,1):parentarray(3,2,1), & 1282 parentarray(4,1,1):parentarray(4,2,1), & 1283 parentarray(5,1,1):parentarray(5,2,1), & 1284 parentarray(6,1,1):parentarray(6,2,1)), & 1285 parentarray(1,1,2),parentarray(1,2,2), & 1286 parentarray(2,1,2),parentarray(2,2,2), & 1287 parentarray(3,1,2),parentarray(3,2,2), & 1288 parentarray(4,1,2),parentarray(4,2,2), & 1289 parentarray(5,1,2),parentarray(5,2,2), & 1290 parentarray(6,1,2),parentarray(6,2,2),.FALSE.,nbin,ndirin) 1743 1744 call procname(tempPextend_chunk%array6(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), & 1745 parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), & 1746 parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), & 1747 parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1), & 1748 parentarray_chunk_decal(i,5,1,1):parentarray_chunk_decal(i,5,2,1), & 1749 parentarray_chunk_decal(i,6,1,1):parentarray_chunk_decal(i,6,2,1)), & 1750 parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2), & 1751 parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2), & 1752 parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2), & 1753 parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2), & 1754 parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2),& 1755 parentarray_chunk(i,6,1,2),parentarray_chunk(i,6,2,2),.FALSE.,nbin,ndirin) 1756 1291 1757 END SELECT 1758 ENDIF 1759 enddo ! enddo i=1,nb_chunks 1760 1761 if (nb_chunks > 1) then 1762 call Agrif_array_deallocate(tempPextend_chunk,nbdim) 1763 deallocate(tempPextend_chunk) 1764 endif 1292 1765 ! 1293 1766 call Agrif_ParentGrid_to_ChildGrid() 1294 1767 ! 1295 call Agrif_array_deallocate(tempPextend,nbdim)1296 ! 1297 ENDIF 1768 if (ANY(member_chuncks)) call Agrif_array_deallocate(tempPextend,nbdim) 1769 ! 1770 1298 1771 ! 1299 1772 #if defined AGRIF_MPI … … 1355 1828 IF ( do_update(i) ) THEN 1356 1829 IF (posvar(i) == 1) THEN 1357 IF (type_update(i) == Agrif_Update_Average) THEN1830 IF ((type_update(i) == Agrif_Update_Average).OR.(type_update(i) == Agrif_Update_Max)) THEN 1358 1831 positionmin = positionmin - ds_parent(i)/2. 1359 1832 ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN … … 1381 1854 IF ( do_update(i) ) THEN 1382 1855 IF (posvar(i) == 1) THEN 1383 IF (type_update(i) == Agrif_Update_Average) THEN1856 IF ((type_update(i) == Agrif_Update_Average).OR.(type_update(i) == Agrif_Update_Max)) THEN 1384 1857 positionmax = positionmax + ds_parent(i)/2. 1385 1858 ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN … … 2007 2480 ds_parent, ds_child ) 2008 2481 ! 2482 elseif ( type_update == Agrif_Update_Max ) then 2483 ! 2484 call Agrif_basicupdate_max1d( & 2485 parent_tab, child_tab, & 2486 np, nc, & 2487 s_parent, s_child, & 2488 ds_parent, ds_child ) 2009 2489 elseif ( type_update == Agrif_Update_Full_Weighting ) then 2010 2490 !
Note: See TracChangeset
for help on using the changeset viewer.
