source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lbc_north_icb_generic.h90 @ 13266

Last change on this file since 13266 was 13266, checked in by acc, 4 months ago

Extra_Halo: revert previous bugfix in mppini.F90 and fix, instead, the ordering and treatment of processors in the north-fold communicator. Now passes all SETTE including an extra version of ORCA2_ICE_PISCES, REPRO_8_4 with land-suppression and ln_nnogather=F. run.stat differences from trunk@13218 in ORCA2_ICE_PISCES associated with calving (REPRO tests which have ln_calving=F match). Also tracer.stat differences after 42 timesteps (unexplained).

File size: 4.3 KB
RevLine 
[12632]1# if defined SINGLE_PRECISION
2#    define PRECISION sp
3#    define SENDROUTINE mppsend_sp
4#    define RECVROUTINE mpprecv_sp
5#    define MPI_TYPE MPI_REAL
6# else
7#    define PRECISION dp
8#    define SENDROUTINE mppsend_dp
9#    define RECVROUTINE mpprecv_dp
10#    define MPI_TYPE MPI_DOUBLE_PRECISION
11# endif
12
13   SUBROUTINE ROUTINE_LNK( pt2d, cd_type, psgn, kextj)
14      !!---------------------------------------------------------------------
15      !!                   ***  routine mpp_lbc_north_icb  ***
16      !!
17      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
18      !!              in mpp configuration in case of jpn1 > 1 and for 2d
19      !!              array with outer extra halo
20      !!
21      !! ** Method  :   North fold condition and mpp with more than one proc
22      !!              in i-direction require a specific treatment. We gather
23      !!              the 4+kextj northern lines of the global domain on 1
24      !!              processor and apply lbc north-fold on this sub array.
25      !!              Then we scatter the north fold array back to the processors.
26      !!              This routine accounts for an extra halo with icebergs
27      !!              and assumes ghost rows and columns have been suppressed.
28      !!
29      !!----------------------------------------------------------------------
30      REAL(PRECISION), DIMENSION(:,:), INTENT(inout) ::   pt2d     ! 2D array with extra halo
31      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
32      !                                                     !   = T ,  U , V , F or W -points
33      REAL(wp)                , INTENT(in   ) ::   psgn     ! = -1. the sign change across the
34      !!                                                    ! north fold, =  1. otherwise
35      INTEGER                 , INTENT(in   ) ::   kextj    ! Extra halo width at north fold
36      !
37      INTEGER ::   ji, jj, jr
[13266]38      INTEGER ::   ierr, itaille
39      INTEGER ::   ipj, ij, iproc, ijnr, ii1, ipi, impp
[12632]40      !
41      REAL(PRECISION), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
42      REAL(PRECISION), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
43      !!----------------------------------------------------------------------
44#if defined key_mpp_mpi
45      !
46      ipj=4
47      ALLOCATE(        ztab_e(jpiglo, 1-kextj:ipj+kextj)       ,       &
48     &            znorthloc_e(jpimax, 1-kextj:ipj+kextj)       ,       &
[13266]49     &          znorthgloio_e(jpimax, 1-kextj:ipj+kextj,ndim_rank_north)    )
[12632]50      !
[13221]51# if defined SINGLE_PRECISION
52      ztab_e(:,:)      = 0._sp
53      znorthloc_e(:,:) = 0._sp
54# else
55      ztab_e(:,:)      = 0._dp
56      znorthloc_e(:,:) = 0._dp
57# endif
[12632]58      !
59      ij = 1 - kextj
60      ! put the last ipj+2*kextj lines of pt2d into znorthloc_e
61      DO jj = jpj - ipj + 1 - kextj , jpj + kextj
62         znorthloc_e(1:jpi,ij)=pt2d(1:jpi,jj)
63         ij = ij + 1
64      END DO
65      !
66      itaille = jpimax * ( ipj + 2*kextj )
67      !
68      IF( ln_timing ) CALL tic_tac(.TRUE.)
69      CALL MPI_ALLGATHER( znorthloc_e(1,1-kextj)    , itaille, MPI_TYPE,    &
70         &                znorthgloio_e(1,1-kextj,1), itaille, MPI_TYPE,    &
71         &                ncomm_north, ierr )
72      !
73      IF( ln_timing ) CALL tic_tac(.FALSE.)
74      !
[13266]75      ijnr = 0
[12632]76      DO jr = 1, ndim_rank_north            ! recover the global north array
[13266]77         iproc = nfproc(jr)
78         IF( iproc /= -1 ) THEN
79            impp = nfimpp(jr)
80            ipi  = nfjpi(jr)
81            ijnr = ijnr + 1
82            DO jj = 1-kextj, ipj+kextj
83               DO ji = 1, ipi
84                  ii1 = impp + ji - 1       ! corresponds to mig(ji) but for subdomain iproc
85                  ztab_e(ii1,jj) = znorthgloio_e(ji,jj,ijnr)
86               END DO
[12632]87            END DO
[13266]88         ENDIF
[12632]89      END DO
90
91      ! 2. North-Fold boundary conditions
92      ! ----------------------------------
93      CALL lbc_nfd( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj )
94
95      ij = 1 - kextj
96      !! Scatter back to pt2d
97      DO jj = jpj - ipj + 1 - kextj , jpj + kextj
98         DO ji= 1, jpi
99            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
100         END DO
101         ij  = ij +1
102      END DO
103      !
104      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
105      !
106#endif
107   END SUBROUTINE ROUTINE_LNK
108
109#    undef PRECISION
110#    undef SENDROUTINE
111#    undef RECVROUTINE
112#    undef MPI_TYPE
Note: See TracBrowser for help on using the repository browser.