Index: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/lbc_nfd_nogather_generic.h90
===================================================================
--- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/lbc_nfd_nogather_generic.h90	(revision 14197)
+++ NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/lbc_nfd_nogather_generic.h90	(revision 14644)
@@ -1,79 +1,4 @@
-#if defined MULTI
-#   define NAT_IN(k)                cd_nat(k)   
-#   define SGN_IN(k)                psgn(k)
-#   define F_SIZE(ptab)             kfld
-#   if defined DIM_2d
-#      if defined SINGLE_PRECISION
-#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp),INTENT(inout)::ptab(f)
-#      else
-#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp),INTENT(inout)::ptab(f)
-#      endif 
-#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
-#      define K_SIZE(ptab)             1
-#      define L_SIZE(ptab)             1
-#   endif
-#   if defined DIM_3d
-#      if defined SINGLE_PRECISION
-#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp),INTENT(inout)::ptab(f)
-#      else
-#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp),INTENT(inout)::ptab(f)
-#      endif 
-#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
-#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
-#      define L_SIZE(ptab)             1
-#   endif
-#   if defined DIM_4d
-#      if defined SINGLE_PRECISION
-#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp),INTENT(inout)::ptab(f)
-#      else
-#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp),INTENT(inout)::ptab(f)
-#      endif 
-#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
-#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
-#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
-#   endif
-#   if defined SINGLE_PRECISION
-#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D_sp),INTENT(inout)::ptab2(f)
-#   else
-#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D_dp),INTENT(inout)::ptab2(f)
-#   endif
-#   define J_SIZE(ptab2)            SIZE(ptab2(1)%pt4d,2)
-#   define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l)
-#else
-!                          !==  IN: ptab is an array  ==!
-#   define NAT_IN(k)                cd_nat
-#   define SGN_IN(k)                psgn
-#   define F_SIZE(ptab)             1
-#   if defined DIM_2d
-#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
-#      define K_SIZE(ptab)          1
-#      define L_SIZE(ptab)          1
-#   endif
-#   if defined DIM_3d
-#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
-#      define K_SIZE(ptab)          SIZE(ptab,3)
-#      define L_SIZE(ptab)          1
-#   endif
-#   if defined DIM_4d
-#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
-#      define K_SIZE(ptab)          SIZE(ptab,3)
-#      define L_SIZE(ptab)          SIZE(ptab,4)
-#   endif
-#   define J_SIZE(ptab2)             SIZE(ptab2,2)
-#   define ARRAY2_IN(i,j,k,l,f)   ptab2(i,j,k,l)
-#   if defined SINGLE_PRECISION
-#      define ARRAY_TYPE(i,j,k,l,f)     REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
-#      define ARRAY2_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
-#   else
-#      define ARRAY_TYPE(i,j,k,l,f)     REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
-#      define ARRAY2_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
-#   endif
-#   endif
-#   ifdef SINGLE_PRECISION
-#      define PRECISION sp
-#   else
-#      define PRECISION dp
-#   endif
-   SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld )
+
+   SUBROUTINE lbc_nfd_nogather_/**/PRECISION( ptab, ptab2, cd_nat, psgn, khls )
       !!----------------------------------------------------------------------
       !!
@@ -82,131 +7,119 @@
       !!
       !!----------------------------------------------------------------------
-      ARRAY_TYPE(:,:,:,:,:)
-      ARRAY2_TYPE(:,:,:,:,:) 
-      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
-      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
-      !
-      INTEGER  ::    ji,  jj,   jk, jn, ii,   jl,   jh,  jf   ! dummy loop indices
-      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf, iij, ijj   ! dimension of the input array
+      REAL(PRECISION),  DIMENSION(:,:,:,:), INTENT(inout) ::   ptab        ! 
+      REAL(PRECISION),  DIMENSION(:,:,:,:), INTENT(inout) ::   ptab2       ! 
+      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_nat      ! nature of array grid-points
+      REAL(PRECISION)                     , INTENT(in   ) ::   psgn        ! sign used across the north fold boundary
+      INTEGER                             , INTENT(in   ) ::   khls        ! halo size, default = nn_hls
+      !
+      INTEGER  ::    ji,  jj, jk,  jn,  jl, jh       ! dummy loop indices
+      INTEGER  ::   ipk, ipl, ii, iij, ijj      ! dimension of the input array
       INTEGER  ::   ijt, iju, ijta, ijua, jia, startloop, endloop
       LOGICAL  ::   l_fast_exchanges
       !!----------------------------------------------------------------------
