| 1 | MODULE bdytides |
|---|
| 2 | !!================================================================================= |
|---|
| 3 | !! *** MODULE bdytides *** |
|---|
| 4 | !! Ocean dynamics: Tidal forcing at open boundaries |
|---|
| 5 | !!================================================================================= |
|---|
| 6 | #if defined key_bdy_tides |
|---|
| 7 | !!--------------------------------------------------------------------------------- |
|---|
| 8 | !! PUBLIC |
|---|
| 9 | !! tide_init : read of namelist |
|---|
| 10 | !! tide_data : read in and initialisation of tidal constituents at boundary |
|---|
| 11 | !! tide_update : calculation of tidal forcing at each timestep |
|---|
| 12 | !! PRIVATE |
|---|
| 13 | !! uvset :\ |
|---|
| 14 | !! vday : | Routines to correct tidal harmonics forcing for |
|---|
| 15 | !! shpen : | start time of integration |
|---|
| 16 | !! ufset : | |
|---|
| 17 | !! vset :/ |
|---|
| 18 | !!--------------------------------------------------------------------------------- |
|---|
| 19 | |
|---|
| 20 | !!--------------------------------------------------------------------------------- |
|---|
| 21 | !! * Modules used |
|---|
| 22 | USE oce ! ocean dynamics and tracers |
|---|
| 23 | USE dom_oce ! ocean space and time domain |
|---|
| 24 | USE iom |
|---|
| 25 | USE in_out_manager ! I/O units |
|---|
| 26 | USE phycst ! physical constants |
|---|
| 27 | USE lbclnk ! ocean lateral boundary conditions (or mpp link) |
|---|
| 28 | USE bdy_par ! Unstructured boundary parameters |
|---|
| 29 | USE bdy_oce ! ocean open boundary conditions |
|---|
| 30 | USE daymod ! calendar |
|---|
| 31 | IMPLICIT NONE |
|---|
| 32 | PRIVATE |
|---|
| 33 | |
|---|
| 34 | !! * Accessibility |
|---|
| 35 | PUBLIC tide_init ! routine called in bdyini |
|---|
| 36 | PUBLIC tide_data ! routine called in bdyini |
|---|
| 37 | PUBLIC tide_update ! routine called in bdydyn |
|---|
| 38 | |
|---|
| 39 | !! * Module variables |
|---|
| 40 | LOGICAL, PUBLIC, PARAMETER :: lk_bdy_tides = .TRUE. !: tidal forcing at boundaries. |
|---|
| 41 | |
|---|
| 42 | CHARACTER(len=80), PUBLIC :: & |
|---|
| 43 | filtide !: Filename root for tidal input files |
|---|
| 44 | |
|---|
| 45 | INTEGER, PUBLIC, PARAMETER :: ntide_max = 15 ! Max number of tidal contituents |
|---|
| 46 | INTEGER, PUBLIC :: ntide ! Actual number of tidal constituents |
|---|
| 47 | |
|---|
| 48 | CHARACTER(len=4), PUBLIC, DIMENSION(ntide_max) :: & |
|---|
| 49 | tide_cpt !: Names of tidal components used. |
|---|
| 50 | |
|---|
| 51 | logical, PUBLIC :: ln_tide_date ! if true correct tide phases and amplitude for model start date |
|---|
| 52 | |
|---|
| 53 | REAL(wp), PUBLIC, DIMENSION(ntide_max) :: tide_speed ! Phase speed of tidal constituent (deg/hr) |
|---|
| 54 | INTEGER, DIMENSION(ntide_max) :: indx |
|---|
| 55 | REAL(wp), DIMENSION(jpbdim,ntide_max) :: & |
|---|
| 56 | ssh1, ssh2, & !: Tidal constituents : SSH |
|---|
| 57 | u1 , u2 , & !: Tidal constituents : U |
|---|
| 58 | v1 , v2 !: Tidal constituents : V |
|---|
| 59 | |
|---|
| 60 | |
|---|
| 61 | !!--------------------------------------------------------------------------------- |
|---|
| 62 | |
|---|
| 63 | CONTAINS |
|---|
| 64 | |
|---|
| 65 | SUBROUTINE tide_init |
|---|
| 66 | !!------------------------------------------------------------------------------ |
|---|
| 67 | !! SUBROUTINE tide_init |
|---|
| 68 | !! *********************** |
|---|
| 69 | !! ** Purpose : - Read in namelist for tides |
|---|
| 70 | !! |
|---|
| 71 | !! History : |
|---|
| 72 | !! NEMO v2.0 ! 07-01 (D.Storkey) Original |
|---|
| 73 | !!------------------------------------------------------------------------------ |
|---|
| 74 | !! * Local declarations |
|---|
| 75 | INTEGER :: jtide ! dummy loop index |
|---|
| 76 | ! different from nblendta!) |
|---|
| 77 | |
|---|
| 78 | !!------------------------------------------------------------------------------ |
|---|
| 79 | !! OPA 9.0, LODYC-IPSL (2007) |
|---|
| 80 | !!------------------------------------------------------------------------------ |
|---|
| 81 | |
|---|
| 82 | NAMELIST/namtide/filtide, tide_cpt, tide_speed, ln_tide_date |
|---|
| 83 | |
|---|
| 84 | !!---------------------------------------------------------------------- |
|---|
| 85 | |
|---|
| 86 | IF(lwp) WRITE(numout,*) |
|---|
| 87 | IF(lwp) WRITE(numout,*) 'tide_init : initialization of tidal harmonic forcing at open boundaries' |
|---|
| 88 | IF(lwp) WRITE(numout,*) '~~~~~~~~~' |
|---|
| 89 | |
|---|
| 90 | ! 0. Read namelist parameters |
|---|
| 91 | ! --------------------------- |
|---|
| 92 | |
|---|
| 93 | do jtide = 1, ntide_max |
|---|
| 94 | tide_cpt(jtide) = '' |
|---|
| 95 | enddo |
|---|
| 96 | |
|---|
| 97 | REWIND( numnam ) |
|---|
| 98 | READ ( numnam, namtide ) |
|---|
| 99 | |
|---|
| 100 | ! control prints |
|---|
| 101 | IF(lwp) WRITE(numout,*) ' namtide' |
|---|
| 102 | |
|---|
| 103 | ! Count number of components specified: |
|---|
| 104 | ntide=ntide_max |
|---|
| 105 | do jtide = 1, ntide_max |
|---|
| 106 | if ( tide_cpt(jtide) == '' ) then |
|---|
| 107 | ntide = jtide-1 |
|---|
| 108 | exit |
|---|
| 109 | endif |
|---|
| 110 | |
|---|
| 111 | enddo |
|---|
| 112 | ! find constients in standard list |
|---|
| 113 | do jtide = 1, ntide |
|---|
| 114 | indx(jtide) = 0 |
|---|
| 115 | if ( TRIM(tide_cpt(jtide)) == 'Q1' ) indx(jtide) = 1 |
|---|
| 116 | if ( TRIM(tide_cpt(jtide)) == 'O1' ) indx(jtide) = 2 |
|---|
| 117 | if ( TRIM(tide_cpt(jtide)) == 'P1' ) indx(jtide) = 3 |
|---|
| 118 | if ( TRIM(tide_cpt(jtide)) == 'S1' ) indx(jtide) = 4 |
|---|
| 119 | if ( TRIM(tide_cpt(jtide)) == 'K1' ) indx(jtide) = 5 |
|---|
| 120 | if ( TRIM(tide_cpt(jtide)) == '2N2' ) indx(jtide) = 6 |
|---|
| 121 | if ( TRIM(tide_cpt(jtide)) == 'MU2' ) indx(jtide) = 7 |
|---|
| 122 | if ( TRIM(tide_cpt(jtide)) == 'N2' ) indx(jtide) = 8 |
|---|
| 123 | if ( TRIM(tide_cpt(jtide)) == 'NU2' ) indx(jtide) = 9 |
|---|
| 124 | if ( TRIM(tide_cpt(jtide)) == 'M2' ) indx(jtide) = 10 |
|---|
| 125 | if ( TRIM(tide_cpt(jtide)) == 'L2' ) indx(jtide) = 11 |
|---|
| 126 | if ( TRIM(tide_cpt(jtide)) == 'T2' ) indx(jtide) = 12 |
|---|
| 127 | if ( TRIM(tide_cpt(jtide)) == 'S2' ) indx(jtide) = 13 |
|---|
| 128 | if ( TRIM(tide_cpt(jtide)) == 'K2' ) indx(jtide) = 14 |
|---|
| 129 | if ( TRIM(tide_cpt(jtide)) == 'M4' ) indx(jtide) = 15 |
|---|
| 130 | if (indx(jtide) == 0 ) then |
|---|
| 131 | if(lwp) write(numout,*) 'WARNING: constitunent', jtide,':', tide_cpt(jtide) & |
|---|
| 132 | , 'not in standard list' |
|---|
| 133 | endif |
|---|
| 134 | enddo |
|---|
| 135 | ! |
|---|
| 136 | if ( ntide < 1 ) then |
|---|
| 137 | if(lwp) write(numout,*) |
|---|
| 138 | if(lwp) write(numout,*) ' E R R O R : Did not find any tidal components in namelist.' |
|---|
| 139 | if(lwp) write(numout,*) ' ========== ' |
|---|
| 140 | if(lwp) write(numout,*) |
|---|
| 141 | nstop = nstop + 1 |
|---|
| 142 | else |
|---|
| 143 | if(lwp) write(numout,*) |
|---|
| 144 | if(lwp) write(numout,*) ntide,' tidal components specified : ' |
|---|
| 145 | if(lwp) write(numout,*) tide_cpt(1:ntide) |
|---|
| 146 | if(lwp) write(numout,*) ntide,' phase speeds (deg/hr) : ' |
|---|
| 147 | if(lwp) write(numout,*) tide_speed(1:ntide) |
|---|
| 148 | endif |
|---|
| 149 | |
|---|
| 150 | ! Initialisation of tidal harmonics arrays |
|---|
| 151 | |
|---|
| 152 | sshtide(:) = 0.e0 |
|---|
| 153 | utide(:) = 0.e0 |
|---|
| 154 | vtide(:) = 0.e0 |
|---|
| 155 | |
|---|
| 156 | END SUBROUTINE tide_init |
|---|
| 157 | |
|---|
| 158 | SUBROUTINE tide_data |
|---|
| 159 | !!------------------------------------------------------------------------------ |
|---|
| 160 | !! SUBROUTINE tide_data |
|---|
| 161 | !! *********************** |
|---|
| 162 | !! ** Purpose : - Read in tidal harmonics data and adjust for the start time of |
|---|
| 163 | !! the model run. |
|---|
| 164 | !! |
|---|
| 165 | !! History : |
|---|
| 166 | !! NEMO v2.0 ! 07-01 (D.Storkey) Original |
|---|
| 167 | !! ! 08-01 (J.Holt) Add date correction. |
|---|
| 168 | !!------------------------------------------------------------------------------ |
|---|
| 169 | !! * Local declarations |
|---|
| 170 | CHARACTER(len=80) :: tidefile ! full file name for tidal input file |
|---|
| 171 | INTEGER :: jtide, jgrd, jb ! dummy loop indices |
|---|
| 172 | INTEGER :: ipi, ipj, inum, idvar ! temporary integers (netcdf read) |
|---|
| 173 | INTEGER, DIMENSION(3) :: lendta ! length of data in the file (note may be |
|---|
| 174 | ! different from nblendta!) |
|---|
| 175 | INTEGER :: iday,imonth,iyear |
|---|
| 176 | REAL(wp) :: arg, atde, btde,z1t,z2t |
|---|
| 177 | REAL(wp), DIMENSION(jpbdta,1) :: & |
|---|
| 178 | pdta ! temporary array for data fields |
|---|
| 179 | REAL(WP), DIMENSION(ntide_max) :: vplu, ftc |
|---|
| 180 | |
|---|
| 181 | !!------------------------------------------------------------------------------ |
|---|
| 182 | !! OPA 9.0, LODYC-IPSL (2007) |
|---|
| 183 | !!------------------------------------------------------------------------------ |
|---|
| 184 | |
|---|
| 185 | ! 1. Open files and read in tidal forcing data |
|---|
| 186 | ! -------------------------------------------- |
|---|
| 187 | |
|---|
| 188 | ipj = 1 |
|---|
| 189 | |
|---|
| 190 | do jtide = 1 ,ntide |
|---|
| 191 | |
|---|
| 192 | ! SSH fields |
|---|
| 193 | ! ---------- |
|---|
| 194 | |
|---|
| 195 | tidefile = TRIM(filtide)//TRIM(tide_cpt(jtide))//'_grid_T.nc' |
|---|
| 196 | if(lwp) write(numout,*) 'Reading data from file ',tidefile |
|---|
| 197 | CALL iom_open( tidefile, inum ) |
|---|
| 198 | |
|---|
| 199 | jgrd = 1 |
|---|
| 200 | IF ( nblendta(jgrd) .le. 0 ) THEN |
|---|
| 201 | idvar = iom_varid( inum,'z1' ) |
|---|
| 202 | if(lwp) write(numout,*) 'iom_file(1)%ndims(idvar) : ',iom_file%ndims(idvar) |
|---|
| 203 | nblendta(jgrd) = iom_file(inum)%dimsz(1,idvar) |
|---|
| 204 | WRITE(numout,*) 'Dim size for z1 is ',nblendta(jgrd) |
|---|
| 205 | ENDIF |
|---|
| 206 | ipi=nblendta(jgrd) |
|---|
| 207 | |
|---|
| 208 | CALL iom_get ( inum, jpdom_unknown, 'z1', pdta(1:ipi,1:ipj) ) |
|---|
| 209 | DO jb=1, nblenrim(jgrd) |
|---|
| 210 | ssh1(jb,jtide) = pdta(nbmap(jb,jgrd),1) |
|---|
| 211 | END DO |
|---|
| 212 | |
|---|
| 213 | CALL iom_get ( inum, jpdom_unknown, 'z2', pdta(1:ipi,1:ipj) ) |
|---|
| 214 | DO jb=1, nblenrim(jgrd) |
|---|
| 215 | ssh2(jb,jtide) = pdta(nbmap(jb,jgrd),1) |
|---|
| 216 | END DO |
|---|
| 217 | |
|---|
| 218 | CALL iom_close( inum ) |
|---|
| 219 | |
|---|
| 220 | ! U fields |
|---|
| 221 | ! -------- |
|---|
| 222 | |
|---|
| 223 | tidefile = TRIM(filtide)//TRIM(tide_cpt(jtide))//'_grid_U.nc' |
|---|
| 224 | if(lwp) write(numout,*) 'Reading data from file ',tidefile |
|---|
| 225 | CALL iom_open( tidefile, inum ) |
|---|
| 226 | |
|---|
| 227 | jgrd = 2 |
|---|
| 228 | IF ( lendta(jgrd) .le. 0 ) THEN |
|---|
| 229 | idvar = iom_varid( inum,'u1' ) |
|---|
| 230 | lendta(jgrd) = iom_file(inum)%dimsz(1,idvar) |
|---|
| 231 | WRITE(numout,*) 'Dim size for u1 is ',lendta(jgrd) |
|---|
| 232 | ENDIF |
|---|
| 233 | ipi=lendta(jgrd) |
|---|
| 234 | |
|---|
| 235 | CALL iom_get ( inum, jpdom_unknown, 'u1', pdta(1:ipi,1:ipj) ) |
|---|
| 236 | DO jb=1, nblenrim(jgrd) |
|---|
| 237 | u1(jb,jtide) = pdta(nbmap(jb,jgrd),1) |
|---|
| 238 | END DO |
|---|
| 239 | |
|---|
| 240 | CALL iom_get ( inum, jpdom_unknown, 'u2', pdta(1:ipi,1:ipj) ) |
|---|
| 241 | DO jb=1, nblenrim(jgrd) |
|---|
| 242 | u2(jb,jtide) = pdta(nbmap(jb,jgrd),1) |
|---|
| 243 | END DO |
|---|
| 244 | |
|---|
| 245 | CALL iom_close( inum ) |
|---|
| 246 | |
|---|
| 247 | ! V fields |
|---|
| 248 | ! -------- |
|---|
| 249 | |
|---|
| 250 | tidefile = TRIM(filtide)//TRIM(tide_cpt(jtide))//'_grid_V.nc' |
|---|
| 251 | if(lwp) write(numout,*) 'Reading data from file ',tidefile |
|---|
| 252 | CALL iom_open( tidefile, inum ) |
|---|
| 253 | |
|---|
| 254 | jgrd = 3 |
|---|
| 255 | IF ( lendta(jgrd) .le. 0 ) THEN |
|---|
| 256 | idvar = iom_varid( inum,'v1' ) |
|---|
| 257 | lendta(jgrd) = iom_file(inum)%dimsz(1,idvar) |
|---|
| 258 | WRITE(numout,*) 'Dim size for v1 is ',lendta(jgrd) |
|---|
| 259 | ENDIF |
|---|
| 260 | ipi=lendta(jgrd) |
|---|
| 261 | |
|---|
| 262 | CALL iom_get ( inum, jpdom_unknown, 'v1', pdta(1:ipi,1:ipj) ) |
|---|
| 263 | DO jb=1, nblenrim(jgrd) |
|---|
| 264 | v1(jb,jtide) = pdta(nbmap(jb,jgrd),1) |
|---|
| 265 | END DO |
|---|
| 266 | |
|---|
| 267 | CALL iom_get ( inum, jpdom_unknown, 'v2', pdta(1:ipi,1:ipj) ) |
|---|
| 268 | DO jb=1, nblenrim(jgrd) |
|---|
| 269 | v2(jb,jtide) = pdta(nbmap(jb,jgrd),1) |
|---|
| 270 | END DO |
|---|
| 271 | |
|---|
| 272 | CALL iom_close( inum ) |
|---|
| 273 | enddo ! end loop on tidal components |
|---|
| 274 | ! |
|---|
| 275 | ! correct for date factors |
|---|
| 276 | ! |
|---|
| 277 | if( ln_tide_date ) then |
|---|
| 278 | |
|---|
| 279 | |
|---|
| 280 | ! Calculate date corrects for 15 standard consituents |
|---|
| 281 | iyear = int(ndate0 / 10000 ) ! initial year |
|---|
| 282 | imonth = int((ndate0 - iyear * 10000 ) / 100 ) ! initial month |
|---|
| 283 | iday = int(ndate0 - iyear * 10000 - imonth * 100) ! initial day betwen 1 and 30 |
|---|
| 284 | |
|---|
| 285 | call uvset(0,iday,imonth,iyear,ftc,vplu) |
|---|
| 286 | ! |
|---|
| 287 | if(lwp) write(numout,*) 'Correcting tide for date:',iday,imonth,iyear |
|---|
| 288 | |
|---|
| 289 | do jtide = 1, ntide |
|---|
| 290 | ! |
|---|
| 291 | if(indx(jtide) .ne. 0) then |
|---|
| 292 | arg=3.14159265d0*vplu(indx(jtide))/180.0d0 |
|---|
| 293 | atde=ftc(indx(jtide))*cos(arg) |
|---|
| 294 | btde=ftc(indx(jtide))*sin(arg) |
|---|
| 295 | if(lwp) then |
|---|
| 296 | write(numout,'(2i5,8f10.6)') jtide,indx(jtide),tide_speed(jtide), & |
|---|
| 297 | ftc(indx(jtide)),vplu(indx(jtide)) |
|---|
| 298 | endif |
|---|
| 299 | else |
|---|
| 300 | atde = 1.0_wp |
|---|
| 301 | btde = 0.0_wp |
|---|
| 302 | endif |
|---|
| 303 | ! elevation |
|---|
| 304 | jgrd = 1 |
|---|
| 305 | do jb=1, nblenrim(jgrd) |
|---|
| 306 | z1t=atde*ssh1(jb,jtide)+btde*ssh2(jb,jtide) |
|---|
| 307 | z2t=atde*ssh2(jb,jtide)-btde*ssh1(jb,jtide) |
|---|
| 308 | ssh1(jb,jtide) = z1t |
|---|
| 309 | ssh2(jb,jtide) = z2t |
|---|
| 310 | end do |
|---|
| 311 | ! u |
|---|
| 312 | jgrd = 2 |
|---|
| 313 | do jb=1, nblenrim(jgrd) |
|---|
| 314 | z1t=atde*u1(jb,jtide)+btde*u2(jb,jtide) |
|---|
| 315 | z2t=atde*u2(jb,jtide)-btde*u1(jb,jtide) |
|---|
| 316 | u1(jb,jtide) = z1t |
|---|
| 317 | u2(jb,jtide) = z2t |
|---|
| 318 | end do |
|---|
| 319 | ! v |
|---|
| 320 | jgrd = 3 |
|---|
| 321 | do jb=1, nblenrim(jgrd) |
|---|
| 322 | z1t=atde*v1(jb,jtide)+btde*v2(jb,jtide) |
|---|
| 323 | z2t=atde*v2(jb,jtide)-btde*v1(jb,jtide) |
|---|
| 324 | v1(jb,jtide) = z1t |
|---|
| 325 | v2(jb,jtide) = z2t |
|---|
| 326 | end do |
|---|
| 327 | |
|---|
| 328 | enddo ! end loop on tidal components |
|---|
| 329 | endif ! date correction |
|---|
| 330 | |
|---|
| 331 | END SUBROUTINE tide_data |
|---|
| 332 | |
|---|
| 333 | SUBROUTINE tide_update ( kt, jit ) |
|---|
| 334 | !!------------------------------------------------------------------------------ |
|---|
| 335 | !! SUBROUTINE tide_update |
|---|
| 336 | !! ************************ |
|---|
| 337 | !! ** Purpose : - Add tidal forcing to sshbdy, ubtbdy and vbtbdy arrays. |
|---|
| 338 | !! |
|---|
| 339 | !! |
|---|
| 340 | !! History : |
|---|
| 341 | !! NEMO v2.0 ! 06-12 (D.Storkey) Original |
|---|
| 342 | !!------------------------------------------------------------------------------ |
|---|
| 343 | !! * Arguments |
|---|
| 344 | INTEGER, INTENT( in ) :: kt ! Main timestep counter |
|---|
| 345 | INTEGER, INTENT( in ) :: jit ! Barotropic timestep counter (for timesplitting option) |
|---|
| 346 | |
|---|
| 347 | !! * Local declarations |
|---|
| 348 | INTEGER :: jtide, jgrd, jb ! dummy loop indices |
|---|
| 349 | REAL(wp) :: arg, sarg |
|---|
| 350 | REAL(wp), DIMENSION(ntide_max) :: sist, cost |
|---|
| 351 | |
|---|
| 352 | !!------------------------------------------------------------------------------ |
|---|
| 353 | !! OPA 9.0, LODYC-IPSL (2003) |
|---|
| 354 | !!------------------------------------------------------------------------------ |
|---|
| 355 | |
|---|
| 356 | ! Note tide phase speeds are in deg/hour, so we need to convert the |
|---|
| 357 | ! elapsed time in seconds to hours by dividing by 3600.0 |
|---|
| 358 | if ( jit .eq. 0 ) then |
|---|
| 359 | arg = kt*rdt*rad/3600.0 |
|---|
| 360 | else ! we are in a barotropic subcycle (for timesplitting option) |
|---|
| 361 | arg = ( (kt-1)*rdt + jit*rdtbt ) * rad/3600.0 |
|---|
| 362 | endif |
|---|
| 363 | |
|---|
| 364 | do jtide = 1,ntide |
|---|
| 365 | sarg = arg*tide_speed(jtide) |
|---|
| 366 | cost(jtide) = cos(sarg) |
|---|
| 367 | sist(jtide) = sin(sarg) |
|---|
| 368 | enddo |
|---|
| 369 | |
|---|
| 370 | !! summing of tidal constituents into BDY arrays |
|---|
| 371 | |
|---|
| 372 | sshtide(:) = 0.0 |
|---|
| 373 | utide(:) = 0.0 |
|---|
| 374 | vtide(:) = 0.0 |
|---|
| 375 | |
|---|
| 376 | do jtide = 1 ,ntide |
|---|
| 377 | jgrd=1 !: SSH on tracer grid. |
|---|
| 378 | do jb = 1, nblenrim(jgrd) |
|---|
| 379 | sshtide(jb) =sshtide(jb)+ ssh1(jb,jtide)*cost(jtide) + ssh2(jb,jtide)*sist(jtide) |
|---|
| 380 | ! if(lwp) write(numout,*) 'z',jb,jtide,sshtide(jb), ssh1(jb,jtide),ssh2(jb,jtide) |
|---|
| 381 | enddo |
|---|
| 382 | jgrd=2 !: U grid |
|---|
| 383 | do jb=1, nblenrim(jgrd) |
|---|
| 384 | utide(jb) = utide(jb)+ u1(jb,jtide)*cost(jtide) + u2(jb,jtide)*sist(jtide) |
|---|
| 385 | ! if(lwp) write(numout,*) 'u',jb,jtide,utide(jb), u1(jb,jtide),u2(jb,jtide) |
|---|
| 386 | |
|---|
| 387 | enddo |
|---|
| 388 | jgrd=3 !: V grid |
|---|
| 389 | do jb=1, nblenrim(jgrd) |
|---|
| 390 | vtide(jb) = vtide(jb)+ v1(jb,jtide)*cost(jtide) + v2(jb,jtide)*sist(jtide) |
|---|
| 391 | ! if(lwp) write(numout,*) 'v',jb,jtide,vtide(jb), v1(jb,jtide),v2(jb,jtide) |
|---|
| 392 | |
|---|
| 393 | enddo |
|---|
| 394 | enddo |
|---|
| 395 | |
|---|
| 396 | END SUBROUTINE tide_update |
|---|
| 397 | |
|---|
| 398 | ! |
|---|
| 399 | ! |
|---|
| 400 | SUBROUTINE uvset (ihs,iday,imnth,iyr,f,vplu) |
|---|
| 401 | !!------------------------------------------------------------------------------ |
|---|
| 402 | !! SUBROUTINE uvset |
|---|
| 403 | !! ************************ |
|---|
| 404 | !! ** Purpose : - adjust tidal forcing for date factors |
|---|
| 405 | !! |
|---|
| 406 | !! |
|---|
| 407 | !! History : |
|---|
| 408 | !! |
|---|
| 409 | !! Origins POLCOMS v6.3 2007 |
|---|
| 410 | !! NEMO v2.3 ! Jason Holt |
|---|
| 411 | !!------------------------------------------------------------------------------ |
|---|
| 412 | implicit none |
|---|
| 413 | !! * Arguments |
|---|
| 414 | INTEGER, INTENT( in ) :: ihs ! Start time hours |
|---|
| 415 | INTEGER, INTENT( in ) :: iday ! start time days |
|---|
| 416 | INTEGER, INTENT( in ) :: imnth ! start time month |
|---|
| 417 | INTEGER, INTENT( in ) :: iyr ! start time year |
|---|
| 418 | INTEGER, PARAMETER :: nc =15 ! maximum number of constituents |
|---|
| 419 | |
|---|
| 420 | REAL(WP) :: f(nc) ! nodal correction |
|---|
| 421 | REAL(WP) :: vplu(nc) ! phase correction |
|---|
| 422 | ! |
|---|
| 423 | INTEGER :: year,vd,ivdy,ndc,i,k |
|---|
| 424 | REAL(WP) :: u(nc),v(nc),zig(nc),rtd |
|---|
| 425 | REAL(WP) :: ss,h,p,en,p1 |
|---|
| 426 | CHARACTER(len=8), DIMENSION(nc) :: cname |
|---|
| 427 | ! |
|---|
| 428 | !!------------------------------------------------------------------------------ |
|---|
| 429 | !! OPA 9.0, LODYC-IPSL (2007) |
|---|
| 430 | !!------------------------------------------------------------------------------ |
|---|
| 431 | |
|---|
| 432 | data cname/ 'q1', 'o1', 'p1', 's1', 'k1', & |
|---|
| 433 | '2n2','mu2', 'n2','nu2', 'm2', 'l2', 't2', 's2', 'k2', & |
|---|
| 434 | 'm4'/ |
|---|
| 435 | data zig/.2338507481,.2433518789,.2610826055,.2617993878 & |
|---|
| 436 | , .2625161701 & |
|---|
| 437 | , .4868657873,.4881373225,.4963669182,.4976384533 & |
|---|
| 438 | , .5058680490,.5153691799,.5228820265,.5235987756 & |
|---|
| 439 | , .5250323419 & |
|---|
| 440 | , 1.011736098/ |
|---|
| 441 | ! |
|---|
| 442 | ! ihs - start time gmt on ... |
|---|
| 443 | ! iday/imnth/iyr - date e.g. 12/10/87 |
|---|
| 444 | ! |
|---|
| 445 | call vday(iday,imnth,iyr,ivdy) |
|---|
| 446 | vd=ivdy |
|---|
| 447 | ! |
|---|
| 448 | !rp note change of year number for d. blackman shpen |
|---|
| 449 | !rp if(iyr.ge.1000) year=iyr-1900 |
|---|
| 450 | !rp if(iyr.lt.1000) year=iyr |
|---|
| 451 | year = iyr |
|---|
| 452 | ! |
|---|
| 453 | !.....year = year of required data |
|---|
| 454 | !.....vd = day of required data..set up for 0000gmt day year |
|---|
| 455 | ! |
|---|
| 456 | ndc = nc |
|---|
| 457 | !.....ndc = number of constituents allowed |
|---|
| 458 | ! |
|---|
| 459 | rtd = 360.0/6.2831852 |
|---|
| 460 | do i = 1,ndc |
|---|
| 461 | zig(i) = zig(i)*rtd |
|---|
| 462 | ! sigo(i)= zig(i) |
|---|
| 463 | enddo |
|---|
| 464 | ! |
|---|
| 465 | if(year == 0) then |
|---|
| 466 | return |
|---|
| 467 | endif |
|---|
| 468 | |
|---|
| 469 | call shpen (year,vd,ss,h,p,en,p1) |
|---|
| 470 | call ufset (p,en,u,f) |
|---|
| 471 | call vset (ss,h,p,en,p1,v) |
|---|
| 472 | ! |
|---|
| 473 | do k=1,nc |
|---|
| 474 | |
|---|
| 475 | vplu(k)=v(k)+u(k) |
|---|
| 476 | vplu(k)=vplu(k)+dble(ihs)*zig(k) |
|---|
| 477 | ! |
|---|
| 478 | do while ( vplu(k) < 0 ) |
|---|
| 479 | vplu(k) = vplu(k) + 360.0 |
|---|
| 480 | enddo |
|---|
| 481 | ! |
|---|
| 482 | do while (vplu(k) > 360. ) |
|---|
| 483 | vplu(k) = vplu(k) - 360.0 |
|---|
| 484 | enddo |
|---|
| 485 | ! |
|---|
| 486 | enddo |
|---|
| 487 | ! |
|---|
| 488 | END SUBROUTINE uvset |
|---|
| 489 | |
|---|
| 490 | |
|---|
| 491 | SUBROUTINE vday(iday,imnth,iy,ivdy) |
|---|
| 492 | !!------------------------------------------------------------------------------ |
|---|
| 493 | !! SUBROUTINE vday |
|---|
| 494 | !! **************** |
|---|
| 495 | !! ** Purpose : - adjust tidal forcing for date factors |
|---|
| 496 | !! |
|---|
| 497 | !! |
|---|
| 498 | !! History : |
|---|
| 499 | !! |
|---|
| 500 | !! Origins POLCOMS v6.3 2007 |
|---|
| 501 | !! NEMO v2.3 ! Jason Holt |
|---|
| 502 | !!------------------------------------------------------------------------------ |
|---|
| 503 | implicit none |
|---|
| 504 | ! |
|---|
| 505 | ! subroutine arguments |
|---|
| 506 | integer :: iday,imnth,iy,ivdy |
|---|
| 507 | ! |
|---|
| 508 | ! local variables |
|---|
| 509 | integer iyr |
|---|
| 510 | !!------------------------------------------------------------------------------ |
|---|
| 511 | !! NEMO 2.3, LODYC-IPSL (2008) |
|---|
| 512 | !!------------------------------------------------------------------------------ |
|---|
| 513 | |
|---|
| 514 | ! ================================================================= |
|---|
| 515 | ! |
|---|
| 516 | ! calculate day number in year from day/month/year |
|---|
| 517 | ! |
|---|
| 518 | ! ================================================================= |
|---|
| 519 | if(imnth.eq.1) ivdy=iday |
|---|
| 520 | if(imnth.eq.2) ivdy=iday+31 |
|---|
| 521 | if(imnth.eq.3) ivdy=iday+59 |
|---|
| 522 | if(imnth.eq.4) ivdy=iday+90 |
|---|
| 523 | if(imnth.eq.5) ivdy=iday+120 |
|---|
| 524 | if(imnth.eq.6) ivdy=iday+151 |
|---|
| 525 | if(imnth.eq.7) ivdy=iday+181 |
|---|
| 526 | if(imnth.eq.8) ivdy=iday+212 |
|---|
| 527 | if(imnth.eq.9) ivdy=iday+243 |
|---|
| 528 | if(imnth.eq.10) ivdy=iday+273 |
|---|
| 529 | if(imnth.eq.11) ivdy=iday+304 |
|---|
| 530 | if(imnth.eq.12) ivdy=iday+334 |
|---|
| 531 | iyr=iy |
|---|
| 532 | if(mod(iyr,4).eq.0.and.imnth.gt.2) ivdy=ivdy+1 |
|---|
| 533 | if(mod(iyr,100).eq.0.and.imnth.gt.2) ivdy=ivdy-1 |
|---|
| 534 | if(mod(iyr,400).eq.0.and.imnth.gt.2) ivdy=ivdy+1 |
|---|
| 535 | |
|---|
| 536 | RETURN |
|---|
| 537 | END SUBROUTINE vday |
|---|
| 538 | |
|---|
| 539 | SUBROUTINE shpen (year,vd,s,h,p,en,p1) |
|---|
| 540 | !!------------------------------------------------------------------------------ |
|---|
| 541 | !! SUBROUTINE shpen |
|---|
| 542 | !! ***************** |
|---|
| 543 | !! ** Purpose : - calculate astronomical arguments for tides |
|---|
| 544 | !! this version from d. blackman 30 nove 1990 |
|---|
| 545 | !! |
|---|
| 546 | !! History : |
|---|
| 547 | !! |
|---|
| 548 | !! Origins POLCOMS v6.3 2007 |
|---|
| 549 | !! NEMO v2.3 ! Jason Holt |
|---|
| 550 | !!------------------------------------------------------------------------------ |
|---|
| 551 | implicit none |
|---|
| 552 | |
|---|
| 553 | ! subroutine arguments |
|---|
| 554 | integer ::year,vd |
|---|
| 555 | real(wp) :: s,h,p,en,p1 |
|---|
| 556 | |
|---|
| 557 | ! local variables |
|---|
| 558 | |
|---|
| 559 | integer yr,ilc,icent,it,iday,ild,ipos,nn,iyd |
|---|
| 560 | REAL(wp) :: cycle,t,td,delt(84),delta,deltat |
|---|
| 561 | |
|---|
| 562 | !!------------------------------------------------------------------------------ |
|---|
| 563 | !! NEMO 2.3, LODYC-IPSL (2008) |
|---|
| 564 | !!------------------------------------------------------------------------------ |
|---|
| 565 | |
|---|
| 566 | data delt /-5.04,-3.90,-2.87,-0.58,0.71,1.80, & |
|---|
| 567 | 3.08, 4.63, 5.86, 7.21, 8.58,10.50,12.10, & |
|---|
| 568 | 12.49,14.41,15.59,15.81,17.52,19.01,18.39, & |
|---|
| 569 | 19.55,20.36,21.01,21.81,21.76,22.35,22.68, & |
|---|
| 570 | 22.94,22.93,22.69,22.94,23.20,23.31,23.63, & |
|---|
| 571 | 23.47,23.68,23.62,23.53,23.59,23.99,23.80, & |
|---|
| 572 | 24.20,24.99,24.97,25.72,26.21,26.37,26.89, & |
|---|
| 573 | 27.68,28.13,28.94,29.42,29.66,30.29,30.96, & |
|---|
| 574 | 31.09,31.59,31.52,31.92,32.45,32.91,33.39, & |
|---|
| 575 | 33.80,34.23,34.73,35.40,36.14,36.99,37.87, & |
|---|
| 576 | 38.75,39.70,40.70,41.68,42.82,43.96,45.00, & |
|---|
| 577 | 45.98,47.00,48.03,49.10,50.10,50.97,51.81, & |
|---|
| 578 | 52.57/ |
|---|
| 579 | ! |
|---|
| 580 | cycle = 360.0 |
|---|
| 581 | ilc = 0 |
|---|
| 582 | icent = year/100 |
|---|
| 583 | yr = year - icent*100 |
|---|
| 584 | t = icent - 20 |
|---|
| 585 | ! |
|---|
| 586 | ! for the following equations |
|---|
| 587 | ! time origin is fixed at 00 hr of jan 1st,2000. |
|---|
| 588 | ! see notes by cartwright |
|---|
| 589 | ! |
|---|
| 590 | it = icent - 20 |
|---|
| 591 | if (it) 1,2,2 |
|---|
| 592 | 1 iday = it/4 -it |
|---|
| 593 | go to 3 |
|---|
| 594 | 2 iday = (it+3)/4 - it |
|---|
| 595 | ! |
|---|
| 596 | ! t is in julian century |
|---|
| 597 | ! correction in gegorian calander where only century year divisible |
|---|
| 598 | ! by 4 is leap year. |
|---|
| 599 | ! |
|---|
| 600 | 3 continue |
|---|
| 601 | ! |
|---|
| 602 | td = 0.0 |
|---|
| 603 | ! |
|---|
| 604 | if (yr) 4,5,4 |
|---|
| 605 | ! |
|---|
| 606 | 4 iyd = 365*yr |
|---|
| 607 | ild = (yr-1)/4 |
|---|
| 608 | if((icent - (icent/4)*4) .eq. 0) ilc = 1 |
|---|
| 609 | td = iyd + ild + ilc |
|---|
| 610 | ! |
|---|
| 611 | 5 td = td + iday + vd -1.0 - 0.5 |
|---|
| 612 | t = t + (td/36525.0) |
|---|
| 613 | ! |
|---|
| 614 | ipos=year-1899 |
|---|
| 615 | if (ipos .lt. 0) go to 7 |
|---|
| 616 | if (ipos .gt. 83) go to 6 |
|---|
| 617 | ! |
|---|
| 618 | delta = (delt(ipos+1)+delt(ipos))/2.0 |
|---|
| 619 | go to 7 |
|---|
| 620 | ! |
|---|
| 621 | 6 delta= (65.0-50.5)/20.0*(year-1980)+50.5 |
|---|
| 622 | ! |
|---|
| 623 | 7 deltat = delta * 1.0e-6 |
|---|
| 624 | ! |
|---|
| 625 | s = 218.3165 + 481267.8813*t - 0.0016*t*t + 152.0*deltat |
|---|
| 626 | h = 280.4661 + 36000.7698*t + 0.0003*t*t + 11.0*deltat |
|---|
| 627 | p = 83.3535 + 4069.0139*t - 0.0103*t*t + deltat |
|---|
| 628 | en = 234.9555 + 1934.1363*t - 0.0021*t*t + deltat |
|---|
| 629 | p1 = 282.9384 + 1.7195*t + 0.0005*t*t |
|---|
| 630 | ! |
|---|
| 631 | nn = s/cycle |
|---|
| 632 | s = s - nn*cycle |
|---|
| 633 | if ( s .lt. 0.0) s = s+cycle |
|---|
| 634 | ! |
|---|
| 635 | nn = h/cycle |
|---|
| 636 | h = h-cycle*nn |
|---|
| 637 | if (h .lt. 0.0) h = h+cycle |
|---|
| 638 | ! |
|---|
| 639 | nn = p/cycle |
|---|
| 640 | p = p- cycle*nn |
|---|
| 641 | if (p .lt. 0.0) p = p+cycle |
|---|
| 642 | ! |
|---|
| 643 | nn = en/cycle |
|---|
| 644 | en = en-cycle*nn |
|---|
| 645 | if(en .lt. 0.0) en = en + cycle |
|---|
| 646 | en = cycle - en |
|---|
| 647 | ! |
|---|
| 648 | nn = p1/cycle |
|---|
| 649 | p1 = p1 - nn*cycle |
|---|
| 650 | ! |
|---|
| 651 | RETURN |
|---|
| 652 | ! |
|---|
| 653 | END SUBROUTINE shpen |
|---|
| 654 | |
|---|
| 655 | |
|---|
| 656 | SUBROUTINE ufset (p,cn,b,a) |
|---|
| 657 | !!------------------------------------------------------------------------------ |
|---|
| 658 | !! SUBROUTINE ufset |
|---|
| 659 | !! ***************** |
|---|
| 660 | !! ** Purpose : - calculate nodal parameters for the tides |
|---|
| 661 | !! |
|---|
| 662 | !! |
|---|
| 663 | !! History : |
|---|
| 664 | !! |
|---|
| 665 | !! Origins POLCOMS v6.3 2007 |
|---|
| 666 | !! NEMO v2.3 ! Jason Holt |
|---|
| 667 | !!------------------------------------------------------------------------------ |
|---|
| 668 | |
|---|
| 669 | implicit none |
|---|
| 670 | integer nc |
|---|
| 671 | parameter (nc=15) |
|---|
| 672 | ! subroutine arguments |
|---|
| 673 | real(wp) p,cn |
|---|
| 674 | ! |
|---|
| 675 | ! |
|---|
| 676 | ! local variables |
|---|
| 677 | real(wp) :: w1,w2,w3,w4,w5,w6,w7,w8,nw,pw,rad |
|---|
| 678 | real(wp) :: a(nc),b(nc) |
|---|
| 679 | integer ndc,k |
|---|
| 680 | ! |
|---|
| 681 | !!------------------------------------------------------------------------------ |
|---|
| 682 | !! NEMO 2.3, LODYC-IPSL (2008) |
|---|
| 683 | !!------------------------------------------------------------------------------ |
|---|
| 684 | |
|---|
| 685 | ndc=nc |
|---|
| 686 | ! |
|---|
| 687 | ! a=f , b =u |
|---|
| 688 | ! t is zero as compared to tifa. |
|---|
| 689 | rad = 6.2831852d0/360.0 |
|---|
| 690 | pw = p*rad |
|---|
| 691 | nw = cn*rad |
|---|
| 692 | w1 = cos(nw) |
|---|
| 693 | w2 = cos(2*nw) |
|---|
| 694 | w3 = cos(3*nw) |
|---|
| 695 | w4 = sin(nw) |
|---|
| 696 | w5 = sin(2*nw) |
|---|
| 697 | w6 = sin(3*nw) |
|---|
| 698 | w7 = 1 -0.2505*cos(2*pw) -0.1102*cos(2*pw-nw) & |
|---|
| 699 | -0.156*cos(2*pw-2*nw) -0.037*cos(nw) |
|---|
| 700 | w8 = -0.2505*sin(2*pw) -0.1102*sin(2*pw-nw) & |
|---|
| 701 | -0.0156*sin(2*pw-2*nw) -0.037*sin(nw) |
|---|
| 702 | ! |
|---|
| 703 | a(1) = 1.0089+0.1871*w1-0.0147*w2+0.0014*w3 |
|---|
| 704 | b(1) = 0.1885*w4 - 0.0234*w5+.0033*w6 |
|---|
| 705 | ! q1 |
|---|
| 706 | a(2) = a(1) |
|---|
| 707 | b(2) = b(1) |
|---|
| 708 | ! o1 |
|---|
| 709 | a(3) = 1.0 |
|---|
| 710 | b(3) = 0.0 |
|---|
| 711 | ! p1 |
|---|
| 712 | a(4) = 1.0 |
|---|
| 713 | b(4) = 0.0 |
|---|
| 714 | ! s1 |
|---|
| 715 | a(5) = 1.0060+0.1150*w1- 0.0088*w2 +0.0006*w3 |
|---|
| 716 | b(5) = -0.1546*w4 + 0.0119*w5 -0.0012*w6 |
|---|
| 717 | ! k1 |
|---|
| 718 | a(6) =1.0004 -0.0373*w1+ 0.0002*w2 |
|---|
| 719 | b(6) = -0.0374*w4 |
|---|
| 720 | ! 2n2 |
|---|
| 721 | a(7) = a(6) |
|---|
| 722 | b(7) = b(6) |
|---|
| 723 | ! mu2 |
|---|
| 724 | a(8) = a(6) |
|---|
| 725 | b(8) = b(6) |
|---|
| 726 | ! n2 |
|---|
| 727 | a(9) = a(6) |
|---|
| 728 | b(9) = b(6) |
|---|
| 729 | ! nu2 |
|---|
| 730 | a(10) = a(6) |
|---|
| 731 | b(10) = b(6) |
|---|
| 732 | ! m2 |
|---|
| 733 | a(11) = sqrt(w7*w7+w8*w8) |
|---|
| 734 | b(11) = atan(w8/w7) |
|---|
| 735 | if(w7.lt.0) b(11) = b(11) + 3.141992 |
|---|
| 736 | ! l2 |
|---|
| 737 | a(12) = 1.0 |
|---|
| 738 | b(12) = 0.0 |
|---|
| 739 | ! t2 |
|---|
| 740 | a(13)= a(12) |
|---|
| 741 | b(13)= b(12) |
|---|
| 742 | ! s2 |
|---|
| 743 | a(14) = 1.0241+0.2863*w1+0.0083*w2 -0.0015*w3 |
|---|
| 744 | b(14) = -0.3096*w4 + 0.0119*w5 - 0.0007*w6 |
|---|
| 745 | ! k2 |
|---|
| 746 | a(15) = a(6)*a(6) |
|---|
| 747 | b(15) = 2*b(6) |
|---|
| 748 | ! m4 |
|---|
| 749 | ! |
|---|
| 750 | do 40 k = 1,ndc |
|---|
| 751 | b(k) = b(k)/rad |
|---|
| 752 | 32 if (b(k)) 34,35,35 |
|---|
| 753 | 34 b(k) = b(k) + 360.0 |
|---|
| 754 | go to 32 |
|---|
| 755 | 35 if (b(k)-360.0) 40,37,37 |
|---|
| 756 | 37 b(k) = b(k)-360.0 |
|---|
| 757 | go to 35 |
|---|
| 758 | 40 continue |
|---|
| 759 | RETURN |
|---|
| 760 | END SUBROUTINE ufset |
|---|
| 761 | |
|---|
| 762 | SUBROUTINE vset( s,h,p,en,p1,v) |
|---|
| 763 | !!------------------------------------------------------------------------------ |
|---|
| 764 | !! SUBROUTINE vset |
|---|
| 765 | !! **************** |
|---|
| 766 | !! ** Purpose : - calculate tidal phases for 0000gmt on start day of run |
|---|
| 767 | !! |
|---|
| 768 | !! |
|---|
| 769 | !! History : |
|---|
| 770 | !! |
|---|
| 771 | !! Origins POLCOMS v6.3 2007 |
|---|
| 772 | !! NEMO v2.3 ! Jason Holt |
|---|
| 773 | !!------------------------------------------------------------------------------ |
|---|
| 774 | implicit none |
|---|
| 775 | integer nc |
|---|
| 776 | parameter (nc=15) |
|---|
| 777 | ! subroutine arguments |
|---|
| 778 | real(wp) s,h,p,en,p1 |
|---|
| 779 | real(wp) v(nc) |
|---|
| 780 | ! |
|---|
| 781 | integer ndc,k |
|---|
| 782 | !!------------------------------------------------------------------------------ |
|---|
| 783 | !! NEMO 2.3, LODYC-IPSL (2008) |
|---|
| 784 | !!------------------------------------------------------------------------------ |
|---|
| 785 | |
|---|
| 786 | ndc = nc |
|---|
| 787 | ! v s are computed here. |
|---|
| 788 | v(1) =-3*s +h +p +270 |
|---|
| 789 | ! q1 |
|---|
| 790 | v(2) =-2*s +h +270.0 |
|---|
| 791 | ! o1 |
|---|
| 792 | v(3) =-h +270 |
|---|
| 793 | ! p1 |
|---|
| 794 | v(4) =180 |
|---|
| 795 | ! s1 |
|---|
| 796 | v(5) =h +90.0 |
|---|
| 797 | ! k1 |
|---|
| 798 | v(6) =-4*s +2*h +2*p |
|---|
| 799 | ! 2n2 |
|---|
| 800 | v(7) =-4*(s-h) |
|---|
| 801 | ! mu2 |
|---|
| 802 | v(8) =-3*s +2*h +p |
|---|
| 803 | ! n2 |
|---|
| 804 | v(9) =-3*s +4*h -p |
|---|
| 805 | ! mu2 |
|---|
| 806 | v(10) =-2*s +2*h |
|---|
| 807 | ! m2 |
|---|
| 808 | v(11) =-s +2*h -p +180 |
|---|
| 809 | ! l2 |
|---|
| 810 | v(12) =-h +p1 |
|---|
| 811 | ! t2 |
|---|
| 812 | v(13) =0 |
|---|
| 813 | ! s2 |
|---|
| 814 | v(14) =h+h |
|---|
| 815 | ! k2 |
|---|
| 816 | v(15) =2*v(10) |
|---|
| 817 | ! m4 |
|---|
| 818 | ! |
|---|
| 819 | do 72 k = 1, ndc |
|---|
| 820 | 69 if (v(k) ) 70,71,71 |
|---|
| 821 | 70 v(k)=v(k)+360.0 |
|---|
| 822 | go to 69 |
|---|
| 823 | 71 if ( v(k) - 360.0) 72,73,73 |
|---|
| 824 | 73 v(k)=v(k)-360.0 |
|---|
| 825 | go to 71 |
|---|
| 826 | 72 continue |
|---|
| 827 | RETURN |
|---|
| 828 | END SUBROUTINE vset |
|---|
| 829 | |
|---|
| 830 | #else |
|---|
| 831 | !!================================================================================= |
|---|
| 832 | !! *** MODULE bdytides *** |
|---|
| 833 | !!================================================================================= |
|---|
| 834 | |
|---|
| 835 | LOGICAL, PUBLIC, PARAMETER :: lk_bdy_tides = .FALSE. !: tidal forcing at boundaries. |
|---|
| 836 | |
|---|
| 837 | CHARACTER(len=80), PUBLIC :: & |
|---|
| 838 | filtide !: Filename root for tidal input files |
|---|
| 839 | |
|---|
| 840 | CHARACTER(len=4), PUBLIC, DIMENSION(1) :: & |
|---|
| 841 | tide_cpt !: Names of tidal components used. |
|---|
| 842 | |
|---|
| 843 | CONTAINS |
|---|
| 844 | |
|---|
| 845 | SUBROUTINE tide_init |
|---|
| 846 | ! No tidal forcing at boundaries ==> empty routine |
|---|
| 847 | END SUBROUTINE tide_init |
|---|
| 848 | |
|---|
| 849 | SUBROUTINE tide_data |
|---|
| 850 | ! No tidal forcing at boundaries ==> empty routine |
|---|
| 851 | END SUBROUTINE tide_data |
|---|
| 852 | |
|---|
| 853 | SUBROUTINE tide_update( kt, jit ) |
|---|
| 854 | INTEGER :: kt, jit |
|---|
| 855 | WRITE(*,*) 'tide_update: You should not have seen this print! error?', kt, jit |
|---|
| 856 | |
|---|
| 857 | ! No tidal forcing at boundaries ==> empty routine |
|---|
| 858 | END SUBROUTINE tide_update |
|---|
| 859 | |
|---|
| 860 | #endif |
|---|
| 861 | |
|---|
| 862 | END MODULE bdytides |
|---|
