New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 10725 for vendors – NEMO

Changeset 10725 for vendors


Ignore:
Timestamp:
2019-02-27T14:55:54+01:00 (6 years ago)
Author:
rblod
Message:

Update agrif library and conv see ticket #2129

Location:
vendors/AGRIF/CMEMS_2020
Files:
23 edited

Legend:

Unmodified
Added
Removed
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modarrays.F90

    r10087 r10725  
    8888        ub_glob_index = ub_var(i) 
    8989#endif 
    90  
    9190        lb_tab_true(i) = max(lb_tab(i), lb_glob_index) 
    9291        ub_tab_true(i) = min(ub_tab(i), ub_glob_index) 
     
    234233    case (1) ; call Agrif_set_array_tozero_1D(variable%array1) 
    235234    case (2) ; call Agrif_set_array_tozero_2D(variable%array2) 
    236     case (3) ; call Agrif_set_array_tozero_reshape(variable%array3,size(variable%array3)) 
    237 !case (3) ; call Agrif_set_array_tozero_3D(variable%array3) 
     235    case (3) ; call Agrif_set_array_tozero_3D(variable%array3) 
    238236    case (4) ; call Agrif_set_array_tozero_4D(variable%array4) 
    239237    case (5) ; call Agrif_set_array_tozero_5D(variable%array5) 
     
    276274!=================================================================================================== 
    277275! 
    278 !=================================================================================================== 
    279 ! 
    280 !=================================================================================================== 
    281 !  subroutine agrif_set_array_cond 
    282 ! 
    283 !> Compute the masking of \b variablein, according to the required dimension. 
    284 !--------------------------------------------------------------------------------------------------- 
    285 subroutine agrif_set_array_cond ( variablein, variableout, value, nbdim ) 
    286 !--------------------------------------------------------------------------------------------------- 
    287     type(Agrif_Variable), intent(in)    :: variablein     !< Variablein 
    288     type(Agrif_Variable), intent(inout) :: variableout    !< Variableout 
    289     real,intent(in) :: value                            !< special value 
    290     integer, intent(in)                 :: nbdim        !< Dimension of the array 
    291  
    292 ! 
    293     select case (nbdim) 
    294     case (1) ; call agrif_set_array_cond_1D(variablein%array1,variableout%array1,value) 
    295     case (2) ; call agrif_set_array_cond_2D(variablein%array2,variableout%array2,value) 
    296     case (3) ; call agrif_set_array_cond_reshape(variablein%array3,variableout%array3,value,size(variablein%array3)) 
    297 !    case (3) ; call agrif_set_array_cond_3D(variablein%array3,variableout%array3,value) 
    298     case (4) ; call agrif_set_array_cond_4D(variablein%array4,variableout%array4,value) 
    299     case (5) ; call agrif_set_array_cond_5D(variablein%array5,variableout%array5,value) 
    300     case (6) ; call agrif_set_array_cond_6D(variablein%array6,variableout%array6,value) 
    301     end select 
    302 !--------------------------------------------------------------------------------------------------- 
    303 contains 
    304 !--------------------------------------------------------------------------------------------------- 
    305 subroutine agrif_set_array_cond_1D(arrayin,arrayout,value) 
    306 real,dimension(:),intent(in) :: arrayin 
    307 real,dimension(:),intent(out) :: arrayout 
    308 real :: value 
    309  
    310 where (arrayin == value) 
    311   arrayout = 0. 
    312 elsewhere 
    313   arrayout = 1. 
    314 end where 
    315  
    316 end subroutine agrif_set_array_cond_1D 
    317 ! 
    318 subroutine agrif_set_array_cond_2D(arrayin,arrayout,value) 
    319 real,dimension(:,:),intent(in) :: arrayin 
    320 real,dimension(:,:),intent(out) :: arrayout 
    321 real :: value 
    322  
    323 where (arrayin == value) 
    324   arrayout = 0. 
    325 elsewhere 
    326   arrayout = 1. 
    327 end where 
    328  
    329 end subroutine agrif_set_array_cond_2D 
    330 ! 
    331 subroutine agrif_set_array_cond_3D(arrayin,arrayout,value) 
    332 real,dimension(:,:,:),intent(in) :: arrayin 
    333 real,dimension(:,:,:),intent(out) :: arrayout 
    334 real :: value 
    335  
    336 where (arrayin == value) 
    337   arrayout = 0. 
    338 elsewhere 
    339   arrayout = 1. 
    340 end where 
    341  
    342 end subroutine agrif_set_array_cond_3D 
    343 ! 
    344 subroutine agrif_set_array_cond_4D(arrayin,arrayout,value) 
    345 real,dimension(:,:,:,:),intent(in) :: arrayin 
    346 real,dimension(:,:,:,:),intent(out) :: arrayout 
    347 real :: value 
    348  
    349 where (arrayin == value) 
    350   arrayout = 0. 
    351 elsewhere 
    352   arrayout = 1. 
    353 end where 
    354  
    355 end subroutine agrif_set_array_cond_4D 
    356 ! 
    357 subroutine agrif_set_array_cond_5D(arrayin,arrayout,value) 
    358 real,dimension(:,:,:,:,:),intent(in) :: arrayin 
    359 real,dimension(:,:,:,:,:),intent(out) :: arrayout 
    360 real :: value 
    361  
    362 where (arrayin == value) 
    363   arrayout = 0. 
    364 elsewhere 
    365   arrayout = 1. 
    366 end where 
    367  
    368 end subroutine agrif_set_array_cond_5D 
    369 ! 
    370 subroutine agrif_set_array_cond_6D(arrayin,arrayout,value) 
    371 real,dimension(:,:,:,:,:,:),intent(in) :: arrayin 
    372 real,dimension(:,:,:,:,:,:),intent(out) :: arrayout 
    373 real :: value 
    374  
    375 where (arrayin == value) 
    376   arrayout = 0. 
    377 elsewhere 
    378   arrayout = 1. 
    379 end where 
    380  
    381 end subroutine agrif_set_array_cond_6D 
    382 !--------------------------------------------------------------------------------------------------- 
    383 end subroutine agrif_set_array_cond 
    384276!=================================================================================================== 
    385277!  subroutine Agrif_var_copy_array 
     
    446338        real, dimension(l(1):,l(2):,l(3):), intent(out) :: tabout 
    447339        real, dimension(m(1):,m(2):,m(3):), intent(in)  :: tabin 
    448         integer :: i,j,k 
    449  
    450  
    451 !$OMP PARALLEL DO DEFAULT(none) PRIVATE(i,j,k) & 
    452 !$OMP SHARED(inf1,inf2,sup1,sup2,tabin,tabout) & 
    453 !$OMP SCHEDULE(RUNTIME) 
    454         do k=inf1(3),sup1(3) 
    455         do j=inf1(2),sup1(2) 
    456         do i=inf1(1),sup1(1) 
    457 !          tabout(i,j,k) = tabin(i+inf2(1)-inf1(1),j+inf2(2)-inf1(2),k+inf2(3)-inf1(3)) 
    458           tabout(i,j,k) = tabin(i,j,k) 
    459         enddo 
    460         enddo 
    461         enddo 
    462 !$OMP END PARALLEL DO 
    463  
    464  
    465 !        tabout(inf1(1):sup1(1), & 
    466 !               inf1(2):sup1(2), & 
    467 !               inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), & 
    468 !                                        inf2(2):sup2(2), & 
    469 !                                        inf2(3):sup2(3)) 
     340        tabout(inf1(1):sup1(1), & 
     341               inf1(2):sup1(2), & 
     342               inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), & 
     343                                        inf2(2):sup2(2), & 
     344                                        inf2(3):sup2(3)) 
    470345    end subroutine Agrif_copy_array_3d 
    471346! 
     
    764639    integer, dimension(6), intent(out)          :: lb_child     !< Lower bound on the child grid 
    765640    integer, dimension(6), intent(out)          :: lb_parent    !< Lower bound on the parent grid 
    766     real(kind=8), dimension(6),    intent(out)  :: s_child      !< Child  grid position (s_root = 0) 
    767     real(kind=8), dimension(6),    intent(out)  :: s_parent     !< Parent grid position (s_root = 0) 
    768     real(kind=8), dimension(6),    intent(out)  :: ds_child     !< Child  grid dx (ds_root = 1) 
    769     real(kind=8), dimension(6),    intent(out)  :: ds_parent    !< Parent grid dx (ds_root = 1) 
     641    real, dimension(6),    intent(out)          :: s_child      !< Child  grid position (s_root = 0) 
     642    real, dimension(6),    intent(out)          :: s_parent     !< Parent grid position (s_root = 0) 
     643    real, dimension(6),    intent(out)          :: ds_child     !< Child  grid dx (ds_root = 1) 
     644    real, dimension(6),    intent(out)          :: ds_parent    !< Parent grid dx (ds_root = 1) 
    770645    integer,               intent(out)          :: nbdim        !< Number of dimensions 
    771646    logical,               intent(in)           :: interp       !< .true. if preprocess for interpolation, \n 
     
    804679            else 
    805680                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) - 1 
    806                 s_child(n)  = s_child(n)  + 0.5d0*ds_child(n) 
    807                 s_parent(n) = s_parent(n) + 0.5d0*ds_parent(n) 
     681                s_child(n)  = s_child(n)  + 0.5*ds_child(n) 
     682                s_parent(n) = s_parent(n) + 0.5*ds_parent(n) 
    808683            endif 
    809684! 
     
    822697            else 
    823698                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) - 1 
    824                 s_child(n)  = s_child(n)  + 0.5d0*ds_child(n) 
    825                 s_parent(n) = s_parent(n) + 0.5d0*ds_parent(n) 
     699                s_child(n)  = s_child(n)  + 0.5*ds_child(n) 
     700                s_parent(n) = s_parent(n) + 0.5*ds_parent(n) 
    826701            endif 
    827702! 
     
    860735!           No interpolation but only a copy of the values of the grid variable 
    861736            lb_parent(n) = lb_child(n) 
    862             s_child(n)   = 0.d0 
    863             s_parent(n)  = 0.d0 
    864             ds_child(n)  = 1.d0 
    865             ds_parent(n) = 1.d0 
     737            s_child(n)   = 0. 
     738            s_parent(n)  = 0. 
     739            ds_child(n)  = 1. 
     740            ds_parent(n) = 1. 
    866741! 
    867742        end select 
     
    966841! 
    967842end module Agrif_Arrays 
    968  
    969  
    970 subroutine agrif_set_array_cond_reshape(arrayin,arrayout,value,n) 
    971 integer :: n 
    972 real,dimension(n) :: arrayin,arrayout 
    973 real :: value 
    974  
    975 integer :: i 
    976  
    977 do i=1,n 
    978   if (arrayin(i) == value) then 
    979     arrayout(i) = 0. 
    980   else 
    981     arrayout(i) = 1. 
    982   endif 
    983 enddo 
    984  
    985 end subroutine agrif_set_array_cond_reshape 
    986  
    987 subroutine agrif_set_array_tozero_reshape(array,n) 
    988 integer :: n 
    989 real,dimension(n) :: array 
    990  
    991 integer :: i 
    992  
    993 !$OMP PARALLEL DO DEFAULT(none) PRIVATE(i) & 
    994 !$OMP SHARED(array,n) 
    995 do i=1,n 
    996     array(i) = 0. 
    997 enddo 
    998 !$OMP END PARALLEL DO 
    999  
    1000 end subroutine agrif_set_array_tozero_reshape 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modbc.F90

    r10087 r10725  
    3232! 
    3333    implicit none 
    34     REAL,DIMENSION(:),ALLOCATABLE :: parray_temp 
    3534! 
    3635contains 
     
    6261    integer, dimension(6)  :: loctab_child      ! Indicates if the child grid has a common border 
    6362                                                !    with the root grid 
    64     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 
     63    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 
    6665! 
    6766    call PreProcessToInterpOrUpdate( parent,   child,       & 
     
    146145    INTEGER, DIMENSION(nbdim)   :: posvartab_Child      !< Position of the grid variable (1 or 2) 
    147146    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 grids 
    149     REAL(kind=8)   , DIMENSION(nbdim)   :: ds_Child, ds_Parent  !< Space steps of the parent and child grids 
     147    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 
    150149    INTEGER                             :: nbdim        !< Number of dimensions of the grid variable 
    151150    procedure()                         :: procname     !< Data recovery procedure 
     
    160159    INTEGER,DIMENSION(nbdim,2,2,nbdim)  :: ptres,ptres2 ! calculated 
    161160    INTEGER,DIMENSION(nbdim)            :: coords 
    162     INTEGER                             :: i, nb, ndir,j,k,l 
     161    INTEGER                             :: i, nb, ndir 
    163162    INTEGER                             :: n, sizetab 
    164163    INTEGER                             :: ibeg, iend 
    165164    INTEGER                             :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2 
    166165    REAL                                :: c1t,c2t      ! Coefficients for the time interpolation (c2t=1-c1t) 
    167     INTEGER :: isize 
    168     INTEGER :: kindex_2d(2,nbdim) 
    169  
    170166#if defined AGRIF_MPI 
    171167! 
     
    192188    END WHERE 
    193189! 
    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) 
    196191! 
    197192    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1)) 
     
    199194    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2)) 
    200195    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2)) 
    201     
    202196! 
    203197    do nb = 1,nbdim 
     
    273267                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 
    274268! 
    275  
    276269                    call Agrif_InterpnD(type_interp, parent, child,             & 
    277270                                        ptres(1:nbdim,1,ndir,nb),               & 
     
    326319        do nb = 1,nbdim 
    327320            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 
    330322                    Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim) 
    331323                endif 
     
    333325        enddo 
    334326! 
     327    endif 
     328! 
    335329    do nb = 1,nbdim 
    336330    do ndir = 1,2 
    337331        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  
    350332            select case(nbdim) 
    351333            case(1) 
     
    364346                              i1,i2,j1,j2, .FALSE.,coords(nb),ndir) 
    365347            case(3) 
    366  
    367348                i1 = child % childarray(1,1,2,nb,ndir) 
    368349                i2 = child % childarray(1,2,2,nb,ndir) 
     
    372353                k2 = child % childarray(3,2,2,nb,ndir) 
    373354 
    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) 
    376357            case(4) 
    377358                i1 = child % childarray(1,1,2,nb,ndir) 
     
    384365                l2 = child % childarray(4,2,2,nb,ndir) 
    385366 
    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) 
    388369            case(5) 
    389370                i1 = child % childarray(1,1,2,nb,ndir) 
     
    420401    enddo 
    421402    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  
    506403!--------------------------------------------------------------------------------------------------- 
    507404end subroutine Agrif_Correctnd 
     
    628525! 
    629526    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   
    653527! 
    654528    SELECT CASE (nbdim) 
     
    672546! 
    673547    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 
    678558! 
    679559    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 
    684572! 
    685573    CASE (5) 
     
    717605        enddo 
    718606    END SELECT 
    719  
    720     kindex = kindexmax + 1 
    721  
    722607!--------------------------------------------------------------------------------------------------- 
    723608end subroutine timeInterpolation 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modbcfunction.F90

    r10087 r10725  
    2121!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 
    2222! 
    23 !--------------------------------------------------------------------------------------------------- 
    2423!> Module Agrif_BcFunction. 
    25 !! 
    26 !--------------------------------------------------------------------------------------------------- 
     24! 
    2725module Agrif_BcFunction 
    2826! 
    2927!     Modules used: 
    3028! 
    31    use Agrif_User_Variables 
    32  
     29    use Agrif_Boundary 
     30    use Agrif_Update 
     31    use Agrif_Save 
    3332! 
    3433    implicit none 
     34! 
     35    interface Agrif_Set_Parent 
     36        module procedure Agrif_Set_Parent_int,      & 
     37                         Agrif_Set_Parent_real4,    & 
     38                         Agrif_Set_Parent_real8 
     39    end interface 
    3540! 
    3641    interface Agrif_Save_Forrestore 
     
    4247! 
    4348contains 
    44  
     49! 
     50!=================================================================================================== 
     51!  subroutine Agrif_Set_parent_int 
     52! 
     53!> To set the TYPE of the variable 
     54!--------------------------------------------------------------------------------------------------- 
     55subroutine Agrif_Set_parent_int(integer_variable,value) 
     56!--------------------------------------------------------------------------------------------------- 
     57    integer, intent(in)     :: integer_variable !< indice of the variable in tabvars 
     58    integer, intent(in)     :: value        !< input value 
     59! 
     60     
     61integer :: i 
     62logical :: i_found 
     63 
     64i_found = .FALSE. 
     65 
     66do i=1,Agrif_NbVariables(4) 
     67  if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then 
     68     agrif_curgrid%tabvars_i(i)%parent_var%iarray0 = value 
     69     i_found = .TRUE. 
     70     EXIT 
     71  endif 
     72enddo 
     73 
     74if (.NOT.i_found) STOP 'Agrif_Set_Integer : Variable not found' 
     75 
     76!--------------------------------------------------------------------------------------------------- 
     77end subroutine Agrif_Set_parent_int 
     78!=================================================================================================== 
     79! 
     80!=================================================================================================== 
     81!  subroutine Agrif_Set_parent_real4 
     82!--------------------------------------------------------------------------------------------------- 
     83!> To set the parent value of a real variable 
     84!--------------------------------------------------------------------------------------------------- 
     85subroutine Agrif_Set_parent_real4 ( real_variable, value ) 
     86!--------------------------------------------------------------------------------------------------- 
     87    real(kind=4), intent(in)     :: real_variable !< input variable 
     88    real(kind=4),intent(in) :: value        !< input value for the parent grid 
     89 
     90integer :: i 
     91logical :: i_found 
     92 
     93i_found = .FALSE. 
     94 
     95do i=1,Agrif_NbVariables(2) 
     96  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then 
     97     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value 
     98     agrif_curgrid%tabvars_r(i)%parent_var%sarray0 = value 
     99     i_found = .TRUE. 
     100     EXIT 
     101  endif 
     102enddo 
     103 
     104IF (.NOT.i_found) THEN 
     105do i=1,Agrif_NbVariables(2) 
     106  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then 
     107     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value 
     108     agrif_curgrid%tabvars_r(i)%parent_var%sarray0 = value 
     109     i_found = .TRUE. 
     110     EXIT 
     111  endif 
     112enddo 
     113ENDIF 
     114 
     115if (.NOT.i_found) STOP 'Agrif_Set_parent_real4 : Variable not found' 
     116 
     117!--------------------------------------------------------------------------------------------------- 
     118end subroutine Agrif_Set_parent_real4 
     119!=================================================================================================== 
     120! 
     121!=================================================================================================== 
     122!  subroutine Agrif_Set_parent_real8 
     123!--------------------------------------------------------------------------------------------------- 
     124!> To set the parent value of a real variable 
     125!--------------------------------------------------------------------------------------------------- 
     126subroutine Agrif_Set_parent_real8 ( real_variable, value ) 
     127!--------------------------------------------------------------------------------------------------- 
     128    real(kind=8), intent(in)     :: real_variable !< input variable 
     129    real(kind=8),intent(in) :: value        !< input value for the parent grid 
     130 
     131integer :: i 
     132logical :: i_found 
     133 
     134i_found = .FALSE. 
     135 
     136do i=1,Agrif_NbVariables(2) 
     137  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then 
     138     agrif_curgrid%tabvars_r(i)%parent_var%darray0 = value 
     139     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value 
     140     i_found = .TRUE. 
     141     EXIT 
     142  endif 
     143enddo 
     144 
     145IF (.NOT.i_found) THEN 
     146do i=1,Agrif_NbVariables(2) 
     147  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then 
     148     agrif_curgrid%tabvars_r(i)%parent_var%darray0 = value 
     149     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value 
     150     i_found = .TRUE. 
     151     EXIT 
     152  endif 
     153enddo 
     154ENDIF 
     155 
     156if (.NOT.i_found) STOP 'Agrif_Set_parent_real8 : Variable not found' 
     157 
     158!--------------------------------------------------------------------------------------------------- 
     159end subroutine Agrif_Set_parent_real8 
     160!=================================================================================================== 
     161! 
     162!=================================================================================================== 
     163!  subroutine Agrif_Set_bc 
     164!--------------------------------------------------------------------------------------------------- 
     165subroutine Agrif_Set_bc ( tabvarsindic, bcinfsup, Interpolationshouldbemade ) 
     166!--------------------------------------------------------------------------------------------------- 
     167    integer,               intent(in)   :: tabvarsindic !< indice of the variable in tabvars 
     168    integer, dimension(2), intent(in)   :: bcinfsup     !< bcinfsup 
     169    logical, optional,     intent(in)   :: Interpolationshouldbemade !< interpolation should be made 
     170! 
     171    integer                         :: indic ! indice of the variable in tabvars 
     172    type(Agrif_Variable),  pointer  :: var 
     173! 
     174    var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
     175    if (.not.associated(var)) return ! Grand mother grid case 
     176! 
     177    if ( Agrif_Curgrid % fixedrank /= 0 ) then 
     178        if ( .not.associated(var % oldvalues2D) ) then 
     179            allocate(var % oldvalues2D(2,1)) 
     180            var % interpIndex = -1 
     181            var % oldvalues2D = 0. 
     182        endif 
     183        if ( present(Interpolationshouldbemade) ) then 
     184            var % Interpolationshouldbemade = Interpolationshouldbemade 
     185        endif 
     186    endif 
     187! 
     188    var % bcinf = bcinfsup(1) 
     189    var % bcsup = bcinfsup(2) 
     190!--------------------------------------------------------------------------------------------------- 
     191end subroutine Agrif_Set_bc 
     192!=================================================================================================== 
     193! 
     194!=================================================================================================== 
     195!  subroutine Agrif_Set_interp 
     196!--------------------------------------------------------------------------------------------------- 
     197subroutine Agrif_Set_interp ( tabvarsindic, interp, interp1, interp2, interp3 , interp4) 
     198!--------------------------------------------------------------------------------------------------- 
     199    integer,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars 
     200    integer, optional, intent(in)   :: interp, interp1, interp2, interp3, interp4 
     201! 
     202    integer                         :: indic ! indice of the variable in tabvars 
     203    type(Agrif_Variable), pointer   :: var 
     204! 
     205    var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
     206    if (.not.associated(var)) return ! Grand mother grid case 
     207! 
     208    var % type_interp = Agrif_Constant 
     209! 
     210    if (present(interp))    var % type_interp    = interp 
     211    if (present(interp1))   var % type_interp(1) = interp1 
     212    if (present(interp2))   var % type_interp(2) = interp2 
     213    if (present(interp3))   var % type_interp(3) = interp3 
     214    if (present(interp4))   var % type_interp(4) = interp4 
     215!--------------------------------------------------------------------------------------------------- 
     216end subroutine Agrif_Set_interp 
     217!=================================================================================================== 
     218! 
     219!=================================================================================================== 
     220!  subroutine Agrif_Set_bcinterp 
     221!--------------------------------------------------------------------------------------------------- 
     222subroutine Agrif_Set_bcinterp ( tabvarsindic, interp,   interp1,  interp2,  interp3, interp4, & 
     223                                              interp11, interp12, interp21, interp22 ) 
     224!--------------------------------------------------------------------------------------------------- 
     225    INTEGER,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars 
     226    INTEGER, OPTIONAL, intent(in)   :: interp,   interp1,  interp2,  interp3, interp4 
     227    INTEGER, OPTIONAL, intent(in)   :: interp11, interp12, interp21, interp22 
     228! 
     229    INTEGER                         :: indic ! indice of the variable in tabvars 
     230    TYPE(Agrif_Variable), pointer   :: var 
     231! 
     232    var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
     233! 
     234    var % type_interp_bc = Agrif_Constant 
     235! 
     236    if (present(interp))    var % type_interp_bc      = interp 
     237    if (present(interp1))   var % type_interp_bc(:,1) = interp1 
     238    if (present(interp11))  var % type_interp_bc(1,1) = interp11 
     239    if (present(interp12))  var % type_interp_bc(1,2) = interp12 
     240    if (present(interp2))   var % type_interp_bc(:,2) = interp2 
     241    if (present(interp21))  var % type_interp_bc(2,1) = interp21 
     242    if (present(interp22))  var % type_interp_bc(2,2) = interp22 
     243    if (present(interp3))   var % type_interp_bc(:,3) = interp3 
     244    if (present(interp4))   var % type_interp_bc(:,4) = interp4 
     245!--------------------------------------------------------------------------------------------------- 
     246end subroutine Agrif_Set_bcinterp 
     247!=================================================================================================== 
     248! 
     249!=================================================================================================== 
     250!  subroutine Agrif_Set_UpdateType 
     251!--------------------------------------------------------------------------------------------------- 
     252subroutine Agrif_Set_UpdateType ( tabvarsindic, update,  update1, update2, & 
     253                                                update3, update4, update5 ) 
     254!--------------------------------------------------------------------------------------------------- 
     255    INTEGER,           intent(in) :: tabvarsindic     !< indice of the variable in tabvars 
     256    INTEGER, OPTIONAL, intent(in) :: update, update1, update2, update3, update4, update5 
     257! 
     258    INTEGER                         :: indic ! indice of the variable in tabvars 
     259    type(Agrif_Variable),  pointer  :: root_var 
     260! 
     261 
     262        root_var => Agrif_Search_Variable(Agrif_Mygrid,tabvarsindic) 
     263 
     264! 
     265    root_var % type_update = Agrif_Update_Copy 
     266    if (present(update))    root_var % type_update    = update 
     267    if (present(update1))   root_var % type_update(1) = update1 
     268    if (present(update2))   root_var % type_update(2) = update2 
     269    if (present(update3))   root_var % type_update(3) = update3 
     270    if (present(update4))   root_var % type_update(4) = update4 
     271    if (present(update5))   root_var % type_update(5) = update5 
     272!--------------------------------------------------------------------------------------------------- 
     273end subroutine Agrif_Set_UpdateType 
     274!=================================================================================================== 
     275! 
    45276!=================================================================================================== 
    46277!  subroutine Agrif_Set_restore 
    47 !> This subroutine is used to set the index of the current grid variable we want to restore. 
    48278!--------------------------------------------------------------------------------------------------- 
    49279subroutine Agrif_Set_restore ( tabvarsindic ) 
     
    64294! 
    65295!=================================================================================================== 
     296!  subroutine Agrif_Init_variable 
     297!--------------------------------------------------------------------------------------------------- 
     298subroutine Agrif_Init_variable ( tabvarsindic, procname ) 
     299!--------------------------------------------------------------------------------------------------- 
     300    INTEGER, intent(in)  :: tabvarsindic     !< indice of the variable in tabvars 
     301    procedure()          :: procname         !< Data recovery procedure 
     302! 
     303    if ( Agrif_Curgrid%level <= 0 ) return 
     304! 
     305    call Agrif_Interp_variable(tabvarsindic, procname) 
     306    call Agrif_Bc_variable(tabvarsindic, procname, 1.) 
     307!--------------------------------------------------------------------------------------------------- 
     308end subroutine Agrif_Init_variable 
     309!=================================================================================================== 
     310! 
     311!=================================================================================================== 
     312!  subroutine Agrif_Bc_variable 
     313!--------------------------------------------------------------------------------------------------- 
     314subroutine Agrif_Bc_variable ( tabvarsindic, procname, calledweight ) 
     315!--------------------------------------------------------------------------------------------------- 
     316    integer,        intent(in) :: tabvarsindic     !< indice of the variable in tabvars 
     317    procedure()                :: procname 
     318    real, optional, intent(in) :: calledweight 
     319! 
     320    real    :: weight 
     321    logical :: pweight 
     322    integer :: indic 
     323    integer :: nbdim 
     324    type(Agrif_Variable), pointer :: root_var 
     325    type(Agrif_Variable), pointer :: parent_var 
     326    type(Agrif_Variable), pointer :: child_var 
     327    type(Agrif_Variable), pointer :: child_tmp      ! Temporary variable on the child grid 
     328    integer :: i 
     329    integer,dimension(7) :: lb, ub 
     330! 
     331    if ( Agrif_Curgrid%level <= 0 ) return 
     332! 
     333! 
     334    if ( present(calledweight) ) then 
     335        weight  = calledweight 
     336        pweight = .true. 
     337    else 
     338        weight  = 0. 
     339        pweight = .false. 
     340    endif 
     341! 
     342        child_var  => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
     343        parent_var => child_var % parent_var 
     344        root_var   => child_var % root_var 
     345! 
     346    nbdim = root_var % nbdim 
     347! 
     348    do i=1,nbdim 
     349      if (root_var%coords(i) == 0) then 
     350        lb(i) = parent_var%lb(i) 
     351        ub(i) = parent_var%ub(i) 
     352      else 
     353        lb(i) = child_var%lb(i) 
     354        ub(i) = child_var%ub(i) 
     355      endif 
     356    enddo 
     357 
     358    select case( nbdim ) 
     359    case(1) 
     360        allocate(parray1(lb(1):ub(1))) 
     361    case(2) 
     362        allocate(parray2(lb(1):ub(1), & 
     363                         lb(2):ub(2) )) 
     364    case(3) 
     365        allocate(parray3(lb(1):ub(1), & 
     366                         lb(2):ub(2), & 
     367                         lb(3):ub(3) )) 
     368    case(4) 
     369        allocate(parray4(lb(1):ub(1), & 
     370                         lb(2):ub(2), & 
     371                         lb(3):ub(3), & 
     372                         lb(4):ub(4) )) 
     373    case(5) 
     374        allocate(parray5(lb(1):ub(1), & 
     375                         lb(2):ub(2), & 
     376                         lb(3):ub(3), & 
     377                         lb(4):ub(4), & 
     378                         lb(5):ub(5) )) 
     379    case(6) 
     380        allocate(parray6(lb(1):ub(1), & 
     381                         lb(2):ub(2), & 
     382                         lb(3):ub(3), & 
     383                         lb(4):ub(4), & 
     384                         lb(5):ub(5), & 
     385                         lb(6):ub(6) )) 
     386    end select 
     387! 
     388!   Create temporary child variable 
     389    allocate(child_tmp) 
     390! 
     391    child_tmp % root_var => root_var 
     392    child_tmp % oldvalues2D => child_var % oldvalues2D 
     393! 
     394!   Index indicating if a space interpolation is necessary 
     395    child_tmp % interpIndex =  child_var % interpIndex 
     396    child_tmp % list_interp => child_var % list_interp 
     397    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade 
     398! 
     399    child_tmp % point = child_var % point 
     400    child_tmp % lb = child_var % lb 
     401    child_tmp % ub = child_var % ub 
     402! 
     403    child_tmp % bcinf = child_var % bcinf 
     404    child_tmp % bcsup = child_var % bcsup 
     405! 
     406    child_tmp % childarray = child_var % childarray 
     407    child_tmp % memberin   = child_var % memberin 
     408! 
     409    call Agrif_CorrectVariable(parent_var, child_tmp, pweight, weight, procname) 
     410! 
     411    child_var % childarray = child_tmp % childarray 
     412    child_var % memberin   = child_tmp % memberin 
     413! 
     414    child_var % oldvalues2D => child_tmp % oldvalues2D 
     415    child_var % list_interp => child_tmp % list_interp 
     416! 
     417    child_var % interpIndex = child_tmp % interpIndex 
     418! 
     419    deallocate(child_tmp) 
     420! 
     421    select case( nbdim ) 
     422        case(1); deallocate(parray1) 
     423        case(2); deallocate(parray2) 
     424        case(3); deallocate(parray3) 
     425        case(4); deallocate(parray4) 
     426        case(5); deallocate(parray5) 
     427        case(6); deallocate(parray6) 
     428    end select 
     429!--------------------------------------------------------------------------------------------------- 
     430end subroutine Agrif_Bc_variable 
     431!=================================================================================================== 
     432! 
     433!=================================================================================================== 
     434!  subroutine Agrif_Interp_variable 
     435!--------------------------------------------------------------------------------------------------- 
     436subroutine Agrif_Interp_variable ( tabvarsindic, procname ) 
     437!--------------------------------------------------------------------------------------------------- 
     438    integer,     intent(in)     :: tabvarsindic     !< indice of the variable in tabvars 
     439    procedure()                 :: procname         !< Data recovery procedure 
     440! 
     441    integer :: nbdim 
     442    integer :: indic  ! indice of the variable in tabvars 
     443    logical :: torestore 
     444    type(Agrif_Variable), pointer   :: root_var 
     445    type(Agrif_Variable), pointer   :: parent_var       ! Variable on the parent grid 
     446    type(Agrif_Variable), pointer   :: child_var        ! Variable on the parent grid 
     447    type(Agrif_Variable), pointer   :: child_tmp        ! Temporary variable on the child grid 
     448! 
     449 
     450    if ( Agrif_Curgrid%level <= 0 ) return 
     451! 
     452 
     453        child_var  => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
     454        parent_var => child_var % parent_var 
     455        root_var   => child_var % root_var 
     456 
     457! 
     458    nbdim     = root_var % nbdim 
     459    torestore = root_var % restore 
     460! 
     461    allocate(child_tmp) 
     462! 
     463    child_tmp % root_var => root_var 
     464    child_tmp % nbdim = root_var % nbdim 
     465    child_tmp % point = child_var % point 
     466    child_tmp % lb = child_var % lb 
     467    child_tmp % ub = child_var % ub 
     468    child_tmp % interpIndex =  child_var % interpIndex 
     469    child_tmp % list_interp => child_var % list_interp 
     470    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade 
     471! 
     472    if ( torestore ) then 
     473        select case( nbdim ) 
     474        case(1) 
     475            parray1 = child_var % array1 
     476            child_tmp % restore1D => child_var % restore1D 
     477        case(2) 
     478            parray2 = child_var % array2 
     479            child_tmp % restore2D => child_var % restore2D 
     480        case(3) 
     481            parray3 = child_var % array3 
     482            child_tmp % restore3D => child_var % restore3D 
     483        case(4) 
     484            parray4 = child_var % array4 
     485            child_tmp % restore4D => child_var % restore4D 
     486        case(5) 
     487            parray5 = child_var % array5 
     488            child_tmp % restore5D => child_var % restore5D 
     489        case(6) 
     490            parray6 = child_var % array6 
     491            child_tmp % restore6D => child_var % restore6D 
     492        end select 
     493    endif 
     494! 
     495    call Agrif_InterpVariable(parent_var, child_tmp, torestore, procname) 
     496! 
     497    child_var % list_interp => child_tmp % list_interp 
     498! 
     499    deallocate(child_tmp) 
     500!--------------------------------------------------------------------------------------------------- 
     501end subroutine Agrif_Interp_variable 
     502!=================================================================================================== 
     503! 
     504!=================================================================================================== 
     505!  subroutine Agrif_Update_Variable 
     506!--------------------------------------------------------------------------------------------------- 
     507subroutine Agrif_Update_Variable ( tabvarsindic, procname, & 
     508                                   locupdate, locupdate1, locupdate2, locupdate3, locupdate4 ) 
     509!--------------------------------------------------------------------------------------------------- 
     510    integer,               intent(in)           :: tabvarsindic     !< Indice of the variable in tabvars 
     511    procedure()                                 :: procname         !< Data recovery procedure 
     512    integer, dimension(2), intent(in), optional :: locupdate 
     513    integer, dimension(2), intent(in), optional :: locupdate1 
     514    integer, dimension(2), intent(in), optional :: locupdate2 
     515    integer, dimension(2), intent(in), optional :: locupdate3 
     516    integer, dimension(2), intent(in), optional :: locupdate4 
     517!--------------------------------------------------------------------------------------------------- 
     518    integer :: indic 
     519    integer :: nbdim 
     520    integer, dimension(6)           :: updateinf    ! First positions where interpolations are calculated 
     521    integer, dimension(6)           :: updatesup    ! Last  positions where interpolations are calculated 
     522    type(Agrif_Variable), pointer   :: root_var 
     523    type(Agrif_Variable), pointer   :: parent_var 
     524    type(Agrif_Variable), pointer   :: child_var 
     525! 
     526    if ( Agrif_Root() .AND. (.not.agrif_coarse) ) return 
     527    if (agrif_curgrid%grand_mother_grid) return 
     528! 
     529 
     530        child_var  => Agrif_Search_Variable(Agrif_Curgrid, tabvarsindic) 
     531        parent_var => child_var % parent_var 
     532 
     533        if (.not.associated(parent_var)) then 
     534          ! can occur during the first update of Agrif_Coarsegrid (if any) 
     535          parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, tabvarsindic) 
     536          child_var % parent_var => parent_var 
     537        endif 
     538 
     539        root_var   => child_var % root_var 
     540 
     541! 
     542    nbdim = root_var % nbdim 
     543! 
     544    updateinf = -99 
     545    updatesup = -99 
     546! 
     547    if ( present(locupdate) ) then 
     548        updateinf(1:nbdim) = locupdate(1) 
     549        updatesup(1:nbdim) = locupdate(2) 
     550    endif 
     551! 
     552    if ( present(locupdate1) ) then 
     553        updateinf(1) = locupdate1(1) 
     554        updatesup(1) = locupdate1(2) 
     555    endif 
     556! 
     557    if ( present(locupdate2) ) then 
     558        updateinf(2) = locupdate2(1) 
     559        updatesup(2) = locupdate2(2) 
     560    endif 
     561 
     562    if ( present(locupdate3) ) then 
     563        updateinf(3) = locupdate3(1) 
     564        updatesup(3) = locupdate3(2) 
     565    endif 
     566 
     567    if ( present(locupdate4) ) then 
     568        updateinf(4) = locupdate4(1) 
     569        updatesup(4) = locupdate4(2) 
     570    endif 
     571! 
     572    call Agrif_UpdateVariable( parent_var, child_var, updateinf, updatesup, procname ) 
     573!--------------------------------------------------------------------------------------------------- 
     574end subroutine Agrif_Update_Variable 
     575!=================================================================================================== 
     576! 
     577!=================================================================================================== 
    66578!  subroutine Agrif_Save_ForRestore0D 
    67579!--------------------------------------------------------------------------------------------------- 
    68580subroutine Agrif_Save_ForRestore0D ( tabvarsindic0, tabvarsindic ) 
    69581!--------------------------------------------------------------------------------------------------- 
    70     integer, intent(in) :: tabvarsindic0 !< index of the current grid variable  
    71     integer, intent(in) :: tabvarsindic  !< index of the varible which should be restored 
    72      
     582    integer, intent(in) :: tabvarsindic0, tabvarsindic 
    73583! 
    74584    type(Agrif_Variable), pointer   :: root_var, save_var 
     
    92602!=================================================================================================== 
    93603!  subroutine Agrif_Save_ForRestore2D 
    94 !> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 2D-variable. 
    95604!--------------------------------------------------------------------------------------------------- 
    96605subroutine Agrif_Save_ForRestore2D ( q, tabvarsindic ) 
    97606!--------------------------------------------------------------------------------------------------- 
    98 ! 
    99 real, dimension(:,:), intent(in) :: q            !< input 2D-variable which should be saved 
    100 integer,            intent(in) :: tabvarsindic !< index of the current grid variable we want to restore 
     607    real, dimension(:,:), intent(in)        :: q 
     608    integer,              intent(in)        :: tabvarsindic 
    101609! 
    102610    type(Agrif_Variable),  pointer  :: root_var, save_var 
     
    133641!=================================================================================================== 
    134642!  subroutine Agrif_Save_ForRestore3D 
    135 !> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 3D-variable. 
    136643!--------------------------------------------------------------------------------------------------- 
    137644subroutine Agrif_Save_ForRestore3D ( q, tabvarsindic ) 
    138645!--------------------------------------------------------------------------------------------------- 
    139 ! 
    140 real, dimension(:,:,:), intent(in) :: q !< input 3D-variable which should be saved 
    141 integer, intent(in) :: tabvarsindic    !< index of the current grid variable we want to restore 
     646    real, dimension(:,:,:), intent(in)      :: q 
     647    integer,                intent(in)      :: tabvarsindic 
    142648! 
    143649    type(Agrif_Variable),  pointer  :: root_var, save_var 
     
    176682!=================================================================================================== 
    177683!  subroutine Agrif_Save_ForRestore4D 
    178 !> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 4D-variable. 
    179684!--------------------------------------------------------------------------------------------------- 
    180685subroutine Agrif_Save_ForRestore4D ( q, tabvarsindic ) 
    181686!--------------------------------------------------------------------------------------------------- 
    182 ! 
    183 real, dimension(:,:,:,:), intent(in) :: q !< input 4D-variable which should be saved 
    184 integer, intent(in) :: tabvarsindic      !< index of the current grid variable we want to restore 
    185 ! 
     687    real, dimension(:,:,:,:), intent(in)    :: q 
     688    integer,                  intent(in)    :: tabvarsindic 
    186689! 
    187690    type(Agrif_Variable),  pointer  :: root_var, save_var 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modcluster.F90

    r10087 r10725  
    2929module Agrif_Clustering 
    3030! 
    31     !use Agrif_CurgridFunctions 
    32     !use Agrif_Init_Vars 
    33     !use Agrif_Save 
     31    use Agrif_CurgridFunctions 
    3432    use Agrif_Init_Vars 
    3533    use Agrif_Save 
    36     use Agrif_Init 
    3734! 
    3835    implicit none 
     
    5754    TYPE(Agrif_LRectangle), pointer  :: parcours 
    5855    TYPE(Agrif_Grid)      , pointer  :: newgrid 
    59     REAL(kind=8)                     :: g_eps 
     56    REAL                             :: g_eps 
    6057    INTEGER                          :: i 
    6158! 
     
    134131    TYPE(Agrif_PGrid), pointer  :: parcours 
    135132! 
    136     REAL(kind=8)                  :: g_eps, newgrid_eps, eps 
    137     REAL(kind=8)   , DIMENSION(3) :: newmin, newmax 
    138     REAL(kind=8)   , DIMENSION(3) :: gmin, gmax 
    139     REAL(kind=8)   , DIMENSION(3) :: xmin 
     133    REAL                  :: g_eps, newgrid_eps, eps 
     134    REAL   , DIMENSION(3) :: newmin, newmax 
     135    REAL   , DIMENSION(3) :: gmin, gmax 
     136    REAL   , DIMENSION(3) :: xmin 
    140137    INTEGER, DIMENSION(3) :: igmin, inewmin 
    141138    INTEGER, DIMENSION(3) :: inewmax 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modcurgridfunctions.F90

    r10087 r10725  
    2929    implicit none 
    3030! 
     31 
     32    interface Agrif_Parent 
     33        module procedure Agrif_Parent_Real_4,   & 
     34                         Agrif_Parent_Real_8,   & 
     35                         Agrif_Parent_Array2_Real_8,   & 
     36                         Agrif_Parent_Integer, & 
     37                         Agrif_Parent_Character, & 
     38                         Agrif_Parent_Logical 
     39    end interface 
     40     
    3141contains 
    3242! 
     
    92102! 
    93103    rhot = float(Agrif_IRhot()) 
    94      
    95104!--------------------------------------------------------------------------------------------------- 
    96105end function Agrif_Rhot 
     
    764773!=================================================================================================== 
    765774! 
     775 
     776function Agrif_Parent_Real_4(real_variable) result(real_variable_parent) 
     777real(KIND=4) :: real_variable 
     778real(KIND=4) :: real_variable_parent 
     779 
     780integer :: i 
     781logical :: i_found 
     782 
     783i_found = .FALSE. 
     784 
     785do i=1,Agrif_NbVariables(2) 
     786  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then 
     787     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0 
     788     i_found = .TRUE. 
     789     EXIT 
     790  endif 
     791enddo 
     792 
     793IF (.NOT.i_found) THEN 
     794do i=1,Agrif_NbVariables(2) 
     795  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then 
     796     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%sarray0 
     797     i_found = .TRUE. 
     798     EXIT 
     799  endif 
     800enddo 
     801ENDIF 
     802 
     803if (.NOT.i_found) STOP 'Agrif_Parent_Real_4 : Variable not found' 
     804 
     805end function Agrif_Parent_Real_4 
     806 
     807function Agrif_Parent_Real_8(real_variable) result(real_variable_parent) 
     808real(KIND=8) :: real_variable 
     809real(KIND=8) :: real_variable_parent 
     810 
     811integer :: i 
     812logical :: i_found 
     813 
     814i_found = .FALSE. 
     815 
     816do i=1,Agrif_NbVariables(2) 
     817  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then 
     818     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0 
     819     i_found = .TRUE. 
     820     EXIT 
     821  endif 
     822enddo 
     823 
     824IF (.NOT.i_found) THEN 
     825do i=1,Agrif_NbVariables(2) 
     826  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then 
     827     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%darray0 
     828     i_found = .TRUE. 
     829     EXIT 
     830  endif 
     831enddo 
     832ENDIF 
     833 
     834if (.NOT.i_found) STOP 'Agrif_Parent_Real_8 : Variable not found' 
     835 
     836end function Agrif_Parent_Real_8 
     837 
     838function Agrif_Parent_Array2_Real_8(real_variable,ji,jj) result(real_variable_parent) 
     839real(KIND=8), DIMENSION(:,:) :: real_variable 
     840real(KIND=8) :: real_variable_parent 
     841integer :: ji,jj 
     842 
     843integer :: i 
     844logical :: i_found 
     845 
     846i_found = .FALSE. 
     847 
     848do i=1,Agrif_NbVariables(0) 
     849  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars(i)%array2)) then 
     850     real_variable_parent = agrif_curgrid%tabvars(i)%parent_var%array2(ji,jj) 
     851     i_found = .TRUE. 
     852     EXIT 
     853  endif 
     854enddo 
     855 
     856if (.NOT.i_found) STOP 'Agrif_Parent_Array2_Real_8 : Variable not found' 
     857 
     858end function Agrif_Parent_Array2_Real_8 
     859 
     860 
     861function Agrif_Parent_Integer(integer_variable) result(integer_variable_parent) 
     862integer :: integer_variable 
     863integer :: integer_variable_parent 
     864 
     865integer :: i 
     866logical :: i_found 
     867 
     868i_found = .FALSE. 
     869 
     870do i=1,Agrif_NbVariables(4) 
     871  if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then 
     872     integer_variable_parent = agrif_curgrid%tabvars_i(i)%parent_var%iarray0 
     873     i_found = .TRUE. 
     874     EXIT 
     875  endif 
     876enddo 
     877 
     878if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' 
     879 
     880end function Agrif_Parent_Integer 
     881 
     882function Agrif_Parent_Character(character_variable) result(character_variable_parent) 
     883character(*) :: character_variable 
     884character(len(character_variable)) :: character_variable_parent 
     885 
     886integer :: i 
     887logical :: i_found 
     888 
     889i_found = .FALSE. 
     890 
     891do i=1,Agrif_NbVariables(1) 
     892  if (LOC(character_variable) == LOC(agrif_curgrid%tabvars_c(i)%carray0)) then 
     893     character_variable_parent = agrif_curgrid%tabvars_c(i)%parent_var%carray0 
     894     i_found = .TRUE. 
     895     EXIT 
     896  endif 
     897enddo 
     898 
     899if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' 
     900 
     901end function Agrif_Parent_Character 
     902 
     903function Agrif_Parent_Logical(logical_variable) result(logical_variable_parent) 
     904logical :: logical_variable 
     905logical :: logical_variable_parent 
     906 
     907integer :: i 
     908logical :: i_found 
     909 
     910i_found = .FALSE. 
     911 
     912do i=1,Agrif_NbVariables(3) 
     913  if (LOC(logical_variable) == LOC(agrif_curgrid%tabvars_l(i)%larray0)) then 
     914     logical_variable_parent = agrif_curgrid%tabvars_l(i)%parent_var%larray0 
     915     i_found = .TRUE. 
     916     EXIT 
     917  endif 
     918enddo 
     919 
     920if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' 
     921 
     922end function Agrif_Parent_Logical 
     923 
     924function Agrif_Irhox() result(i_val) 
     925integer :: i_val 
     926i_val = agrif_curgrid%spaceref(1) 
     927end function Agrif_Irhox 
     928 
     929function Agrif_Irhoy() result(i_val) 
     930integer :: i_val 
     931i_val = agrif_curgrid%spaceref(2) 
     932end function Agrif_Irhoy 
     933 
     934function Agrif_Irhoz() result(i_val) 
     935integer :: i_val 
     936i_val = agrif_curgrid%spaceref(3) 
     937end function Agrif_Irhoz 
     938 
     939function Agrif_NearCommonBorderX() result(l_val) 
     940logical :: l_val 
     941l_val = agrif_curgrid%nearRootBorder(1) 
     942end function Agrif_NearCommonBorderX 
     943 
     944function Agrif_NearCommonBorderY() result(l_val) 
     945logical :: l_val 
     946l_val = agrif_curgrid%nearRootBorder(2) 
     947end function Agrif_NearCommonBorderY 
     948 
     949function Agrif_NearCommonBorderZ() result(l_val) 
     950logical :: l_val 
     951l_val = agrif_curgrid%nearRootBorder(3) 
     952end function Agrif_NearCommonBorderZ 
     953 
     954function Agrif_DistantCommonBorderX() result(l_val) 
     955logical :: l_val 
     956l_val = agrif_curgrid%DistantRootBorder(1) 
     957end function Agrif_DistantCommonBorderX 
     958 
     959function Agrif_DistantCommonBorderY() result(l_val) 
     960logical :: l_val 
     961l_val = agrif_curgrid%DistantRootBorder(2) 
     962end function Agrif_DistantCommonBorderY 
     963 
     964function Agrif_DistantCommonBorderZ() result(l_val) 
     965logical :: l_val 
     966l_val = agrif_curgrid%DistantRootBorder(3) 
     967end function Agrif_DistantCommonBorderZ 
     968 
     969function Agrif_Ix() result(i_val) 
     970integer :: i_val 
     971i_val = agrif_curgrid%ix(1) 
     972end function Agrif_Ix 
     973 
     974function Agrif_Iy() result(i_val) 
     975integer :: i_val 
     976i_val = agrif_curgrid%ix(2) 
     977end function Agrif_Iy 
     978 
     979function Agrif_Iz() result(i_val) 
     980integer :: i_val 
     981i_val = agrif_curgrid%ix(3) 
     982end function Agrif_Iz 
     983 
     984function Agrif_Get_grid_id() result(i_val) 
     985integer :: i_val 
     986i_val = agrif_curgrid % grid_id 
     987end function Agrif_Get_grid_id 
     988 
     989function Agrif_Get_parent_id() result(i_val) 
     990integer :: i_val 
     991i_val = agrif_curgrid % parent % grid_id 
     992end function Agrif_Get_parent_id 
     993 
     994function Agrif_rhox() result(r_val) 
     995real :: r_val 
     996r_val = real(agrif_curgrid%spaceref(1)) 
     997end function Agrif_rhox 
     998 
     999function Agrif_rhoy() result(r_val) 
     1000real :: r_val 
     1001r_val = real(agrif_curgrid%spaceref(2)) 
     1002end function Agrif_rhoy 
     1003 
     1004function Agrif_rhoz() result(r_val) 
     1005real :: r_val 
     1006r_val = real(agrif_curgrid%spaceref(3)) 
     1007end function Agrif_rhoz 
     1008 
     1009function Agrif_Nb_Step() result(i_val) 
     1010integer :: i_val 
     1011i_val = agrif_curgrid%ngridstep 
     1012end function Agrif_Nb_Step 
     1013 
     1014function Agrif_Nb_Fine_Grids() result(i_val) 
     1015integer :: i_val 
     1016i_val = Agrif_nbfixedgrids 
     1017end function Agrif_Nb_Fine_Grids 
     1018 
    7661019end module Agrif_CurgridFunctions 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modgrids.F90

    r10087 r10725  
    4444    type(Agrif_Variable_i), dimension(:), allocatable :: tabvars_i  !< List of integer   grid variables 
    4545! 
    46     real(kind=8), dimension(3)         :: Agrif_x   !< global x, y and z position 
    47     real(kind=8)   , dimension(3)      :: Agrif_dx  !< global space step in the x, y and z direction 
    48     real, dimension(3)                 :: Agrif_dt  !< global time  step in the x, y and z direction 
     46    real   , dimension(3)              :: Agrif_x   !< global x, y and z position 
     47    real   , dimension(3)              :: Agrif_dx  !< global space step in the x, y and z direction 
     48    real   , dimension(3)              :: Agrif_dt  !< global time  step in the x, y and z direction 
    4949    integer, dimension(3)              :: nb        !< number of cells in the x, y and z direction 
    5050    integer, dimension(3)              :: ix        !< minimal position in the x, y and z direction 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modinit.F90

    r10087 r10725  
    3131! 
    3232    implicit none 
    33  
    34     abstract interface 
    35         subroutine step_proc() 
    36         end subroutine step_proc 
    37     end interface 
    38      
    3933! 
    4034contains 
    4135! 
    42  
    43  
    44 subroutine Agrif_call_procname ( procname ) 
    45     procedure(step_proc)  :: procname 
    46     call procname() 
    47 end subroutine  Agrif_call_procname 
    48 !=================================================================================================== 
    49  
    50 subroutine Agrif_call_procname1 ( procname1 ) 
    51     procedure(typedef_proc) :: procname1  
    52     call procname1() 
    53 end subroutine  Agrif_call_procname1 
    54  
    5536!=================================================================================================== 
    5637!  subroutine Agrif_Allocation 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modinterp.F90

    r10087 r10725  
    2626module Agrif_Interpolation 
    2727! 
    28   use Agrif_Init 
    29   use Agrif_Arrays 
    30   use Agrif_InterpBasic 
    31   use Agrif_User_Functions 
    32  
     28    use Agrif_InterpBasic 
     29    use Agrif_Arrays 
     30    use Agrif_Mask 
     31    use Agrif_CurgridFunctions 
    3332#if defined AGRIF_MPI 
    3433    use Agrif_Mpp 
    3534#endif 
    36    
    37     use Agrif_Mask 
    3835! 
    3936    implicit none 
     
    6966    integer, dimension(6) :: ub_child 
    7067    integer, dimension(6) :: lb_parent 
    71     real(kind=8)   , dimension(6) :: s_child,   s_parent 
    72     real(kind=8)   , dimension(6) :: ds_child, ds_parent 
     68    real   , dimension(6) :: s_child,   s_parent 
     69    real   , dimension(6) :: ds_child, ds_parent 
    7370    integer, dimension(child % root_var % nbdim,2,2) :: childarray 
    7471! 
     
    118115    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Parent !< Index of the first point inside the domain 
    119116                                                            !<    for the parent grid variable 
    120     REAL(kind=8),    DIMENSION(nbdim), INTENT(in)   :: s_Child,s_Parent   !< Positions of the parent and child grids 
    121     REAL(kind=8),    DIMENSION(nbdim), INTENT(in)   :: ds_Child,ds_Parent !< Space steps of the parent and child grids 
     117    REAL,    DIMENSION(nbdim), INTENT(in)   :: s_Child,s_Parent   !< Positions of the parent and child grids 
     118    REAL,    DIMENSION(nbdim), INTENT(in)   :: ds_Child,ds_Parent !< Space steps of the parent and child grids 
    122119    TYPE(Agrif_Variable),      pointer      :: restore            !< Indicates points where interpolation 
    123120    LOGICAL,                   INTENT(in)   :: torestore          !< Indicates if the array restore is used 
     
    131128    INTEGER                       :: i,j,k,l,m,n 
    132129    INTEGER, DIMENSION(nbdim)     :: pttruetab,cetruetab 
    133     INTEGER, DIMENSION(nbdim)     :: indmin,     indmax, indmin_required_p, indmax_required_p 
     130    INTEGER, DIMENSION(nbdim)     :: indmin,     indmax 
    134131    INTEGER, DIMENSION(nbdim)     :: indminglob, indmaxglob 
    135132#if defined AGRIF_MPI 
     
    138135#endif 
    139136    LOGICAL, DIMENSION(nbdim)     :: noraftab 
    140     REAL(kind=8)   , DIMENSION(nbdim)     :: s_Child_temp,s_Parent_temp,s_Parent_temp_p 
     137    REAL   , DIMENSION(nbdim)     :: s_Child_temp,s_Parent_temp 
    141138    INTEGER, DIMENSION(nbdim)     :: lowerbound, upperbound, coords 
    142139    INTEGER, DIMENSION(nbdim,2,2), INTENT(OUT) :: childarray 
     
    174171            child % list_interp,                                    & 
    175172            pttab, petab, pttab_Child, pttab_Parent, nbdim,         & 
    176             indmin, indmax, indmin_required_p, indmax_required_p,   & 
    177             indminglob, indmaxglob,                                 & 
     173            indmin, indmax, indminglob, indmaxglob,                 & 
    178174            pttruetab, cetruetab, memberin                          & 
    179175#if defined AGRIF_MPI 
     
    182178#endif 
    183179        ) 
    184  
    185180! 
    186181    if (.not.find_list_interp) then 
    187182! 
    188 ! output : lowerbound and upperbound are the (local) lower and upper bounds of the child arrays 
    189  
    190183        call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim) 
    191  
    192 ! input : pttab, petab : global indexes where the interpolation is required 
    193 ! output : pttruetab, cetruetab : global indexes restricted to the bounds of the current processor  
    194 ! output : memberin is false if the current processor is not involved in the interpolation 
    195  
    196184        call Agrif_Childbounds(nbdim, lowerbound, upperbound,               & 
    197185                               pttab, petab, Agrif_Procrank, coords,        & 
    198186                               pttruetab, cetruetab, memberin) 
    199           
    200  
    201  
    202 ! output : indminglob, indmaxglob : global indexes required on the parent grid for the interpolation 
    203 ! output : s_Parent_temp, s_Child_temp : local s_Parent, s_Child relatively to indmin ou pttab 
    204187        call Agrif_Parentbounds(type_interp,nbdim,indminglob,indmaxglob,    & 
    205                                 indmin_required_p, indmax_required_p,           & 
    206188                                s_Parent_temp,s_Child_temp,                 & 
    207189                                s_Child,ds_Child,                           & 
     
    212194#if defined AGRIF_MPI 
    213195        if (memberin) then 
    214  
    215 ! output : indmin, indmax : global indexes required on the parent grid for the interpolation on the current processor (i.e. on pttruetab, cetruetab) 
    216 ! output : s_Parent_temp, s_Child_temp : local s_Parent, s_Child relatively to indmin ou pttruetab 
    217196            call Agrif_Parentbounds(type_interp,nbdim,indmin,indmax,        & 
    218                                     indmin_required_p, indmax_required_p,       & 
    219197                                    s_Parent_temp,s_Child_temp,             & 
    220198                                    s_Child,ds_Child,                       & 
     
    226204 
    227205        local_proc = Agrif_Procrank 
    228  
    229 ! output : lowerbound and upperbound are the (local) lower and upper bounds of the parent arrays 
    230206        call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim) 
    231207        call Agrif_ChildGrid_to_ParentGrid() 
    232  
    233 ! input : indminglob,indmaxglob : global indexes where data are required for the interpolation 
    234 ! output : indminglob2,indmaxglob2 : global indexes restricted to the bounds of the current processor  
    235 ! output : member is false if the current processor does not need to send data 
    236 ! output : indminglob3,indmaxglob3 : global bounds on the current processor for the parent array 
    237  
     208! 
    238209        call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 & 
    239210                               indminglob,indmaxglob, local_proc, coords,   & 
     
    242213! 
    243214        if (member) then 
    244  
    245 ! output : parentarray 
    246 ! output : parentarray (:,:,2) : indminglob2, indmaxglob2 in term of local indexes on current processor 
    247 ! output : parentarray (:,:,1) : indminglob2, indmaxglob2 restricted to the current processor (different from indminglob2 ???) 
    248 ! output : member is .false. is the current processor has not data to send 
    249  
    250215            call Agrif_GlobalToLocalBounds(parentarray,                     & 
    251216                                           lowerbound,  upperbound,         & 
     
    256221        call Agrif_ParentGrid_to_ChildGrid() 
    257222#else 
    258  
    259 ! In the sequentiel case, the following lines ensure that the bounds needed on the parent grid in the interpolation  
    260 ! do not exceed lower and upper bounds of the parent array 
    261  
    262 ! output : lowerbound and upperbound are the (local) lower and upper bounds of the parent arrays 
    263         call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim) 
    264         call Agrif_ChildGrid_to_ParentGrid() 
    265  
    266 ! input : indminglob,indmaxglob : global indexes where data are required for the interpolation 
    267 ! output : indminglob2,indmaxglob2 : global indexes restricted to the bounds of the current processor  
    268 ! output : member is false if the current processor does not need to send data 
    269  
    270         call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 & 
    271                                indminglob,indmaxglob, Agrif_Procrank, coords,   & 
    272                                indmin,indmax,member) 
    273  
    274         call Agrif_ParentGrid_to_ChildGrid() 
    275  
    276         indminglob = indmin 
    277         indmaxglob = indmax 
    278  
    279223        parentarray(:,1,1) = indminglob 
    280224        parentarray(:,2,1) = indmaxglob 
    281225        parentarray(:,1,2) = indminglob 
    282226        parentarray(:,2,2) = indmaxglob 
    283   
    284 !       indmin = indminglob 
    285 !        indmax = indmaxglob 
    286  
     227        indmin = indminglob 
     228        indmax = indmaxglob 
    287229        member = .TRUE. 
    288         s_Parent_temp = s_Parent + (indminglob - pttab_Parent) * ds_Parent 
    289  
    290230#endif 
    291231!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     
    307247        s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child 
    308248#else 
    309  
    310 ! In the sequentiel case, the following lines ensure that the bounds needed on the parent grid in the interpolation  
    311 ! do not exceed lower and upper bounds of the parent array 
    312  
    313 ! output : lowerbound and upperbound are the (local) lower and upper bounds of the parent arrays 
    314         call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim) 
    315         call Agrif_ChildGrid_to_ParentGrid() 
    316  
    317 ! input : indminglob,indmaxglob : global indexes where data are required for the interpolation 
    318 ! output : indminglob2,indmaxglob2 : global indexes restricted to the bounds of the current processor  
    319 ! output : member is false if the current processor does not need to send data 
    320  
    321         call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 & 
    322                                indminglob,indmaxglob, Agrif_Procrank, coords,   & 
    323                                indmin,indmax,member) 
    324  
    325         call Agrif_ParentGrid_to_ChildGrid() 
    326  
    327         indminglob = indmin 
    328         indmaxglob = indmax 
    329  
    330249        parentarray(:,1,1) = indminglob 
    331250        parentarray(:,2,1) = indmaxglob 
    332251        parentarray(:,1,2) = indminglob 
    333252        parentarray(:,2,2) = indmaxglob 
    334  !       indmin = indminglob 
    335  !       indmax = indmaxglob 
     253        indmin = indminglob 
     254        indmax = indmaxglob 
    336255        member = .TRUE. 
    337256        s_Parent_temp = s_Parent + (indminglob - pttab_Parent) * ds_Parent 
     
    343262        if (.not.associated(tempP)) allocate(tempP) 
    344263! 
    345  
    346264        call Agrif_array_allocate(tempP,parentarray(:,1,1),parentarray(:,2,1),nbdim) 
    347265        call Agrif_var_set_array_tozero(tempP,nbdim) 
     
    384302                      parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir) 
    385303        end select 
    386  
    387304! 
    388305        call Agrif_ParentGrid_to_ChildGrid() 
     
    443360                child%list_interp,pttab,petab,                  & 
    444361                pttab_Child,pttab_Parent,indmin,indmax,         & 
    445                 indmin_required_p, indmax_required_p,           & 
    446362                indminglob,indmaxglob,                          & 
    447363                pttruetab,cetruetab,                            & 
     
    456372    endif 
    457373! 
    458  
    459374    if (memberin) then 
    460375! 
    461376        if (.not.associated(tempC)) allocate(tempC) 
    462377! 
    463  
    464378        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim) 
    465  
    466379! 
    467380!       Special values on the parent grid 
     
    471384! 
    472385            if (.not.associated(parentvalues))  allocate(parentvalues) 
    473 !t 
    474  
     386! 
    475387            call Agrif_array_allocate(parentvalues,indmin,indmax,nbdim) 
    476388            call Agrif_var_full_copy_array(parentvalues,tempPextend,nbdim) 
    477389! 
    478             call Agrif_CheckMasknD(tempPextend,parentvalues,                & 
    479                     indmin(1:nbdim),indmax(1:nbdim),                        & 
    480                     indmin(1:nbdim),indmax(1:nbdim),                        & 
    481                     indmin_required_p(1:nbdim),indmax_required_p(1:nbdim),  & 
     390            call Agrif_CheckMasknD(tempPextend,parentvalues,    & 
     391                    indmin(1:nbdim),indmax(1:nbdim),            & 
     392                    indmin(1:nbdim),indmax(1:nbdim),            & 
    482393                    noraftab(1:nbdim),nbdim) 
    483394! 
     
    507418                                                ds_Child(1:2),    ds_Parent(1:2) ) 
    508419            case(3) 
    509                 s_Parent_temp_p = s_Parent + (indmin_required_p - pttab_Parent) * ds_Parent 
    510                 call Agrif_Interp_3D_recursive( type_interp(1:3),                                 & 
    511                                                 tempPextend % array3(                             & 
    512                                                 indmin_required_p(1):indmax_required_p(1),        & 
    513                                                 indmin_required_p(2):indmax_required_p(2),        & 
    514                                                 indmin_required_p(3):indmax_required_p(3)),       & 
    515                                                 tempC       % array3,                             & 
    516                                                 indmin_required_p(1:3), indmax_required_p(1:3),   & 
    517                                                 pttruetab(1:3),    cetruetab(1:3),                & 
    518                                                 s_Child_temp(1:3), s_Parent_temp_p(1:3),          & 
     420                call Agrif_Interp_3D_recursive( type_interp(1:3),                       & 
     421                                                tempPextend % array3,                   & 
     422                                                tempC       % array3,                   & 
     423                                                indmin(1:3), indmax(1:3),               & 
     424                                                pttruetab(1:3),    cetruetab(1:3),      & 
     425                                                s_Child_temp(1:3), s_Parent_temp(1:3),  & 
    519426                                                ds_Child(1:3),    ds_Parent(1:3) ) 
    520  
    521427            case(4) 
    522                 s_Parent_temp_p = s_Parent + (indmin_required_p - pttab_Parent) * ds_Parent 
    523                 call Agrif_Interp_4D_recursive( type_interp(1:4),                                 & 
    524                                                 tempPextend % array4(                             & 
    525                                                 indmin_required_p(1):indmax_required_p(1),        & 
    526                                                 indmin_required_p(2):indmax_required_p(2),        & 
    527                                                 indmin_required_p(3):indmax_required_p(3),        & 
    528                                                 indmin_required_p(4):indmax_required_p(4)),       & 
    529                                                 tempC       % array4,                             & 
    530                                                 indmin_required_p(1:4), indmax_required_p(1:4),   & 
    531                                                 pttruetab(1:4),    cetruetab(1:4),                & 
    532                                                 s_Child_temp(1:4), s_Parent_temp_p(1:4),          & 
     428                call Agrif_Interp_4D_recursive( type_interp(1:4),                       & 
     429                                                tempPextend % array4,                   & 
     430                                                tempC       % array4,                   & 
     431                                                indmin(1:4), indmax(1:4),               & 
     432                                                pttruetab(1:4),    cetruetab(1:4),      & 
     433                                                s_Child_temp(1:4), s_Parent_temp(1:4),  & 
    533434                                                ds_Child(1:4),    ds_Parent(1:4) ) 
    534435            case(5) 
     
    721622        else    ! .not.to_restore 
    722623! 
    723  
    724624            if (memberin) then 
    725625    ! 
     
    842742        endif 
    843743 
    844  
    845744        call Agrif_array_deallocate(tempPextend,nbdim) 
    846745        call Agrif_array_deallocate(tempC,nbdim) 
     
    864763!--------------------------------------------------------------------------------------------------- 
    865764subroutine Agrif_Parentbounds ( type_interp, nbdim, indmin, indmax, & 
    866                                 indmin_required,indmax_required,    & 
    867765                                s_Parent_temp, s_Child_temp,        & 
    868766                                s_Child, ds_Child,                  & 
     
    874772    INTEGER,                   intent(in)  :: nbdim 
    875773    INTEGER, DIMENSION(nbdim), intent(out) :: indmin, indmax 
    876     INTEGER, DIMENSION(nbdim), intent(out) :: indmin_required, indmax_required 
    877     REAL(kind=8),    DIMENSION(nbdim), intent(out) :: s_Parent_temp, s_child_temp 
    878     REAL(kind=8),    DIMENSION(nbdim), intent(in)  :: s_Child, ds_child 
    879     REAL(kind=8),    DIMENSION(nbdim), intent(in)  :: s_Parent,ds_Parent 
     774    REAL,    DIMENSION(nbdim), intent(out) :: s_Parent_temp, s_child_temp 
     775    REAL,    DIMENSION(nbdim), intent(in)  :: s_Child, ds_child 
     776    REAL,    DIMENSION(nbdim), intent(in)  :: s_Parent,ds_Parent 
    880777    INTEGER, DIMENSION(nbdim), intent(in)  :: pttruetab, cetruetab 
    881778    INTEGER, DIMENSION(nbdim), intent(in)  :: pttab_Child, pttab_Parent 
     
    883780    INTEGER, DIMENSION(nbdim), intent(in)  :: coords 
    884781! 
    885     REAL(kind=8) :: xpmin, xpmax 
    886     INTEGER :: coeffraf 
    887782    INTEGER :: i 
    888     REAL(kind=8),DIMENSION(nbdim) :: dim_newmin, dim_newmax 
     783    REAL,DIMENSION(nbdim) :: dim_newmin, dim_newmax 
    889784! 
    890785    dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child 
     
    895790        indmin(i) = pttab_Parent(i) + agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i)) 
    896791        indmax(i) = pttab_Parent(i) + agrif_ceiling((dim_newmax(i)-s_Parent(i))/ds_Parent(i)) 
    897  
    898         coeffraf = nint(ds_Parent(i)/ds_Child(i)) 
    899          
    900         indmin_required(i) = indmin(i) 
    901         indmax_required(i) = indmax(i) 
    902792! 
    903793!       Necessary for the Quadratic interpolation 
    904794! 
    905  
    906795        if ( (pttruetab(i) == cetruetab(i)) .and. (posvar(i) == 1) ) then 
    907             if (Agrif_UseSpecialValue) then 
    908                indmin(i) = indmin(i)-MaxSearch 
    909                indmax(i) = indmax(i)+MaxSearch 
    910             endif 
    911796        elseif ( coords(i) == 0 ) then  ! (interptab == 'N') 
    912797        elseif ( (type_interp(i) == Agrif_ppm)     .or.     & 
     
    914799                 (type_interp(i) == Agrif_ppm_lim) .or.     & 
    915800                 (type_interp(i) == Agrif_weno) ) then 
    916                   
    917             if ((mod(coeffraf,2) == 0).AND.(posvar(i)==2)) then 
    918              
    919               xpmax = s_Parent(i)+(indmax(i)-pttab_Parent(i))*ds_Parent(i) 
    920               if (xpmax > dim_newmax(i)+ds_Child(i)) then 
    921                 indmax(i) = indmax(i) + 1 
    922               else 
    923                 indmax(i) = indmax(i) + 2 
    924               endif 
    925                
    926               xpmin = s_Parent(i)+(indmin(i)-pttab_Parent(i))*ds_Parent(i) 
    927               if (xpmin < dim_newmin(i)-ds_Child(i)) then 
    928                 indmin(i) = indmin(i) - 1 
    929               else 
    930                 indmin(i) = indmin(i) - 2 
    931               endif 
    932                
    933             else 
    934               indmin(i) = indmin(i) - 2 
    935               indmax(i) = indmax(i) + 2 
    936             endif 
    937  
    938             indmin_required(i) = indmin(i) 
    939             indmax_required(i) = indmax(i) 
    940          
    941             if (Agrif_UseSpecialValue) then 
    942                indmin(i) = indmin(i)-MaxSearch 
    943                indmax(i) = indmax(i)+MaxSearch 
    944             endif 
    945         elseif (type_interp(i) == Agrif_linearconservlim) then 
    946          
    947             if ((mod(coeffraf,2) == 0).AND.(posvar(i)==2)) then 
    948              
    949               xpmax = s_Parent(i)+(indmax(i)-pttab_Parent(i))*ds_Parent(i) 
    950               if (xpmax > dim_newmax(i)+ds_Child(i)) then 
    951                 indmax(i) = indmax(i) 
    952               else 
    953                 indmax(i) = indmax(i) + 1 
    954               endif 
    955                
    956               xpmin = s_Parent(i)+(indmin(i)-pttab_Parent(i))*ds_Parent(i) 
    957               if (xpmin < dim_newmin(i)-ds_Child(i)) then 
    958                 indmin(i) = indmin(i) 
    959               else 
    960                 indmin(i) = indmin(i) - 1 
    961               endif 
    962                
    963             else 
    964               indmin(i) = indmin(i) - 1 
    965               indmax(i) = indmax(i) + 1 
    966             endif 
    967  
    968             indmin_required(i) = indmin(i) 
    969             indmax_required(i) = indmax(i) 
    970          
    971             if (Agrif_UseSpecialValue) then 
    972                indmin(i) = indmin(i)-MaxSearch 
    973                indmax(i) = indmax(i)+MaxSearch 
    974             endif 
    975              
     801            indmin(i) = indmin(i) - 2 
     802            indmax(i) = indmax(i) + 2 
    976803        elseif ( (type_interp(i) /= Agrif_constant) .and.   & 
    977804                 (type_interp(i) /= Agrif_linear) ) then 
    978805            indmin(i) = indmin(i) - 1 
    979806            indmax(i) = indmax(i) + 1 
    980              
    981             indmin_required(i) = indmin(i) 
    982             indmax_required(i) = indmax(i) 
    983  
    984             if (Agrif_UseSpecialValue) then 
    985                indmin(i) = indmin(i)-MaxSearch 
    986                indmax(i) = indmax(i)+MaxSearch 
    987             endif 
    988         elseif ( (type_interp(i) == Agrif_constant) .or.   & 
    989                  (type_interp(i) == Agrif_linear) ) then 
    990             indmin_required(i) = indmin(i) 
    991             indmax_required(i) = indmax(i) 
    992             if (Agrif_UseSpecialValue) then 
    993                indmin(i) = indmin(i)-MaxSearch 
    994                indmax(i) = indmax(i)+MaxSearch 
    995             endif 
    996807        endif 
    997  
    998808! 
    999809    enddo 
     
    1020830    integer,            intent(in)  :: indmin, indmax 
    1021831    integer,            intent(in)  :: pttab_child, petab_child 
    1022     real(kind=8),               intent(in)  :: s_child, s_parent 
    1023     real(kind=8),               intent(in)  :: ds_child, ds_parent 
     832    real,               intent(in)  :: s_child, s_parent 
     833    real,               intent(in)  :: ds_child, ds_parent 
    1024834    real, dimension(            & 
    1025835        indmin:indmax           & 
     
    1055865    integer, dimension(2),              intent(in)  :: indmin, indmax 
    1056866    integer, dimension(2),              intent(in)  :: pttab_child, petab_child 
    1057     real(kind=8),    dimension(2),              intent(in)  :: s_child, s_parent 
    1058     real(kind=8),    dimension(2),              intent(in)  :: ds_child, ds_parent 
     867    real,    dimension(2),              intent(in)  :: s_child, s_parent 
     868    real,    dimension(2),              intent(in)  :: ds_child, ds_parent 
    1059869    real,    dimension(                 & 
    1060870        indmin(1):indmax(1),            & 
     
    1073883        indmin(2):indmax(2),            & 
    1074884        pttab_child(1):petab_child(1))  :: tabtemp_trsp 
    1075     integer                             :: i, j, coeffraf, locind_child_left, ideb 
     885    integer                             :: i, j, coeffraf 
    1076886!--------------------------------------------------------------------------------------------------- 
    1077887! 
     
    1098908                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 
    1099909!---CDIR NEXPAND 
    1100         call PPM1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1,indchildppm(:,1),tabppm(:,:,1)) 
    1101     else if (coeffraf == 1) then 
    1102         locind_child_left = indmin(1) + agrif_int((s_child(1)-s_parent(1))/ds_parent(1)) 
    1103          
    1104             do j = indmin(2), indmax(2) 
    1105             ideb = locind_child_left 
    1106             do i = pttab_child(1), petab_child(1) 
    1107                 tabtemp(i,j) = tabin(ideb,j) 
    1108                 ideb = ideb + 1 
    1109             enddo 
    1110             enddo 
    1111  
     910        call PPM1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1) 
    1112911    else 
    1113912        do j = indmin(2),indmax(2) 
     
    1150949!---CDIR NEXPAND 
    1151950        call PPM1dAfterCompute(tabtemp_trsp, tabout_trsp,    & 
    1152                                size(tabtemp_trsp), size(tabout_trsp), 2, & 
    1153                               indchildppm(:,2),tabppm(:,:,2)) 
     951                               size(tabtemp_trsp), size(tabout_trsp), 2) 
    1154952    else 
    1155953        do i = pttab_child(1), petab_child(1) 
     
    1186984    integer, dimension(3),              intent(in)  :: indmin, indmax 
    1187985    integer, dimension(3),              intent(in)  :: pttab_child, petab_child 
    1188     real(kind=8),    dimension(3),              intent(in)  :: s_child, s_parent 
    1189     real(kind=8),    dimension(3),              intent(in)  :: ds_child, ds_parent 
     986    real,    dimension(3),              intent(in)  :: s_child, s_parent 
     987    real,    dimension(3),              intent(in)  :: ds_child, ds_parent 
    1190988    real,    dimension(                 & 
    1191989        indmin(1):indmax(1),            & 
     
    1201999        pttab_child(2):petab_child(2),  & 
    12021000        indmin(3):indmax(3))            :: tabtemp 
    1203     integer                             :: i, j, k, coeffraf,kp,kp1,kp2,kp3,kp4,kref 
     1001    integer                             :: i, j, k, coeffraf 
    12041002    integer                             :: locind_child_left, kdeb 
    1205     real(kind=8)    :: ypos,globind_parent_left 
    1206     real(kind=8)    :: deltax, invdsparent 
    1207     real    :: t2,t3,t4,t5,t6,t7,t8 
    1208     integer :: locind_parent_left 
    1209  
    12101003! 
    12111004    coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
     
    12661059            enddo 
    12671060        enddo 
    1268     else if (type_interp(3) == Agrif_LAGRANGE) then 
    1269       invdsparent = 1./ds_parent(3) 
    1270       ypos = s_child(3) 
    1271       do k=pttab_child(3), petab_child(3) 
    1272         locind_parent_left = indmin(3)+agrif_int((ypos - s_parent(3))/ds_parent(3)) 
    1273         globind_parent_left = s_parent(3) + (locind_parent_left - indmin(3))*ds_parent(3) 
    1274         deltax = invdsparent*(ypos-globind_parent_left) 
    1275         deltax = nint(coeffraf*deltax)/real(coeffraf) 
    1276         ypos = ypos + ds_child(3) 
    1277  
    1278         if (abs(deltax) <= 0.0001) then 
    1279           do j = pttab_child(2), petab_child(2) 
    1280           do i = pttab_child(1), petab_child(1) 
    1281              tabout(i,j,k) = tabtemp(i,j,locind_parent_left) 
    1282           enddo 
    1283           enddo 
    1284         else 
    1285          t2 = deltax - 2. 
    1286         t3 = deltax - 1. 
    1287         t4 = deltax + 1. 
    1288  
    1289         t5 = -(1./6.)*deltax*t2*t3 
    1290         t6 = 0.5*t2*t3*t4 
    1291         t7 = -0.5*deltax*t2*t4 
    1292         t8 = (1./6.)*deltax*t3*t4       
    1293           do j = pttab_child(2), petab_child(2) 
    1294           do i = pttab_child(1), petab_child(1) 
    1295              tabout(i,j,k) = t5*tabtemp(i,j,locind_parent_left-1) + t6*tabtemp(i,j,locind_parent_left)    & 
    1296               +t7*tabtemp(i,j,locind_parent_left+1) + t8*tabtemp(i,j,locind_parent_left+2) 
    1297           enddo 
    1298           enddo 
    1299  
    1300         endif 
    1301  
    1302       enddo 
    1303     else if (type_interp(3) == Agrif_PPM) then 
    1304      call PPM1dPrecompute2d(1, & 
    1305                                indmax(3)-indmin(3)+1,           & 
    1306                                petab_child(3)-pttab_child(3)+1, & 
    1307                                s_parent(3),s_child(3),ds_parent(3),ds_child(3),1) 
    1308  
    1309      do k=pttab_child(3),petab_child(3) 
    1310         kref = k-pttab_child(3)+1 
    1311         kp=indmin(3)+indparentppm(kref,1)-1 
    1312         kp1 = kp + 1 
    1313         kp2 = kp1 + 1 
    1314         kp3 = kp2 + 1 
    1315         kp4 = kp3 + 1 
    1316         do j = pttab_child(2), petab_child(2) 
    1317         do i = pttab_child(1), petab_child(1) 
    1318          tabout(i,j,k) = tabppm(1,indchildppm(kref,1),1)*tabtemp(i,j,kp)   + & 
    1319                          tabppm(2,indchildppm(kref,1),1)*tabtemp(i,j,kp1)  + & 
    1320                          tabppm(3,indchildppm(kref,1),1)*tabtemp(i,j,kp2)  + & 
    1321                          tabppm(4,indchildppm(kref,1),1)*tabtemp(i,j,kp3)  + & 
    1322                          tabppm(5,indchildppm(kref,1),1)*tabtemp(i,j,kp4) 
    1323         enddo 
    1324         enddo 
    1325      enddo 
    1326  
    13271061    else 
    1328  
    13291062        do j = pttab_child(2), petab_child(2) 
    13301063        do i = pttab_child(1), petab_child(1) 
     
    13381071        enddo 
    13391072        enddo 
    1340  
    13411073    endif 
    13421074!--------------------------------------------------------------------------------------------------- 
     
    13591091    integer, dimension(4),              intent(in)  :: indmin, indmax 
    13601092    integer, dimension(4),              intent(in)  :: pttab_child, petab_child 
    1361     real(kind=8),    dimension(4),              intent(in)  :: s_child, s_parent 
    1362     real(kind=8),    dimension(4),              intent(in)  :: ds_child, ds_parent 
     1093    real,    dimension(4),              intent(in)  :: s_child, s_parent 
     1094    real,    dimension(4),              intent(in)  :: ds_child, ds_parent 
    13631095    real,    dimension(                 & 
    13641096        indmin(1):indmax(1),            & 
     
    13781110        indmin(4):indmax(4))            :: tabtemp 
    13791111    integer                             :: i, j, k, l 
    1380  
    1381     real(kind=8)    :: ypos,globind_parent_left 
    1382     real(kind=8)    :: deltax, invdsparent 
    1383     real    :: t2,t3,t4,t5,t6,t7,t8 
    1384     integer :: locind_parent_left, coeffraf 
    13851112! 
    13861113    do l = indmin(4), indmax(4) 
     
    13981125    enddo 
    13991126! 
    1400      if (type_interp(4) == Agrif_LAGRANGE) then 
    1401       coeffraf = nint(ds_parent(4)/ds_child(4)) 
    1402       invdsparent = 1./ds_parent(4) 
    1403       ypos = s_child(4) 
    1404       do l=pttab_child(4), petab_child(4) 
    1405         locind_parent_left = indmin(4)+agrif_int((ypos - s_parent(4))/ds_parent(4)) 
    1406         globind_parent_left = s_parent(4) + (locind_parent_left - indmin(4))*ds_parent(4) 
    1407         deltax = invdsparent*(ypos-globind_parent_left) 
    1408         deltax = nint(coeffraf*deltax)/real(coeffraf) 
    1409         ypos = ypos + ds_child(4) 
    1410  
    1411         if (abs(deltax) <= 0.0001) then 
    1412           do k = pttab_child(3), petab_child(3) 
    1413           do j = pttab_child(2), petab_child(2) 
    1414           do i = pttab_child(1), petab_child(1) 
    1415              tabout(i,j,k,l) = tabtemp(i,j,k,locind_parent_left) 
    1416           enddo 
    1417           enddo 
    1418           enddo 
    1419         else 
    1420          t2 = deltax - 2. 
    1421         t3 = deltax - 1. 
    1422         t4 = deltax + 1. 
    1423  
    1424         t5 = -(1./6.)*deltax*t2*t3 
    1425         t6 = 0.5*t2*t3*t4 
    1426         t7 = -0.5*deltax*t2*t4 
    1427         t8 = (1./6.)*deltax*t3*t4       
    1428           do k = pttab_child(3), petab_child(3) 
    1429           do j = pttab_child(2), petab_child(2) 
    1430           do i = pttab_child(1), petab_child(1) 
    1431              tabout(i,j,k,l) = t5*tabtemp(i,j,k,locind_parent_left-1) + t6*tabtemp(i,j,k,locind_parent_left)    & 
    1432               +t7*tabtemp(i,j,k,locind_parent_left+1) + t8*tabtemp(i,j,k,locind_parent_left+2) 
    1433           enddo 
    1434           enddo 
    1435           enddo 
    1436         endif 
    1437  
    1438       enddo 
    1439     else 
    14401127    do k = pttab_child(3), petab_child(3) 
    14411128    do j = pttab_child(2), petab_child(2) 
     
    14511138    enddo 
    14521139    enddo 
    1453     endif 
    14541140!--------------------------------------------------------------------------------------------------- 
    14551141end subroutine Agrif_Interp_4D_recursive 
     
    14711157    integer, dimension(5),              intent(in)  :: indmin, indmax 
    14721158    integer, dimension(5),              intent(in)  :: pttab_child, petab_child 
    1473     real(kind=8),    dimension(5),              intent(in)  :: s_child, s_parent 
    1474     real(kind=8),    dimension(5),              intent(in)  :: ds_child, ds_parent 
     1159    real,    dimension(5),              intent(in)  :: s_child, s_parent 
     1160    real,    dimension(5),              intent(in)  :: ds_child, ds_parent 
    14751161    real,    dimension(                 & 
    14761162        indmin(1):indmax(1),            & 
     
    15441230    integer, dimension(6),                  intent(in)  :: indmin, indmax 
    15451231    integer, dimension(6),                  intent(in)  :: pttab_child, petab_child 
    1546     real(kind=8),    dimension(6),                  intent(in)  :: s_child, s_parent 
    1547     real(kind=8),    dimension(6),                  intent(in)  :: ds_child, ds_parent 
     1232    real,    dimension(6),                  intent(in)  :: s_child, s_parent 
     1233    real,    dimension(6),                  intent(in)  :: ds_child, ds_parent 
    15481234    real,    dimension(                 & 
    15491235        indmin(1):indmax(1),            & 
     
    16231309    REAL, DIMENSION(indmin:indmax),           INTENT(IN)    :: parenttab 
    16241310    REAL, DIMENSION(pttab_child:petab_child), INTENT(OUT)   :: childtab 
    1625     REAL(kind=8)                                            :: s_parent, s_child 
    1626     REAL(kind=8)                                            :: ds_parent,ds_child 
     1311    REAL                                                    :: s_parent, s_child 
     1312    REAL                                                    :: ds_parent,ds_child 
    16271313! 
    16281314    if ( (indmin == indmax) .and. (pttab_child == petab_child) ) then 
     
    16931379!--------------------------------------------------------------------------------------------------- 
    16941380function Agrif_Find_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,     & 
    1695                                     nbdim, indmin, indmax, indmin_required_p, indmax_required_p, & 
    1696                                     indminglob,  indmaxglob,         & 
     1381                                    nbdim, indmin, indmax, indminglob,  indmaxglob,         & 
    16971382                                    pttruetab, cetruetab, memberin                          & 
    16981383#if defined AGRIF_MPI 
     
    17051390    integer,                       intent(in)  :: nbdim 
    17061391    integer, dimension(nbdim),     intent(in)  :: pttab, petab, pttab_Child, pttab_Parent 
    1707     integer, dimension(nbdim),     intent(out) :: indmin, indmax, indmin_required_p, indmax_required_p 
     1392    integer, dimension(nbdim),     intent(out) :: indmin, indmax 
    17081393    integer, dimension(nbdim),     intent(out) :: indminglob, indmaxglob 
    17091394    integer, dimension(nbdim),     intent(out) :: pttruetab, cetruetab 
     
    17441429        indmin = pil % indmin(1:nbdim) 
    17451430        indmax = pil % indmax(1:nbdim) 
    1746         indmin_required_p = pil % indmin_required_p(1:nbdim) 
    1747         indmax_required_p = pil % indmax_required_p(1:nbdim) 
    17481431 
    17491432        pttruetab = pil % pttruetab(1:nbdim) 
     
    17771460!--------------------------------------------------------------------------------------------------- 
    17781461subroutine Agrif_AddTo_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,  & 
    1779                                      indmin, indmax, indmin_required_p, indmax_required_p,  & 
    1780                                      indminglob, indmaxglob,                & 
     1462                                     indmin, indmax, indminglob, indmaxglob,                & 
    17811463                                     pttruetab, cetruetab,                                  & 
    17821464                                     memberin, nbdim                                        & 
     
    17921474    integer                                 :: nbdim 
    17931475    integer, dimension(nbdim)               :: pttab, petab, pttab_Child, pttab_Parent 
    1794     integer, dimension(nbdim)               :: indmin,indmax, indmin_required_p, indmax_required_p 
     1476    integer, dimension(nbdim)               :: indmin,indmax 
    17951477    integer, dimension(nbdim)               :: indminglob, indmaxglob 
    17961478    integer, dimension(nbdim)               :: pttruetab, cetruetab 
     
    18211503    pil % indmin(1:nbdim) = indmin(1:nbdim) 
    18221504    pil % indmax(1:nbdim) = indmax(1:nbdim) 
    1823  
    1824     pil % indmin_required_p(1:nbdim) = indmin_required_p(1:nbdim) 
    1825     pil % indmax_required_p(1:nbdim) = indmax_required_p(1:nbdim) 
    18261505 
    18271506    pil % memberin = memberin 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modinterpbasic.F90

    r10087 r10725  
    4141    integer, dimension(:), allocatable      :: indparentppm_1d, indchildppm_1d 
    4242! 
    43  
    4443    private :: Agrif_limiter_vanleer 
    4544! 
     
    5756    integer,             intent(in)     :: np           !< Length of input array 
    5857    integer,             intent(in)     :: nc           !< Length of output array 
    59     real(kind=8),                intent(in)     :: s_parent     !< Parent grid position (s_root = 0) 
    60     real(kind=8),                intent(in)     :: s_child      !< Child  grid position (s_root = 0) 
    61     real(kind=8),                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1) 
    62     real(kind=8),                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1) 
     58    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0) 
     59    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0) 
     60    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1) 
     61    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1) 
    6362! 
    6463    integer :: i, coeffraf, locind_parent_left 
    65     real(kind=8)    :: globind_parent_left, globind_parent_right 
    66     real(kind=8)    :: invds, invds2, ypos, ypos2, diff 
     64    real    :: globind_parent_left, globind_parent_right 
     65    real    :: invds, invds2, ypos, ypos2, diff 
    6766! 
    6867    coeffraf = nint(ds_parent/ds_child) 
     
    9392! 
    9493        diff = globind_parent_right - ypos2 
    95 ! quick fix for roundoff error 
    96         diff=nint(diff*coeffraf)/real(coeffraf) 
    97  
    9894        y(i) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1)) 
    99  
    10095        ypos2 = ypos2 + invds2 
    10196! 
     
    109104    else 
    110105        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent 
    111         diff=(globind_parent_left + ds_parent - ypos)*invds 
    112  
    113 ! quick fix for roundoff error 
    114         diff=nint(diff*coeffraf)/real(coeffraf) 
    115 !        y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left)  & 
    116 !                           + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds 
    117         y(nc) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1)) 
    118     endif 
    119  
     106        y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left)  & 
     107                           + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds 
     108    endif 
    120109!--------------------------------------------------------------------------------------------------- 
    121110end subroutine Agrif_basicinterp_linear1D 
     
    131120!--------------------------------------------------------------------------------------------------- 
    132121    integer, intent(in) :: np,nc,np2 
    133     real(kind=8),    intent(in) :: s_parent, s_child 
    134     real(kind=8),    intent(in) :: ds_parent, ds_child 
     122    real,    intent(in) :: s_parent, s_child 
     123    real,    intent(in) :: ds_parent, ds_child 
    135124    integer, intent(in) :: dir 
    136125! 
     
    138127    integer, dimension(:,:), allocatable :: indparent_tmp 
    139128    real, dimension(:,:), allocatable :: coeffparent_tmp 
    140     real(kind=8)    :: ypos,globind_parent_left,globind_parent_right 
    141     real(kind=8)    :: invds, invds2, invds3 
    142     real(kind=8) :: ypos2,diff 
     129    real    :: ypos,globind_parent_left,globind_parent_right 
     130    real    :: invds, invds2, invds3 
     131    real :: ypos2,diff 
    143132! 
    144133    coeffraf = nint(ds_parent/ds_child) 
     
    175164        if (ypos2 > globind_parent_right) then 
    176165            locind_parent_left = locind_parent_left + 1 
    177             globind_parent_right = globind_parent_right + 1.d0 
     166            globind_parent_right = globind_parent_right + 1. 
    178167            ypos2 = ypos*invds+(i-1)*invds2 
    179168        endif 
     
    250239    real, dimension(np), intent(in)     :: x 
    251240    real, dimension(nc), intent(out)    :: y 
    252     real(kind=8),                intent(in)     :: s_parent, s_child 
    253     real(kind=8),                intent(in)     :: ds_parent, ds_child 
     241    real,                intent(in)     :: s_parent, s_child 
     242    real,                intent(in)     :: ds_parent, ds_child 
    254243! 
    255244    integer :: i, coeffraf, locind_parent_left 
    256     real(kind=8)    :: ypos,globind_parent_left 
    257     real(kind=8)    :: deltax, invdsparent 
     245    real    :: ypos,globind_parent_left 
     246    real    :: deltax, invdsparent 
    258247    real    :: t2,t3,t4,t5,t6,t7,t8 
    259248! 
     
    315304    real, dimension(np), intent(in)     :: x 
    316305    real, dimension(nc), intent(out)    :: y 
    317     real(kind=8),                intent(in)     :: s_parent, s_child 
    318     real(kind=8),                intent(in)     :: ds_parent, ds_child 
     306    real,                intent(in)     :: s_parent, s_child 
     307    real,                intent(in)     :: ds_parent, ds_child 
    319308! 
    320309    integer :: i, coeffraf, locind_parent 
    321     real(kind=8)    :: ypos 
     310    real    :: ypos 
    322311! 
    323312    coeffraf = nint(ds_parent/ds_child) 
     
    353342    real, dimension(np), intent(in)     :: x 
    354343    real, dimension(nc), intent(out)    :: y 
    355     real(kind=8),                intent(in)     :: s_parent, s_child 
    356     real(kind=8),                intent(in)     :: ds_parent, ds_child 
     344    real,                intent(in)     :: s_parent, s_child 
     345    real,                intent(in)     :: ds_parent, ds_child 
    357346! 
    358347    real, dimension(:), allocatable :: ytemp 
    359348    integer :: i,coeffraf,locind_parent_left,locind_parent_last 
    360     real(kind=8)    :: ypos,xdiffmod,xpmin,xpmax,slope 
     349    real    :: ypos,xdiffmod,xpmin,xpmax,slope 
    361350    integer :: i1,i2,ii 
    362351    integer :: diffmod 
     
    440429    real, dimension(np), intent(in)     :: x 
    441430    real, dimension(nc), intent(out)    :: y 
    442     real(kind=8),                intent(in)     :: s_parent, s_child 
    443     real(kind=8),                intent(in)     :: ds_parent, ds_child 
     431    real,                intent(in)     :: s_parent, s_child 
     432    real,                intent(in)     :: ds_parent, ds_child 
    444433! 
    445434    real, dimension(:), allocatable :: ytemp 
    446435    integer :: i,coeffraf,locind_parent_left,locind_parent_last 
    447     real(kind=8)    :: ypos,xdiffmod,xpmin,xpmax,slope 
     436    real    :: ypos,xdiffmod,xpmin,xpmax,slope 
    448437    integer :: i1,i2,ii 
    449438    integer :: diffmod 
     
    535524    real, dimension(np), intent(in)     :: x 
    536525    real, dimension(nc), intent(out)    :: y 
    537     real(kind=8),                intent(in)     :: s_parent, s_child 
    538     real(kind=8),                intent(in)     :: ds_parent, ds_child 
     526    real,                intent(in)     :: s_parent, s_child 
     527    real,                intent(in)     :: ds_parent, ds_child 
    539528! 
    540529    integer :: i,coeffraf,locind_parent_left,locind_parent_last 
    541530    integer :: iparent,ipos,pos,nmin,nmax 
    542     real(kind=8)    :: ypos 
     531    real    :: ypos 
    543532    integer :: i1,jj 
    544     real(kind=8) :: xpmin 
    545     real :: a 
     533    real :: xpmin,a 
    546534! 
    547535    real, dimension(np) :: xl,delta,a6,slope 
     
    658646!--------------------------------------------------------------------------------------------------- 
    659647    integer,             intent(in)     :: np2, np, nc 
    660     real(kind=8),                intent(in)     :: s_parent, s_child 
    661     real(kind=8),                intent(in)     :: ds_parent, ds_child 
     648    real,                intent(in)     :: s_parent, s_child 
     649    real,                intent(in)     :: ds_parent, ds_child 
    662650    integer,             intent(in)     :: dir 
    663651! 
     
    667655    integer :: iparent,ipos,pos 
    668656    real    :: ypos 
    669     integer :: i1,jj,k,l,j 
    670     real(kind=8) :: xpmin 
    671     real :: a 
     657    integer :: i1,jj 
     658    real :: xpmin,a 
    672659! 
    673660    integer :: diffmod 
     
    751738    enddo 
    752739! 
    753  
    754     k=1 
    755     l=0 
    756     do i=1,np2 
    757       do j=1,nc 
    758         indchildppm(k,dir) = indchildppm_1d(j) 
    759         indparentppm(k,dir) = indparentppm_1d(j) + l 
    760         k=k+1 
    761       enddo 
    762       l=l+np 
     740    do i = 1,np2 
     741        indparentppm(1+(i-1)*nc:i*nc,dir) = indparentppm_1d(1:nc) + (i-1)*np 
     742        indchildppm (1+(i-1)*nc:i*nc,dir) = indchildppm_1d (1:nc) 
    763743    enddo 
    764744!--------------------------------------------------------------------------------------------------- 
     
    766746!=================================================================================================== 
    767747! 
    768  
     748!=================================================================================================== 
     749!subroutine PPM1dPrecompute(np,nc,& 
     750!                    s_parent,s_child,ds_parent,ds_child) 
     751!! 
     752!!CC   Description: 
     753!!CC   subroutine to compute coefficient and index for  a 1D interpolation 
     754!!CC   using piecewise parabolic method 
     755!!C    Method: 
     756!! 
     757!!     Declarations: 
     758!! 
     759!      Implicit none 
     760!! 
     761!!     Arguments 
     762!      Integer             :: np,nc 
     763!!      Real, Dimension(:),Allocatable :: ytemp 
     764!      Real                :: s_parent,s_child,ds_parent,ds_child 
     765!! 
     766!!     Local scalars 
     767!      Integer :: i,coeffraf,locind_parent_left,locind_parent_last 
     768!      Integer :: iparent,ipos,pos,nmin,nmax 
     769!      Real    :: ypos 
     770!      integer :: i1,jj 
     771!      Real :: xpmin,a 
     772!! 
     773!      Real :: xrmin,xrmax,am3,s2,s1 
     774!      Real, Dimension(np) :: xl,delta,a6,slope 
     775!!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3 
     776!      INTEGER :: diffmod 
     777!      REAL :: invcoeffraf 
     778!! 
     779!      coeffraf = nint(ds_parent/ds_child) 
     780!! 
     781!      If (coeffraf == 1) Then 
     782!          return 
     783!      End If 
     784!      invcoeffraf = ds_child/ds_parent 
     785!! 
     786! 
     787!      if (.not.allocated(indparentppm)) then 
     788!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),& 
     789!         indchildppm(-2*coeffraf:nc+2*coeffraf,1)) 
     790!      else 
     791!      if (size(indparentppm,1)<nc+4*coeffraf+1) then 
     792!      deallocate(indparentppm,indchildppm) 
     793!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),& 
     794!         indchildppm(-2*coeffraf:nc+2*coeffraf,1)) 
     795!      endif 
     796!      endif 
     797! 
     798!      ypos = s_child 
     799!! 
     800!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
     801!      locind_parent_last = 1 +& 
     802!      agrif_ceiling((ypos +(nc - 1)& 
     803!      *ds_child - s_parent)/ds_parent) 
     804!! 
     805!      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
     806!      i1 = 1+agrif_int((xpmin-s_child)/ds_child) 
     807!! 
     808!! 
     809! 
     810!      Do i=1,coeffraf 
     811!        tabdiff2(i)=(real(i)-0.5)*invcoeffraf 
     812!      EndDo 
     813! 
     814!      a = invcoeffraf**2 
     815!      tabdiff3(1) = (1./3.)*a 
     816!      a=2.*a 
     817!!CDIR ALTCODE 
     818!!!!CDIR SHORTLOOP 
     819!      Do i=2,coeffraf 
     820!        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a 
     821!      EndDo 
     822! 
     823!!CDIR ALTCODE 
     824!!!!CDIR SHORTLOOP 
     825!      Do i=1,coeffraf 
     826!      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i)) 
     827!      tabppm(2,i,1) = 0.08333333333333*& 
     828!              (7.-26.*tabdiff2(i)+18.*tabdiff3(i)) 
     829!      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i)) 
     830!      tabppm(4,i,1) = 0.08333333333333*& 
     831!              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i)) 
     832!      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i)) 
     833!      End Do 
     834!! 
     835!! 
     836!        diffmod = 0 
     837!       IF (mod(coeffraf,2) == 0) diffmod = 1 
     838!! 
     839!        ipos = i1 
     840!! 
     841!        Do iparent = locind_parent_left,locind_parent_last 
     842!             pos=1 
     843!!CDIR ALTCODE 
     844!!CDIR SHORTLOOP 
     845!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2 
     846!         indparentppm(jj,1) = iparent-2 
     847!         indchildppm(jj,1) = pos 
     848!               pos = pos+1 
     849!             End do 
     850!             ipos = ipos + coeffraf 
     851!! 
     852!        End do 
     853! 
     854!      Return 
     855!      End subroutine ppm1dprecompute 
    769856!=================================================================================================== 
    770857! 
     
    776863! Use precomputed coefficient and index. 
    777864!--------------------------------------------------------------------------------------------------- 
    778 subroutine PPM1dAfterCompute ( x, y, np, nc, dir, indchildppmloc, tabppmloc ) 
    779 !--------------------------------------------------------------------------------------------------- 
    780     integer,             intent(in)     :: np, nc 
     865subroutine PPM1dAfterCompute ( x, y, np, nc, dir ) 
     866!--------------------------------------------------------------------------------------------------- 
    781867    real, dimension(np), intent(in)     :: x 
    782868    real, dimension(nc), intent(out)    :: y 
     869    integer,             intent(in)     :: np, nc 
    783870    integer,             intent(in)     :: dir 
    784     integer, dimension(1:),intent(in) :: indchildppmloc 
    785     real, dimension(1:,1:),intent(in) :: tabppmloc 
    786 ! 
    787     integer :: i,j,jp1,jp2,jp3,jp4,k 
    788  
    789      
     871! 
     872    integer :: i 
     873! 
    790874    do i = 1,nc 
    791         j = indparentppm(i,dir) 
    792         jp1=j+1 
    793         jp2=jp1+1 
    794         jp3=jp2+1 
    795         jp4=jp3+1 
    796         y(i) = tabppmloc(1,indchildppmloc(i)) * x(j) + & 
    797                tabppmloc(2,indchildppmloc(i)) * x(jp1) + & 
    798                tabppmloc(3,indchildppmloc(i)) * x(jp2) + & 
    799                tabppmloc(4,indchildppmloc(i)) * x(jp3) + & 
    800                tabppmloc(5,indchildppmloc(i)) * x(jp4) 
    801     enddo 
    802  
     875        y(i) = tabppm(1,indchildppm(i,dir),dir) * x(indparentppm(i,dir)  ) + & 
     876               tabppm(2,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+1) + & 
     877               tabppm(3,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+2) + & 
     878               tabppm(4,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+3) + & 
     879               tabppm(5,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+4) 
     880    enddo 
    803881!--------------------------------------------------------------------------------------------------- 
    804882end subroutine PPM1dAfterCompute 
    805  
    806883!=================================================================================================== 
    807884! 
     
    9921069    real, dimension(np), intent(in)     :: x 
    9931070    real, dimension(nc), intent(out)    :: y 
    994     real(kind=8),                intent(in)     :: s_parent, s_child 
    995     real(kind=8),                intent(in)     :: ds_parent, ds_child 
     1071    real,                intent(in)     :: s_parent, s_child 
     1072    real,                intent(in)     :: ds_parent, ds_child 
    9961073! 
    9971074    real, dimension(:), allocatable :: ytemp 
    9981075    integer :: i,coeffraf,locind_parent_left,locind_parent_last 
    9991076    integer :: iparent,ipos,pos,nmin,nmax 
    1000     real(kind=8)    :: ypos 
     1077    real    :: ypos 
    10011078    integer :: i1,jj 
    1002     real(kind=8) :: xpmin 
     1079    real :: xpmin 
    10031080! 
    10041081    real, dimension(np) :: slope 
     
    10891166    real, dimension(np), intent(in)     :: x 
    10901167    real, dimension(nc), intent(out)    :: y 
    1091     real(kind=8),                intent(in)     :: s_parent, s_child 
    1092     real(kind=8),                intent(in)     :: ds_parent, ds_child 
     1168    real,                intent(in)     :: s_parent, s_child 
     1169    real,                intent(in)     :: ds_parent, ds_child 
    10931170! 
    10941171    integer :: i,coeffraf,locind_parent_left,locind_parent_last 
    10951172    integer :: ipos, pos 
    1096     real(kind=8)    :: ypos,xi 
     1173    real    :: ypos,xi 
    10971174    integer :: i1,jj 
    1098     real(kind=8) :: xpmin 
     1175    real :: xpmin 
    10991176! 
    11001177    real, dimension(:),   allocatable  :: ytemp 
     
    11991276      Real, Dimension(nc) :: y 
    12001277      Real, Dimension(:),Allocatable :: ytemp 
    1201       Real(kind=8)        :: s_parent,s_child,ds_parent,ds_child 
     1278      Real                :: s_parent,s_child,ds_parent,ds_child 
    12021279! 
    12031280!     Local scalars 
    12041281      Integer :: i,coeffraf,locind_parent_left,locind_parent_last 
    12051282      Integer :: iparent,ipos,pos,nmin,nmax 
    1206       Real(kind=8)    :: ypos 
     1283      Real    :: ypos 
    12071284      integer :: i1,jj 
    1208       Real(kind=8) :: xpmin 
    1209       real :: cavg,a,b 
     1285      Real :: xpmin,cavg,a,b 
    12101286!       
    12111287      Real :: xrmin,xrmax,am3,s2,s1   
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modmask.F90

    r10087 r10725  
    4040!! when this one is equal to Agrif_SpecialValue. 
    4141!--------------------------------------------------------------------------------------------------- 
    42 subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, & 
    43              pbtab_required, petab_required, noraftab, nbdim ) 
     42subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, noraftab, nbdim ) 
    4443!--------------------------------------------------------------------------------------------------- 
    4544    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid 
     
    4746    integer, dimension(nbdim)       :: pbtab  !< limits of the parent grid used 
    4847    integer, dimension(nbdim)       :: petab  !< interpolation of the child grid 
    49     integer, dimension(nbdim)       :: ppbtab, ppetab, pbtab_required, petab_required 
     48    integer, dimension(nbdim)       :: ppbtab, ppetab 
    5049    logical, dimension(nbdim)       :: noraftab 
    5150    integer                         :: nbdim 
    5251! 
    53     integer :: i0,j0,k0,l0,m0,n0,ll,kk 
    54     integer,dimension(:,:),allocatable :: trytoreplace 
    55     integer :: ilook, Nbvals 
    56     real :: xold 
     52    integer :: i0,j0,k0,l0,m0,n0 
    5753! 
    5854    select case (nbdim) 
     
    8177                    parent%array3(ppbtab(1),ppbtab(2),ppbtab(3)), & 
    8278                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue) 
     79 
     80!            Call CalculNewValTempP((/i0,j0,k0/), 
     81!     &                             tempP,parent, 
     82!     &                             ppbtab,ppetab, 
     83!     &                             noraftab,nbdim) 
     84 
    8385            endif 
    8486        enddo 
     
    8688        enddo 
    8789    case (4) 
    88  
    89         if (noraftab(1).AND.noraftab(2)) then 
    90           allocate(trytoreplace(pbtab_required(3):petab_required(3),pbtab_required(4):petab_required(4))) 
    91           trytoreplace = -1 
    92           i0 = pbtab_required(1) 
    93           j0 = pbtab_required(2) 
    94           do l0 = pbtab_required(4),petab_required(4) 
    95           do k0 = pbtab_required(3),petab_required(3) 
     90        do l0 = pbtab(4),petab(4) 
     91        do k0 = pbtab(3),petab(3) 
     92        do j0 = pbtab(2),petab(2) 
     93        do i0 = pbtab(1),petab(1) 
    9694            if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then 
    9795                call CalculNewValTempP4D((/i0,j0,k0,l0/), & 
    9896                    tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  & 
    9997                    parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), & 
    100                     ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue, & 
    101                     trytoreplace(k0,l0)) 
    102             endif 
    103           enddo 
    104           enddo 
    105  
    106           do l0 = pbtab_required(4),petab_required(4) 
    107           do k0 = pbtab_required(3),petab_required(3) 
    108           if (trytoreplace(k0,l0) /= -1) then 
    109           do j0 = pbtab_required(2),petab_required(2) 
    110           do i0 = pbtab_required(1),petab_required(1) 
    111  
    112           if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then 
    113           tempP%array4(i0,j0,k0,l0) = 0. 
    114           Nbvals = 0 
    115           do ll=max(l0-trytoreplace(k0,l0),ppbtab(4)),min(l0+trytoreplace(k0,l0),ppetab(4)) 
    116           do kk=max(k0-trytoreplace(k0,l0),ppbtab(3)),min(k0+trytoreplace(k0,l0),ppetab(3)) 
    117            if (parent%array4(i0,j0,kk,ll) /= Agrif_SpecialValue) then 
    118              tempP%array4(i0,j0,k0,l0) = tempP%array4(i0,j0,k0,l0) + parent%array4(i0,j0,kk,ll) 
    119              Nbvals = Nbvals + 1 
    120            endif 
    121           enddo 
    122           enddo 
    123  
    124           tempP%array4(i0,j0,k0,l0) = tempP%array4(i0,j0,k0,l0) /Nbvals 
    125           endif 
    126           enddo 
    127           enddo 
    128           endif 
    129           enddo 
    130           enddo 
    131           deallocate(trytoreplace) 
    132  
    133         else 
    134  
    135         do l0 = pbtab_required(4),petab_required(4) 
    136         do k0 = pbtab_required(3),petab_required(3) 
    137         do j0 = pbtab_required(2),petab_required(2) 
    138         do i0 = pbtab_required(1),petab_required(1) 
    139             if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then 
    140                 ilook = -1 
    141                 call CalculNewValTempP4D((/i0,j0,k0,l0/), & 
    142                     tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  & 
    143                     parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), & 
    144                     ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue,ilook) 
    145             endif 
    146         enddo 
    147         enddo 
    148         enddo 
    149         enddo 
    150  
    151         endif 
     98                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue) 
     99            endif 
     100        enddo 
     101        enddo 
     102        enddo 
     103        enddo 
    152104    case (5) 
    153105        do m0 = pbtab(5),petab(5) 
     
    536488!--------------------------------------------------------------------------------------------------- 
    537489subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, & 
    538                                  MaxSearch, Agrif_SpecialValue, ilook ) 
     490                                 MaxSearch, Agrif_SpecialValue ) 
    539491!--------------------------------------------------------------------------------------------------- 
    540492    integer, parameter          :: nbdim = 4 
     
    559511! 
    560512    logical                     :: firsttest 
    561     integer :: ilook 
    562513! 
    563514    ValMax = 1 
     
    577528    firsttest = .TRUE. 
    578529    idecal = indic 
    579  
    580     if (ilook /= -1) then 
    581        i = ilook 
    582     else 
    583        i = 1 
    584     endif 
    585530! 
    586531    do while (i <= ValMax) 
    587532! 
    588 !        if ((i == 1).AND.(firsttest)) i = Valmax 
     533        if ((i == 1).AND.(firsttest)) i = Valmax 
    589534 
    590535        do iii = 1,nbdim 
     
    592537                imin(iii) = max(indic(iii) - i,ppbtab(iii)) 
    593538                imax(iii) = min(indic(iii) + i,ppetab(iii)) 
    594  !               if (firsttest) then 
    595  !                   if (indic(iii) > ppbtab(iii)) then 
    596  !                       idecal(iii) = idecal(iii)-1 
    597  !                       if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then 
    598  !                           imin(iii) = imax(iii) 
    599  !                       endif 
    600  !                       idecal(iii) = idecal(iii)+1 
    601  !                   endif 
    602  !               endif 
     539                if (firsttest) then 
     540                    if (indic(iii) > ppbtab(iii)) then 
     541                        idecal(iii) = idecal(iii)-1 
     542                        if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then 
     543                            imin(iii) = imax(iii) 
     544                        endif 
     545                        idecal(iii) = idecal(iii)+1 
     546                    endif 
     547                endif 
    603548            endif 
    604549        enddo 
     
    622567! 
    623568        if (Nbvals > 0) then 
    624 !            if (firsttest) then 
    625 !                firsttest = .FALSE. 
    626 !                i=1 
    627 !                cycle 
    628 !            endif 
     569            if (firsttest) then 
     570                firsttest = .FALSE. 
     571                i=1 
     572                cycle 
     573            endif 
    629574 
    630575            tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals 
    631             ilook = i 
    632576            exit 
    633577        else 
    634 !            if (firsttest) exit 
     578            if (firsttest) exit 
    635579            i = i + 1 
    636580        endif 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modsauv.F90

    r10087 r10725  
    2727! 
    2828module Agrif_Save 
    29 !    
     29! 
    3030    use Agrif_Types 
    3131    use Agrif_Link 
    3232    use Agrif_Arrays 
    33     use Agrif_User_Variables 
     33    use Agrif_Variables 
    3434! 
    3535    implicit none 
     
    250250! 
    251251    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure 
    252     real(kind=8)    :: g_eps, eps, oldgrid_eps 
     252    real    :: g_eps, eps, oldgrid_eps 
    253253    integer :: out 
    254254    integer :: iii 
     
    331331! 
    332332    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure 
    333     real(kind=8)    :: g_eps,eps,oldgrid_eps 
     333    real    :: g_eps,eps,oldgrid_eps 
    334334    integer :: out 
    335335    integer :: iii 
     
    415415    integer, dimension(6) :: nbtabold  ! Number of cells in each direction 
    416416    integer, dimension(6) :: nbtabnew  ! Number of cells in each direction 
    417     real(kind=8),    dimension(6) :: snew,sold 
    418     real(kind=8),    dimension(6) :: dsnew,dsold 
    419     real(kind=8)    :: eps 
     417    real,    dimension(6) :: snew,sold 
     418    real,    dimension(6) :: dsnew,dsold 
     419    real    :: eps 
    420420    integer :: n 
    421421! 
     
    531531    integer, dimension(nbdim),     intent(in)    :: pttabold 
    532532    integer, dimension(nbdim),     intent(in)    :: petabold 
    533     real(kind=8),    dimension(nbdim),     intent(in)    :: snew, sold 
    534     real(kind=8),    dimension(nbdim),     intent(in)    :: dsnew,dsold 
     533    real,    dimension(nbdim),     intent(in)    :: snew, sold 
     534    real,    dimension(nbdim),     intent(in)    :: dsnew,dsold 
    535535    integer,                       intent(in)    :: nbdim 
    536536! 
    537537    integer :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0 
    538538! 
    539     real(kind=8),    dimension(nbdim) :: dim_gmin,   dim_gmax 
    540     real(kind=8),    dimension(nbdim) :: dim_newmin, dim_newmax 
    541     real(kind=8),    dimension(nbdim) :: dim_min 
     539    real,    dimension(nbdim) :: dim_gmin,   dim_gmax 
     540    real,    dimension(nbdim) :: dim_newmin, dim_newmax 
     541    real,    dimension(nbdim) :: dim_min 
    542542    integer, dimension(nbdim) :: ind_gmin,ind_newmin, ind_newmax 
    543543! 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modseq.F90

    r10087 r10725  
    33    use Agrif_Init 
    44    use Agrif_Procs 
    5     use Agrif_Grids 
    6     !use Agrif_Arrays 
     5    use Agrif_Arrays 
    76! 
    87    implicit none 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modtypes.F90

    r10098 r10725  
    111111!> \name Arrays containing the values of the grid variables (real) 
    112112!> @{ 
    113     real,    dimension(:)          , pointer :: parray1 => NULL() 
    114     real,    dimension(:,:)        , pointer :: parray2 => NULL() 
    115     real,    dimension(:,:,:)      , pointer :: parray3 => NULL() 
    116     real,    dimension(:,:,:,:)    , pointer :: parray4 => NULL() 
    117     real,    dimension(:,:,:,:,:)  , pointer :: parray5 => NULL() 
    118     real,    dimension(:,:,:,:,:,:), pointer :: parray6 => NULL() 
     113    real,    dimension(:)          , pointer :: parray1 
     114    real,    dimension(:,:)        , pointer :: parray2 
     115    real,    dimension(:,:,:)      , pointer :: parray3 
     116    real,    dimension(:,:,:,:)    , pointer :: parray4 
     117    real,    dimension(:,:,:,:,:)  , pointer :: parray5 
     118    real,    dimension(:,:,:,:,:,:), pointer :: parray6 
    119119!> @} 
    120120!> \name Arrays containing the values of the grid variables (real*8) 
    121121!> @{ 
    122     real(8), dimension(:)          , pointer :: pdarray1 => NULL() 
    123     real(8), dimension(:,:)        , pointer :: pdarray2 => NULL() 
    124     real(8), dimension(:,:,:)      , pointer :: pdarray3 => NULL() 
    125     real(8), dimension(:,:,:,:)    , pointer :: pdarray4 => NULL() 
    126     real(8), dimension(:,:,:,:,:)  , pointer :: pdarray5 => NULL() 
    127     real(8), dimension(:,:,:,:,:,:), pointer :: pdarray6 => NULL() 
     122    real(8), dimension(:)          , pointer :: pdarray1 
     123    real(8), dimension(:,:)        , pointer :: pdarray2 
     124    real(8), dimension(:,:,:)      , pointer :: pdarray3 
     125    real(8), dimension(:,:,:,:)    , pointer :: pdarray4 
     126    real(8), dimension(:,:,:,:,:)  , pointer :: pdarray5 
     127    real(8), dimension(:,:,:,:,:,:), pointer :: pdarray6 
    128128!> @} 
    129129!> \name Arrays containing the values of the grid variables (real*4) 
    130130!> @{ 
    131     real(4), dimension(:)          , pointer :: psarray1 => NULL() 
    132     real(4), dimension(:,:)        , pointer :: psarray2 => NULL() 
    133     real(4), dimension(:,:,:)      , pointer :: psarray3 => NULL() 
    134     real(4), dimension(:,:,:,:)    , pointer :: psarray4 => NULL() 
    135     real(4), dimension(:,:,:,:,:)  , pointer :: psarray5 => NULL() 
    136     real(4), dimension(:,:,:,:,:,:), pointer :: psarray6 => NULL() 
     131    real(4), dimension(:)          , pointer :: psarray1 
     132    real(4), dimension(:,:)        , pointer :: psarray2 
     133    real(4), dimension(:,:,:)      , pointer :: psarray3 
     134    real(4), dimension(:,:,:,:)    , pointer :: psarray4 
     135    real(4), dimension(:,:,:,:,:)  , pointer :: psarray5 
     136    real(4), dimension(:,:,:,:,:,:), pointer :: psarray6 
    137137!> @} 
    138138!> \name Arrays used to restore the values 
     
    159159    integer, dimension(6)   :: ub 
    160160 
    161     integer, dimension(6,2) :: lubglob 
    162  
    163161    logical,dimension(6,2) :: memberin 
    164162    integer,dimension(6,2,2,6,2) :: childarray 
     
    288286    integer,dimension(6)              :: pttab, petab, pttab_Child, pttab_Parent = -99 
    289287    integer,dimension(6)              :: indmin, indmax 
    290     integer,dimension(6)              :: indmin_required_p, indmax_required_p 
    291288    integer,dimension(6)              :: pttruetab,cetruetab 
    292289    logical :: member, memberin 
     
    354351    real                  :: Agrif_Efficiency = 0.7 
    355352    integer               :: MaxSearch = 5 
    356     real(kind=8), dimension(3)    :: Agrif_mind 
     353    real, dimension(3)    :: Agrif_mind 
    357354!> @} 
    358355!> \name parameters for the interpolation of the child grids 
     
    374371    integer, parameter    :: Agrif_Update_Average = 2           !< average 
    375372    integer, parameter    :: Agrif_Update_Full_Weighting = 3    !< full-weighting 
     373    integer, parameter    :: Agrif_Update_Max = 4               !< Max 
    376374!> @} 
    377375!> \name Raffinement grid switches 
     
    418416integer function Agrif_Ceiling ( x ) 
    419417!--------------------------------------------------------------------------------------------------- 
    420     real(kind=8),intent(in) :: x 
     418    real,   intent(in) :: x 
    421419! 
    422420    integer   :: i 
     
    438436    integer function Agrif_Int(x) 
    439437!--------------------------------------------------------------------------------------------------- 
    440     real(kind=8),intent(in) :: x 
     438    real,   intent(in) :: x 
    441439! 
    442440    integer :: i 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modupdate.F90

    r10087 r10725  
    2727module Agrif_Update 
    2828! 
    29 !    use Agrif_UpdateBasic 
    30 !    use Agrif_Arrays 
    31 !    use Agrif_CurgridFunctions 
    32 !    use Agrif_Mask 
    33 #if defined AGRIF_MPI 
    34 !    use Agrif_Mpp 
    35 #endif 
    36 ! 
    3729    use Agrif_UpdateBasic 
    3830    use Agrif_Arrays 
    39     use Agrif_User_Functions 
    40     use Agrif_Init 
     31    use Agrif_CurgridFunctions 
    4132    use Agrif_Mask 
    42      
    4333#if defined AGRIF_MPI 
    4434    use Agrif_Mpp 
     
    6858    integer, dimension(6) :: ub_child 
    6959    integer, dimension(6) :: lb_parent 
    70     real(kind=8)   , dimension(6) ::  s_child           ! Child  grid position (s_root = 0) 
    71     real(kind=8)   , dimension(6) ::  s_parent          ! Parent grid position (s_root = 0) 
    72     real(kind=8)   , dimension(6) :: ds_child           ! Child  grid dx (ds_root = 1) 
    73     real(kind=8)   , dimension(6) :: ds_parent          ! Parent grid dx (ds_root = 1) 
     60    real   , dimension(6) ::  s_child           ! Child  grid position (s_root = 0) 
     61    real   , dimension(6) ::  s_parent          ! Parent grid position (s_root = 0) 
     62    real   , dimension(6) :: ds_child           ! Child  grid dx (ds_root = 1) 
     63    real   , dimension(6) :: ds_parent          ! Parent grid dx (ds_root = 1) 
    7464    logical, dimension(6) :: do_update          ! Indicates if we perform update for each dimension 
    7565    integer, dimension(6) :: posvar             ! Position of the variable on the cell (1 or 2) 
     
    170160    integer, dimension(nbdim), intent(in) :: posvar         !< Position of the variable on the cell (1 or 2) 
    171161    logical, dimension(nbdim), intent(in) :: do_update      !< Indicates if we update for each dimension 
    172     real(kind=8),    dimension(nbdim), intent(in) :: s_child        !< Positions of the child grid 
    173     real(kind=8),    dimension(nbdim), intent(in) :: s_parent       !< Positions of the parent grid 
    174     real(kind=8),    dimension(nbdim), intent(in) :: ds_child       !< Space steps of the child grid 
    175     real(kind=8),    dimension(nbdim), intent(in) :: ds_parent      !< Space steps of the parent grid 
     162    real,    dimension(nbdim), intent(in) :: s_child        !< Positions of the child grid 
     163    real,    dimension(nbdim), intent(in) :: s_parent       !< Positions of the parent grid 
     164    real,    dimension(nbdim), intent(in) :: ds_child       !< Space steps of the child grid 
     165    real,    dimension(nbdim), intent(in) :: ds_parent      !< Space steps of the parent grid 
    176166    procedure()                           :: procname       !< Data recovery procedure 
    177167! 
     
    240230! lubglob(:,2) : global lbound for each dimension 
    241231! 
    242 !     call Agrif_get_var_global_bounds(child, lubglob, nbdim) 
    243     lubglob = child % lubglob(1:nbdim,:) 
     232    call Agrif_get_var_global_bounds(child, lubglob, nbdim) 
    244233! 
    245234    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1)) 
     
    285274    integer, dimension(nbdim), intent(in)   :: posvar       !< Position of the variable on the cell (1 or 2) 
    286275    logical, dimension(nbdim), intent(in)   :: do_update    !< Indicates if we update for each dimension 
    287     real(kind=8),    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid 
    288     real(kind=8),    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid 
    289     real(kind=8),    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid 
    290     real(kind=8),    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid 
     276    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid 
     277    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid 
     278    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid 
     279    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid 
    291280    procedure()                             :: procname     !< Data recovery procedure 
    292281! 
     
    411400    integer, dimension(nbdim), intent(in)   :: lb_parent !< Index of the first point inside the domain for the parent 
    412401                                                            !!    grid variable 
    413     real(kind=8),    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid 
    414     real(kind=8),    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid 
    415     real(kind=8),    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid 
    416     real(kind=8),    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid 
     402    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid 
     403    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid 
     404    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid 
     405    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid 
    417406    procedure()                             :: procname     !< Data recovery procedure 
    418407    integer, optional,         intent(in)   :: nb, ndir 
     
    426415    integer, dimension(nbdim)       :: indmin, indmax 
    427416    integer, dimension(nbdim)       :: indminglob, indmaxglob 
    428     real(kind=8)   , dimension(nbdim)       :: s_Child_temp, s_Parent_temp 
     417    real   , dimension(nbdim)       :: s_Child_temp, s_Parent_temp 
    429418    integer, dimension(nbdim)       :: lowerbound,upperbound 
    430419    integer, dimension(nbdim)       :: pttruetabwhole, cetruetabwhole 
     
    461450    real :: coeff_multi 
    462451    integer :: nb_dimensions 
    463  
    464452! 
    465453!   Get local lower and upper bound of the child variable 
     
    518506! 
    519507        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim) 
    520 #if defined AGRIF_MPI 
    521508        call Agrif_var_set_array_tozero(tempC,nbdim) 
    522 #endif 
    523509 
    524510        SELECT CASE (nbdim) 
     
    615601! 
    616602        call Agrif_array_allocate(tempP,indmin,indmax,nbdim) 
    617  
    618         IF (Agrif_UseSpecialValueInUpdate) THEN 
    619             allocate(tempC_indic) 
    620             allocate(tempP_indic) 
    621             call Agrif_array_allocate(tempC_indic,pttruetabwhole,cetruetabwhole,nbdim) 
    622             call Agrif_array_allocate(tempP_indic,indmin,indmax,nbdim) 
    623             call agrif_set_array_cond(tempCextend,tempC_indic,agrif_SpecialValueFineGrid,nbdim) 
    624         ELSE 
    625             tempC_indic=>tempCextend ! Just to associate tempC_indic to something ... 
    626         ENDIF 
    627 ! 
    628  
    629  
     603! 
    630604        if ( nbdim == 1 ) then 
    631605            tempP % array1 = 0. 
     
    633607                                            tempP%array1,   & 
    634608                                            tempCextend%array1, & 
    635                                             tempC_indic%array1, & 
    636609                                            indmin(1), indmax(1),   & 
    637610                                            pttruetabwhole(1), cetruetabwhole(1),   & 
     
    640613                                             
    641614            IF (Agrif_UseSpecialValueInUpdate) THEN 
     615            allocate(tempC_indic) 
     616            allocate(tempP_indic) 
     617            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array1),ubound(tempCextend%array1),nbdim) 
     618            call Agrif_array_allocate(tempP_indic,lbound(tempP%array1),ubound(tempP%array1),nbdim) 
    642619 
    643620            compute_average = .FALSE. 
     
    653630                                            tempP_average%array1,       & 
    654631                                            tempCextend%array1, & 
    655                                             tempC_indic%array1, & 
    656632                                            indmin(1), indmax(1),   & 
    657633                                            pttruetabwhole(1), cetruetabwhole(1),   & 
     
    664640            ENDIF 
    665641             
     642            WHERE (tempCextend%array1 == Agrif_SpecialValueFineGrid) 
     643              tempC_indic%array1 = 0. 
     644            ELSEWHERE 
     645              tempC_indic%array1 = 1. 
     646            END WHERE 
     647             
    666648            Agrif_UseSpecialValueInUpdate = .FALSE. 
    667649            Agrif_Update_Weights = .TRUE. 
     
    669651             call Agrif_Update_1D_Recursive( type_update_temp(1),   & 
    670652                                            tempP_indic%array1,       & 
    671                                             tempC_indic%array1, & 
    672653                                            tempC_indic%array1, & 
    673654                                            indmin(1), indmax(1),   & 
     
    711692                                            tempP%array2,       & 
    712693                                            tempCextend%array2, & 
    713                                             tempC_indic%array2, & 
    714694                                            indmin(1:2), indmax(1:2),   & 
    715695                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   & 
     
    718698 
    719699            IF (Agrif_UseSpecialValueInUpdate) THEN 
     700            allocate(tempC_indic) 
     701            allocate(tempP_indic) 
     702            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array2),ubound(tempCextend%array2),nbdim) 
     703            call Agrif_array_allocate(tempP_indic,lbound(tempP%array2),ubound(tempP%array2),nbdim) 
    720704  
    721705            compute_average = .FALSE. 
     
    731715                                            tempP_average%array2,       & 
    732716                                            tempCextend%array2, & 
    733                                             tempC_indic%array2, & 
    734717                                            indmin(1:2), indmax(1:2),   & 
    735718                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   & 
     
    742725            ENDIF 
    743726             
     727            WHERE (tempCextend%array2 == Agrif_SpecialValueFineGrid) 
     728              tempC_indic%array2 = 0. 
     729            ELSEWHERE 
     730              tempC_indic%array2 = 1. 
     731            END WHERE 
     732             
    744733            Agrif_UseSpecialValueInUpdate = .FALSE. 
    745734            Agrif_Update_Weights = .TRUE. 
     
    747736            call Agrif_Update_2D_Recursive( type_update_temp(1:2),   & 
    748737                                            tempP_indic%array2,       & 
    749                                             tempC_indic%array2, & 
    750738                                            tempC_indic%array2, & 
    751739                                            indmin(1:2), indmax(1:2),   & 
     
    786774        endif 
    787775        if ( nbdim == 3 ) then 
    788  
    789776            call Agrif_Update_3D_Recursive( type_update(1:3),   & 
    790777                                            tempP%array3,       & 
    791778                                            tempCextend%array3, & 
    792                                             tempC_indic%array3, & 
    793779                                            indmin(1:3), indmax(1:3),   & 
    794780                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   & 
    795781                                            s_Child_temp(1:3), s_Parent_temp(1:3),      & 
    796782                                            ds_child(1:3), ds_parent(1:3) ) 
    797  
    798                        
     783                                             
    799784            IF (Agrif_UseSpecialValueInUpdate) THEN 
     785            allocate(tempC_indic) 
     786            allocate(tempP_indic) 
     787            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array3),ubound(tempCextend%array3),nbdim) 
     788            call Agrif_array_allocate(tempP_indic,lbound(tempP%array3),ubound(tempP%array3),nbdim) 
    800789 
    801790            compute_average = .FALSE. 
     
    808797                type_update_temp(1:nbdim) = Agrif_Update_Average 
    809798              END WHERE 
    810  
    811799              call Agrif_Update_3D_Recursive( type_update_temp(1:3),   & 
    812800                                            tempP_average%array3,       & 
    813801                                            tempCextend%array3, & 
    814                                             tempC_indic%array3, & 
    815802                                            indmin(1:3), indmax(1:3),   & 
    816803                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   & 
     
    822809              enddo 
    823810            ENDIF 
    824  
     811             
     812            WHERE (tempCextend%array3 == Agrif_SpecialValueFineGrid) 
     813              tempC_indic%array3 = 0. 
     814            ELSEWHERE 
     815              tempC_indic%array3 = 1. 
     816            END WHERE 
     817             
    825818            Agrif_UseSpecialValueInUpdate = .FALSE. 
    826819            Agrif_Update_Weights = .TRUE. 
    827  
    828  
     820  
    829821             call Agrif_Update_3D_Recursive( type_update_temp(1:3),   & 
    830822                                            tempP_indic%array3,       & 
    831823                                            tempC_indic%array3, & 
    832                                             tempCextend%array3, & 
    833824                                            indmin(1:3), indmax(1:3),   & 
    834825                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   & 
     
    836827                                            ds_child(1:3), ds_parent(1:3) ) 
    837828 
    838  
    839829           Agrif_UseSpecialValueInUpdate = .TRUE. 
    840830           Agrif_Update_Weights = .FALSE. 
    841831 
    842  
    843832           IF (compute_average) THEN 
    844           
    845833               WHERE (tempP_indic%array3 == 0.) 
    846834                  tempP%array3 = Agrif_SpecialValueFineGrid 
     
    850838                  tempP%array3 = tempP_average%array3 /tempP_indic%array3 
    851839               END WHERE 
    852              
     840 
    853841           ELSE 
    854842               WHERE (tempP_indic%array3 == 0.) 
     
    858846               END WHERE 
    859847            ENDIF 
    860  
     848            
    861849            deallocate(tempP_indic%array3) 
    862850            deallocate(tempC_indic%array3) 
     
    868856            ENDIF 
    869857            ENDIF 
    870  
    871           
     858             
    872859        endif 
    873860        if ( nbdim == 4 ) then 
    874            
    875861            call Agrif_Update_4D_Recursive( type_update(1:4),   & 
    876862                                            tempP%array4,       & 
    877863                                            tempCextend%array4, & 
    878                                             tempC_indic%array4, & 
    879864                                            indmin(1:4), indmax(1:4),   & 
    880865                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   & 
    881866                                            s_Child_temp(1:4), s_Parent_temp(1:4),      & 
    882867                                            ds_child(1:4), ds_parent(1:4) ) 
    883                  
     868                                             
    884869            IF (Agrif_UseSpecialValueInUpdate) THEN 
     870             
     871            allocate(tempC_indic) 
     872            allocate(tempP_indic) 
     873            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array4),ubound(tempCextend%array4),nbdim) 
     874            call Agrif_array_allocate(tempP_indic,lbound(tempP%array4),ubound(tempP%array4),nbdim) 
    885875            
    886876            compute_average = .FALSE. 
     
    896886                                            tempP_average%array4,       & 
    897887                                            tempCextend%array4, & 
    898                                             tempC_indic%array4, & 
    899888                                            indmin(1:4), indmax(1:4),   & 
    900889                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   & 
     
    907896            ENDIF 
    908897             
     898            WHERE (tempCextend%array4 == Agrif_SpecialValueFineGrid) 
     899              tempC_indic%array4 = 0. 
     900            ELSEWHERE 
     901              tempC_indic%array4 = 1. 
     902            END WHERE 
     903             
    909904            Agrif_UseSpecialValueInUpdate = .FALSE. 
    910905            Agrif_Update_Weights = .TRUE. 
     
    912907             call Agrif_Update_4D_Recursive( type_update_temp(1:4),   & 
    913908                                            tempP_indic%array4,       & 
    914                                             tempC_indic%array4, & 
    915909                                            tempC_indic%array4, & 
    916910                                            indmin(1:4), indmax(1:4),   & 
     
    947941            ENDIF 
    948942            ENDIF 
    949                   
     943             
    950944        endif 
    951945        if ( nbdim == 5 ) then 
     
    953947                                            tempP%array5,       & 
    954948                                            tempCextend%array5, & 
    955                                             tempC_indic%array5, & 
    956949                                            indmin(1:5), indmax(1:5),   & 
    957950                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   & 
     
    960953                                             
    961954            IF (Agrif_UseSpecialValueInUpdate) THEN 
     955            allocate(tempC_indic) 
     956            allocate(tempP_indic) 
     957            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array5),ubound(tempCextend%array5),nbdim) 
     958            call Agrif_array_allocate(tempP_indic,lbound(tempP%array5),ubound(tempP%array5),nbdim) 
    962959 
    963960            compute_average = .FALSE. 
     
    973970                                            tempP_average%array5,       & 
    974971                                            tempCextend%array5, & 
    975                                             tempC_indic%array5, & 
    976972                                            indmin(1:5), indmax(1:5),   & 
    977973                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   & 
     
    984980            ENDIF 
    985981             
     982            WHERE (tempCextend%array5 == Agrif_SpecialValueFineGrid) 
     983              tempC_indic%array5 = 0. 
     984            ELSEWHERE 
     985              tempC_indic%array5 = 1. 
     986            END WHERE 
     987             
    986988            Agrif_UseSpecialValueInUpdate = .FALSE. 
    987989            Agrif_Update_Weights = .TRUE. 
     
    989991             call Agrif_Update_5D_Recursive( type_update_temp(1:5),   & 
    990992                                            tempP_indic%array5,       & 
    991                                             tempC_indic%array5, & 
    992993                                            tempC_indic%array5, & 
    993994                                            indmin(1:5), indmax(1:5),   & 
     
    10311032                                            tempP%array6,       & 
    10321033                                            tempCextend%array6, & 
    1033                                             tempC_indic%array6, & 
    10341034                                            indmin(1:6), indmax(1:6),   & 
    10351035                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   & 
    10361036                                            s_Child_temp(1:6), s_Parent_temp(1:6),      & 
    10371037                                            ds_child(1:6), ds_parent(1:6) ) 
    1038  
    10391038            IF (Agrif_UseSpecialValueInUpdate) THEN 
     1039            allocate(tempC_indic) 
     1040            allocate(tempP_indic) 
     1041            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array6),ubound(tempCextend%array6),nbdim) 
     1042            call Agrif_array_allocate(tempP_indic,lbound(tempP%array6),ubound(tempP%array6),nbdim) 
    10401043 
    10411044            compute_average = .FALSE. 
     
    10521055                                            tempP_average%array6,       & 
    10531056                                            tempCextend%array6, & 
    1054                                             tempC_indic%array6, & 
    10551057                                            indmin(1:6), indmax(1:6),   & 
    10561058                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   & 
     
    10631065            ENDIF 
    10641066 
    1065              
    1066             Agrif_UseSpecialValueInUpdate = .FALSE. 
    1067             Agrif_Update_Weights = .TRUE. 
    1068   
    1069              call Agrif_Update_6D_Recursive( type_update_temp(1:6),   & 
    1070                                             tempP_indic%array6,       & 
    1071                                             tempC_indic%array6, & 
    1072                                             tempC_indic%array6, & 
    1073                                             indmin(1:6), indmax(1:6),   & 
    1074                                             pttruetabwhole(1:6), cetruetabwhole(1:6),   & 
    1075                                             s_Child_temp(1:6), s_Parent_temp(1:6),      & 
    1076                                             ds_child(1:6), ds_parent(1:6) ) 
    1077  
    1078            Agrif_UseSpecialValueInUpdate = .TRUE. 
    1079            Agrif_Update_Weights = .FALSE. 
    1080             
    10811067           IF (compute_average) THEN 
    10821068               WHERE (tempP_indic%array6 == 0.) 
     
    10951081               END WHERE 
    10961082            ENDIF 
     1083             
     1084            Agrif_UseSpecialValueInUpdate = .FALSE. 
     1085            Agrif_Update_Weights = .TRUE. 
     1086  
     1087             call Agrif_Update_6D_Recursive( type_update_temp(1:6),   & 
     1088                                            tempP_indic%array6,       & 
     1089                                            tempC_indic%array6, & 
     1090                                            indmin(1:6), indmax(1:6),   & 
     1091                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   & 
     1092                                            s_Child_temp(1:6), s_Parent_temp(1:6),      & 
     1093                                            ds_child(1:6), ds_parent(1:6) ) 
     1094 
     1095           Agrif_UseSpecialValueInUpdate = .TRUE. 
     1096           Agrif_Update_Weights = .FALSE. 
     1097            
     1098            WHERE (tempP_indic%array6 == 0.) 
     1099              tempP%array6 = Agrif_SpecialValueFineGrid 
     1100            ELSEWHERE 
     1101              tempP%array6 = tempP%array6 /tempP_indic%array6 
     1102            END WHERE 
    10971103            
    10981104            deallocate(tempP_indic%array6) 
     
    13191325    integer,                   intent(in)   :: nbdim 
    13201326    integer, dimension(nbdim), intent(out)  :: indmin, indmax 
    1321     real(kind=8),    dimension(nbdim), intent(out)  :: s_Parent_temp, s_Child_temp 
    1322     real(kind=8),    dimension(nbdim), intent(in)   :: s_child,  ds_child 
    1323     real(kind=8),    dimension(nbdim), intent(in)   :: s_parent, ds_parent 
     1327    real,    dimension(nbdim), intent(out)  :: s_Parent_temp, s_Child_temp 
     1328    real,    dimension(nbdim), intent(in)   :: s_child,  ds_child 
     1329    real,    dimension(nbdim), intent(in)   :: s_parent, ds_parent 
    13241330    integer, dimension(nbdim), intent(in)   :: pttruetab, cetruetab 
    13251331    integer, dimension(nbdim), intent(in)   :: lb_child, lb_parent 
     
    13311337#endif 
    13321338! 
    1333     real(kind=8),dimension(nbdim) :: dim_newmin,dim_newmax 
     1339    real,dimension(nbdim) :: dim_newmin,dim_newmax 
    13341340    integer :: i 
    13351341#if defined AGRIF_MPI 
    1336     real(kind=8)    :: positionmin, positionmax 
     1342    real    :: positionmin, positionmax 
    13371343    integer :: imin, imax 
    13381344    integer :: coeffraf 
     
    13511357        IF ( do_update(i) ) THEN 
    13521358            IF (posvar(i) == 1) THEN 
    1353                 IF      (type_update(i) == Agrif_Update_Average) THEN 
     1359                IF ((type_update(i) == Agrif_Update_Average).OR.(type_update(i) == Agrif_Update_Max)) THEN 
    13541360                    positionmin = positionmin - ds_parent(i)/2. 
    13551361                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN 
     
    13771383        IF ( do_update(i) ) THEN 
    13781384            IF (posvar(i) == 1) THEN 
    1379                 IF      (type_update(i) == Agrif_Update_Average) THEN 
     1385                IF ((type_update(i) == Agrif_Update_Average).OR.(type_update(i) == Agrif_Update_Max)) THEN 
    13801386                    positionmax = positionmax  + ds_parent(i)/2. 
    13811387                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN 
     
    14181424!> Updates a 1D grid variable on the parent grid 
    14191425!--------------------------------------------------------------------------------------------------- 
    1420 subroutine Agrif_Update_1D_Recursive ( type_update,                     & 
    1421                                        tempP, tempC, tempC_indic,       & 
    1422                                        indmin, indmax,                  & 
    1423                                        lb_child, ub_child,              & 
    1424                                        s_child,  s_parent,              & 
     1426subroutine Agrif_Update_1D_Recursive ( type_update,         & 
     1427                                       tempP, tempC,        & 
     1428                                       indmin, indmax,      & 
     1429                                       lb_child, ub_child,  & 
     1430                                       s_child,  s_parent,  & 
    14251431                                       ds_child, ds_parent ) 
    14261432!--------------------------------------------------------------------------------------------------- 
     
    14281434    integer,                            intent(in)  :: indmin, indmax 
    14291435    integer,                            intent(in)  :: lb_child, ub_child 
    1430     real(kind=8),                               intent(in)  ::  s_child,  s_parent 
    1431     real(kind=8),                               intent(in)  :: ds_child, ds_parent 
     1436    real,                               intent(in)  ::  s_child,  s_parent 
     1437    real,                               intent(in)  :: ds_child, ds_parent 
    14321438    real, dimension(indmin:indmax),     intent(out) :: tempP 
    1433     real, dimension(lb_child:ub_child), intent(in)  :: tempC, tempC_indic 
     1439    real, dimension(lb_child:ub_child), intent(in)  :: tempC 
    14341440!--------------------------------------------------------------------------------------------------- 
    14351441    call Agrif_UpdateBase(type_update,              & 
     
    14501456!! Calls #Agrif_Update_1D_Recursive and #Agrif_UpdateBase 
    14511457!--------------------------------------------------------------------------------------------------- 
    1452 subroutine Agrif_Update_2D_Recursive ( type_update,                     & 
    1453                                        tempP, tempC, tempC_indic,       & 
    1454                                        indmin, indmax,                  & 
    1455                                        lb_child, ub_child,              & 
    1456                                        s_child,  s_parent,              & 
     1458subroutine Agrif_Update_2D_Recursive ( type_update,         & 
     1459                                       tempP, tempC,        & 
     1460                                       indmin, indmax,      & 
     1461                                       lb_child, ub_child,  & 
     1462                                        s_child,  s_parent, & 
    14571463                                       ds_child, ds_parent ) 
    14581464!--------------------------------------------------------------------------------------------------- 
     
    14601466    integer, dimension(2),          intent(in)  :: indmin, indmax 
    14611467    integer, dimension(2),          intent(in)  :: lb_child, ub_child 
    1462     real(kind=8),    dimension(2),          intent(in)  ::  s_child,  s_parent 
    1463     real(kind=8),    dimension(2),          intent(in)  :: ds_child, ds_parent 
     1468    real,    dimension(2),          intent(in)  ::  s_child,  s_parent 
     1469    real,    dimension(2),          intent(in)  :: ds_child, ds_parent 
    14641470    real,    dimension(          & 
    14651471        indmin(1):indmax(1),     & 
    14661472        indmin(2):indmax(2)),       intent(out) :: tempP 
    1467     real,    dimension(:,:),        intent(in)  :: tempC, tempC_indic 
     1473    real,    dimension(:,:),        intent(in)  :: tempC 
    14681474!--------------------------------------------------------------------------------------------------- 
    14691475    real, dimension(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp 
     
    14711477    real, dimension(lb_child(2):ub_child(2), indmin(1):indmax(1)) :: tabtemp_trsp 
    14721478    integer :: i, j 
    1473     integer :: coeffraf, coeffraf_2 
    1474    integer :: jmin,jmax 
    1475     integer locind_child_left, locind_child_left_2,kuinf 
    1476     logical :: to_transpose 
    1477     real :: invcoeffraf 
    1478     integer :: diffmod, jj,i1,j1 
    1479  
    1480  
    1481     to_transpose = .TRUE. 
    1482 ! 
    1483      
     1479    integer :: coeffraf 
     1480! 
     1481    tabtemp = 0. 
    14841482    coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
    14851483! 
     
    14941492        endif 
    14951493!---CDIR NEXPAND 
    1496         tabtemp = 0. 
    14971494        call Average1dAfterCompute( tabtemp, tempC, size(tabtemp), size(tempC), & 
    14981495                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 
     
    15081505        endif 
    15091506!---CDIR NEXPAND 
    1510  
    15111507        call Agrif_basicupdate_copy1d_after(tabtemp,tempC,size(tabtemp),size(tempC),1) 
    15121508! 
    1513     ELSE IF ((coeffraf == 1).AND.(type_update(2) == Agrif_Update_Average)) THEN 
    1514             locind_child_left = 1+agrif_int((s_parent(1)-s_child(1))/ds_child(1)) 
    1515             coeffraf_2 = nint ( ds_parent(2) / ds_child(2) ) 
    1516             invcoeffraf = 1./coeffraf_2 
    1517             tempP = 0. 
    1518             diffmod = 0 
    1519             if (mod(coeffraf_2,2) == 0) diffmod = 1 
    1520             locind_child_left_2 = 1+agrif_int((s_parent(2)-s_child(2))/ds_child(2)) 
    1521  
    1522             if (Agrif_UseSpecialValueInUpdate) then 
    1523               j1 = -coeffraf_2/2+locind_child_left_2+diffmod 
    1524               do j=indmin(2),indmax(2) 
    1525                 do jj=j1,j1+coeffraf_2-1 
    1526                   i1 = locind_child_left 
    1527                   do i=indmin(1),indmax(1) 
    1528                      tempP(i,j) = tempP(i,j) + tempC(i1,jj)*tempC_indic(i1,jj) 
    1529                      i1 = i1 + 1 
    1530                   enddo 
    1531                 enddo 
    1532                 j1 = j1 + coeffraf_2 
    1533               enddo 
    1534             else 
    1535               j1 = -coeffraf_2/2+locind_child_left_2+diffmod 
    1536               do j=indmin(2),indmax(2) 
    1537                 do jj=j1,j1+coeffraf_2-1 
    1538                   do i=indmin(1),indmax(1) 
    1539                        tempP(i,j) = tempP(i,j) + tempC(locind_child_left+i-indmin(1),jj) 
    1540                   enddo 
    1541                 enddo 
    1542                 j1 = j1 + coeffraf_2 
    1543               enddo 
    1544               if (.not.Agrif_Update_Weights) tempP = tempP * invcoeffraf 
    1545             endif 
    1546             return 
    1547 ! 
    1548     ELSE IF ((coeffraf == 1).AND.(type_update(2) == Agrif_Update_Copy)) THEN 
    1549  
    1550             locind_child_left = 1 + agrif_int((s_parent(1)-s_child(1))/ds_child(1)) 
    1551 ! 
    1552             locind_child_left_2 = 1+nint((s_parent(2)-s_child(2))/ds_child(2)) 
    1553             coeffraf_2 = nint ( ds_parent(2) / ds_child(2) ) 
    1554  
    1555             do j=indmin(2),indmax(2) 
    1556               do i=indmin(1),indmax(1) 
    1557                 tempP(i,j) = tempC(locind_child_left+i-indmin(1),locind_child_left_2) 
    1558               enddo 
    1559               locind_child_left_2 = locind_child_left_2 + coeffraf_2 
    1560             enddo 
    1561  
    1562             return 
    1563  
    1564     ELSE IF (coeffraf == 1) THEN 
    1565             locind_child_left = 1 + agrif_int((s_parent(1)-s_child(1))/ds_child(1)) 
    1566 ! 
    1567             do j = lb_child(2),ub_child(2) 
    1568 !              tabtemp(indmin(1):indmax(1),j) = tempC(locind_child_left:locind_child_left+indmax(1)-indmin(1),j-lb_child(2)+1) 
    1569               tabtemp_trsp(j,indmin(1):indmax(1)) = tempC(locind_child_left:locind_child_left+indmax(1)-indmin(1),j-lb_child(2)+1) 
    1570             enddo 
    1571             to_transpose = .FALSE. 
    15721509    ELSE 
    15731510        do j = lb_child(2),ub_child(2) 
     
    15771514                                            tabtemp(:,j),               & 
    15781515                                            tempC(:,j-lb_child(2)+1),   & 
    1579                                             tempC_indic(:,j-lb_child(2)+1),   & 
    15801516                                            indmin(1), indmax(1),       & 
    15811517                                            lb_child(1),ub_child(1),    & 
     
    15851521    ENDIF 
    15861522! 
    1587  
    1588     if (to_transpose) tabtemp_trsp = TRANSPOSE(tabtemp) 
    1589  
     1523    tabtemp_trsp = TRANSPOSE(tabtemp) 
    15901524    coeffraf = nint(ds_parent(2)/ds_child(2)) 
    15911525! 
     
    16321566    ENDIF 
    16331567! 
    1634  
    1635     
    16361568    tempP = TRANSPOSE(tempP_trsp) 
    16371569!--------------------------------------------------------------------------------------------------- 
    16381570end subroutine Agrif_Update_2D_Recursive 
     1571!=================================================================================================== 
     1572! 
     1573subroutine Agrif_Update_2D_Recursive_ok ( type_update, & 
     1574                                        tempP, tempC, & 
     1575                                        indmin, indmax,   & 
     1576                                       lb_child, ub_child,                    & 
     1577                                       s_child, s_parent, ds_child, ds_parent ) 
     1578!--------------------------------------------------------------------------------------------------- 
     1579    INTEGER, DIMENSION(2), intent(in)   :: type_update            !< Type of update (copy or average) 
     1580    INTEGER, DIMENSION(2), intent(in)   :: indmin, indmax 
     1581    INTEGER, DIMENSION(2), intent(in)   :: lb_child, ub_child 
     1582    REAL,    DIMENSION(2), intent(in)   :: s_child,  s_parent 
     1583    REAL,    DIMENSION(2), intent(in)   :: ds_child, ds_parent 
     1584    REAL,    DIMENSION(                 & 
     1585                indmin(1):indmax(1),    & 
     1586                indmin(2):indmax(2)),           intent(out) :: tempP 
     1587    REAL, DIMENSION(                            & 
     1588                lb_child(1):ub_child(1),  & 
     1589                lb_child(2):ub_child(2)), intent(in)  :: tempC 
     1590! 
     1591    REAL, DIMENSION(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp 
     1592    INTEGER :: i 
     1593! 
     1594    do i = lb_child(2),ub_child(2) 
     1595        call Agrif_Update_1D_Recursive(type_update(1),                              & 
     1596                                       tabtemp(:, i),          & 
     1597                                       tempC(:,i),  & 
     1598                                       indmin(1),indmax(1),                 & 
     1599                                       lb_child(1),ub_child(1),       & 
     1600                                       s_child(1), s_parent(1),             & 
     1601                                      ds_child(1),ds_parent(1)) 
     1602    enddo 
     1603! 
     1604    tempP = 0. 
     1605! 
     1606    do i = indmin(1),indmax(1) 
     1607        call Agrif_UpdateBase(type_update(2),                                       & 
     1608                              tempP(i,:),             & 
     1609                              tabtemp(i,:), & 
     1610                              indmin(2),indmax(2),                          & 
     1611                              lb_child(2),ub_child(2),                & 
     1612                              s_parent(2),s_child(2),                       & 
     1613                             ds_parent(2),ds_child(2)) 
     1614    enddo 
     1615!--------------------------------------------------------------------------------------------------- 
     1616end subroutine Agrif_Update_2D_Recursive_ok 
    16391617!=================================================================================================== 
    16401618 
     
    16461624!! Calls #Agrif_Update_2D_Recursive and #Agrif_UpdateBase. 
    16471625!--------------------------------------------------------------------------------------------------- 
    1648 subroutine Agrif_Update_3D_Recursive ( type_update,                     & 
    1649                                        tempP, tempC, tempC_indic,       & 
    1650                                        indmin, indmax,                  & 
    1651                                        lb_child, ub_child,              & 
    1652                                        s_child,  s_parent,              & 
     1626subroutine Agrif_Update_3D_Recursive ( type_update,         & 
     1627                                       tempP, tempC,        & 
     1628                                       indmin, indmax,      & 
     1629                                       lb_child, ub_child,  & 
     1630                                        s_child,  s_parent, & 
    16531631                                       ds_child, ds_parent ) 
    16541632!--------------------------------------------------------------------------------------------------- 
     
    16561634    integer, dimension(3),          intent(in)  :: indmin, indmax 
    16571635    integer, dimension(3),          intent(in)  :: lb_child, ub_child 
    1658     real(kind=8),    dimension(3),          intent(in)  ::  s_child,  s_parent 
    1659     real(kind=8),    dimension(3),          intent(in)  :: ds_child, ds_parent 
     1636    real,    dimension(3),          intent(in)  ::  s_child,  s_parent 
     1637    real,    dimension(3),          intent(in)  :: ds_child, ds_parent 
    16601638    real,    dimension(          & 
    16611639        indmin(1):indmax(1),     & 
     
    16651643        lb_child(1):ub_child(1), & 
    16661644        lb_child(2):ub_child(2), & 
    1667         lb_child(3):ub_child(3)),   intent(in)  :: tempC, tempC_indic 
     1645        lb_child(3):ub_child(3)),   intent(in)  :: tempC 
    16681646!--------------------------------------------------------------------------------------------------- 
    16691647    real, dimension(            & 
     
    16741652    integer :: coeffraf,locind_child_left 
    16751653    integer :: kuinf 
    1676     REAL :: invcoeffraf 
    1677     INTEGER :: diffmod, kk 
    16781654! 
    16791655    coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
     
    17131689    endif 
    17141690! 
    1715  !   do k = lb_child(3),ub_child(3) 
    1716  !       call Agrif_Update_2D_Recursive( type_update(1:2),tabtemp(:,:,k),tempC(:,:,k), & 
    1717  !                                       indmin(1:2),indmax(1:2),                & 
    1718  !                                       lb_child(1:2),ub_child(1:2),      & 
    1719  !                                       s_child(1:2),s_parent(1:2),             & 
    1720  !                                       ds_child(1:2),ds_parent(1:2) ) 
    1721  !   enddo 
    1722  
    1723  
    17241691    do k = lb_child(3),ub_child(3) 
    1725         call Agrif_Update_2D_Recursive( type_update,tabtemp(:,:,k),tempC(:,:,k),tempC_indic(:,:,k), & 
    1726                                         indmin,indmax,                & 
    1727                                         lb_child,ub_child,      & 
    1728                                         s_child,s_parent,             & 
    1729                                         ds_child,ds_parent) 
    1730     enddo 
    1731  
     1692        call Agrif_Update_2D_Recursive( type_update(1:2),tabtemp(:,:,k),tempC(:,:,k), & 
     1693                                        indmin(1:2),indmax(1:2),                & 
     1694                                        lb_child(1:2),ub_child(1:2),      & 
     1695                                        s_child(1:2),s_parent(1:2),             & 
     1696                                        ds_child(1:2),ds_parent(1:2) ) 
     1697    enddo 
    17321698! 
    17331699    precomputedone(1) = .FALSE. 
     
    17471713            enddo 
    17481714        enddo 
    1749     else if (type_update(3) == Agrif_Update_Copy) then 
    1750     locind_child_left = lb_child(3) + nint((s_parent(3)-s_child(3))/ds_child(3)) 
    1751  
    1752         do k=indmin(3),indmax(3) 
    1753             do j = indmin(2),indmax(2) 
    1754             do i = indmin(1),indmax(1) 
    1755                 tempP(i,j,k) = tabtemp(i,j,locind_child_left) 
    1756             enddo 
    1757             enddo 
    1758             locind_child_left = locind_child_left + coeffraf 
    1759         enddo 
    1760     else if (type_update(3) == Agrif_Update_Average) then 
    1761       invcoeffraf = 1./coeffraf 
    1762       tempP = 0. 
    1763       diffmod = 0 
    1764       if (mod(coeffraf,2) == 0) diffmod=1  
    1765       locind_child_left = lb_child(3) + agrif_int((s_parent(3)-s_child(3))/ds_child(3)) 
    1766       if (Agrif_UseSpecialValueInUpdate) then 
    1767         do k=indmin(3),indmax(3) 
    1768           do kk=-coeffraf/2+locind_child_left+diffmod, & 
    1769                    coeffraf/2+locind_child_left 
    1770             do j=indmin(2),indmax(2) 
    1771             do i=indmin(1),indmax(1) 
    1772                if (tabtemp(i,j,kk) /= Agrif_SpecialValueFineGrid) then 
    1773                   tempP(i,j,k) = tempP(i,j,k) + tabtemp(i,j,kk) 
    1774                endif 
    1775             enddo 
    1776             enddo 
    1777           enddo 
    1778           locind_child_left = locind_child_left + coeffraf 
    1779         enddo 
    1780       else 
    1781         do k=indmin(3),indmax(3) 
    1782           do kk=-coeffraf/2+locind_child_left+diffmod, & 
    1783                    coeffraf/2+locind_child_left 
    1784             do j=indmin(2),indmax(2) 
    1785             do i=indmin(1),indmax(1) 
    1786                   tempP(i,j,k) = tempP(i,j,k) + tabtemp(i,j,kk) 
    1787             enddo 
    1788             enddo 
    1789           enddo 
    1790           locind_child_left = locind_child_left + coeffraf 
    1791         enddo 
    1792         if (.not.Agrif_Update_Weights) tempP = tempP * invcoeffraf 
    1793       endif 
    17941715    else 
     1716        tempP = 0. 
    17951717        do j = indmin(2),indmax(2) 
    17961718        do i = indmin(1),indmax(1) 
     
    18001722                                  s_parent(3),s_child(3),               & 
    18011723                                  ds_parent(3),ds_child(3)) 
    1802  
     1724! 
    18031725        enddo 
    18041726        enddo 
    1805  
    1806  
    18071727    endif 
    18081728!--------------------------------------------------------------------------------------------------- 
     
    18161736!! Calls #Agrif_Update_3D_Recursive and #Agrif_UpdateBase. 
    18171737!--------------------------------------------------------------------------------------------------- 
    1818 subroutine Agrif_Update_4D_Recursive ( type_update,                     & 
    1819                                        tempP, tempC, tempC_indic,       & 
    1820                                        indmin, indmax,                  & 
    1821                                        lb_child, ub_child,              & 
    1822                                        s_child,  s_parent,              & 
     1738subroutine Agrif_Update_4D_Recursive ( type_update,         & 
     1739                                       tempP, tempC,        & 
     1740                                       indmin, indmax,      & 
     1741                                       lb_child, ub_child,  & 
     1742                                        s_child,  s_parent, & 
    18231743                                       ds_child, ds_parent ) 
    18241744!--------------------------------------------------------------------------------------------------- 
     
    18261746    integer, dimension(4),          intent(in)  :: indmin, indmax 
    18271747    integer, dimension(4),          intent(in)  :: lb_child, ub_child 
    1828     real(kind=8),    dimension(4),          intent(in)  ::  s_child,  s_parent 
    1829     real(kind=8),    dimension(4),          intent(in)  :: ds_child, ds_parent 
     1748    real,    dimension(4),          intent(in)  ::  s_child,  s_parent 
     1749    real,    dimension(4),          intent(in)  :: ds_child, ds_parent 
    18301750    real,    dimension(          & 
    18311751        indmin(1):indmax(1),     & 
     
    18371757        lb_child(2):ub_child(2), & 
    18381758        lb_child(3):ub_child(3), & 
    1839         lb_child(4):ub_child(4)),   intent(in)  :: tempC, tempC_indic 
     1759        lb_child(4):ub_child(4)),   intent(in)  :: tempC 
    18401760!--------------------------------------------------------------------------------------------------- 
    18411761    real, dimension(:,:,:,:), allocatable       :: tabtemp 
     
    18531773                                               indmin(3):indmax(3), l),     & 
    18541774                                       tempC(lb_child(1):ub_child(1),       & 
    1855                                              lb_child(2):ub_child(2),       & 
    1856                                              lb_child(3):ub_child(3), l),   & 
    1857                                        tempC_indic(lb_child(1):ub_child(1),       & 
    18581775                                             lb_child(2):ub_child(2),       & 
    18591776                                             lb_child(3):ub_child(3), l),   & 
     
    18911808!! Calls #Agrif_Update_4D_Recursive and #Agrif_UpdateBase. 
    18921809!--------------------------------------------------------------------------------------------------- 
    1893 subroutine Agrif_Update_5D_Recursive ( type_update,                     & 
    1894                                        tempP, tempC, tempC_indic,       & 
    1895                                        indmin, indmax,                  & 
    1896                                        lb_child, ub_child,              & 
    1897                                        s_child,  s_parent,              & 
     1810subroutine Agrif_Update_5D_Recursive ( type_update,         & 
     1811                                       tempP, tempC,        & 
     1812                                       indmin, indmax,      & 
     1813                                       lb_child, ub_child,  & 
     1814                                        s_child,  s_parent, & 
    18981815                                       ds_child, ds_parent ) 
    18991816!--------------------------------------------------------------------------------------------------- 
     
    19011818    integer, dimension(5),          intent(in)  :: indmin, indmax 
    19021819    integer, dimension(5),          intent(in)  :: lb_child, ub_child 
    1903     real(kind=8),    dimension(5),          intent(in)  ::  s_child,  s_parent 
    1904     real(kind=8),    dimension(5),          intent(in)  :: ds_child, ds_parent 
     1820    real,    dimension(5),          intent(in)  ::  s_child,  s_parent 
     1821    real,    dimension(5),          intent(in)  :: ds_child, ds_parent 
    19051822    real,    dimension(          & 
    19061823        indmin(1):indmax(1),     & 
     
    19141831        lb_child(3):ub_child(3), & 
    19151832        lb_child(4):ub_child(4), & 
    1916         lb_child(5):ub_child(5)),   intent(in)  :: tempC, tempC_indic 
     1833        lb_child(5):ub_child(5)),   intent(in)  :: tempC 
    19171834!--------------------------------------------------------------------------------------------------- 
    19181835    real, dimension(:,:,:,:,:), allocatable     :: tabtemp 
     
    19321849                                               indmin(4):indmax(4), m),     & 
    19331850                                       tempC(lb_child(1):ub_child(1),       & 
    1934                                              lb_child(2):ub_child(2),       & 
    1935                                              lb_child(3):ub_child(3),       & 
    1936                                              lb_child(4):ub_child(4), m),   & 
    1937                                        tempC_indic(lb_child(1):ub_child(1),       & 
    19381851                                             lb_child(2):ub_child(2),       & 
    19391852                                             lb_child(3):ub_child(3),       & 
     
    19741887!! Calls #Agrif_Update_5D_Recursive and #Agrif_UpdateBase. 
    19751888!--------------------------------------------------------------------------------------------------- 
    1976 subroutine Agrif_Update_6D_Recursive ( type_update,                     & 
    1977                                        tempP, tempC, tempC_indic,       & 
    1978                                        indmin, indmax,                  & 
    1979                                        lb_child, ub_child,              & 
    1980                                        s_child,  s_parent,              & 
     1889subroutine Agrif_Update_6D_Recursive ( type_update,         & 
     1890                                       tempP, tempC,        & 
     1891                                       indmin, indmax,      & 
     1892                                       lb_child, ub_child,  & 
     1893                                        s_child,  s_parent, & 
    19811894                                       ds_child, ds_parent ) 
    19821895!--------------------------------------------------------------------------------------------------- 
     
    19841897    integer, dimension(6),          intent(in)  :: indmin, indmax 
    19851898    integer, dimension(6),          intent(in)  :: lb_child, ub_child 
    1986     real(kind=8),    dimension(6),          intent(in)  ::  s_child,  s_parent 
    1987     real(kind=8),    dimension(6),          intent(in)  :: ds_child, ds_parent 
     1899    real,    dimension(6),          intent(in)  ::  s_child,  s_parent 
     1900    real,    dimension(6),          intent(in)  :: ds_child, ds_parent 
    19881901    real,    dimension(          & 
    19891902        indmin(1):indmax(1),     & 
     
    19991912        lb_child(4):ub_child(4), & 
    20001913        lb_child(5):ub_child(5), & 
    2001         lb_child(6):ub_child(6)),   intent(in)  :: tempC, tempC_indic 
     1914        lb_child(6):ub_child(6)),   intent(in)  :: tempC 
    20021915!--------------------------------------------------------------------------------------------------- 
    20031916    real, dimension(:,:,:,:,:,:), allocatable   :: tabtemp 
     
    20231936                                             lb_child(4):ub_child(4),       & 
    20241937                                             lb_child(5):ub_child(5), n),   & 
    2025                                        tempC_indic(lb_child(1):ub_child(1),       & 
    2026                                              lb_child(2):ub_child(2),       & 
    2027                                              lb_child(3):ub_child(3),       & 
    2028                                              lb_child(4):ub_child(4),       & 
    2029                                              lb_child(5):ub_child(5), n),   & 
    20301938                                       indmin(1:5), indmax(1:5),            & 
    20311939                                       lb_child(1:5),ub_child(1:5),         & 
     
    20761984    real, dimension(indmin:indmax),     intent(out):: parent_tab 
    20771985    real, dimension(lb_child:ub_child), intent(in) :: child_tab 
    2078     real(kind=8),                       intent(in) :: s_parent,  s_child 
    2079     real(kind=8),                       intent(in) :: ds_parent, ds_child 
     1986    real,                               intent(in) :: s_parent,  s_child 
     1987    real,                               intent(in) :: ds_parent, ds_child 
    20801988!--------------------------------------------------------------------------------------------------- 
    20811989    integer :: np       ! Length of parent array 
     
    21012009                    ds_parent, ds_child ) 
    21022010! 
     2011    elseif ( type_update == Agrif_Update_Max ) then 
     2012! 
     2013        call Agrif_basicupdate_max1d(           & 
     2014                    parent_tab, child_tab,          & 
     2015                    np,         nc,                 & 
     2016                     s_parent,  s_child,            & 
     2017                    ds_parent, ds_child ) 
    21032018    elseif ( type_update == Agrif_Update_Full_Weighting ) then 
    21042019! 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modupdatebasic.F90

    r10087 r10725  
    4949    integer,             intent(in)     :: np           !< Length of parent array 
    5050    integer,             intent(in)     :: nc           !< Length of child  array 
    51     real(kind=8),        intent(in)     :: s_parent     !< Parent grid position (s_root = 0) 
    52     real(kind=8),        intent(in)     :: s_child      !< Child  grid position (s_root = 0) 
    53     real(kind=8),        intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1) 
    54     real(kind=8),        intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1) 
     51    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0) 
     52    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0) 
     53    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1) 
     54    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1) 
    5555!--------------------------------------------------------------------------------------------------- 
    5656    integer :: i, locind_child_left, coeffraf 
     
    8484    integer,             intent(in)     :: np           !< Length of parent array 
    8585    integer,             intent(in)     :: nc           !< Length of child  array 
    86     real(kind=8),        intent(in)     :: s_parent     !< Parent grid position (s_root = 0) 
    87     real(kind=8),        intent(in)     :: s_child      !< Child  grid position (s_root = 0) 
    88     real(kind=8),        intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1) 
    89     real(kind=8),        intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1) 
     86    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0) 
     87    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0) 
     88    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1) 
     89    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1) 
    9090    integer,             intent(in)     :: dir          !< Direction 
    9191!--------------------------------------------------------------------------------------------------- 
     
    157157    REAL, DIMENSION(nc), intent(in)     :: y 
    158158    INTEGER,             intent(in)     :: np,nc 
    159     REAL(kind=8),        intent(in)     :: s_parent,  s_child 
    160     REAL(kind=8),        intent(in)     :: ds_parent, ds_child 
     159    REAL,                intent(in)     :: s_parent,  s_child 
     160    REAL,                intent(in)     :: ds_parent, ds_child 
    161161! 
    162162    INTEGER :: i, ii, locind_child_left, coeffraf 
    163     REAL(kind=8)    :: xpos 
    164     REAL ::  invcoeffraf 
     163    REAL    :: xpos, invcoeffraf 
    165164    INTEGER :: nbnonnuls 
    166165    INTEGER :: diffmod 
     
    221220end subroutine Agrif_basicupdate_average1d 
    222221!=================================================================================================== 
     222 
     223!=================================================================================================== 
     224!  subroutine Agrif_basicupdate_max1d 
     225! 
     226!> Carries out an update by taking the maximum on a parent grid (vector x)from its child grid (vector y). 
     227!--------------------------------------------------------------------------------------------------- 
     228subroutine Agrif_basicupdate_max1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) 
     229!--------------------------------------------------------------------------------------------------- 
     230    REAL, DIMENSION(np), intent(out)    :: x 
     231    REAL, DIMENSION(nc), intent(in)     :: y 
     232    INTEGER,             intent(in)     :: np,nc 
     233    REAL,                intent(in)     :: s_parent,  s_child 
     234    REAL,                intent(in)     :: ds_parent, ds_child 
     235! 
     236    INTEGER :: i, ii, locind_child_left, coeffraf 
     237    REAL    :: xpos, invcoeffraf 
     238    INTEGER :: nbnonnuls 
     239    INTEGER :: diffmod 
     240! 
     241    coeffraf = nint(ds_parent/ds_child) 
     242    invcoeffraf = 1./coeffraf 
     243! 
     244    if (coeffraf == 1) then 
     245        locind_child_left = 1 + nint((s_parent - s_child)/ds_child) 
     246        x(1:np) = y(locind_child_left:locind_child_left+np-1) 
     247        return 
     248    endif 
     249! 
     250    xpos = s_parent 
     251    x = -HUGE(1.0) 
     252! 
     253    diffmod = 0 
     254! 
     255    IF ( mod(coeffraf,2) == 0 ) diffmod = 1 
     256! 
     257    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child) 
     258! 
     259    IF (Agrif_UseSpecialValueInUpdate) THEN 
     260        do i = 1,np 
     261            nbnonnuls = 0 
     262!CDIR NOVECTOR 
     263            do ii = -coeffraf/2+locind_child_left+diffmod, & 
     264                     coeffraf/2+locind_child_left 
     265                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN 
     266                    x(i) = max(x(i),y(ii)) 
     267                ENDIF 
     268            enddo 
     269            locind_child_left = locind_child_left + coeffraf 
     270        enddo 
     271    ELSE 
     272! 
     273!CDIR ALTCODE 
     274        do i = 1,np 
     275!CDIR NOVECTOR 
     276            do ii = -coeffraf/2+locind_child_left+diffmod, & 
     277                     coeffraf/2+locind_child_left 
     278                x(i) = max(x(i),y(ii)) 
     279            enddo 
     280            locind_child_left = locind_child_left + coeffraf 
     281        enddo 
     282    ENDIF 
     283!--------------------------------------------------------------------------------------------------- 
     284end subroutine Agrif_basicupdate_max1d 
     285!=================================================================================================== 
     286 
    223287! 
    224288!=================================================================================================== 
     
    230294!--------------------------------------------------------------------------------------------------- 
    231295    INTEGER, intent(in) :: nc2, np, nc 
    232     REAL(kind=8),    intent(in) :: s_parent,  s_child 
    233     REAL(kind=8),    intent(in) :: ds_parent, ds_child 
     296    REAL,    intent(in) :: s_parent,  s_child 
     297    REAL,    intent(in) :: ds_parent, ds_child 
    234298    INTEGER, intent(in) :: dir 
    235299! 
    236300    INTEGER, DIMENSION(:,:), ALLOCATABLE :: indchildaverage_tmp 
    237301    INTEGER :: i, locind_child_left, coeffraf 
    238     REAL(kind=8)    :: xpos 
     302    REAL    :: xpos 
    239303    INTEGER :: diffmod 
    240304! 
     
    282346    REAL, DIMENSION(nc), intent(in)     :: y 
    283347    INTEGER,             intent(in)     :: np, nc 
    284     REAL(kind=8),                intent(in)     :: s_parent,  s_child 
    285     REAL(kind=8),                intent(in)     :: ds_parent, ds_child 
     348    REAL,                intent(in)     :: s_parent,  s_child 
     349    REAL,                intent(in)     :: ds_parent, ds_child 
    286350    INTEGER,             intent(in)     :: dir 
    287351! 
     
    312376    ELSE 
    313377! 
    314  
    315         do i = 1,np 
    316         do j = 1,coeffraf 
     378!CDIR NOLOOPCHG 
     379        do  j = 1,coeffraf 
     380!CDIR VECTOR 
     381            do i= 1,np 
    317382                x(i) = x(i) + y(indchildaverage(i,dir) + j-1 ) 
    318         enddo 
     383            enddo 
    319384        enddo 
    320385        IF (.not.Agrif_Update_Weights) THEN 
     
    338403    real, dimension(nc), intent(in)     :: y 
    339404    integer,             intent(in)     :: np, nc 
    340     real(kind=8),                intent(in)     :: s_parent,  s_child 
    341     real(kind=8),                intent(in)     :: ds_parent, ds_child 
    342 !--------------------------------------------------------------------------------------------------- 
    343     REAL(kind=8)    :: xpos, xposfin 
     405    real,                intent(in)     :: s_parent,  s_child 
     406    real,                intent(in)     :: ds_parent, ds_child 
     407!--------------------------------------------------------------------------------------------------- 
     408    REAL    :: xpos, xposfin 
    344409    INTEGER :: i, ii, diffmod 
    345410    INTEGER :: it1, it2 
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modutil.F90

    r10087 r10725  
    22! $Id$ 
    33! 
    4 !     AGRIF (Adaptive Grid Refinement In Fortran) 
     4!     Agrif (Adaptive Grid Refinement In Fortran) 
    55! 
    66!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) 
     
    1919!     You should have received a copy of the GNU General Public License 
    2020!     along with this program; if not, write to the Free Software 
    21 !     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. 
     21!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA. 
    2222! 
    2323!> Module Agrif_Util 
    24 !> 
    25 !>  
    26 ! 
     24!! 
     25!! This module contains the two procedures called in the main program : 
     26!! - #Agrif_Init_Grids allows the initialization of the root coarse grid 
     27!! - #Agrif_Step allows the creation of the grid hierarchy and the management of the time integration. 
    2728! 
    2829module Agrif_Util 
    2930! 
    30   use Agrif_User_Hierarchy 
    31   use Agrif_User_Variables 
    32   use Agrif_user_Functions 
    33   use Agrif_user_Interpolation 
    34   use Agrif_user_Update 
    35   
     31    use Agrif_Clustering 
     32    use Agrif_BcFunction 
     33    use Agrif_seq 
    3634! 
    3735    implicit none 
    3836! 
     37    abstract interface 
     38        subroutine step_proc() 
     39        end subroutine step_proc 
     40    end interface 
     41! 
    3942contains 
    4043! 
    41  
     44!=================================================================================================== 
     45!  subroutine Agrif_Step 
     46! 
     47!> Creates the grid hierarchy and manages the time integration procedure. 
     48!> It is called in the main program. 
     49!> Calls subroutines #Agrif_Regrid and #Agrif_Integrate. 
     50!--------------------------------------------------------------------------------------------------- 
     51subroutine Agrif_Step ( procname ) 
     52!--------------------------------------------------------------------------------------------------- 
     53    procedure(step_proc)    :: procname     !< subroutine to call on each grid 
     54    type(agrif_grid), pointer :: ref_grid 
     55! 
     56! Set the clustering variables 
     57    call Agrif_clustering_def() 
     58! 
     59! Creation and initialization of the grid hierarchy 
     60    if ( Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then 
     61! 
     62        if ( (Agrif_Mygrid % ngridstep == 0) .AND. (.not. Agrif_regrid_has_been_done) ) then 
     63            call Agrif_Regrid() 
     64            Agrif_regrid_has_been_done = .TRUE. 
     65        endif 
     66! 
     67    else 
     68! 
     69        if (mod(Agrif_Mygrid % ngridstep,Agrif_Regridding) == 0) then 
     70            call Agrif_Regrid() 
     71        endif 
     72! 
     73    endif 
     74! 
     75! Time integration of the grid hierarchy 
     76    if (agrif_coarse) then 
     77      ref_grid => agrif_coarsegrid 
     78    else 
     79      ref_grid => agrif_mygrid 
     80    endif 
     81    if ( Agrif_Parallel_sisters ) then 
     82        call Agrif_Integrate_Parallel(ref_grid,procname) 
     83    else 
     84        call Agrif_Integrate(ref_grid,procname) 
     85    endif 
     86! 
     87    if ( ref_grid%child_list%nitems > 0 ) call Agrif_Instance(ref_grid) 
     88!--------------------------------------------------------------------------------------------------- 
     89end subroutine Agrif_Step 
     90!=================================================================================================== 
     91! 
     92!=================================================================================================== 
     93!  subroutine Agrif_Step_Child 
     94! 
     95!> Apply 'procname' to each grid of the hierarchy 
     96!--------------------------------------------------------------------------------------------------- 
     97subroutine Agrif_Step_Child ( procname ) 
     98!--------------------------------------------------------------------------------------------------- 
     99    procedure(step_proc)    :: procname     !< subroutine to call on each grid 
     100! 
     101    if ( Agrif_Parallel_sisters ) then 
     102        call Agrif_Integrate_Child_Parallel(Agrif_Mygrid,procname) 
     103    else 
     104        call Agrif_Integrate_Child(Agrif_Mygrid,procname) 
     105    endif 
     106! 
     107    if ( Agrif_Mygrid%child_list%nitems > 0 ) call Agrif_Instance(Agrif_Mygrid) 
     108!--------------------------------------------------------------------------------------------------- 
     109end subroutine Agrif_Step_Child 
     110!=================================================================================================== 
     111! 
     112!=================================================================================================== 
     113!  subroutine Agrif_Step_Childs 
     114! 
     115!> Apply 'procname' to each child grids of the current grid 
     116!--------------------------------------------------------------------------------------------------- 
     117!     ************************************************************************** 
     118!!!   Subroutine Agrif_Step_Childs 
     119!     ************************************************************************** 
     120! 
     121      Subroutine Agrif_Step_Childs(procname) 
     122! 
     123    procedure(step_proc)    :: procname     !< subroutine to call on each grid 
     124!     Pointer argument 
     125      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid 
     126! 
     127 
     128! 
     129!     Local pointer 
     130      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
     131                                             ! procedure 
     132! 
     133      g => Agrif_Curgrid 
     134       
     135      parcours => g % child_list % first 
     136! 
     137!     Recursive procedure for the time integration of the grid hierarchy       
     138      Do while (associated(parcours)) 
     139! 
     140!       Instanciation of the variables of the current grid 
     141        Call Agrif_Instance(parcours % gr) 
     142 
     143!     One step on the current grid 
     144 
     145         Call procname () 
     146        parcours => parcours % next 
     147      enddo 
     148    
     149      If (associated(g % child_list % first)) Call Agrif_Instance (g) 
     150      Return 
     151      End Subroutine Agrif_Step_Childs 
     152!=================================================================================================== 
     153! 
     154!=================================================================================================== 
     155!  subroutine Agrif_Regrid 
     156! 
     157!> Creates the grid hierarchy from fixed grids and adaptive mesh refinement. 
     158!--------------------------------------------------------------------------------------------------- 
     159subroutine Agrif_Regrid ( procname ) 
     160!--------------------------------------------------------------------------------------------------- 
     161    procedure(init_proc), optional    :: procname     !< Initialisation subroutine (Default: Agrif_InitValues) 
     162! 
     163    type(Agrif_Rectangle), pointer     :: coarsegrid_fixed 
     164    type(Agrif_Rectangle), pointer     :: coarsegrid_moving 
     165    integer                            :: i, j 
     166    integer :: nunit 
     167    logical :: BEXIST 
     168    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid 
     169    integer :: is_coarse, rhox, rhoy, rhoz, rhot 
     170! 
     171    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) & 
     172        call Agrif_detect_all(Agrif_Mygrid)     ! Detection of areas to be refined 
     173! 
     174    allocate(coarsegrid_fixed) 
     175    allocate(coarsegrid_moving) 
     176! 
     177    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) & 
     178        call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering 
     179! 
     180    if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then 
     181! 
     182        if (Agrif_Mygrid % ngridstep == 0) then 
     183!             
     184            nunit = Agrif_Get_Unit() 
     185            open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=99) 
     186            if (agrif_coarse) then ! SKIP the coarse grid declaration 
     187                if (Agrif_Probdim == 3) then 
     188                    read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot 
     189                elseif (Agrif_Probdim == 2) then 
     190                    read(nunit,*) is_coarse, rhox, rhoy, rhot 
     191                elseif (Agrif_Probdim == 2) then 
     192                    read(nunit,*) is_coarse, rhox, rhot 
     193                endif 
     194            endif 
     195!           Creation of the grid hierarchy from the Agrif_FixedGrids.in file 
     196            do i = 1,Agrif_Probdim 
     197                coarsegrid_fixed % imin(i) = 1 
     198                coarsegrid_fixed % imax(i) = Agrif_Mygrid % nb(i) + 1 
     199            enddo 
     200            j = 1 
     201            call Agrif_Read_Fix_Grd(coarsegrid_fixed,j,nunit) 
     202            close(nunit) 
     203! 
     204            call Agrif_gl_clear(Agrif_oldmygrid) 
     205! 
     206!           Creation of the grid hierarchy from coarsegrid_fixed 
     207            call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_fixed) 
     208             
     209        else 
     210            call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list) 
     211        endif 
     212    else 
     213        call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list) 
     214        call Agrif_gl_clear(Agrif_Mygrid % child_list) 
     215    endif 
     216! 
     217    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then 
     218! 
     219        call Agrif_Save_All(Agrif_oldmygrid) 
     220        call Agrif_Free_before_All(Agrif_oldmygrid) 
     221! 
     222!       Creation of the grid hierarchy from coarsegrid_moving 
     223        call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_moving) 
     224! 
     225    endif 
     226! 
     227!   Initialization of the grid hierarchy by copy or interpolation 
     228! 
     229#if defined AGRIF_MPI 
     230    if ( Agrif_Parallel_sisters ) then 
     231        call Agrif_Init_Hierarchy_Parallel_1(Agrif_Mygrid) 
     232        call Agrif_Init_Hierarchy_Parallel_2(Agrif_Mygrid,procname) 
     233    else 
     234        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname) 
     235    endif 
     236#else 
     237        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname) 
     238#endif 
     239! 
     240    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) call Agrif_Free_after_All(Agrif_oldmygrid) 
     241! 
     242    Agrif_regrid_has_been_done = .TRUE. 
     243! 
     244    call Agrif_Instance( Agrif_Mygrid ) 
     245! 
     246    deallocate(coarsegrid_fixed) 
     247    deallocate(coarsegrid_moving) 
     248! 
     249    return 
     250! 
     251!     Opening error 
     252! 
     25399  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST) 
     254    if (.not. BEXIST) then 
     255        print*,'ERROR : File AGRIF_FixedGrids.in not found.' 
     256        STOP 
     257    else 
     258        print*,'Error opening file AGRIF_FixedGrids.in' 
     259        STOP 
     260    endif 
     261!--------------------------------------------------------------------------------------------------- 
     262end subroutine Agrif_Regrid 
     263!=================================================================================================== 
     264! 
     265!=================================================================================================== 
     266!  subroutine Agrif_detect_All 
     267! 
     268!> Detects areas to be refined. 
     269!--------------------------------------------------------------------------------------------------- 
     270recursive subroutine Agrif_detect_all ( g ) 
     271!--------------------------------------------------------------------------------------------------- 
     272    TYPE(Agrif_Grid),  pointer  :: g        !< Pointer on the current grid 
     273! 
     274    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure 
     275    integer, DIMENSION(3)       :: size 
     276    integer                     :: i 
     277    real                        :: g_eps 
     278! 
     279    parcours => g % child_list % first 
     280! 
     281!   To be positioned on the finer grids of the grid hierarchy 
     282! 
     283    do while (associated(parcours)) 
     284        call Agrif_detect_all(parcours % gr) 
     285        parcours => parcours % next 
     286    enddo 
     287! 
     288    g_eps = huge(1.) 
     289    do i = 1,Agrif_Probdim 
     290        g_eps = min(g_eps, g % Agrif_dx(i)) 
     291    enddo 
     292! 
     293    g_eps = g_eps / 100. 
     294! 
     295    if ( Agrif_Probdim == 1 ) g%tabpoint1D = 0 
     296    if ( Agrif_Probdim == 2 ) g%tabpoint2D = 0 
     297    if ( Agrif_Probdim == 3 ) g%tabpoint3D = 0 
     298! 
     299    do i = 1,Agrif_Probdim 
     300        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps) ) return 
     301    enddo 
     302! 
     303    call Agrif_instance(g) 
     304! 
     305!   Detection (Agrif_detect is a users routine) 
     306! 
     307    do i = 1,Agrif_Probdim 
     308        size(i) = g % nb(i) + 1 
     309    enddo 
     310! 
     311    SELECT CASE (Agrif_Probdim) 
     312    CASE (1) 
     313        call Agrif_detect(g%tabpoint1D,size) 
     314    CASE (2) 
     315        call Agrif_detect(g%tabpoint2D,size) 
     316    CASE (3) 
     317        call Agrif_detect(g%tabpoint3D,size) 
     318    END SELECT 
     319! 
     320!   Addition of the areas detected on the child grids 
     321! 
     322    parcours => g % child_list % first 
     323! 
     324    do while (associated(parcours)) 
     325        call Agrif_Add_detected_areas(g,parcours % gr) 
     326        parcours => parcours % next 
     327    enddo 
     328!--------------------------------------------------------------------------------------------------- 
     329end subroutine Agrif_detect_all 
     330!=================================================================================================== 
     331! 
     332!=================================================================================================== 
     333!  subroutine Agrif_Add_detected_areas 
     334! 
     335!> Adds on the parent grid the areas detected on its child grids 
     336!--------------------------------------------------------------------------------------------------- 
     337subroutine Agrif_Add_detected_areas ( parentgrid, childgrid ) 
     338!--------------------------------------------------------------------------------------------------- 
     339    Type(Agrif_Grid), pointer   :: parentgrid 
     340    Type(Agrif_Grid), pointer   :: childgrid 
     341! 
     342    integer :: i,j,k 
     343! 
     344    do i = 1,childgrid%nb(1)+1 
     345        if ( Agrif_Probdim == 1 ) then 
     346            if (childgrid%tabpoint1D(i)==1) then 
     347                parentgrid%tabpoint1D(childgrid%ix(1)+(i-1)/Agrif_Coeffref(1)) = 1 
     348            endif 
     349        else 
     350            do j=1,childgrid%nb(2)+1 
     351                if (Agrif_Probdim==2) then 
     352                    if (childgrid%tabpoint2D(i,j)==1) then 
     353                        parentgrid%tabpoint2D(                       & 
     354                            childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), & 
     355                            childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1 
     356                    endif 
     357                else 
     358                    do k=1,childgrid%nb(3)+1 
     359                        if (childgrid%tabpoint3D(i,j,k)==1) then 
     360                            parentgrid%tabpoint3D(                       & 
     361                                childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), & 
     362                                childgrid%ix(2)+(j-1)/Agrif_Coeffref(2), & 
     363                                childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1 
     364                        endif 
     365                    enddo 
     366                endif 
     367            enddo 
     368        endif 
     369    enddo 
     370!--------------------------------------------------------------------------------------------------- 
     371end subroutine Agrif_Add_detected_areas 
     372!=================================================================================================== 
     373! 
     374!=================================================================================================== 
     375!  subroutine Agrif_Free_before_All 
     376!--------------------------------------------------------------------------------------------------- 
     377recursive subroutine Agrif_Free_before_All ( gridlist ) 
     378!--------------------------------------------------------------------------------------------------- 
     379    Type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list 
     380! 
     381    Type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure 
     382! 
     383    parcours => gridlist % first 
     384! 
     385    do while (associated(parcours)) 
     386! 
     387        if (.not. parcours%gr%fixed) then 
     388            call Agrif_Free_data_before(parcours%gr) 
     389            parcours % gr % oldgrid = .TRUE. 
     390        endif 
     391! 
     392        call Agrif_Free_before_all (parcours % gr % child_list) 
     393! 
     394        parcours => parcours % next 
     395! 
     396    enddo 
     397!--------------------------------------------------------------------------------------------------- 
     398end subroutine Agrif_Free_before_All 
     399!=================================================================================================== 
     400! 
     401!=================================================================================================== 
     402!  subroutine Agrif_Save_All 
     403!--------------------------------------------------------------------------------------------------- 
     404recursive subroutine Agrif_Save_All ( gridlist ) 
     405!--------------------------------------------------------------------------------------------------- 
     406    type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list 
     407! 
     408    type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure 
     409! 
     410    parcours => gridlist % first 
     411! 
     412    do while (associated(parcours)) 
     413! 
     414        if (.not. parcours%gr%fixed) then 
     415            call Agrif_Instance(parcours%gr) 
     416            call Agrif_Before_Regridding() 
     417            parcours % gr % oldgrid = .TRUE. 
     418        endif 
     419! 
     420        call Agrif_Save_All(parcours % gr % child_list) 
     421! 
     422        parcours => parcours % next 
     423! 
     424      enddo 
     425!--------------------------------------------------------------------------------------------------- 
     426end subroutine Agrif_Save_All 
     427!=================================================================================================== 
     428! 
     429!=================================================================================================== 
     430!  subroutine Agrif_Free_after_All 
     431!--------------------------------------------------------------------------------------------------- 
     432recursive subroutine Agrif_Free_after_All ( gridlist ) 
     433!--------------------------------------------------------------------------------------------------- 
     434    Type(Agrif_Grid_List), intent(inout)    :: gridlist       !< Grid list to free 
     435! 
     436    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive proced 
     437    Type(Agrif_PGrid), pointer  :: preparcours 
     438    Type(Agrif_PGrid), pointer  :: preparcoursini 
     439! 
     440    allocate(preparcours) 
     441! 
     442    preparcoursini => preparcours 
     443! 
     444    nullify(preparcours % gr) 
     445! 
     446    preparcours % next => gridlist % first 
     447    parcours => gridlist % first 
     448! 
     449    do while (associated(parcours)) 
     450! 
     451        if ( (.NOT. parcours%gr % fixed) .AND. (parcours%gr % oldgrid) ) then 
     452            call Agrif_Free_data_after(parcours%gr) 
     453        endif 
     454! 
     455        call Agrif_Free_after_all( parcours%gr % child_list ) 
     456! 
     457        if (parcours % gr % oldgrid) then 
     458            deallocate(parcours % gr) 
     459            preparcours % next => parcours % next 
     460            deallocate(parcours) 
     461            parcours => preparcours % next 
     462        else 
     463            preparcours => preparcours % next 
     464            parcours => parcours % next 
     465        endif 
     466! 
     467    enddo 
     468! 
     469    deallocate(preparcoursini) 
     470!--------------------------------------------------------------------------------------------------- 
     471end subroutine Agrif_Free_after_All 
     472!=================================================================================================== 
     473! 
     474!=================================================================================================== 
     475!  subroutine Agrif_Integrate 
     476! 
     477!> Manages the time integration of the grid hierarchy. 
     478!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step 
     479!--------------------------------------------------------------------------------------------------- 
     480recursive subroutine Agrif_Integrate ( g, procname ) 
     481!--------------------------------------------------------------------------------------------------- 
     482    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid 
     483    procedure(step_proc)        :: procname !< Subroutine to call on each grid 
     484! 
     485    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure 
     486    integer                     :: nbt      ! Number of time steps of the current grid 
     487    integer                     :: i, k 
     488! 
     489!   Instanciation of the variables of the current grid 
     490!    if ( g % fixedrank /= 0 ) then 
     491        call Agrif_Instance(g) 
     492!    endif 
     493! 
     494!   One step on the current grid 
     495! 
     496    call procname () 
     497! 
     498!   Number of time steps on the current grid 
     499! 
     500    g%ngridstep = g % ngridstep + 1 
     501    parcours => g % child_list % first 
     502! 
     503!   Recursive procedure for the time integration of the grid hierarchy 
     504    do while (associated(parcours)) 
     505! 
     506!       Instanciation of the variables of the current grid 
     507        call Agrif_Instance(parcours % gr) 
     508! 
     509!       Number of time steps 
     510        nbt = 1 
     511        do i = 1,Agrif_Probdim 
     512            nbt = max(nbt, parcours % gr % timeref(i)) 
     513        enddo 
     514! 
     515        do k = 1,nbt 
     516            call Agrif_Integrate(parcours % gr, procname) 
     517        enddo 
     518! 
     519        parcours => parcours % next 
     520! 
     521    enddo 
     522!--------------------------------------------------------------------------------------------------- 
     523end subroutine Agrif_Integrate 
     524!=================================================================================================== 
     525! 
     526!=================================================================================================== 
     527!  subroutine Agrif_Integrate_Parallel 
     528! 
     529!> Manages the time integration of the grid hierarchy in parallel 
     530!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step 
     531!--------------------------------------------------------------------------------------------------- 
     532recursive subroutine Agrif_Integrate_Parallel ( g, procname ) 
     533!--------------------------------------------------------------------------------------------------- 
     534    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid 
     535    procedure(step_proc)        :: procname !< Subroutine to call on each grid 
     536! 
     537#if defined AGRIF_MPI 
     538    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure 
     539    integer                     :: nbt      ! Number of time steps of the current grid 
     540    integer                     :: i, k, is 
     541! 
     542!   Instanciation of the variables of the current grid 
     543    if ( g % fixedrank /= 0 ) then 
     544        call Agrif_Instance(g) 
     545    endif 
     546! 
     547! One step on the current grid 
     548    call procname () 
     549! 
     550! Number of time steps on the current grid 
     551    g % ngridstep = g % ngridstep + 1 
     552! 
     553! Continue only if the grid has defined sequences of child integrations. 
     554    if ( .not. associated(g % child_seq) ) return 
     555! 
     556    do is = 1, g % child_seq % nb_seqs 
     557! 
     558!     For each sequence, a given processor does integrate only on grid. 
     559        gridp => Agrif_seq_select_child(g,is) 
     560! 
     561!     Instanciation of the variables of the current grid 
     562        call Agrif_Instance(gridp % gr) 
     563! 
     564!     Number of time steps 
     565        nbt = 1 
     566        do i = 1,Agrif_Probdim 
     567            nbt = max(nbt, gridp % gr % timeref(i)) 
     568        enddo 
     569! 
     570        do k = 1,nbt 
     571            call Agrif_Integrate_Parallel(gridp % gr, procname) 
     572        enddo 
     573! 
     574    enddo 
     575#else 
     576    call Agrif_Integrate( g, procname ) 
     577#endif 
     578!--------------------------------------------------------------------------------------------------- 
     579end subroutine Agrif_Integrate_Parallel 
     580!=================================================================================================== 
     581! 
     582!=================================================================================================== 
     583! 
     584! 
     585!=================================================================================================== 
     586!  subroutine Agrif_Integrate_ChildGrids 
     587! 
     588!> Manages the time integration of the grid hierarchy. 
     589!! Call the subroutine procname on each child grid of the current grid 
     590!--------------------------------------------------------------------------------------------------- 
     591recursive subroutine Agrif_Integrate_ChildGrids ( procname ) 
     592!--------------------------------------------------------------------------------------------------- 
     593    procedure(step_proc)        :: procname !< Subroutine to call on each grid 
     594! 
     595    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure 
     596    integer                     :: nbt      ! Number of time steps of the current grid 
     597    integer                     :: i, k, is 
     598    type(Agrif_Grid)                    , pointer :: save_grid 
     599    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure 
     600     
     601    save_grid => Agrif_Curgrid 
     602 
     603! Number of time steps on the current grid 
     604    save_grid % ngridstep = save_grid % ngridstep + 1 
     605     
     606#ifdef AGRIF_MPI 
     607    if ( .not. Agrif_Parallel_sisters ) then 
     608#endif 
     609    parcours => save_grid % child_list % first 
     610! 
     611!   Recursive procedure for the time integration of the grid hierarchy 
     612    do while (associated(parcours)) 
     613! 
     614!       Instanciation of the variables of the current grid 
     615        call Agrif_Instance(parcours % gr) 
     616! 
     617!       Number of time steps 
     618        nbt = 1 
     619        do i = 1,Agrif_Probdim 
     620            nbt = max(nbt, parcours % gr % timeref(i)) 
     621        enddo 
     622! 
     623        do k = 1,nbt 
     624            call procname() 
     625        enddo 
     626! 
     627        parcours => parcours % next 
     628! 
     629    enddo 
     630 
     631#ifdef AGRIF_MPI 
     632    else 
     633! Continue only if the grid has defined sequences of child integrations. 
     634    if ( .not. associated(save_grid % child_seq) ) return 
     635! 
     636    do is = 1, save_grid % child_seq % nb_seqs 
     637! 
     638!     For each sequence, a given processor does integrate only on grid. 
     639        gridp => Agrif_seq_select_child(save_grid,is) 
     640! 
     641!     Instanciation of the variables of the current grid 
     642        call Agrif_Instance(gridp % gr) 
     643! 
     644!     Number of time steps 
     645        nbt = 1 
     646        do i = 1,Agrif_Probdim 
     647            nbt = max(nbt, gridp % gr % timeref(i)) 
     648        enddo 
     649! 
     650        do k = 1,nbt 
     651            call procname() 
     652        enddo 
     653! 
     654    enddo 
     655    endif 
     656#endif  
     657 
     658    call Agrif_Instance(save_grid) 
     659     
     660!--------------------------------------------------------------------------------------------------- 
     661end subroutine Agrif_Integrate_ChildGrids 
     662!=================================================================================================== 
     663!=================================================================================================== 
     664!  subroutine Agrif_Integrate_Child 
     665! 
     666!> Manages the time integration of the grid hierarchy. 
     667!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step. 
     668!--------------------------------------------------------------------------------------------------- 
     669recursive subroutine Agrif_Integrate_Child ( g, procname ) 
     670!--------------------------------------------------------------------------------------------------- 
     671    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid 
     672    procedure(step_proc)        :: procname !< Subroutine to call on each grid 
     673! 
     674    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure 
     675! 
     676!   One step on the current grid 
     677! 
     678    call procname () 
     679! 
     680!   Number of time steps on the current grid 
     681! 
     682    parcours => g % child_list % first 
     683! 
     684!   Recursive procedure for the time integration of the grid hierarchy 
     685    do while (associated(parcours)) 
     686! 
     687!       Instanciation of the variables of the current grid 
     688        call Agrif_Instance(parcours % gr) 
     689        call Agrif_Integrate_Child (parcours % gr, procname) 
     690        parcours => parcours % next 
     691! 
     692    enddo 
     693!--------------------------------------------------------------------------------------------------- 
     694end subroutine Agrif_Integrate_Child 
     695!=================================================================================================== 
     696! 
     697!=================================================================================================== 
     698!  subroutine Agrif_Integrate_Child_Parallel 
     699! 
     700!> Manages the time integration of the grid hierarchy. 
     701!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step. 
     702!--------------------------------------------------------------------------------------------------- 
     703recursive subroutine Agrif_Integrate_Child_Parallel ( g, procname ) 
     704!--------------------------------------------------------------------------------------------------- 
     705    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid 
     706    procedure(step_proc)        :: procname !< Subroutine to call on each grid 
     707! 
     708#if defined AGRIF_MPI 
     709    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure 
     710    integer                     :: is 
     711! 
     712! Instanciation of the variables of the current grid 
     713    call Agrif_Instance(g) 
     714! 
     715! One step on the current grid 
     716    call procname () 
     717! 
     718! Continue only if the grid has defined sequences of child integrations. 
     719    if ( .not. associated(g % child_seq) ) return 
     720! 
     721    do is = 1, g % child_seq % nb_seqs 
     722! 
     723!     For each sequence, a given processor does integrate only on grid. 
     724        gridp => Agrif_seq_select_child(g,is) 
     725        call Agrif_Integrate_Child_Parallel(gridp % gr, procname) 
     726! 
     727    enddo 
     728! 
     729    call Agrif_Instance(g) 
     730#else 
     731    call Agrif_Integrate_Child( g, procname ) 
     732#endif 
     733!--------------------------------------------------------------------------------------------------- 
     734end subroutine Agrif_Integrate_Child_Parallel 
     735!=================================================================================================== 
     736! 
     737!=================================================================================================== 
     738!  subroutine Agrif_Init_Grids 
     739! 
     740!> Initializes the root coarse grid pointed by Agrif_Mygrid. It is called in the main program. 
     741!--------------------------------------------------------------------------------------------------- 
     742subroutine Agrif_Init_Grids ( procname1, procname2 ) 
     743!--------------------------------------------------------------------------------------------------- 
     744    procedure(typedef_proc), optional   :: procname1 !< (Default: Agrif_probdim_modtype_def) 
     745    procedure(alloc_proc),   optional   :: procname2 !< (Default: Agrif_Allocationcalls) 
     746! 
     747    integer :: i, ierr_allocate, nunit 
     748    integer :: is_coarse, rhox,rhoy,rhoz,rhot 
     749    logical :: BEXIST 
     750! 
     751    if (present(procname1)) Then 
     752        call procname1() 
     753    else 
     754        call Agrif_probdim_modtype_def() 
     755    endif 
     756! 
     757 
     758! TEST FOR COARSE GRID (GRAND MOTHER GRID) in AGRIF_FixedGrids.in 
     759    nunit = Agrif_Get_Unit() 
     760    open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=98) 
     761    if (Agrif_Probdim == 3) then 
     762       read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot 
     763    elseif (Agrif_Probdim == 2) then 
     764       read(nunit,*) is_coarse, rhox, rhoy, rhot 
     765    elseif (Agrif_Probdim == 2) then 
     766       read(nunit,*) is_coarse, rhox, rhot 
     767    endif 
     768    if (is_coarse == -1) then 
     769       agrif_coarse = .TRUE. 
     770       if (Agrif_Probdim == 3) then 
     771          coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/) 
     772       elseif (Agrif_Probdim == 2) then 
     773          coarse_spaceref(1:2)=(/rhox,rhoy/) 
     774       elseif (Agrif_Probdim == 2) then 
     775          coarse_spaceref(1:1)=(/rhox/) 
     776       endif 
     777       coarse_timeref(1:Agrif_Probdim) = rhot 
     778    endif 
     779    close(nunit) 
     780     
     781    Agrif_UseSpecialValue = .FALSE. 
     782    Agrif_UseSpecialValueFineGrid = .FALSE. 
     783    Agrif_SpecialValue = 0. 
     784    Agrif_SpecialValueFineGrid = 0. 
     785! 
     786    allocate(Agrif_Mygrid) 
     787    allocate(Agrif_OldMygrid) 
     788! 
     789!   Space and time refinement factors are set to 1 on the root grid 
     790! 
     791    do i = 1,Agrif_Probdim 
     792        Agrif_Mygrid % spaceref(i) = coarse_spaceref(i) 
     793        Agrif_Mygrid % timeref(i)  = coarse_timeref(i) 
     794    enddo 
     795! 
     796!   Initialization of the number of time steps 
     797    Agrif_Mygrid % ngridstep = 0 
     798    Agrif_Mygrid % grid_id   = 0 
     799! 
     800!   No parent grid for the root coarse grid 
     801    nullify(Agrif_Mygrid % parent) 
     802! 
     803!   Initialization of the minimum positions, global abscissa and space steps 
     804    do i = 1, Agrif_Probdim 
     805        Agrif_Mygrid % ix(i) = 1 
     806        Agrif_Mygrid % Agrif_x(i)  = 0. 
     807        Agrif_Mygrid % Agrif_dx(i) = 1./Agrif_Mygrid % spaceref(i) 
     808        Agrif_Mygrid % Agrif_dt(i) = 1./Agrif_Mygrid % timeref(i) 
     809!       Borders of the root coarse grid 
     810        Agrif_Mygrid % NearRootBorder(i) = .true. 
     811        Agrif_Mygrid % DistantRootBorder(i) = .true. 
     812    enddo 
     813! 
     814!   The root coarse grid is a fixed grid 
     815    Agrif_Mygrid % fixed = .TRUE. 
     816!   Level of the root grid 
     817    Agrif_Mygrid % level = 0 
     818!   Maximum level in the hierarchy 
     819    Agrif_MaxLevelLoc = 0 
     820! 
     821!   Number of the grid pointed by Agrif_Mygrid (root coarse grid) 
     822    Agrif_Mygrid % rank = 1 
     823! 
     824!   Number of the root grid as a fixed grid 
     825    Agrif_Mygrid % fixedrank = 0 
     826! 
     827!   Initialization of some fields of the root grid variables 
     828    ierr_allocate = 0 
     829    if( Agrif_NbVariables(0) > 0 ) allocate(Agrif_Mygrid % tabvars(Agrif_NbVariables(0)),stat=ierr_allocate) 
     830    if( Agrif_NbVariables(1) > 0 ) allocate(Agrif_Mygrid % tabvars_c(Agrif_NbVariables(1)),stat=ierr_allocate) 
     831    if( Agrif_NbVariables(2) > 0 ) allocate(Agrif_Mygrid % tabvars_r(Agrif_NbVariables(2)),stat=ierr_allocate) 
     832    if( Agrif_NbVariables(3) > 0 ) allocate(Agrif_Mygrid % tabvars_l(Agrif_NbVariables(3)),stat=ierr_allocate) 
     833    if( Agrif_NbVariables(4) > 0 ) allocate(Agrif_Mygrid % tabvars_i(Agrif_NbVariables(4)),stat=ierr_allocate) 
     834    if (ierr_allocate /= 0) THEN 
     835      STOP "*** ERROR WHEN ALLOCATING TABVARS ***" 
     836    endif 
     837! 
     838!   Initialization of the other fields of the root grid variables (number of 
     839!   cells, positions, number and type of its dimensions, ...) 
     840    call Agrif_Instance(Agrif_Mygrid) 
     841    call Agrif_Set_numberofcells(Agrif_Mygrid) 
     842! 
     843!   Allocation of the array containing the values of the grid variables 
     844    call Agrif_Allocation(Agrif_Mygrid, procname2) 
     845    call Agrif_initialisations(Agrif_Mygrid) 
     846! 
     847!   Total number of fixed grids 
     848    Agrif_nbfixedgrids = 0 
     849     
     850! If a grand mother grid is declared 
     851 
     852    if (agrif_coarse) then 
     853      allocate(Agrif_Coarsegrid) 
     854 
     855      Agrif_Coarsegrid % ngridstep = 0 
     856      Agrif_Coarsegrid % grid_id   = -9999 
     857       
     858    do i = 1, Agrif_Probdim 
     859        Agrif_Coarsegrid%spaceref(i) = coarse_spaceref(i) 
     860        Agrif_Coarsegrid%timeref(i) = coarse_timeref(i) 
     861        Agrif_Coarsegrid % ix(i) = 1 
     862        Agrif_Coarsegrid % Agrif_x(i)  = 0. 
     863        Agrif_Coarsegrid % Agrif_dx(i) = 1. 
     864        Agrif_Coarsegrid % Agrif_dt(i) = 1. 
     865!       Borders of the root coarse grid 
     866        Agrif_Coarsegrid % NearRootBorder(i) = .true. 
     867        Agrif_Coarsegrid % DistantRootBorder(i) = .true. 
     868        Agrif_Coarsegrid % nb(i) =Agrif_mygrid%nb(i) / coarse_spaceref(i) 
     869    enddo       
     870 
     871!   The root coarse grid is a fixed grid 
     872    Agrif_Coarsegrid % fixed = .TRUE. 
     873!   Level of the root grid 
     874    Agrif_Coarsegrid % level = -1 
     875     
     876    Agrif_Coarsegrid % grand_mother_grid = .true. 
     877 
     878!   Number of the grid pointed by Agrif_Mygrid (root coarse grid) 
     879    Agrif_Coarsegrid % rank = -9999 
     880! 
     881!   Number of the root grid as a fixed grid 
     882    Agrif_Coarsegrid % fixedrank = -9999 
     883     
     884      Agrif_Mygrid%parent => Agrif_Coarsegrid 
     885       
     886! Not used but required to prevent seg fault 
     887      Agrif_Coarsegrid%parent => Agrif_Mygrid 
     888       
     889      call Agrif_Create_Var(Agrif_Coarsegrid) 
     890 
     891! Reset to null 
     892      Nullify(Agrif_Coarsegrid%parent) 
     893       
     894      Agrif_Coarsegrid%child_list%nitems = 1 
     895      allocate(Agrif_Coarsegrid%child_list%first) 
     896      allocate(Agrif_Coarsegrid%child_list%last) 
     897      Agrif_Coarsegrid%child_list%first%gr => Agrif_Mygrid 
     898      Agrif_Coarsegrid%child_list%last%gr => Agrif_Mygrid 
     899 
     900    endif 
     901     
     902    return 
     903 
     90498  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST) 
     905    if (.not. BEXIST) then 
     906        print*,'ERROR : File AGRIF_FixedGrids.in not found.' 
     907        STOP 
     908    else 
     909        print*,'Error opening file AGRIF_FixedGrids.in' 
     910        STOP 
     911    endif 
     912     
     913!--------------------------------------------------------------------------------------------------- 
     914end subroutine Agrif_Init_Grids 
     915!=================================================================================================== 
     916! 
     917!=================================================================================================== 
     918!  subroutine Agrif_Deallocation 
     919! 
     920!> Deallocates all data arrays. 
     921!--------------------------------------------------------------------------------------------------- 
     922subroutine Agrif_Deallocation 
     923!--------------------------------------------------------------------------------------------------- 
     924    integer                         :: nb 
     925    type(Agrif_Variable), pointer   :: var 
     926    type(Agrif_Variable_c), pointer   :: var_c 
     927    type(Agrif_Variable_l), pointer   :: var_l 
     928    type(Agrif_Variable_i), pointer   :: var_i 
     929! 
     930    do nb = 1,Agrif_NbVariables(0) 
     931! 
     932        var => Agrif_Mygrid % tabvars(nb) 
     933! 
     934        if ( allocated(var % array1) ) deallocate(var % array1) 
     935        if ( allocated(var % array2) ) deallocate(var % array2) 
     936        if ( allocated(var % array3) ) deallocate(var % array3) 
     937        if ( allocated(var % array4) ) deallocate(var % array4) 
     938        if ( allocated(var % array5) ) deallocate(var % array5) 
     939        if ( allocated(var % array6) ) deallocate(var % array6) 
     940! 
     941        if ( allocated(var % sarray1) ) deallocate(var % sarray1) 
     942        if ( allocated(var % sarray2) ) deallocate(var % sarray2) 
     943        if ( allocated(var % sarray3) ) deallocate(var % sarray3) 
     944        if ( allocated(var % sarray4) ) deallocate(var % sarray4) 
     945        if ( allocated(var % sarray5) ) deallocate(var % sarray5) 
     946        if ( allocated(var % sarray6) ) deallocate(var % sarray6) 
     947! 
     948        if ( allocated(var % darray1) ) deallocate(var % darray1) 
     949        if ( allocated(var % darray2) ) deallocate(var % darray2) 
     950        if ( allocated(var % darray3) ) deallocate(var % darray3) 
     951        if ( allocated(var % darray4) ) deallocate(var % darray4) 
     952        if ( allocated(var % darray5) ) deallocate(var % darray5) 
     953        if ( allocated(var % darray6) ) deallocate(var % darray6) 
     954! 
     955    enddo 
     956! 
     957    do nb = 1,Agrif_NbVariables(1) 
     958! 
     959        var_c => Agrif_Mygrid % tabvars_c(nb) 
     960! 
     961        if ( allocated(var_c % carray1) ) deallocate(var_c % carray1) 
     962        if ( allocated(var_c % carray2) ) deallocate(var_c % carray2) 
     963! 
     964    enddo 
     965 
     966    do nb = 1,Agrif_NbVariables(3) 
     967! 
     968        var_l => Agrif_Mygrid % tabvars_l(nb) 
     969! 
     970        if ( allocated(var_l % larray1) ) deallocate(var_l % larray1) 
     971        if ( allocated(var_l % larray2) ) deallocate(var_l % larray2) 
     972        if ( allocated(var_l % larray3) ) deallocate(var_l % larray3) 
     973        if ( allocated(var_l % larray4) ) deallocate(var_l % larray4) 
     974        if ( allocated(var_l % larray5) ) deallocate(var_l % larray5) 
     975        if ( allocated(var_l % larray6) ) deallocate(var_l % larray6) 
     976! 
     977    enddo 
     978! 
     979    do nb = 1,Agrif_NbVariables(4) 
     980! 
     981        var_i => Agrif_Mygrid % tabvars_i(nb) 
     982! 
     983        if ( allocated(var_i % iarray1) ) deallocate(var_i % iarray1) 
     984        if ( allocated(var_i % iarray2) ) deallocate(var_i % iarray2) 
     985        if ( allocated(var_i % iarray3) ) deallocate(var_i % iarray3) 
     986        if ( allocated(var_i % iarray4) ) deallocate(var_i % iarray4) 
     987        if ( allocated(var_i % iarray5) ) deallocate(var_i % iarray5) 
     988        if ( allocated(var_i % iarray6) ) deallocate(var_i % iarray6)