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/AGRIF/CMEMS_2020/AGRIF_FILES/modinterp.F90 – NEMO

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

Update agrif library and conv see ticket #2129

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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 
Note: See TracChangeset for help on using the changeset viewer.