- Timestamp:
- 2017-03-17T08:46:30+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r7256 r7806 28 28 USE wrk_nemo ! Memory Allocation 29 29 USE timing ! Timing 30 USE diaptr ! Heat/Salt transport diagnostics 31 USE trddyn 32 USE trd_oce 30 33 31 34 IMPLICIT NONE … … 78 81 # endif 79 82 REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d, z3d_T 80 84 !!---------------------------------------------------------------------- 81 85 ! … … 84 88 # if defined key_diaeiv 85 89 CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 90 CALL wrk_alloc( jpi, jpj, jpk, z3d, z3d_T ) 86 91 # else 87 92 CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) … … 160 165 CALL iom_put( "voce_eiv", v_eiv ) ! j-eiv current 161 166 CALL iom_put( "woce_eiv", w_eiv ) ! vert. eiv current 162 IF( iom_use('ueiv_heattr') ) THEN 163 zztmp = 0.5 * rau0 * rcp 167 IF( iom_use('weiv_masstr') ) THEN ! vertical mass transport & its square value 168 z2d(:,:) = rau0 * e12t(:,:) 169 DO jk = 1, jpk 170 z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 171 END DO 172 CALL iom_put( "weiv_masstr" , z3d ) 173 ENDIF 174 IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") .OR. iom_use('ueiv_heattr3d') & 175 .OR. iom_use("ueiv_salttr") .OR. iom_use('ueiv_salttr3d') ) THEN 176 z3d(:,:,jpk) = 0.e0 177 z2d(:,:) = 0.e0 178 DO jk = 1, jpkm1 179 z3d(:,:,jk) = rau0 * u_eiv(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 180 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 181 END DO 182 CALL iom_put( "ueiv_masstr", z3d ) ! mass transport in i-direction 183 ENDIF 184 185 IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 186 zztmp = 0.5 * rcp 164 187 z2d(:,:) = 0.e0 165 DO jk = 1, jpkm1 166 DO jj = 2, jpjm1 167 DO ji = fs_2, fs_jpim1 ! vector opt. 168 z2d(ji,jj) = z2d(ji,jj) + u_eiv(ji,jj,jk) & 169 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk) 170 END DO 171 END DO 172 END DO 173 CALL lbc_lnk( z2d, 'U', -1. ) 174 CALL iom_put( "ueiv_heattr", zztmp * z2d ) ! heat transport in i-direction 188 z3d_T(:,:,:) = 0.e0 189 DO jk = 1, jpkm1 190 DO jj = 2, jpjm1 191 DO ji = fs_2, fs_jpim1 ! vector opt. 192 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 193 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 194 END DO 195 END DO 196 END DO 197 IF (iom_use('ueiv_heattr') ) THEN 198 CALL lbc_lnk( z2d, 'U', -1. ) 199 CALL iom_put( "ueiv_heattr", zztmp * z2d ) ! 2D heat transport in i-direction 200 ENDIF 201 IF (iom_use('ueiv_heattr3d') ) THEN 202 CALL lbc_lnk( z3d_T, 'U', -1. ) 203 CALL iom_put( "ueiv_heattr3d", zztmp * z3d_T ) ! 3D heat transport in i-direction 204 ENDIF 205 ENDIF 206 207 IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d') ) THEN 208 zztmp = 0.5 * 0.001 209 z2d(:,:) = 0.e0 210 z3d_T(:,:,:) = 0.e0 211 DO jk = 1, jpkm1 212 DO jj = 2, jpjm1 213 DO ji = fs_2, fs_jpim1 ! vector opt. 214 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 215 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 216 END DO 217 END DO 218 END DO 219 IF (iom_use('ueiv_salttr') ) THEN 220 CALL lbc_lnk( z2d, 'U', -1. ) 221 CALL iom_put( "ueiv_salttr", zztmp * z2d ) ! 2D salt transport in i-direction 222 ENDIF 223 IF (iom_use('ueiv_salttr3d') ) THEN 224 CALL lbc_lnk( z3d_T, 'U', -1. ) 225 CALL iom_put( "ueiv_salttr3d", zztmp * z3d_T ) ! 3D salt transport in i-direction 226 ENDIF 227 ENDIF 228 229 IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") .OR. iom_use('veiv_heattr3d') & 230 .OR. iom_use("veiv_salttr") .OR. iom_use('veiv_salttr3d') ) THEN 231 z3d(:,:,jpk) = 0.e0 232 DO jk = 1, jpkm1 233 z3d(:,:,jk) = rau0 * v_eiv(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 234 END DO 235 CALL iom_put( "veiv_masstr", z3d ) ! mass transport in j-direction 175 236 ENDIF 176 237 177 IF( iom_use('veiv_heattr') ) THEN178 zztmp = 0.5 * r au0 * rcp238 IF( iom_use('veiv_heattr') .OR. iom_use('veiv_heattr3d') ) THEN 239 zztmp = 0.5 * rcp 179 240 z2d(:,:) = 0.e0 180 DO jk = 1, jpkm1 181 DO jj = 2, jpjm1 182 DO ji = fs_2, fs_jpim1 ! vector opt. 183 z2d(ji,jj) = z2d(ji,jj) + v_eiv(ji,jj,jk) & 184 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk) 185 END DO 186 END DO 187 END DO 188 CALL lbc_lnk( z2d, 'V', -1. ) 189 CALL iom_put( "veiv_heattr", zztmp * z2d ) ! heat transport in i-direction 190 ENDIF 241 z3d_T(:,:,:) = 0.e0 242 DO jk = 1, jpkm1 243 DO jj = 2, jpjm1 244 DO ji = fs_2, fs_jpim1 ! vector opt. 245 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 246 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 247 END DO 248 END DO 249 END DO 250 IF (iom_use('veiv_heattr') ) THEN 251 CALL lbc_lnk( z2d, 'V', -1. ) 252 CALL iom_put( "veiv_heattr", zztmp * z2d ) ! 2D heat transport in j-direction 253 ENDIF 254 IF (iom_use('veiv_heattr3d') ) THEN 255 CALL lbc_lnk( z3d_T, 'V', -1. ) 256 CALL iom_put( "veiv_heattr3d", zztmp * z3d_T ) ! 3D heat transport in j-direction 257 ENDIF 258 ENDIF 259 260 IF( iom_use('veiv_salttr') .OR. iom_use('veiv_salttr3d') ) THEN 261 zztmp = 0.5 * 0.001 262 z2d(:,:) = 0.e0 263 z3d_T(:,:,:) = 0.e0 264 DO jk = 1, jpkm1 265 DO jj = 2, jpjm1 266 DO ji = fs_2, fs_jpim1 ! vector opt. 267 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 268 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 269 END DO 270 END DO 271 END DO 272 IF (iom_use('veiv_salttr') ) THEN 273 CALL lbc_lnk( z2d, 'V', -1. ) 274 CALL iom_put( "veiv_salttr", zztmp * z2d ) ! 2D salt transport in i-direction 275 ENDIF 276 IF (iom_use('veiv_salttr3d') ) THEN 277 CALL lbc_lnk( z3d_T, 'V', -1. ) 278 CALL iom_put( "veiv_salttr3d", zztmp * z3d_T ) ! 3D salt transport in i-direction 279 ENDIF 280 ENDIF 281 282 IF( iom_use('weiv_masstr') .OR. iom_use('weiv_heattr3d') .OR. iom_use('weiv_salttr3d')) THEN ! vertical mass transport & its square value 283 z2d(:,:) = rau0 * e12t(:,:) 284 DO jk = 1, jpk 285 z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 286 END DO 287 CALL iom_put( "weiv_masstr" , z3d ) ! mass transport in k-direction 288 ENDIF 289 290 IF( iom_use('weiv_heattr3d') ) THEN 291 zztmp = 0.5 * rcp 292 DO jk = 1, jpkm1 293 DO jj = 2, jpjm1 294 DO ji = fs_2, fs_jpim1 ! vector opt. 295 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj,jk+1,jp_tem) ) 296 END DO 297 END DO 298 END DO 299 CALL lbc_lnk( z3d_T, 'T', 1. ) 300 CALL iom_put( "weiv_heattr3d", zztmp * z3d_T ) ! 3D heat transport in k-direction 301 ENDIF 302 303 IF( iom_use('weiv_salttr3d') ) THEN 304 zztmp = 0.5 * 0.001 305 DO jk = 1, jpkm1 306 DO jj = 2, jpjm1 307 DO ji = fs_2, fs_jpim1 ! vector opt. 308 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj,jk+1,jp_sal) ) 309 END DO 310 END DO 311 END DO 312 CALL lbc_lnk( z3d_T, 'T', 1. ) 313 CALL iom_put( "weiv_salttr3d", zztmp * z3d_T ) ! 3D salt transport in k-direction 314 ENDIF 315 191 316 END IF 317 ! 318 IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 319 z3d(:,:,:) = 0._wp 320 DO jk = 1, jpkm1 321 DO jj = 2, jpjm1 322 DO ji = fs_2, fs_jpim1 ! vector opt. 323 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 324 & * e1v(ji,jj) * fse3v(ji,jj,jk) 325 END DO 326 END DO 327 END DO 328 CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 329 z3d(:,:,:) = 0._wp 330 DO jk = 1, jpkm1 331 DO jj = 2, jpjm1 332 DO ji = fs_2, fs_jpim1 ! vector opt. 333 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 334 & * e1v(ji,jj) * fse3v(ji,jj,jk) 335 END DO 336 END DO 337 END DO 338 CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 339 ENDIF 340 341 IF( ln_KE_trd ) CALL trd_dyn(u_eiv, v_eiv, jpdyn_eivke, kt ) 192 342 # endif 193 ! 343 194 344 # if defined key_diaeiv 195 345 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 346 CALL wrk_dealloc( jpi, jpj, jpk, z3d, z3d_T ) 196 347 # else 197 348 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv )
Note: See TracChangeset
for help on using the changeset viewer.