-      ipj = J_SIZE(ptab2)  ! 2nd dimension of input array
-      ipk = K_SIZE(ptab)   ! 3rd dimension of output array
-      ipl = L_SIZE(ptab)   ! 4th    -
-      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
-      !
-      ! Security check for further developments
-      IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' )
+      ipk = SIZE(ptab,3)
+      ipl = SIZE(ptab,4)
+      !
       ! 2nd dimension determines exchange speed
-      IF (ipj == 1 ) THEN
-        l_fast_exchanges = .TRUE.
-      ELSE
-        l_fast_exchanges = .FALSE.
-      ENDIF
-      !
-      DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+      l_fast_exchanges = SIZE(ptab2,2) == 1
+      !
+      IF( c_NFtype == 'T' ) THEN          ! *  North fold  T-point pivot
          !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-            !
-            SELECT CASE ( NAT_IN(jf) )
-            !
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               IF ( nimpp /= 1 ) THEN  ;  startloop = 1 
-               ELSE                    ;  startloop = 1 + nn_hls
-               ENDIF
-               !
-               DO jl = 1, ipl; DO jk = 1, ipk
-               	  DO jj = 1, nn_hls
-               	     ijj = jpj -jj +1
+         SELECT CASE ( cd_nat )
+            !
+         CASE ( 'T' , 'W' )                         ! T-, W-point
+            IF ( nimpp /= 1 ) THEN  ;  startloop = 1 
+            ELSE                    ;  startloop = 1 + khls
+            ENDIF
+            !
+            DO jl = 1, ipl; DO jk = 1, ipk
+               DO jj = 1, khls
+                  ijj = jpj -jj +1
+                  DO ji = startloop, jpi
+                     ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
+                     ptab(ji,ijj,jk,jl) = psgn * ptab2(ijt,jj,jk,jl)
+                  END DO
+               END DO
+            END DO; END DO
+            IF( nimpp == 1 ) THEN
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO jj = 1, khls
+                     ijj = jpj -jj +1
+                     DO ii = 0, khls-1
+                        ptab(ii+1,ijj,jk,jl) = psgn * ptab(2*khls-ii+1,jpj-2*khls+jj-1,jk,jl)
+                     END DO
+                  END DO
+               END DO; END DO
+            ENDIF
+            !
+            IF ( .NOT. l_fast_exchanges ) THEN
+               IF( nimpp >= Ni0glo/2+2 ) THEN
+                  startloop = 1
+               ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
+                  startloop = Ni0glo/2+2 - nimpp + khls
+               ELSE
+                  startloop = jpi + 1
+               ENDIF
+               IF( startloop <= jpi ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
                      DO ji = startloop, jpi
-                    	ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
-                     	ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
-                     END DO
-                  END DO
-               END DO; END DO
-               IF( nimpp == 1 ) THEN
-                  DO jl = 1, ipl; DO jk = 1, ipk
-                     DO jj = 1, nn_hls
-               	  	ijj = jpj -jj +1
-               	  	DO ii = 0, nn_hls-1
-                  	   ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl,jf)
-                  	END DO
+                        ijt  = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
+                        jia  = ji + nimpp - 1
+                        ijta = jpiglo - jia + 2
+                        IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
+                           ptab(ji,jpj-khls,jk,jl) = psgn * ptab(ijta-nimpp+khls,jpj-khls,jk,jl)
+                        ELSE
+                           ptab(ji,jpj-khls,jk,jl) = psgn * ptab2(ijt,khls+1,jk,jl)
+                        ENDIF
                      END DO
                   END DO; END DO
