Changeset 6929 for branches/2015
- Timestamp:
- 2016-09-13T11:58:01+02:00 (8 years ago)
- Location:
- branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC
- Files:
-
- 2 edited
-
agrif_opa_update.F90 (modified) (18 diffs)
-
agrif_user.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r6777 r6929 1 # defineTWO_WAY /* TWO WAY NESTING */1 #undef TWO_WAY /* TWO WAY NESTING */ 2 2 #undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 3 3 … … 121 121 ! 122 122 IF (MOD(nbcline,nbclineupdate) == 0) THEN 123 WRITE(numout,*) 'TG print 1' 124 CALL FLUSH(numout) 123 125 # if ! defined DECAL_FEEDBACK 124 126 CALL Agrif_Update_Variable(tsn_id, procname=updateTS) … … 126 128 CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS) 127 129 # endif 128 ELSE 130 WRITE(numout,*) 'TG print 2' 131 CALL FLUSH(numout) 132 ELSE 133 WRITE(numout,*) 'TG print 3' 134 CALL FLUSH(numout) 129 135 # if ! defined DECAL_FEEDBACK 130 136 CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS) … … 132 138 CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS) 133 139 # endif 140 WRITE(numout,*) 'TG print 4' 141 CALL FLUSH(numout) 134 142 ENDIF 135 143 ! … … 300 308 ! VERTICAL REFINEMENT BEGIN 301 309 ptab_child(:,:,:,:) = 0. 302 310 303 311 DO jj=j1,j2 304 312 DO ji=i1,i2 … … 314 322 IF (tmask(ji,jj,jk) == 0) EXIT ! TODO: Will not work with ISF 315 323 N_out = N_out + 1 316 h_out(N_out) = e3t_n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above324 h_out(N_out) = e3t_n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above 317 325 ENDDO 318 326 IF (N_in > 0) THEN 319 327 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 320 328 ! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 321 IF abs(h_diff > 1.e-8) THEN329 ! IF abs(h_diff > 1.e-8) THEN 322 330 ! N_in = N_in + 1 323 331 ! h_in(N_in) = h_diff 324 332 ! tabin(N_in,:) = tabin(N_in-1,:) 325 ELSEIF (h_diff < 0) THEN333 IF (h_diff < 0) THEN 326 334 print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out)) 327 335 print *,'Nval = ',N_out,mbathy(ji,jj) … … 372 380 ENDIF 373 381 ! 382 WRITE(numout,*) 'I got to end of updateTS before=',before 383 CALL FLUSH(numout) 374 384 END SUBROUTINE updateTS 375 385 376 SUBROUTINE updateu( ptab, i1, i2, j1, j2, k1, k2, before )386 SUBROUTINE updateu( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 377 387 !!--------------------------------------------- 378 388 !! *** ROUTINE updateu *** 379 389 !!--------------------------------------------- 380 390 !! 381 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 382 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2 ), INTENT(inout) :: ptab391 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2, n1, n2 392 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,2), INTENT(inout) :: ptab 383 393 LOGICAL , INTENT(in ) :: before 384 394 ! … … 386 396 REAL(wp) :: zrhoy 387 397 ! VERTICAL REFINEMENT BEGIN 388 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk ) :: ptab_child398 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,2) :: ptab_child 389 399 REAL(wp) :: h_in(k1:k2) 390 400 REAL(wp) :: h_out(1:jpk) … … 395 405 !!--------------------------------------------- 396 406 ! 407 WRITE(numout,*) 'TG print 5: Start of updateu before = ',before 408 CALL FLUSH(numout) 397 409 IF( before ) THEN 398 410 zrhoy = Agrif_Rhoy() … … 400 412 DO jj=j1,j2 401 413 DO ji=i1,i2 402 ptab(ji,jj,jk ) =e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)403 END DO404 END DO405 END DO406 ptab = zrhoy * ptab414 ptab(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 415 ptab(ji,jj,jk,2) = umask(ji,jj,jk) * zrhoy * e2u(ji,jj) * e3u_n(ji,jj,jk) 416 END DO 417 END DO 418 END DO 407 419 ELSE 408 420 ! VERTICAL REFINEMENT BEGIN 409 ptab_child(:,:,: ) = 0.421 ptab_child(:,:,:,:) = 0. 410 422 411 423 DO jj=j1,j2 412 424 DO ji=i1,i2 413 425 N_in = 0 414 DO jk=k1,k2 415 IF ( update_scales_u(ji,jj,jk) == 0) EXIT426 DO jk=k1,k2 !k2=jpk of child grid 427 IF (ptab(ji,jj,jk,2) == 0) EXIT 416 428 N_in = N_in + 1 417 tabin(jk) = ptab(ji,jj,jk)/ update_scales_u(ji,jj,jk)418 h_in(N_in) = update_scales_u(ji,jj,jk)429 tabin(jk) = ptab(ji,jj,jk)/ptab(ji,jj,jk,2) 430 h_in(N_in) = ptab(ji,jj,jk,2)/e2u(ji,jj) 419 431 ENDDO 420 432 N_out = 0 … … 426 438 IF (N_in * N_out > 0) THEN 427 439 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 440 ! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 428 441 if (h_diff < 0.) then 429 442 print *,'CHECK YOUR BATHY ...' 430 443 stop 431 else ! Extends with 0432 N_in = N_in + 1433 tabin(N_in) = 0.434 h_in(N_in) = h_diff444 ! else ! Extends with 0 445 ! N_in = N_in + 1 446 ! tabin(N_in) = 0. 447 ! h_in(N_in) = h_diff 435 448 endif 436 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out ),h_out(1:N_out),N_in,N_out)449 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out,1),h_out(1:N_out),N_in,N_out) 437 450 ENDIF 438 451 ENDDO … … 448 461 DO jj=j1,j2 449 462 DO ji=i1,i2 450 ptab_child(ji,jj,jk) = ptab_child(ji,jj,jk) / e2u(ji,jj) 463 !Following line now replaced by division higher up I think 464 ! ptab_child(ji,jj,jk) = ptab_child(ji,jj,jk) / e2u(ji,jj) 451 465 ! 452 466 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 453 467 ub(ji,jj,jk) = ub(ji,jj,jk) & 454 & + atfp * ( ptab_child(ji,jj,jk ) - un(ji,jj,jk) ) * umask(ji,jj,jk)468 & + atfp * ( ptab_child(ji,jj,jk,1) - un(ji,jj,jk) ) * umask(ji,jj,jk) 455 469 ENDIF 456 470 ! 457 un(ji,jj,jk) = ptab_child(ji,jj,jk ) * umask(ji,jj,jk)471 un(ji,jj,jk) = ptab_child(ji,jj,jk,1) * umask(ji,jj,jk) 458 472 END DO 459 473 END DO … … 461 475 ENDIF 462 476 ! 477 WRITE(numout,*) 'TG print 6: End of updateu before = ',before 478 CALL FLUSH(numout) 463 479 END SUBROUTINE updateu 464 480 465 SUBROUTINE updatev( ptab, i1, i2, j1, j2, k1, k2, before )481 SUBROUTINE updatev( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 466 482 !!--------------------------------------------- 467 483 !! *** ROUTINE updatev *** 468 484 !!--------------------------------------------- 469 485 !! 470 INTEGER :: i1,i2,j1,j2,k1,k2 486 INTEGER :: i1,i2,j1,j2,k1,k2,n1,n2 471 487 INTEGER :: ji,jj,jk 472 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2 ) :: ptab488 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,2) :: ptab 473 489 LOGICAL :: before 474 490 !! 475 491 REAL(wp) :: zrhox 476 492 ! VERTICAL REFINEMENT BEGIN 477 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk ) :: ptab_child493 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,2) :: ptab_child 478 494 REAL(wp) :: h_in(k1:k2) 479 495 REAL(wp) :: h_out(1:jpk) … … 484 500 !!--------------------------------------------- 485 501 ! 502 WRITE(numout,*) 'TG print 7: Start of updatev before = ',before 503 CALL FLUSH(numout) 486 504 IF (before) THEN 487 505 zrhox = Agrif_Rhox() … … 489 507 DO jj=j1,j2 490 508 DO ji=i1,i2 491 ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 492 ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3v_n(ji,jj,jk) 493 END DO 494 END DO 495 END DO 496 ptab = zrhox * ptab 509 ptab(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 510 ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) 511 END DO 512 END DO 513 END DO 497 514 ELSE 498 515 ! VERTICAL REFINEMENT BEGIN … … 505 522 IF (update_scales_v(ji,jj,jk) == 0) EXIT 506 523 N_in = N_in + 1 507 tabin(jk) = ptab(ji,jj, jk)/update_scales_v(ji,jj,jk)508 h_in(N_in) = update_scales_v(ji,jj,jk)524 tabin(jk) = ptab(ji,jj,1)/ptab(ji,jj,jk,2) 525 h_in(N_in) = ptab(ji,jj,jk,2)/e1v(ji,jj) 509 526 ENDDO 510 527 N_out = 0 … … 516 533 IF (N_in * N_out > 0) THEN 517 534 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 535 ! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 518 536 if (h_diff < 0.) then 519 537 print *,'CHECK YOUR BATHY ...' 520 538 stop 521 else ! Extends with 0522 N_in = N_in + 1523 tabin(N_in) = 0.524 h_in(N_in) = h_diff539 ! else ! Extends with 0 540 ! N_in = N_in + 1 541 ! tabin(N_in) = 0. 542 ! h_in(N_in) = h_diff 525 543 endif 526 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out ),h_out(1:N_out),N_in,N_out)544 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out,1),h_out(1:N_out),N_in,N_out) 527 545 ENDIF 528 546 ENDDO … … 538 556 DO jj=j1,j2 539 557 DO ji=i1,i2 540 ptab_child(ji,jj,jk) = ptab_child(ji,jj,jk) / e1v(ji,jj) 558 !Following line now replaced by division higher up I think 559 ! ptab_child(ji,jj,jk) = ptab_child(ji,jj,jk) / e1v(ji,jj) 541 560 ! 542 561 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 543 562 vb(ji,jj,jk) = vb(ji,jj,jk) & 544 & + atfp * ( ptab_child(ji,jj,jk ) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)563 & + atfp * ( ptab_child(ji,jj,jk,1) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 545 564 ENDIF 546 565 ! 547 vn(ji,jj,jk) = ptab_child(ji,jj,jk) * vmask(ji,jj,jk) 548 END DO 549 END DO 550 END DO 551 ENDIF 566 vn(ji,jj,jk) = ptab_child(ji,jj,jk,1) * vmask(ji,jj,jk) 567 END DO 568 END DO 569 END DO 570 ENDIF 571 WRITE(numout,*) 'TG print 8: End of updatev before = ',before 552 572 ! 553 573 END SUBROUTINE updatev -
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r6454 r6929 380 380 CALL agrif_declare_variable((/1,2,0,0/),(/2,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 381 381 CALL agrif_declare_variable((/2,1,0,0/),(/3,2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 382 CALL agrif_declare_variable((/1,2,0 /),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)383 CALL agrif_declare_variable((/2,1,0 /),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)382 CALL agrif_declare_variable((/1,2,0,0/),(/2,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 383 CALL agrif_declare_variable((/2,1,0,0/),(/3,2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 384 384 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 385 385 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
Note: See TracChangeset
for help on using the changeset viewer.
