- Timestamp:
- 2014-11-28T18:24:01+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4747 r4924 45 45 USE diadimg ! dimg direct access file format output 46 46 USE diaar5, ONLY : lk_diaar5 47 USE dynadv, ONLY : ln_dynadv_vec48 47 USE iom 49 48 USE ioipsl … … 131 130 REAL(wp) :: zztmp, zztmpx, zztmpy ! 132 131 !! 133 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 132 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 133 REAL(wp), POINTER, DIMENSION(:,:) :: z2ds ! 2D workspace 134 134 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace 135 135 !!---------------------------------------------------------------------- … … 137 137 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 138 138 ! 139 CALL wrk_alloc( jpi , jpj , z2d )139 CALL wrk_alloc( jpi , jpj , z2d , z2ds ) 140 140 CALL wrk_alloc( jpi , jpj, jpk , z3d ) 141 141 ! … … 234 234 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 235 235 236 ! clem: heat and salt content 237 z2d(:,:) = 0._wp 238 z2ds(:,:) = 0._wp 239 DO jk = 1, jpkm1 240 DO jj = 2, jpjm1 241 DO ji = fs_2, fs_jpim1 ! vector opt. 242 z2d(ji,jj) = z2d(ji,jj) + rau0 * rcp * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 243 z2ds(ji,jj) = z2ds(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 244 END DO 245 END DO 246 END DO 247 CALL lbc_lnk( z2d, 'T', 1. ) 248 CALL lbc_lnk( z2ds, 'T', 1. ) 249 CALL iom_put( "heatc", z2d ) ! vertically integrated heat content (J/m2) 250 CALL iom_put( "saltc", z2ds ) ! vertically integrated salt content (PSU*kg/m2) 251 252 ! 253 rke(:,:,jk) = 0._wp ! kinetic energy 254 DO jk = 1, jpkm1 255 DO jj = 2, jpjm1 256 DO ji = fs_2, fs_jpim1 ! vector opt. 257 zztmp = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 258 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) & 259 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * fse3u(ji ,jj,jk) ) & 260 & * zztmp 261 ! 262 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) & 263 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * fse3v(ji,jj ,jk) ) & 264 & * zztmp 265 ! 266 rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 267 ! 268 ENDDO 269 ENDDO 270 ENDDO 271 CALL lbc_lnk( rke, 'T', 1. ) 272 CALL iom_put( "eken", rke ) 273 236 274 IF( lk_diaar5 ) THEN 237 275 z3d(:,:,jpk) = 0.e0 238 276 DO jk = 1, jpkm1 239 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 277 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 240 278 END DO 241 279 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 280 242 281 zztmp = 0.5 * rcp 243 282 z2d(:,:) = 0.e0 283 z2ds(:,:) = 0.e0 244 284 DO jk = 1, jpkm1 245 285 DO jj = 2, jpjm1 246 286 DO ji = fs_2, fs_jpim1 ! vector opt. 247 287 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 288 z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 248 289 END DO 249 290 END DO 250 291 END DO 251 292 CALL lbc_lnk( z2d, 'U', -1. ) 293 CALL lbc_lnk( z2ds, 'U', -1. ) 252 294 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction 295 CALL iom_put( "u_salttr", z2ds ) ! salt transport in i-direction 296 297 z3d(:,:,jpk) = 0.e0 253 298 DO jk = 1, jpkm1 254 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 299 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 255 300 END DO 256 301 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 302 257 303 z2d(:,:) = 0.e0 304 z2ds(:,:) = 0.e0 258 305 DO jk = 1, jpkm1 259 306 DO jj = 2, jpjm1 260 307 DO ji = fs_2, fs_jpim1 ! vector opt. 261 308 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 309 z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 262 310 END DO 263 311 END DO 264 312 END DO 265 313 CALL lbc_lnk( z2d, 'V', -1. ) 266 CALL iom_put( "v_heattr", z2d ) ! heat transport in i-direction 267 ENDIF 268 ! 269 CALL wrk_dealloc( jpi , jpj , z2d ) 314 CALL lbc_lnk( z2ds, 'V', -1. ) 315 CALL iom_put( "v_heattr", z2d ) ! heat transport in j-direction 316 CALL iom_put( "v_salttr", z2ds ) ! salt transport in j-direction 317 ENDIF 318 ! 319 CALL wrk_dealloc( jpi , jpj , z2d , z2ds ) 270 320 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 271 321 !
Note: See TracChangeset
for help on using the changeset viewer.