source: NEMO/trunk/src/OCE/SBC/sbctide.F90 @ 10522

Last change on this file since 10522 was 10068, checked in by nicolasmartin, 2 years ago

First part of modifications to have a common default header : fix typos and SVN keywords properties

  • Property svn:keywords set to Id
File size: 7.1 KB
Line 
1MODULE sbctide
2   !!======================================================================
3   !!                       ***  MODULE  sbctide  ***
4   !! Initialization of tidal forcing
5   !!======================================================================
6   !! History :  9.0  !  2007  (O. Le Galloudec)  Original code
7   !!----------------------------------------------------------------------
8   USE oce            ! ocean dynamics and tracers variables
9   USE dom_oce        ! ocean space and time domain
10   USE phycst         ! physical constant
11   USE daymod         ! calandar
12   USE tideini        !
13   !
14   USE in_out_manager ! I/O units
15   USE iom            ! xIOs server
16   USE ioipsl         ! NetCDF IPSL library
17   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
18
19   IMPLICIT NONE
20   PUBLIC
21
22   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   pot_astro   !
23
24   !!----------------------------------------------------------------------
25   !!   tidal potential
26   !!----------------------------------------------------------------------
27   !!   sbc_tide            :
28   !!   tide_init_potential :
29   !!----------------------------------------------------------------------
30
31   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_pot, phi_pot
32   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_load, phi_load
33 
34   !!----------------------------------------------------------------------
35   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
36   !! $Id$
37   !! Software governed by the CeCILL license (see ./LICENSE)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE sbc_tide( kt )
42      !!----------------------------------------------------------------------
43      !!                 ***  ROUTINE sbc_tide  ***
44      !!----------------------------------------------------------------------     
45      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
46      INTEGER               ::   jk     ! dummy loop index
47      INTEGER               ::   nsec_day_orig     ! Temporary variable
48      !!----------------------------------------------------------------------
49     
50      IF( nsec_day == NINT(0.5_wp * rdt) .OR. kt == nit000 ) THEN      ! start a new day
51         !
52         IF( kt == nit000 )THEN
53            ALLOCATE( amp_pot(jpi,jpj,nb_harmo),                      &
54               &      phi_pot(jpi,jpj,nb_harmo), pot_astro(jpi,jpj)   )
55            IF( ln_read_load )THEN
56               ALLOCATE( amp_load(jpi,jpj,nb_harmo), phi_load(jpi,jpj,nb_harmo) )
57               CALL tide_init_load
58            ENDIF
59         ENDIF
60         !
61         IF( ln_read_load )THEN
62            amp_pot(:,:,:) = amp_load(:,:,:)
63            phi_pot(:,:,:) = phi_load(:,:,:)
64         ELSE
65            amp_pot(:,:,:) = 0._wp
66            phi_pot(:,:,:) = 0._wp
67         ENDIF
68         pot_astro(:,:) = 0._wp
69         !
70         ! If the run does not start from midnight then need to initialise tides
71         ! at the start of the current day (only occurs when kt==nit000)
72         ! Temporarily set nsec_day to beginning of day.
73         nsec_day_orig = nsec_day
74         IF ( nsec_day /= NINT(0.5_wp * rdt) ) THEN
75            kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
76            nsec_day = NINT(0.5_wp * rdt)
77         ELSE
78            kt_tide = kt 
79         ENDIF
80         CALL tide_harmo( omega_tide, v0tide, utide, ftide, ntide, nb_harmo )
81         !
82         !
83         IF(lwp) THEN
84            WRITE(numout,*)
85            WRITE(numout,*) 'sbc_tide : Update of the components and (re)Init. the potential at kt=', kt
86            WRITE(numout,*) '~~~~~~~~ '
87            DO jk = 1, nb_harmo
88               WRITE(numout,*) Wave(ntide(jk))%cname_tide, utide(jk), ftide(jk), v0tide(jk), omega_tide(jk)
89            END DO
90         ENDIF
91         !
92         IF( ln_tide_pot )   CALL tide_init_potential
93         !
94         ! Reset nsec_day
95         nsec_day = nsec_day_orig 
96      ENDIF
97      !
98   END SUBROUTINE sbc_tide
99
100
101   SUBROUTINE tide_init_potential
102      !!----------------------------------------------------------------------
103      !!                 ***  ROUTINE tide_init_potential  ***
104      !!----------------------------------------------------------------------
105      INTEGER  ::   ji, jj, jk   ! dummy loop indices
106      REAL(wp) ::   zcons, ztmp1, ztmp2, zlat, zlon, ztmp, zamp, zcs   ! local scalar
107      !!----------------------------------------------------------------------
108
109      DO jk = 1, nb_harmo
110         zcons = 0.7_wp * Wave(ntide(jk))%equitide * ftide(jk)
111         DO ji = 1, jpi
112            DO jj = 1, jpj
113               ztmp1 =  ftide(jk) * amp_pot(ji,jj,jk) * COS( phi_pot(ji,jj,jk) + v0tide(jk) + utide(jk) )
114               ztmp2 = -ftide(jk) * amp_pot(ji,jj,jk) * SIN( phi_pot(ji,jj,jk) + v0tide(jk) + utide(jk) )
115               zlat = gphit(ji,jj)*rad !! latitude en radian
116               zlon = glamt(ji,jj)*rad !! longitude en radian
117               ztmp = v0tide(jk) + utide(jk) + Wave(ntide(jk))%nutide * zlon
118               ! le potentiel est composé des effets des astres:
119               IF    ( Wave(ntide(jk))%nutide == 1 )  THEN  ;  zcs = zcons * SIN( 2._wp*zlat )
120               ELSEIF( Wave(ntide(jk))%nutide == 2 )  THEN  ;  zcs = zcons * COS( zlat )**2
121               ELSE                                         ;  zcs = 0._wp
122               ENDIF
123               ztmp1 = ztmp1 + zcs * COS( ztmp )
124               ztmp2 = ztmp2 - zcs * SIN( ztmp )
125               zamp = SQRT( ztmp1*ztmp1 + ztmp2*ztmp2 )
126               amp_pot(ji,jj,jk) = zamp
127               phi_pot(ji,jj,jk) = ATAN2( -ztmp2 / MAX( 1.e-10_wp , zamp ) ,   &
128                  &                        ztmp1 / MAX( 1.e-10_wp,  zamp )   )
129            END DO
130         END DO
131      END DO
132      !
133   END SUBROUTINE tide_init_potential
134
135   SUBROUTINE tide_init_load
136      !!----------------------------------------------------------------------
137      !!                 ***  ROUTINE tide_init_load  ***
138      !!----------------------------------------------------------------------
139      INTEGER :: inum                 ! Logical unit of input file
140      INTEGER :: ji, jj, itide        ! dummy loop indices
141      REAL(wp), DIMENSION(jpi,jpj) ::   ztr, zti   !: workspace to read in tidal harmonics data
142      !!----------------------------------------------------------------------
143      IF(lwp) THEN
144         WRITE(numout,*)
145         WRITE(numout,*) 'tide_init_load : Initialization of load potential from file'
146         WRITE(numout,*) '~~~~~~~~~~~~~~ '
147      ENDIF
148      !
149      CALL iom_open ( cn_tide_load , inum )
150      !
151      DO itide = 1, nb_harmo
152         CALL iom_get  ( inum, jpdom_data,TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
153         CALL iom_get  ( inum, jpdom_data,TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )
154         !
155         DO ji=1,jpi
156            DO jj=1,jpj
157               amp_load(ji,jj,itide) =  SQRT( ztr(ji,jj)**2. + zti(ji,jj)**2. )
158               phi_load(ji,jj,itide) = ATAN2(-zti(ji,jj), ztr(ji,jj) )
159            END DO
160         END DO
161         !
162      END DO
163      CALL iom_close( inum )
164      !
165   END SUBROUTINE tide_init_load
166
167  !!======================================================================
168END MODULE sbctide
Note: See TracBrowser for help on using the repository browser.