New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14433 for NEMO/trunk/src/OCE/LBC/lbc_nfd_ext_generic.h90 – NEMO

Ignore:
Timestamp:
2021-02-11T09:06:49+01:00 (3 years ago)
Author:
smasson
Message:

trunk: merge dev_r14312_MPI_Interface into the trunk, #2598

File:
1 edited

Legend:

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

    r13286 r14433  
    1 !                          !==  IN: ptab is an array  ==! 
    2 #define NAT_IN(k)                cd_nat 
    3 #define SGN_IN(k)                psgn 
    4 #define F_SIZE(ptab)             1 
    5 #if defined DIM_2d 
    6 #   define ARRAY_IN(i,j,k,l,f)   ptab(i,j) 
    7 #   define K_SIZE(ptab)          1 
    8 #   define L_SIZE(ptab)          1 
    9 #endif 
    10 #if defined SINGLE_PRECISION 
    11 #   define ARRAY_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    12 #   define PRECISION sp 
    13 #else 
    14 #   define ARRAY_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    15 #   define PRECISION dp 
    16 #endif 
    171 
    18    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj ) 
     2   SUBROUTINE lbc_nfd_ext_/**/PRECISION( ptab, cd_nat, psgn, kextj ) 
    193      !!---------------------------------------------------------------------- 
    20       INTEGER          , INTENT(in   ) ::   kextj       ! extra halo width at north fold, declared before its use in ARRAY_TYPE 
    21       ARRAY_TYPE(:,1-kextj:,:,:,:)                      ! array or pointer of arrays on which the boundary condition is applied 
    22       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    23       REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     4      REAL(PRECISION), DIMENSION(:,1-kextj:),INTENT(inout) ::   ptab 
     5      CHARACTER(len=1), INTENT(in   ) ::   cd_nat      ! nature of array grid-points 
     6      REAL(PRECISION),  INTENT(in   ) ::   psgn        ! sign used across the north fold boundary 
     7      INTEGER,          INTENT(in   ) ::   kextj       ! extra halo width at north fold 
    248      ! 
    25       INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices 
    26       INTEGER  ::   ipi, ipj, ipk, ipl,     ipf   ! dimension of the input array 
     9      INTEGER  ::    ji,  jj,  jh   ! dummy loop indices 
     10      INTEGER  ::   ipj 
    2711      INTEGER  ::   ijt, iju, ipjm1 
    2812      !!---------------------------------------------------------------------- 
    29       ! 
    30       ipk = K_SIZE(ptab)   ! 3rd dimension 
    31       ipl = L_SIZE(ptab)   ! 4th    - 
    32       ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    33       ! 
    3413      ! 
    3514      SELECT CASE ( jpni ) 
     
    3918      ! 
    4019      ipjm1 = ipj-1 
     20      ! 
     21      IF( c_NFtype == 'T' ) THEN            ! *  North fold  T-point pivot 
     22         ! 
     23         SELECT CASE ( cd_nat  ) 
     24         CASE ( 'T' , 'W' )                         ! T-, W-point 
     25            DO jh = 0, kextj 
     26               DO ji = 2, jpiglo 
     27                  ijt = jpiglo-ji+2 
     28                  ptab(ji,ipj+jh) = psgn * ptab(ijt,ipj-2-jh) 
     29               END DO 
     30               ptab(1,ipj+jh) = psgn * ptab(3,ipj-2-jh) 
     31            END DO 
     32            DO ji = jpiglo/2+1, jpiglo 
     33               ijt = jpiglo-ji+2 
     34               ptab(ji,ipjm1) = psgn * ptab(ijt,ipjm1) 
     35            END DO 
     36         CASE ( 'U' )                               ! U-point 
     37            DO jh = 0, kextj 
     38               DO ji = 2, jpiglo-1 
     39                  iju = jpiglo-ji+1 
     40                  ptab(ji,ipj+jh) = psgn * ptab(iju,ipj-2-jh) 
     41               END DO 
     42               ptab(   1  ,ipj+jh) = psgn * ptab(    2   ,ipj-2-jh) 
     43               ptab(jpiglo,ipj+jh) = psgn * ptab(jpiglo-1,ipj-2-jh)  
     44            END DO 
     45            DO ji = jpiglo/2, jpiglo-1 
     46               iju = jpiglo-ji+1 
     47               ptab(ji,ipjm1) = psgn * ptab(iju,ipjm1) 
     48            END DO 
     49         CASE ( 'V' )                               ! V-point 
     50            DO jh = 0, kextj 
     51               DO ji = 2, jpiglo 
     52                  ijt = jpiglo-ji+2 
     53                  ptab(ji,ipj-1+jh) = psgn * ptab(ijt,ipj-2-jh) 
     54                  ptab(ji,ipj+jh  ) = psgn * ptab(ijt,ipj-3-jh) 
     55               END DO 
     56               ptab(1,ipj+jh) = psgn * ptab(3,ipj-3-jh)  
     57            END DO 
     58         CASE ( 'F' )                               ! F-point 
     59            DO jh = 0, kextj 
     60               DO ji = 1, jpiglo-1 
     61                  iju = jpiglo-ji+1 
     62                  ptab(ji,ipj-1+jh) = psgn * ptab(iju,ipj-2-jh) 
     63                  ptab(ji,ipj+jh  ) = psgn * ptab(iju,ipj-3-jh) 
     64               END DO 
     65            END DO 
     66            DO jh = 0, kextj 
     67               ptab(   1  ,ipj+jh) = psgn * ptab(    2   ,ipj-3-jh) 
     68               ptab(jpiglo,ipj+jh) = psgn * ptab(jpiglo-1,ipj-3-jh) 
     69            END DO 
     70         END SELECT 
     71         ! 
     72      ENDIF   ! c_NFtype == 'T' 
     73      ! 
     74      IF( c_NFtype == 'F' ) THEN            ! *  North fold  F-point pivot 
     75         ! 
     76         SELECT CASE ( cd_nat  ) 
     77         CASE ( 'T' , 'W' )                         ! T-, W-point 
     78            DO jh = 0, kextj 
     79               DO ji = 1, jpiglo 
     80                  ijt = jpiglo-ji+1 
     81                  ptab(ji,ipj+jh) = psgn * ptab(ijt,ipj-1-jh) 
     82               END DO 
     83            END DO 
     84         CASE ( 'U' )                               ! U-point 
     85            DO jh = 0, kextj 
     86               DO ji = 1, jpiglo-1 
     87                  iju = jpiglo-ji 
     88                  ptab(ji,ipj+jh) = psgn * ptab(iju,ipj-1-jh) 
     89               END DO 
     90               ptab(jpiglo,ipj+jh) = psgn * ptab(jpiglo-2,ipj-1-jh) 
     91            END DO 
     92         CASE ( 'V' )                               ! V-point 
     93            DO jh = 0, kextj 
     94               DO ji = 1, jpiglo 
     95                  ijt = jpiglo-ji+1 
     96                  ptab(ji,ipj+jh) = psgn * ptab(ijt,ipj-2-jh) 
     97               END DO 
     98            END DO 
     99            DO ji = jpiglo/2+1, jpiglo 
     100               ijt = jpiglo-ji+1 
     101               ptab(ji,ipjm1) = psgn * ptab(ijt,ipjm1) 
     102            END DO 
     103         CASE ( 'F' )                               ! F-point 
     104            DO jh = 0, kextj 
     105               DO ji = 1, jpiglo-1 
     106                  iju = jpiglo-ji 
     107                  ptab(ji,ipj+jh  ) = psgn * ptab(iju,ipj-2-jh) 
     108               END DO 
     109               ptab(jpiglo,ipj+jh) = psgn * ptab(jpiglo-2,ipj-2-jh) 
     110            END DO 
     111            DO ji = jpiglo/2+1, jpiglo-1 
     112               iju = jpiglo-ji 
     113               ptab(ji,ipjm1) = psgn * ptab(iju,ipjm1) 
     114            END DO 
     115         END SELECT 
     116         ! 
     117      ENDIF   ! c_NFtype == 'F' 
     118      ! 
     119   END SUBROUTINE lbc_nfd_ext_/**/PRECISION 
    41120 
    42       ! 
    43       DO jf = 1, ipf                      ! Loop on the number of arrays to be treated 
    44          ! 
    45          SELECT CASE ( npolj ) 
    46          ! 
    47          CASE ( 3 , 4 )                        ! *  North fold  T-point pivot 
    48             ! 
    49             SELECT CASE ( NAT_IN(jf)  ) 
    50             CASE ( 'T' , 'W' )                         ! T-, W-point 
    51                DO jh = 0, kextj 
    52                   DO ji = 2, jpiglo 
    53                      ijt = jpiglo-ji+2 
    54                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf) 
    55                   END DO 
    56                   ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2-jh,:,:,jf) 
    57                END DO 
    58                DO ji = jpiglo/2+1, jpiglo 
    59                   ijt = jpiglo-ji+2 
    60                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf) 
    61                END DO 
    62             CASE ( 'U' )                               ! U-point 
    63                DO jh = 0, kextj 
    64                   DO ji = 2, jpiglo-1 
    65                      iju = jpiglo-ji+1 
    66                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf) 
    67                   END DO 
    68                  ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2-jh,:,:,jf) 
    69                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2-jh,:,:,jf)  
    70                END DO 
    71                DO ji = jpiglo/2, jpiglo-1 
    72                   iju = jpiglo-ji+1 
    73                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf) 
    74                END DO 
    75             CASE ( 'V' )                               ! V-point 
    76                DO jh = 0, kextj 
    77                   DO ji = 2, jpiglo 
    78                      ijt = jpiglo-ji+2 
    79                      ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf) 
    80                      ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3-jh,:,:,jf) 
    81                   END DO 
    82                   ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3-jh,:,:,jf)  
    83                END DO 
    84             CASE ( 'F' )                               ! F-point 
    85                DO jh = 0, kextj 
    86                   DO ji = 1, jpiglo-1 
    87                      iju = jpiglo-ji+1 
    88                      ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf) 
    89                      ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3-jh,:,:,jf) 
    90                   END DO 
    91                END DO 
    92                DO jh = 0, kextj 
    93                   ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3-jh,:,:,jf) 
    94                   ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf) 
    95                END DO 
    96             END SELECT 
    97             ! 
    98          CASE ( 5 , 6 )                        ! *  North fold  F-point pivot 
    99             ! 
    100             SELECT CASE ( NAT_IN(jf)  ) 
    101             CASE ( 'T' , 'W' )                         ! T-, W-point 
    102                DO jh = 0, kextj 
    103                   DO ji = 1, jpiglo 
    104                      ijt = jpiglo-ji+1 
    105                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1-jh,:,:,jf) 
    106                   END DO 
    107                END DO 
    108             CASE ( 'U' )                               ! U-point 
    109                DO jh = 0, kextj 
    110                   DO ji = 1, jpiglo-1 
    111                      iju = jpiglo-ji 
    112                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1-jh,:,:,jf) 
    113                   END DO 
    114                   ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-1-jh,:,:,jf) 
    115                END DO 
    116             CASE ( 'V' )                               ! V-point 
    117                DO jh = 0, kextj 
    118                   DO ji = 1, jpiglo 
    119                      ijt = jpiglo-ji+1 
    120                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf) 
    121                   END DO 
    122                END DO 
    123                DO ji = jpiglo/2+1, jpiglo 
    124                   ijt = jpiglo-ji+1 
    125                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf) 
    126                END DO 
    127             CASE ( 'F' )                               ! F-point 
    128                DO jh = 0, kextj 
    129                   DO ji = 1, jpiglo-1 
    130                      iju = jpiglo-ji 
    131                      ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf) 
    132                   END DO 
    133                   ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-2-jh,:,:,jf) 
    134                END DO 
    135                DO ji = jpiglo/2+1, jpiglo-1 
    136                   iju = jpiglo-ji 
    137                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf) 
    138                END DO 
    139             END SELECT 
    140             ! 
    141          CASE DEFAULT                           ! *  closed : the code probably never go through 
    142             ! 
    143             SELECT CASE ( NAT_IN(jf) ) 
    144             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    145                ARRAY_IN(:,  1:1-kextj  ,:,:,jf) = 0._wp 
    146                ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp 
    147             CASE ( 'F' )                               ! F-point 
    148                ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp 
    149             END SELECT 
    150             ! 
    151          END SELECT     !  npolj 
    152          ! 
    153       END DO 
    154       ! 
    155    END SUBROUTINE ROUTINE_NFD 
    156  
    157 #undef PRECISION 
    158 #undef ARRAY_TYPE 
    159 #undef ARRAY_IN 
    160 #undef NAT_IN 
    161 #undef SGN_IN 
    162 #undef K_SIZE 
    163 #undef L_SIZE 
    164 #undef F_SIZE 
Note: See TracChangeset for help on using the changeset viewer.