Changeset 8999
- Timestamp:
- 2017-12-13T09:49:08+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_METO_MERCATOR_2017_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r8998 r8999 873 873 zrhoy = Agrif_rhoy() 874 874 IF (before) THEN 875 !We can't use zero as the special value because we need to include zeros876 !when interpolating the scale factors877 IF(Agrif_UseSpecialValue) THEN878 ! Agrif_SpecialValue = -999._wp879 Agrif_SpecialValue = 0._wp880 ELSE881 Agrif_SpecialValue = 0._wp882 ENDIF883 875 DO jk=1,jpk 884 876 DO jj=j1,j2 885 877 DO ji=i1,i2 886 ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)*umask(ji,jj,jk)) - & 887 & ((umask(ji,jj,jk)-1) * Agrif_SpecialValue) 878 ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)*umask(ji,jj,jk)) 888 879 # if defined key_vertical 889 880 ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)) … … 898 889 western_side = (nb == 1).AND.(ndir == 1) 899 890 eastern_side = (nb == 1).AND.(ndir == 2) 900 901 Agrif_SpecialValue = 0._wp ! reset specialvalue to zero now interpolation completed902 891 903 892 DO ji=i1,i2 … … 976 965 ! 977 966 IF (before) THEN 978 IF(Agrif_UseSpecialValue) THEN979 ! Agrif_SpecialValue = -999._wp980 Agrif_SpecialValue = 0._wp981 ELSE982 Agrif_SpecialValue = 0._wp983 ENDIF984 967 DO jk=k1,k2 985 968 DO jj=j1,j2 986 969 DO ji=i1,i2 987 ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk)*vmask(ji,jj,jk)) - & 988 & ((vmask(ji,jj,jk)-1) * Agrif_SpecialValue) 970 ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk)*vmask(ji,jj,jk)) 989 971 # if defined key_vertical 990 972 ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) … … 996 978 zrhox = Agrif_rhox() 997 979 # if defined key_vertical 998 Agrif_SpecialValue = 0._wp !Reset special value to zero now interpolation is done999 980 1000 981 southern_side = (nb == 2).AND.(ndir == 1) … … 1403 1384 # if defined key_zdftke || defined key_zdfgls 1404 1385 1405 SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before )1386 SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 1406 1387 !!---------------------------------------------------------------------- 1407 1388 !! *** ROUTINE interavm *** 1408 1389 !!---------------------------------------------------------------------- 1409 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 1410 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2 ), INTENT(inout) :: ptab1390 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, m1, m2 1391 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab 1411 1392 LOGICAL , INTENT(in ) :: before 1393 REAL(wp), DIMENSION(k1:k2) :: tabin 1394 REAL(wp) :: h_in(k1:k2) 1395 REAL(wp) :: h_out(1:jpk) 1396 REAL(wp) :: zrhoxy 1397 INTEGER :: N_in, N_out, ji, jj, jk 1412 1398 !!---------------------------------------------------------------------- 1413 1399 ! 1414 IF( before ) THEN 1415 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 1416 ELSE 1417 avm (i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1400 zrhoxy = Agrif_rhox()*Agrif_rhoy() 1401 IF (before) THEN 1402 DO jk=k1,k2 1403 DO jj=j1,j2 1404 DO ji=i1,i2 1405 ptab(ji,jj,jk,1) = avm_k(ji,jj,jk) 1406 END DO 1407 END DO 1408 END DO 1409 #ifdef key_vertical 1410 DO jk=k1,k2 1411 DO jj=j1,j2 1412 DO ji=i1,i2 1413 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e1e2t(ji,jj) * e3w_n(ji,jj,jk) 1414 END DO 1415 END DO 1416 END DO 1417 #else 1418 ptab(i1:i2,j1:j2,k1:k2,2) = 0._wp 1419 #endif 1420 ELSE 1421 #ifdef key_vertical 1422 avm_k(i1:i2,j1:j2,1:jpk) = 0. 1423 DO jj=j1,j2 1424 DO ji=i1,i2 1425 N_in = 0 1426 DO jk=k1,k2 !k2 = jpk of parent grid 1427 IF (ptab(ji,jj,jk,2) == 0) EXIT 1428 N_in = N_in + 1 1429 tabin(jk) = ptab(ji,jj,jk,1) 1430 h_in(N_in) = ptab(ji,jj,jk,2)/(e1e2t(ji,jj)*zrhoxy) 1431 END DO 1432 N_out = 0 1433 DO jk=1,jpk ! jpk of child grid 1434 IF (wmask(ji,jj,jk) == 0) EXIT 1435 N_out = N_out + 1 1436 h_out(jk) = e3t_n(ji,jj,jk) 1437 ENDDO 1438 IF (N_in > 0) THEN 1439 CALL reconstructandremap(tabin(1:N_in),h_in,avm_k(ji,jj,1:N_out),h_out,N_in,N_out) 1440 ENDIF 1441 ENDDO 1442 ENDDO 1443 #else 1444 avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2,1) 1445 #endif 1418 1446 ENDIF 1419 1447 !
Note: See TracChangeset
for help on using the changeset viewer.