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.F90 in trunk/NEMO/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/cla_dynspg.F90 @ 1057

Last change on this file since 1057 was 888, checked in by ctlod, 16 years ago

merge dev_001_SBC branche with the trunk to include the New Surface Module package, see ticket: #113
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.0 KB
Line 
1MODULE cla_dynspg
2   !!======================================================================
3   !!                       ***  cla_dynspg  ***
4   !!======================================================================
5   !!   dyn_spg      : update the momentum trend with the surface pressure
6   !!                  gradient in the free surface constant volume case
7   !!                  with vector optimization
8   !!----------------------------------------------------------------------
9   !! * Modules used
10   USE oce             ! ocean dynamics and tracers
11   USE dom_oce         ! ocean space and time domain
12   USE zdf_oce         ! ocean vertical physics
13   USE obc_oce         ! Lateral open boundary condition
14   USE sol_oce         ! solver variables
15   USE sbc_oce         ! surface boundary condition: ocean
16   USE phycst          ! physical constants
17   USE solpcg          ! preconditionned conjugate gradient solver
18   USE solsor          ! Successive Over-relaxation solver
19   USE solfet          ! FETI solver
20   USE obcdyn          ! ocean open boundary condition (obc_dyn routines)
21   USE obcvol          ! ocean open boundary condition (obc_vol routines)
22   USE in_out_manager  ! I/O manager
23   USE lib_mpp         ! distribued memory computing
24   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
25
26   IMPLICIT NONE
27   PRIVATE
28
29   !! * Accessibility
30   PUBLIC dyn_spg_cla   ! routine called by step.F90
31
32   !! * Substitutions
33#  include "domzgr_substitute.h90"
34#  include "vectopt_loop_substitute.h90"
35   !!----------------------------------------------------------------------
36   !!   OPA 9.0 , LOCEAN-IPSL (2005)
37   !! $Id$
38   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
39   !!----------------------------------------------------------------------
40
41CONTAINS
42
43   SUBROUTINE dyn_spg_cla( kt ) 
44      !!----------------------------------------------------------------------
45      !!              ***  routine dyn_spg_cross_land  ***
46      !!
47      !! ** Purpose :
48      !!
49      !! ** Method :
50      !!
51      !! ** Action :
52      !!
53      !! History :
54      !!        !         (A. Bozec)  Original code
55      !!   8.5  !  02-11  (A. Bozec)  F90: Free form and module
56      !!---------------------------------------------------------------------
57      !! * Arguments
58      INTEGER, INTENT( in ) ::   kt           ! ocean time-step
59      !! * Local declarations
60      INTEGER  ::   ji, jj, jk                ! dummy loop indices
61      INTEGER  ::   ii0, ii1, ij0, ij1        ! temporary integer
62      REAL(wp) ::    &   
63         zempmed, zempred,   &                ! EMP on Med Sea ans Red Sea
64         zwei,   &                            !             
65         zisw_rs, zurw_rs, zbrw_rs,      &    ! imposed transport Red sea
66         zisw_ms, zurw_ms, zbrw_ms, zmrw_ms   ! imposed transport Med Sea
67      !!----------------------------------------------------------------------
68
69      ! Different velocities for straits ( Gibraltar, Bab el Mandeb...)
70         
71      ! Control print
72      ! -------------
73      IF( kt == nit000 ) THEN
74         IF(lwp) WRITE(numout,*)
75         IF(lwp) WRITE(numout,*) 'dynspg_cross_land : cross land advection on surface '
76         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~   pressure '
77         IF(lwp) WRITE(numout,*) ' '
78      ENDIF
79
80      ! EMP on Mediterranean Sea and Red Sea
81      ! ------------------------------------
82      ! compute the emp in Mediterranean Sea
83      zempmed = 0.e0
84      zwei = 0.e0
85      ij0 =  96   ;   ij1 = 110
86      ii0 = 141   ;   ii1 = 181
87      DO jj = mj0(ij0), mj1(ij1)
88         DO ji = mi0(ii0),mi1(ii1)
89            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
90            zempmed = zempmed + emp(ji,jj) * zwei
91         END DO
92      END DO
93      IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value
94
95      ! minus 2 points in Red Sea and 3 in Atlantic
96      ij0 =  96   ;   ij1 =  96
97      ii0 = 148   ;   ii1 = 148
98      DO jj = mj0(ij0), mj1(ij1)
99         DO ji = mi0(ii0),mi1(ii1)
100            zempmed = zempmed - emp(ji  ,jj) * tmask(ji  ,jj,1) * e1t(ji  ,jj) * e2t(ji  ,jj)   &
101               &              - emp(ji+1,jj) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)   
102         END DO
103      END DO
104      ! we convert in m3
105      zempmed = zempmed * 1.e-3
106
107      ! compute the emp in Red Sea   
108      zempred = 0.e0
109      zwei = 0.e0
110      ij0 =  87   ;   ij1 =  96
111      ii0 = 148   ;   ii1 = 160
112      DO jj = mj0(ij0), mj1(ij1)
113         DO ji = mi0(ii0),mi1(ii1)
114            zwei      = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
115            zempred   = zempred + emp(ji,jj) * zwei
116         END DO
117      END DO
118      IF( lk_mpp )   CALL mpp_sum( zempred )      ! sum with other processors value
119
120      ! we convert in m3
121      zempred = zempred * 1.e-3
122
123      ! New Transport at Bab el Mandeb and Gibraltar
124      ! --------------------------------------------
125
126      ! imposed transport at Bab el Mandeb
127      zisw_rs = 0.4e6        ! inflow surface water
128      zurw_rs = 0.2e6        ! upper recirculation water
129!!Alex      zbrw_rs = 1.2e6        ! bottom  recirculation water
130      zbrw_rs = 0.5e6        ! bottom  recirculation water
131
132      ! imposed transport at Gibraltar
133      zisw_ms  = 0.8e6          ! atlantic-mediterranean  water
134      zmrw_ms  = 0.7e6          ! middle recirculation water
135      zurw_ms  = 2.5e6          ! upper  recirculation water
136      zbrw_ms  = 3.5e6          ! bottom recirculation water
137
138      ! Different velocities for straits ( Gibraltar, Bab el Mandeb )
139      ! -------------------------------------------------------------
140
141      ! Bab el Mandeb
142      ! -------------
143      ! 160,88 north point Bab el Mandeb
144      ij0 =  88   ;   ij1 =  88
145      ii0 = 160   ;   ii1 = 160
146      DO jj = mj0(ij0), mj1(ij1)
147         DO ji = mi0(ii0),mi1(ii1)
148            ua(ji,jj  ,: ) = 0.e0  !  North East Bab el Mandeb
149         END DO
150      END DO
151      !                              ! surface
152      DO jk = 1,  8                                     
153         DO jj = mj0(ij0), mj1(ij1)
154            DO ji = mi0(ii0),mi1(ii1)
155               ua(ji, jj,jk) = -( ( zisw_rs + zempred ) / 8. ) / ( e2u(ji, jj) * fse3t(ji, jj,jk) )     
156            END DO
157         END DO
158      END DO
159      !                              ! deeper
160      DO jj = mj0(ij0), mj1(ij1)
161         DO ji = mi0(ii0),mi1(ii1)
162            ua(ji, jj,21) = - zbrw_rs / ( e2u(ji, jj) * fse3t(ji, jj,21) )
163         END DO
164      END DO
165
166      ! 160,87 south point Bab el Mandeb
167      ij0 =  87   ;   ij1 =  87
168      ii0 = 160   ;   ii1 = 160
169      DO jj = mj0(ij0), mj1(ij1)
170         DO ji = mi0(ii0),mi1(ii1)
171            ua(ji,jj  ,: ) = 0.e0  !  South East Bab el Mandeb
172         END DO
173      END DO
174      DO jj = mj0(ij0), mj1(ij1)
175         DO ji = mi0(ii0),mi1(ii1)
176            ua(ji, jj,21) =  ( zisw_rs + zbrw_rs ) / ( e2u(ji,jj )*fse3t(ji, jj,21) )     
177         END DO
178      END DO
179
180      ! Gibraltar
181      ! ---------
182
183      ! initialisation of velocity at concerned points
184      ! 139, 101 south point in Gibraltar
185      ij0 = 101   ;   ij1 = 101
186      ii0 = 139   ;   ii1 = 139
187      DO jj = mj0(ij0), mj1(ij1)
188         DO ji = mi0(ii0),mi1(ii1)
189            ua(ji,jj  ,: ) = 0.e0  !  South West Gibraltar
190            ua(ji,jj+1,: ) = 0.e0  !  North West Gibraltar
191         END DO
192      END DO
193      !                            ! surface
194      DO jk = 1, 14                     
195         DO jj = mj0(ij0), mj1(ij1)
196            DO ji = mi0(ii0),mi1(ii1)
197               ua(ji,jj,jk) =  ( ( zisw_ms + zempmed ) / 14. ) / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
198            END DO
199         END DO
200      END DO
201      !                            ! middle circulation
202      DO jk = 15, 20                     
203         DO jj = mj0(ij0), mj1(ij1)
204            DO ji = mi0(ii0),mi1(ii1)
205               ua(ji,jj,jk) =  ( zmrw_ms / 6. ) / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
206            END DO
207         END DO
208      END DO
209      !                            ! deeper
210      DO jj = mj0(ij0), mj1(ij1)
211         DO ji = mi0(ii0),mi1(ii1)
212            ua(ji,jj,21) =             zurw_ms   / ( e2u(ji,jj) * fse3t(ji,jj,21) )
213            ua(ji,jj,22) = ( zbrw_ms - zurw_ms ) / ( e2u(ji,jj) * fse3t(ji,jj,22) )
214         END DO
215      END DO
216
217      ! 139,102 north point in Gibraltar
218      ij0 = 102   ;   ij1 = 102
219      ii0 = 139   ;   ii1 = 139
220      DO jj = mj0(ij0), mj1(ij1)
221         DO ji = mi0(ii0),mi1(ii1)
222            ua(ji,jj  ,: ) = 0.e0  !  North West Gibraltar
223         END DO
224      END DO
225      DO jk = 15, 20                     
226         DO jj = mj0(ij0), mj1(ij1)
227            DO ji = mi0(ii0),mi1(ii1)
228               ua(ji,jj,jk) = -( zmrw_ms / 6. ) / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
229            END DO
230         END DO
231      END DO
232      !                            ! deeper
233      DO jj = mj0(ij0), mj1(ij1)
234         DO ji = mi0(ii0),mi1(ii1)
235            ua(ji,jj,22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji,jj) * fse3t(ji,jj,22) )
236         END DO
237      END DO
238
239   END SUBROUTINE dyn_spg_cla
240
241   !!======================================================================
242END MODULE cla_dynspg
Note: See TracBrowser for help on using the repository browser.