Ignore:
Timestamp:
2018-09-05T15:33:44+02:00 (2 years ago)
Author:
rblod
Message:

update AGRIF library

File:
1 edited

Legend:

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

    r5656 r10087  
    4040!! when this one is equal to Agrif_SpecialValue. 
    4141!--------------------------------------------------------------------------------------------------- 
    42 subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, noraftab, nbdim ) 
     42subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, & 
     43             pbtab_required, petab_required, noraftab, nbdim ) 
    4344!--------------------------------------------------------------------------------------------------- 
    4445    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid 
     
    4647    integer, dimension(nbdim)       :: pbtab  !< limits of the parent grid used 
    4748    integer, dimension(nbdim)       :: petab  !< interpolation of the child grid 
    48     integer, dimension(nbdim)       :: ppbtab, ppetab 
     49    integer, dimension(nbdim)       :: ppbtab, ppetab, pbtab_required, petab_required 
    4950    logical, dimension(nbdim)       :: noraftab 
    5051    integer                         :: nbdim 
    5152! 
    52     integer :: i0,j0,k0,l0,m0,n0 
     53    integer :: i0,j0,k0,l0,m0,n0,ll,kk 
     54    integer,dimension(:,:),allocatable :: trytoreplace 
     55    integer :: ilook, Nbvals 
     56    real :: xold 
    5357! 
    5458    select case (nbdim) 
     
    7781                    parent%array3(ppbtab(1),ppbtab(2),ppbtab(3)), & 
    7882                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue) 
    79  
    80 !            Call CalculNewValTempP((/i0,j0,k0/), 
    81 !     &                             tempP,parent, 
    82 !     &                             ppbtab,ppetab, 
    83 !     &                             noraftab,nbdim) 
    84  
    8583            endif 
    8684        enddo 
     
    8886        enddo 
    8987    case (4) 
    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) 
     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) 
    9496            if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then 
    9597                call CalculNewValTempP4D((/i0,j0,k0,l0/), & 
    9698                    tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  & 
    9799                    parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), & 
    98                     ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue) 
    99             endif 
    100         enddo 
    101         enddo 
    102         enddo 
    103         enddo 
     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 
    104152    case (5) 
    105153        do m0 = pbtab(5),petab(5) 
     
    488536!--------------------------------------------------------------------------------------------------- 
    489537subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, & 
    490                                  MaxSearch, Agrif_SpecialValue ) 
     538                                 MaxSearch, Agrif_SpecialValue, ilook ) 
    491539!--------------------------------------------------------------------------------------------------- 
    492540    integer, parameter          :: nbdim = 4 
     
    511559! 
    512560    logical                     :: firsttest 
     561    integer :: ilook 
    513562! 
    514563    ValMax = 1 
     
    528577    firsttest = .TRUE. 
    529578    idecal = indic 
     579 
     580    if (ilook /= -1) then 
     581       i = ilook 
     582    else 
     583       i = 1 
     584    endif 
    530585! 
    531586    do while (i <= ValMax) 
    532587! 
    533         if ((i == 1).AND.(firsttest)) i = Valmax 
     588!        if ((i == 1).AND.(firsttest)) i = Valmax 
    534589 
    535590        do iii = 1,nbdim 
     
    537592                imin(iii) = max(indic(iii) - i,ppbtab(iii)) 
    538593                imax(iii) = min(indic(iii) + i,ppetab(iii)) 
    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 
     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 
    548603            endif 
    549604        enddo 
     
    567622! 
    568623        if (Nbvals > 0) then 
    569             if (firsttest) then 
    570                 firsttest = .FALSE. 
    571                 i=1 
    572                 cycle 
    573             endif 
     624!            if (firsttest) then 
     625!                firsttest = .FALSE. 
     626!                i=1 
     627!                cycle 
     628!            endif 
    574629 
    575630            tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals 
     631            ilook = i 
    576632            exit 
    577633        else 
    578             if (firsttest) exit 
     634!            if (firsttest) exit 
    579635            i = i + 1 
    580636        endif 
Note: See TracChangeset for help on using the changeset viewer.