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

source: branches/2012/dev_NOC_MERCATOR_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90 @ 3651

Last change on this file since 3651 was 3651, checked in by cbricaud, 11 years ago

merge dev_MERCATOR_2012_rev3555 into dev_NOC_MERCATOR_2012 ; see ticket 1020

File size: 4.5 KB
Line 
1MODULE sbctide
2  !!=================================================================================
3  !!                       ***  MODULE  sbctide  ***
4  !! Initialization of tidal forcing
5  !! History :  9.0  !  07  (O. Le Galloudec)  Original code
6  !!=================================================================================
7  !! * Modules used
8  USE oce             ! ocean dynamics and tracers variables
9  USE dom_oce         ! ocean space and time domain
10  USE in_out_manager  ! I/O units
11  USE ioipsl          ! NetCDF IPSL library
12  USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
13  USE phycst
14  USE daymod
15  USE dynspg_oce
16  USE tideini
17  USE iom
18
19  IMPLICIT NONE
20  PUBLIC
21
22  REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: pot_astro
23
24#if defined key_tide
25
26  LOGICAL, PUBLIC, PARAMETER ::   lk_tide  = .TRUE.
27  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: amp_pot,phi_pot
28  !!---------------------------------------------------------------------------------
29  !!   OPA 9.0 , LODYC-IPSL  (2003)
30  !!---------------------------------------------------------------------------------
31
32CONTAINS
33
34  SUBROUTINE sbc_tide ( kt )
35    !!----------------------------------------------------------------------
36    !!                 ***  ROUTINE sbc_tide  ***
37    !!----------------------------------------------------------------------     
38    !! * Arguments
39    INTEGER, INTENT( in ) ::   kt     ! ocean time-step
40    !!----------------------------------------------------------------------
41
42    IF ( kt == nit000 .AND. .NOT. lk_dynspg_ts )  CALL ctl_stop( 'STOP', 'sbc_tide : tidal potential use only with time splitting' )
43
44    IF ( nsec_day == NINT(0.5 * rdttra(1)) ) THEN
45      !
46      kt_tide = kt
47
48      IF(lwp) THEN
49         WRITE(numout,*)
50         WRITE(numout,*) 'sbc_tide : (re)Initialization of the tidal potential at kt=',kt
51         WRITE(numout,*) '~~~~~~~ '
52      ENDIF
53
54      IF(lwp) THEN
55         IF ( kt == nit000 ) WRITE(numout,*) 'Apply astronomical potential : ln_tide_pot =', ln_tide_pot
56         CALL flush(numout)
57      ENDIF
58
59      IF ( kt == nit000 ) ALLOCATE(amp_pot(jpi,jpj,nb_harmo))
60      IF ( kt == nit000 ) ALLOCATE(phi_pot(jpi,jpj,nb_harmo))
61      IF ( kt == nit000 ) ALLOCATE(pot_astro(jpi,jpj))
62
63      amp_pot(:,:,:) = 0.e0
64      phi_pot(:,:,:) = 0.e0
65      pot_astro(:,:) = 0.e0
66
67      IF ( ln_tide_pot ) CALL tide_init_potential
68      !
69    ENDIF
70
71  END SUBROUTINE sbc_tide
72
73  SUBROUTINE tide_init_potential
74    !!----------------------------------------------------------------------
75    !!                 ***  ROUTINE tide_init_potential  ***
76    !!----------------------------------------------------------------------
77    !! * Local declarations
78    INTEGER  :: ji,jj,jk
79    REAL(wp) :: zcons,ztmp1,ztmp2,zlat,zlon
80
81
82    DO jk=1,nb_harmo
83       zcons=0.7*Wave(ntide(jk))%equitide*ftide(jk)
84       do ji=1,jpi
85          do jj=1,jpj
86             ztmp1 = amp_pot(ji,jj,jk)*COS(phi_pot(ji,jj,jk))
87             ztmp2 = -amp_pot(ji,jj,jk)*SIN(phi_pot(ji,jj,jk))
88             zlat = gphit(ji,jj)*rad !! latitude en radian
89             zlon = glamt(ji,jj)*rad !! longitude en radian
90             ! le potentiel est composé des effets des astres:
91             IF (Wave(ntide(jk))%nutide .EQ.1) THEN
92                ztmp1= ztmp1 + zcons*(SIN(2.*zlat))*COS(v0tide(jk)+utide(jk)+Wave(ntide(jk))%nutide*zlon)
93                ztmp2= ztmp2 - zcons*(SIN(2.*zlat))*SIN(v0tide(jk)+utide(jk)+Wave(ntide(jk))%nutide*zlon)
94             ENDIF
95             IF (Wave(ntide(jk))%nutide.EQ.2) THEN
96                ztmp1= ztmp1 + zcons*(COS(zlat)**2)*COS(v0tide(jk)+utide(jk)+Wave(ntide(jk))%nutide*zlon)
97                ztmp2= ztmp2 - zcons*(COS(zlat)**2)*SIN(v0tide(jk)+utide(jk)+Wave(ntide(jk))%nutide*zlon)
98             ENDIF
99             amp_pot(ji,jj,jk)=SQRT(ztmp1**2+ztmp2**2)
100             phi_pot(ji,jj,jk)=ATAN2(-ztmp2/MAX(1.E-10,SQRT(ztmp1**2+ztmp2**2)),ztmp1/MAX(1.E-10,SQRT(ztmp1**2+ztmp2**2)))
101          enddo
102       enddo
103    END DO
104
105  END SUBROUTINE tide_init_potential
106
107#else
108  !!----------------------------------------------------------------------
109  !!   Default case :   Empty module
110  !!----------------------------------------------------------------------
111  LOGICAL, PUBLIC, PARAMETER ::   lk_tide = .FALSE.
112CONTAINS
113  SUBROUTINE sbc_tide( kt )      ! Empty routine
114    INTEGER         , INTENT(in) ::   kt         ! ocean time-step
115    WRITE(*,*) 'sbc_tide: You should not have seen this print! error?', kt
116  END SUBROUTINE sbc_tide
117#endif
118  !!======================================================================
119
120END MODULE sbctide
Note: See TracBrowser for help on using the repository browser.