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 branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC – NEMO

source: branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/cla_dynspg.F90 @ 2000

Last change on this file since 2000 was 2000, checked in by acc, 14 years ago

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