-               ENDIF              
-               !
-               IF ( .NOT. l_fast_exchanges ) THEN
-                  IF( nimpp >= Ni0glo/2+2 ) THEN
-                     startloop = 1
-                  ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
-                     startloop = Ni0glo/2+2 - nimpp + nn_hls
-                  ELSE
-                     startloop = jpi + 1
-                  ENDIF
-                  IF( startloop <= jpi ) THEN
-                     DO jl = 1, ipl; DO jk = 1, ipk
-                        DO ji = startloop, jpi
-                           ijt  = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
-                           jia  = ji + nimpp - 1
-                           ijta = jpiglo - jia + 2
-                           IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
-                              ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf)
-                           ELSE
-                              ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf)
-                           ENDIF
-                        END DO
-                     END DO; END DO
-                  ENDIF
-               ENDIF
-            CASE ( 'U' )                                     ! U-point
+               ENDIF
+            ENDIF
+         CASE ( 'U' )                                     ! U-point
+            IF( nimpp + jpi - 1 /= jpiglo ) THEN
+               endloop = jpi
+            ELSE
+               endloop = jpi - khls
+            ENDIF
+            DO jl = 1, ipl; DO jk = 1, ipk
+               DO jj = 1, khls
+                  ijj = jpj -jj +1
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                     ptab(ji,ijj,jk,jl) = psgn * ptab2(iju,jj,jk,jl)
+                  END DO
+               END DO
+            END DO; END DO
+            IF (nimpp .eq. 1) THEN
+               DO jj = 1, khls
+                  ijj = jpj -jj +1
+                  DO ii = 0, khls-1
+                     ptab(ii+1,ijj,:,:) = psgn * ptab(2*khls-ii,jpj-2*khls+jj-1,:,:)
+                  END DO
+               END DO
+            ENDIF
+            IF((nimpp + jpi - 1) .eq. jpiglo) THEN
+               DO jj = 1, khls
+                  ijj = jpj -jj +1
+                  DO ii = 1, khls
+                     ptab(jpi-ii+1,ijj,:,:) = psgn * ptab(jpi-2*khls+ii,jpj-2*khls+jj-1,:,:)
+                  END DO
+               END DO
+            ENDIF
+            !
+            IF ( .NOT. l_fast_exchanges ) THEN
                IF( nimpp + jpi - 1 /= jpiglo ) THEN
                   endloop = jpi
                ELSE
-                  endloop = jpi - nn_hls
-               ENDIF
-               DO jl = 1, ipl; DO jk = 1, ipk
-		  DO jj = 1, nn_hls
-        	     ijj = jpj -jj +1
-                     DO ji = 1, endloop
-                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
-                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
-                     END DO
-                  END DO
-               END DO; END DO
-               IF (nimpp .eq. 1) THEN
-		  DO jj = 1, nn_hls
-		     ijj = jpj -jj +1
-		     DO ii = 0, nn_hls-1
-		 	ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf)
-		     END DO
-                  END DO
-               ENDIF
-               IF((nimpp + jpi - 1) .eq. jpiglo) THEN
-                  DO jj = 1, nn_hls
-               	     ijj = jpj -jj +1
-			DO ii = 1, nn_hls
-		   	   ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf)
-			END DO
-		  END DO
-               ENDIF
-               !
-               IF ( .NOT. l_fast_exchanges ) THEN
-                  IF( nimpp + jpi - 1 /= jpiglo ) THEN
-                     endloop = jpi
-                  ELSE
-                     endloop = jpi - nn_hls
-                  ENDIF
-                  IF( nimpp >= Ni0glo/2+1 ) THEN
-                     startloop = nn_hls
-                  ELSEIF( ( nimpp + jpi - 1 >= Ni0glo/2+1 ) .AND. ( nimpp < Ni0glo/2+1 ) ) THEN
-                     startloop = Ni0glo/2+1 - nimpp + nn_hls 
-                  ELSE
-                     startloop = endloop + 1
-                  ENDIF
-                  IF( startloop <= endloop ) THEN
+                  endloop = jpi - khls
+               ENDIF
+               IF( nimpp >= Ni0glo/2+1 ) THEN
+                  startloop = khls
+               ELSEIF( ( nimpp + jpi - 1 >= Ni0glo/2+1 ) .AND. ( nimpp < Ni0glo/2+1 ) ) THEN
+                  startloop = Ni0glo/2+1 - nimpp + khls 
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF( startloop <= endloop ) THEN
                   DO jl = 1, ipl; DO jk = 1, ipk
                      DO ji = startloop, endloop
