Changeset 12719 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90

Timestamp:

2020-04-08T17:45:31+02:00 (4 years ago)

Author:

francesca

Message:

extra-halo management with positive arrays indices - ticket #2366

File:

• NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90 (modified) (11 diffs)

NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90

@@ -48 +48 @@
    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
       !!----------------------------------------------------------------------
-      ARRAY_TYPE(1-nn_hls+1:,1-nn_hls+1:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
+      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
       REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
@@ -80 +80 @@
          ALLOCATE(ipj_s(ipf))
 
-         ijpj      = 2 + nn_hls - 1           ! Max 2nd dimension of message transfers (last two j-line only)
-         ipj_s(:) = 1 + nn_hls - 1           ! Real 2nd dimension of message transfers (depending on perf requirement)
+         ijpj     = 2 + nn_hls -1           ! Max 2nd dimension of message transfers (last two j-line only)
+         ipj_s(:) = 1 + nn_hls -1           ! Real 2nd dimension of message transfers (depending on perf requirement)
                                  ! by default, only one line is exchanged
 
@@ -98 +98 @@
          IF ( l_full_nf_update .OR.                          &    ! if coupling fields
               ( ncom_stp == nit000 .AND. .NOT. ln_rstart ) ) &    ! at first time step, if not restart
-            ipj_s(:) = 2 + nn_hls - 1 
+            ipj_s(:) = 2 + nn_hls -1
 
          ! Index of modifying lines in input
@@ -110 +110 @@
                !
                CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point
-                     DO ji = 1, nn_hls+1
-                  jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1
-               ENDDO
+                  DO ji = 1, nn_hls+1
+                     jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1
+                  ENDDO
                CASE ( 'V' , 'F' )                                 ! V-, F-point
-               DO ji = 1, nn_hls+1
-                  jj_s(jf,ji) = nlcj - 2*nn_hls +ji - 2
-               ENDDO
+                  DO ji = 1, nn_hls+1
+                     jj_s(jf,ji) = nlcj - 2*nn_hls +ji - 2
+                  ENDDO
                END SELECT
             !
@@ -123 +123 @@
                !
                CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point
-               DO ji = 1, nn_hls
-                  jj_s(jf,ji) = nlcj - 2*nn_hls + ji     
-               ENDDO
-               ipj_s(jf) = nn_hls                  ! need only one line anyway
+                  DO ji = 1, nn_hls
+                     jj_s(jf,ji) = nlcj - 2*nn_hls + ji
+                  ENDDO
+                  ipj_s(jf) = nn_hls                  ! need only one line anyway
                CASE ( 'V' , 'F' )                                 ! V-, F-point
-               DO ji = 1, nn_hls+1
-                  jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1
-               ENDDO
+                  DO ji = 1, nn_hls+1
+                     jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1
+                  ENDDO
                END SELECT
             !
@@ -139 +139 @@
          ipf_j = sum (ipj_s(:))      ! Total number of lines to be exchanged
          !
-         ALLOCATE( znorthloc(1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) )
+         ALLOCATE( znorthloc(jpimax,ipf_j,ipk,ipl,1) )
          !
          js = 0
@@ -147 +147 @@
                DO jl = 1, ipl
                   DO jk = 1, ipk
-                     znorthloc(1-nn_hls+1:jpi,js,jk,jl,1) = ARRAY_IN(1-nn_hls+1:jpi,jj_s(jf,jj),jk,jl,jf)
+                     znorthloc(1:jpi,js,jk,jl,1) = ARRAY_IN(1:jpi,jj_s(jf,jj),jk,jl,jf)
                   END DO
                END DO
@@ -153 +153 @@
          END DO
          !
-         ibuffsize = (jpimax + nn_hls -1) * ipf_j * ipk * ipl
-         !
-         ALLOCATE( zfoldwk(1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) )
-         ALLOCATE( ztabr(1-nn_hls+1:(jpi+nn_hls-1)*jpmaxngh-nn_hls+1,ijpj,ipk,ipl,ipf) ) 
+         ibuffsize = jpimax * ipf_j * ipk * ipl
+         !
+         ALLOCATE( zfoldwk(jpimax,ipf_j,ipk,ipl,1) )
+         ALLOCATE( ztabr(jpimax*jpmaxngh,ijpj,ipk,ipl,ipf) ) 
          ! when some processors of the north fold are suppressed, 
          ! values of ztab* arrays corresponding to these suppressed domain won't be defined 
@@ -177 +177 @@
                iilb = nimppt(iproc+1)
                ilci = nlcit (iproc+1)
-               ildi = nldit (iproc+1)
-               ilei = nleit (iproc+1)
-               IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column
-               IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column
+               ildi = nldit (iproc+1) + nn_hls-1
+               ilei = nleit (iproc+1) + nn_hls-1
+               IF( iilb            ==      1 )   ildi = nn_hls   ! e-w boundary already done -> force to take 1st column
+               IF( iilb + ilci - 1 == jpiglo )   ilei = nlei+1   ! e-w boundary already done -> force to take last column
                iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
             ENDIF
@@ -191 +191 @@
                      DO jk = 1, ipk
                         DO ji = ildi, ilei
-                           ztabr(iilb+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1)
+                           ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1)
                         END DO
                      END DO
@@ -201 +201 @@
                      DO jk = 1, ipk
                         DO ji = ildi, ilei
-                           ztabr(iilb+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf)
+                           ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf)
                         END DO
                      END DO