Changeset 6004 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.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_update.F90
r5845 r6004 11 11 USE lib_mpp 12 12 USE wrk_nemo 13 USE dynspg_oce14 13 USE zdf_oce ! vertical physics: ocean variables 15 14 … … 107 106 # endif 108 107 109 # if defined key_dynspg_ts 110 IF (ln_bt_fw) THEN 108 IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 111 109 ! Update time integrated transports 112 110 IF (mod(nbcline,nbclineupdate) == 0) THEN … … 128 126 ENDIF 129 127 END IF 130 # endif131 128 ! 132 129 nbcline = nbcline + 1 … … 237 234 !! *** ROUTINE updateu *** 238 235 !!--------------------------------------------- 239 INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2236 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 240 237 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 241 LOGICAL , INTENT(in) :: before242 ! !243 INTEGER ::ji, jj, jk244 REAL(wp) :: zrhoy245 !!--------------------------------------------- 246 ! 247 IF (before) THEN238 LOGICAL , INTENT(in ) :: before 239 ! 240 INTEGER :: ji, jj, jk 241 REAL(wp) :: zrhoy 242 !!--------------------------------------------- 243 ! 244 IF( before ) THEN 248 245 zrhoy = Agrif_Rhoy() 246 DO jk = k1, k2 247 tabres(i1:i2,j1:j2,jk) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 248 END DO 249 ELSE 249 250 DO jk=k1,k2 250 251 DO jj=j1,j2 251 252 DO ji=i1,i2 252 tabres(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 253 END DO 254 END DO 255 END DO 256 tabres = zrhoy * tabres 257 ELSE 258 DO jk=k1,k2 259 DO jj=j1,j2 260 DO ji=i1,i2 261 tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 253 tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk) 262 254 ! 263 255 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part … … 292 284 DO jj=j1,j2 293 285 DO ji=i1,i2 294 tabres(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 295 END DO 296 END DO 297 END DO 298 tabres = zrhox * tabres 286 tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 287 END DO 288 END DO 289 END DO 299 290 ELSE 300 291 DO jk=k1,k2 301 292 DO jj=j1,j2 302 293 DO ji=i1,i2 303 tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e1v(ji,jj) * e3v_n(ji,jj,jk))294 tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk) 304 295 ! 305 296 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part … … 334 325 DO jj=j1,j2 335 326 DO ji=i1,i2 336 tabres(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 337 END DO 338 END DO 339 tabres = zrhoy * tabres 327 tabres(ji,jj) = zrhoy * un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 328 END DO 329 END DO 340 330 ELSE 341 331 DO jj=j1,j2 … … 344 334 ! 345 335 ! Update "now" 3d velocities: 346 spgu(ji,jj) = 0. e0336 spgu(ji,jj) = 0._wp 347 337 DO jk=1,jpkm1 348 338 spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) … … 356 346 ! 357 347 ! Update barotropic velocities: 358 #if defined key_dynspg_ts 359 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part360 zcorr = tabres(ji,jj) - un_b(ji,jj)361 ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1)362 END IF363 #endif348 IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 349 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 350 zcorr = tabres(ji,jj) - un_b(ji,jj) 351 ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 352 END IF 353 ENDIF 364 354 un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1) 365 355 ! … … 400 390 DO jj=j1,j2 401 391 DO ji=i1,i2 402 tabres(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 403 END DO 404 END DO 405 tabres = zrhox * tabres 392 tabres(ji,jj) = zrhox * vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 393 END DO 394 END DO 406 395 ELSE 407 396 DO jj=j1,j2 … … 422 411 ! 423 412 ! Update barotropic velocities: 424 #if defined key_dynspg_ts 425 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part426 zcorr = tabres(ji,jj) - vn_b(ji,jj)427 vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1)428 END IF429 #endif413 IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 414 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 415 zcorr = tabres(ji,jj) - vn_b(ji,jj) 416 vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 417 END IF 418 ENDIF 430 419 vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1) 431 420 ! … … 467 456 END DO 468 457 ELSE 469 #if ! defined key_dynspg_ts 470 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 471 DO jj=j1,j2 472 DO ji=i1,i2 473 sshb(ji,jj) = sshb(ji,jj) & 474 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 475 END DO 476 END DO 458 IF( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. .NOT.ln_bt_fw ) ) THEN 459 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 460 DO jj=j1,j2 461 DO ji=i1,i2 462 sshb(ji,jj) = sshb(ji,jj) & 463 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 464 END DO 465 END DO 466 ENDIF 477 467 ENDIF 478 #endif 468 ! 479 469 DO jj=j1,j2 480 470 DO ji=i1,i2
Note: See TracChangeset
for help on using the changeset viewer.