@@ -215,235 +128,222 @@
                         ijua = jpiglo - jia + 1 
                         IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN
-                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,jpj-nn_hls,jk,jl,jf)
+                           ptab(ji,jpj-khls,jk,jl) = psgn * ptab(ijua-nimpp+1,jpj-khls,jk,jl)
                         ELSE
-                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf)
+                           ptab(ji,jpj-khls,jk,jl) = psgn * ptab2(iju,khls+1,jk,jl)
                         ENDIF
                      END DO
                   END DO; END DO
-                  ENDIF
-               ENDIF
-               !
-            CASE ( 'V' )                                     ! V-point
-               IF( nimpp /= 1 ) THEN
-                 startloop = 1 
-               ELSE
-                 startloop = 1 + nn_hls
-               ENDIF
+               ENDIF
+            ENDIF
+            !
+         CASE ( 'V' )                                     ! V-point
+            IF( nimpp /= 1 ) THEN
+               startloop = 1 
+            ELSE
+               startloop = 1 + khls
+            ENDIF
+            IF ( .NOT. l_fast_exchanges ) THEN
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO jj = 2, khls+1
+                     ijj = jpj -jj +1
+                     DO ji = startloop, jpi
+                        ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
+                        ptab(ji,ijj,jk,jl) = psgn * ptab2(ijt,jj,jk,jl)
+                     END DO
+                  END DO
+               END DO; END DO
+            ENDIF
+            DO jl = 1, ipl; DO jk = 1, ipk
+               DO ji = startloop, jpi
+                  ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
+                  ptab(ji,jpj,jk,jl) = psgn * ptab2(ijt,1,jk,jl)
+               END DO
+            END DO; END DO
+            IF (nimpp .eq. 1) THEN
+               DO jj = 1, khls
+                  ijj = jpj-jj+1
+                  DO ii = 0, khls-1
+                     ptab(ii+1,ijj,:,:) = psgn * ptab(2*khls-ii+1,jpj-2*khls+jj-1,:,:)
+                  END DO
+               END DO
+            ENDIF
+         CASE ( 'F' )                                     ! F-point
+            IF( nimpp + jpi - 1 /= jpiglo ) THEN
+               endloop = jpi
+            ELSE
+               endloop = jpi - khls
+            ENDIF
+            IF ( .NOT. l_fast_exchanges ) THEN
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO jj = 2, khls+1
+                     ijj = jpj -jj +1
+                     DO ji = 1, endloop
+                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                        ptab(ji,ijj,jk,jl) = psgn * ptab2(iju,jj,jk,jl)
+                     END DO
+                  END DO
+               END DO; END DO
+            ENDIF
+            DO jl = 1, ipl; DO jk = 1, ipk
+               DO ji = 1, endloop
+                  iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                  ptab(ji,jpj,jk,jl) = psgn * ptab2(iju,1,jk,jl)
+               END DO
+            END DO; END DO
+            IF (nimpp .eq. 1) THEN               
+               DO ii = 1, khls
+                  ptab(ii,jpj,:,:) = psgn * ptab(2*khls-ii,jpj-2*khls-1,:,:)
+               END DO
                IF ( .NOT. l_fast_exchanges ) THEN
