Ignore:
Timestamp:
2018-12-19T22:54:16+01:00 (2 years ago)
Author:
smasson
Message:

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/LBC/lbc_nfd_nogather_generic.h90

    r10068 r10425  
    88#      define K_SIZE(ptab)             1 
    99#      define L_SIZE(ptab)             1 
    10 #      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_2D),INTENT(inout)::ptab2(f) 
    11 #      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt2d(i,j) 
    1210#   endif 
    1311#   if defined DIM_3d 
     
    1614#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
    1715#      define L_SIZE(ptab)             1 
    18 #      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_3D),INTENT(inout)::ptab2(f) 
    19 #      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt3d(i,j,k) 
    2016#   endif 
    2117#   if defined DIM_4d 
     
    2420#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
    2521#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
    26 #      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D),INTENT(inout)::ptab2(f) 
    27 #      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l) 
    28 #   endif 
     22#   endif 
     23#   define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D),INTENT(inout)::ptab2(f) 
     24#   define J_SIZE(ptab2)            SIZE(ptab2(1)%pt4d,2) 
     25#   define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l) 
    2926#else 
    3027!                          !==  IN: ptab is an array  ==! 
     
    3633#      define K_SIZE(ptab)          1 
    3734#      define L_SIZE(ptab)          1 
    38 #      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j) 
    3935#   endif 
    4036#   if defined DIM_3d 
     
    4238#      define K_SIZE(ptab)          SIZE(ptab,3) 
    4339#      define L_SIZE(ptab)          1 
    44 #      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k) 
    4540#   endif 
    4641#   if defined DIM_4d 
     
    4843#      define K_SIZE(ptab)          SIZE(ptab,3) 
    4944#      define L_SIZE(ptab)          SIZE(ptab,4) 
    50 #      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k,l) 
    51 #   endif 
     45#   endif 
     46#   define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k,l) 
     47#   define J_SIZE(ptab2)             SIZE(ptab2,2) 
    5248#   define ARRAY_TYPE(i,j,k,l,f)     REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    5349#   define ARRAY2_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 
     
    6965      INTEGER  ::    ji,  jj,   jk,     jl,   jh,  jf   ! dummy loop indices 
    7066      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf        ! dimension of the input array 
    71       INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 
     67      INTEGER  ::   ijt, iju, ijpj, ijpjp1, ijta, ijua, jia, startloop, endloop 
     68      LOGICAL  ::   l_fast_exchanges 
    7269      !!---------------------------------------------------------------------- 
    73       ipk = K_SIZE(ptab)   ! 3rd dimension 
     70      ipj = J_SIZE(ptab2)  ! 2nd dimension of input array 
     71      ipk = K_SIZE(ptab)   ! 3rd dimension of output array 
    7472      ipl = L_SIZE(ptab)   ! 4th    - 
    7573      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    7674      ! 
     75      ! Security check for further developments 
     76      IF ( ipf > 1 ) THEN 
     77        write(6,*) 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation'  
     78        write(6,*) 'You should not be there...'  
     79        STOP 
     80      ENDIF 
    7781      ! 
    78       SELECT CASE ( jpni ) 
    79       CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction 
    80       CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction 
    81       END SELECT 
    82       ijpjm1 = ijpj-1 
    83       ! 
     82      ijpj   = 1    ! index of first modified line  
     83      ijpjp1 = 2    ! index + 1 
     84       
     85      ! 2nd dimension determines exchange speed 
     86      IF (ipj == 1 ) THEN 
     87        l_fast_exchanges = .TRUE. 
     88      ELSE 
     89        l_fast_exchanges = .FALSE. 
     90      ENDIF 
    8491      ! 
    8592      DO jf = 1, ipf                      ! Loop over the number of arrays to be processed 
     
    96103               ENDIF 
    97104               ! 
    98                DO ji = startloop, nlci 
    99                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    100                   ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf) 
    101                END DO 
     105               DO jl = 1, ipl; DO jk = 1, ipk 
     106                  DO ji = startloop, nlci 
     107                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     108                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
     109                  END DO 
     110               END DO; END DO 
    102111               IF( nimpp == 1 ) THEN 
    103                   ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-2,:,:,jf) 
    104                ENDIF 
    105                ! 
    106                IF( nimpp >= jpiglo/2+1 ) THEN 
    107                   startloop = 1 
    108                ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    109                   startloop = jpiglo/2+1 - nimpp + 1 
    110                ELSE 
    111                   startloop = nlci + 1 
    112                ENDIF 
    113                IF( startloop <= nlci ) THEN 
    114                   DO ji = startloop, nlci 
    115                      ijt  = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    116                      jia  = ji + nimpp - 1 
    117                      ijta = jpiglo - jia + 2 
    118                      IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 
    119                         ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,ijpjm1,:,:,jf) 
    120                      ELSE 
    121                         ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf) 
    122                      ENDIF 
    123                   END DO 
    124                ENDIF 
    125                ! 
     112                  DO jl = 1, ipl; DO jk = 1, ipk 
     113                     ARRAY_IN(1,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-2,jk,jl,jf) 
     114                  END DO; END DO 
     115               ENDIF 
     116               ! 
     117               IF ( .NOT. l_fast_exchanges ) THEN 
     118                  IF( nimpp >= jpiglo/2+1 ) THEN 
     119                     startloop = 1 
     120                  ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
     121                     startloop = jpiglo/2+1 - nimpp + 1 
     122                  ELSE 
     123                     startloop = nlci + 1 
     124                  ENDIF 
     125                  IF( startloop <= nlci ) THEN 
     126                     DO jl = 1, ipl; DO jk = 1, ipk 
     127                        DO ji = startloop, nlci 
     128                           ijt  = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     129                           jia  = ji + nimpp - 1 
     130                           ijta = jpiglo - jia + 2 
     131                           IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 
     132                              ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,nlcj-1,jk,jl,jf) 
     133                           ELSE 
     134                              ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 
     135                           ENDIF 
     136                        END DO 
     137                     END DO; END DO 
     138                  ENDIF 
     139               ENDIF 
     140 
    126141            CASE ( 'U' )                                     ! U-point 
    127142               IF( nimpp + nlci - 1 /= jpiglo ) THEN 
     
    130145                  endloop = nlci - 1 
    131146               ENDIF 
    132                DO ji = 1, endloop 
    133                   iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    134                         ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf) 
    135                END DO 
     147               DO jl = 1, ipl; DO jk = 1, ipk 
     148                  DO ji = 1, endloop 
     149                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     150                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
     151                  END DO 
     152               END DO; END DO 
    136153               IF (nimpp .eq. 1) THEN 
    137                         ARRAY_IN(   1  ,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-2,:,:,jf) 
     154                  ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 
    138155               ENDIF 
    139156               IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    140                         ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf) 
    141                ENDIF 
    142                ! 
    143                IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    144                   endloop = nlci 
    145                ELSE 
    146                   endloop = nlci - 1 
    147                ENDIF 
    148                IF( nimpp >= jpiglo/2 ) THEN 
    149                   startloop = 1 
    150                   ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 
    151                   startloop = jpiglo/2 - nimpp + 1 
    152                ELSE 
    153                   startloop = endloop + 1 
    154                ENDIF 
    155                IF( startloop <= endloop ) THEN 
    156                DO ji = startloop, endloop 
    157                   iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    158                   jia = ji + nimpp - 1 
    159                   ijua = jpiglo - jia + 1 
    160                   IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 
    161                            ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,ijpjm1,:,:,jf) 
    162                   ELSE 
    163                            ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf) 
    164                   ENDIF 
    165                END DO 
     157                  ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 
     158               ENDIF 
     159               ! 
     160               IF ( .NOT. l_fast_exchanges ) THEN 
     161                  IF( nimpp + nlci - 1 /= jpiglo ) THEN 
     162                     endloop = nlci 
     163                  ELSE 
     164                     endloop = nlci - 1 
     165                  ENDIF 
     166                  IF( nimpp >= jpiglo/2 ) THEN 
     167                     startloop = 1 
     168                     ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 
     169                     startloop = jpiglo/2 - nimpp + 1 
     170                  ELSE 
     171                     startloop = endloop + 1 
     172                  ENDIF 
     173                  IF( startloop <= endloop ) THEN 
     174                  DO jl = 1, ipl; DO jk = 1, ipk 
     175                     DO ji = startloop, endloop 
     176                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     177                        jia = ji + nimpp - 1 
     178                        ijua = jpiglo - jia + 1 
     179                        IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 
     180                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,nlcj-1,jk,jl,jf) 
     181                        ELSE 
     182                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 
     183                        ENDIF 
     184                     END DO 
     185                  END DO; END DO 
     186                  ENDIF 
    166187               ENDIF 
    167188               ! 
     
    172193                 startloop = 2 
    173194               ENDIF 
    174                DO ji = startloop, nlci 
    175                  ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    176                         ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf) 
    177                         ARRAY_IN(ji,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-3,:,:,jf) 
    178                END DO 
     195               IF ( .NOT. l_fast_exchanges ) THEN 
     196                  DO jl = 1, ipl; DO jk = 1, ipk 
     197                     DO ji = startloop, nlci 
     198                        ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     199                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 
     200                     END DO 
     201                  END DO; END DO 
     202               ENDIF 
     203               DO jl = 1, ipl; DO jk = 1, ipk 
     204                  DO ji = startloop, nlci 
     205                     ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     206                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
     207                  END DO 
     208               END DO; END DO 
    179209               IF (nimpp .eq. 1) THEN 
    180                         ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-3,:,:,jf) 
     210                  ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-3,:,:,jf) 
    181211               ENDIF 
    182212            CASE ( 'F' )                                     ! F-point 
     
    186216                  endloop = nlci - 1 
    187217               ENDIF 
    188                DO ji = 1, endloop 
    189                   iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    190                         ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf) 
    191                         ARRAY_IN(ji,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-3,:,:,jf) 
    192                END DO 
     218               IF ( .NOT. l_fast_exchanges ) THEN 
     219                  DO jl = 1, ipl; DO jk = 1, ipk 
     220                     DO ji = 1, endloop 
     221                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     222                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 
     223                     END DO 
     224                  END DO; END DO 
     225               ENDIF 
     226               DO jl = 1, ipl; DO jk = 1, ipk 
     227                  DO ji = 1, endloop 
     228                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     229                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
     230                  END DO 
     231               END DO; END DO 
    193232               IF (nimpp .eq. 1) THEN 
    194                         ARRAY_IN(   1  ,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-3,:,:,jf) 
    195                         ARRAY_IN(   1  ,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-2,:,:,jf) 
     233                  ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-3,:,:,jf) 
     234                  IF ( .NOT. l_fast_exchanges ) & 
     235                     ARRAY_IN(1,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 
    196236               ENDIF 
    197237               IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    198                         ARRAY_IN(nlci,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-3,:,:,jf) 
    199                         ARRAY_IN(nlci,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf)  
    200                ENDIF 
    201                ! 
    202             CASE ( 'I' )                                     ! ice U-V point (I-point) 
    203                IF( nimpp /= 1 ) THEN 
    204                   startloop = 1 
    205                ELSE 
    206                   startloop = 3 
    207                   ARRAY_IN(2,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(3,ijpjm1,:,:,jf) 
    208                ENDIF 
    209                DO ji = startloop, nlci 
    210                   iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    211                   ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf) 
    212                END DO 
     238                  ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-3,:,:,jf) 
     239                  IF ( .NOT. l_fast_exchanges ) & 
     240                     ARRAY_IN(nlci,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 
     241               ENDIF 
     242               ! 
    213243            END SELECT 
    214244            ! 
     
    217247            SELECT CASE ( NAT_IN(jf) ) 
    218248            CASE ( 'T' , 'W' )                               ! T-, W-point 
    219                DO ji = 1, nlci 
    220                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    221                         ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-1,:,:,jf) 
    222                END DO 
     249               DO jl = 1, ipl; DO jk = 1, ipk 
     250                  DO ji = 1, nlci 
     251                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     252                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
     253                  END DO 
     254               END DO; END DO 
    223255               ! 
    224256            CASE ( 'U' )                                     ! U-point 
     
    228260                  endloop = nlci - 1 
    229261               ENDIF 
    230                DO ji = 1, endloop 
    231                   iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    232                         ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-1,:,:,jf) 
    233                END DO 
     262               DO jl = 1, ipl; DO jk = 1, ipk 
     263                  DO ji = 1, endloop 
     264                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     265                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
     266                  END DO 
     267               END DO; END DO 
    234268               IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    235                         ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-1,:,:,jf) 
     269                  DO jl = 1, ipl; DO jk = 1, ipk 
     270                     ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-1,jk,jl,jf) 
     271                  END DO; END DO 
    236272               ENDIF 
    237273               ! 
    238274            CASE ( 'V' )                                     ! V-point 
    239                DO ji = 1, nlci 
    240                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    241                         ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf) 
    242                END DO 
    243                   ! 
    244                IF( nimpp >= jpiglo/2+1 ) THEN 
    245                   startloop = 1 
    246                ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    247                   startloop = jpiglo/2+1 - nimpp + 1 
    248                ELSE 
    249                   startloop = nlci + 1 
    250                ENDIF 
    251                IF( startloop <= nlci ) THEN 
    252                DO ji = startloop, nlci 
    253                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    254                           ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf) 
    255                END DO 
     275               DO jl = 1, ipl; DO jk = 1, ipk 
     276                  DO ji = 1, nlci 
     277                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     278                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
     279                  END DO 
     280               END DO; END DO 
     281 
     282               IF ( .NOT. l_fast_exchanges ) THEN 
     283                  IF( nimpp >= jpiglo/2+1 ) THEN 
     284                     startloop = 1 
     285                  ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
     286                     startloop = jpiglo/2+1 - nimpp + 1 
     287                  ELSE 
     288                     startloop = nlci + 1 
     289                  ENDIF 
     290                  IF( startloop <= nlci ) THEN 
     291                  DO jl = 1, ipl; DO jk = 1, ipk 
     292                     DO ji = startloop, nlci 
     293                        ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     294                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 
     295                     END DO 
     296                  END DO; END DO 
     297                  ENDIF 
    256298               ENDIF 
    257299               ! 
     
    262304                  endloop = nlci - 1 
    263305               ENDIF 
    264                DO ji = 1, endloop 
    265                   iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    266                         ARRAY_IN(ji,ijpj ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf) 
    267                END DO 
     306               DO jl = 1, ipl; DO jk = 1, ipk 
     307                  DO ji = 1, endloop 
     308                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     309                     ARRAY_IN(ji,nlcj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
     310                  END DO 
     311               END DO; END DO 
    268312               IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    269                         ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-2,:,:,jf) 
    270                ENDIF 
    271                ! 
    272                IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    273                   endloop = nlci 
    274                ELSE 
    275                   endloop = nlci - 1 
    276                ENDIF 
    277                IF( nimpp >= jpiglo/2+1 ) THEN 
    278                   startloop = 1 
    279                ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    280                   startloop = jpiglo/2+1 - nimpp + 1 
    281                ELSE 
    282                   startloop = endloop + 1 
    283                ENDIF 
    284                IF( startloop <= endloop ) THEN 
    285                   DO ji = startloop, endloop 
    286                       iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    287                       ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf) 
    288                   END DO 
    289                ENDIF 
    290                ! 
    291             CASE ( 'I' )                                  ! ice U-V point (I-point) 
    292                IF( nimpp /= 1 ) THEN 
    293                   startloop = 1 
    294                ELSE 
    295                   startloop = 2 
    296                ENDIF 
    297                IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    298                   endloop = nlci 
    299                ELSE 
    300                   endloop = nlci - 1 
    301                ENDIF 
    302                DO ji = startloop , endloop 
    303                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    304                   ARRAY_IN(ji,ijpj,:,:,jf) = 0.5 * (ARRAY_IN(ji,ijpjm1,:,:,jf) + SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)) 
    305                END DO 
     313                  DO jl = 1, ipl; DO jk = 1, ipk 
     314                     ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-2,jk,jl,jf) 
     315                  END DO; END DO 
     316               ENDIF 
     317               ! 
     318               IF ( .NOT. l_fast_exchanges ) THEN 
     319                  IF( nimpp + nlci - 1 /= jpiglo ) THEN 
     320                     endloop = nlci 
     321                  ELSE 
     322                     endloop = nlci - 1 
     323                  ENDIF 
     324                  IF( nimpp >= jpiglo/2+1 ) THEN 
     325                     startloop = 1 
     326                  ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
     327                     startloop = jpiglo/2+1 - nimpp + 1 
     328                  ELSE 
     329                     startloop = endloop + 1 
     330                  ENDIF 
     331                  IF( startloop <= endloop ) THEN 
     332                     DO jl = 1, ipl; DO jk = 1, ipk 
     333                        DO ji = startloop, endloop 
     334                           iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     335                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 
     336                        END DO 
     337                     END DO; END DO 
     338                  ENDIF 
     339               ENDIF 
    306340               ! 
    307341            END SELECT 
     
    309343         CASE DEFAULT                           ! *  closed : the code probably never go through 
    310344            ! 
    311             SELECT CASE ( NAT_IN(jf)) 
    312             CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points 
    313                ARRAY_IN(:, 1  ,:,:,jf) = 0._wp 
    314                ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 
    315             CASE ( 'F' )                                   ! F-point 
    316                ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 
    317             CASE ( 'I' )                                   ! ice U-V point 
    318                ARRAY_IN(:, 1  ,:,:,jf) = 0._wp 
    319                ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 
    320             END SELECT 
     345            WRITE(*,*) 'lbc_nfd_nogather_generic: You should not have seen this print! error?', npolj 
    321346            ! 
    322347         END SELECT     !  npolj 
     
    328353#undef NAT_IN 
    329354#undef SGN_IN 
     355#undef J_SIZE 
    330356#undef K_SIZE 
    331357#undef L_SIZE 
Note: See TracChangeset for help on using the changeset viewer.