Changeset 11607
- Timestamp:
- 2019-09-27T11:59:22+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST
- Files:
-
- 2 edited
-
agrif_oce_update.F90 (modified) (13 diffs)
-
agrif_top_update.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_update.F90
r11603 r11607 284 284 !! 285 285 INTEGER :: ji,jj,jk,jn 286 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: tabres_child 286 INTEGER :: N_in, N_out 287 REAL(wp) :: ztb, ztnu, ztno 287 288 REAL(wp) :: h_in(k1:k2) 288 289 REAL(wp) :: h_out(1:jpk) 289 INTEGER :: N_in, N_out 290 REAL(wp) :: zrho_xy, h_diff 291 REAL(wp) :: tabin(k1:k2,n1:n2) 290 REAL(wp) :: tabin(k1:k2,jpts) 291 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jpts) :: tabres_child 292 292 !!--------------------------------------------- 293 293 ! 294 294 IF (before) THEN 295 295 AGRIF_SpecialValue = -999._wp 296 zrho_xy = Agrif_rhox() * Agrif_rhoy()297 296 DO jn = n1,n2-1 298 297 DO jk=k1,k2 … … 300 299 DO ji=i1,i2 301 300 tabres(ji,jj,jk,jn) = (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 302 * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1 )*999._wp301 * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1._wp)*999._wp 303 302 END DO 304 303 END DO … … 314 313 END DO 315 314 ELSE 316 tabres_child(:,:,:,:) = 0. 315 tabres_child(:,:,:,:) = 0._wp 317 316 AGRIF_SpecialValue = 0._wp 318 317 DO jj=j1,j2 … … 332 331 ENDDO 333 332 IF (N_in > 0) THEN !Remove this? 334 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))335 IF (h_diff < -1.e-4) THEN336 print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out))337 print *,h_in(1:N_in)338 print *,h_out(1:N_out)339 STOP340 ENDIF341 333 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) 342 334 ENDIF … … 346 338 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 347 339 ! Add asselin part 348 DO jn = n1,n2-1 349 DO jk=1,jpk 350 DO jj=j1,j2 351 DO ji=i1,i2 352 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 353 tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 354 & + atfp * ( tabres_child(ji,jj,jk,jn) & 355 & - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 340 DO jn = 1,jpts 341 DO jk = 1, jpkm1 342 DO jj = j1, j2 343 DO ji = i1, i2 344 IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 345 ztb = tsb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used 346 ztnu = tabres_child(ji,jj,jk,jn) * e3t_n(ji,jj,jk) 347 ztno = tsn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 348 tsb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & 349 & * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 356 350 ENDIF 357 END DO358 END DO359 END DO360 END DO361 ENDIF 362 DO jn = n1,n2-1363 DO jk =1,jpk364 DO jj =j1,j2365 DO ji =i1,i2366 IF( tabres_child(ji,jj,jk,jn) .NE. 0.) THEN367 tsn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk)351 END DO 352 END DO 353 END DO 354 END DO 355 ENDIF 356 DO jn = 1,jpts 357 DO jk = 1, jpkm1 358 DO jj = j1, j2 359 DO ji = i1, i2 360 IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 361 tsn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) 368 362 END IF 369 363 END DO … … 371 365 END DO 372 366 END DO 367 ! 368 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 369 tsb(i1:i2,j1:j2,1:jpkm1,1:jpts) = tsn(i1:i2,j1:j2,1:jpkm1,1:jpts) 370 ENDIF 373 371 ENDIF 374 372 ! … … 460 458 ! 461 459 INTEGER :: ji, jj, jk 462 REAL(wp):: zrhoy 460 REAL(wp):: zrhoy, zub, zunu, zuno 463 461 ! VERTICAL REFINEMENT BEGIN 464 462 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child … … 527 525 ENDDO 528 526 ENDDO 529 527 ! 530 528 DO jk=1,jpk 531 529 DO jj=j1,j2 532 530 DO ji=i1,i2 533 531 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 534 ub(ji,jj,jk) = ub(ji,jj,jk) & 535 & + atfp * ( tabres_child(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 532 zub = ub(ji,jj,jk) * e3u_b(ji,jj,jk) ! fse3t_b prior update should be used 533 zuno = un(ji,jj,jk) * e3u_a(ji,jj,jk) 534 zunu = tabres_child(ji,jj,jk) * e3u_n(ji,jj,jk) 535 ub(ji,jj,jk) = ( zub + atfp * ( zunu - zuno) ) & 536 & * umask(ji,jj,jk) / e3u_b(ji,jj,jk) 536 537 ENDIF 537 538 ! … … 540 541 END DO 541 542 END DO 543 ! 544 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 545 ub(i1:i2,j1:j2,1:jpkm1) = un(i1:i2,j1:j2,1:jpkm1) 546 ENDIF 547 ! 542 548 ENDIF 543 549 ! … … 647 653 ! 648 654 INTEGER :: ji, jj, jk 649 REAL(wp) :: zrhox 655 REAL(wp) :: zrhox, zvb, zvnu, zvno 650 656 ! VERTICAL REFINEMENT BEGIN 651 657 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child … … 692 698 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 693 699 IF (h_diff < -1.e-4) then 694 !Even if bathy at T points match it's possible for the Upoints to be deeper in the child grid.700 !Even if bathy at T points match it's possible for the V points to be deeper in the child grid. 695 701 !In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell. 696 702 excess = 0._wp … … 712 718 ENDDO 713 719 ENDDO 714 715 DO jk=1,jpk 720 ! 721 DO jk=1,jpkm1 716 722 DO jj=j1,j2 717 723 DO ji=i1,i2 718 ! 719 IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN ! Add asselin part 720 vb(ji,jj,jk) = vb(ji,jj,jk) & 721 & + atfp * ( tabres_child(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 724 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 725 zvb = vb(ji,jj,jk) * e3v_b(ji,jj,jk) ! fse3t_b prior update should be used 726 zvno = vn(ji,jj,jk) * e3v_a(ji,jj,jk) 727 zvnu = tabres_child(ji,jj,jk) * e3v_n(ji,jj,jk) 728 vb(ji,jj,jk) = ( zvb + atfp * ( zvnu - zvno) ) & 729 & * vmask(ji,jj,jk) / e3v_b(ji,jj,jk) 722 730 ENDIF 723 731 ! … … 726 734 END DO 727 735 END DO 736 ! 737 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 738 vb(i1:i2,j1:j2,1:jpkm1) = vn(i1:i2,j1:j2,1:jpkm1) 739 ENDIF 740 ! 728 741 ENDIF 729 742 ! -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_top_update.F90
r11603 r11607 124 124 ENDDO 125 125 ENDDO 126 126 ! 127 127 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 128 128 ! Add asselin part 129 129 DO jn = 1,jptra 130 DO jk=1,jpk 130 DO jk=1,jpkm1 131 131 DO jj=j1,j2 132 132 DO ji=i1,i2 133 133 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 134 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 135 & + atfp * ( tabres_child(ji,jj,jk,jn) & 136 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 134 ztb = trb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used 135 ztnu = tabres_child(ji,jj,jk,jn) * e3t_n(ji,jj,jk) 136 ztno = trn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 137 trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & 138 & * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 137 139 ENDIF 138 140 ENDDO … … 142 144 ENDIF 143 145 DO jn = 1,jptra 144 DO jk=1,jpk 146 DO jk=1,jpkm1 145 147 DO jj=j1,j2 146 148 DO ji=i1,i2 147 149 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 148 trn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk)150 trn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) 149 151 END IF 150 152 END DO … … 152 154 END DO 153 155 END DO 156 ! 157 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 158 trb(i1:i2,j1:j2,1:jpkm1,1:jptra) = trn(i1:i2,j1:j2,1:jpkm1,1:jptra) 159 ENDIF 160 ! 161 154 162 ENDIF 155 163 !
Note: See TracChangeset
for help on using the changeset viewer.
