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 NEMO/trunk/src/OCE/SBC – NEMO

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

Last change on this file since 10454 was 10068, checked in by nicolasmartin, 6 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
RevLine 
[2952]1MODULE sbctide
[4292]2   !!======================================================================
3   !!                       ***  MODULE  sbctide  ***
4   !! Initialization of tidal forcing
5   !!======================================================================
6   !! History :  9.0  !  2007  (O. Le Galloudec)  Original code
7   !!----------------------------------------------------------------------
[6140]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        !
[4292]13   !
[6140]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)
[2952]18
[4292]19   IMPLICIT NONE
20   PUBLIC
[2952]21
[4292]22   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   pot_astro   !
[3651]23
[4292]24   !!----------------------------------------------------------------------
[7646]25   !!   tidal potential
[4292]26   !!----------------------------------------------------------------------
27   !!   sbc_tide            :
28   !!   tide_init_potential :
29   !!----------------------------------------------------------------------
[2952]30
[4292]31   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_pot, phi_pot
[9023]32   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_load, phi_load
33 
[4292]34   !!----------------------------------------------------------------------
[9598]35   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5215]36   !! $Id$
[10068]37   !! Software governed by the CeCILL license (see ./LICENSE)
[4292]38   !!----------------------------------------------------------------------
[2952]39CONTAINS
40
[4292]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
[6140]47      INTEGER               ::   nsec_day_orig     ! Temporary variable
[4292]48      !!----------------------------------------------------------------------
[6140]49     
50      IF( nsec_day == NINT(0.5_wp * rdt) .OR. kt == nit000 ) THEN      ! start a new day
[4292]51         !
[9023]52         IF( kt == nit000 )THEN
[4292]53            ALLOCATE( amp_pot(jpi,jpj,nb_harmo),                      &
54               &      phi_pot(jpi,jpj,nb_harmo), pot_astro(jpi,jpj)   )
[9023]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
[4292]59         ENDIF
60         !
[9023]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
[4292]68         pot_astro(:,:) = 0._wp
69         !
[6140]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
[4292]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         !
[6140]94         ! Reset nsec_day
95         nsec_day = nsec_day_orig 
[4292]96      ENDIF
[3651]97      !
[4292]98   END SUBROUTINE sbc_tide
[2952]99
100
[4292]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      !!----------------------------------------------------------------------
[2952]108
[4292]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
[9023]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) )
[4292]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
[3651]132      !
[4292]133   END SUBROUTINE tide_init_potential
[2952]134
[9023]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
[9125]141      REAL(wp), DIMENSION(jpi,jpj) ::   ztr, zti   !: workspace to read in tidal harmonics data
[9023]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
[2952]167  !!======================================================================
168END MODULE sbctide
Note: See TracBrowser for help on using the repository browser.