Changeset 10725 for vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modbc.F90
- Timestamp:
- 2019-02-27T14:55:54+01:00 (5 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
r10087 r10725 32 32 ! 33 33 implicit none 34 REAL,DIMENSION(:),ALLOCATABLE :: parray_temp35 34 ! 36 35 contains … … 62 61 integer, dimension(6) :: loctab_child ! Indicates if the child grid has a common border 63 62 ! with the root grid 64 real (kind=8), dimension(6) :: s_child, s_parent ! Positions of the parent and child grids65 real (kind=8), dimension(6) :: ds_child, ds_parent ! Space steps of the parent and child grids63 real, dimension(6) :: s_child, s_parent ! Positions of the parent and child grids 64 real, dimension(6) :: ds_child, ds_parent ! Space steps of the parent and child grids 66 65 ! 67 66 call PreProcessToInterpOrUpdate( parent, child, & … … 146 145 INTEGER, DIMENSION(nbdim) :: posvartab_Child !< Position of the grid variable (1 or 2) 147 146 INTEGER, DIMENSION(nbdim) :: loctab_Child !< Indicates if the child grid has a common border with the root grid 148 REAL (kind=8), DIMENSION(nbdim) :: s_Child, s_Parent !< Positions of the parent and child grids149 REAL (kind=8), DIMENSION(nbdim) :: ds_Child, ds_Parent !< Space steps of the parent and child grids147 REAL , DIMENSION(nbdim) :: s_Child, s_Parent !< Positions of the parent and child grids 148 REAL , DIMENSION(nbdim) :: ds_Child, ds_Parent !< Space steps of the parent and child grids 150 149 INTEGER :: nbdim !< Number of dimensions of the grid variable 151 150 procedure() :: procname !< Data recovery procedure … … 160 159 INTEGER,DIMENSION(nbdim,2,2,nbdim) :: ptres,ptres2 ! calculated 161 160 INTEGER,DIMENSION(nbdim) :: coords 162 INTEGER :: i, nb, ndir ,j,k,l161 INTEGER :: i, nb, ndir 163 162 INTEGER :: n, sizetab 164 163 INTEGER :: ibeg, iend 165 164 INTEGER :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2 166 165 REAL :: c1t,c2t ! Coefficients for the time interpolation (c2t=1-c1t) 167 INTEGER :: isize168 INTEGER :: kindex_2d(2,nbdim)169 170 166 #if defined AGRIF_MPI 171 167 ! … … 192 188 END WHERE 193 189 ! 194 ! call Agrif_get_var_global_bounds(child,lubglob,nbdim) 195 lubglob = child%lubglob(1:nbdim,:) 190 call Agrif_get_var_global_bounds(child,lubglob,nbdim) 196 191 ! 197 192 indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1)) … … 199 194 indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2)) 200 195 indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2)) 201 202 196 ! 203 197 do nb = 1,nbdim … … 273 267 if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 274 268 ! 275 276 269 call Agrif_InterpnD(type_interp, parent, child, & 277 270 ptres(1:nbdim,1,ndir,nb), & … … 326 319 do nb = 1,nbdim 327 320 do ndir = 1,2 328 kindex_2d(ndir,nb) = kindex 329 if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then 321 if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 330 322 Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim) 331 323 endif … … 333 325 enddo 334 326 ! 327 endif 328 ! 335 329 do nb = 1,nbdim 336 330 do ndir = 1,2 337 331 if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then 338 339 do i=1,nbdim340 if (ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir)) then341 print *,'problem ptres2 childarray 1 ',ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir)342 stop343 endif344 if (ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir)) then345 print *,'problem ptres2 childarray 2 ',ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir)346 stop347 endif348 enddo349 350 332 select case(nbdim) 351 333 case(1) … … 364 346 i1,i2,j1,j2, .FALSE.,coords(nb),ndir) 365 347 case(3) 366 367 348 i1 = child % childarray(1,1,2,nb,ndir) 368 349 i2 = child % childarray(1,2,2,nb,ndir) … … 372 353 k2 = child % childarray(3,2,2,nb,ndir) 373 354 374 call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir)375 355 call procname(parray3(i1:i2,j1:j2,k1:k2), & 356 i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) 376 357 case(4) 377 358 i1 = child % childarray(1,1,2,nb,ndir) … … 384 365 l2 = child % childarray(4,2,2,nb,ndir) 385 366 386 call procname(parray _temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2,l1,l2,.FALSE.,coords(nb),ndir)387 367 call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2), & 368 i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir) 388 369 case(5) 389 370 i1 = child % childarray(1,1,2,nb,ndir) … … 420 401 enddo 421 402 enddo 422 423 else424 425 do nb = 1,nbdim426 do ndir = 1,2427 if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then428 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 select499 endif500 enddo501 enddo502 503 endif504 !505 506 403 !--------------------------------------------------------------------------------------------------- 507 404 end subroutine Agrif_Correctnd … … 628 525 ! 629 526 INTEGER :: ir,jr,kr,lr,mr,nr 630 INTEGER :: kindexmax, isize,i631 REAL,DIMENSION(:),ALLOCATABLE :: tabtemp632 633 isize = 1634 DO i=1,nbdim635 isize = isize * (bounds(i,2)-bounds(i,1)+1)636 ENDDO637 IF (isize <= 0) RETURN638 639 kindexmax = kindex + isize - 1640 IF (.NOT.ALLOCATED(parray_temp)) THEN641 ALLOCATE(parray_temp(kindexmax))642 ELSE643 IF (size(parray_temp) < kindexmax) THEN644 ALLOCATE(tabtemp(size(parray_temp)))645 tabtemp = parray_temp646 DEALLOCATE(parray_temp)647 ALLOCATE(parray_temp(kindexmax))648 parray_temp(1:size(tabtemp)) = tabtemp649 DEALLOCATE(tabtemp)650 ENDIF651 ENDIF652 653 527 ! 654 528 SELECT CASE (nbdim) … … 672 546 ! 673 547 CASE (3) 674 675 parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & 676 c1t*child_var % oldvalues2d(2,kindex:kindexmax) 677 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 678 558 ! 679 559 CASE (4) 680 681 parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & 682 c1t*child_var % oldvalues2d(2,kindex:kindexmax) 683 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 684 572 ! 685 573 CASE (5) … … 717 605 enddo 718 606 END SELECT 719 720 kindex = kindexmax + 1721 722 607 !--------------------------------------------------------------------------------------------------- 723 608 end subroutine timeInterpolation
Note: See TracChangeset
for help on using the changeset viewer.
