Changeset 6004 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
- Timestamp:
- 2015-12-04T17:05:58+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r5845 r6004 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 … … 18 24 19 25 !!---------------------------------------------------------------------- 20 !! NEMO/NST 3. 3 , NEMO Consortium (2010)26 !! NEMO/NST 3.7 , NEMO Consortium (2015) 21 27 !! $Id$ 22 28 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 23 29 !!---------------------------------------------------------------------- 24 25 30 CONTAINS 26 31 … … 29 34 !! *** ROUTINE Agrif_Sponge_Tra *** 30 35 !!--------------------------------------------- 31 !!32 36 REAL(wp) :: timecoeff 33 37 !!--------------------------------------------- 38 ! 34 39 #if defined SPONGE 35 40 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() … … 44 49 Agrif_UseSpecialValue = .FALSE. 45 50 #endif 46 51 ! 47 52 END SUBROUTINE Agrif_Sponge_Tra 48 53 54 49 55 SUBROUTINE Agrif_Sponge_dyn 50 56 !!--------------------------------------------- 51 57 !! *** ROUTINE Agrif_Sponge_dyn *** 52 58 !!--------------------------------------------- 53 !!54 59 REAL(wp) :: timecoeff 60 !!--------------------------------------------- 55 61 56 62 #if defined SPONGE … … 70 76 Agrif_UseSpecialValue = .FALSE. 71 77 #endif 72 78 ! 73 79 END SUBROUTINE Agrif_Sponge_dyn 80 74 81 75 82 SUBROUTINE Agrif_Sponge … … 181 188 ! 182 189 #endif 183 190 ! 184 191 END SUBROUTINE Agrif_Sponge 192 185 193 186 194 SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) … … 191 199 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 192 200 LOGICAL, INTENT(in) :: before 193 194 201 ! 195 202 INTEGER :: ji, jj, jk, jn ! dummy loop indices 196 203 INTEGER :: iku, ikv … … 199 206 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 200 207 ! 201 IF (before) THEN208 IF( before ) THEN 202 209 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 203 210 ELSE 204 211 ! 205 212 tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 206 213 DO jn = 1, jpts … … 212 219 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 213 220 ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 214 END DO215 END DO216 221 END DO 222 END DO 223 ! 217 224 IF( ln_zps ) THEN ! set gradient at partial step level 218 225 DO jj = j1,j2-1 … … 221 228 iku = mbku(ji,jj) 222 229 ikv = mbkv(ji,jj) 223 IF( iku == jk ) THEN 224 ztu(ji,jj,jk) = 0._wp 225 ENDIF 226 IF( ikv == jk ) THEN 227 ztv(ji,jj,jk) = 0._wp 228 ENDIF 230 IF( iku == jk ) ztu(ji,jj,jk) = 0._wp 231 IF( ikv == jk ) ztv(ji,jj,jk) = 0._wp 229 232 END DO 230 233 END DO 231 234 ENDIF 232 END DO233 235 END DO 236 ! 234 237 DO jk = 1, jpkm1 235 238 DO jj = j1+1,j2-1 236 239 DO ji = i1+1,i2-1 237 238 240 IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 239 241 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) … … 243 245 tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 244 246 ENDIF 245 246 ENDDO 247 ENDDO 248 249 ENDDO 250 ENDDO 251 247 END DO 248 END DO 249 END DO 250 ! 251 END DO 252 ! 252 253 tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 253 254 ENDIF 255 254 ! 255 ENDIF 256 ! 256 257 END SUBROUTINE interptsn_sponge 258 257 259 258 260 SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) … … 271 273 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 272 274 INTEGER :: jmax 273 ! 274 275 276 IF (before) THEN 275 !!--------------------------------------------- 276 ! 277 IF( before ) THEN 277 278 tabres = un(i1:i2,j1:j2,:) 278 279 ELSE 279 280 280 ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:) 281 281 ! 282 282 DO jk = 1, jpkm1 ! Horizontal slab 283 283 ! ! =============== … … 302 302 END DO 303 303 END DO 304 ENDDO 305 306 ! 307 308 309 304 END DO 305 ! 310 306 DO jj = j1+1, j2-1 311 307 DO ji = i1+1, i2-1 ! vector opt. … … 349 345 END DO 350 346 ENDIF 351 352 END DO 353 END DO 354 355 347 ! 348 END DO 349 END DO 350 ! 356 351 tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE. 357 358 ENDIF 359 360 352 ! 353 ENDIF 354 ! 361 355 END SUBROUTINE interpun_sponge 362 356 … … 370 364 LOGICAL, INTENT(in) :: before 371 365 INTEGER, INTENT(in) :: nb , ndir 372 373 INTEGER :: ji,jj,jk 374 375 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 376 366 ! 367 INTEGER :: ji, jj, jk 368 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 377 369 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 378 370 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 379 371 INTEGER :: imax 380 ! 381 382 IF (before) THEN372 !!--------------------------------------------- 373 374 IF( before ) THEN 383 375 tabres = vn(i1:i2,j1:j2,:) 384 376 ELSE 385 377 ! 386 378 vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:) 387 379 ! 388 380 DO jk = 1, jpkm1 ! Horizontal slab 389 381 ! ! =============== … … 403 395 zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 404 396 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 405 & -e2v(ji ,jj) * vbdiff(ji ,jj,jk) & 406 & ) * fmask(ji,jj,jk) * zbtr 407 END DO 408 END DO 409 ENDDO 397 & -e2v(ji ,jj) * vbdiff(ji ,jj,jk) ) * fmask(ji,jj,jk) * zbtr 398 END DO 399 END DO 400 END DO 410 401 411 402 ! ! =============== … … 413 404 414 405 imax = i2-1 415 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3)406 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3) 416 407 417 408 DO jj = j1+1, j2 418 409 DO ji = i1+1, imax ! vector opt. 419 IF (.NOT. tabspongedone_u(ji,jj)) THEN 420 DO jk = 1, jpkm1 ! Horizontal slab 421 ze2u = rotdiff (ji,jj,jk) 422 ze1v = hdivdiff(ji,jj,jk) 423 ! horizontal diffusive trends 424 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 425 / e1u(ji,jj) 426 427 428 ! add it to the general momentum trends 429 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 430 END DO 431 432 ENDIF 433 END DO 434 END DO 435 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,jj-1,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 ! 436 420 tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE. 437 421 ! 438 422 DO jj = j1+1, j2-1 439 423 DO ji = i1+1, i2-1 ! vector opt. 440 IF (.NOT. tabspongedone_v(ji,jj)) THEN 441 DO jk = 1, jpkm1 ! Horizontal slab 442 ze2u = rotdiff (ji,jj,jk) 443 ze1v = hdivdiff(ji,jj,jk) 444 ! horizontal diffusive trends 445 446 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 447 / e2v(ji,jj) 448 449 ! add it to the general momentum trends 450 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 (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) & 428 & + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) * r1_e2v(ji,jj) 451 429 END DO 452 430 ENDIF … … 455 433 tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE. 456 434 ENDIF 457 435 ! 458 436 END SUBROUTINE interpvn_sponge 459 437 460 438 #else 461 439 CONTAINS 462 463 440 SUBROUTINE agrif_opa_sponge_empty 464 441 !!--------------------------------------------- … … 469 446 #endif 470 447 448 !!====================================================================== 471 449 END MODULE agrif_opa_sponge
Note: See TracChangeset
for help on using the changeset viewer.
