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_package/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 5.3 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   IMPLICIT NONE
21   PUBLIC
22
23   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   pot_astro   !
24
25#if defined key_tide
26   !!----------------------------------------------------------------------
27   !!   'key_tide' :                                        tidal potential
28   !!----------------------------------------------------------------------
29   !!   sbc_tide            :
30   !!   tide_init_potential :
31   !!----------------------------------------------------------------------
32
33   LOGICAL, PUBLIC, PARAMETER ::   lk_tide  = .TRUE.
34   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_pot, phi_pot
35
36   !!----------------------------------------------------------------------
37   !! NEMO/OPA 3.5 , NEMO Consortium (2013)
38   !! $Id$
39   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41CONTAINS
42
43   SUBROUTINE sbc_tide( kt )
44      !!----------------------------------------------------------------------
45      !!                 ***  ROUTINE sbc_tide  ***
46      !!----------------------------------------------------------------------     
47      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
48      INTEGER               ::   jk     ! dummy loop index
49      !!----------------------------------------------------------------------
50
51      IF( nsec_day == NINT(0.5_wp * rdttra(1)) ) THEN      ! start a new day
52         !
53         IF( kt == nit000 ) THEN
54            ALLOCATE( amp_pot(jpi,jpj,nb_harmo),                      &
55               &      phi_pot(jpi,jpj,nb_harmo), pot_astro(jpi,jpj)   )
56         ENDIF
57         !
58         amp_pot(:,:,:) = 0._wp
59         phi_pot(:,:,:) = 0._wp
60         pot_astro(:,:) = 0._wp
61         !
62         CALL tide_harmo( omega_tide, v0tide, utide, ftide, ntide, nb_harmo )
63         !
64         kt_tide = kt
65         !
66         IF(lwp) THEN
67            WRITE(numout,*)
68            WRITE(numout,*) 'sbc_tide : Update of the components and (re)Init. the potential at kt=', kt
69            WRITE(numout,*) '~~~~~~~~ '
70            DO jk = 1, nb_harmo
71               WRITE(numout,*) Wave(ntide(jk))%cname_tide, utide(jk), ftide(jk), v0tide(jk), omega_tide(jk)
72            END DO
73            IF(lflush) CALL flush(numout)
74         ENDIF
75         !
76         IF( ln_tide_pot )   CALL tide_init_potential
77         !
78      ENDIF
79      !
80   END SUBROUTINE sbc_tide
81
82
83   SUBROUTINE tide_init_potential
84      !!----------------------------------------------------------------------
85      !!                 ***  ROUTINE tide_init_potential  ***
86      !!----------------------------------------------------------------------
87      INTEGER  ::   ji, jj, jk   ! dummy loop indices
88      REAL(wp) ::   zcons, ztmp1, ztmp2, zlat, zlon, ztmp, zamp, zcs   ! local scalar
89      !!----------------------------------------------------------------------
90
91      DO jk = 1, nb_harmo
92         zcons = 0.7_wp * Wave(ntide(jk))%equitide * ftide(jk)
93         DO ji = 1, jpi
94            DO jj = 1, jpj
95               ztmp1 =  amp_pot(ji,jj,jk) * COS( phi_pot(ji,jj,jk) )
96               ztmp2 = -amp_pot(ji,jj,jk) * SIN( phi_pot(ji,jj,jk) )
97               zlat = gphit(ji,jj)*rad !! latitude en radian
98               zlon = glamt(ji,jj)*rad !! longitude en radian
99               ztmp = v0tide(jk) + utide(jk) + Wave(ntide(jk))%nutide * zlon
100               ! le potentiel est composé des effets des astres:
101               IF    ( Wave(ntide(jk))%nutide == 1 )  THEN  ;  zcs = zcons * SIN( 2._wp*zlat )
102               ELSEIF( Wave(ntide(jk))%nutide == 2 )  THEN  ;  zcs = zcons * COS( zlat )**2
103               ELSE                                         ;  zcs = 0._wp
104               ENDIF
105               ztmp1 = ztmp1 + zcs * COS( ztmp )
106               ztmp2 = ztmp2 - zcs * SIN( ztmp )
107               zamp = SQRT( ztmp1*ztmp1 + ztmp2*ztmp2 )
108               amp_pot(ji,jj,jk) = zamp
109               phi_pot(ji,jj,jk) = ATAN2( -ztmp2 / MAX( 1.e-10_wp , zamp ) ,   &
110                  &                        ztmp1 / MAX( 1.e-10_wp,  zamp )   )
111            END DO
112         END DO
113      END DO
114      !
115   END SUBROUTINE tide_init_potential
116
117#else
118  !!----------------------------------------------------------------------
119  !!   Default case :   Empty module
120  !!----------------------------------------------------------------------
121  LOGICAL, PUBLIC, PARAMETER ::   lk_tide = .FALSE.
122CONTAINS
123  SUBROUTINE sbc_tide( kt )      ! Empty routine
124    INTEGER         , INTENT(in) ::   kt         ! ocean time-step
125    WRITE(*,*) 'sbc_tide: You should not have seen this print! error?', kt
126  END SUBROUTINE sbc_tide
127#endif
128
129  !!======================================================================
130END MODULE sbctide
Note: See TracBrowser for help on using the repository browser.