+                  DO jj = 1, khls
+                     ijj = jpj -jj
+                     DO ii = 0, khls-1
+                        ptab(ii+1,ijj,:,:) = psgn * ptab(2*khls-ii,jpj-2*khls+jj-1,:,:)
+                     END DO
+                  END DO
+               ENDIF
+            ENDIF
+            IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN
+               DO ii = 1, khls
+                  ptab(jpi-ii+1,jpj,:,:) = psgn * ptab(jpi-2*khls+ii,jpj-2*khls-1,:,:)
+               END DO
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  DO jj = 1, khls
+                     ijj = jpj -jj
+                     DO ii = 1, khls
+                        ptab(jpi-ii+1,ijj,:,:) = psgn * ptab(jpi-2*khls+ii,jpj-2*khls+jj-1,:,:)
+                     END DO
+                  END DO
+               ENDIF
+            ENDIF
+            !
+         END SELECT
+         !
+      ENDIF   ! c_NFtype == 'T'
+      !
+      IF( c_NFtype == 'F' ) THEN           ! *  North fold  F-point pivot
+         !
+         SELECT CASE ( cd_nat )
+         CASE ( 'T' , 'W' )                               ! T-, W-point
+            DO jl = 1, ipl; DO jk = 1, ipk
+               DO jj = 1, khls
+                  ijj = jpj-jj+1
+                  DO ji = 1, jpi
+                     ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                     ptab(ji,ijj,jk,jl) = psgn * ptab2(ijt,jj,jk,jl)
+                  END DO
+               END DO
+            END DO; END DO
+            !
+         CASE ( 'U' )                                     ! U-point
+            IF( nimpp + jpi - 1 /= jpiglo ) THEN
+               endloop = jpi
+            ELSE
+               endloop = jpi - khls
+            ENDIF
+            DO jl = 1, ipl; DO jk = 1, ipk
+               DO jj = 1, khls
+                  ijj = jpj-jj+1
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
+                     ptab(ji,ijj,jk,jl) = psgn * ptab2(iju,jj,jk,jl)
+                  END DO
+               END DO
+            END DO; END DO
+            IF(nimpp + jpi - 1 .eq. jpiglo) THEN
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO jj = 1, khls
+                     ijj = jpj-jj+1
+                     DO ii = 1, khls
+                        iij = jpi-ii+1
+                        ptab(iij,ijj,jk,jl) = psgn * ptab(jpi-2*khls+ii-1,jpj-2*khls+jj,jk,jl)
+                     END DO
+                  END DO
+               END DO; END DO
+            ENDIF
+            !
+         CASE ( 'V' )                                     ! V-point
+            DO jl = 1, ipl; DO jk = 1, ipk
+               DO jj = 1, khls
+                  ijj = jpj -jj +1
+                  DO ji = 1, jpi
+                     ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                     ptab(ji,ijj,jk,jl) = psgn * ptab2(ijt,jj,jk,jl)
+                  END DO
+               END DO
+            END DO; END DO
+
+            IF ( .NOT. l_fast_exchanges ) THEN
+               IF( nimpp >= Ni0glo/2+2 ) THEN
+                  startloop = 1
+               ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
+                  startloop = Ni0glo/2+2 - nimpp + khls
+               ELSE
+                  startloop = jpi + 1
+               ENDIF
+               IF( startloop <= jpi ) THEN
                   DO jl = 1, ipl; DO jk = 1, ipk
-               	     DO jj = 2, nn_hls+1
-               	  	ijj = jpj -jj +1
-                     	DO ji = startloop, jpi
-                           ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
-                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
-                     	END DO
-                    END DO
+                     DO ji = startloop, jpi
+                        ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                        ptab(ji,jpj-khls,jk,jl) = psgn * ptab2(ijt,khls+1,jk,jl)
+                     END DO
                   END DO; END DO
                ENDIF
