- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r6140 r8882 25 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 26 USE timing ! preformance summary 27 USE wrk_nemo ! working array28 27 29 28 IMPLICIT NONE … … 58 57 INTEGER :: ji, jj, jk ! dummy loop indices 59 58 REAL(wp) :: z2dcrsu, z2dcrsv ! local scalars 60 ! 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e3 62 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zt_crs 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs, zs_crs 59 REAL(wp) :: zztmp ! - - 60 ! 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e3 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zt , zs , z3d 63 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) :: zt_crs, zs_crs 64 64 !!---------------------------------------------------------------------- 65 65 ! 66 66 IF( nn_timing == 1 ) CALL timing_start('crs_fld') 67 68 ! Initialize arrays69 CALL wrk_alloc( jpi,jpj,jpk, ze3t, ze3w )70 CALL wrk_alloc( jpi,jpj,jpk, ze3u, ze3v )71 CALL wrk_alloc( jpi,jpj,jpk, zt , zs )72 !73 CALL wrk_alloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs )74 67 75 68 ! Depth work arrrays … … 84 77 vn_crs (:,:,: ) = 0._wp ! v-velocity 85 78 wn_crs (:,:,: ) = 0._wp ! w 86 av t_crs (:,:,: ) = 0._wp ! avt79 avs_crs (:,:,: ) = 0._wp ! avt 87 80 hdivn_crs(:,:,: ) = 0._wp ! hdiv 88 rke_crs (:,:,: ) = 0._wp ! rke89 81 sshn_crs (:,: ) = 0._wp ! ssh 90 82 utau_crs (:,: ) = 0._wp ! taux … … 158 150 CALL iom_put( "voces" , zs_crs ) ! vS 159 151 160 161 ! Kinetic energy 162 CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 163 CALL iom_put( "eken", rke_crs ) 164 152 IF( iom_use( "eken") ) THEN ! kinetic energy 153 z3d(:,:,jk) = 0._wp 154 DO jk = 1, jpkm1 155 DO jj = 2, jpjm1 156 DO ji = fs_2, fs_jpim1 ! vector opt. 157 zztmp = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 158 z3d(ji,jj,jk) = 0.25_wp * zztmp * ( & 159 & un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 160 & + un(ji ,jj,jk)**2 * e2u(ji ,jj) * e3u_n(ji ,jj,jk) & 161 & + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 162 & + vn(ji,jj ,jk)**2 * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) 163 END DO 164 END DO 165 END DO 166 CALL lbc_lnk( z3d, 'T', 1. ) 167 ! 168 CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 169 CALL iom_put( "eken", zt_crs ) 170 ENDIF 165 171 ! Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 ) 166 172 DO jk = 1, jpkm1 … … 175 181 hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 176 182 ENDIF 177 END DO178 END DO179 END DO183 END DO 184 END DO 185 END DO 180 186 CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 ) 181 187 ! … … 196 202 ! free memory 197 203 198 ! avt, avs 199 !!gm BUG TOP always uses avs !!! 204 ! avs 200 205 SELECT CASE ( nn_crs_kz ) 201 206 CASE ( 0 ) 202 207 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 208 CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 203 209 CASE ( 1 ) 204 210 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 211 CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 205 212 CASE ( 2 ) 206 213 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 214 CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 207 215 END SELECT 208 216 ! 209 CALL iom_put( "avt", avt_crs ) ! Kz 217 CALL iom_put( "avt", avt_crs ) ! Kz on T 218 CALL iom_put( "avs", avs_crs ) ! Kz on S 210 219 211 220 ! sbc fields … … 231 240 CALL iom_put( "ice_cover", fr_i_crs ) ! ice cover output 232 241 233 ! free memory234 CALL wrk_dealloc( jpi,jpj,jpk, ze3t, ze3w )235 CALL wrk_dealloc( jpi,jpj,jpk, ze3u, ze3v )236 CALL wrk_dealloc( jpi,jpj,jpk, zt , zs )237 CALL wrk_dealloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs )238 242 ! 239 243 CALL iom_swap( "nemo" ) ! return back on high-resolution grid
Note: See TracChangeset
for help on using the changeset viewer.