- Timestamp:
- 2017-04-23T09:30:41+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r7646 r7953 3 3 MODULE agrif_opa_sponge 4 4 !!====================================================================== 5 !! *** MODULE agrif_opa_update***6 !! AGRIF :5 !! *** MODULE agrif_opa_interp *** 6 !! AGRIF: interpolation package 7 7 !!====================================================================== 8 !! History : 8 !! History : 2.0 ! 2002-06 (XXX) Original cade 9 !! - ! 2005-11 (XXX) 10 !! 3.2 ! 2009-04 (R. Benshila) 11 !! 3.6 ! 2014-09 (R. Benshila) 9 12 !!---------------------------------------------------------------------- 10 13 #if defined key_agrif 14 !!---------------------------------------------------------------------- 15 !! 'key_agrif' AGRIF zoom 16 !!---------------------------------------------------------------------- 11 17 USE par_oce 12 18 USE oce 13 19 USE dom_oce 20 ! 14 21 USE in_out_manager 15 22 USE agrif_oce … … 24 31 25 32 !!---------------------------------------------------------------------- 26 !! NEMO/NST 3.7 , NEMO Consortium (2015)33 !! NEMO/NST 4.0 , NEMO Consortium (2017) 27 34 !! $Id$ 28 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 31 38 32 39 SUBROUTINE Agrif_Sponge_Tra 33 !!--------------------------------------------- 34 !! *** ROUTINE Agrif_Sponge_Tra ***35 !!--------------------------------------------- 36 REAL(wp) :: timecoeff37 !!--------------------------------------------- 40 !!---------------------------------------------------------------------- 41 !! *** ROUTINE Agrif_Sponge_Tra *** 42 !!---------------------------------------------------------------------- 43 REAL(wp) :: timecoeff ! local scalar 44 !!---------------------------------------------------------------------- 38 45 ! 39 46 #if defined SPONGE 40 47 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 41 48 ! 42 49 CALL Agrif_Sponge 43 Agrif_SpecialValue =0.50 Agrif_SpecialValue = 0._wp 44 51 Agrif_UseSpecialValue = .TRUE. 45 tabspongedone_tsn = .FALSE.46 52 tabspongedone_tsn = .FALSE. 53 ! 47 54 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge) 48 55 ! 49 56 Agrif_UseSpecialValue = .FALSE. 50 57 #endif … … 54 61 55 62 SUBROUTINE Agrif_Sponge_dyn 56 !!--------------------------------------------- 57 !! *** ROUTINE Agrif_Sponge_dyn ***58 !!--------------------------------------------- 59 REAL(wp) :: timecoeff60 !!--------------------------------------------- 61 63 !!---------------------------------------------------------------------- 64 !! *** ROUTINE Agrif_Sponge_dyn *** 65 !!---------------------------------------------------------------------- 66 REAL(wp) :: timecoeff ! local scalar 67 !!---------------------------------------------------------------------- 68 ! 62 69 #if defined SPONGE 63 70 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 64 65 Agrif_SpecialValue =0.71 ! 72 Agrif_SpecialValue = 0._wp 66 73 Agrif_UseSpecialValue = ln_spc_dyn 67 74 ! 68 75 tabspongedone_u = .FALSE. 69 76 tabspongedone_v = .FALSE. 70 77 CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge) 71 78 ! 72 79 tabspongedone_u = .FALSE. 73 80 tabspongedone_v = .FALSE. 74 81 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge) 75 82 ! 76 83 Agrif_UseSpecialValue = .FALSE. 77 84 #endif … … 81 88 82 89 SUBROUTINE Agrif_Sponge 83 !!--------------------------------------------- 84 !! *** ROUTINE Agrif_Sponge ***85 !!--------------------------------------------- 90 !!---------------------------------------------------------------------- 91 !! *** ROUTINE Agrif_Sponge *** 92 !!---------------------------------------------------------------------- 86 93 INTEGER :: ji,jj,jk 87 94 INTEGER :: ispongearea, ilci, ilcj … … 89 96 REAL(wp) :: z1spongearea, zramp 90 97 REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 91 98 !!---------------------------------------------------------------------- 99 ! 92 100 #if defined SPONGE || defined SPONGE_TOP 93 101 ll_spdone=.TRUE. … … 176 184 fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj) 177 185 fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) & 178 &+ztabramp(ji,jj) + ztabramp(ji+1,jj ) )179 END DO 180 END DO 181 186 & +ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 187 END DO 188 END DO 189 ! 182 190 CALL lbc_lnk( fsahm_spt, 'T', 1. ) ! Lateral boundary conditions 183 191 CALL lbc_lnk( fsahm_spf, 'F', 1. ) … … 192 200 193 201 194 SUBROUTINE interptsn_sponge( tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)195 !!--------------------------------------------- 196 !! *** ROUTINE interptsn_sponge ***197 !!--------------------------------------------- 198 INTEGER , INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2199 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres200 LOGICAL , INTENT(in) ::before202 SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 203 !!---------------------------------------------------------------------- 204 !! *** ROUTINE interptsn_sponge *** 205 !!---------------------------------------------------------------------- 206 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 207 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 208 LOGICAL , INTENT(in ) :: before 201 209 ! 202 210 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 205 213 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 206 214 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 215 !!---------------------------------------------------------------------- 207 216 ! 208 217 IF( before ) THEN … … 258 267 259 268 260 SUBROUTINE interpun_sponge( tabres,i1,i2,j1,j2,k1,k2, before)261 !!--------------------------------------------- 262 !! *** ROUTINE interpun_sponge ***263 !!--------------------------------------------- 264 INTEGER , INTENT(in) :: i1,i2,j1,j2,k1,k2265 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres266 LOGICAL , INTENT(in) ::before267 269 SUBROUTINE interpun_sponge( tabres, i1, i2, j1, j2, k1, k2, before ) 270 !!---------------------------------------------------------------------- 271 !! *** ROUTINE interpun_sponge *** 272 !!---------------------------------------------------------------------- 273 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 274 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 275 LOGICAL , INTENT(in ) :: before 276 !! 268 277 INTEGER :: ji,jj,jk 269 270 ! sponge parameters 278 INTEGER :: jmax 271 279 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 272 280 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff 273 281 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 274 INTEGER :: jmax 275 !!--------------------------------------------- 282 !!---------------------------------------------------------------------- 276 283 ! 277 284 IF( before ) THEN … … 356 363 357 364 358 SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir) 359 !!--------------------------------------------- 360 !! *** ROUTINE interpvn_sponge *** 361 !!--------------------------------------------- 362 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 363 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 364 LOGICAL, INTENT(in) :: before 365 INTEGER, INTENT(in) :: nb , ndir 366 ! 367 INTEGER :: ji, jj, jk 368 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 369 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 370 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 371 INTEGER :: imax 372 !!--------------------------------------------- 365 SUBROUTINE interpvn_sponge( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 366 !!---------------------------------------------------------------------- 367 !! *** ROUTINE interpvn_sponge *** 368 !!---------------------------------------------------------------------- 369 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 370 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 371 LOGICAL , INTENT(in ) :: before 372 INTEGER , INTENT(in ) :: nb , ndir 373 ! 374 INTEGER :: ji, jj, jk 375 INTEGER :: imax 376 REAL(wp):: ze2u, ze1v, zua, zva, zbtr 377 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff, rotdiff, hdivdiff 378 !!---------------------------------------------------------------------- 373 379 374 380 IF( before ) THEN … … 403 409 ! 404 410 405 imax = i2 -1411 imax = i2 - 1 406 412 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3) 407 413 … … 437 443 438 444 #else 445 !!---------------------------------------------------------------------- 446 !! Empty module no AGRIF zoom 447 !!---------------------------------------------------------------------- 439 448 CONTAINS 440 449 SUBROUTINE agrif_opa_sponge_empty 441 !!--------------------------------------------- 442 !! *** ROUTINE agrif_OPA_sponge_empty ***443 !!--------------------------------------------- 450 !!---------------------------------------------------------------------- 451 !! *** ROUTINE agrif_OPA_sponge_empty *** 452 !!---------------------------------------------------------------------- 444 453 WRITE(*,*) 'agrif_opa_sponge : You should not have seen this print! error?' 445 454 END SUBROUTINE agrif_opa_sponge_empty
Note: See TracChangeset
for help on using the changeset viewer.
