- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_oce_sponge.F90 (modified) (31 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/NST/agrif_oce_sponge.F90
r10425 r13463 22 22 USE agrif_oce 23 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 USE iom 25 USE vremap 24 26 25 27 IMPLICIT NONE … … 29 31 PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge 30 32 33 !! * Substitutions 34 # include "do_loop_substitute.h90" 31 35 !!---------------------------------------------------------------------- 32 36 !! NEMO/NST 4.0 , NEMO Consortium (2018) … … 58 62 #endif 59 63 ! 64 CALL iom_put( 'agrif_spu', fspu(:,:)) 65 CALL iom_put( 'agrif_spv', fspv(:,:)) 66 ! 60 67 END SUBROUTINE Agrif_Sponge_Tra 61 68 … … 71 78 zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 72 79 73 Agrif_SpecialValue =0.80 Agrif_SpecialValue = 0._wp 74 81 Agrif_UseSpecialValue = ln_spc_dyn 82 use_sign_north = .TRUE. 83 sign_north = -1._wp 75 84 ! 76 85 tabspongedone_u = .FALSE. … … 83 92 ! 84 93 Agrif_UseSpecialValue = .FALSE. 94 use_sign_north = .FALSE. 85 95 #endif 86 96 ! 97 CALL iom_put( 'agrif_spt', fspt(:,:)) 98 CALL iom_put( 'agrif_spf', fspf(:,:)) 99 ! 87 100 END SUBROUTINE Agrif_Sponge_dyn 88 101 … … 93 106 !!---------------------------------------------------------------------- 94 107 INTEGER :: ji, jj, ind1, ind2 95 INTEGER :: ispongearea 96 REAL(wp) :: z1_ spongearea108 INTEGER :: ispongearea, jspongearea 109 REAL(wp) :: z1_ispongearea, z1_jspongearea 97 110 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 98 !!---------------------------------------------------------------------- 99 ! 111 #if defined key_vertical 112 REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu 113 REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv 114 #endif 115 REAL(wp), DIMENSION(jpjmax) :: zmskwest, zmskeast 116 REAL(wp), DIMENSION(jpimax) :: zmsknorth, zmsksouth 117 !!---------------------------------------------------------------------- 118 ! 119 ! Sponge 1d example with: 120 ! iraf = 3 ; nbghost = 3 ; nn_sponge_len = 2 121 ! 122 !coarse : U T U T U T U 123 !| | | | | 124 !fine : t u t u t u t u t u t u t u t u t u t u t 125 !sponge val:0 0 0 1 5/6 4/6 3/6 2/6 1/6 0 0 126 ! | ghost | <-- sponge area -- > | 127 ! | points | | 128 ! |--> dynamical interface 129 100 130 #if defined SPONGE || defined SPONGE_TOP 101 131 IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 132 ! 133 ! Retrieve masks at open boundaries: 134 135 IF( lk_west ) THEN ! --- West --- ! 136 ztabramp(:,:) = 0._wp 137 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 138 DO ji = mi0(ind1), mi1(ind1) 139 ztabramp(ji,:) = ssumask(ji,:) 140 END DO 141 zmskwest( 1:jpj ) = MAXVAL(ztabramp(:,:), dim=1) 142 zmskwest(jpj+1:jpjmax) = 0._wp 143 ENDIF 144 IF( lk_east ) THEN ! --- East --- ! 145 ztabramp(:,:) = 0._wp 146 ind1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 147 DO ji = mi0(ind1), mi1(ind1) 148 ztabramp(ji,:) = ssumask(ji,:) 149 END DO 150 zmskeast( 1:jpj ) = MAXVAL(ztabramp(:,:), dim=1) 151 zmskeast(jpj+1:jpjmax) = 0._wp 152 ENDIF 153 IF( lk_south ) THEN ! --- South --- ! 154 ztabramp(:,:) = 0._wp 155 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 156 DO jj = mj0(ind1), mj1(ind1) 157 ztabramp(:,jj) = ssvmask(:,jj) 158 END DO 159 zmsksouth( 1:jpi ) = MAXVAL(ztabramp(:,:), dim=2) 160 zmsksouth(jpi+1:jpimax) = 0._wp 161 ENDIF 162 IF( lk_north ) THEN ! --- North --- ! 163 ztabramp(:,:) = 0._wp 164 ind1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 165 DO jj = mj0(ind1), mj1(ind1) 166 ztabramp(:,jj) = ssvmask(:,jj) 167 END DO 168 zmsknorth( 1:jpi ) = MAXVAL(ztabramp(:,:), dim=2) 169 zmsknorth(jpi+1:jpimax) = 0._wp 170 ENDIF 171 172 ! JC: SPONGE MASKING TO BE SORTED OUT: 173 zmskwest(:) = 1._wp 174 zmskeast(:) = 1._wp 175 zmsksouth(:) = 1._wp 176 zmsknorth(:) = 1._wp 177 #if defined key_mpp_mpi 178 ! CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax ) 179 ! CALL mpp_max( 'AGRIF_Sponge', zmskeast(:) , jpjmax ) 180 ! CALL mpp_max( 'AGRIF_Sponge', zmsksouth(:), jpimax ) 181 ! CALL mpp_max( 'AGRIF_Sponge', zmsknorth(:), jpimax ) 182 #endif 183 102 184 ! Define ramp from boundaries towards domain interior at T-points 103 185 ! Store it in ztabramp 104 186 105 ispongearea = 1 + nn_sponge_len * Agrif_irhox() 106 z1_spongearea = 1._wp / REAL( ispongearea ) 187 ispongearea = nn_sponge_len * Agrif_irhox() 188 z1_ispongearea = 1._wp / REAL( ispongearea, wp ) 189 jspongearea = nn_sponge_len * Agrif_irhoy() 190 z1_jspongearea = 1._wp / REAL( jspongearea, wp ) 107 191 108 192 ztabramp(:,:) = 0._wp 109 193 110 ! --- West --- ! 111 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 112 ind1 = 1+nbghostcells 113 ind2 = 1+nbghostcells + ispongearea 114 DO jj = 1, jpj 115 DO ji = ind1, ind2 116 ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 117 END DO 118 ENDDO 194 ! Trick to remove sponge in 2DV domains: 195 IF ( nbcellsx <= 3 ) ispongearea = -1 196 IF ( nbcellsy <= 3 ) jspongearea = -1 197 198 IF( lk_west ) THEN ! --- West --- ! 199 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 200 ind2 = nn_hls + 1 + nbghostcells + ispongearea 201 DO ji = mi0(ind1), mi1(ind2) 202 DO jj = 1, jpj 203 ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea * zmskwest(jj) 204 END DO 205 END DO 206 ! ghost cells: 207 ind1 = 1 208 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 209 DO ji = mi0(ind1), mi1(ind2) 210 DO jj = 1, jpj 211 ztabramp(ji,jj) = zmskwest(jj) 212 END DO 213 END DO 119 214 ENDIF 120 121 ! --- East --- ! 122 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 123 ind1 = nlci - nbghostcells - ispongearea 124 ind2 = nlci - nbghostcells 125 DO jj = 1, jpj 126 DO ji = ind1, ind2 127 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind1 ) * z1_spongearea * umask(ind2-1,jj,1) ) 128 ENDDO 129 ENDDO 215 IF( lk_east ) THEN ! --- East --- ! 216 ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 217 ind2 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 218 DO ji = mi0(ind1), mi1(ind2) 219 DO jj = 1, jpj 220 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj) 221 END DO 222 END DO 223 ! ghost cells: 224 ind1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 225 ind2 = jpiglo 226 DO ji = mi0(ind1), mi1(ind2) 227 DO jj = 1, jpj 228 ztabramp(ji,jj) = zmskeast(jj) 229 END DO 230 END DO 231 ENDIF 232 IF( lk_south ) THEN ! --- South --- ! 233 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 234 ind2 = nn_hls + 1 + nbghostcells + jspongearea 235 DO jj = mj0(ind1), mj1(ind2) 236 DO ji = 1, jpi 237 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji) 238 END DO 239 END DO 240 ! ghost cells: 241 ind1 = 1 242 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 243 DO jj = mj0(ind1), mj1(ind2) 244 DO ji = 1, jpi 245 ztabramp(ji,jj) = zmsksouth(ji) 246 END DO 247 END DO 130 248 ENDIF 131 132 ! --- South --- ! 133 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 134 ind1 = 1+nbghostcells 135 ind2 = 1+nbghostcells + ispongearea 136 DO jj = ind1, ind2 249 IF( lk_north ) THEN ! --- North --- ! 250 ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 251 ind2 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 252 DO jj = mj0(ind1), mj1(ind2) 137 253 DO ji = 1, jpi 138 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 139 END DO 140 ENDDO 254 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji) 255 END DO 256 END DO 257 ! ghost cells: 258 ind1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 259 ind2 = jpjglo 260 DO jj = mj0(ind1), mj1(ind2) 261 DO ji = 1, jpi 262 ztabramp(ji,jj) = zmsknorth(ji) 263 END DO 264 END DO 141 265 ENDIF 142 143 ! --- North --- ! 144 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 145 ind1 = nlcj - nbghostcells - ispongearea 146 ind2 = nlcj - nbghostcells 147 DO jj = ind1, ind2 148 DO ji = 1, jpi 149 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind1 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 150 END DO 151 ENDDO 152 ENDIF 153 266 ! 154 267 ENDIF 155 268 156 269 ! Tracers 157 270 IF( .NOT. spongedoneT ) THEN 158 fsaht_spu(:,:) = 0._wp 159 fsaht_spv(:,:) = 0._wp 160 DO jj = 2, jpjm1 161 DO ji = 2, jpim1 ! vector opt. 162 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 163 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) 164 END DO 165 END DO 166 CALL lbc_lnk( 'agrif_oce_sponge', fsaht_spu, 'U', 1. ) ! Lateral boundary conditions 167 CALL lbc_lnk( 'agrif_oce_sponge', fsaht_spv, 'V', 1. ) 168 271 fspu(:,:) = 0._wp 272 fspv(:,:) = 0._wp 273 DO_2D( 0, 0, 0, 0 ) 274 fspu(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) * ssumask(ji,jj) 275 fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) * ssvmask(ji,jj) 276 END_2D 277 ENDIF 278 279 ! Dynamics 280 IF( .NOT. spongedoneU ) THEN 281 fspt(:,:) = 0._wp 282 fspf(:,:) = 0._wp 283 DO_2D( 0, 0, 0, 0 ) 284 fspt(ji,jj) = ztabramp(ji,jj) * ssmask(ji,jj) 285 fspf(ji,jj) = 0.25_wp * ( ztabramp(ji ,jj ) + ztabramp(ji ,jj+1) & 286 & +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj ) ) & 287 & * ssvmask(ji,jj) * ssvmask(ji,jj+1) 288 END_2D 289 ENDIF 290 291 IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 292 CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 293 spongedoneT = .TRUE. 294 spongedoneU = .TRUE. 295 ENDIF 296 IF( .NOT. spongedoneT ) THEN 297 CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp ) 169 298 spongedoneT = .TRUE. 170 299 ENDIF 171 172 ! Dynamics 173 IF( .NOT. spongedoneU ) THEN 174 fsahm_spt(:,:) = 0._wp 175 fsahm_spf(:,:) = 0._wp 176 DO jj = 2, jpjm1 177 DO ji = 2, jpim1 ! vector opt. 178 fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj) 179 fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji ,jj ) + ztabramp(ji ,jj+1) & 180 & +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj ) ) 181 END DO 182 END DO 183 CALL lbc_lnk( 'agrif_oce_sponge', fsahm_spt, 'T', 1. ) ! Lateral boundary conditions 184 CALL lbc_lnk( 'agrif_oce_sponge', fsahm_spf, 'F', 1. ) 185 300 IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 301 CALL lbc_lnk_multi( 'agrif_Sponge', fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 186 302 spongedoneU = .TRUE. 187 303 ENDIF 188 ! 304 305 #if defined key_vertical 306 ! Remove vertical interpolation where not needed: 307 DO_2D( 0, 0, 0, 0 ) 308 IF ((fspu(ji-1,jj)==0._wp).AND.(fspu(ji,jj)==0._wp).AND. & 309 & (fspv(ji,jj-1)==0._wp).AND.(fspv(ji,jj)==0._wp)) mbkt_parent(ji,jj) = 0 310 ! 311 IF ((fspt(ji+1,jj)==0._wp).AND.(fspt(ji,jj)==0._wp).AND. & 312 & (fspf(ji,jj-1)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbku_parent(ji,jj) = 0 313 ! 314 IF ((fspt(ji,jj+1)==0._wp).AND.(fspt(ji,jj)==0._wp).AND. & 315 & (fspf(ji-1,jj)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbkv_parent(ji,jj) = 0 316 ! 317 IF ( ssmask(ji,jj) == 0._wp) mbkt_parent(ji,jj) = 0 318 IF (ssumask(ji,jj) == 0._wp) mbku_parent(ji,jj) = 0 319 IF (ssvmask(ji,jj) == 0._wp) mbkv_parent(ji,jj) = 0 320 END_2D 321 ! 322 ztabramp (:,:) = REAL( mbkt_parent(:,:), wp ) 323 ztabrampu(:,:) = REAL( mbku_parent(:,:), wp ) 324 ztabrampv(:,:) = REAL( mbkv_parent(:,:), wp ) 325 CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp ) 326 mbkt_parent(:,:) = NINT( ztabramp (:,:) ) 327 mbku_parent(:,:) = NINT( ztabrampu(:,:) ) 328 mbkv_parent(:,:) = NINT( ztabrampv(:,:) ) 189 329 #endif 190 330 ! 331 #endif 332 ! 191 333 END SUBROUTINE Agrif_Sponge 192 334 335 193 336 SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 194 337 !!---------------------------------------------------------------------- … … 201 344 INTEGER :: ji, jj, jk, jn ! dummy loop indices 202 345 INTEGER :: iku, ikv 203 REAL(wp) :: ztsa, zabe1, zabe2, zbtr 346 REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot 204 347 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk) :: ztu, ztv 205 348 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tsbdiff … … 210 353 REAL(wp), DIMENSION(1:jpk) :: h_out 211 354 INTEGER :: N_in, N_out 212 REAL(wp) :: h_diff213 355 !!---------------------------------------------------------------------- 214 356 ! … … 218 360 DO jj=j1,j2 219 361 DO ji=i1,i2 220 tabres(ji,jj,jk,jn) = ts b(ji,jj,jk,jn)362 tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kbb_a) 221 363 END DO 222 364 END DO … … 225 367 226 368 # if defined key_vertical 227 DO jk=k1,k2 228 DO jj=j1,j2 229 DO ji=i1,i2 230 tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 231 END DO 232 END DO 233 END DO 369 ! Interpolate thicknesses 370 ! Warning: these are masked, hence extrapolated prior interpolation. 371 DO jk=k1,k2 372 DO jj=j1,j2 373 DO ji=i1,i2 374 tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 375 END DO 376 END DO 377 END DO 378 379 ! Extrapolate thicknesses in partial bottom cells: 380 ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 381 IF (ln_zps) THEN 382 DO jj=j1,j2 383 DO ji=i1,i2 384 jk = mbkt(ji,jj) 385 tabres(ji,jj,jk,jpts+1) = 0._wp 386 END DO 387 END DO 388 END IF 389 390 ! Save ssh at last level: 391 IF (.NOT.ln_linssh) THEN 392 tabres(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kbb_a)*tmask(i1:i2,j1:j2,1) 393 ELSE 394 tabres(i1:i2,j1:j2,k2,jpts+1) = 0._wp 395 END IF 234 396 # endif 235 397 … … 237 399 ! 238 400 # if defined key_vertical 239 tabres_child(:,:,:,:) = 0. 401 402 IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp 403 240 404 DO jj=j1,j2 241 405 DO ji=i1,i2 242 N_in = 0 243 DO jk=k1,k2 !k2 = jpk of parent grid 244 IF (tabres(ji,jj,jk,n2) == 0) EXIT 245 N_in = N_in + 1 406 tabres_child(ji,jj,:,:) = 0._wp 407 N_in = mbkt_parent(ji,jj) 408 zhtot = 0._wp 409 DO jk=1,N_in !k2 = jpk of parent grid 410 IF (jk==N_in) THEN 411 h_in(jk) = ht0_parent(ji,jj) + tabres(ji,jj,k2,n2) - zhtot 412 ELSE 413 h_in(jk) = tabres(ji,jj,jk,n2) 414 ENDIF 415 zhtot = zhtot + h_in(jk) 246 416 tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1) 247 h_in(N_in) = tabres(ji,jj,jk,n2)248 417 END DO 249 418 N_out = 0 … … 251 420 IF (tmask(ji,jj,jk) == 0) EXIT 252 421 N_out = N_out + 1 253 h_out(jk) = e3t_n(ji,jj,jk) !Child grid scale factors. Could multiply by e1e2t here instead of division above 254 ENDDO 255 IF (N_in > 0) THEN 256 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 257 tabres(ji,jj,k2,:) = tabres(ji,jj,k2-1,:) !what is this line for????? 258 DO jn=1,jpts 259 call reconstructandremap(tabin(1:N_in,jn),h_in,tabres_child(ji,jj,1:N_out,jn),h_out,N_in,N_out) 260 ENDDO 261 ENDIF 262 ENDDO 263 ENDDO 422 h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above 423 END DO 424 425 ! Account for small differences in free-surface 426 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 427 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 428 ELSE 429 h_in(1) = h_in(1) - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 430 ENDIF 431 IF (N_in*N_out > 0) THEN 432 CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 433 ENDIF 434 END DO 435 END DO 264 436 # endif 265 437 … … 268 440 DO jk=1,jpkm1 269 441 # if defined key_vertical 270 tsbdiff(ji,jj,jk,1:jpts) = tsb(ji,jj,jk,1:jpts) - tabres_child(ji,jj,jk,1:jpts)442 tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres_child(ji,jj,jk,1:jpts)) * tmask(ji,jj,jk) 271 443 # else 272 tsbdiff(ji,jj,jk,1:jpts) = tsb(ji,jj,jk,1:jpts) - tabres(ji,jj,jk,1:jpts)444 tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk) 273 445 # endif 274 END DO275 END DO276 END DO446 END DO 447 END DO 448 END DO 277 449 278 450 DO jn = 1, jpts … … 281 453 DO jj = j1,j2 282 454 DO ji = i1,i2-1 283 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)455 zabe1 = rn_sponge_tra * r1_Dt * fspu(ji,jj) * umask(ji,jj,jk) * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 284 456 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 285 457 END DO … … 288 460 DO ji = i1,i2 289 461 DO jj = j1,j2-1 290 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)462 zabe2 = rn_sponge_tra * r1_Dt * fspv(ji,jj) * vmask(ji,jj,jk) * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 291 463 ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 292 464 END DO … … 310 482 DO ji = i1+1,i2-1 311 483 IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 312 zbtr = r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)484 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a) 313 485 ! horizontal diffusive trends 314 ztsa = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 486 ztsa = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 487 & - rn_trelax_tra * r1_Dt * fspt(ji,jj) * tsbdiff(ji,jj,jk,jn) 315 488 ! add it to the general tracer trends 316 ts a(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa489 ts(ji,jj,jk,jn,Krhs_a) = ts(ji,jj,jk,jn,Krhs_a) + ztsa 317 490 ENDIF 318 491 END DO … … 328 501 END SUBROUTINE interptsn_sponge 329 502 503 330 504 SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 331 505 !!--------------------------------------------- … … 336 510 LOGICAL, INTENT(in) :: before 337 511 338 INTEGER :: ji,jj,jk,jmax339 512 INTEGER :: ji,jj,jk,jmax 513 INTEGER :: ind1 340 514 ! sponge parameters 341 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, h_diff515 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot 342 516 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ubdiff 343 517 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff … … 346 520 REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 347 521 REAL(wp), DIMENSION(1:jpk) :: h_out 348 INTEGER ::N_in, N_out522 INTEGER ::N_in, N_out 349 523 !!--------------------------------------------- 350 524 ! 351 525 IF( before ) THEN 352 DO jk= 1,jpkm1526 DO jk=k1,k2 353 527 DO jj=j1,j2 354 528 DO ji=i1,i2 355 tabres(ji,jj,jk,m1) = u b(ji,jj,jk)529 tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb_a) 356 530 # if defined key_vertical 357 tabres(ji,jj,jk,m2) = e3u _n(ji,jj,jk)*umask(ji,jj,jk)531 tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kbb_a)*umask(ji,jj,jk) 358 532 # endif 359 533 END DO … … 361 535 END DO 362 536 537 # if defined key_vertical 538 ! Extrapolate thicknesses in partial bottom cells: 539 ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 540 IF (ln_zps) THEN 541 DO jj=j1,j2 542 DO ji=i1,i2 543 jk = mbku(ji,jj) 544 tabres(ji,jj,jk,m2) = 0._wp 545 END DO 546 END DO 547 END IF 548 ! Save ssh at last level: 549 tabres(i1:i2,j1:j2,k2,m2) = 0._wp 550 IF (.NOT.ln_linssh) THEN 551 ! This vertical sum below should be replaced by the sea-level at U-points (optimization): 552 DO jk=1,jpk 553 tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3u(i1:i2,j1:j2,jk,Kbb_a) * umask(i1:i2,j1:j2,jk) 554 END DO 555 tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hu_0(i1:i2,j1:j2) 556 END IF 557 # endif 558 363 559 ELSE 364 560 365 561 # if defined key_vertical 366 tabres_child(:,:,:) = 0._wp 562 IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp 563 367 564 DO jj=j1,j2 368 565 DO ji=i1,i2 369 N_in = 0 370 DO jk=k1,k2 371 IF (tabres(ji,jj,jk,m2) == 0) EXIT 372 N_in = N_in + 1 566 tabres_child(ji,jj,:) = 0._wp 567 N_in = mbku_parent(ji,jj) 568 zhtot = 0._wp 569 DO jk=1,N_in 570 IF (jk==N_in) THEN 571 h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 572 ELSE 573 h_in(jk) = tabres(ji,jj,jk,m2) 574 ENDIF 575 zhtot = zhtot + h_in(jk) 373 576 tabin(jk) = tabres(ji,jj,jk,m1) 374 h_in(N_in) = tabres(ji,jj,jk,m2) 375 ENDDO 376 ! 377 IF (N_in == 0) THEN 378 tabres_child(ji,jj,:) = 0. 379 CYCLE 380 ENDIF 381 382 N_out = 0 383 DO jk=1,jpk 384 if (umask(ji,jj,jk) == 0) EXIT 385 N_out = N_out + 1 386 h_out(N_out) = e3u_n(ji,jj,jk) 387 ENDDO 388 389 IF (N_out == 0) THEN 390 tabres_child(ji,jj,:) = 0. 391 CYCLE 392 ENDIF 393 394 IF (N_in * N_out > 0) THEN 395 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 396 if (h_diff < -1.e4) then 397 print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in)) 398 endif 399 ENDIF 400 call reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 401 402 ENDDO 403 ENDDO 404 405 ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 577 END DO 578 ! 579 N_out = 0 580 DO jk=1,jpk 581 IF (umask(ji,jj,jk) == 0) EXIT 582 N_out = N_out + 1 583 h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 584 END DO 585 586 ! Account for small differences in free-surface 587 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 588 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 589 ELSE 590 h_in(1) = h_in(1) - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 591 ENDIF 592 593 IF (N_in * N_out > 0) THEN 594 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 595 ENDIF 596 END DO 597 END DO 598 599 ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 406 600 #else 407 ubdiff(i1:i2,j1:j2,:) = (u b(i1:i2,j1:j2,:) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:)601 ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:) 408 602 #endif 409 603 ! … … 416 610 DO jj = j1,j2 417 611 DO ji = i1+1,i2 ! vector opt. 418 zbtr = r 1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj)419 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)*e3u _n(ji ,jj,jk) * ubdiff(ji ,jj,jk) &420 & -e2u(ji-1,jj)*e3u _n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr612 zbtr = rn_sponge_dyn * r1_Dt * fspt(ji,jj) / e3t(ji,jj,jk,Kbb_a) 613 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)*e3u(ji ,jj,jk,Kbb_a) * ubdiff(ji ,jj,jk) & 614 & -e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb_a) * ubdiff(ji-1,jj,jk) ) * zbtr 421 615 END DO 422 616 END DO … … 424 618 DO jj = j1,j2-1 425 619 DO ji = i1,i2 ! vector opt. 426 zbtr = r 1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj)620 zbtr = rn_sponge_dyn * r1_Dt * fspf(ji,jj) * e3f(ji,jj,jk) 427 621 rotdiff(ji,jj,jk) = ( -e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 428 622 & +e1u(ji,jj ) * ubdiff(ji,jj ,jk) ) * fmask(ji,jj,jk) * zbtr … … 439 633 ze1v = hdivdiff(ji,jj,jk) 440 634 ! horizontal diffusive trends 441 zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) & 442 + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) 635 zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) ) & 636 & + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) & 637 & - rn_trelax_dyn * r1_Dt * fspu(ji,jj) * ubdiff(ji,jj,jk) 443 638 444 639 ! add it to the general momentum trends 445 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 446 640 uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a) + zua 447 641 END DO 448 642 ENDIF … … 454 648 455 649 jmax = j2-1 456 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2) ! North 650 ind1 = jpjglo - ( nn_hls + nbghostcells + 2 ) ! North 651 DO jj = mj0(ind1), mj1(ind1) 652 jmax = MIN(jmax,jj) 653 END DO 457 654 458 655 DO jj = j1+1, jmax … … 465 662 466 663 ! horizontal diffusive trends 467 zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v _n(ji,jj,jk) ) &664 zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) ) & 468 665 + ( hdivdiff(ji,jj+1,jk) - ze1v ) * r1_e2v(ji,jj) 469 666 470 667 ! add it to the general momentum trends 471 v a(ji,jj,jk) = va(ji,jj,jk) + zva668 vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a) + zva 472 669 END DO 473 670 ENDIF … … 482 679 END SUBROUTINE interpun_sponge 483 680 484 SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before,nb,ndir) 681 682 SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 485 683 !!--------------------------------------------- 486 684 !! *** ROUTINE interpvn_sponge *** … … 489 687 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: tabres 490 688 LOGICAL, INTENT(in) :: before 491 INTEGER, INTENT(in) :: nb , ndir492 689 ! 493 690 INTEGER :: ji, jj, jk, imax 494 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, h_diff 691 INTEGER :: ind1 692 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot 495 693 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff 496 694 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff … … 503 701 504 702 IF( before ) THEN 505 DO jk= 1,jpkm1703 DO jk=k1,k2 506 704 DO jj=j1,j2 507 705 DO ji=i1,i2 508 tabres(ji,jj,jk,m1) = v b(ji,jj,jk)706 tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb_a) 509 707 # if defined key_vertical 510 tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v _n(ji,jj,jk)708 tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kbb_a) 511 709 # endif 512 710 END DO 513 711 END DO 514 712 END DO 713 714 # if defined key_vertical 715 ! Extrapolate thicknesses in partial bottom cells: 716 ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 717 IF (ln_zps) THEN 718 DO jj=j1,j2 719 DO ji=i1,i2 720 jk = mbkv(ji,jj) 721 tabres(ji,jj,jk,m2) = 0._wp 722 END DO 723 END DO 724 END IF 725 ! Save ssh at last level: 726 tabres(i1:i2,j1:j2,k2,m2) = 0._wp 727 IF (.NOT.ln_linssh) THEN 728 ! This vertical sum below should be replaced by the sea-level at V-points (optimization): 729 DO jk=1,jpk 730 tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3v(i1:i2,j1:j2,jk,Kbb_a) * vmask(i1:i2,j1:j2,jk) 731 END DO 732 tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hv_0(i1:i2,j1:j2) 733 END IF 734 # endif 735 515 736 ELSE 516 737 517 738 # if defined key_vertical 518 tabres_child(:,:,:) = 0._wp739 IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp 519 740 DO jj=j1,j2 520 741 DO ji=i1,i2 521 N_in = 0 522 DO jk=k1,k2 523 IF (tabres(ji,jj,jk,m2) == 0) EXIT 524 N_in = N_in + 1 742 tabres_child(ji,jj,:) = 0._wp 743 N_in = mbkv_parent(ji,jj) 744 zhtot = 0._wp 745 DO jk=1,N_in 746 IF (jk==N_in) THEN 747 h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 748 ELSE 749 h_in(jk) = tabres(ji,jj,jk,m2) 750 ENDIF 751 zhtot = zhtot + h_in(jk) 525 752 tabin(jk) = tabres(ji,jj,jk,m1) 526 h_in(N_in) = tabres(ji,jj,jk,m2) 527 ENDDO 753 END DO 754 ! 755 N_out = 0 756 DO jk=1,jpk 757 IF (vmask(ji,jj,jk) == 0) EXIT 758 N_out = N_out + 1 759 h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 760 END DO 761 762 ! Account for small differences in free-surface 763 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 764 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 765 ELSE 766 h_in(1) = h_in(1) - ( sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 767 ENDIF 528 768 529 IF (N_in == 0) THEN 530 tabres_child(ji,jj,:) = 0. 531 CYCLE 532 ENDIF 533 534 N_out = 0 535 DO jk=1,jpk 536 if (vmask(ji,jj,jk) == 0) EXIT 537 N_out = N_out + 1 538 h_out(N_out) = e3v_n(ji,jj,jk) 539 ENDDO 540 541 IF (N_in * N_out > 0) THEN 542 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 543 if (h_diff < -1.e4) then 544 print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in)) 545 endif 546 ENDIF 547 call reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 548 ENDDO 549 ENDDO 550 551 vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:) 769 IF (N_in * N_out > 0) THEN 770 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 771 ENDIF 772 END DO 773 END DO 774 775 vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:) 552 776 # else 553 vbdiff(i1:i2,j1:j2,:) = (v b(i1:i2,j1:j2,:) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:)777 vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:) 554 778 # endif 555 779 ! … … 562 786 DO jj = j1+1,j2 563 787 DO ji = i1,i2 ! vector opt. 564 zbtr = r 1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj)565 hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * e3v _n(ji,jj ,jk) * vbdiff(ji,jj ,jk) &566 & -e1v(ji,jj-1) * e3v _n(ji,jj-1,jk) * vbdiff(ji,jj-1,jk) ) * zbtr788 zbtr = rn_sponge_dyn * r1_Dt * fspt(ji,jj) / e3t(ji,jj,jk,Kbb_a) 789 hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * e3v(ji,jj ,jk,Kbb_a) * vbdiff(ji,jj ,jk) & 790 & -e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kbb_a) * vbdiff(ji,jj-1,jk) ) * zbtr 567 791 END DO 568 792 END DO 569 793 DO jj = j1,j2 570 794 DO ji = i1,i2-1 ! vector opt. 571 zbtr = r 1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj)795 zbtr = rn_sponge_dyn * r1_Dt * fspf(ji,jj) * e3f(ji,jj,jk) 572 796 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 573 797 & -e2v(ji ,jj) * vbdiff(ji ,jj,jk) ) * fmask(ji,jj,jk) * zbtr … … 580 804 581 805 imax = i2 - 1 582 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-nbghostcells-2) ! East 583 806 ind1 = jpiglo - ( nn_hls + nbghostcells + 2 ) ! East 807 DO ji = mi0(ind1), mi1(ind1) 808 imax = MIN(imax,ji) 809 END DO 810 584 811 DO jj = j1+1, j2 585 812 DO ji = i1+1, imax ! vector opt. 586 813 IF( .NOT. tabspongedone_u(ji,jj) ) THEN 587 814 DO jk = 1, jpkm1 588 u a(ji,jj,jk) = ua(ji,jj,jk)&589 & - ( rotdiff (ji ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u _n(ji,jj,jk) ) &815 uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a) & 816 & - ( rotdiff (ji ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) ) & 590 817 & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj ,jk)) * r1_e1u(ji,jj) 591 818 END DO … … 600 827 IF( .NOT. tabspongedone_v(ji,jj) ) THEN 601 828 DO jk = 1, jpkm1 602 va(ji,jj,jk) = va(ji,jj,jk) & 603 & + ( rotdiff (ji,jj ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) & 604 & + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) * r1_e2v(ji,jj) 829 vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a) & 830 & + ( rotdiff (ji,jj ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) ) & 831 & + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) * r1_e2v(ji,jj) & 832 & - rn_trelax_dyn * r1_Dt * fspv(ji,jj) * vbdiff(ji,jj,jk) 605 833 END DO 606 834 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
