! ! $Id$ ! ! AGRIF (Adaptive Grid Refinement In Fortran) ! ! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) ! Christophe Vouland (Christophe.Vouland@imag.fr) ! ! This program is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2 of the License, or ! (at your option) any later version. ! ! This program is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software ! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. ! ! !> Module Agrif_Boundary. !> !> Contains subroutines to calculate the boundary conditions on the child grids from their !> parent grids. ! module Agrif_Boundary ! use Agrif_Interpolation ! implicit none REAL,DIMENSION(:),ALLOCATABLE :: parray_temp ! contains ! !=================================================================================================== ! subroutine Agrif_CorrectVariable ! !> subroutine to calculate the boundary conditions on a fine grid !--------------------------------------------------------------------------------------------------- subroutine Agrif_CorrectVariable ( parent, child, pweight, weight, procname ) !--------------------------------------------------------------------------------------------------- type(Agrif_Variable), pointer :: parent !< Variable on the parent grid type(Agrif_Variable), pointer :: child !< Variable on the child grid logical :: pweight !< Indicates if weight is used for the time interpolation real :: weight !< Coefficient for the time interpolation procedure() :: procname !< Data recovery procedure ! type(Agrif_Grid) , pointer :: Agrif_Child_Gr, Agrif_Parent_Gr type(Agrif_Variable), pointer :: root_var ! Variable on the root grid integer :: nbdim ! Number of dimensions of the grid variable integer :: n integer, dimension(6) :: lb_child ! Index of the first point inside the domain for ! the child grid variable integer, dimension(6) :: lb_parent ! Index of the first point inside the domain for ! the parent grid variable integer, dimension(6) :: ub_child ! Upper bound on the child grid integer, dimension(6) :: nb_child ! Number of cells for child integer, dimension(6) :: posvartab_child ! Position of the variable on the cell integer, dimension(6) :: loctab_child ! Indicates if the child grid has a common border ! with the root grid real(kind=8), dimension(6) :: s_child, s_parent ! Positions of the parent and child grids real(kind=8), dimension(6) :: ds_child, ds_parent ! Space steps of the parent and child grids ! call PreProcessToInterpOrUpdate( parent, child, & nb_child, ub_child, & lb_child, lb_parent, & s_child, s_parent, & ds_child, ds_parent, nbdim, interp=.true.) root_var => child % root_var Agrif_Child_Gr => Agrif_Curgrid Agrif_Parent_Gr => Agrif_Curgrid % parent ! loctab_child(:) = 0 posvartab_child(1:nbdim) = root_var % posvar(1:nbdim) ! do n = 1,nbdim ! select case(root_var % interptab(n)) ! case('x') ! x DIMENSION ! if (Agrif_Curgrid % NearRootBorder(1)) loctab_child(n) = -1 if (Agrif_Curgrid % DistantRootBorder(1)) loctab_child(n) = -2 if ((Agrif_Curgrid % NearRootBorder(1)) .AND. & (Agrif_Curgrid % DistantRootBorder(1))) loctab_child(n) = -3 ! case('y') ! y DIMENSION ! if (Agrif_Curgrid % NearRootBorder(2)) loctab_child(n) = -1 if (Agrif_Curgrid % DistantRootBorder(2)) loctab_child(n) = -2 if ((Agrif_Curgrid % NearRootBorder(2)) .AND. & (Agrif_Curgrid % DistantRootBorder(2))) loctab_child(n) = -3 ! case('z') ! z DIMENSION ! if (Agrif_Curgrid % NearRootBorder(3)) loctab_child(n) = -1 if (Agrif_Curgrid % DistantRootBorder(3)) loctab_child(n) = -2 if ((Agrif_Curgrid % NearRootBorder(3)) .AND. & (Agrif_Curgrid % DistantRootBorder(3))) loctab_child(n) = -3 ! case('N') ! No space DIMENSION ! posvartab_child(n) = 1 loctab_child(n) = -3 ! end select ! enddo ! call Agrif_Correctnd(parent, child, pweight, weight, & lb_child(1:nbdim), lb_parent(1:nbdim), & nb_child(1:nbdim), posvartab_child(1:nbdim), & loctab_child(1:nbdim), & s_child(1:nbdim), s_parent(1:nbdim), & ds_child(1:nbdim),ds_parent(1:nbdim), nbdim, procname ) !--------------------------------------------------------------------------------------------------- end subroutine Agrif_CorrectVariable !=================================================================================================== ! !=================================================================================================== ! subroutine Agrif_Correctnd ! !> calculates the boundary conditions for a nD grid variable on a fine grid by using !> a space and time interpolations; it is called by the #Agrif_CorrectVariable procedure !--------------------------------------------------------------------------------------------------- subroutine Agrif_Correctnd ( parent, child, pweight, weight, & pttab_child, pttab_Parent, & nbtab_Child, posvartab_Child, loctab_Child, & s_Child, s_Parent, ds_Child, ds_Parent, & nbdim, procname ) !--------------------------------------------------------------------------------------------------- #if defined AGRIF_MPI include 'mpif.h' #endif ! TYPE(Agrif_Variable), pointer :: parent !< Variable on the parent grid TYPE(Agrif_Variable), pointer :: child !< Variable on the child grid LOGICAL :: pweight !< Indicates if weight is used for the temporal interpolation REAL :: weight !< Coefficient for the temporal interpolation INTEGER, DIMENSION(nbdim) :: pttab_child !< Index of the first point inside the domain for the parent grid variable INTEGER, DIMENSION(nbdim) :: pttab_Parent !< Index of the first point inside the domain for the child grid variable INTEGER, DIMENSION(nbdim) :: nbtab_Child !< Number of cells of the child grid INTEGER, DIMENSION(nbdim) :: posvartab_Child !< Position of the grid variable (1 or 2) INTEGER, DIMENSION(nbdim) :: loctab_Child !< Indicates if the child grid has a common border with the root grid REAL(kind=8) , DIMENSION(nbdim) :: s_Child, s_Parent !< Positions of the parent and child grids REAL(kind=8) , DIMENSION(nbdim) :: ds_Child, ds_Parent !< Space steps of the parent and child grids INTEGER :: nbdim !< Number of dimensions of the grid variable procedure() :: procname !< Data recovery procedure ! INTEGER,DIMENSION(6) :: type_interp ! Type of interpolation (linear, spline,...) INTEGER,DIMENSION(6,6) :: type_interp_bc ! Type of interpolation (linear, spline,...) INTEGER,DIMENSION(nbdim,2,2) :: childarray INTEGER,DIMENSION(nbdim,2) :: lubglob INTEGER :: kindex ! Index used for safeguard and time interpolation INTEGER,DIMENSION(nbdim,2,2) :: indtab ! Arrays indicating the limits of the child INTEGER,DIMENSION(nbdim,2,2) :: indtruetab ! grid variable where boundary conditions are INTEGER,DIMENSION(nbdim,2,2,nbdim) :: ptres,ptres2 ! calculated INTEGER,DIMENSION(nbdim) :: coords INTEGER :: i, nb, ndir,j,k,l INTEGER :: n, sizetab INTEGER :: ibeg, iend INTEGER :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2 REAL :: c1t,c2t ! Coefficients for the time interpolation (c2t=1-c1t) INTEGER :: isize INTEGER :: kindex_2d(2,nbdim) #if defined AGRIF_MPI ! INTEGER, DIMENSION(nbdim) :: lower, upper INTEGER, DIMENSION(nbdim) :: ltab, utab ! #endif ! type_interp_bc = child % root_var % type_interp_bc coords = child % root_var % coords ! ibeg = child % bcinf iend = child % bcsup ! indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim) + ibeg indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( iend - ibeg ) indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - iend indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - ibeg WHERE (posvartab_child(1:nbdim) == 2) indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1 indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1 END WHERE ! ! call Agrif_get_var_global_bounds(child,lubglob,nbdim) lubglob = child%lubglob(1:nbdim,:) ! indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1)) indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2), lubglob(1:nbdim,1)) indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2)) indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2)) ! do nb = 1,nbdim do ndir = 1,2 ! if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then ! do n = 1,2 ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n) enddo ! do i = 1,nbdim ! if (i /= nb) then ! if (loctab_child(i) == -1 .OR. loctab_child(i) == -3) then ptres(i,1,ndir,nb) = pttab_child(i) else ptres(i,1,ndir,nb) = indtruetab(i,1,1) endif if (loctab_child(i) == -2 .OR. loctab_child(i) == -3) then if (posvartab_child(i) == 1) then ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i) else ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i) - 1 endif else ptres(i,2,ndir,nb) = indtruetab(i,2,2) endif ! endif ! enddo ! #if defined AGRIF_MPI call Agrif_get_var_bounds_array(child,lower,upper,nbdim) do i = 1,nbdim ! Call Agrif_GetLocalBoundaries(ptres(i,1,ndir,nb), ptres(i,2,ndir,nb), & coords(i), lower(i), upper(i), ltab(i), utab(i) ) ptres2(i,1,ndir,nb) = max(ltab(i),lower(i)) ptres2(i,2,ndir,nb) = min(utab(i),upper(i)) if ((i == nb) .AND. (ndir == 1)) then ptres2(i,2,ndir,nb) = max(utab(i),lower(i)) elseif ((i == nb) .AND. (ndir == 2)) then ptres2(i,1,ndir,nb) = min(ltab(i),upper(i)) endif ! enddo #else ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb) #endif endif ! enddo ! ndir = 1,2 enddo ! nb = 1,nbdim ! if ( child % interpIndex /= Agrif_Curgrid % parent % ngridstep .OR. & child % Interpolationshouldbemade ) then ! ! Space interpolation ! kindex = 1 ! do nb = 1,nbdim type_interp = type_interp_bc(nb,:) do ndir = 1,2 ! if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then ! call Agrif_InterpnD(type_interp, parent, child, & ptres(1:nbdim,1,ndir,nb), & ptres(1:nbdim,2,ndir,nb), & pttab_child(1:nbdim), & pttab_Parent(1:nbdim), & s_Child(1:nbdim), s_Parent(1:nbdim), & ds_Child(1:nbdim),ds_Parent(1:nbdim), & NULL(), .FALSE., nbdim, & childarray, & child%memberin(nb,ndir), .TRUE., procname, coords(nb), ndir) child % childarray(1:nbdim,:,:,nb,ndir) = childarray if (.not. child%interpolationshouldbemade) then ! ! Safeguard of the values of the grid variable (at times n and n+1 on the parent grid) ! sizetab = 1 do i = 1,nbdim sizetab = sizetab * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1) enddo call saveAfterInterp(child,ptres2(:,:,ndir,nb),kindex,sizetab,nbdim) ! endif ! endif ! enddo ! ndir = 1,2 enddo ! nb = 1,nbdim ! child % interpIndex = Agrif_Curgrid % parent % ngridstep ! endif ! if (.not. child%interpolationshouldbemade) then ! ! Calculation of the coefficients c1t and c2t for the temporary interpolation ! if (pweight) then c1t = weight else c1t = (REAL(Agrif_Nbstepint()) + 1.) / Agrif_Rhot() endif c2t = 1. - c1t ! ! Time interpolation ! kindex = 1 ! do nb = 1,nbdim do ndir = 1,2 kindex_2d(ndir,nb) = kindex if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim) endif enddo enddo ! do nb = 1,nbdim do ndir = 1,2 if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then do i=1,nbdim if (ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir)) then print *,'problem ptres2 childarray 1 ',ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir) stop endif if (ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir)) then print *,'problem ptres2 childarray 2 ',ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir) stop endif enddo select case(nbdim) case(1) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) call procname(parray1(i1:i2), & i1,i2, .FALSE.,coords(nb),ndir) case(2) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) call procname(parray2(i1:i2,j1:j2), & i1,i2,j1,j2, .FALSE.,coords(nb),ndir) case(3) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) k1 = child % childarray(3,1,2,nb,ndir) k2 = child % childarray(3,2,2,nb,ndir) call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) case(4) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) k1 = child % childarray(3,1,2,nb,ndir) k2 = child % childarray(3,2,2,nb,ndir) l1 = child % childarray(4,1,2,nb,ndir) l2 = child % childarray(4,2,2,nb,ndir) call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2,l1,l2,.FALSE.,coords(nb),ndir) case(5) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) k1 = child % childarray(3,1,2,nb,ndir) k2 = child % childarray(3,2,2,nb,ndir) l1 = child % childarray(4,1,2,nb,ndir) l2 = child % childarray(4,2,2,nb,ndir) m1 = child % childarray(5,1,2,nb,ndir) m2 = child % childarray(5,2,2,nb,ndir) call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2), & i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir) case(6) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) k1 = child % childarray(3,1,2,nb,ndir) k2 = child % childarray(3,2,2,nb,ndir) l1 = child % childarray(4,1,2,nb,ndir) l2 = child % childarray(4,2,2,nb,ndir) m1 = child % childarray(5,1,2,nb,ndir) m2 = child % childarray(5,2,2,nb,ndir) n1 = child % childarray(6,1,2,nb,ndir) n2 = child % childarray(6,2,2,nb,ndir) call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), & i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir) end select endif enddo enddo else do nb = 1,nbdim do ndir = 1,2 if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then select case(nbdim) case(1) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) call procname(parray1(i1:i2), & i1,i2, .FALSE.,coords(nb),ndir) case(2) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) call procname(parray2(i1:i2,j1:j2), & i1,i2,j1,j2, .FALSE.,coords(nb),ndir) case(3) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) k1 = child % childarray(3,1,2,nb,ndir) k2 = child % childarray(3,2,2,nb,ndir) call procname(parray3(i1:i2,j1:j2,k1:k2), & i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) case(4) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) k1 = child % childarray(3,1,2,nb,ndir) k2 = child % childarray(3,2,2,nb,ndir) l1 = child % childarray(4,1,2,nb,ndir) l2 = child % childarray(4,2,2,nb,ndir) call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2), & i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir) case(5) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) k1 = child % childarray(3,1,2,nb,ndir) k2 = child % childarray(3,2,2,nb,ndir) l1 = child % childarray(4,1,2,nb,ndir) l2 = child % childarray(4,2,2,nb,ndir) m1 = child % childarray(5,1,2,nb,ndir) m2 = child % childarray(5,2,2,nb,ndir) call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2), & i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir) case(6) i1 = child % childarray(1,1,2,nb,ndir) i2 = child % childarray(1,2,2,nb,ndir) j1 = child % childarray(2,1,2,nb,ndir) j2 = child % childarray(2,2,2,nb,ndir) k1 = child % childarray(3,1,2,nb,ndir) k2 = child % childarray(3,2,2,nb,ndir) l1 = child % childarray(4,1,2,nb,ndir) l2 = child % childarray(4,2,2,nb,ndir) m1 = child % childarray(5,1,2,nb,ndir) m2 = child % childarray(5,2,2,nb,ndir) n1 = child % childarray(6,1,2,nb,ndir) n2 = child % childarray(6,2,2,nb,ndir) call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), & i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir) end select endif enddo enddo endif ! !--------------------------------------------------------------------------------------------------- end subroutine Agrif_Correctnd !=================================================================================================== ! !=================================================================================================== ! subroutine saveAfterInterp ! !> saves the values of the grid variable on the fine grid after the space interpolation !--------------------------------------------------------------------------------------------------- subroutine saveAfterInterp ( child_var, bounds, kindex, newsize, nbdim ) !--------------------------------------------------------------------------------------------------- TYPE (Agrif_Variable), INTENT(inout) :: child_var !< The fine grid variable INTEGER, DIMENSION(nbdim,2), INTENT(in) :: bounds INTEGER, INTENT(inout) :: kindex !< Index indicating where this safeguard !< is done on the fine grid INTEGER, INTENT(in) :: newsize INTEGER, INTENT(in) :: nbdim ! INTEGER :: ir,jr,kr,lr,mr,nr ! ! Allocation of the array oldvalues2d ! if (newsize .LE. 0) return ! Call Agrif_Checksize(child_var,kindex+newsize) if (child_var % interpIndex /= Agrif_Curgrid % parent % ngridstep ) then child_var % oldvalues2d(1,kindex:kindex+newsize-1) = & child_var % oldvalues2d(2,kindex:kindex+newsize-1) endif SELECT CASE (nbdim) CASE (1) !CDIR ALTCODE do ir = bounds(1,1), bounds(1,2) child_var % oldvalues2d(2,kindex) = parray1(ir) kindex = kindex + 1 enddo ! CASE (2) do jr = bounds(2,1),bounds(2,2) !CDIR ALTCODE do ir = bounds(1,1),bounds(1,2) child_var % oldvalues2d(2,kindex) = parray2(ir,jr) kindex = kindex + 1 enddo enddo ! CASE (3) do kr = bounds(3,1),bounds(3,2) do jr = bounds(2,1),bounds(2,2) !CDIR ALTCODE do ir = bounds(1,1),bounds(1,2) child_var % oldvalues2d(2,kindex) = parray3(ir,jr,kr) kindex = kindex + 1 enddo enddo enddo ! CASE (4) do lr = bounds(4,1),bounds(4,2) do kr = bounds(3,1),bounds(3,2) do jr = bounds(2,1),bounds(2,2) !CDIR ALTCODE do ir = bounds(1,1),bounds(1,2) child_var % oldvalues2d(2,kindex) = parray4(ir,jr,kr,lr) kindex = kindex + 1 enddo enddo enddo enddo ! CASE (5) do mr = bounds(5,1),bounds(5,2) do lr = bounds(4,1),bounds(4,2) do kr = bounds(3,1),bounds(3,2) do jr = bounds(2,1),bounds(2,2) !CDIR ALTCODE do ir = bounds(1,1),bounds(1,2) child_var % oldvalues2d(2,kindex) = parray5(ir,jr,kr,lr,mr) kindex = kindex + 1 enddo enddo enddo enddo enddo ! CASE (6) do nr = bounds(6,1),bounds(6,2) do mr = bounds(5,1),bounds(5,2) do lr = bounds(4,1),bounds(4,2) do kr = bounds(3,1),bounds(3,2) do jr = bounds(2,1),bounds(2,2) !CDIR ALTCODE do ir = bounds(1,1),bounds(1,2) child_var % oldvalues2d(2,kindex) = parray6(ir,jr,kr,lr,mr,nr) kindex = kindex + 1 enddo enddo enddo enddo enddo enddo END SELECT !--------------------------------------------------------------------------------------------------- end subroutine saveAfterInterp !=================================================================================================== ! !=================================================================================================== ! subroutine timeInterpolation ! !> subroutine for a linear time interpolation on the child grid !--------------------------------------------------------------------------------------------------- subroutine timeInterpolation ( child_var, bounds, kindex, c1t, c2t, nbdim ) !--------------------------------------------------------------------------------------------------- TYPE (Agrif_Variable) :: child_var !< The fine grid variable INTEGER, DIMENSION(nbdim,2) :: bounds INTEGER :: kindex !< Index indicating the values of the fine grid got !< before and after the space interpolation and !< used for the time interpolation REAL :: c1t, c2t !< Coefficients for the time interpolation (c2t=1-c1t) INTEGER :: nbdim ! INTEGER :: ir,jr,kr,lr,mr,nr INTEGER :: kindexmax, isize,i REAL,DIMENSION(:),ALLOCATABLE :: tabtemp isize = 1 DO i=1,nbdim isize = isize * (bounds(i,2)-bounds(i,1)+1) ENDDO IF (isize <= 0) RETURN kindexmax = kindex + isize - 1 IF (.NOT.ALLOCATED(parray_temp)) THEN ALLOCATE(parray_temp(kindexmax)) ELSE IF (size(parray_temp) < kindexmax) THEN ALLOCATE(tabtemp(size(parray_temp))) tabtemp = parray_temp DEALLOCATE(parray_temp) ALLOCATE(parray_temp(kindexmax)) parray_temp(1:size(tabtemp)) = tabtemp DEALLOCATE(tabtemp) ENDIF ENDIF ! SELECT CASE (nbdim) CASE (1) !CDIR ALTCODE do ir = bounds(1,1),bounds(1,2) parray1(ir) = c2t*child_var % oldvalues2d(1,kindex) + & c1t*child_var % oldvalues2d(2,kindex) kindex = kindex + 1 enddo ! CASE (2) do jr = bounds(2,1),bounds(2,2) !CDIR ALTCODE do ir = bounds(1,1),bounds(1,2) parray2(ir,jr) = c2t*child_var % oldvalues2d(1,kindex) + & c1t*child_var % oldvalues2d(2,kindex) kindex = kindex + 1 enddo enddo ! CASE (3) parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & c1t*child_var % oldvalues2d(2,kindex:kindexmax) ! CASE (4) parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & c1t*child_var % oldvalues2d(2,kindex:kindexmax) ! CASE (5) do mr=bounds(5,1),bounds(5,2) do lr=bounds(4,1),bounds(4,2) do kr=bounds(3,1),bounds(3,2) do jr=bounds(2,1),bounds(2,2) !CDIR ALTCODE do ir=bounds(1,1),bounds(1,2) parray5(ir,jr,kr,lr,mr) = c2t*child_var % oldvalues2d(1,kindex) + & c1t*child_var % oldvalues2d(2,kindex) kindex = kindex + 1 enddo enddo enddo enddo enddo ! CASE (6) do nr=bounds(6,1),bounds(6,2) do mr=bounds(5,1),bounds(5,2) do lr=bounds(4,1),bounds(4,2) do kr=bounds(3,1),bounds(3,2) do jr=bounds(2,1),bounds(2,2) !CDIR ALTCODE do ir=bounds(1,1),bounds(1,2) parray6(ir,jr,kr,lr,mr,nr) = c2t*child_var % oldvalues2d(1,kindex) + & c1t*child_var % oldvalues2d(2,kindex) kindex = kindex + 1 enddo enddo enddo enddo enddo enddo END SELECT kindex = kindexmax + 1 !--------------------------------------------------------------------------------------------------- end subroutine timeInterpolation !=================================================================================================== ! !=================================================================================================== ! subroutine Agrif_Checksize ! !> subroutine used in the saveAfterInterp procedure to allocate the oldvalues2d array !--------------------------------------------------------------------------------------------------- subroutine Agrif_Checksize ( child_var, newsize ) !--------------------------------------------------------------------------------------------------- TYPE (Agrif_Variable), INTENT(inout) :: child_var !< The fine grid variable INTEGER , INTENT(in) :: newsize !< Size of the domains where the boundary !< conditions are calculated ! REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array ! if (.NOT. associated(child_var % oldvalues2d)) then ! allocate(child_var % oldvalues2d(2,newsize)) child_var % oldvalues2d = 0. ! else ! if (SIZE(child_var % oldvalues2d,2) < newsize) then ! allocate(tempoldvalues(2,SIZE(child_var % oldvalues2d,2))) tempoldvalues = child_var % oldvalues2d deallocate(child_var % oldvalues2d) allocate( child_var % oldvalues2d(2,newsize)) child_var % oldvalues2d = 0. child_var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = tempoldvalues(:,:) deallocate(tempoldvalues) ! endif ! endif !--------------------------------------------------------------------------------------------------- end subroutine Agrif_Checksize !=================================================================================================== ! end module Agrif_Boundary