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

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/cla_dynspg_tam.F90 @ 1885

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

add TAM sources

File size: 17.4 KB
Line 
1MODULE cla_dynspg_tam
2   !!----------------------------------------------------------------------
3   !!    This software is governed by the CeCILL licence (Version 2)
4   !!----------------------------------------------------------------------
5#if defined key_tam
6   !!======================================================================
7   !!  ***  MODULE  cla_dynspg_tam : TANGENT/ADJOINT OF MODULE cla_dynspg  ***
8   !!
9   !!  Update the momentum trend with the cross land advection from surface
10   !!  pressure gradient in the free surface constant volume case with
11   !!  vector optimization.
12   !!                 
13   !!======================================================================
14   !! History of the direct module:
15   !!        !         (A. Bozec)  Original code
16   !!   8.5  !  02-11  (A. Bozec)  F90: Free form and module
17   !! History of the TAM module:
18   !!   9.0  !  09-03  (A. Weaver) Original version
19   !!----------------------------------------------------------------------
20   !!   dyn_spg_cla_tan  : update the momentum trend with the surface pressure
21   !!                      gradient in the free surface constant volume case
22   !!                      with vector optimization (tangent routine)
23   !!   dyn_spg_cla_adj  : update the momentum trend with the surface pressure
24   !!                      gradient in the free surface constant volume case
25   !!                      with vector optimization (adjoint routine)
26   !!----------------------------------------------------------------------
27   !! * Modules used
28   USE par_kind      , ONLY: & ! Precision variables
29      & wp
30   USE in_out_manager, ONLY: & ! I/O manager
31      & lwp,                 &
32      & numout,              & 
33      & nit000
34   USE dom_oce       , ONLY: & ! Ocean space and time domain
35      & mi0,                 &
36      & mi1,                 &
37      & mj0,                 &
38      & mj1,                 &
39      & e1t,                 &
40      & e2t,                 &
41      & e2u,                 &
42#if defined key_zco
43      & e3t_0,               &
44#else
45      & e3t,                 &
46#endif
47      & tmask
48   USE oce_tam       , ONLY: & ! Tangent-linear and adjoint model variables
49      & ua_tl,               &
50      & va_tl,               &
51      & ua_ad,               &
52      & va_ad
53   USE sbc_oce_tam   , ONLY: & ! Surface BCs for tangent and adjoint model
54      & emp_tl,              &
55      & emp_ad
56   USE lib_mpp       , ONLY: & ! Massively parallel processing library
57      & mpp_sum,             &
58      & lk_mpp
59     
60   IMPLICIT NONE
61   PRIVATE
62
63   !! * Accessibility
64   PUBLIC dyn_spg_cla_tan,   & ! routine called by dyn_spg_tan
65      &   dyn_spg_cla_adj      ! routine called by dyn_spg_adj
66
67   !! * Substitutions
68#  include "domzgr_substitute.h90"
69#  include "vectopt_loop_substitute.h90"
70
71CONTAINS
72
73   SUBROUTINE dyn_spg_cla_tan( kt ) 
74      !!----------------------------------------------------------------------
75      !!              ***  routine dyn_spg_cla_tan  ***
76      !!
77      !! ** Purpose of direct routine :
78      !!
79      !! ** Method of direct routine :
80      !!
81      !! ** Action :
82      !!
83      !! History
84      !!        !  09-03  (A. Weaver) Original version
85      !!---------------------------------------------------------------------
86      !! * Arguments
87      INTEGER, INTENT( in ) ::  &
88         & kt              ! ocean time-step
89
90      !! * Local declarations
91      INTEGER  :: &
92         & ji, &           ! dummy loop indices
93         & jj, &
94         & jk               
95      INTEGER  :: &
96         & ii0, &          ! temporary integers
97         & ii1, &
98         & ij0, &
99         & ij1       
100      REAL(wp) ::  &   
101         & zempmed, &      ! EMP on Med Sea ans Red Sea
102         & zempred, &               
103         & zwei,    &                            !             
104         & zisw_rs, &      ! imposed transport Red sea
105         & zurw_rs, &
106         & zbrw_rs, &   
107         & zisw_ms, &      ! imposed transport Med Sea
108         & zurw_ms, &     
109         & zbrw_ms, &
110         & zmrw_ms
111      !!----------------------------------------------------------------------
112
113      ! Different velocities for straits ( Gibraltar, Bab el Mandeb...)
114         
115      ! Control print
116      ! -------------
117      IF( kt == nit000 ) THEN
118         IF(lwp) WRITE(numout,*)
119         IF(lwp) WRITE(numout,*) 'cla_dynspg_tan : cross land advection on surface '
120         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   pressure '
121         IF(lwp) WRITE(numout,*) ' '
122      ENDIF
123
124      ! EMP on Mediterranean Sea and Red Sea
125      ! ------------------------------------
126      ! compute the emp in Mediterranean Sea
127      zempmed = 0.0_wp
128      zwei = 0.0_wp
129      ij0 =  96   ;   ij1 = 110
130      ii0 = 141   ;   ii1 = 181
131      DO jj = mj0(ij0), mj1(ij1)
132         DO ji = mi0(ii0), mi1(ii1)
133            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
134            zempmed = zempmed + emp_tl(ji,jj) * zwei
135         END DO
136      END DO
137      IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value
138
139      ! minus 2 points in Red Sea and 3 in Atlantic
140      ij0 =  96   ;   ij1 =  96
141      ii0 = 148   ;   ii1 = 148
142      DO jj = mj0(ij0), mj1(ij1)
143         DO ji = mi0(ii0), mi1(ii1)
144            zempmed = zempmed - emp_tl(ji  ,jj) * tmask(ji  ,jj,1)             &
145               &                                * e1t(ji  ,jj) * e2t(ji  ,jj)  &
146               &              - emp_tl(ji+1,jj) * tmask(ji+1,jj,1)             &
147               &                                * e1t(ji+1,jj) * e2t(ji+1,jj)   
148         END DO
149      END DO
150      ! we convert in m3
151      zempmed = zempmed * 1.e-3_wp
152
153      ! compute the emp in Red Sea   
154      zempred = 0.0_wp
155      zwei = 0.0_wp
156      ij0 =  87   ;   ij1 =  96
157      ii0 = 148   ;   ii1 = 160
158      DO jj = mj0(ij0), mj1(ij1)
159         DO ji = mi0(ii0), mi1(ii1)
160            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
161            zempred = zempred + emp_tl(ji,jj) * zwei
162         END DO
163      END DO
164      IF( lk_mpp )   CALL mpp_sum( zempred )      ! sum with other processors value
165
166      ! we convert in m3
167      zempred = zempred * 1.e-3
168
169      ! New Transport at Bab el Mandeb and Gibraltar
170      ! --------------------------------------------
171
172      ! imposed transport at Bab el Mandeb
173      zisw_rs = 0.4e6_wp        ! inflow surface water
174      zurw_rs = 0.2e6_wp        ! upper recirculation water
175      zbrw_rs = 0.5e6_wp        ! bottom recirculation water
176
177      ! imposed transport at Gibraltar
178      zisw_ms = 0.8e6_wp        ! atlantic-mediterranean  water
179      zmrw_ms = 0.7e6_wp        ! middle recirculation water
180      zurw_ms = 2.5e6_wp        ! upper  recirculation water
181      zbrw_ms = 3.5e6_wp        ! bottom recirculation water
182
183      ! Different velocities for straits ( Gibraltar, Bab el Mandeb )
184      ! -------------------------------------------------------------
185
186      ! Bab el Mandeb
187      ! -------------
188      ! 160,88 north point Bab el Mandeb
189      ij0 =  88   ;   ij1 =  88
190      ii0 = 160   ;   ii1 = 160
191      DO jj = mj0(ij0), mj1(ij1)
192         DO ji = mi0(ii0), mi1(ii1)
193            ua_tl(ji,jj  ,: ) = 0.0_wp  !  North East Bab el Mandeb
194         END DO
195      END DO
196      !                              ! surface
197      DO jk = 1,  8                                     
198         DO jj = mj0(ij0), mj1(ij1)
199            DO ji = mi0(ii0), mi1(ii1)
200               ua_tl(ji, jj,jk) = - ( zempred / 8.0_wp ) &
201                  &               / ( e2u(ji, jj) * fse3t(ji, jj,jk) )     
202            END DO
203         END DO
204      END DO
205      !                              ! deeper
206      DO jj = mj0(ij0), mj1(ij1)
207         DO ji = mi0(ii0), mi1(ii1)
208            ua_tl(ji, jj,21) = 0.0_wp
209         END DO
210      END DO
211
212      ! 160,87 south point Bab el Mandeb
213      ij0 =  87   ;   ij1 =  87
214      ii0 = 160   ;   ii1 = 160
215      DO jj = mj0(ij0), mj1(ij1)
216         DO ji = mi0(ii0), mi1(ii1)
217            ua_tl(ji,jj  ,: ) = 0.0_wp  !  South East Bab el Mandeb
218         END DO
219      END DO
220      DO jj = mj0(ij0), mj1(ij1)
221         DO ji = mi0(ii0), mi1(ii1)
222            ua_tl(ji, jj,21) = 0.0_wp
223         END DO
224      END DO
225
226      ! Gibraltar
227      ! ---------
228
229      ! initialisation of velocity at concerned points
230      ! 139, 101 south point in Gibraltar
231      ij0 = 101   ;   ij1 = 101
232      ii0 = 139   ;   ii1 = 139
233      DO jj = mj0(ij0), mj1(ij1)
234         DO ji = mi0(ii0), mi1(ii1)
235            ua_tl(ji,jj  ,: ) = 0.0_wp  !  South West Gibraltar
236            ua_tl(ji,jj+1,: ) = 0.0_wp  !  North West Gibraltar
237         END DO
238      END DO
239      !                            ! surface
240      DO jk = 1, 14                     
241         DO jj = mj0(ij0), mj1(ij1)
242            DO ji = mi0(ii0), mi1(ii1)
243               ua_tl(ji,jj,jk) = ( zempmed / 14.0_wp ) &
244                  &              / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
245            END DO
246         END DO
247      END DO
248      !                            ! middle circulation
249      DO jk = 15, 20                     
250         DO jj = mj0(ij0), mj1(ij1)
251            DO ji = mi0(ii0), mi1(ii1)
252               ua_tl(ji,jj,jk) = 0.0_wp
253            END DO
254         END DO
255      END DO
256      !                            ! deeper
257      DO jj = mj0(ij0), mj1(ij1)
258         DO ji = mi0(ii0), mi1(ii1)
259            ua_tl(ji,jj,21) = 0.0_wp
260            ua_tl(ji,jj,22) = 0.0_wp
261         END DO
262      END DO
263
264      ! 139,102 north point in Gibraltar
265      ij0 = 102   ;   ij1 = 102
266      ii0 = 139   ;   ii1 = 139
267      DO jj = mj0(ij0), mj1(ij1)
268         DO ji = mi0(ii0), mi1(ii1)
269            ua_tl(ji,jj  ,: ) = 0.0_wp !  North West Gibraltar
270         END DO
271      END DO
272      DO jk = 15, 20                     
273         DO jj = mj0(ij0), mj1(ij1)
274            DO ji = mi0(ii0), mi1(ii1)
275               ua_tl(ji,jj,jk) = 0.0_wp
276            END DO
277         END DO
278      END DO
279      !                            ! deeper
280      DO jj = mj0(ij0), mj1(ij1)
281         DO ji = mi0(ii0), mi1(ii1)
282            ua_tl(ji,jj,22) = 0.0_wp
283         END DO
284      END DO
285
286   END SUBROUTINE dyn_spg_cla_tan
287
288   SUBROUTINE dyn_spg_cla_adj( kt ) 
289      !!----------------------------------------------------------------------
290      !!              ***  routine dyn_spg_cla_adj  ***
291      !!
292      !! ** Purpose of direct routine :
293      !!
294      !! ** Method of direct routine :
295      !!
296      !! ** Action :
297      !!
298      !! History
299      !!        !  09-03  (A. Weaver) Original version
300      !!---------------------------------------------------------------------
301      !! * Arguments
302      INTEGER, INTENT( in ) ::  &
303         & kt              ! ocean time-step
304
305      !! * Local declarations
306      INTEGER  :: &
307         & ji, &           ! dummy loop indices
308         & jj, &
309         & jk               
310      INTEGER  :: &
311         & ii0, &          ! temporary integers
312         & ii1, &
313         & ij0, &
314         & ij1       
315      REAL(wp) ::  &   
316         & zempmed, &      ! EMP on Med Sea ans Red Sea
317         & zempred, &               
318         & zwei,    &                            !             
319         & zisw_rs, &      ! imposed transport Red sea
320         & zurw_rs, &
321         & zbrw_rs, &   
322         & zisw_ms, &      ! imposed transport Med Sea
323         & zurw_ms, &     
324         & zbrw_ms, &
325         & zmrw_ms
326      !!----------------------------------------------------------------------
327
328      ! Different velocities for straits ( Gibraltar, Bab el Mandeb...)
329         
330      ! Control print
331      ! -------------
332      IF( kt == nit000 ) THEN
333         IF(lwp) WRITE(numout,*)
334         IF(lwp) WRITE(numout,*) 'cla_dynspg_adj : cross land advection on surface '
335         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   pressure '
336         IF(lwp) WRITE(numout,*) ' '
337      ENDIF
338
339      ! Local initialization
340      ! --------------------
341      zempmed = 0.0_wp
342      zempred = 0.0_wp
343
344      ! New Transport at Bab el Mandeb and Gibraltar
345      ! --------------------------------------------
346
347      ! imposed transport at Bab el Mandeb
348      zisw_rs = 0.4e6_wp        ! inflow surface water
349      zurw_rs = 0.2e6_wp        ! upper recirculation water
350      zbrw_rs = 0.5e6_wp        ! bottom recirculation water
351
352      ! imposed transport at Gibraltar
353      zisw_ms = 0.8e6_wp        ! atlantic-mediterranean  water
354      zmrw_ms = 0.7e6_wp        ! middle recirculation water
355      zurw_ms = 2.5e6_wp        ! upper  recirculation water
356      zbrw_ms = 3.5e6_wp        ! bottom recirculation water
357
358      ! Different velocities for straits ( Gibraltar, Bab el Mandeb )
359      ! -------------------------------------------------------------
360
361      ! Gibraltar
362      ! ---------
363
364      ! initialisation of velocity at concerned points
365
366      ! 139,102 north point in Gibraltar
367      ij0 = 102   ;   ij1 = 102
368      ii0 = 139   ;   ii1 = 139
369      !                            ! deeper
370      DO jj = mj0(ij0), mj1(ij1)
371         DO ji = mi0(ii0), mi1(ii1)
372            ua_ad(ji,jj,22) = 0.0_wp
373         END DO
374      END DO
375
376      DO jk = 15, 20                     
377         DO jj = mj0(ij0), mj1(ij1)
378            DO ji = mi0(ii0), mi1(ii1)
379               ua_ad(ji,jj,jk) = 0.0_wp
380            END DO
381         END DO
382      END DO
383      DO jj = mj0(ij0), mj1(ij1)
384         DO ji = mi0(ii0), mi1(ii1)
385            ua_ad(ji,jj  ,: ) = 0.0_wp !  North West Gibraltar
386         END DO
387      END DO
388
389      ! 139, 101 south point in Gibraltar
390      ij0 = 101   ;   ij1 = 101
391      ii0 = 139   ;   ii1 = 139
392      !                            ! deeper
393      DO jj = mj0(ij0), mj1(ij1)
394         DO ji = mi0(ii0), mi1(ii1)
395            ua_ad(ji,jj,21) = 0.0_wp
396            ua_ad(ji,jj,22) = 0.0_wp
397         END DO
398      END DO
399      !                            ! middle circulation
400      DO jk = 15, 20                     
401         DO jj = mj0(ij0), mj1(ij1)
402            DO ji = mi0(ii0), mi1(ii1)
403               ua_ad(ji,jj,jk) = 0.0_wp
404            END DO
405         END DO
406      END DO
407      !                            ! surface
408      DO jk = 1, 14                     
409         DO jj = mj0(ij0), mj1(ij1)
410            DO ji = mi0(ii0), mi1(ii1)
411               zempmed = zempmed + ua_ad(ji,jj,jk) / 14.0_wp &
412                  &            / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
413               ua_ad(ji,jj,jk) = 0.0_wp
414            END DO
415         END DO
416      END DO
417      DO jj = mj0(ij0), mj1(ij1)
418         DO ji = mi0(ii0), mi1(ii1)
419            ua_ad(ji,jj+1,: ) = 0.0_wp  !  North West Gibraltar
420            ua_ad(ji,jj  ,: ) = 0.0_wp  !  South West Gibraltar
421         END DO
422      END DO
423
424      ! Bab el Mandeb
425      ! -------------
426
427      ! 160,87 south point Bab el Mandeb
428      ij0 =  87   ;   ij1 =  87
429      ii0 = 160   ;   ii1 = 160
430
431      DO jj = mj0(ij0), mj1(ij1)
432         DO ji = mi0(ii0), mi1(ii1)
433            ua_ad(ji, jj,21) = 0.0_wp
434         END DO
435      END DO
436      DO jj = mj0(ij0), mj1(ij1)
437         DO ji = mi0(ii0), mi1(ii1)
438            ua_ad(ji,jj  ,: ) = 0.0_wp  !  South East Bab el Mandeb
439         END DO
440      END DO
441
442      ! 160,88 north point Bab el Mandeb
443      ij0 =  88   ;   ij1 =  88
444      ii0 = 160   ;   ii1 = 160
445      !                              ! deeper
446      DO jj = mj0(ij0), mj1(ij1)
447         DO ji = mi0(ii0), mi1(ii1)
448            ua_ad(ji, jj,21) = 0.0_wp
449         END DO
450      END DO
451      !                              ! surface
452      DO jk = 1, 8                                     
453         DO jj = mj0(ij0), mj1(ij1)
454            DO ji = mi0(ii0), mi1(ii1)
455               zempred = zempred - ua_ad(ji,jj,jk) / 8.0_wp &
456                  &            / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
457               ua_ad(ji,jj,jk) = 0.0_wp
458            END DO
459         END DO
460      END DO
461      DO jj = mj0(ij0), mj1(ij1)
462         DO ji = mi0(ii0), mi1(ii1)
463            ua_ad(ji,jj  ,: ) = 0.0_wp  !  North East Bab el Mandeb
464         END DO
465      END DO
466
467      ! EMP on Mediterranean Sea and Red Sea
468      ! ------------------------------------
469
470      ! we convert in m3
471      zempred = zempred * 1.e-3_wp
472
473!!!! AW: Adjoint of this????
474      IF( lk_mpp )   CALL mpp_sum( zempred )      ! sum with other processors value
475
476      ! compute the emp in Red Sea   
477      ij0 =  87   ;   ij1 =  96
478      ii0 = 148   ;   ii1 = 160
479      DO jj = mj0(ij0), mj1(ij1)
480         DO ji = mi0(ii0), mi1(ii1)
481            zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
482            emp_ad(ji,jj) = emp_ad(ji,jj) + zempred * zwei
483         END DO
484      END DO
485
486      ! we convert in m3
487      zempmed = zempmed * 1.e-3_wp
488
489!!!! AW: Adjoint of this????
490      IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value
491
492      ! minus 2 points in Red Sea and 3 in Atlantic
493      ij0 =  96   ;   ij1 =  96
494      ii0 = 148   ;   ii1 = 148
495      DO jj = mj0(ij0), mj1(ij1)
496         DO ji = mi0(ii0), mi1(ii1)
497            emp_ad(ji  ,jj) = emp_ad(ji  ,jj)                        &
498               &            - zempmed * tmask(ji  ,jj,1)             &
499               &                      * e1t(ji  ,jj) * e2t(ji  ,jj)
500            emp_ad(ji+1,jj) = emp_ad(ji+1,jj)                        &
501               &            - zempmed * tmask(ji+1,jj,1)             &
502               &                      * e1t(ji+1,jj) * e2t(ji+1,jj)   
503         END DO
504      END DO
505
506      ! compute the emp in Mediterranean Sea
507      ij0 =  96   ;   ij1 = 110
508      ii0 = 141   ;   ii1 = 181
509      DO jj = mj0(ij0), mj1(ij1)
510         DO ji = mi0(ii0), mi1(ii1)
511            zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
512            emp_ad(ji,jj) = emp_ad(ji,jj) + zempmed * zwei
513         END DO
514      END DO
515
516   END SUBROUTINE dyn_spg_cla_adj
517   !!======================================================================
518
519#endif
520END MODULE cla_dynspg_tam
Note: See TracBrowser for help on using the repository browser.