- Timestamp:
- 2017-05-30T10:13:14+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r7953 r8093 29 29 USE dynadv, ONLY: ln_dynadv_vec 30 30 USE zdf_oce ! ocean vertical physics 31 USE zdfdrg ! ocean vertical physics: top/bottom friction 31 32 USE ldftra ! lateral physics: eddy diffusivity coef. 32 33 USE ldfdyn ! lateral physics: eddy viscosity coef. … … 119 120 !! ** Method : use iom_put 120 121 !!---------------------------------------------------------------------- 121 !!122 122 INTEGER, INTENT( in ) :: kt ! ocean time-step index 123 123 !! 124 INTEGER :: ji, jj, jk! dummy loop indices125 INTEGER :: jkbot !126 REAL(wp) :: zztmp, zztmpx, zztmpy !127 !!128 REAL(wp), POINTER, DIMENSION(:,:) :: z2d! 2D workspace129 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d! 3D workspace124 INTEGER :: ji, jj, jk ! dummy loop indices 125 INTEGER :: ikbot ! local integer 126 REAL(wp):: zztmp , zztmpx ! local scalar 127 REAL(wp):: zztmp2, zztmpy ! - - 128 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 129 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 130 130 !!---------------------------------------------------------------------- 131 131 ! 132 132 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 133 133 ! 134 CALL wrk_alloc( jpi , jpj , z2d )135 CALL wrk_alloc( jpi , jpj, jpk , z3d )136 !137 134 ! Output the initial state and forcings 138 135 IF( ninist == 1 ) THEN … … 162 159 DO jj = 1, jpj 163 160 DO ji = 1, jpi 164 jkbot = mbkt(ji,jj)165 z2d(ji,jj) = tsn(ji,jj, jkbot,jp_tem)161 ikbot = mbkt(ji,jj) 162 z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem) 166 163 END DO 167 164 END DO … … 174 171 DO jj = 1, jpj 175 172 DO ji = 1, jpi 176 jkbot = mbkt(ji,jj)177 z2d(ji,jj) = tsn(ji,jj, jkbot,jp_sal)173 ikbot = mbkt(ji,jj) 174 z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal) 178 175 END DO 179 176 END DO … … 182 179 183 180 IF ( iom_use("taubot") ) THEN ! bottom stress 181 zztmp = rau0 * 0.25 184 182 z2d(:,:) = 0._wp 185 183 DO jj = 2, jpjm1 186 184 DO ji = fs_2, fs_jpim1 ! vector opt. 185 !!gm old 186 !!gm BUG missing x 0.5 187 187 zztmpx = ( bfrua(ji ,jj) * un(ji ,jj,mbku(ji ,jj)) & 188 188 & + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj)) ) … … 190 190 & + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1)) ) 191 191 z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1) 192 !!gm 193 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * un(ji ,jj,mbku(ji ,jj)) )**2 & 194 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * un(ji-1,jj,mbku(ji-1,jj)) )**2 & 195 & + ( ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj ) ) * vn(ji,jj ,mbkv(ji,jj )) )**2 & 196 & + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vn(ji,jj-1,mbkv(ji,jj-1)) )**2 197 z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 198 !!gm new end 192 199 ! 193 200 ENDDO … … 202 209 DO jj = 1, jpj 203 210 DO ji = 1, jpi 204 jkbot = mbku(ji,jj)205 z2d(ji,jj) = un(ji,jj, jkbot)211 ikbot = mbku(ji,jj) 212 z2d(ji,jj) = un(ji,jj,ikbot) 206 213 END DO 207 214 END DO … … 214 221 DO jj = 1, jpj 215 222 DO ji = 1, jpi 216 jkbot = mbkv(ji,jj)217 z2d(ji,jj) = vn(ji,jj, jkbot)223 ikbot = mbkv(ji,jj) 224 z2d(ji,jj) = vn(ji,jj,ikbot) 218 225 END DO 219 226 END DO … … 281 288 ! 282 289 IF ( iom_use("eken") ) THEN 283 rke(:,:,jk) = 0._wp ! kinetic energy290 z3d(:,:,jk) = 0._wp ! kinetic energy 284 291 DO jk = 1, jpkm1 285 292 DO jj = 2, jpjm1 286 293 DO ji = fs_2, fs_jpim1 ! vector opt. 287 zztmp = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 288 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 289 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * e3u_n(ji ,jj,jk) ) & 290 & * zztmp 291 ! 292 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 293 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) & 294 & * zztmp 295 ! 296 rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 297 ! 298 ENDDO 299 ENDDO 300 ENDDO 301 CALL lbc_lnk( rke, 'T', 1. ) 302 CALL iom_put( "eken", rke ) 294 zztmp = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 295 z3d(ji,jj,jk) = 0.25_wp * zztmp * ( & 296 & un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 297 & + un(ji ,jj,jk)**2 * e2u(ji ,jj) * e3u_n(ji ,jj,jk) & 298 & + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 299 & + vn(ji,jj ,jk)**2 * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) 300 END DO 301 END DO 302 END DO 303 CALL lbc_lnk( z3d, 'T', 1. ) 304 CALL iom_put( "eken", z3d ) 303 305 ENDIF 304 306 ! … … 407 409 CALL iom_put( "bn2", rn2 ) !Brunt-Vaisala buoyancy frequency (N^2) 408 410 ! 409 CALL wrk_dealloc( jpi , jpj , z2d ) 410 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 411 ! 412 ! If we want tmb values 413 414 IF (ln_diatmb) THEN 411 412 IF (ln_diatmb) THEN ! If we want tmb values 415 413 CALL dia_tmb 416 414 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
