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.
bdytides.F90 in branches/2013/dev_r3853_CNRS9_ConfSetting/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/2013/dev_r3853_CNRS9_ConfSetting/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90 @ 3875

Last change on this file since 3875 was 3875, checked in by clevy, 11 years ago

Configuration Setting/Step? 1, see ticket:#1074
  • Property svn:keywords set to Id
File size: 22.0 KB
Line 
1MODULE bdytides
2   !!======================================================================
3   !!                       ***  MODULE  bdytides  ***
4   !! Ocean dynamics:   Tidal forcing at open boundaries
5   !!======================================================================
6   !! History :  2.0  !  2007-01  (D.Storkey)  Original code
7   !!            2.3  !  2008-01  (J.Holt)  Add date correction. Origins POLCOMS v6.3 2007
8   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
9   !!            3.3  !  2010-09  (D.Storkey and E.O'Dea)  bug fixes
10   !!            3.4  !  2012-09  (G. Reffray and J. Chanut) New inputs + mods
11   !!----------------------------------------------------------------------
12#if defined key_bdy
13   !!----------------------------------------------------------------------
14   !!   'key_bdy'     Open Boundary Condition
15   !!----------------------------------------------------------------------
16   !!   PUBLIC
17   !!      bdytide_init     : read of namelist and initialisation of tidal harmonics data
18   !!      tide_update   : calculation of tidal forcing at each timestep
19   !!----------------------------------------------------------------------
20   USE timing          ! Timing
21   USE oce             ! ocean dynamics and tracers
22   USE dom_oce         ! ocean space and time domain
23   USE iom
24   USE in_out_manager  ! I/O units
25   USE phycst          ! physical constants
26   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
27   USE bdy_par         ! Unstructured boundary parameters
28   USE bdy_oce         ! ocean open boundary conditions
29   USE daymod          ! calendar
30   USE wrk_nemo        ! Memory allocation
31   USE tideini
32!   USE tide_mod       ! Useless ??
33   USE fldread, ONLY: fld_map
34
35   IMPLICIT NONE
36   PRIVATE
37
38   PUBLIC   bdytide_init     ! routine called in bdy_init
39   PUBLIC   bdytide_update   ! routine called in bdy_dta
40
41   TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data
42      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0       !: Tidal constituents : SSH0 (read in file)
43      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0         !: Tidal constituents : U0   (read in file)
44      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v0         !: Tidal constituents : V0   (read in file)
45      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh        !: Tidal constituents : SSH  (after nodal cor.)
46      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u          !: Tidal constituents : U    (after nodal cor.)
47      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V    (after nodal cor.)
48   END TYPE TIDES_DATA
49
50   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides  !: External tidal harmonics data
51
52   !!----------------------------------------------------------------------
53   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
54   !! $Id$
55   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
56   !!----------------------------------------------------------------------
57CONTAINS
58
59   SUBROUTINE bdytide_init
60      !!----------------------------------------------------------------------
61      !!                    ***  SUBROUTINE bdytide_init  ***
62      !!                     
63      !! ** Purpose : - Read in namelist for tides and initialise external
64      !!                tidal harmonics data
65      !!
66      !!----------------------------------------------------------------------
67      !! namelist variables
68      !!-------------------
69      CHARACTER(len=80)                         ::   filtide             !: Filename root for tidal input files
70      LOGICAL                                   ::   ln_bdytide_2ddta    !: If true, read 2d harmonic data
71      LOGICAL                                   ::   ln_bdytide_conj     !: If true, assume complex conjugate tidal data
72      !!
73      INTEGER                                   ::   ib_bdy, itide, ib   !: dummy loop indices
74      INTEGER                                   ::   ii, ij              !: dummy loop indices
75      INTEGER                                   ::   inum, igrd
76      INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays)
77      INTEGER, POINTER, DIMENSION(:)            ::   nblen, nblenrim     ! short cuts
78      INTEGER                                   ::   ios                 ! Local integer output status for namelist read
79      CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file
80      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            !: work space to read in tidal harmonics data
81      REAL(wp), POINTER, DIMENSION(:,:)         ::   ztr, zti            !:  "     "    "   "   "   "        "      "
82      !!
83      TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut   
84      !!
85      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
86      !!----------------------------------------------------------------------
87
88      IF( nn_timing == 1 ) CALL timing_start('bdytide_init')
89
90      IF (nb_bdy>0) THEN
91         IF(lwp) WRITE(numout,*)
92         IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries'
93         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
94      ENDIF
95
96      ln_bdytide_2ddta = .FALSE.
97      ln_bdytide_conj  = .FALSE.
98
99      REWIND(numnam_cfg)
100
101      DO ib_bdy = 1, nb_bdy
102         IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN
103
104            td => tides(ib_bdy)
105            nblen => idx_bdy(ib_bdy)%nblen
106            nblenrim => idx_bdy(ib_bdy)%nblenrim
107
108            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
109            filtide(:) = ''
110
111            ! Don't REWIND here - may need to read more than one of these namelists.
112            ! Read only configuration namelist to avoid unsecessful overwrite
113!!          REWIND( numnam_ref )              ! Namelist nambdy_tide in reference namelist :
114!!          READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901)
115!!    901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwp )
116
117!!          REWIND( numnam_cfg )              ! Namelist nambdy_tide in configuration namelist :
118            READ  ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 )
119902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwp )
120            WRITE ( numond, nambdy_tide )
121            !                                               ! Parameter control and print
122            IF(lwp) WRITE(numout,*) '  '
123            IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
124            IF(lwp) WRITE(numout,*) '             read tidal data in 2d files: ', ln_bdytide_2ddta
125            IF(lwp) WRITE(numout,*) '             assume complex conjugate   : ', ln_bdytide_conj
126            IF(lwp) WRITE(numout,*) '             Number of tidal components to read: ', nb_harmo
127            IF(lwp) THEN
128                    WRITE(numout,*) '             Tidal cpt name    -     Phase speed (deg/hr)'           
129               DO itide = 1, nb_harmo
130                  WRITE(numout,*)  '             ', Wave(ntide(itide))%cname_tide, omega_tide(itide)   
131               END DO
132            ENDIF
133            IF(lwp) WRITE(numout,*) ' '
134
135            ! Allocate space for tidal harmonics data - get size from OBC data arrays
136            ! -----------------------------------------------------------------------
137
138            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole
139            ! relaxation area     
140            IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
141               ilen0(:)=nblen(:)
142            ELSE
143               ilen0(:)=nblenrim(:)
144            ENDIF
145
146            ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) )
147            ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) )
148
149            ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) )
150            ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) )
151
152            ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) )
153            ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) )
154
155            td%ssh0(:,:,:) = 0.e0
156            td%ssh(:,:,:) = 0.e0
157            td%u0(:,:,:) = 0.e0
158            td%u(:,:,:) = 0.e0
159            td%v0(:,:,:) = 0.e0
160            td%v(:,:,:) = 0.e0
161
162            IF (ln_bdytide_2ddta) THEN
163               ! It is assumed that each data file contains all complex harmonic amplitudes
164               ! given on the data domain (ie global, jpidta x jpjdta)
165               !
166               CALL wrk_alloc( jpi, jpj, zti, ztr )
167               !
168               ! SSH fields
169               clfile = TRIM(filtide)//'_grid_T.nc'
170               CALL iom_open (clfile , inum ) 
171               igrd = 1                       ! Everything is at T-points here
172               DO itide = 1, nb_harmo
173                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
174                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) ) 
175                  DO ib = 1, ilen0(igrd)
176                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
177                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
178                     td%ssh0(ib,itide,1) = ztr(ii,ij)
179                     td%ssh0(ib,itide,2) = zti(ii,ij)
180                  END DO
181               END DO
182               CALL iom_close( inum )
183               !
184               ! U fields
185               clfile = TRIM(filtide)//'_grid_U.nc'
186               CALL iom_open (clfile , inum ) 
187               igrd = 2                       ! Everything is at U-points here
188               DO itide = 1, nb_harmo
189                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) )
190                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) )
191                  DO ib = 1, ilen0(igrd)
192                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
193                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
194                     td%u0(ib,itide,1) = ztr(ii,ij)
195                     td%u0(ib,itide,2) = zti(ii,ij)
196                  END DO
197               END DO
198               CALL iom_close( inum )
199               !
200               ! V fields
201               clfile = TRIM(filtide)//'_grid_V.nc'
202               CALL iom_open (clfile , inum ) 
203               igrd = 3                       ! Everything is at V-points here
204               DO itide = 1, nb_harmo
205                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) )
206                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) )
207                  DO ib = 1, ilen0(igrd)
208                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
209                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
210                     td%v0(ib,itide,1) = ztr(ii,ij)
211                     td%v0(ib,itide,2) = zti(ii,ij)
212                  END DO
213               END DO 
214               CALL iom_close( inum )
215               !
216               CALL wrk_dealloc( jpi, jpj, ztr, zti ) 
217               !
218            ELSE           
219               !
220               ! Read tidal data only on bdy segments
221               !
222               ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
223
224               ! Open files and read in tidal forcing data
225               ! -----------------------------------------
226
227               DO itide = 1, nb_harmo
228                  !                                                              ! SSH fields
229                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
230                  CALL iom_open( clfile, inum )
231                  CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
232                  td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
233                  CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
234                  td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
235                  CALL iom_close( inum )
236                  !                                                              ! U fields
237                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
238                  CALL iom_open( clfile, inum )
239                  CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
240                  td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
241                  CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
242                  td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
243                  CALL iom_close( inum )
244                  !                                                              ! V fields
245                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
246                  CALL iom_open( clfile, inum )
247                  CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
248                  td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
249                  CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
250                  td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
251                  CALL iom_close( inum )
252                  !
253               END DO ! end loop on tidal components
254               !
255               DEALLOCATE( dta_read )
256            ENDIF ! ln_bdytide_2ddta=.true.
257            !
258            IF ( ln_bdytide_conj ) THEN ! assume complex conjugate in data files
259               td%ssh0(:,:,2) = - td%ssh0(:,:,2)
260               td%u0  (:,:,2) = - td%u0  (:,:,2)
261               td%v0  (:,:,2) = - td%v0  (:,:,2)
262            ENDIF
263            !
264         ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2
265         !
266      END DO ! loop on ib_bdy
267
268      IF( nn_timing == 1 ) CALL timing_stop('bdytide_init')
269
270   END SUBROUTINE bdytide_init
271
272   SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset )
273      !!----------------------------------------------------------------------
274      !!                 ***  SUBROUTINE bdytide_update  ***
275      !!               
276      !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
277      !!               
278      !!----------------------------------------------------------------------
279      INTEGER, INTENT( in )            ::   kt          ! Main timestep counter
280      TYPE(OBC_INDEX), INTENT( in )    ::   idx         ! OBC indices
281      TYPE(OBC_DATA),  INTENT(inout)   ::   dta         ! OBC external data
282      TYPE(TIDES_DATA),INTENT( inout ) ::   td          ! tidal harmonics data
283      INTEGER,INTENT(in),OPTIONAL      ::   jit         ! Barotropic timestep counter (for timesplitting option)
284      INTEGER,INTENT( in ), OPTIONAL   ::   time_offset ! time offset in units of timesteps. NB. if jit
285                                                        ! is present then units = subcycle timesteps.
286                                                        ! time_offset = 0  => get data at "now"    time level
287                                                        ! time_offset = -1 => get data at "before" time level
288                                                        ! time_offset = +1 => get data at "after"  time level
289                                                        ! etc.
290      !!
291      INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays)
292      INTEGER                          :: itide, igrd, ib   ! dummy loop indices
293      INTEGER                          :: time_add          ! time offset in units of timesteps
294      REAL(wp)                         :: z_arg, z_sarg, zflag, zramp     
295      REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
296      !!----------------------------------------------------------------------
297
298      IF( nn_timing == 1 ) CALL timing_start('bdytide_update')
299
300      ilen0(1) =  SIZE(td%ssh(:,1,1))
301      ilen0(2) =  SIZE(td%u(:,1,1))
302      ilen0(3) =  SIZE(td%v(:,1,1))
303
304      zflag=1
305      IF ( PRESENT(jit) ) THEN
306        IF ( jit /= 1 ) zflag=0
307      ENDIF
308
309      IF ( nsec_day == NINT(0.5 * rdttra(1)) .AND. zflag==1 ) THEN
310        !
311        kt_tide = kt
312        !
313        IF(lwp) THEN
314           WRITE(numout,*)
315           WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt
316           WRITE(numout,*) '~~~~~~~~~~~~~~ '
317        ENDIF
318        !
319        CALL tide_init_elevation ( idx, td )
320        CALL tide_init_velocities( idx, td )
321        !
322      ENDIF
323
324      time_add = 0
325      IF( PRESENT(time_offset) ) THEN
326         time_add = time_offset
327      ENDIF
328         
329      IF( PRESENT(jit) ) THEN 
330         z_arg = ( ((kt-kt_tide)-1) * rdt + (jit+time_add) * rdt / REAL(nn_baro,wp) )
331      ELSE                             
332         z_arg = ((kt-kt_tide)+time_add) * rdt
333      ENDIF
334
335      ! Linear ramp on tidal component at open boundaries
336      zramp = 1.
337      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rdt)/(rdttideramp*rday),0.),1.)
338
339      DO itide = 1, nb_harmo
340         z_sarg = z_arg * omega_tide(itide)
341         z_cost(itide) = COS( z_sarg )
342         z_sist(itide) = SIN( z_sarg )
343      END DO
344
345      DO itide = 1, nb_harmo
346         igrd=1                              ! SSH on tracer grid
347         DO ib = 1, ilen0(igrd)
348            dta%ssh(ib) = dta%ssh(ib) + zramp*(td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
349         END DO
350         igrd=2                              ! U grid
351         DO ib = 1, ilen0(igrd)
352            dta%u2d(ib) = dta%u2d(ib) + zramp*(td%u  (ib,itide,1)*z_cost(itide) + td%u  (ib,itide,2)*z_sist(itide))
353         END DO
354         igrd=3                              ! V grid
355         DO ib = 1, ilen0(igrd) 
356            dta%v2d(ib) = dta%v2d(ib) + zramp*(td%v  (ib,itide,1)*z_cost(itide) + td%v  (ib,itide,2)*z_sist(itide))
357         END DO
358      END DO
359      !
360      IF( nn_timing == 1 ) CALL timing_stop('bdytide_update')
361      !
362   END SUBROUTINE bdytide_update
363
364   SUBROUTINE tide_init_elevation( idx, td )
365      !!----------------------------------------------------------------------
366      !!                 ***  ROUTINE tide_init_elevation  ***
367      !!----------------------------------------------------------------------
368      TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices
369      TYPE(TIDES_DATA),INTENT( inout )   ::   td      ! tidal harmonics data
370      !! * Local declarations
371      INTEGER, DIMENSION(1)            ::   ilen0       !: length of boundary data (from OBC arrays)
372      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
373      INTEGER                            ::   itide, igrd, ib      ! dummy loop indices
374
375      igrd=1   
376                              ! SSH on tracer grid.
377   
378      ilen0(1) =  SIZE(td%ssh0(:,1,1))
379
380      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
381
382      DO itide = 1, nb_harmo
383         DO ib = 1, ilen0(igrd)
384            mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.)
385            phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
386         END DO
387         DO ib = 1 , ilen0(igrd)
388            mod_tide(ib)=mod_tide(ib)*ftide(itide)
389            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
390         ENDDO
391         DO ib = 1 , ilen0(igrd)
392            td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
393            td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
394         ENDDO
395      END DO
396
397      DEALLOCATE(mod_tide,phi_tide)
398
399   END SUBROUTINE tide_init_elevation
400
401   SUBROUTINE tide_init_velocities( idx, td )
402      !!----------------------------------------------------------------------
403      !!                 ***  ROUTINE tide_init_elevation  ***
404      !!----------------------------------------------------------------------
405      TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices
406      TYPE(TIDES_DATA),INTENT( inout )      ::   td      ! tidal harmonics data
407      !! * Local declarations
408      INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays)
409      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
410      INTEGER                            ::   itide, igrd, ib      ! dummy loop indices
411
412      ilen0(2) =  SIZE(td%u0(:,1,1))
413      ilen0(3) =  SIZE(td%v0(:,1,1))
414
415      igrd=2                                 ! U grid.
416
417      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
418
419      DO itide = 1, nb_harmo
420         DO ib = 1, ilen0(igrd)
421            mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.)
422            phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
423         END DO
424         DO ib = 1, ilen0(igrd)
425            mod_tide(ib)=mod_tide(ib)*ftide(itide)
426            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
427         ENDDO
428         DO ib = 1, ilen0(igrd)
429            td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
430            td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
431         ENDDO
432      END DO
433
434      DEALLOCATE(mod_tide,phi_tide)
435
436      igrd=3                                 ! V grid.
437
438      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
439
440      DO itide = 1, nb_harmo
441         DO ib = 1, ilen0(igrd)
442            mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.)
443            phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
444         END DO
445         DO ib = 1, ilen0(igrd)
446            mod_tide(ib)=mod_tide(ib)*ftide(itide)
447            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
448         ENDDO
449         DO ib = 1, ilen0(igrd)
450            td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
451            td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
452         ENDDO
453      END DO
454
455      DEALLOCATE(mod_tide,phi_tide)
456
457  END SUBROUTINE tide_init_velocities
458#else
459   !!----------------------------------------------------------------------
460   !!   Dummy module         NO Unstruct Open Boundary Conditions for tides
461   !!----------------------------------------------------------------------
462CONTAINS
463   SUBROUTINE bdytide_init             ! Empty routine
464      WRITE(*,*) 'bdytide_init: You should not have seen this print! error?'
465   END SUBROUTINE bdytide_init
466   SUBROUTINE bdytide_update( kt, jit )   ! Empty routine
467      WRITE(*,*) 'bdytide_update: You should not have seen this print! error?', kt, jit
468   END SUBROUTINE bdytide_update
469#endif
470
471   !!======================================================================
472END MODULE bdytides
Note: See TracBrowser for help on using the repository browser.