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/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/LBC – NEMO

source: NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/LBC/halo_mng.F90 @ 11720

Last change on this file since 11720 was 11720, checked in by francesca, 4 years ago

add halo managment file- ticket #2009

File size: 4.6 KB
RevLine 
[11720]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
14   IMPLICIT NONE
15   PRIVATE
16
17   INTERFACE halo_mng_copy
18      MODULE PROCEDURE halo_mng_copy_2D, halo_mng_copy_3d, halo_mng_copy_4d
19   END INTERFACE
20
21   PUBLIC halo_mng_copy
22   PUBLIC halo_mng_init
23   PUBLIC halo_mng_set
24
25   INTEGER :: jpi_1, jpj_1
26   INTEGER :: jpimax_1, jpjmax_1
27   INTEGER :: nlci_1, nlcj_1
28   INTEGER :: jplbi_1, jplbj_1
29CONTAINS
30
31   SUBROUTINE halo_mng_init( )
32
33        jpi_1 = jpi
34        jpj_1 = jpj
35
36        nlci_1 = nlci
37        nlcj_1 = nlcj
38
39        jplbi_1 = 1 
40        jplbj_1 = 1 
41       
42        jplbi = 1 
43        jplbj = 1 
44
45         jpimax_1 = jpimax
46         jpjmax_1 = jpjmax
47
48   END SUBROUTINE halo_mng_init
49
50   SUBROUTINE halo_mng_set( khls )
51   
52        INTEGER, INTENT(in   )    ::   khls
53
54        nn_hls = khls
55        jpi = jpi_1 + khls -1
56        jpj = jpj_1 + khls -1
57
58        nlci = nlci_1 + khls -1
59        nlcj = nlcj_1 + khls -1
60       
61        jplbi = jplbi_1 - khls +1 
62        jplbj = jplbj_1 - khls +1 
63       
64        jpimax = jpimax_1 + khls -1
65        jpjmax = jpjmax_1 + khls -1
66
67   END SUBROUTINE halo_mng_set
68   
69   SUBROUTINE halo_mng_copy_2D(pta_1, pta_2)
70      !!----------------------------------------------------------------------
71      !!                  ***  ROUTINE halo_mng_copy  ***
72      !!
73      !! ** Purpose : copy pta_1 into pta_2
74      !! ** Method  :
75      !! History :
76      !!   1.0  !  07-19  ( CMCC - ASC )  halo_mng_copy
77      !!----------------------------------------------------------------------
78       REAL(wp), DIMENSION(:,:), INTENT(in)  :: pta_1
79       REAL(wp), DIMENSION(:,:), INTENT(out)  :: pta_2
80       INTEGER :: halo, off1, off2
81       INTEGER, DIMENSION(2) :: dim
82
83       halo = (SIZE(pta_1,1) - SIZE(pta_2,1))/2
84       IF (halo < 0) THEN
85          off1 = 0
86          off2 = -halo
87          dim = SHAPE(pta_1)
88       ELSE
89          off1 = halo
90          off2 = 0
91          dim = SHAPE(pta_2)
92       END IF
93       
94       pta_2(1+off2:SIZE(pta_2,1)-off2, 1+off2:SIZE(pta_2,2)-off2) = pta_1(1+off1:SIZE(pta_1,1)-off1, 1+off1:SIZE(pta_1,2)-off1)
95       
96   
97   END SUBROUTINE halo_mng_copy_2D
98
99   SUBROUTINE halo_mng_copy_3D(pta_1, pta_2)
100      !!----------------------------------------------------------------------
101      !!                  ***  ROUTINE halo_mng_copy  ***
102      !!
103      !! ** Purpose : copy pta_1 into pta_2
104      !! ** Method  :
105      !! History :
106      !!   1.0  !  07-19  ( CMCC - ASC )  halo_mng_copy
107      !!----------------------------------------------------------------------
108       REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pta_1
109       REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pta_2
110
111       INTEGER :: halo, off1, off2
112       INTEGER, DIMENSION(3) :: dim
113
114       halo = (SIZE(pta_1,1) - SIZE(pta_2,1))/2
115       IF (halo < 0) THEN
116          off1 = 0
117          off2 = -halo
118          dim = SHAPE(pta_1)
119       ELSE
120          off1 = halo
121          off2 = 0
122          dim = SHAPE(pta_2)
123       END IF
124       
125       pta_2(1+off2:SIZE(pta_2,1)-off2, 1+off2:SIZE(pta_2,2)-off2,:) = pta_1(1+off1:SIZE(pta_1,1)-off1, 1+off1:SIZE(pta_1,2)-off1,:) 
126
127   END SUBROUTINE halo_mng_copy_3D
128
129   SUBROUTINE halo_mng_copy_4D(pta_1, pta_2)
130      !!----------------------------------------------------------------------
131      !!                  ***  ROUTINE halo_mng_copy  ***
132      !!
133      !! ** Purpose : copy pta_1 into pta_2
134      !! ** Method  :
135      !! History :
136      !!   1.0  !  07-19  ( CMCC - ASC )  halo_mng_copy
137      !!----------------------------------------------------------------------
138       REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pta_1
139       REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pta_2
140       INTEGER :: halo, off1, off2
141       INTEGER, DIMENSION(4) :: dim
142
143       halo = (SIZE(pta_1,1) - SIZE(pta_2,1))/2
144       IF (halo < 0) THEN
145          off1 = 0
146          off2 = -halo
147          dim = SHAPE(pta_1)
148       ELSE
149          off1 = halo
150          off2 = 0
151          dim = SHAPE(pta_2)
152       END IF
153       
154       pta_2(1+off2:SIZE(pta_2,1)-off2, 1+off2:SIZE(pta_2,2)-off2,:,:) = pta_1(1+off1:SIZE(pta_1,1)-off1, 1+off1:SIZE(pta_1,2)-off1,:,:)
155
156   END SUBROUTINE halo_mng_copy_4D
157END MODULE
Note: See TracBrowser for help on using the repository browser.