Changeset 4921 for branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
- Timestamp:
- 2014-11-28T14:59:01+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4570 r4921 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 ! … … 193 193 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 194 194 195 ! clem: heat and salt content 196 z2d(:,:) = 0._wp 197 z2ds(:,:) = 0._wp 198 DO jk = 1, jpkm1 199 DO jj = 2, jpjm1 200 DO ji = fs_2, fs_jpim1 ! vector opt. 201 z2d(ji,jj) = z2d(ji,jj) + rau0 * rcp * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 202 z2ds(ji,jj) = z2ds(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 203 END DO 204 END DO 205 END DO 206 CALL lbc_lnk( z2d, 'T', 1. ) 207 CALL lbc_lnk( z2ds, 'T', 1. ) 208 CALL iom_put( "heatc", z2d ) ! vertically integrated heat content (J/m2) 209 CALL iom_put( "saltc", z2ds ) ! vertically integrated salt content (PSU*kg/m2) 210 211 ! 212 rke(:,:,jk) = 0._wp ! kinetic energy 213 DO jk = 1, jpkm1 214 DO jj = 2, jpjm1 215 DO ji = fs_2, fs_jpim1 ! vector opt. 216 zztmp = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 217 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) & 218 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * fse3u(ji ,jj,jk) ) & 219 & * zztmp 220 ! 221 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) & 222 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * fse3v(ji,jj ,jk) ) & 223 & * zztmp 224 ! 225 rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 226 ! 227 ENDDO 228 ENDDO 229 ENDDO 230 CALL lbc_lnk( rke, 'T', 1. ) 231 CALL iom_put( "eken", rke ) 232 195 233 IF( lk_diaar5 ) THEN 196 234 z3d(:,:,jpk) = 0.e0 197 235 DO jk = 1, jpkm1 198 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 236 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 199 237 END DO 200 238 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 239 201 240 zztmp = 0.5 * rcp 202 241 z2d(:,:) = 0.e0 242 z2ds(:,:) = 0.e0 203 243 DO jk = 1, jpkm1 204 244 DO jj = 2, jpjm1 205 245 DO ji = fs_2, fs_jpim1 ! vector opt. 206 246 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 247 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) ) 207 248 END DO 208 249 END DO 209 250 END DO 210 251 CALL lbc_lnk( z2d, 'U', -1. ) 252 CALL lbc_lnk( z2ds, 'U', -1. ) 211 253 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction 254 CALL iom_put( "u_salttr", z2ds ) ! salt transport in i-direction 255 256 z3d(:,:,jpk) = 0.e0 212 257 DO jk = 1, jpkm1 213 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 258 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 214 259 END DO 215 260 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 261 216 262 z2d(:,:) = 0.e0 263 z2ds(:,:) = 0.e0 217 264 DO jk = 1, jpkm1 218 265 DO jj = 2, jpjm1 219 266 DO ji = fs_2, fs_jpim1 ! vector opt. 220 267 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 268 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) ) 221 269 END DO 222 270 END DO 223 271 END DO 224 272 CALL lbc_lnk( z2d, 'V', -1. ) 225 CALL iom_put( "v_heattr", z2d ) ! heat transport in i-direction 226 ENDIF 227 ! 228 CALL wrk_dealloc( jpi , jpj , z2d ) 273 CALL lbc_lnk( z2ds, 'V', -1. ) 274 CALL iom_put( "v_heattr", z2d ) ! heat transport in j-direction 275 CALL iom_put( "v_salttr", z2ds ) ! salt transport in j-direction 276 ENDIF 277 ! 278 CALL wrk_dealloc( jpi , jpj , z2d , z2ds ) 229 279 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 230 280 !
Note: See TracChangeset
for help on using the changeset viewer.