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.
obctra_tam.F90 in branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/OBC – NEMO

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/OBC/obctra_tam.F90 @ 1885

Last change on this file since 1885 was 1885, checked in by rblod, 14 years ago

add TAM sources

  • Property svn:executable set to *
File size: 14.9 KB
Line 
1MODULE obctra_tam
2   !!=================================================================================
3   !!                       ***  MODULE  obctra  ***
4   !! Ocean tracers:   Radiation of tracers on each open boundary
5   !!=================================================================================
6#if defined key_obc
7   !!---------------------------------------------------------------------------------
8   !!   'key_obc'      :                                      Open Boundary Conditions
9   !!---------------------------------------------------------------------------------
10   !!   obc_tra_tan        : call the subroutine for each open boundary
11   !!   obc_tra_east_tan   :
12   !!   obc_tra_west_tan   :
13   !!   obc_tra_north_tan  :
14   !!   obc_tra_south_tan  :
15   !!   obc_tra_adj        : call the subroutine for each open boundary
16   !!   obc_tra_east_adj   :
17   !!   obc_tra_west_adj   :
18   !!   obc_tra_north_adj  :
19   !!   obc_tra_south_adj  :
20   !!----------------------------------------------------------------------------------
21   !! * Modules used
22   USE oce_tam,         ONLY : tb_tl, sb_tl, ta_tl, sa_tl, & ! ocean dynamics and tracers
23        &                      tb_ad, sb_ad, ta_ad, sa_ad
24   USE dom_oce         ! ocean space and time domain variables
25   USE phycst          ! physical constants
26   USE obc_oce         ! ocean open boundary conditions
27   USE lib_mpp         ! ???
28   USE lbclnk          ! ???
29   USE lbclnk_tam,      ONLY : lbc_lnk_adj ! TAM lateral boundary conditions
30   USE in_out_manager  ! I/O manager
31
32   IMPLICIT NONE
33   PRIVATE
34
35   !! * Accessibility
36   PUBLIC obc_tra_tan     ! routine called in tranxt.F90
37   PUBLIC obc_tra_adj     ! routine called in tranxt.F90
38
39   !! * Module variables
40   LOGICAL  ::   ll_fbc
41
42   
43   !! * Substitutions
44#  include "obc_vectopt_loop_substitute.h90"
45   !!---------------------------------------------------------------------------------
46   !!   OPA 9.0 , LOCEAN-IPSL (2005)
47   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/OBC/obctra.F90,v 1.4 2005/03/27 18:35:10 opalod Exp $
48   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
49   !!---------------------------------------------------------------------------------
50
51CONTAINS
52
53   SUBROUTINE obc_tra_tan( kt )
54      !!-------------------------------------------------------------------------------
55      !!                 ***  SUBROUTINE obc_tra  ***
56      !!                   
57      !! ** Purpose :   Compute tracer fields (t,s) along the open boundaries.
58      !!      This routine is called by the tranxt.F routine and updates ta,sa
59      !!      which are the actual temperature and salinity fields.
60      !!        The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north,
61      !!      and/or lp_obc_south allow the user to determine which boundary is an
62      !!      open one (must be done in the param_obc.h90 file).
63      !!
64      !! Reference :
65      !!   Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
66      !!
67      !!  History :
68      !!        !  95-03 (J.-M. Molines) Original, SPEM
69      !!        !  97-07 (G. Madec, J.-M. Molines) addition
70      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) F90
71      !!----------------------------------------------------------------------
72      !! * Arguments
73      INTEGER, INTENT( in ) ::   kt
74      !!----------------------------------------------------------------------
75
76      ! 0. Local constant initialization
77
78#if defined key_pomme_r025
79      ! Warning : TAM is available only for fixed boundary conditions (FBC)
80      ll_fbc = .true.
81#else
82      Error, OBC not ready.
83#endif
84
85!    Remove the dependance on kt to avoid compilation warnings
86      IF( lp_obc_east  )   CALL obc_tra_east_tan     ! East open boundary
87      IF( lp_obc_west  )   CALL obc_tra_west_tan     ! West open boundary
88      IF( lp_obc_north )   CALL obc_tra_north_tan    ! North open boundary
89      IF( lp_obc_south )   CALL obc_tra_south_tan    ! South open boundary
90
91      IF( lk_mpp ) THEN
92         CALL lbc_lnk( ta_tl, 'T', 1. )
93         CALL lbc_lnk( sa_tl, 'T', 1. )
94      ENDIF
95
96   END SUBROUTINE obc_tra_tan
97
98   SUBROUTINE obc_tra_adj( kt )
99      !!                 ***  SUBROUTINE obc_tra  ***
100      INTEGER, INTENT( in ) ::   kt
101#if defined key_pomme_r025
102      ! Warning : TAM is available only for fixed boundary conditions (FBC)
103      ll_fbc = .true.
104#else
105      Error, OBC not ready.
106#endif
107
108      IF( lk_mpp ) THEN
109         CALL lbc_lnk_adj( sa_ad, 'T', 1. )
110         CALL lbc_lnk_adj( ta_ad, 'T', 1. )
111      ENDIF
112
113      IF( lp_obc_south )   CALL obc_tra_south_adj    ! South open boundary
114      IF( lp_obc_north )   CALL obc_tra_north_adj    ! North open boundary
115      IF( lp_obc_west  )   CALL obc_tra_west_adj     ! West open boundary
116      IF( lp_obc_east  )   CALL obc_tra_east_adj     ! East open boundary
117
118   END SUBROUTINE obc_tra_adj
119
120   SUBROUTINE obc_tra_east_tan
121      !!------------------------------------------------------------------------------
122      !!                ***  SUBROUTINE obc_tra_east  ***
123      !!                 
124      !! ** Purpose :
125      !!      Apply the radiation algorithm on east OBC tracers ta, sa using the
126      !!      phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module
127      !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC
128      !!
129      !!  History :
130      !!         ! 95-03 (J.-M. Molines) Original from SPEM
131      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
132      !!         ! 97-12 (M. Imbard) Mpp adaptation
133      !!         ! 00-06 (J.-M. Molines)
134      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
135      !!------------------------------------------------------------------------------
136      !! * Arguments
137      !! * Local declaration
138      INTEGER ::   ji, jj, jk      ! dummy loop indices
139      !!------------------------------------------------------------------------------
140      ! 1. First three time steps and more if lfbceast is .TRUE.
141      !    In that case open boundary conditions are FIXED.
142      ! --------------------------------------------------------
143
144      IF ( ll_fbc .OR. lfbceast ) THEN
145
146        DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
147            DO jk = 1, jpkm1
148               DO jj = 1, jpj
149                  ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) * (1. - temsk(jj,jk))
150                  sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) * (1. - temsk(jj,jk))
151               END DO
152            END DO
153         END DO
154
155      ELSE
156
157         CALL ctl_stop( 'Error in obctra_tam : TAM is available only for fixed boundary conditions' )
158
159      END IF
160
161   END SUBROUTINE obc_tra_east_tan
162
163   SUBROUTINE obc_tra_east_adj
164      !!                ***  SUBROUTINE obc_tra_east  ***
165      INTEGER ::   ji, jj, jk      ! dummy loop indices
166      IF ( ll_fbc .OR. lfbceast ) THEN
167
168        DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
169            DO jk = 1, jpkm1
170               DO jj = 1, jpj
171                  ta_ad(ji,jj,jk) = ta_ad(ji,jj,jk) * (1. - temsk(jj,jk))
172                  sa_ad(ji,jj,jk) = sa_ad(ji,jj,jk) * (1. - temsk(jj,jk))
173               END DO
174            END DO
175         END DO
176
177      ELSE
178
179         CALL ctl_stop( 'Error in obctra_tam : TAM is available only for fixed boundary conditions' )
180
181      END IF
182
183   END SUBROUTINE obc_tra_east_adj
184
185   SUBROUTINE obc_tra_west_tan
186      !!------------------------------------------------------------------------------
187      !!                 ***  SUBROUTINE obc_tra_west  ***
188      !!           
189      !! ** Purpose :
190      !!      Apply the radiation algorithm on west OBC tracers ta, sa using the
191      !!      phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module
192      !!      If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC
193      !!
194      !!  History :
195      !!         ! 95-03 (J.-M. Molines) Original from SPEM
196      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
197      !!         ! 97-12 (M. Imbard) Mpp adaptation
198      !!         ! 00-06 (J.-M. Molines)
199      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
200      !!------------------------------------------------------------------------------
201      !! * Arguments
202      !! * Local declaration
203      INTEGER ::   ji, jj, jk      ! dummy loop indices
204      !!------------------------------------------------------------------------------
205
206      ! 1. First three time steps and more if lfbcwest is .TRUE.
207      !    In that case open boundary conditions are FIXED.
208      ! --------------------------------------------------------
209
210      IF ( ll_fbc .OR. lfbcwest ) THEN
211
212         DO ji = fs_niw0, fs_niw1 ! Vector opt.
213            DO jk = 1, jpkm1
214               DO jj = 1, jpj
215                  ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) * (1. - twmsk(jj,jk))
216                  sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) * (1. - twmsk(jj,jk))
217               END DO
218            END DO
219         END DO
220
221      ELSE
222
223         CALL ctl_stop( 'Error in obctra_tam : TAM is available only for fixed boundary conditions' )
224
225      END IF
226
227   END SUBROUTINE obc_tra_west_tan
228
229   SUBROUTINE obc_tra_west_adj
230      !!                 ***  SUBROUTINE obc_tra_west  ***
231      INTEGER ::   ji, jj, jk      ! dummy loop indices
232      IF ( ll_fbc .OR. lfbcwest ) THEN
233
234         DO ji = fs_niw0, fs_niw1 ! Vector opt.
235            DO jk = 1, jpkm1
236               DO jj = 1, jpj
237                  ta_ad(ji,jj,jk) = ta_ad(ji,jj,jk) * (1. - twmsk(jj,jk))
238                  sa_ad(ji,jj,jk) = sa_ad(ji,jj,jk) * (1. - twmsk(jj,jk))
239               END DO
240            END DO
241         END DO
242
243      ELSE
244
245         CALL ctl_stop( 'Error in obctra_tam : TAM is available only for fixed boundary conditions' )
246
247      END IF
248
249   END SUBROUTINE obc_tra_west_adj
250
251   SUBROUTINE obc_tra_north_tan
252      !!------------------------------------------------------------------------------
253      !!                 ***  SUBROUTINE obc_tra_north  ***
254      !!
255      !! ** Purpose :
256      !!      Apply the radiation algorithm on north OBC tracers ta, sa using the
257      !!      phase velocities calculated in obc_rad_north subroutine in obcrad.F90 module
258      !!      If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC
259      !!
260      !!  History :
261      !!         ! 95-03 (J.-M. Molines) Original from SPEM
262      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
263      !!         ! 97-12 (M. Imbard) Mpp adaptation
264      !!         ! 00-06 (J.-M. Molines)
265      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
266      !!------------------------------------------------------------------------------
267      !! * Arguments
268      !! * Local declaration
269      INTEGER ::   ji, jj, jk      ! dummy loop indices
270      !!------------------------------------------------------------------------------
271
272      ! 1. First three time steps and more if lfbcnorth is .TRUE.
273      !    In that case open boundary conditions are FIXED.
274      ! --------------------------------------------------------
275
276      IF ( ll_fbc .OR. lfbcnorth ) THEN
277
278         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
279            DO jk = 1, jpkm1
280               DO ji = 1, jpi
281                  ta_tl(ji,jj,jk)= ta_tl(ji,jj,jk) * (1.-tnmsk(ji,jk)) 
282                  sa_tl(ji,jj,jk)= sa_tl(ji,jj,jk) * (1.-tnmsk(ji,jk)) 
283               END DO
284            END DO
285         END DO
286
287      ELSE
288
289         CALL ctl_stop( 'Error in obctra_tam : TAM is available only for fixed boundary conditions' )
290
291      END IF
292
293   END SUBROUTINE obc_tra_north_tan
294
295   SUBROUTINE obc_tra_north_adj
296      !!                 ***  SUBROUTINE obc_tra_north  ***
297      INTEGER ::   ji, jj, jk      ! dummy loop indices
298
299      IF ( ll_fbc .OR. lfbcnorth ) THEN
300
301         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
302            DO jk = 1, jpkm1
303               DO ji = 1, jpi
304                  ta_ad(ji,jj,jk)= ta_ad(ji,jj,jk) * (1.-tnmsk(ji,jk)) 
305                  sa_ad(ji,jj,jk)= sa_ad(ji,jj,jk) * (1.-tnmsk(ji,jk)) 
306               END DO
307            END DO
308         END DO
309
310      ELSE
311
312         CALL ctl_stop( 'Error in obctra_tam : TAM is available only for fixed boundary conditions' )
313
314      END IF
315
316   END SUBROUTINE obc_tra_north_adj
317
318   SUBROUTINE obc_tra_south_tan
319      !!------------------------------------------------------------------------------
320      !!                ***  SUBROUTINE obc_tra_south  ***
321      !!     
322      !! ** Purpose :
323      !!      Apply the radiation algorithm on south OBC tracers ta, sa using the
324      !!      phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module
325      !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC
326      !!
327      !!  History :
328      !!         ! 95-03 (J.-M. Molines) Original from SPEM
329      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
330      !!         ! 97-12 (M. Imbard) Mpp adaptation
331      !!         ! 00-06 (J.-M. Molines)
332      !!    8.5  ! 02-10 (C. Talandier, A-M Treguier) F90
333      !!------------------------------------------------------------------------------
334      !! * Arguments
335      !! * Local declaration
336      INTEGER ::   ji, jj, jk      ! dummy loop indices
337      !!------------------------------------------------------------------------------
338
339      ! 1. First three time steps and more if lfbcsouth is .TRUE.
340      !    In that case open boundary conditions are FIXED.
341      ! --------------------------------------------------------
342
343      IF ( ll_fbc .OR. lfbcsouth ) THEN
344
345         DO jj = fs_njs0, fs_njs1  ! Vector opt.
346            DO jk = 1, jpkm1
347               DO ji = 1, jpi
348                  ta_tl(ji,jj,jk)= ta_tl(ji,jj,jk) * (1.-tsmsk(ji,jk))
349                  sa_tl(ji,jj,jk)= sa_tl(ji,jj,jk) * (1.-tsmsk(ji,jk))
350               END DO
351            END DO
352         END DO
353
354      ELSE
355
356         CALL ctl_stop( 'Error in obctra_tam : TAM is available only for fixed boundary conditions' )
357
358      END IF   
359
360   END SUBROUTINE obc_tra_south_tan
361
362   SUBROUTINE obc_tra_south_adj
363      !!                ***  SUBROUTINE obc_tra_south  ***
364      INTEGER ::   ji, jj, jk      ! dummy loop indices
365
366      IF ( ll_fbc .OR. lfbcsouth ) THEN
367
368         DO jj = fs_njs0, fs_njs1  ! Vector opt.
369            DO jk = 1, jpkm1
370               DO ji = 1, jpi
371                  ta_ad(ji,jj,jk)= ta_ad(ji,jj,jk) * (1.-tsmsk(ji,jk))
372                  sa_ad(ji,jj,jk)= sa_ad(ji,jj,jk) * (1.-tsmsk(ji,jk))
373               END DO
374            END DO
375         END DO
376
377      ELSE
378
379         CALL ctl_stop( 'Error in obctra_tam : TAM is available only for fixed boundary conditions' )
380
381      END IF   
382
383   END SUBROUTINE obc_tra_south_adj
384
385#else
386   !!---------------------------------------------------------------------------------
387   !!   Default option                                                    Empty module
388   !!---------------------------------------------------------------------------------
389CONTAINS
390   SUBROUTINE obc_tra_tan      ! Empty routine
391   END SUBROUTINE obc_tra_tan
392   SUBROUTINE obc_tra_adj
393   END SUBROUTINE obc_tra_adj
394
395#endif
396
397   !!=================================================================================
398END MODULE obctra_tam
Note: See TracBrowser for help on using the repository browser.