Changeset 10087 for vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modbc.F90
- Timestamp:
- 2018-09-05T15:33:44+02:00 (6 years ago)
- File:
-
- 1 edited
-
vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modbc.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modbc.F90
r5656 r10087 32 32 ! 33 33 implicit none 34 REAL,DIMENSION(:),ALLOCATABLE :: parray_temp 34 35 ! 35 36 contains … … 61 62 integer, dimension(6) :: loctab_child ! Indicates if the child grid has a common border 62 63 ! with the root grid 63 real , dimension(6) :: s_child, s_parent ! Positions of the parent and child grids64 real , dimension(6) :: ds_child, ds_parent ! Space steps of the parent and child grids64 real(kind=8), dimension(6) :: s_child, s_parent ! Positions of the parent and child grids 65 real(kind=8), dimension(6) :: ds_child, ds_parent ! Space steps of the parent and child grids 65 66 ! 66 67 call PreProcessToInterpOrUpdate( parent, child, & … … 145 146 INTEGER, DIMENSION(nbdim) :: posvartab_Child !< Position of the grid variable (1 or 2) 146 147 INTEGER, DIMENSION(nbdim) :: loctab_Child !< Indicates if the child grid has a common border with the root grid 147 REAL , DIMENSION(nbdim) :: s_Child, s_Parent !< Positions of the parent and child grids148 REAL , DIMENSION(nbdim) :: ds_Child, ds_Parent !< Space steps of the parent and child grids148 REAL(kind=8) , DIMENSION(nbdim) :: s_Child, s_Parent !< Positions of the parent and child grids 149 REAL(kind=8) , DIMENSION(nbdim) :: ds_Child, ds_Parent !< Space steps of the parent and child grids 149 150 INTEGER :: nbdim !< Number of dimensions of the grid variable 150 151 procedure() :: procname !< Data recovery procedure … … 159 160 INTEGER,DIMENSION(nbdim,2,2,nbdim) :: ptres,ptres2 ! calculated 160 161 INTEGER,DIMENSION(nbdim) :: coords 161 INTEGER :: i, nb, ndir 162 INTEGER :: i, nb, ndir,j,k,l 162 163 INTEGER :: n, sizetab 163 164 INTEGER :: ibeg, iend 164 165 INTEGER :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2 165 166 REAL :: c1t,c2t ! Coefficients for the time interpolation (c2t=1-c1t) 167 INTEGER :: isize 168 INTEGER :: kindex_2d(2,nbdim) 169 166 170 #if defined AGRIF_MPI 167 171 ! … … 188 192 END WHERE 189 193 ! 190 call Agrif_get_var_global_bounds(child,lubglob,nbdim) 194 ! call Agrif_get_var_global_bounds(child,lubglob,nbdim) 195 lubglob = child%lubglob(1:nbdim,:) 191 196 ! 192 197 indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1)) … … 194 199 indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2)) 195 200 indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2)) 201 196 202 ! 197 203 do nb = 1,nbdim … … 267 273 if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 268 274 ! 275 269 276 call Agrif_InterpnD(type_interp, parent, child, & 270 277 ptres(1:nbdim,1,ndir,nb), & … … 319 326 do nb = 1,nbdim 320 327 do ndir = 1,2 321 if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 328 kindex_2d(ndir,nb) = kindex 329 if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then 322 330 Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim) 323 331 endif … … 325 333 enddo 326 334 ! 327 endif328 !329 335 do nb = 1,nbdim 330 336 do ndir = 1,2 331 337 if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then 338 339 do i=1,nbdim 340 if (ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir)) then 341 print *,'problem ptres2 childarray 1 ',ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir) 342 stop 343 endif 344 if (ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir)) then 345 print *,'problem ptres2 childarray 2 ',ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir) 346 stop 347 endif 348 enddo 349 332 350 select case(nbdim) 333 351 case(1) … … 346 364 i1,i2,j1,j2, .FALSE.,coords(nb),ndir) 347 365 case(3) 366 348 367 i1 = child % childarray(1,1,2,nb,ndir) 349 368 i2 = child % childarray(1,2,2,nb,ndir) … … 353 372 k2 = child % childarray(3,2,2,nb,ndir) 354 373 355 call procname(parray3(i1:i2,j1:j2,k1:k2), &356 i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) 374 call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) 375 357 376 case(4) 358 377 i1 = child % childarray(1,1,2,nb,ndir) … … 365 384 l2 = child % childarray(4,2,2,nb,ndir) 366 385 367 call procname(parray 4(i1:i2,j1:j2,k1:k2,l1:l2), &368 i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir) 386 call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2,l1,l2,.FALSE.,coords(nb),ndir) 387 369 388 case(5) 370 389 i1 = child % childarray(1,1,2,nb,ndir) … … 401 420 enddo 402 421 enddo 422 423 else 424 425 do nb = 1,nbdim 426 do ndir = 1,2 427 if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then 428 select case(nbdim) 429 case(1) 430 i1 = child % childarray(1,1,2,nb,ndir) 431 i2 = child % childarray(1,2,2,nb,ndir) 432 433 call procname(parray1(i1:i2), & 434 i1,i2, .FALSE.,coords(nb),ndir) 435 case(2) 436 i1 = child % childarray(1,1,2,nb,ndir) 437 i2 = child % childarray(1,2,2,nb,ndir) 438 j1 = child % childarray(2,1,2,nb,ndir) 439 j2 = child % childarray(2,2,2,nb,ndir) 440 441 call procname(parray2(i1:i2,j1:j2), & 442 i1,i2,j1,j2, .FALSE.,coords(nb),ndir) 443 case(3) 444 445 i1 = child % childarray(1,1,2,nb,ndir) 446 i2 = child % childarray(1,2,2,nb,ndir) 447 j1 = child % childarray(2,1,2,nb,ndir) 448 j2 = child % childarray(2,2,2,nb,ndir) 449 k1 = child % childarray(3,1,2,nb,ndir) 450 k2 = child % childarray(3,2,2,nb,ndir) 451 452 call procname(parray3(i1:i2,j1:j2,k1:k2), & 453 i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) 454 455 case(4) 456 i1 = child % childarray(1,1,2,nb,ndir) 457 i2 = child % childarray(1,2,2,nb,ndir) 458 j1 = child % childarray(2,1,2,nb,ndir) 459 j2 = child % childarray(2,2,2,nb,ndir) 460 k1 = child % childarray(3,1,2,nb,ndir) 461 k2 = child % childarray(3,2,2,nb,ndir) 462 l1 = child % childarray(4,1,2,nb,ndir) 463 l2 = child % childarray(4,2,2,nb,ndir) 464 465 call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2), & 466 i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir) 467 468 case(5) 469 i1 = child % childarray(1,1,2,nb,ndir) 470 i2 = child % childarray(1,2,2,nb,ndir) 471 j1 = child % childarray(2,1,2,nb,ndir) 472 j2 = child % childarray(2,2,2,nb,ndir) 473 k1 = child % childarray(3,1,2,nb,ndir) 474 k2 = child % childarray(3,2,2,nb,ndir) 475 l1 = child % childarray(4,1,2,nb,ndir) 476 l2 = child % childarray(4,2,2,nb,ndir) 477 m1 = child % childarray(5,1,2,nb,ndir) 478 m2 = child % childarray(5,2,2,nb,ndir) 479 480 call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2), & 481 i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir) 482 case(6) 483 i1 = child % childarray(1,1,2,nb,ndir) 484 i2 = child % childarray(1,2,2,nb,ndir) 485 j1 = child % childarray(2,1,2,nb,ndir) 486 j2 = child % childarray(2,2,2,nb,ndir) 487 k1 = child % childarray(3,1,2,nb,ndir) 488 k2 = child % childarray(3,2,2,nb,ndir) 489 l1 = child % childarray(4,1,2,nb,ndir) 490 l2 = child % childarray(4,2,2,nb,ndir) 491 m1 = child % childarray(5,1,2,nb,ndir) 492 m2 = child % childarray(5,2,2,nb,ndir) 493 n1 = child % childarray(6,1,2,nb,ndir) 494 n2 = child % childarray(6,2,2,nb,ndir) 495 496 call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), & 497 i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir) 498 end select 499 endif 500 enddo 501 enddo 502 503 endif 504 ! 505 403 506 !--------------------------------------------------------------------------------------------------- 404 507 end subroutine Agrif_Correctnd … … 525 628 ! 526 629 INTEGER :: ir,jr,kr,lr,mr,nr 630 INTEGER :: kindexmax, isize,i 631 REAL,DIMENSION(:),ALLOCATABLE :: tabtemp 632 633 isize = 1 634 DO i=1,nbdim 635 isize = isize * (bounds(i,2)-bounds(i,1)+1) 636 ENDDO 637 IF (isize <= 0) RETURN 638 639 kindexmax = kindex + isize - 1 640 IF (.NOT.ALLOCATED(parray_temp)) THEN 641 ALLOCATE(parray_temp(kindexmax)) 642 ELSE 643 IF (size(parray_temp) < kindexmax) THEN 644 ALLOCATE(tabtemp(size(parray_temp))) 645 tabtemp = parray_temp 646 DEALLOCATE(parray_temp) 647 ALLOCATE(parray_temp(kindexmax)) 648 parray_temp(1:size(tabtemp)) = tabtemp 649 DEALLOCATE(tabtemp) 650 ENDIF 651 ENDIF 652 527 653 ! 528 654 SELECT CASE (nbdim) … … 546 672 ! 547 673 CASE (3) 548 do kr = bounds(3,1),bounds(3,2) 549 do jr = bounds(2,1),bounds(2,2) 550 !CDIR ALTCODE 551 do ir = bounds(1,1),bounds(1,2) 552 parray3(ir,jr,kr) = c2t*child_var % oldvalues2d(1,kindex) + & 553 c1t*child_var % oldvalues2d(2,kindex) 554 kindex = kindex + 1 555 enddo 556 enddo 557 enddo 674 675 parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & 676 c1t*child_var % oldvalues2d(2,kindex:kindexmax) 677 558 678 ! 559 679 CASE (4) 560 do lr = bounds(4,1),bounds(4,2) 561 do kr = bounds(3,1),bounds(3,2) 562 do jr = bounds(2,1),bounds(2,2) 563 !CDIR ALTCODE 564 do ir = bounds(1,1),bounds(1,2) 565 parray4(ir,jr,kr,lr) = c2t*child_var % oldvalues2d(1,kindex) + & 566 c1t*child_var % oldvalues2d(2,kindex) 567 kindex = kindex + 1 568 enddo 569 enddo 570 enddo 571 enddo 680 681 parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & 682 c1t*child_var % oldvalues2d(2,kindex:kindexmax) 683 572 684 ! 573 685 CASE (5) … … 605 717 enddo 606 718 END SELECT 719 720 kindex = kindexmax + 1 721 607 722 !--------------------------------------------------------------------------------------------------- 608 723 end subroutine timeInterpolation
Note: See TracChangeset
for help on using the changeset viewer.
