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_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC – NEMO

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/halo_mng.F90 @ 12807

Last change on this file since 12807 was 12807, checked in by smasson, 4 years ago

Extra_Halo: input file only over inner domain + new variables names, see #2366
File size: 5.6 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         CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval)
95         DEALLOCATE(pta)
96         pta => zpta
97      END IF
98     
99   END SUBROUTINE halo_mng_resize_2D
100
101   SUBROUTINE halo_mng_resize_3D(pta, cdna, psgn, fillval)
102   
103      REAL(wp), POINTER, DIMENSION(:,:,:) :: pta
104      CHARACTER(len=1), INTENT(in)  :: cdna
105      REAL(wp), INTENT(in)  :: psgn
106      REAL(wp), OPTIONAL, INTENT(in ) :: fillval
107      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta
108      INTEGER :: offset
109      INTEGER :: pta_size_i, pta_size_j
110
111      pta_size_i = SIZE(pta,1)
112      pta_size_j = SIZE(pta,2)
113     
114      ! check if the current size of pta is equal to the current expected dimension
115      IF (pta_size_i .ne. jpi) THEN
116         ALLOCATE (zpta(jpi, jpj, jpk))
117         offset = abs((jpi - pta_size_i) / 2) 
118
119         IF (pta_size_i .lt. jpi) THEN
120            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :) = pta
121         ELSE
122            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :)
123         END IF
124         CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval)
125         DEALLOCATE(pta)
126         pta => zpta
127      END IF
128     
129   END SUBROUTINE halo_mng_resize_3D
130
131   SUBROUTINE halo_mng_resize_4D(pta, cdna, psgn, fillval, fjpt)
132   
133      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: pta
134      CHARACTER(len=1), INTENT(in)  :: cdna
135      REAL(wp), INTENT(in)  :: psgn
136      REAL(wp), OPTIONAL, INTENT(in) :: fillval
137      INTEGER , INTENT(in) ::   fjpt 
138      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta
139      INTEGER :: offset
140      INTEGER :: pta_size_i, pta_size_j
141
142      pta_size_i = SIZE(pta,1)
143      pta_size_j = SIZE(pta,2)
144     
145      ! check if the current size of pta is equal to the current expected dimension
146      IF (pta_size_i .ne. jpi) THEN
147         ALLOCATE (zpta(jpi, jpj, jpk, jpt))
148         offset = abs((jpi - pta_size_i) / 2) 
149
150         IF (pta_size_i .lt. jpi) THEN
151            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :) = pta
152         ELSE
153            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :)
154         END IF
155         CALL lbc_lnk( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval)
156         DEALLOCATE(pta)
157         pta => zpta
158      END IF
159     
160   END SUBROUTINE halo_mng_resize_4D
161   
162   SUBROUTINE halo_mng_resize_5D(pta, cdna, psgn, fillval, kjpt, fjpt)
163   
164      REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: pta
165      CHARACTER(len=1), INTENT(in)  :: cdna
166      REAL(wp), INTENT(in)  :: psgn
167      REAL(wp), OPTIONAL, INTENT(in) :: fillval
168      INTEGER , OPTIONAL, INTENT(in) :: kjpt            ! number of tracers
169      INTEGER , INTENT(in) :: fjpt           
170      REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: zpta
171      INTEGER :: offset
172      INTEGER :: pta_size_i, pta_size_j
173
174      pta_size_i = SIZE(pta,1)
175      pta_size_j = SIZE(pta,2)
176     
177      ! check if the current size of pta is equal to the current expected dimension
178      IF (pta_size_i .ne. jpi) THEN
179         ALLOCATE (zpta(jpi, jpj, jpk, kjpt, jpt))
180         offset = abs((jpi - pta_size_i) / 2) 
181
182         IF (pta_size_i .lt. jpi) THEN
183            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :, :) = pta
184         ELSE
185            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :, :)
186         END IF
187         CALL lbc_lnk( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval)
188         DEALLOCATE(pta)
189         pta => zpta
190      END IF
191     
192   END SUBROUTINE halo_mng_resize_5D
193   
194END MODULE
Note: See TracBrowser for help on using the repository browser.