Changeset 9472
- Timestamp:
- 2018-04-12T17:29:18+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_withNOOS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r9194 r9472 814 814 SELECT CASE( sec%direction(jseg) ) 815 815 CASE(0,1) 816 ztn = interp(k%I,k%J,jk,'V', tsn(:,:,:,jp_tem))817 zsn = interp(k%I,k%J,jk,'V', tsn(:,:,:,jp_sal))818 zrhop = interp(k%I,k%J,jk,'V', rhop)819 zrhoi = interp(k%I,k%J,jk,'V', rhd*rau0+rau0)816 ztn = interp(k%I,k%J,jk,'V',0 ) 817 zsn = interp(k%I,k%J,jk,'V',1 ) 818 zrhop = interp(k%I,k%J,jk,'V',2 ) 819 zrhoi = interp(k%I,k%J,jk,'V',3 ) 820 820 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 821 821 CASE(2,3) 822 ztn = interp(k%I,k%J,jk,'U', tsn(:,:,:,jp_tem))823 zsn = interp(k%I,k%J,jk,'U', tsn(:,:,:,jp_sal))824 zrhop = interp(k%I,k%J,jk,'U', rhop)825 zrhoi = interp(k%I,k%J,jk,'U', rhd*rau0+rau0)822 ztn = interp(k%I,k%J,jk,'U',0 ) 823 zsn = interp(k%I,k%J,jk,'U',1 ) 824 zrhop = interp(k%I,k%J,jk,'U',2 ) 825 zrhoi = interp(k%I,k%J,jk,'U',3 ) 826 826 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 827 827 END SELECT … … 1039 1039 SELECT CASE( sec%direction(jseg) ) 1040 1040 CASE(0,1) 1041 ztn = interp(k%I,k%J,jk,'V', tsn(:,:,:,jp_tem))1042 zsn = interp(k%I,k%J,jk,'V', tsn(:,:,:,jp_sal))1043 zrhop = interp(k%I,k%J,jk,'V', rhop)1044 zrhoi = interp(k%I,k%J,jk,'V', rhd*rau0+rau0)1041 ztn = interp(k%I,k%J,jk,'V',0 ) 1042 zsn = interp(k%I,k%J,jk,'V',1) 1043 zrhop = interp(k%I,k%J,jk,'V',2) 1044 zrhoi = interp(k%I,k%J,jk,'V',3) 1045 1045 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 1046 1046 CASE(2,3) 1047 ztn = interp(k%I,k%J,jk,'U', tsn(:,:,:,jp_tem))1048 zsn = interp(k%I,k%J,jk,'U', tsn(:,:,:,jp_sal))1049 zrhop = interp(k%I,k%J,jk,'U', rhop)1050 zrhoi = interp(k%I,k%J,jk,'U', rhd*rau0+rau0)1047 ztn = interp(k%I,k%J,jk,'U',0) 1048 zsn = interp(k%I,k%J,jk,'U',1) 1049 zrhop = interp(k%I,k%J,jk,'U',2) 1050 zrhoi = interp(k%I,k%J,jk,'U',3) 1051 1051 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 1052 1052 END SELECT … … 1210 1210 SELECT CASE( sec%direction(jseg) ) 1211 1211 CASE(0,1) 1212 ztn = interp(k%I,k%J,jk,'V', tsn(:,:,:,jp_tem))1213 zsn = interp(k%I,k%J,jk,'V', tsn(:,:,:,jp_sal))1214 zrhop = interp(k%I,k%J,jk,'V', rhop)1215 zrhoi = interp(k%I,k%J,jk,'V', rhd*rau0+rau0)1212 ztn = interp(k%I,k%J,jk,'V',0 ) 1213 zsn = interp(k%I,k%J,jk,'V',1 ) 1214 zrhop = interp(k%I,k%J,jk,'V',2) 1215 zrhoi = interp(k%I,k%J,jk,'V',3) 1216 1216 1217 1217 CASE(2,3) 1218 ztn = interp(k%I,k%J,jk,'U', tsn(:,:,:,jp_tem))1219 zsn = interp(k%I,k%J,jk,'U', tsn(:,:,:,jp_sal))1220 zrhop = interp(k%I,k%J,jk,'U', rhop)1221 zrhoi = interp(k%I,k%J,jk,'U', rhd*rau0+rau0)1218 ztn = interp(k%I,k%J,jk,'U',0 ) 1219 zsn = interp(k%I,k%J,jk,'U',1 ) 1220 zrhop = interp(k%I,k%J,jk,'U',2 ) 1221 zrhoi = interp(k%I,k%J,jk,'U',3 ) 1222 1222 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 1223 1223 END SELECT … … 1421 1421 SELECT CASE( sec%direction(jseg) ) 1422 1422 CASE(0,1) 1423 ztn = interp(k%I,k%J,jk,'V', tsn(:,:,:,jp_tem))1424 zsn = interp(k%I,k%J,jk,'V', tsn(:,:,:,jp_sal))1425 zrhop = interp(k%I,k%J,jk,'V', rhop)1426 zrhoi = interp(k%I,k%J,jk,'V', rhd*rau0+rau0)1423 ztn = interp(k%I,k%J,jk,'V',0 ) 1424 zsn = interp(k%I,k%J,jk,'V',1 ) 1425 zrhop = interp(k%I,k%J,jk,'V',2 ) 1426 zrhoi = interp(k%I,k%J,jk,'V',3 ) 1427 1427 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 1428 1428 CASE(2,3) 1429 ztn = interp(k%I,k%J,jk,'U', tsn(:,:,:,jp_tem))1430 zsn = interp(k%I,k%J,jk,'U', tsn(:,:,:,jp_sal))1431 zrhop = interp(k%I,k%J,jk,'U', rhop)1432 zrhoi = interp(k%I,k%J,jk,'U', rhd*rau0+rau0)1429 ztn = interp(k%I,k%J,jk,'U',0 ) 1430 zsn = interp(k%I,k%J,jk,'U',1 ) 1431 zrhop = interp(k%I,k%J,jk,'U',2 ) 1432 zrhoi = interp(k%I,k%J,jk,'U',3 ) 1433 1433 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 1434 1434 END SELECT … … 1869 1869 END SUBROUTINE dia_dct_wri 1870 1870 1871 FUNCTION interp(ki, kj, kk, cd_point, ptab)1871 PURE FUNCTION interp(ki, kj, kk, cd_point,var) 1872 1872 !!---------------------------------------------------------------------- 1873 1873 !! … … 1931 1931 !*arguments 1932 1932 INTEGER, INTENT(IN) :: ki, kj, kk ! coordinate of point 1933 INTEGER, INTENT(IN) :: var ! which variable 1933 1934 CHARACTER(len=1), INTENT(IN) :: cd_point ! type of point (U, V) 1934 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab ! variable to compute at (ki, kj, kk )1935 1935 REAL(wp) :: interp ! interpolated variable 1936 1936 … … 1943 1943 !!---------------------------------------------------------------------- 1944 1944 1945 1946 1945 1947 IF( cd_point=='U' )THEN 1946 1948 ii1 = ki ; ij1 = kj … … 1973 1975 1974 1976 ! result 1975 interp = zmsk * ( zwgt2 * ptab(ii1,ij1,kk) + zwgt1 * ptab(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 ) 1976 1977 SELECT CASE( var ) 1978 CASE(0) ; interp = zmsk * ( zwgt2 * tsn(ii1,ij1,kk,jp_tem) + zwgt1 * tsn(ii1,ij1,kk,jp_tem) ) / ( zwgt2 + zwgt1 ) 1979 CASE(1) ; interp = zmsk * ( zwgt2 * tsn(ii1,ij1,kk,jp_sal) + zwgt1 * tsn(ii1,ij1,kk,jp_sal) ) / ( zwgt2 + zwgt1 ) 1980 CASE(2) ; interp = zmsk * ( zwgt2 * rhop(ii1,ij1,kk) + zwgt1 * rhop(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 ) 1981 CASE(3) ; interp = zmsk * ( zwgt2 * (rhd(ii1,ij1,kk)*rau0+rau0) + zwgt1 * (rhd(ii1,ij1,kk)*rau0+rau0) ) / ( zwgt2 + zwgt1 ) 1982 END SELECT 1977 1983 1978 1984 ELSE ! full step or partial step case … … 1996 2002 IF( ze3t >= 0. )THEN 1997 2003 ! zbis 1998 zbis = ptab(ii2,ij2,kk) + zwgt1 * ( ptab(ii2,ij2,kk-1) - ptab(ii2,ij2,kk) ) 2004 SELECT CASE( var ) 2005 CASE(0) 2006 zbis = tsn(ii2,ij2,kk,jp_tem) + zwgt1 * (tsn(ii2,ij2,kk-1,jp_tem)-tsn(ii2,ij2,kk,jp_tem) ) 2007 interp = zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * zbis )/( zet1 + zet2 ) 2008 CASE(1) 2009 zbis = tsn(ii2,ij2,kk,jp_sal) + zwgt1 * (tsn(ii2,ij2,kk-1,jp_sal)-tsn(ii2,ij2,kk,jp_sal) ) 2010 interp = zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * zbis )/( zet1 + zet2 ) 2011 CASE(2) 2012 zbis = rhop(ii2,ij2,kk) + zwgt1 * (rhop(ii2,ij2,kk-1)-rhop(ii2,ij2,kk) ) 2013 interp = zmsk * ( zet2 * rhop(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 ) 2014 CASE(3) 2015 zbis = (rhd(ii2,ij2,kk)*rau0+rau0) + zwgt1 * ( (rhd(ii2,ij2,kk-1)*rau0+rau0)-(rhd(ii2,ij2,kk)*rau0+rau0) ) 2016 interp = zmsk * ( zet2 * (rhd(ii1,ij1,kk)*rau0+rau0) + zet1 * zbis )/( zet1 + zet2 ) 2017 END SELECT 1999 2018 ! result 2000 interp = zmsk * ( zet2 * ptab(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 )2001 2019 ELSE 2002 2020 ! zbis 2003 zbis = ptab(ii1,ij1,kk) + zwgt2 * ( ptab(ii1,ij1,kk-1) - ptab(ii1,ij2,kk) ) 2004 ! result 2005 interp = zmsk * ( zet2 * zbis + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 ) 2021 SELECT CASE( var ) 2022 CASE(0) 2023 zbis = tsn(ii1,ij1,kk,jp_tem) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_tem) - tsn(ii1,ij2,kk,jp_tem) ) 2024 interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 ) 2025 CASE(1) 2026 zbis = tsn(ii1,ij1,kk,jp_sal) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_sal) - tsn(ii1,ij2,kk,jp_sal) ) 2027 interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 ) 2028 CASE(2) 2029 zbis = rhop(ii1,ij1,kk) + zwgt2 * ( rhop(ii1,ij1,kk-1) - rhop(ii1,ij2,kk) ) 2030 interp = zmsk * ( zet2 * zbis + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 ) 2031 CASE(3) 2032 zbis = (rhd(ii1,ij1,kk)*rau0+rau0) + zwgt2 * ( (rhd(ii1,ij1,kk-1)*rau0+rau0) - (rhd(ii1,ij2,kk)*rau0+rau0) ) 2033 interp = zmsk * ( zet2 * zbis + zet1 * (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 ) 2034 END SELECT 2006 2035 ENDIF 2007 2036 2008 2037 ELSE 2009 interp = zmsk * ( zet2 * ptab(ii1,ij1,kk) + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 ) 2038 SELECT CASE( var ) 2039 CASE(0) 2040 interp = zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 ) 2041 CASE(1) 2042 interp = zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 ) 2043 CASE(2) 2044 interp = zmsk * ( zet2 * rhop(ii1,ij1,kk) + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 ) 2045 CASE(3) 2046 interp = zmsk * ( zet2 * (rhd(ii1,ij1,kk)*rau0+rau0) + zet1 * (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 ) 2047 END SELECT 2010 2048 ENDIF 2011 2049 2012 2050 ENDIF 2013 2014 2051 2015 2052 END FUNCTION interp
Note: See TracChangeset
for help on using the changeset viewer.