Changeset 10725 for vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modmask.F90

Timestamp:

2019-02-27T14:55:54+01:00 (5 years ago)

Author:

rblod

Message:

Update agrif library and conv see ticket #2129

File:

• vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modmask.F90 (modified) (9 diffs)

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modmask.F90

@@ -40 +40 @@
 !! when this one is equal to Agrif_SpecialValue.
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, &
-             pbtab_required, petab_required, noraftab, nbdim )
+subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, noraftab, nbdim )
 !---------------------------------------------------------------------------------------------------
     type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
@@ -47 +46 @@
     integer, dimension(nbdim)       :: pbtab  !< limits of the parent grid used
     integer, dimension(nbdim)       :: petab  !< interpolation of the child grid
-    integer, dimension(nbdim)       :: ppbtab, ppetab, pbtab_required, petab_required
+    integer, dimension(nbdim)       :: ppbtab, ppetab
     logical, dimension(nbdim)       :: noraftab
     integer                         :: nbdim
 !
-    integer :: i0,j0,k0,l0,m0,n0,ll,kk
-    integer,dimension(:,:),allocatable :: trytoreplace
-    integer :: ilook, Nbvals
-    real :: xold
+    integer :: i0,j0,k0,l0,m0,n0
 !
     select case (nbdim)
@@ -81 +77 @@
                     parent%array3(ppbtab(1),ppbtab(2),ppbtab(3)), &
                     ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+
+!            Call CalculNewValTempP((/i0,j0,k0/),
+!     &                             tempP,parent,
+!     &                             ppbtab,ppetab,
+!     &                             noraftab,nbdim)
+
             endif
         enddo
@@ -86 +88 @@
         enddo
     case (4)
-
-        if (noraftab(1).AND.noraftab(2)) then
-          allocate(trytoreplace(pbtab_required(3):petab_required(3),pbtab_required(4):petab_required(4)))
-          trytoreplace = -1
-          i0 = pbtab_required(1)
-          j0 = pbtab_required(2)
-          do l0 = pbtab_required(4),petab_required(4)
-          do k0 = pbtab_required(3),petab_required(3)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
             if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
                 call CalculNewValTempP4D((/i0,j0,k0,l0/), &
                     tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  &
                     parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), &
-                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue, &
-                    trytoreplace(k0,l0))
-            endif
-          enddo
-          enddo
-
-          do l0 = pbtab_required(4),petab_required(4)
-          do k0 = pbtab_required(3),petab_required(3)
-          if (trytoreplace(k0,l0) /= -1) then
-          do j0 = pbtab_required(2),petab_required(2)
-          do i0 = pbtab_required(1),petab_required(1)
-
-          if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
-          tempP%array4(i0,j0,k0,l0) = 0.
-          Nbvals = 0
-          do ll=max(l0-trytoreplace(k0,l0),ppbtab(4)),min(l0+trytoreplace(k0,l0),ppetab(4))
-          do kk=max(k0-trytoreplace(k0,l0),ppbtab(3)),min(k0+trytoreplace(k0,l0),ppetab(3))
-           if (parent%array4(i0,j0,kk,ll) /= Agrif_SpecialValue) then
-             tempP%array4(i0,j0,k0,l0) = tempP%array4(i0,j0,k0,l0) + parent%array4(i0,j0,kk,ll)
-             Nbvals = Nbvals + 1
-           endif
-          enddo
-          enddo
-
-          tempP%array4(i0,j0,k0,l0) = tempP%array4(i0,j0,k0,l0) /Nbvals
-          endif
-          enddo
-          enddo
-          endif
-          enddo
-          enddo
-          deallocate(trytoreplace)
-
-        else
-
-        do l0 = pbtab_required(4),petab_required(4)
-        do k0 = pbtab_required(3),petab_required(3)
-        do j0 = pbtab_required(2),petab_required(2)
-        do i0 = pbtab_required(1),petab_required(1)
-            if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
-                ilook = -1
-                call CalculNewValTempP4D((/i0,j0,k0,l0/), &
-                    tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  &
-                    parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), &
-                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue,ilook)
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
-
-        endif
+                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
     case (5)
         do m0 = pbtab(5),petab(5)
@@ -536 +488 @@
 !---------------------------------------------------------------------------------------------------
 subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
-                                 MaxSearch, Agrif_SpecialValue, ilook )
+                                 MaxSearch, Agrif_SpecialValue )
 !---------------------------------------------------------------------------------------------------
     integer, parameter          :: nbdim = 4
@@ -559 +511 @@
 !
     logical                     :: firsttest
-    integer :: ilook
 !
     ValMax = 1
@@ -577 +528 @@
     firsttest = .TRUE.
     idecal = indic
-
-    if (ilook /= -1) then
-       i = ilook
-    else
-       i = 1
-    endif
 !
     do while (i <= ValMax)
 !
-!        if ((i == 1).AND.(firsttest)) i = Valmax
+        if ((i == 1).AND.(firsttest)) i = Valmax
 
         do iii = 1,nbdim
@@ -592 +537 @@
                 imin(iii) = max(indic(iii) - i,ppbtab(iii))
                 imax(iii) = min(indic(iii) + i,ppetab(iii))
- !               if (firsttest) then
- !                   if (indic(iii) > ppbtab(iii)) then
- !                       idecal(iii) = idecal(iii)-1
- !                       if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then
- !                           imin(iii) = imax(iii)
- !                       endif
- !                       idecal(iii) = idecal(iii)+1
- !                   endif
- !               endif
+                if (firsttest) then
+                    if (indic(iii) > ppbtab(iii)) then
+                        idecal(iii) = idecal(iii)-1
+                        if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then
+                            imin(iii) = imax(iii)
+                        endif
+                        idecal(iii) = idecal(iii)+1
+                    endif
+                endif
             endif
         enddo
@@ -622 +567 @@
 !
         if (Nbvals > 0) then
-!            if (firsttest) then
-!                firsttest = .FALSE.
-!                i=1
-!                cycle
-!            endif
+            if (firsttest) then
+                firsttest = .FALSE.
+                i=1
+                cycle
+            endif
 
             tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
-            ilook = i
             exit
         else
-!            if (firsttest) exit
+            if (firsttest) exit
             i = i + 1
         endif