Changeset 4761 for trunk/NEMOGCM
- Timestamp:
- 2014-09-08T15:27:51+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4570 r4761 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 195 212 IF( lk_diaar5 ) THEN 196 213 z3d(:,:,jpk) = 0.e0 197 214 DO jk = 1, jpkm1 198 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 215 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 199 216 END DO 200 217 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 218 201 219 zztmp = 0.5 * rcp 202 220 z2d(:,:) = 0.e0 221 z2ds(:,:) = 0.e0 203 222 DO jk = 1, jpkm1 204 223 DO jj = 2, jpjm1 205 224 DO ji = fs_2, fs_jpim1 ! vector opt. 206 225 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 226 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 227 END DO 208 228 END DO 209 229 END DO 210 230 CALL lbc_lnk( z2d, 'U', -1. ) 231 CALL lbc_lnk( z2ds, 'U', -1. ) 211 232 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction 233 CALL iom_put( "u_salttr", z2ds ) ! salt transport in i-direction 234 235 z3d(:,:,jpk) = 0.e0 212 236 DO jk = 1, jpkm1 213 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 237 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 214 238 END DO 215 239 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 240 216 241 z2d(:,:) = 0.e0 242 z2ds(:,:) = 0.e0 217 243 DO jk = 1, jpkm1 218 244 DO jj = 2, jpjm1 219 245 DO ji = fs_2, fs_jpim1 ! vector opt. 220 246 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,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,jj+1,jk,jp_sal) ) 221 248 END DO 222 249 END DO 223 250 END DO 224 251 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 ) 252 CALL lbc_lnk( z2ds, 'V', -1. ) 253 CALL iom_put( "v_heattr", z2d ) ! heat transport in j-direction 254 CALL iom_put( "v_salttr", z2ds ) ! salt transport in j-direction 255 ENDIF 256 ! 257 CALL wrk_dealloc( jpi , jpj , z2d , z2ds ) 229 258 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 230 259 !
Note: See TracChangeset
for help on using the changeset viewer.