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/2019/dev_r11943_MERGE_2019/src/OCE/BDY – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/BDY/bdytides.F90 @ 12250

Last change on this file since 12250 was 12250, checked in by smasson, 4 years ago

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