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.
halo_mng.F90 in NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC – NEMO

source: NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC/halo_mng.F90 @ 13630

Last change on this file since 13630 was 13630, checked in by mocavero, 4 years ago

Add neighborhood collectives calls in the NEMO src - ticket #2496
File size: 6.1 KB
Line 
1MODULE halo_mng
2   !!======================================================================
3   !!                       ***  MODULE  halo_mng  ***
4   !! Ocean numerics:  massively parallel processing library
5   !!=====================================================================
6   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)
7   !Original code
8   !!            4.0  !  2019  (CMCC - ASC)  initial version of halo management module
9   !in_out_manager
10   !!----------------------------------------------------------------------
11
12   USE dom_oce       ! ocean space and time domain
13   USE lbclnk        ! ocean lateral boundary condition (or mpp link)
14
15   IMPLICIT NONE
16   PRIVATE
17
18   INTERFACE halo_mng_resize
19      MODULE PROCEDURE halo_mng_resize_2D, halo_mng_resize_3D, halo_mng_resize_4D, halo_mng_resize_5D
20   END INTERFACE
21
22   PUBLIC halo_mng_resize
23   PUBLIC halo_mng_init
24   PUBLIC halo_mng_set
25
26   INTEGER :: jpi_1, jpj_1
27   INTEGER :: jpimax_1, jpjmax_1
28   INTEGER :: Nis0_1, Njs0_1
29   INTEGER :: Nie0_1, Nje0_1
30CONTAINS
31
32   SUBROUTINE halo_mng_init( )
33
34        jpi_1 = jpi
35        jpj_1 = jpj
36
37        Nis0_1 = Nis0
38        Njs0_1 = Njs0
39
40        Nie0_1 = Nie0
41        Nje0_1 = Nje0
42
43      jpimax_1 = jpimax
44      jpjmax_1 = jpjmax
45
46   END SUBROUTINE halo_mng_init
47
48   SUBROUTINE halo_mng_set( khls )
49   
50        INTEGER, INTENT(in   )    ::   khls
51
52        nn_hls = khls
53
54        jpi = jpi_1 + 2*khls -2
55        jpj = jpj_1 + 2*khls -2
56
57        jpi = jpi_1 + 2*khls -2
58        jpj = jpj_1 + 2*khls -2
59       
60        jpimax = jpimax_1 + 2*khls -2
61        jpjmax = jpjmax_1 + 2*khls -2
62
63        Nis0 = Nis0_1 + khls - 1
64        Njs0 = Njs0_1 + khls - 1
65
66        Nie0 = Nie0_1 + khls - 1
67        Nje0 = Nje0_1 + khls - 1
68
69   END SUBROUTINE halo_mng_set
70   
71   SUBROUTINE halo_mng_resize_2D(pta, cdna, psgn, fillval)
72   
73      REAL(wp), POINTER, DIMENSION(:,:) :: pta
74      CHARACTER(len=1), INTENT(in)  :: cdna
75      REAL(wp), INTENT(in)  :: psgn
76      REAL(wp), OPTIONAL, INTENT(in ) :: fillval
77      REAL(wp), POINTER, DIMENSION(:,:) :: zpta
78      INTEGER :: offset
79      INTEGER :: pta_size_i, pta_size_j
80
81      pta_size_i = SIZE(pta,1)
82      pta_size_j = SIZE(pta,2)
83     
84      ! check if the current size of pta is equal to the current expected dimension
85      IF (pta_size_i .ne. jpi) THEN
86         ALLOCATE (zpta(jpi, jpj))
87         offset = abs((jpi - pta_size_i) / 2) 
88
89         IF (pta_size_i .lt. jpi) THEN
90            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j) = pta
91         ELSE
92            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj)
93         END IF
94#if defined key_mpi3
95         CALL lbc_lnk_nc_multi( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval)
96#else
97         CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval)
98#endif
99         DEALLOCATE(pta)
100         pta => zpta
101      END IF
102     
103   END SUBROUTINE halo_mng_resize_2D
104
105   SUBROUTINE halo_mng_resize_3D(pta, cdna, psgn, fillval)
106   
107      REAL(wp), POINTER, DIMENSION(:,:,:) :: pta
108      CHARACTER(len=1), INTENT(in)  :: cdna
109      REAL(wp), INTENT(in)  :: psgn
110      REAL(wp), OPTIONAL, INTENT(in ) :: fillval
111      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta
112      INTEGER :: offset
113      INTEGER :: pta_size_i, pta_size_j
114
115      pta_size_i = SIZE(pta,1)
116      pta_size_j = SIZE(pta,2)
117     
118      ! check if the current size of pta is equal to the current expected dimension
119      IF (pta_size_i .ne. jpi) THEN
120         ALLOCATE (zpta(jpi, jpj, jpk))
121         offset = abs((jpi - pta_size_i) / 2) 
122
123         IF (pta_size_i .lt. jpi) THEN
124            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :) = pta
125         ELSE
126            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :)
127         END IF
128#if defined key_mpi3
129         CALL lbc_lnk_nc_multi( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval)
130#else
131         CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval)
132#endif
133         DEALLOCATE(pta)
134         pta => zpta
135      END IF
136     
137   END SUBROUTINE halo_mng_resize_3D
138
139   SUBROUTINE halo_mng_resize_4D(pta, cdna, psgn, fillval, fjpt)
140   
141      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: pta
142      CHARACTER(len=1), INTENT(in)  :: cdna
143      REAL(wp), INTENT(in)  :: psgn
144      REAL(wp), OPTIONAL, INTENT(in) :: fillval
145      INTEGER , INTENT(in) ::   fjpt 
146      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta
147      INTEGER :: offset
148      INTEGER :: pta_size_i, pta_size_j
149
150      pta_size_i = SIZE(pta,1)
151      pta_size_j = SIZE(pta,2)
152     
153      ! check if the current size of pta is equal to the current expected dimension
154      IF (pta_size_i .ne. jpi) THEN
155         ALLOCATE (zpta(jpi, jpj, jpk, jpt))
156         offset = abs((jpi - pta_size_i) / 2) 
157
158         IF (pta_size_i .lt. jpi) THEN
159            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :) = pta
160         ELSE
161            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :)
162         END IF
163#if defined key_mpi3
164         CALL lbc_lnk_nc_multi( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval)
165#else
166         CALL lbc_lnk( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval)
167#endif
168         DEALLOCATE(pta)
169         pta => zpta
170      END IF
171     
172   END SUBROUTINE halo_mng_resize_4D
173   
174   SUBROUTINE halo_mng_resize_5D(pta, cdna, psgn, fillval, kjpt, fjpt)
175   
176      REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: pta
177      CHARACTER(len=1), INTENT(in)  :: cdna
178      REAL(wp), INTENT(in)  :: psgn
179      REAL(wp), OPTIONAL, INTENT(in) :: fillval
180      INTEGER , OPTIONAL, INTENT(in) :: kjpt            ! number of tracers
181      INTEGER , INTENT(in) :: fjpt           
182      REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: zpta
183      INTEGER :: offset
184      INTEGER :: pta_size_i, pta_size_j
185
186      pta_size_i = SIZE(pta,1)
187      pta_size_j = SIZE(pta,2)
188     
189      ! check if the current size of pta is equal to the current expected dimension
190      IF (pta_size_i .ne. jpi) THEN
191         ALLOCATE (zpta(jpi, jpj, jpk, kjpt, jpt))
192         offset = abs((jpi - pta_size_i) / 2) 
193
194         IF (pta_size_i .lt. jpi) THEN
195            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :, :) = pta
196         ELSE
197            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :, :)
198         END IF
199#if defined key_mpi3
200         CALL lbc_lnk_nc_multi( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval)
201#else
202         CALL lbc_lnk( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval)
203#endif
204         DEALLOCATE(pta)
205         pta => zpta
206      END IF
207     
208   END SUBROUTINE halo_mng_resize_5D
209   
210END MODULE
Note: See TracBrowser for help on using the repository browser.