- Timestamp:
- 2015-12-16T10:25:22+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_merge_2015/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r5930 r6060 25 25 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 26 26 !!---------------------------------------------------------------------- 27 28 27 CONTAINS 29 28 … … 66 65 ! 67 66 END SUBROUTINE Agrif_Update_Tra 67 68 68 69 69 RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) … … 150 150 151 151 # if defined key_zdftke 152 152 153 SUBROUTINE Agrif_Update_Tke( kt ) 153 154 !!--------------------------------------------- … … 172 173 173 174 END SUBROUTINE Agrif_Update_Tke 175 174 176 # endif /* key_zdftke */ 175 177 … … 178 180 !! *** ROUTINE updateT *** 179 181 !!--------------------------------------------- 180 # include "domzgr_substitute.h90"181 182 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 182 183 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 228 229 END SUBROUTINE updateTS 229 230 231 230 232 SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before ) 231 233 !!--------------------------------------------- 232 234 !! *** ROUTINE updateu *** 233 235 !!--------------------------------------------- 234 # include "domzgr_substitute.h90" 235 !! 236 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 236 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 237 237 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 238 LOGICAL , INTENT(in) :: before239 ! !240 INTEGER ::ji, jj, jk241 REAL(wp) :: zrhoy242 !!--------------------------------------------- 243 ! 244 IF (before) THEN238 LOGICAL , INTENT(in ) :: before 239 ! 240 INTEGER :: ji, jj, jk 241 REAL(wp) :: zrhoy 242 !!--------------------------------------------- 243 ! 244 IF( before ) THEN 245 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 246 250 DO jk=k1,k2 247 251 DO jj=j1,j2 248 252 DO ji=i1,i2 249 tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 250 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 251 END DO 252 END DO 253 END DO 254 tabres = zrhoy * tabres 255 ELSE 256 DO jk=k1,k2 257 DO jj=j1,j2 258 DO ji=i1,i2 259 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk) 253 tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk) 260 254 ! 261 255 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part … … 272 266 END SUBROUTINE updateu 273 267 268 274 269 SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before ) 275 270 !!--------------------------------------------- 276 271 !! *** ROUTINE updatev *** 277 272 !!--------------------------------------------- 278 # include "domzgr_substitute.h90"279 !!280 273 INTEGER :: i1,i2,j1,j2,k1,k2 281 274 INTEGER :: ji,jj,jk … … 291 284 DO jj=j1,j2 292 285 DO ji=i1,i2 293 tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 294 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(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) / fse3v_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 … … 316 307 END SUBROUTINE updatev 317 308 309 318 310 SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before ) 319 311 !!--------------------------------------------- 320 312 !! *** ROUTINE updateu2d *** 321 313 !!--------------------------------------------- 322 # include "domzgr_substitute.h90"323 !!324 314 INTEGER, INTENT(in) :: i1, i2, j1, j2 325 315 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres … … 335 325 DO jj=j1,j2 336 326 DO ji=i1,i2 337 tabres(ji,jj) = un_b(ji,jj) * hu(ji,jj) * e2u(ji,jj) 338 END DO 339 END DO 340 tabres = zrhoy * tabres 341 ELSE 342 DO jj=j1,j2 343 DO ji=i1,i2 344 tabres(ji,jj) = tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj) 327 tabres(ji,jj) = zrhoy * un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 328 END DO 329 END DO 330 ELSE 331 DO jj=j1,j2 332 DO ji=i1,i2 333 tabres(ji,jj) = tabres(ji,jj) * r1_hu_n(ji,jj) * r1_e2u(ji,jj) 345 334 ! 346 335 ! Update "now" 3d velocities: 347 spgu(ji,jj) = 0. e0336 spgu(ji,jj) = 0._wp 348 337 DO jk=1,jpkm1 349 spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk)350 END DO 351 spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj)338 spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) 339 END DO 340 spgu(ji,jj) = spgu(ji,jj) * r1_hu_n(ji,jj) 352 341 ! 353 342 zcorr = tabres(ji,jj) - spgu(ji,jj) … … 368 357 spgu(ji,jj) = 0.e0 369 358 DO jk=1,jpkm1 370 spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)371 END DO 372 spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj)359 spgu(ji,jj) = spgu(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) 360 END DO 361 spgu(ji,jj) = spgu(ji,jj) * r1_hu_b(ji,jj) 373 362 ! 374 363 zcorr = ub_b(ji,jj) - spgu(ji,jj) … … 382 371 ! 383 372 END SUBROUTINE updateu2d 373 384 374 385 375 SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before ) … … 400 390 DO jj=j1,j2 401 391 DO ji=i1,i2 402 tabres(ji,jj) = vn_b(ji,jj) * hv(ji,jj) * e1v(ji,jj) 403 END DO 404 END DO 405 tabres = zrhox * tabres 406 ELSE 407 DO jj=j1,j2 408 DO ji=i1,i2 409 tabres(ji,jj) = tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj) 392 tabres(ji,jj) = zrhox * vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 393 END DO 394 END DO 395 ELSE 396 DO jj=j1,j2 397 DO ji=i1,i2 398 tabres(ji,jj) = tabres(ji,jj) * r1_hv_n(ji,jj) * r1_e1v(ji,jj) 410 399 ! 411 400 ! Update "now" 3d velocities: 412 401 spgv(ji,jj) = 0.e0 413 402 DO jk=1,jpkm1 414 spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk)415 END DO 416 spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj)403 spgv(ji,jj) = spgv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) 404 END DO 405 spgv(ji,jj) = spgv(ji,jj) * r1_hv_n(ji,jj) 417 406 ! 418 407 zcorr = tabres(ji,jj) - spgv(ji,jj) … … 433 422 spgv(ji,jj) = 0.e0 434 423 DO jk=1,jpkm1 435 spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)436 END DO 437 spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj)424 spgv(ji,jj) = spgv(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) 425 END DO 426 spgv(ji,jj) = spgv(ji,jj) * r1_hv_b(ji,jj) 438 427 ! 439 428 zcorr = vb_b(ji,jj) - spgv(ji,jj) … … 467 456 END DO 468 457 ELSE 469 IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN458 IF( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. .NOT.ln_bt_fw ) ) THEN 470 459 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 471 460 DO jj=j1,j2 … … 477 466 ENDIF 478 467 ENDIF 479 468 ! 480 469 DO jj=j1,j2 481 470 DO ji=i1,i2 … … 486 475 ! 487 476 END SUBROUTINE updateSSH 477 488 478 489 479 SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before ) … … 517 507 END SUBROUTINE updateub2b 518 508 509 519 510 SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 520 511 !!--------------------------------------------- … … 553 544 !! *** ROUTINE updateT *** 554 545 !!--------------------------------------------- 555 # include "domzgr_substitute.h90"556 557 546 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 558 547 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 559 548 LOGICAL, iNTENT(in) :: before 560 549 ! 561 550 INTEGER :: ji,jj,jk 562 551 REAL(wp) :: ztemp 552 !!--------------------------------------------- 563 553 564 554 IF (before) THEN … … 598 588 599 589 # if defined key_zdftke 590 600 591 SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 601 592 !!---------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
