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

Timestamp:

2018-09-05T15:33:44+02:00 (6 years ago)

Author:

rblod

Message:

update AGRIF library

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, noraftab, nbdim )
+subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, &
+             pbtab_required, petab_required, noraftab, nbdim )
 !---------------------------------------------------------------------------------------------------
     type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
@@ -46 +47 @@
     integer, dimension(nbdim)       :: pbtab  !< limits of the parent grid used
     integer, dimension(nbdim)       :: petab  !< interpolation of the child grid
-    integer, dimension(nbdim)       :: ppbtab, ppetab
+    integer, dimension(nbdim)       :: ppbtab, ppetab, pbtab_required, petab_required
     logical, dimension(nbdim)       :: noraftab
     integer                         :: nbdim
 !
-    integer :: i0,j0,k0,l0,m0,n0
+    integer :: i0,j0,k0,l0,m0,n0,ll,kk
+    integer,dimension(:,:),allocatable :: trytoreplace
+    integer :: ilook, Nbvals
+    real :: xold
 !
     select case (nbdim)
@@ -77 +81 @@
                     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
@@ -88 +86 @@
         enddo
     case (4)
-        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 (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)
             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)
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
+                    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
     case (5)
         do m0 = pbtab(5),petab(5)
@@ -488 +536 @@
 !---------------------------------------------------------------------------------------------------
 subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
-                                 MaxSearch, Agrif_SpecialValue )
+                                 MaxSearch, Agrif_SpecialValue, ilook )
 !---------------------------------------------------------------------------------------------------
     integer, parameter          :: nbdim = 4
@@ -511 +559 @@
 !
     logical                     :: firsttest
+    integer :: ilook
 !
     ValMax = 1
@@ -528 +577 @@
     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
@@ -537 +592 @@
                 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
@@ -567 +622 @@
 !
         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