-               DO jl = 1, ipl; DO jk = 1, ipk
-                  DO ji = startloop, jpi
-                     ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
-                     ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf)
-                  END DO
-               END DO; END DO
-               IF (nimpp .eq. 1) THEN
-		  DO jj = 1, nn_hls
-               	     ijj = jpj-jj+1
-               	     DO ii = 0, nn_hls-1
-                        ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:,jf)
-		     END DO
-		  END DO
-               ENDIF
-            CASE ( 'F' )                                     ! F-point
+            ENDIF
+            !
+         CASE ( 'F' )                               ! F-point
+            IF( nimpp + jpi - 1 /= jpiglo ) THEN
+               endloop = jpi
+            ELSE
+               endloop = jpi - khls
+            ENDIF
+            DO jl = 1, ipl; DO jk = 1, ipk
+               DO jj = 1, khls
+                  ijj = jpj -jj +1
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
+                     ptab(ji,ijj ,jk,jl) = psgn * ptab2(iju,jj,jk,jl)
+                  END DO
+               END DO
+            END DO; END DO
+            IF((nimpp + jpi - 1) .eq. jpiglo) THEN
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO jj = 1, khls
+                     ijj = jpj -jj +1
+                     DO ii = 1, khls
+                        iij = jpi -ii+1
+                        ptab(iij,ijj,jk,jl) = psgn * ptab(jpi-2*khls+ii-1,jpj-2*khls+jj-1,jk,jl)
+                     END DO
+                  END DO
+               END DO; END DO
+            ENDIF
+            !
+            IF ( .NOT. l_fast_exchanges ) THEN
                IF( nimpp + jpi - 1 /= jpiglo ) THEN
                   endloop = jpi
                ELSE
-                  endloop = jpi - nn_hls
-               ENDIF
-               IF ( .NOT. l_fast_exchanges ) THEN
+                  endloop = jpi - khls
+               ENDIF
+               IF( nimpp >= Ni0glo/2+2 ) THEN
+                  startloop = 1 
+               ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
+                  startloop = Ni0glo/2+2 - nimpp + khls
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF( startloop <= endloop ) THEN
                   DO jl = 1, ipl; DO jk = 1, ipk
-               	     DO jj = 2, nn_hls+1
-               	  	ijj = jpj -jj +1
-                     	DO ji = 1, endloop
-                           iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
-                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
-                     	END DO
-                    END DO
+                     DO ji = startloop, endloop
+                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
+                        ptab(ji,jpj-khls,jk,jl) = psgn * ptab2(iju,khls+1,jk,jl)
+                     END DO
                   END DO; END DO
                ENDIF
-               DO jl = 1, ipl; DO jk = 1, ipk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
-                     ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf)
-                  END DO
-               END DO; END DO
-		IF (nimpp .eq. 1) THEN               
-		   DO ii = 1, nn_hls
-	              ARRAY_IN(ii,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:,jf)
-		   END DO
-		   IF ( .NOT. l_fast_exchanges ) THEN
-		      DO jj = 1, nn_hls
-               	 	 ijj = jpj -jj
-               		 DO ii = 0, nn_hls-1
-                    	    ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf)
-                 	 END DO
-                      END DO
-               	   ENDIF
-		ENDIF
-		IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN
-                   DO ii = 1, nn_hls
-	              ARRAY_IN(jpi-ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:,jf)
-		   END DO
-		   IF ( .NOT. l_fast_exchanges ) THEN
-		      DO jj = 1, nn_hls
-               	         ijj = jpj -jj
-	               	 DO ii = 1, nn_hls
-                    	    ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf)
-                     	 END DO
-                      END DO
-               	   ENDIF
-               	ENDIF
-               	!
-	    END SELECT
-            !
-         CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-            !
-            SELECT CASE ( NAT_IN(jf) )
-            CASE ( 'T' , 'W' )                               ! T-, W-point
-               DO jl = 1, ipl; DO jk = 1, ipk
-		  DO jj = 1, nn_hls
- 		     ijj = jpj-jj+1
-		     DO ji = 1, jpi
-                     	ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
-                     	ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
-                     END DO
-		  END DO
-               END DO; END DO
-               !
-            CASE ( 'U' )                                     ! U-point
-               IF( nimpp + jpi - 1 /= jpiglo ) THEN
-                  endloop = jpi
-               ELSE
-                  endloop = jpi - nn_hls
-               ENDIF
-               DO jl = 1, ipl; DO jk = 1, ipk
-		  DO jj = 1, nn_hls
- 		     ijj = jpj-jj+1
-                     DO ji = 1, endloop
-                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
-                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
-                     END DO
-                  END DO
-               END DO; END DO
-               IF(nimpp + jpi - 1 .eq. jpiglo) THEN
-                  DO jl = 1, ipl; DO jk = 1, ipk
-                     DO jj = 1, nn_hls
-               	        ijj = jpj-jj+1
-                        DO ii = 1, nn_hls
-			   iij = jpi-ii+1
-                           ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl,jf)
-                        END DO
-                     END DO
-                  END DO; END DO
-               ENDIF
-               !
-            CASE ( 'V' )                                     ! V-point
-               DO jl = 1, ipl; DO jk = 1, ipk
-		  DO jj = 1, nn_hls
-		     ijj = jpj -jj +1
-                     DO ji = 1, jpi
-                        ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
-                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
-                     END DO
-                  END DO
-               END DO; END DO
+            ENDIF
+            !
+         END SELECT
+         !
+      ENDIF   ! c_NFtype == 'F'
+      !
+   END SUBROUTINE lbc_nfd_nogather_/**/PRECISION
 
