- Timestamp:
- 2013-11-20T17:28:04+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
r3651 r4292 1 1 MODULE updtide 2 !!================================================================================= 3 !! *** MODULE updtide *** 4 !! Initialization of tidal forcing 5 !! History : 9.0 ! 07 (O. Le Galloudec) Original code 6 !!================================================================================= 2 !!====================================================================== 3 !! *** MODULE updtide *** 4 !! Initialization of tidal forcing 5 !!====================================================================== 6 !! History : 9.0 ! 07 (O. Le Galloudec) Original code 7 !!---------------------------------------------------------------------- 7 8 #if defined key_tide 8 !! * Modules used 9 USE oce ! ocean dynamics and tracers variables 10 USE dom_oce ! ocean space and time domain 11 USE in_out_manager ! I/O units 12 USE phycst 13 USE sbctide 14 USE dynspg_oce 15 USE tideini, ONLY: ln_tide_ramp, rdttideramp 9 !!---------------------------------------------------------------------- 10 !! 'key_tide' : tidal potential 11 !!---------------------------------------------------------------------- 12 !! upd_tide : update tidal potential 13 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers variables 15 USE dom_oce ! ocean space and time domain 16 USE in_out_manager ! I/O units 17 USE phycst ! physical constant 18 USE sbctide ! tide potential variable 19 USE tideini, ONLY: ln_tide_ramp, rdttideramp 16 20 17 IMPLICIT NONE18 PUBLIC21 IMPLICIT NONE 22 PUBLIC 19 23 20 !! * Routine accessibility 21 PUBLIC upd_tide 22 !!--------------------------------------------------------------------------------- 23 !! OPA 9.0 , LODYC-IPSL (2003) 24 !!--------------------------------------------------------------------------------- 25 24 PUBLIC upd_tide ! called in dynspg_... modules 25 26 !!---------------------------------------------------------------------- 27 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 28 !! $Id: sbcfwb.F90 3625 2012-11-21 13:19:18Z acc $ 29 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 30 !!---------------------------------------------------------------------- 26 31 CONTAINS 27 32 28 SUBROUTINE upd_tide (kt,kit) 29 !!---------------------------------------------------------------------- 30 !! *** ROUTINE upd_tide *** 31 !!---------------------------------------------------------------------- 32 !! * Local declarations 33 SUBROUTINE upd_tide( kt, kit, kbaro, koffset ) 34 !!---------------------------------------------------------------------- 35 !! *** ROUTINE upd_tide *** 36 !! 37 !! ** Purpose : provide at each time step the astronomical potential 38 !! 39 !! ** Method : computed from pulsation and amplitude of all tide components 40 !! 41 !! ** Action : pot_astro actronomical potential 42 !!---------------------------------------------------------------------- 43 INTEGER, INTENT(in) :: kt ! ocean time-step index 44 INTEGER, INTENT(in), OPTIONAL :: kit ! external mode sub-time-step index (lk_dynspg_ts=T only) 45 INTEGER, INTENT(in), OPTIONAL :: kbaro ! number of sub-time-step (lk_dynspg_ts=T only) 46 INTEGER, INTENT(in), OPTIONAL :: koffset ! time offset in number 47 ! of sub-time-steps (lk_dynspg_ts=T only) 48 ! 49 INTEGER :: joffset ! local integer 50 INTEGER :: ji, jj, jk ! dummy loop indices 51 REAL(wp) :: zt, zramp ! local scalar 52 REAL(wp), DIMENSION(nb_harmo) :: zwt 53 !!---------------------------------------------------------------------- 54 ! 55 ! ! tide pulsation at model time step (or sub-time-step) 56 zt = ( kt - kt_tide ) * rdt 57 ! 58 joffset = 0 59 IF( PRESENT( koffset ) ) joffset = koffset 60 ! 61 IF( PRESENT( kit ) .AND. PRESENT( kbaro ) ) THEN 62 zt = zt + ( kit + 0.5_wp * ( joffset - 1 ) ) * rdt / REAL( kbaro, wp ) 63 ELSE 64 zt = zt + joffset * rdt 65 ENDIF 66 ! 67 zwt(:) = omega_tide(:) * zt 33 68 34 INTEGER, INTENT( in ) :: kt,kit ! ocean time-step index 35 INTEGER :: ji,jj,jk 36 REAL (wp) :: zramp 37 REAL (wp), DIMENSION(nb_harmo) :: zwt 38 !............................................................................... 39 40 pot_astro(:,:)=0.e0 41 zramp = 1.e0 42 43 IF (lk_dynspg_ts) THEN 44 zwt(:) = omega_tide(:)* ((kt-kt_tide)*rdt + kit*(rdt/REAL(nn_baro,wp))) 45 IF (ln_tide_ramp) THEN 46 zramp = MIN(MAX( ((kt-nit000)*rdt + kit*(rdt/REAL(nn_baro,wp)))/(rdttideramp*rday),0.),1.) 47 ENDIF 48 ELSE 49 zwt(:) = omega_tide(:)*(kt-kt_tide)*rdt 50 IF (ln_tide_ramp) THEN 51 zramp = MIN(MAX( ((kt-nit000)*rdt)/(rdttideramp*rday),0.),1.) 52 ENDIF 53 ENDIF 54 55 do jk=1,nb_harmo 56 do ji=1,jpi 57 do jj=1,jpj 58 pot_astro(ji,jj)=pot_astro(ji,jj) + zramp*(amp_pot(ji,jj,jk)*COS(zwt(jk)+phi_pot(ji,jj,jk))) 59 enddo 60 enddo 61 enddo 62 63 END SUBROUTINE upd_tide 69 pot_astro(:,:) = 0._wp ! update tidal potential (sum of all harmonics) 70 DO jk = 1, nb_harmo 71 pot_astro(:,:) = pot_astro(:,:) + amp_pot(:,:,jk) * COS( zwt(jk) + phi_pot(:,:,jk) ) 72 END DO 73 ! 74 IF( ln_tide_ramp ) THEN ! linear increase if asked 75 zt = ( kt - nit000 ) * rdt 76 IF( PRESENT( kit ) .AND. PRESENT( kbaro ) ) zt = zt + kit * rdt / REAL( kbaro, wp ) 77 zramp = MIN( MAX( zt / (rdttideramp*rday) , 0._wp ) , 1._wp ) 78 pot_astro(:,:) = zramp * pot_astro(:,:) 79 ENDIF 80 ! 81 END SUBROUTINE upd_tide 64 82 65 83 #else … … 68 86 !!---------------------------------------------------------------------- 69 87 CONTAINS 70 SUBROUTINE upd_tide( kt,kit ) ! Empty routine 71 INTEGER,INTENT (IN) :: kt, kit 88 SUBROUTINE upd_tide( kt, kit, kbaro, koffset ) ! Empty routine 89 INTEGER, INTENT(in) :: kt ! integer arg, dummy routine 90 INTEGER, INTENT(in), OPTIONAL :: kit ! optional arg, dummy routine 91 INTEGER, INTENT(in), OPTIONAL :: kbaro ! optional arg, dummy routine 92 INTEGER, INTENT(in), OPTIONAL :: koffset ! optional arg, dummy routine 72 93 WRITE(*,*) 'upd_tide: You should not have seen this print! error?', kt 73 94 END SUBROUTINE upd_tide
Note: See TracChangeset
for help on using the changeset viewer.
