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.
sbctide.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.
File size: 6.4 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
11   USE daymod
12   USE dynspg_oce
13   USE tideini
14   !
15   USE iom
16   USE in_out_manager  ! I/O units
17   USE ioipsl          ! NetCDF IPSL library
18   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
19
20   USE yomhook, ONLY: lhook, dr_hook
21   USE parkind1, ONLY: jprb, jpim
22
23   IMPLICIT NONE
24   PUBLIC
25
26   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   pot_astro   !
27
28#if defined key_tide
29   !!----------------------------------------------------------------------
30   !!   'key_tide' :                                        tidal potential
31   !!----------------------------------------------------------------------
32   !!   sbc_tide            :
33   !!   tide_init_potential :
34   !!----------------------------------------------------------------------
35
36   LOGICAL, PUBLIC, PARAMETER ::   lk_tide  = .TRUE.
37   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_pot, phi_pot
38
39   !!----------------------------------------------------------------------
40   !! NEMO/OPA 3.5 , NEMO Consortium (2013)
41   !! $Id$
42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE sbc_tide( kt )
47      !!----------------------------------------------------------------------
48      !!                 ***  ROUTINE sbc_tide  ***
49      !!----------------------------------------------------------------------     
50      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
51      INTEGER               ::   jk     ! dummy loop index
52      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
53      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
54      REAL(KIND=jprb)               :: zhook_handle
55
56      CHARACTER(LEN=*), PARAMETER :: RoutineName='SBC_TIDE'
57
58      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
59
60      !!----------------------------------------------------------------------
61
62      IF( nsec_day == NINT(0.5_wp * rdttra(1)) ) THEN      ! start a new day
63         !
64         IF( kt == nit000 ) THEN
65            ALLOCATE( amp_pot(jpi,jpj,nb_harmo),                      &
66               &      phi_pot(jpi,jpj,nb_harmo), pot_astro(jpi,jpj)   )
67         ENDIF
68         !
69         amp_pot(:,:,:) = 0._wp
70         phi_pot(:,:,:) = 0._wp
71         pot_astro(:,:) = 0._wp
72         !
73         CALL tide_harmo( omega_tide, v0tide, utide, ftide, ntide, nb_harmo )
74         !
75         kt_tide = kt
76         !
77         IF(lwp) THEN
78            WRITE(numout,*)
79            WRITE(numout,*) 'sbc_tide : Update of the components and (re)Init. the potential at kt=', kt
80            WRITE(numout,*) '~~~~~~~~ '
81            DO jk = 1, nb_harmo
82               WRITE(numout,*) Wave(ntide(jk))%cname_tide, utide(jk), ftide(jk), v0tide(jk), omega_tide(jk)
83            END DO
84         ENDIF
85         !
86         IF( ln_tide_pot )   CALL tide_init_potential
87         !
88      ENDIF
89      !
90      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
91   END SUBROUTINE sbc_tide
92
93
94   SUBROUTINE tide_init_potential
95      !!----------------------------------------------------------------------
96      !!                 ***  ROUTINE tide_init_potential  ***
97      !!----------------------------------------------------------------------
98      INTEGER  ::   ji, jj, jk   ! dummy loop indices
99      REAL(wp) ::   zcons, ztmp1, ztmp2, zlat, zlon, ztmp, zamp, zcs   ! local scalar
100      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
101      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
102      REAL(KIND=jprb)               :: zhook_handle
103
104      CHARACTER(LEN=*), PARAMETER :: RoutineName='TIDE_INIT_POTENTIAL'
105
106      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
107
108      !!----------------------------------------------------------------------
109
110      DO jk = 1, nb_harmo
111         zcons = 0.7_wp * Wave(ntide(jk))%equitide * ftide(jk)
112         DO ji = 1, jpi
113            DO jj = 1, jpj
114               ztmp1 =  amp_pot(ji,jj,jk) * COS( phi_pot(ji,jj,jk) )
115               ztmp2 = -amp_pot(ji,jj,jk) * SIN( phi_pot(ji,jj,jk) )
116               zlat = gphit(ji,jj)*rad !! latitude en radian
117               zlon = glamt(ji,jj)*rad !! longitude en radian
118               ztmp = v0tide(jk) + utide(jk) + Wave(ntide(jk))%nutide * zlon
119               ! le potentiel est composé des effets des astres:
120               IF    ( Wave(ntide(jk))%nutide == 1 )  THEN  ;  zcs = zcons * SIN( 2._wp*zlat )
121               ELSEIF( Wave(ntide(jk))%nutide == 2 )  THEN  ;  zcs = zcons * COS( zlat )**2
122               ELSE                                         ;  zcs = 0._wp
123               ENDIF
124               ztmp1 = ztmp1 + zcs * COS( ztmp )
125               ztmp2 = ztmp2 - zcs * SIN( ztmp )
126               zamp = SQRT( ztmp1*ztmp1 + ztmp2*ztmp2 )
127               amp_pot(ji,jj,jk) = zamp
128               phi_pot(ji,jj,jk) = ATAN2( -ztmp2 / MAX( 1.e-10_wp , zamp ) ,   &
129                  &                        ztmp1 / MAX( 1.e-10_wp,  zamp )   )
130            END DO
131         END DO
132      END DO
133      !
134      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
135   END SUBROUTINE tide_init_potential
136
137#else
138  !!----------------------------------------------------------------------
139  !!   Default case :   Empty module
140  !!----------------------------------------------------------------------
141  LOGICAL, PUBLIC, PARAMETER ::   lk_tide = .FALSE.
142CONTAINS
143  SUBROUTINE sbc_tide( kt )      ! Empty routine
144    INTEGER         , INTENT(in) ::   kt         ! ocean time-step
145    INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
146    INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
147    REAL(KIND=jprb)               :: zhook_handle
148
149    CHARACTER(LEN=*), PARAMETER :: RoutineName='SBC_TIDE'
150
151    IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
152
153    WRITE(*,*) 'sbc_tide: You should not have seen this print! error?', kt
154    IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
155  END SUBROUTINE sbc_tide
156#endif
157
158  !!======================================================================
159END MODULE sbctide
Note: See TracBrowser for help on using the repository browser.