-               IF ( .NOT. l_fast_exchanges ) THEN
-                  IF( nimpp >= Ni0glo/2+2 ) THEN
-                     startloop = 1
-                  ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
-                     startloop = Ni0glo/2+2 - nimpp + nn_hls
-                  ELSE
-                     startloop = jpi + 1
-                  ENDIF
-                  IF( startloop <= jpi ) THEN
-                  DO jl = 1, ipl; DO jk = 1, ipk
-                        DO ji = startloop, jpi
-                   	   ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
-                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf)
-                        END DO
-                  END DO; END DO
-                  ENDIF
-               ENDIF
-               !
-            CASE ( 'F' )                               ! F-point
-               IF( nimpp + jpi - 1 /= jpiglo ) THEN
-                  endloop = jpi
-               ELSE
-                  endloop = jpi - nn_hls
-               ENDIF
-               DO jl = 1, ipl; DO jk = 1, ipk
-		  DO jj = 1, nn_hls
-		    ijj = jpj -jj +1
-                    DO ji = 1, endloop
-                       iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
-                       ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
-                     END DO
-                  END DO
-               END DO; END DO
-               IF((nimpp + jpi - 1) .eq. jpiglo) THEN
-                  DO jl = 1, ipl; DO jk = 1, ipk
-                     DO jj = 1, nn_hls
-                        ijj = jpj -jj +1
-                        DO ii = 1, nn_hls
-			   iij = jpi -ii+1
-                     	   ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl,jf)
-                        END DO
-                     END DO
-                  END DO; END DO
-               ENDIF
-               !
-               IF ( .NOT. l_fast_exchanges ) THEN
-                  IF( nimpp + jpi - 1 /= jpiglo ) THEN
-                     endloop = jpi
-                  ELSE
-                     endloop = jpi - nn_hls
-                  ENDIF
-                  IF( nimpp >= Ni0glo/2+2 ) THEN
-                     startloop = 1 
-                  ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
-                     startloop = Ni0glo/2+2 - nimpp + nn_hls
-                  ELSE
-                     startloop = endloop + 1
-                  ENDIF
-                  IF( startloop <= endloop ) THEN
-                     DO jl = 1, ipl; DO jk = 1, ipk
-                        DO ji = startloop, endloop
-                           iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
-                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf)
-                        END DO
-                     END DO; END DO
-                  ENDIF
-               ENDIF
-               !
-            END SELECT
-            !
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            WRITE(*,*) 'lbc_nfd_nogather_generic: You should not have seen this print! error?', npolj
-            !
-         END SELECT     !  npolj
-         !
-      END DO            ! End jf loop
-   END SUBROUTINE ROUTINE_NFD
-#undef PRECISION
-#undef ARRAY_TYPE
-#undef ARRAY_IN
-#undef NAT_IN
-#undef SGN_IN
-#undef J_SIZE
-#undef K_SIZE
-#undef L_SIZE
-#undef F_SIZE
-#undef ARRAY2_TYPE
-#undef ARRAY2_IN
