- Timestamp:
- 2013-11-20T17:28:04+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
r3651 r4292 1 1 MODULE 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 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) 18 19 19 IMPLICIT NONE20 PUBLIC20 IMPLICIT NONE 21 PUBLIC 21 22 22 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: pot_astro23 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: pot_astro ! 23 24 24 25 #if defined key_tide 26 !!---------------------------------------------------------------------- 27 !! 'key_tide' : tidal potential 28 !!---------------------------------------------------------------------- 29 !! sbc_tide : 30 !! tide_init_potential : 31 !!---------------------------------------------------------------------- 25 32 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 !!--------------------------------------------------------------------------------- 33 LOGICAL, PUBLIC, PARAMETER :: lk_tide = .TRUE. 34 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: amp_pot, phi_pot 31 35 36 !!---------------------------------------------------------------------- 37 !! NEMO/OPA 3.5 , NEMO Consortium (2013) 38 !! $Id: $ 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 !!---------------------------------------------------------------------- 32 41 CONTAINS 33 42 34 SUBROUTINE sbc_tide( kt )35 !!----------------------------------------------------------------------36 !! *** ROUTINE sbc_tide ***37 !!----------------------------------------------------------------------38 !! * Arguments39 INTEGER, INTENT( in ) :: kt ! ocean time-step40 !!----------------------------------------------------------------------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 !!---------------------------------------------------------------------- 41 50 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 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 ENDIF 74 ! 75 IF( ln_tide_pot ) CALL tide_init_potential 76 ! 77 ENDIF 45 78 ! 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 79 END SUBROUTINE sbc_tide 80 80 81 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 82 SUBROUTINE tide_init_potential 83 !!---------------------------------------------------------------------- 84 !! *** ROUTINE tide_init_potential *** 85 !!---------------------------------------------------------------------- 86 INTEGER :: ji, jj, jk ! dummy loop indices 87 REAL(wp) :: zcons, ztmp1, ztmp2, zlat, zlon, ztmp, zamp, zcs ! local scalar 88 !!---------------------------------------------------------------------- 104 89 105 END SUBROUTINE tide_init_potential 90 DO jk = 1, nb_harmo 91 zcons = 0.7_wp * Wave(ntide(jk))%equitide * ftide(jk) 92 DO ji = 1, jpi 93 DO jj = 1, jpj 94 ztmp1 = amp_pot(ji,jj,jk) * COS( phi_pot(ji,jj,jk) ) 95 ztmp2 = -amp_pot(ji,jj,jk) * SIN( phi_pot(ji,jj,jk) ) 96 zlat = gphit(ji,jj)*rad !! latitude en radian 97 zlon = glamt(ji,jj)*rad !! longitude en radian 98 ztmp = v0tide(jk) + utide(jk) + Wave(ntide(jk))%nutide * zlon 99 ! le potentiel est composé des effets des astres: 100 IF ( Wave(ntide(jk))%nutide == 1 ) THEN ; zcs = zcons * SIN( 2._wp*zlat ) 101 ELSEIF( Wave(ntide(jk))%nutide == 2 ) THEN ; zcs = zcons * COS( zlat )**2 102 ELSE ; zcs = 0._wp 103 ENDIF 104 ztmp1 = ztmp1 + zcs * COS( ztmp ) 105 ztmp2 = ztmp2 - zcs * SIN( ztmp ) 106 zamp = SQRT( ztmp1*ztmp1 + ztmp2*ztmp2 ) 107 amp_pot(ji,jj,jk) = zamp 108 phi_pot(ji,jj,jk) = ATAN2( -ztmp2 / MAX( 1.e-10_wp , zamp ) , & 109 & ztmp1 / MAX( 1.e-10_wp, zamp ) ) 110 END DO 111 END DO 112 END DO 113 ! 114 END SUBROUTINE tide_init_potential 106 115 107 116 #else … … 116 125 END SUBROUTINE sbc_tide 117 126 #endif 127 118 128 !!====================================================================== 119 120 129 END MODULE sbctide
Note: See TracChangeset
for help on using the changeset viewer.
