- Timestamp:
- 2015-10-31T08:40:45+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r5505 r5845 30 30 !! 31 31 !!---------------------------------------------------------------------- 32 !! * Modules used33 32 USE oce ! ocean dynamics and tracers 34 33 USE dom_oce ! ocean space and time domain … … 51 50 PRIVATE 52 51 53 !! * Routine accessibility54 52 PUBLIC dia_dct ! routine called by step.F90 55 53 PUBLIC dia_dct_init ! routine called by opa.F90 … … 60 58 PRIVATE dia_dct_wri 61 59 62 #include "domzgr_substitute.h90"63 64 !! * Shared module variables65 60 LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .TRUE. !: model-data diagnostics flag 66 61 67 !! * Module variables68 62 INTEGER :: nn_dct ! Frequency of computation 69 63 INTEGER :: nn_dctwri ! Frequency of output … … 112 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d 113 107 108 !!---------------------------------------------------------------------- 109 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 114 110 !! $Id$ 111 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 112 !!---------------------------------------------------------------------- 115 113 CONTAINS 116 117 114 118 115 INTEGER FUNCTION diadct_alloc() … … 130 127 131 128 END FUNCTION diadct_alloc 129 132 130 133 131 SUBROUTINE dia_dct_init … … 208 206 !! Reinitialise all relevant arrays to zero 209 207 !!--------------------------------------------------------------------- 210 !! * Arguments 211 INTEGER,INTENT(IN) ::kt 212 213 !! * Local variables 208 INTEGER,INTENT(in) ::kt 209 ! 214 210 INTEGER :: jsec, &! loop on sections 215 211 itotal ! nb_sec_max*nb_type_class*nb_class_max … … 220 216 REAL(wp), POINTER, DIMENSION(:) :: zwork ! " 221 217 REAL(wp), POINTER, DIMENSION(:,:,:):: zsum ! " 222 223 218 !!--------------------------------------------------------------------- 219 ! 224 220 IF( nn_timing == 1 ) CALL timing_start('dia_dct') 225 221 … … 619 615 zumid_ice, zvmid_ice, &!U/V ice velocity 620 616 zTnorm !transport of velocity through one cell's sides 621 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, z fsdep !temperature/salinity/potential density/ssh/depth at u/v point617 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zdep !temperature/salinity/potential density/ssh/depth at u/v point 622 618 623 619 TYPE(POINT_SECTION) :: k … … 723 719 END SELECT 724 720 725 z fsdep= fsdept(k%I,k%J,jk)721 zdep= gdept_n(k%I,k%J,jk) 726 722 727 723 !compute velocity with the correct direction … … 737 733 !zTnorm=transport through one cell; 738 734 !velocity* cell's length * cell's thickness 739 zTnorm=zumid*e2u(k%I,k%J)* fse3u(k%I,k%J,jk)+ &740 zvmid*e1v(k%I,k%J)* fse3v(k%I,k%J,jk)735 zTnorm=zumid*e2u(k%I,k%J)* e3u_n(k%I,k%J,jk)+ & 736 zvmid*e1v(k%I,k%J)* e3v_n(k%I,k%J,jk) 741 737 742 738 #if ! defined key_vvl … … 828 824 !! 829 825 !!------------------------------------------------------------- 830 !! * arguments831 826 TYPE(SECTION),INTENT(INOUT) :: sec 832 827 INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section … … 834 829 TYPE(POINT_SECTION) :: k 835 830 INTEGER :: jk,jseg,jclass ! dummy variables for looping on level/segment/classes 836 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, z fsdep ! temperature/salinity/ssh/potential density /depth at u/v point831 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zdep ! temperature/salinity/ssh/potential density /depth at u/v point 837 832 !!------------------------------------------------------------- 838 833 … … 903 898 END SELECT 904 899 905 z fsdep= fsdept(k%I,k%J,jk)900 zdep= gdept_n(k%I,k%J,jk) 906 901 907 902 !------------------------------- … … 932 927 ( sec%ztem(jclass) .EQ.99.)) .AND. & 933 928 934 ((( z fsdep .GE. sec%zlay(jclass)) .AND. &935 ( z fsdep .LE. sec%zlay(jclass+1))) .OR. &929 ((( zdep .GE. sec%zlay(jclass)) .AND. & 930 ( zdep .LE. sec%zlay(jclass+1))) .OR. & 936 931 ( sec%zlay(jclass) .EQ. 99. )) & 937 932 )) THEN … … 1144 1139 1145 1140 CALL wrk_dealloc(nb_type_class , zsumclasses ) 1141 ! 1146 1142 END SUBROUTINE dia_dct_wri 1143 1147 1144 1148 1145 FUNCTION interp(ki, kj, kk, cd_point, ptab) … … 1214 1211 !*local declations 1215 1212 INTEGER :: ii1, ij1, ii2, ij2 ! local integer 1216 REAL(wp):: ze3t, z fse3, zwgt1, zwgt2, zbis, zdepu ! local real1213 REAL(wp):: ze3t, ze3, zwgt1, zwgt2, zbis, zdepu ! local real 1217 1214 REAL(wp):: zet1, zet2 ! weight for interpolation 1218 1215 REAL(wp):: zdep1,zdep2 ! differences of depth … … 1241 1238 IF( ln_sco )THEN ! s-coordinate case 1242 1239 1243 zdepu = ( fsdept(ii1,ij1,kk) + fsdept(ii2,ij2,kk) ) /21244 zdep1 = fsdept(ii1,ij1,kk) - zdepu1245 zdep2 = fsdept(ii2,ij2,kk) - zdepu1240 zdepu = ( gdept_n(ii1,ij1,kk) + gdept_n(ii2,ij2,kk) ) * 0.5_wp 1241 zdep1 = gdept_n(ii1,ij1,kk) - zdepu 1242 zdep2 = gdept_n(ii2,ij2,kk) - zdepu 1246 1243 1247 1244 ! weights … … 1255 1252 ELSE ! full step or partial step case 1256 1253 1257 #if defined key_vvl 1258 1259 ze3t = fse3t_n(ii2,ij2,kk) - fse3t_n(ii1,ij1,kk) 1260 zwgt1 = ( fse3w_n(ii2,ij2,kk) - fse3w_n(ii1,ij1,kk) ) / fse3w_n(ii2,ij2,kk) 1261 zwgt2 = ( fse3w_n(ii1,ij1,kk) - fse3w_n(ii2,ij2,kk) ) / fse3w_n(ii1,ij1,kk) 1262 1263 #else 1264 1265 ze3t = fse3t(ii2,ij2,kk) - fse3t(ii1,ij1,kk) 1266 zwgt1 = ( fse3w(ii2,ij2,kk) - fse3w(ii1,ij1,kk) ) / fse3w(ii2,ij2,kk) 1267 zwgt2 = ( fse3w(ii1,ij1,kk) - fse3w(ii2,ij2,kk) ) / fse3w(ii1,ij1,kk) 1268 1269 #endif 1254 ze3t = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk) 1255 zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk) 1256 zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk) 1270 1257 1271 1258 IF(kk .NE. 1)THEN … … 1288 1275 1289 1276 ENDIF 1290 1291 1292 END FUNCTION interp 1277 ! 1278 END FUNCTION interp 1293 1279 1294 1280 #else
Note: See TracChangeset
for help on using the changeset viewer.