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 NEMO/branches/2020/r12581_ticket2418/src/OCE/BDY – NEMO

source: NEMO/branches/2020/r12581_ticket2418/src/OCE/BDY/bdytides.F90 @ 12930

Last change on this file since 12930 was 12930, checked in by smasson, 5 years ago

r12581_ticket2418: update with trunk @12929, see #2418
  • Property svn:keywords set to Id
File size: 23.3 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   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
12   !!----------------------------------------------------------------------
13   !!   bdytide_init  : read of namelist and initialisation of tidal harmonics data
14   !!   tide_update   : calculation of tidal forcing at each timestep
15   !!----------------------------------------------------------------------
16   USE oce            ! ocean dynamics and tracers
17   USE dom_oce        ! ocean space and time domain
18   USE phycst         ! physical constants
19   USE bdy_oce        ! ocean open boundary conditions
20   USE tide_mod       !
21   USE daymod         ! calendar
22   !
23   USE in_out_manager ! I/O units
24   USE iom            ! xIO server
25   USE fldread        !
26   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   bdytide_init     ! routine called in bdy_init
32   PUBLIC   bdy_dta_tides    ! routine called in dyn_spg_ts
33
34   TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data
35      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0     !: Tidal constituents : SSH0   (read in file)
36      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0, v0   !: Tidal constituents : U0, V0 (read in file)
37      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh      !: Tidal constituents : SSH    (after nodal cor.)
38      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u , v    !: Tidal constituents : U , V  (after nodal cor.)
39   END TYPE TIDES_DATA
40
41!$AGRIF_DO_NOT_TREAT
42   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides  !: External tidal harmonics data
43!$AGRIF_END_DO_NOT_TREAT
44   TYPE(OBC_DATA)  , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component)
45
46   INTEGER ::   kt_tide
47
48   !! * Substitutions
49#  include "do_loop_substitute.h90"
50   !!----------------------------------------------------------------------
51   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
52   !! $Id$
53   !! Software governed by the CeCILL license (see ./LICENSE)
54   !!----------------------------------------------------------------------
55CONTAINS
56
57   SUBROUTINE bdytide_init
58      !!----------------------------------------------------------------------
59      !!                    ***  SUBROUTINE bdytide_init  ***
60      !!                     
61      !! ** Purpose : - Read in namelist for tides and initialise external
62      !!                tidal harmonics data
63      !!
64      !!----------------------------------------------------------------------
65      !! namelist variables
66      !!-------------------
67      CHARACTER(len=80)                         ::   filtide             ! Filename root for tidal input files
68      LOGICAL                                   ::   ln_bdytide_2ddta    ! If true, read 2d harmonic data
69      !!
70      INTEGER                                   ::   ib_bdy, itide, ib   ! dummy loop indices
71      INTEGER                                   ::   ii, ij              ! dummy loop indices
72      INTEGER                                   ::   inum, igrd
73      INTEGER                                   ::   isz                 ! bdy data size
74      INTEGER                                   ::   ios                 ! Local integer output status for namelist read
75      INTEGER                                   ::   nbdy_rdstart, nbdy_loc
76      CHARACTER(LEN=50)                         ::   cerrmsg             ! error string
77      CHARACTER(len=80)                         ::   clfile              ! full file name for tidal input file
78      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            ! work space to read in tidal harmonics data
79      REAL(wp),ALLOCATABLE, DIMENSION(:,:)      ::   ztr, zti            !  "     "    "   "   "   "        "      "
80      !!
81      TYPE(TIDES_DATA), POINTER                 ::   td                  ! local short cut   
82      TYPE(  OBC_DATA), POINTER                 ::   dta                 ! local short cut
83      !!
84      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta
85      !!----------------------------------------------------------------------
86      !
87      IF(lwp) WRITE(numout,*)
88      IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries'
89      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
90
91
92      nbdy_rdstart = 1
93      DO ib_bdy = 1, nb_bdy
94         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
95            !
96            td  => tides(ib_bdy)
97            dta => dta_bdy(ib_bdy)
98         
99            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
100            filtide(:) = ''
101
102            READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901)
103901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_tide in reference namelist' )
104            !
105            ! Need to support possibility of reading more than one
106            ! nambdy_tide from the namelist_cfg internal file.
107            ! Do this by finding the ib_bdy'th occurence of nambdy_tide in the
108            ! character buffer as the starting point.
109            !
110            nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_tide' )
111            IF( nbdy_loc .GT. 0 ) THEN
112               nbdy_rdstart = nbdy_rdstart + nbdy_loc
113            ELSE
114               WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',ib_bdy,' of nambdy_tide not found'
115               ios = -1
116               CALL ctl_nam ( ios , cerrmsg )
117            ENDIF
118            READ  ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_tide, IOSTAT = ios, ERR = 902)
119902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' )
120            IF(lwm) 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,*) '             Number of tidal components to read: ', nb_harmo
126            IF(lwp) THEN
127                    WRITE(numout,*) '             Tidal components: ' 
128               DO itide = 1, nb_harmo
129                  WRITE(numout,*)  '                 ', tide_harmonics(itide)%cname_tide 
130               END DO
131            ENDIF
132            IF(lwp) WRITE(numout,*) ' '
133
134            ! Allocate space for tidal harmonics data - get size from BDY data arrays
135            ! Allocate also slow varying data in the case of time splitting:
136            ! Do it anyway because at this stage knowledge of free surface scheme is unknown
137            ! -----------------------------------------------------------------------
138            IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain
139               isz = SIZE(dta%ssh)
140               ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) )
141               dta_bdy_s(ib_bdy)%ssh(:) = 0._wp   ! needed?
142            ENDIF
143            IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain
144               isz = SIZE(dta%u2d)
145               ALLOCATE( td%u0  ( isz, nb_harmo, 2 ), td%u  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) )
146               dta_bdy_s(ib_bdy)%u2d(:) = 0._wp   ! needed?
147            ENDIF
148            IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain
149               isz = SIZE(dta%v2d)
150               ALLOCATE( td%v0  ( isz, nb_harmo, 2 ), td%v  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) )
151               dta_bdy_s(ib_bdy)%v2d(:) = 0._wp   ! needed?
152            ENDIF
153
154            ! fill td%ssh0, td%u0, td%v0
155            ! -----------------------------------------------------------------------
156            IF( ln_bdytide_2ddta ) THEN
157               !
158               ! It is assumed that each data file contains all complex harmonic amplitudes
159               ! given on the global domain (ie global, jpiglo x jpjglo)
160               !
161               ALLOCATE( zti(jpi,jpj), ztr(jpi,jpj) )
162               !
163               ! SSH fields
164               IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain
165                  clfile = TRIM(filtide)//'_grid_T.nc'
166                  CALL iom_open( clfile , inum ) 
167                  igrd = 1                       ! Everything is at T-points here
168                  DO itide = 1, nb_harmo
169                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) )
170                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) ) 
171                     DO ib = 1, SIZE(dta%ssh)
172                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
173                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
174                        td%ssh0(ib,itide,1) = ztr(ii,ij)
175                        td%ssh0(ib,itide,2) = zti(ii,ij)
176                     END DO
177                  END DO
178                  CALL iom_close( inum )
179               ENDIF
180               !
181               ! U fields
182               IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain
183                  clfile = TRIM(filtide)//'_grid_U.nc'
184                  CALL iom_open( clfile , inum ) 
185                  igrd = 2                       ! Everything is at U-points here
186                  DO itide = 1, nb_harmo
187                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) )
188                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) )
189                     DO ib = 1, SIZE(dta%u2d)
190                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
191                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
192                        td%u0(ib,itide,1) = ztr(ii,ij)
193                        td%u0(ib,itide,2) = zti(ii,ij)
194                     END DO
195                  END DO
196                  CALL iom_close( inum )
197               ENDIF
198               !
199               ! V fields
200               IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain
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_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) )
206                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) )
207                     DO ib = 1, SIZE(dta%v2d)
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               ENDIF
216               !
217               DEALLOCATE( ztr, zti ) 
218               !
219            ELSE           
220               !
221               ! Read tidal data only on bdy segments
222               !
223               ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) )
224               !
225               ! Open files and read in tidal forcing data
226               ! -----------------------------------------
227
228               DO itide = 1, nb_harmo
229                  !                                                              ! SSH fields
230                  IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain
231                     isz = SIZE(dta%ssh)
232                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc'
233                     CALL iom_open( clfile, inum )
234                     CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
235                     td%ssh0(:,itide,1) = dta_read(1:isz,1,1)
236                     CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
237                     td%ssh0(:,itide,2) = dta_read(1:isz,1,1)
238                     CALL iom_close( inum )
239                  ENDIF
240                  !                                                              ! U fields
241                  IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain
242                     isz = SIZE(dta%u2d)
243                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc'
244                     CALL iom_open( clfile, inum )
245                     CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
246                     td%u0(:,itide,1) = dta_read(1:isz,1,1)
247                     CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
248                     td%u0(:,itide,2) = dta_read(1:isz,1,1)
249                     CALL iom_close( inum )
250                  ENDIF
251                  !                                                              ! V fields
252                  IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain
253                     isz = SIZE(dta%v2d)
254                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc'
255                     CALL iom_open( clfile, inum )
256                     CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
257                     td%v0(:,itide,1) = dta_read(1:isz,1,1)
258                     CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
259                     td%v0(:,itide,2) = dta_read(1:isz,1,1)
260                     CALL iom_close( inum )
261                  ENDIF
262                  !
263               END DO ! end loop on tidal components
264               !
265               DEALLOCATE( dta_read )
266               !
267            ENDIF ! ln_bdytide_2ddta=.true.
268            !
269         ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2
270         !
271      END DO ! loop on ib_bdy
272      !
273   END SUBROUTINE bdytide_init
274
275
276   SUBROUTINE bdy_dta_tides( kt, kit, pt_offset )
277      !!----------------------------------------------------------------------
278      !!                 ***  SUBROUTINE bdy_dta_tides  ***
279      !!               
280      !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
281      !!               
282      !!----------------------------------------------------------------------
283      INTEGER,           INTENT(in) ::   kt          ! Main timestep counter
284      INTEGER, OPTIONAL, INTENT(in) ::   kit         ! Barotropic timestep counter (for timesplitting option)
285      REAL(wp),OPTIONAL, INTENT(in) ::   pt_offset   ! time offset in units of timesteps
286      !
287      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step
288      INTEGER  ::   itide, ib_bdy, ib         ! loop indices
289      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset   
290      !!----------------------------------------------------------------------
291      !
292      lk_first_btstp=.TRUE.
293      IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF
294
295      zt_offset = 0._wp
296      IF( PRESENT(pt_offset) )   zt_offset = pt_offset
297     
298      ! Absolute time from model initialization:   
299      IF( PRESENT(kit) ) THEN 
300         z_arg = ( REAL(kt, wp) + ( REAL(kit, wp) + zt_offset - 1. ) / REAL(nn_e, wp) ) * rn_Dt
301      ELSE                             
302         z_arg = ( REAL(kt, wp) + zt_offset ) * rn_Dt
303      ENDIF
304
305      ! Linear ramp on tidal component at open boundaries
306      zramp = 1.
307      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - REAL(nit000,wp)*rn_Dt)/(rn_tide_ramp_dt*rday),0.),1.)
308
309      DO ib_bdy = 1,nb_bdy
310         !
311         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
312            !
313            ! We refresh nodal factors every day below
314            ! This should be done somewhere else
315            IF ( ( nsec_day == NINT(0.5_wp * rn_Dt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN
316               !
317               kt_tide = kt - NINT((REAL(nsec_day,wp) - 0.5_wp * rn_Dt)/rn_Dt)
318               !
319               IF(lwp) THEN
320               WRITE(numout,*)
321               WRITE(numout,*) 'bdy_tide_dta : Refresh nodal factors for tidal open bdy data at kt=',kt
322               WRITE(numout,*) '~~~~~~~~~~~~~~ '
323               ENDIF
324               !
325               CALL tide_init_elevation ( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
326               CALL tide_init_velocities( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
327               !
328            ENDIF
329            zoff = REAL(-kt_tide,wp) * rn_Dt ! time offset relative to nodal factor computation time
330            !
331            ! If time splitting, initialize arrays from slow varying open boundary data:
332            IF ( PRESENT(kit) ) THEN           
333               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:)
334               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:)
335               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:)
336            ENDIF
337            !
338            ! Update open boundary data arrays:
339            DO itide = 1, nb_harmo
340               !
341               z_sarg = (z_arg + zoff) * tide_harmonics(itide)%omega
342               z_cost = zramp * COS( z_sarg )
343               z_sist = zramp * SIN( z_sarg )
344               !
345               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN   ! SSH on tracer grid
346                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh)
347                     dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + &
348                        &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + &
349                        &                        tides(ib_bdy)%ssh(ib,itide,2)*z_sist )
350                  END DO
351               ENDIF
352               !
353               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN  ! U grid
354                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d)
355                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + &
356                        &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + &
357                        &                        tides(ib_bdy)%u(ib,itide,2)*z_sist )
358                  END DO
359               ENDIF
360               !
361               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN   ! V grid
362                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d)
363                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + &
364                        &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + &
365                        &                        tides(ib_bdy)%v(ib,itide,2)*z_sist )
366                  END DO
367               ENDIF
368               !
369            END DO             
370         ENDIF
371      END DO
372      !
373   END SUBROUTINE bdy_dta_tides
374
375
376   SUBROUTINE tide_init_elevation( idx, td )
377      !!----------------------------------------------------------------------
378      !!                 ***  ROUTINE tide_init_elevation  ***
379      !!----------------------------------------------------------------------
380      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices
381      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data
382      !
383      INTEGER ::   itide, isz, ib       ! dummy loop indices
384      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
385      !!----------------------------------------------------------------------
386      !
387      IF( ASSOCIATED(td%ssh0) ) THEN   ! SSH on tracer grid.
388         !
389         isz = SIZE( td%ssh0, dim = 1 )
390         ALLOCATE( mod_tide(isz), phi_tide(isz) )
391         !
392         DO itide = 1, nb_harmo
393            DO ib = 1, isz
394               mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)*td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)*td%ssh0(ib,itide,2) )
395               phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
396            END DO
397            DO ib = 1, isz
398               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f
399               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u
400            END DO
401            DO ib = 1, isz
402               td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
403               td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
404            END DO
405         END DO
406         !
407         DEALLOCATE( mod_tide, phi_tide )
408         !
409      ENDIF
410      !
411   END SUBROUTINE tide_init_elevation
412
413
414   SUBROUTINE tide_init_velocities( idx, td )
415      !!----------------------------------------------------------------------
416      !!                 ***  ROUTINE tide_init_elevation  ***
417      !!----------------------------------------------------------------------
418      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices
419      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data
420      !
421      INTEGER ::   itide, isz, ib        ! dummy loop indices
422      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
423      !!----------------------------------------------------------------------
424      !
425      IF( ASSOCIATED(td%u0) ) THEN   ! U grid. we use bdy u2d on this mpi subdomain
426         !
427         isz = SIZE( td%u0, dim = 1 )
428         ALLOCATE( mod_tide(isz), phi_tide(isz) )
429         !
430         DO itide = 1, nb_harmo
431            DO ib = 1, isz
432               mod_tide(ib)=SQRT( td%u0(ib,itide,1)*td%u0(ib,itide,1) + td%u0(ib,itide,2)*td%u0(ib,itide,2) )
433               phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
434            END DO
435            DO ib = 1, isz
436               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f
437               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u
438            END DO
439            DO ib = 1, isz
440               td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
441               td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
442            END DO
443         END DO
444         !
445         DEALLOCATE( mod_tide, phi_tide )
446         !
447      ENDIF
448      !
449      IF( ASSOCIATED(td%v0) ) THEN   ! V grid. we use bdy u2d on this mpi subdomain
450         !
451         isz = SIZE( td%v0, dim = 1 )
452         ALLOCATE( mod_tide(isz), phi_tide(isz) )
453         !
454         DO itide = 1, nb_harmo
455            DO ib = 1, isz
456               mod_tide(ib)=SQRT( td%v0(ib,itide,1)*td%v0(ib,itide,1) + td%v0(ib,itide,2)*td%v0(ib,itide,2) )
457               phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
458            END DO
459            DO ib = 1, isz
460               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f
461               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u
462            END DO
463            DO ib = 1, isz
464               td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
465               td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
466            END DO
467         END DO
468         !
469         DEALLOCATE( mod_tide, phi_tide )
470         !
471      ENDIF
472      !
473   END SUBROUTINE tide_init_velocities
474
475   !!======================================================================
476END MODULE bdytides
477
Note: See TracBrowser for help on using the repository browser.