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.
lbclnk_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/LBC – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/LBC/lbclnk_tam.F90 @ 3611

Last change on this file since 3611 was 3611, checked in by pabouttier, 11 years ago

Add TAM code and ORCA2_TAM configuration - see Ticket #1007
  • Property svn:executable set to *
File size: 13.2 KB
Line 
1MODULE lbclnk_tam
2   !!======================================================================
3   !!                       ***  MODULE  lbclnk_tam  ***
4   !! Ocean        : TAM of lateral boundary conditions
5   !!=====================================================================
6   !! History :  OPA  ! 1997-06  (G. Madec)     Original code
7   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module
8   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment
9   !! History of TAM : 3.2 ! ???
10   !!                  3.4 ! 2012-03 (P.-A. Bouttier) Update
11   !!----------------------------------------------------------------------
12#if   defined key_mpp_mpi
13   !!----------------------------------------------------------------------
14   !!   'key_mpp_mpi'             MPI massively parallel processing library
15   !!----------------------------------------------------------------------
16   !!   lbc_lnk_adj      : generic interface for mpp_lnk_3d_adj and mpp_lnk_2d_adj routines defined in lib_mpp
17   !!   lbc_lnk_e_adj    : generic interface for mpp_lnk_2d_e_adj routine defined in lib_mpp
18   !!----------------------------------------------------------------------
19   USE lib_mpp_tam          ! distributed memory computing library
20
21   INTERFACE lbc_lnk_adj
22      MODULE PROCEDURE mpp_lnk_3d_gather_adj, mpp_lnk_3d_adj, mpp_lnk_2d_adj
23   END INTERFACE
24
25   INTERFACE lbc_lnk_e_adj
26      MODULE PROCEDURE mpp_lnk_2d_e_adj
27   END INTERFACE
28
29   PUBLIC lbc_lnk_adj       ! ocean lateral boundary conditions
30   PUBLIC lbc_lnk_e_adj
31
32   !!----------------------------------------------------------------------
33   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
34   !! $Id$
35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37
38#else
39   !!----------------------------------------------------------------------
40   !!   Default option                              shared memory computing
41   !!----------------------------------------------------------------------
42   !!   lbc_lnk_adj      : generic interface for lbc_lnk_3d and lbc_lnk_2d
43   !!   lbc_lnk_3d_adj   : set the lateral boundary condition on a 3D variable on ocean mesh
44   !!   lbc_lnk_2d_adj   : set the lateral boundary condition on a 2D variable on ocean mesh
45   !!----------------------------------------------------------------------
46   USE oce             ! ocean dynamics and tracers
47   USE dom_oce         ! ocean space and time domain
48   USE in_out_manager  ! I/O manager
49   USE lbcnfd_tam          ! north fold
50
51   IMPLICIT NONE
52   PRIVATE
53
54   INTERFACE lbc_lnk_adj
55      MODULE PROCEDURE lbc_lnk_3d_gather_adj, lbc_lnk_3d_adj, lbc_lnk_2d_adj
56   END INTERFACE
57
58   INTERFACE lbc_lnk_e_adj
59      MODULE PROCEDURE lbc_lnk_2d_adj
60   END INTERFACE
61
62   PUBLIC   lbc_lnk_adj       ! ocean/ice  lateral boundary conditions
63   PUBLIC   lbc_lnk_e_adj
64
65   !!----------------------------------------------------------------------
66   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
67   !! $Id$
68   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
69   !!----------------------------------------------------------------------
70CONTAINS
71
72   SUBROUTINE lbc_lnk_3d_gather_adj( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
73      !!---------------------------------------------------------------------
74      !!                  ***  ROUTINE lbc_lnk_3d_gather_adj  ***
75      !!
76      !! ** Purpose :   Adjoint of set lateral boundary conditions on two 3D arrays (non mpp case)
77      !!
78      !! ** Method  :   psign = -1 :    change the sign across the north fold
79      !!                      =  1 : no change of the sign across the north fold
80      !!                      =  0 : no change of the sign across the north fold and
81      !!                             strict positivity preserved: use inner row/column
82      !!                             for closed boundaries.
83      !!----------------------------------------------------------------------
84      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
85      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
86      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign
87      !!----------------------------------------------------------------------
88      !
89      CALL lbc_lnk_3d_adj( pt3d2, cd_type2, psgn)
90      CALL lbc_lnk_3d_adj( pt3d1, cd_type1, psgn)
91      !
92   END SUBROUTINE lbc_lnk_3d_gather_adj
93
94
95   SUBROUTINE lbc_lnk_3d_adj( pt3d, cd_type, psgn, cd_mpp, pval )
96      !!---------------------------------------------------------------------
97      !!                  ***  ROUTINE lbc_lnk_3d_adj  ***
98      !!
99      !! ** Purpose :   Adjoint of set lateral boundary conditions on a 3D array (non mpp case)
100      !!
101      !! ** Method  :   psign = -1 :    change the sign across the north fold
102      !!                      =  1 : no change of the sign across the north fold
103      !!                      =  0 : no change of the sign across the north fold and
104      !!                             strict positivity preserved: use inner row/column
105      !!                             for closed boundaries.
106      !!----------------------------------------------------------------------
107      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
108      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
109      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
110      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
111      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
112      !!
113      REAL(wp) ::   zland
114      !!----------------------------------------------------------------------
115
116      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
117      ELSE                         ;   zland = 0.e0
118      ENDIF
119
120
121      IF( PRESENT( cd_mpp ) ) THEN
122         ! only fill the overlap area and extra allows
123         ! this is in mpp case. In this module, just do nothing
124      ELSE
125         !
126         !                                     ! North-South boundaries
127         !                                     ! ======================
128         SELECT CASE ( nperio )
129         !
130         CASE ( 2 )                               !**  South symmetric  --  North closed
131            SELECT CASE ( cd_type )
132            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
133               pt3d(:,jpj,:) = 0.0_wp
134               pt3d(:, 3 ,:) = pt3d(:,3,:) + pt3d(:,1,:)
135               pt3d(:, 1 ,:) = 0.0_wp
136            CASE ( 'V' , 'F' )                         ! V-, F-points
137               pt3d(:,jpj,:) = 0.0_wp
138               pt3d(:, 2 ,:) = pt3d(:,2,:) + psgn * pt3d(:,1,:)
139               pt3d(:, 1 ,:) = 0.0_wp
140            END SELECT
141            !
142         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
143            CALL lbc_nfd_adj( pt3d(:,:,:), cd_type, psgn  )  ! North fold
144            pt3d(jpi,jpj,:) = 0.0_wp
145            pt3d( 1 ,jpj,:) = 0.0_wp
146            !
147            SELECT CASE ( cd_type )
148            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
149               pt3d(:, 1 ,:) = 0.0_wp
150            END SELECT
151            !
152         CASE DEFAULT                             !**  North closed  --  South closed
153            SELECT CASE ( cd_type )
154            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
155               pt3d(:,jpj,:) = 0.0_wp
156               pt3d(:, 1 ,:) = 0.0_wp
157            CASE ( 'F' )                               ! F-point
158               pt3d(:,jpj,:) = 0.0_wp
159            END SELECT
160            !
161         END SELECT
162         !
163         !                                     !  East-West boundaries
164         !                                     ! ======================
165         SELECT CASE ( nperio )
166         !
167         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
168            pt3d(  2  ,:,:) = pt3d(  2  ,:,:) + pt3d(jpi,:,:)
169            pt3d(jpi,:,:) = 0.0_wp
170            pt3d(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:)
171            pt3d( 1 ,:,:) = 0.0_wp
172            !
173         CASE DEFAULT                             !**  East closed  --  West closed
174            SELECT CASE ( cd_type )
175            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
176               pt3d( 1 ,:,:) = 0.0_wp
177               pt3d(jpi,:,:) = 0.0_wp
178            CASE ( 'F' )                               ! F-point
179               pt3d(jpi,:,:) = 0.0_wp
180            END SELECT
181            !
182         END SELECT
183         !
184      ENDIF
185      !
186   END SUBROUTINE lbc_lnk_3d_adj
187
188
189   SUBROUTINE lbc_lnk_2d_adj( pt2d, cd_type, psgn, cd_mpp, pval )
190      !!---------------------------------------------------------------------
191      !!                 ***  ROUTINE lbc_lnk_2d_adj  ***
192      !!
193      !! ** Purpose :   Adjoint of set lateral boundary conditions on a 2D array (non mpp case)
194      !!
195      !! ** Method  :   psign = -1 :    change the sign across the north fold
196      !!                      =  1 : no change of the sign across the north fold
197      !!                      =  0 : no change of the sign across the north fold and
198      !!                             strict positivity preserved: use inner row/column
199      !!                             for closed boundaries.
200      !!----------------------------------------------------------------------
201      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
202      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
203      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
204      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
205      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
206      !!
207      REAL(wp) ::   zland
208      !!----------------------------------------------------------------------
209      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
210      ELSE                         ;   zland = 0.e0
211      ENDIF
212      IF (PRESENT(cd_mpp)) THEN
213         ! only fill the overlap area and extra allows
214         ! this is in mpp case. In this module, just do nothing
215      ELSE
216         !
217         !                                     ! North-South boundaries
218         !                                     ! ======================
219         SELECT CASE ( nperio )
220         !
221         CASE ( 2 )                               !**  South symmetric  --  North closed
222            SELECT CASE ( cd_type )
223            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
224               pt2d(:,jpj) = 0.0_wp
225               pt2d(:, 3 ) = pt2d(:,3) + pt2d(:,1)
226               pt2d(:, 1 ) = 0.0_wp
227            CASE ( 'V' , 'F' )                         ! V-, F-points
228               pt2d(:,jpj) = 0.e0
229               pt2d(:, 2 ) = pt2d(:,2) + psgn * pt2d(:,1)
230               pt2d(:, 1 ) = 0.e0
231            END SELECT
232            !
233         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
234            CALL lbc_nfd_adj( pt2d(:,:), cd_type, psgn )
235            pt2d(jpi,jpj) = 0.0_wp
236            pt2d( 1 ,jpj) = 0.0_wp
237            pt2d( 1 , 1 ) = 0.0_wp
238            SELECT CASE ( cd_type )
239            CASE ( 'T' , 'U' , 'V' , 'W' ,  'I')             ! all points except F-point
240               pt2d(:, 1 ) = 0.0_wp
241            END SELECT
242            !
243         CASE DEFAULT                             !**  North closed  --  South closed
244            SELECT CASE ( cd_type )
245            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
246               pt2d(:, 1 ) = 0.0_wp
247               pt2d(:,jpj) = 0.0_wp
248            CASE ( 'F' )                               ! F-point
249               pt2d(:,jpj) = 0.0_wp
250            END SELECT
251            !
252         END SELECT
253         !
254         !                                     ! East-West boundaries
255         !                                     ! ====================
256         SELECT CASE ( nperio )
257         !
258         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
259            pt2d(  2  ,:) = pt2d(  2  ,:) + pt2d( jpi ,:)
260            pt2d( jpi ,:) = 0.0_wp
261            pt2d(jpim1,:) = pt2d(jpim1,:) + pt2d( 1 ,:)
262            pt2d(  1  ,:) = 0.0_wp
263            !
264         CASE DEFAULT                             !** East closed  --  West closed
265            SELECT CASE ( cd_type )
266            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
267               pt2d( 1 ,:) = 0.0_wp
268               pt2d(jpi,:) = 0.0_wp
269            CASE ( 'F' )                              ! F-point
270               pt2d(jpi,:) = 0.0_wp
271            END SELECT
272            !
273         END SELECT
274         !
275      ENDIF
276      !
277   END SUBROUTINE lbc_lnk_2d_adj
278
279#endif
280
281   !!======================================================================
282END MODULE lbclnk_tam
Note: See TracBrowser for help on using the repository browser.