Changeset 6140 for trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
 Timestamp:
 20151221T12:35:23+01:00 (5 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r5836 r6140 2 2 3 3 MODULE agrif_opa_sponge 4 !!====================================================================== 5 !! *** MODULE agrif_opa_update *** 6 !! AGRIF : 7 !!====================================================================== 8 !! History : 9 !! 4 10 #if defined key_agrif && ! defined key_offline 5 11 USE par_oce … … 17 23 PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge 18 24 19 !! * Substitutions20 # include "domzgr_substitute.h90"21 25 !! 22 !! NEMO/NST 3. 3 , NEMO Consortium (2010)26 !! NEMO/NST 3.7 , NEMO Consortium (2015) 23 27 !! $Id$ 24 28 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 25 29 !! 26 27 30 CONTAINS 28 31 … … 31 34 !! *** ROUTINE Agrif_Sponge_Tra *** 32 35 !! 33 !!34 36 REAL(wp) :: timecoeff 35 37 !! 38 ! 36 39 #if defined SPONGE 37 40 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() … … 46 49 Agrif_UseSpecialValue = .FALSE. 47 50 #endif 48 51 ! 49 52 END SUBROUTINE Agrif_Sponge_Tra 50 53 54 51 55 SUBROUTINE Agrif_Sponge_dyn 52 56 !! 53 57 !! *** ROUTINE Agrif_Sponge_dyn *** 54 58 !! 55 !!56 59 REAL(wp) :: timecoeff 60 !! 57 61 58 62 #if defined SPONGE … … 72 76 Agrif_UseSpecialValue = .FALSE. 73 77 #endif 74 78 ! 75 79 END SUBROUTINE Agrif_Sponge_dyn 80 76 81 77 82 SUBROUTINE Agrif_Sponge … … 183 188 ! 184 189 #endif 185 190 ! 186 191 END SUBROUTINE Agrif_Sponge 192 187 193 188 194 SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) … … 193 199 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 194 200 LOGICAL, INTENT(in) :: before 195 196 201 ! 197 202 INTEGER :: ji, jj, jk, jn ! dummy loop indices 198 203 INTEGER :: iku, ikv … … 201 206 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 202 207 ! 203 IF (before) THEN208 IF( before ) THEN 204 209 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 205 210 ELSE 206 211 ! 207 212 tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:)  tabres(:,:,:,:) 208 213 DO jn = 1, jpts … … 210 215 DO jj = j1,j21 211 216 DO ji = i1,i21 212 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)213 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)217 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 218 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 214 219 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn)  tsbdiff(ji,jj,jk,jn) ) 215 220 ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn)  tsbdiff(ji,jj,jk,jn) ) 216 END DO217 END DO218 221 END DO 222 END DO 223 ! 219 224 IF( ln_zps ) THEN ! set gradient at partial step level 220 225 DO jj = j1,j21 … … 223 228 iku = mbku(ji,jj) 224 229 ikv = mbkv(ji,jj) 225 IF( iku == jk ) THEN 226 ztu(ji,jj,jk) = 0._wp 227 ENDIF 228 IF( ikv == jk ) THEN 229 ztv(ji,jj,jk) = 0._wp 230 ENDIF 230 IF( iku == jk ) ztu(ji,jj,jk) = 0._wp 231 IF( ikv == jk ) ztv(ji,jj,jk) = 0._wp 231 232 END DO 232 233 END DO 233 234 ENDIF 234 END DO235 235 END DO 236 ! 236 237 DO jk = 1, jpkm1 237 238 DO jj = j1+1,j21 238 239 DO ji = i1+1,i21 239 240 240 IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 241 zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk)241 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 242 242 ! horizontal diffusive trends 243 243 ztsa = zbtr * ( ztu(ji,jj,jk)  ztu(ji1,jj,jk) + ztv(ji,jj,jk)  ztv(ji ,jj1,jk) ) … … 245 245 tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 246 246 ENDIF 247 248 ENDDO 249 ENDDO 250 251 ENDDO 252 ENDDO 253 247 END DO 248 END DO 249 END DO 250 ! 251 END DO 252 ! 254 253 tabspongedone_tsn(i1+1:i21,j1+1:j21) = .TRUE. 255 256 ENDIF 257 254 ! 255 ENDIF 256 ! 258 257 END SUBROUTINE interptsn_sponge 258 259 259 260 260 SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) … … 273 273 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 274 274 INTEGER :: jmax 275 ! 276 277 278 IF (before) THEN 275 !! 276 ! 277 IF( before ) THEN 279 278 tabres = un(i1:i2,j1:j2,:) 280 279 ELSE 281 282 280 ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:)  tabres(:,:,:))*umask(i1:i2,j1:j2,:) 283 281 ! 284 282 DO jk = 1, jpkm1 ! Horizontal slab 285 283 ! ! =============== … … 290 288 DO jj = j1,j2 291 289 DO ji = i1+1,i2 ! vector opt. 292 zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)293 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)* fse3u_n(ji ,jj,jk) * ubdiff(ji ,jj,jk) &294 & e2u(ji1,jj)* fse3u_n(ji1,jj,jk) * ubdiff(ji1,jj,jk) ) * zbtr290 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 291 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)*e3u_n(ji ,jj,jk) * ubdiff(ji ,jj,jk) & 292 & e2u(ji1,jj)*e3u_n(ji1,jj,jk) * ubdiff(ji1,jj,jk) ) * zbtr 295 293 END DO 296 294 END DO … … 298 296 DO jj = j1,j21 299 297 DO ji = i1,i2 ! vector opt. 300 zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)298 zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 301 299 rotdiff(ji,jj,jk) = (e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 302 300 +e1u(ji,jj ) * ubdiff(ji,jj ,jk) & … … 304 302 END DO 305 303 END DO 306 ENDDO 307 308 ! 309 310 311 304 END DO 305 ! 312 306 DO jj = j1+1, j21 313 307 DO ji = i1+1, i21 ! vector opt. … … 318 312 ze1v = hdivdiff(ji,jj,jk) 319 313 ! horizontal diffusive trends 320 zua =  ( ze2u  rotdiff (ji,jj1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) &314 zua =  ( ze2u  rotdiff (ji,jj1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) & 321 315 + ( hdivdiff(ji+1,jj,jk)  ze1v ) / e1u(ji,jj) 322 316 … … 344 338 345 339 ! horizontal diffusive trends 346 zva = + ( ze2u  rotdiff (ji1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) &340 zva = + ( ze2u  rotdiff (ji1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) & 347 341 + ( hdivdiff(ji,jj+1,jk)  ze1v ) / e2v(ji,jj) 348 342 … … 351 345 END DO 352 346 ENDIF 353 354 END DO 355 END DO 356 357 347 ! 348 END DO 349 END DO 350 ! 358 351 tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE. 359 360 ENDIF 361 362 352 ! 353 ENDIF 354 ! 363 355 END SUBROUTINE interpun_sponge 364 356 … … 372 364 LOGICAL, INTENT(in) :: before 373 365 INTEGER, INTENT(in) :: nb , ndir 374 375 INTEGER :: ji,jj,jk 376 377 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 378 366 ! 367 INTEGER :: ji, jj, jk 368 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 379 369 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 380 370 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 381 371 INTEGER :: imax 382 ! 383 384 IF (before) THEN372 !! 373 374 IF( before ) THEN 385 375 tabres = vn(i1:i2,j1:j2,:) 386 376 ELSE 387 377 ! 388 378 vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:)  tabres(:,:,:))*vmask(i1:i2,j1:j2,:) 389 379 ! 390 380 DO jk = 1, jpkm1 ! Horizontal slab 391 381 ! ! =============== … … 396 386 DO jj = j1+1,j2 397 387 DO ji = i1,i2 ! vector opt. 398 zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)399 hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * fse3v(ji,jj ,jk) * vbdiff(ji,jj ,jk) &400 & e1v(ji,jj1) * fse3v(ji,jj1,jk) * vbdiff(ji,jj1,jk) ) * zbtr388 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 389 hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * e3v_n(ji,jj ,jk) * vbdiff(ji,jj ,jk) & 390 & e1v(ji,jj1) * e3v_n(ji,jj1,jk) * vbdiff(ji,jj1,jk) ) * zbtr 401 391 END DO 402 392 END DO 403 393 DO jj = j1,j2 404 394 DO ji = i1,i21 ! vector opt. 405 zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)395 zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 406 396 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 407 & e2v(ji ,jj) * vbdiff(ji ,jj,jk) & 408 & ) * fmask(ji,jj,jk) * zbtr 409 END DO 410 END DO 411 ENDDO 397 & e2v(ji ,jj) * vbdiff(ji ,jj,jk) ) * fmask(ji,jj,jk) * zbtr 398 END DO 399 END DO 400 END DO 412 401 413 402 ! ! =============== … … 415 404 416 405 imax = i21 417 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci3)406 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci3) 418 407 419 408 DO jj = j1+1, j2 420 409 DO ji = i1+1, imax ! vector opt. 421 IF (.NOT. tabspongedone_u(ji,jj)) THEN 422 DO jk = 1, jpkm1 ! Horizontal slab 423 ze2u = rotdiff (ji,jj,jk) 424 ze1v = hdivdiff(ji,jj,jk) 425 ! horizontal diffusive trends 426 zua =  ( ze2u  rotdiff (ji,jj1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk)  ze1v) & 427 / e1u(ji,jj) 428 429 430 ! add it to the general momentum trends 431 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 432 END DO 433 434 ENDIF 435 END DO 436 END DO 437 410 IF( .NOT. tabspongedone_u(ji,jj) ) THEN 411 DO jk = 1, jpkm1 412 ua(ji,jj,jk) = ua(ji,jj,jk) & 413 &  ( rotdiff (ji ,jj,jk)  rotdiff (ji,jj1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) & 414 & + ( hdivdiff(ji+1,jj,jk)  hdivdiff(ji,jj ,jk)) * r1_e1u(ji,jj) 415 END DO 416 ENDIF 417 END DO 418 END DO 419 ! 438 420 tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE. 439 421 ! 440 422 DO jj = j1+1, j21 441 423 DO ji = i1+1, i21 ! vector opt. 442 IF (.NOT. tabspongedone_v(ji,jj)) THEN 443 DO jk = 1, jpkm1 ! Horizontal slab 444 ze2u = rotdiff (ji,jj,jk) 445 ze1v = hdivdiff(ji,jj,jk) 446 ! horizontal diffusive trends 447 448 zva = + ( ze2u  rotdiff (ji1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk)  ze1v) & 449 / e2v(ji,jj) 450 451 ! add it to the general momentum trends 452 va(ji,jj,jk) = va(ji,jj,jk) + zva 424 IF( .NOT. tabspongedone_v(ji,jj) ) THEN 425 DO jk = 1, jpkm1 426 va(ji,jj,jk) = va(ji,jj,jk) & 427 & + ( rotdiff (ji,jj ,jk)  rotdiff (ji1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) & 428 & + ( hdivdiff(ji,jj+1,jk)  hdivdiff(ji ,jj,jk) ) * r1_e2v(ji,jj) 453 429 END DO 454 430 ENDIF … … 457 433 tabspongedone_v(i1+1:i21,j1+1:j21) = .TRUE. 458 434 ENDIF 459 435 ! 460 436 END SUBROUTINE interpvn_sponge 461 437 462 438 #else 463 439 CONTAINS 464 465 440 SUBROUTINE agrif_opa_sponge_empty 466 441 !! … … 471 446 #endif 472 447 448 !!====================================================================== 473 449 END MODULE agrif_opa_sponge
Note: See TracChangeset
for help on using the changeset viewer.