Changeset 8596
- Timestamp:
- 2017-10-05T16:35:28+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/NEMO/NST_SRC
- Files:
-
- 2 edited
-
agrif_opa_interp.F90 (modified) (8 diffs)
-
agrif_opa_update.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r8135 r8596 617 617 618 618 zrhoxy = Agrif_rhox()*Agrif_rhoy() 619 619 620 IF (before) THEN 620 DO jn = n1,n2-1 621 IF(Agrif_UseSpecialValue) THEN 622 Agrif_SpecialValue = -999._wp 623 ELSE 624 Agrif_SpecialValue = 0._wp 625 ENDIF 626 DO jn = n1,n2-1 627 DO jk=k1,k2 628 DO jj=j1,j2 629 DO ji=i1,i2 630 ptab(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) - & 631 & (tmask(ji,jj,jk)-1) * Agrif_SpecialValue 632 END DO 633 END DO 634 END DO 635 END DO 621 636 DO jk=k1,k2 622 637 DO jj=j1,j2 623 638 DO ji=i1,i2 624 ptab(ji,jj,jk, jn) = tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk)639 ptab(ji,jj,jk,n2) = tmask(ji,jj,jk) * e1e2t(ji,jj) * e3t_n(ji,jj,jk) 625 640 END DO 626 641 END DO 627 642 END DO 628 END DO629 DO jk=k1,k2630 DO jj=j1,j2631 DO ji=i1,i2632 ptab(ji,jj,jk,n2) = tmask(ji,jj,jk) * e1e2t(ji,jj) * e3t_n(ji,jj,jk)633 END DO634 END DO635 END DO636 637 643 ELSE 644 Agrif_SpecialValue = 0._wp !reset now interpolation is done 638 645 ! VERTICAL REFINEMENT BEGIN 639 646 #ifdef key_vertical 640 647 ptab_child(:,:,:,:) = 0. 641 648 do jj=j1,j2 … … 677 684 enddo 678 685 enddo 686 #else 687 do jk=k1,k2 688 do jj=j1,j2 689 do ji=i1,i2 690 ! This will be slow - Is there a way to speed it up and avoid divide by zero? 691 IF (ptab(ji,jj,jk,n2) .NE. 0) THEN 692 ptab_child(ji,jj,jk,n1:n2-1) = ptab(ji,jj,jk,n1:n2-1)/ptab(ji,jj,jk,n2) 693 ELSE 694 ptab_child(ji,jj,jk,n1:n2-1) = 0._wp 695 ENDIF 696 enddo 697 enddo 698 enddo 699 #endif 679 700 680 701 … … 840 861 841 862 842 SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before)863 SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before, nb, ndir ) 843 864 !!---------------------------------------------------------------------- 844 865 !! *** ROUTINE interpun *** … … 891 912 892 913 ptab_child(:,:,:) = 0. 914 #ifdef key_vertical 915 ! VERTICAL REFINEMENT BEGIN 893 916 DO jj=j1,j2 894 917 DO ji=i1,i2 … … 938 961 ! remove division of ua by fs e3u (already done) and also zrhoy and e2u 939 962 ! VERTICAL REFINEMENT END 940 941 963 DO jk = 1, jpkm1 942 964 DO jj=j1,j2 943 965 ua(i1:i2,jj,jk) = ptab_child(i1:i2,jj,jk) 944 !/(zrhoy*e2u(i1:i2,jj))) 945 END DO 946 END DO 966 END DO 967 END DO 968 #else 969 DO jk = 1, jpkm1 970 DO jj=j1,j2 971 ua(i1:i2,jj,jk) = umask(i1:i2,jj,jk) * ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u_n(i1:i2,jj,jk) ) 972 END DO 973 END DO 974 #endif 947 975 ENDIF 948 976 ! … … 950 978 951 979 952 SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before)980 SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before, nb, ndir ) 953 981 !!---------------------------------------------------------------------- 954 982 !! *** ROUTINE interpvn *** … … 991 1019 END DO 992 1020 ELSE 1021 Agrif_SpecialValue = 0._wp !Reset special value to zero now interpolation is done 1022 ptab_child(:,:,:) = 0. 1023 #ifdef key_vertical 993 1024 ! VERTICAL REFINEMENT BEGIN 994 ptab_child(:,:,:) = 0.995 1025 southern_side = (nb == 2).AND.(ndir == 1) 996 1026 northern_side = (nb == 2).AND.(ndir == 2) 997 998 Agrif_SpecialValue = 0._wp !Reset special value to zero now interpolation is done999 1027 1000 1028 do jj=j1,j2 … … 1041 1069 ! in the following 1042 1070 ! remove division of va by fs e3v, zrhox and e1v (already done) 1071 DO jk=1,jpkm1 1072 DO jj=j1,j2 1073 va(i1:i2,jj,jk) = ptab_child(i1:i2,jj,jk) 1074 END DO 1075 END DO 1043 1076 ! VERTICAL REFINEMENT END 1044 DO jk=1,jpkm1 1045 DO jj=j1,j2 1046 va(i1:i2,jj,jk) = ptab_child(i1:i2,jj,jk) 1047 END DO 1048 END DO 1077 #else 1078 DO jk=1,jpkm1 1079 va(i1:i2,j1:j2,jk) = vmask(i1:i2,j1:j2,jk) * ptab(i1:i2,j1:j2,jk,1) / & 1080 & ( zrhox * e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) ) 1081 END DO 1082 #endif 1049 1083 ENDIF 1050 1084 ! -
branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r8135 r8596 199 199 ! 200 200 IF (before) THEN 201 zrho_xy = Agrif_rhox() * Agrif_rhoy() 202 DO jn = n1,n2-1 201 # if defined key_vertical 202 zrho_xy = Agrif_rhox() * Agrif_rhoy() 203 DO jn = n1,n2-1 204 DO jk=k1,k2 205 DO jj=j1,j2 206 DO ji=i1,i2 207 tabres(ji,jj,jk,jn) = zrho_xy * tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk) 208 END DO 209 END DO 210 END DO 211 END DO 203 212 DO jk=k1,k2 204 213 DO jj=j1,j2 205 214 DO ji=i1,i2 206 tabres(ji,jj,jk, jn) = zrho_xy * tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk)215 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * zrho_xy * e1e2t(ji,jj) * e3t_n(ji,jj,jk) 207 216 END DO 208 217 END DO 209 218 END DO 210 END DO 211 DO jk=k1,k2 212 DO jj=j1,j2 213 DO ji=i1,i2 214 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * zrho_xy * e1e2t(ji,jj) * e3t_n(ji,jj,jk) 215 END DO 216 END DO 217 END DO 218 219 #else 220 DO jn = n1,n2-1 221 DO jk=k1,k2 222 DO jj=j1,j2 223 DO ji=i1,i2 224 tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 225 END DO 226 END DO 227 END DO 228 END DO 229 #endif 219 230 ELSE 220 231 ! VERTICAL REFINEMENT BEGIN 221 232 tabres_child(:,:,:,:) = 0. 222 233 # if defined key_vertical 223 234 DO jj=j1,j2 224 235 DO ji=i1,i2 … … 243 254 ! h_in(N_in) = h_diff 244 255 ! tabin(N_in,:) = tabin(N_in-1,:) 245 IF (h_diff < 0) THEN256 IF (h_diff < -1.e-4) THEN 246 257 print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out)) 247 print *,'Nval = ',N_out,mbathy(ji,jj) 248 print *,'BATHY = ',gdepw_0(ji,jj,mbathy(ji,jj)+1),sum(e3t_0(ji,jj,1:mbathy(ji,jj))) 258 print *, tabres(ji,j1:j2,1,n2) 249 259 STOP 250 260 ! N_out = N_out + 1 … … 257 267 ENDDO 258 268 ENDDO 269 #else 270 tabres_child(:,:,:,:) = tabres(:,:,:,1:jpts) 271 #endif 259 272 260 273 ! WARNING : … … 317 330 IF( before ) THEN 318 331 zrhoy = Agrif_Rhoy() 332 # if defined key_vertical 319 333 DO jk=k1,k2 320 334 DO jj=j1,j2 … … 325 339 END DO 326 340 END DO 327 ELSE 341 #else 342 DO jk = k1,k2 343 tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 344 END DO 345 #endif 346 ELSE 347 tabres_child(:,:,:) = 0. 348 # if defined key_vertical 328 349 ! VERTICAL REFINEMENT BEGIN 329 tabres_child(:,:,:) = 0.330 331 350 DO jj=j1,j2 332 351 DO ji=i1,i2 … … 347 366 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 348 367 ! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 349 if (h_diff < 0.) then368 if (h_diff < -1.e-4) then 350 369 print *,'CHECK YOUR BATHY ...' 351 370 stop … … 359 378 ENDDO 360 379 ENDDO 380 #else 381 DO jk=1,jpk 382 DO jj=j1,j2 383 DO ji=i1,i2 384 tabres_child(:,:,:) = tabres(:,:,:,1)* r1_e2u(ji,jj) / e3u_n(ji,jj,jk) 385 END DO 386 END DO 387 END DO 388 #endif 361 389 362 390 ! WARNING : … … 408 436 IF (before) THEN 409 437 zrhox = Agrif_Rhox() 438 #if defined key_vertical 410 439 DO jk=k1,k2 411 440 DO jj=j1,j2 … … 416 445 END DO 417 446 END DO 418 ELSE 447 #else 448 DO jk=k1,k2 449 DO jj=j1,j2 450 DO ji=i1,i2 451 tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 452 END DO 453 END DO 454 END DO 455 #endif 456 ELSE 457 tabres_child(:,:,:) = 0. 419 458 ! VERTICAL REFINEMENT BEGIN 420 tabres_child(:,:,:) = 0. 421 459 #if defined key_vertical 422 460 DO jj=j1,j2 423 461 DO ji=i1,i2 … … 438 476 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 439 477 ! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 440 if (h_diff < 0.) then478 if (h_diff < -1.e-4) then 441 479 print *,'CHECK YOUR BATHY ...' 442 480 stop … … 450 488 ENDDO 451 489 ENDDO 490 #else 491 DO jk=k1,k2 492 DO jj=j1,j2 493 DO ji=i1,i2 494 tabres(ji,jj,jk,1) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 495 END DO 496 END DO 497 END DO 498 #endif 452 499 453 500 ! WARNING :
Note: See TracChangeset
for help on using the changeset viewer.
