- Timestamp:
- 2015-07-16T11:04:29+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r5105 r5601 17 17 USE zdf_oce ! vertical physics: ocean fields 18 18 USE zdfddm ! vertical physics: double diffusion 19 USe zdfmxl 19 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 21 USE in_out_manager ! I/O manager … … 25 26 USE crslbclnk 26 27 USE iom 28 USE zdfmxl_crs 27 29 28 30 IMPLICIT NONE … … 64 66 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 65 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs 68 REAL(wp), POINTER, DIMENSION(:,:) :: z2d,z2d_crs 66 69 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 67 70 REAL(wp) :: z2dcrsu, z2dcrsv … … 71 74 INTEGER :: iji,ijj 72 75 !! 73 !!---------------------------------------------------------------------- 74 ! 75 !IF(narea==267)WRITE(narea+5000,*)"========================================> crsfldt ",kt 76 !!---------------------------------------------------------------------- 76 77 77 78 IF( nn_timing == 1 ) CALL timing_start('crs_fld') … … 80 81 CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w ) 81 82 CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v ) 82 CALL wrk_alloc( jpi, jpj, jpk, zt, zs ) 83 CALL wrk_alloc( jpi, jpj, jpk, zt, zs ) 84 CALL wrk_alloc( jpi, jpj, z2d ) 83 85 ! 84 86 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 87 CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs ) 85 88 86 89 ! Depth work arrrays … … 130 133 zs(:,:,:) = tsb(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp 131 134 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 132 tsb_crs(:,:,:,jp_sal) = z t_crs(:,:,:)135 tsb_crs(:,:,:,jp_sal) = zs_crs(:,:,:) 133 136 zs(:,:,:) = tsn(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp 134 137 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 135 tsn_crs(:,:,:,jp_sal) = z t_crs(:,:,:)138 tsn_crs(:,:,:,jp_sal) = zs_crs(:,:,:) 136 139 137 140 CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) ) ! sal … … 162 165 163 166 ! V-velocity 164 !IF(narea==267)WRITE(narea+5000,*)"deg vb_crs"165 167 CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 166 !IF(narea==267)WRITE(narea+5000,*)"deg vn_crs"167 168 CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 168 !IF(narea==267)WRITE(narea+5000,*)"1 vn_crs(17,5,74) = ",vn_crs(17,5,74),vmask_crs(17,5,74),vn(46,13,74),vn(47,13,74),vn(48,13,74)169 169 vb_crs(:,:,:) = vb_crs(:,:,:)*vmask_crs(:,:,:) 170 170 vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:) 171 !IF(narea==267)WRITE(narea+5000,*)"2 vn_crs(17,5,74) = ",vn_crs(17,5,74),vmask_crs(17,5,74),vn(46,13,74),vn(47,13,74),vn(48,13,74)172 171 ! 173 172 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 209 208 ! 210 209 !cbr 211 !212 210 !bug1: il manquait le facvol_t(ji,jj,jk) ds la division ; ca creait des grosses erreurs de Wcrs ( vu en recalculant la divergence 3D ) 213 211 !bug2: mm test que bug1: on n'obtient tjs pas zero … … 215 213 !exp (117,211,74) : e1*e2*e3=235206030060.005 / ocean_volume_crs_t * facvol = 235205585307.810 216 214 ! e1*e2*e3-cean_volume_crs_t * facvol/(cean_volume_crs_t * facvol) ~1.e-6) 217 !IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk))218 !IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk))219 215 IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) 220 216 221 !iji=117 ; ijj=211222 !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1223 !IF( ji==iji .AND. jj==ijj )THEN224 !WRITE(narea+5000,*)"hdivn_crs =======> "225 !WRITE(narea+5000,*) "u" ,jk,un_crs(ji ,jj ,jk) ,e2e3u_msk(ji ,jj ,jk),un_crs(ji ,jj ,jk)*e2e3u_msk(ji ,jj ,jk)226 !WRITE(narea+5000,*) "um1",jk,un_crs(ji-1,jj ,jk) , e2e3u_msk(ji-1,jj ,jk),un_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk)227 !WRITE(narea+5000,*) "v",jk,vn_crs(ji ,jj ,jk) , e1e3v_msk(ji ,jj ,jk),vn_crs(ji ,jj ,jk) * e1e3v_msk(ji ,jj ,jk)228 !WRITE(narea+5000,*) "vm1",jk,vn_crs(ji ,jj-1,jk) , e1e3v_msk(ji ,jj-1,jk),vn_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk)229 !WRITE(narea+5000,*) "t1 ",jk,z2dcrsu,z2dcrsv, z2dcrsu + z2dcrsv,hdivn_crs(ji,jj,jk)230 !WRITE(narea+5000,*) "t2 ",jk,e1t_crs(ji,jj),e2t_crs(ji,jj),e3t_crs(ji,jj,jk),e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk)231 !WRITE(narea+5000,*) "t3 ",jk,ocean_volume_crs_t(ji,jj,jk),facvol_t(ji,jj,jk),facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk)232 !WRITE(narea+5000,*) "t4 ",jk, ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk))233 !WRITE(narea+5000,*) "t5 ",jk, ( z2dcrsu + z2dcrsv ) / (e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk))234 !ENDIF235 236 237 !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)238 217 z2dcrsu = ( ub_crs(ji ,jj ,jk) * e2e3u_msk(ji ,jj ,jk) ) & 239 218 & - ( ub_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) ) … … 251 230 252 231 253 ! DO jk = 1, jpkm1 ! Interior value254 ! DO jj = 1, jpj_crs255 ! DO ji = 1, jpi_crs256 ! IF( e3t_crs(ji,jj,jk) .NE. e3t_crs(ji,jj,jk) )WRITE(narea+200,*)"e3t_crs",e3t_crs(ji,jj,jk) ; call flush(narea+200)257 ! IF( hdivn_crs(ji,jj,jk) .NE. hdivn_crs(ji,jj,jk) )WRITE(narea+200,*)"hdivn_crs",hdivn_crs(ji,jj,jk) ; call flush(narea+200)258 ! END DO259 ! END DO260 ! END DO261 262 232 ! W-velocity 263 233 IF( ln_crs_wn ) THEN … … 266 236 wn_crs(:,:,jpk) = 0._wp 267 237 DO jk = jpkm1, 1, -1 268 !cbr wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)269 238 wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk) 270 239 WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp ) wn_crs(:,:,jk) = wn_crs(:,:,jk) /e1e2w_msk(:,:,jk) … … 286 255 ! 287 256 CALL iom_put( "avt", avt_crs ) ! Kz 288 257 258 !deja dasn step CALL zdf_mxl_crs(kt) 259 260 289 261 ! sbc fields 290 262 … … 303 275 CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 304 276 277 z2d=REAL(nmln,wp) 278 CALL crs_dom_ope( z2d , 'MAX', 'T', tmask, z2d_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 279 nmln_crs=INT(z2d_crs) 280 nmln_crs=MAX(nlb10,nmln_crs) 281 305 282 CALL iom_put( "ssh" , sshn_crs ) ! ssh output 306 283 CALL iom_put( "utau" , utau_crs ) ! i-tau output … … 313 290 CALL iom_put( "ice_cover", fr_i_crs ) ! ice cover output 314 291 315 !cbr316 !IF(narea==267)WRITE(narea+5000,*)"vn_crs(17,5,74) = ",vn_crs(17,5,74)317 !ji=117 ; jj=211 ; jk=74318 !ji=ji-nimpp_crs+1 ; jj=jj-njmpp_crs+1319 !IF( ji .GE. 2 .AND. ji .LE. jpi_crs-1 .AND. jj .GE. 2 .AND. jj .LE. jpj_crs-1 )THEN320 !WRITE(narea+5000,*)"=======> kt ",kt321 !WRITE(narea+5000,*)ji,jj,glamt(ji,jj),gphit(ji,jj)322 !WRITE(narea+5000,*)"um1 crs ",umask_crs(ji-1,jj,jk),e2e3u_msk(ji-1,jj,jk),un_crs(ji-1,jj,jk),umask_crs(ji-1,jj,jk)*e2e3u_msk(ji-1,jj,jk)*un_crs(ji-1,jj,jk)323 !WRITE(narea+5000,*)"u crs ",umask_crs(ji,jj,jk),e2e3u_msk(ji,jj,jk),un_crs(ji,jj,jk),umask_crs(ji,jj,jk)*e2e3u_msk(ji,jj,jk)*un_crs(ji,jj,jk)324 !WRITE(narea+5000,*)"vm1 crs ",vmask_crs(ji,jj-1,jk),e1e3v_msk(ji,jj-1,jk),vn_crs(ji,jj-1,jk),vmask_crs(ji,jj-1,jk)*e1e3v_msk(ji,jj-1,jk)*vn_crs(ji,jj-1,jk)325 !WRITE(narea+5000,*)"v crs ",vmask_crs(ji,jj,jk),e1e3v_msk(ji,jj,jk),vn_crs(ji,jj,jk),vmask_crs(ji,jj,jk)*e1e3v_msk(ji,jj,jk)*vn_crs(ji,jj,jk)326 !WRITE(narea+5000,*)"wp1 crs ",tmask_crs(ji,jj,jk+1),e1e2w_msk(ji,jj,jk+1),wn_crs(ji,jj,jk+1),tmask_crs(ji,jj,jk+1)*e1e2w_msk(ji,jj,jk+1)*wn_crs(ji,jj,jk+1)327 !WRITE(narea+5000,*)"w crs ",tmask_crs(ji,jj,jk),e1e2w_msk(ji,jj,jk),wn_crs(ji,jj,jk),tmask_crs(ji,jj,jk)*e1e2w_msk(ji,jj,jk)*wn_crs(ji,jj,jk)328 !z = umask_crs(ji,jj,jk)*e2e3u_msk(ji,jj,jk)*un_crs(ji,jj,jk) - umask_crs(ji-1,jj,jk)*e2e3u_msk(ji-1,jj,jk)*un_crs(ji-1,jj,jk) + &329 ! vmask_crs(ji,jj,jk)*e1e3v_msk(ji,jj,jk)*vn_crs(ji,jj,jk) - vmask_crs(ji,jj-1,jk)*e1e3v_msk(ji,jj-1,jk)*vn_crs(ji,jj-1,jk) + &330 ! tmask_crs(ji,jj,jk)*e1e2w_msk(ji,jj,jk)*wn_crs(ji,jj,jk) - tmask_crs(ji,jj,jk+1)*e1e2w_msk(ji,jj,jk+1)*wn_crs(ji,jj,jk+1)331 !WRITE(narea+5000,*)"sum ",z332 !ijie = mie_crs(ji)333 !ijis = mis_crs(ji)334 !ijje = mje_crs(jj)335 !ijjs = mjs_crs(jj)336 !DO i=ijis,ijie337 ! DO j=ijjs,ijje338 ! WRITE(narea+5000,*)"tmask",i,j,tmask(i,j,jk)339 ! ENDDO340 !ENDDO341 342 !z=0._wp343 !zsm=0._wp344 !DO i=ijis,ijie345 ! DO j=ijjs,ijje346 ! WRITE(narea+5000,*)"w",i,j,tmask(i,j,jk),e1t(i,j),e2t(i,j),e1t(i,j)*e2t(i,j),wn(i,j,jk)347 ! z=z+tmask(i,j,jk)*e1t(i,j)*e2t(i,j)*wn(i,j,jk)348 ! zsm=zsm+tmask(i,j,jk)*e1t(i,j)*e2t(i,j)349 ! ENDDO350 !ENDDO351 352 !zw=z353 !WRITE(narea+5000,*)"w sum ",zsm,zw354 !z=0._wp355 !zsm=0._wp356 !DO i=ijis,ijie357 ! DO j=ijjs,ijje358 ! WRITE(narea+5000,*)"wp1 ",i,j,tmask(i,j,jk+1),e1t(i,j),e2t(i,j),e1t(i,j)*e2t(i,j),wn(i,j,jk+1)359 ! z=z+tmask(i,j,jk+1)*e1t(i,j)*e2t(i,j)*wn(i,j,jk+1)360 ! zsm=zsm+tmask(i,j,jk+1)*e1t(i,j)*e2t(i,j)361 ! ENDDO362 !ENDDO363 !zwp1=z364 !WRITE(narea+5000,*)"wp1 sum ",zsm,zwp1365 !z=0._wp366 !zsm=0._wp367 !i=ijis-1368 !DO j=ijjs,ijje369 ! WRITE(narea+5000,*)"um1",i,j,umask(i,j,jk),e2u(i,j),e3u_0(i,j,jk),e2u(i,j)*e3u_0(i,j,jk),un(i,j,jk)370 ! z=z+e2u(i,j)*e3u_0(i,j,jk)*un(i,j,jk)371 ! zsm=zsm+e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk)372 !ENDDO373 !zum1=z374 !WRITE(narea+5000,*)"um1 sum ",zsm,zum1375 !z=0._wp376 !zsm=0._wp377 !i=ijie378 !DO j=ijjs,ijje379 ! WRITE(narea+5000,*)"u",i,j,umask(i,j,jk),e2u(i,j),e3u_0(i,j,jk),e2u(i,j)*e3u_0(i,j,jk),un(i,j,jk)380 ! z=z+e2u(i,j)*e3u_0(i,j,jk)*un(i,j,jk)381 ! zsm=zsm+e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk)382 !ENDDO383 !zu=z384 !WRITE(narea+5000,*)"u sum ",zsm,zu385 !z=0._wp386 !zsm=0._wp387 !j=ijjs-1388 !DO i=ijis,ijie389 ! WRITE(narea+5000,*)"vm1",i,j,vmask(i,j,jk),e1v(i,j),e3v_0(i,j,jk),e1v(i,j)*e3v_0(i,j,jk),vn(i,j,jk)390 ! z=z+e1v(i,j)*e3v_0(i,j,jk)*vn(i,j,jk)391 ! zsm=zsm+e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk)392 !ENDDO393 !zvm1=z394 !WRITE(narea+5000,*)"vm1 sum ",zsm,zvm1395 !z=0._wp396 !zsm=0._wp397 !j=ijje398 !DO i=ijis,ijie399 ! WRITE(narea+5000,*)"v",i,j,vmask(i,j,jk),e1v(i,j),e3v_0(i,j,jk),e1v(i,j)*e3v_0(i,j,jk),vn(i,j,jk)400 ! z=z+e1v(i,j)*e3v_0(i,j,jk)*vn(i,j,jk)401 ! zsm=zsm+e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk)402 !ENDDO403 !zv=z404 !WRITE(narea+5000,*)"v sum ",zv405 !WRITE(narea+5000,*)"sum ",zw+zwp1+zum1+zu+zvm1+zv406 !DO i=ijis,ijie407 ! DO j=ijjs,ijje408 ! WRITE(narea+5000,*)"msk",i,j,tmask(i,j,jk),umask(i,j,jk),vmask(i,j,jk)409 ! WRITE(narea+5000,*)"vel",i,j,un(i,j,jk),vn(i,j,jk),wn(i,j,jk)410 ! ENDDO411 !ENDDO412 413 !DO i=ijis,ijie414 ! DO j=ijjs,ijje415 ! z = un(i,j,jk)*e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk) - un(i-1,j,jk)*e2u(i-1,j)*e3u_0(i-1,j,jk)*umask(i-1,j,jk) + &416 ! vn(i,j,jk)*e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk) - vn(i,j-1,jk)*e1v(i,j-1)*e3v_0(i,j-1,jk)*vmask(i,j-1,jk) + &417 ! wn(i,j,jk)*e2t(i,j)*e1t(i,j)*tmask(i,j,jk) - wn(i,j,jk+1)*e2t(i,j)*e1t(i,j)*tmask(i,j,jk+1)418 ! WRITE(narea+5000,*)"div ",i,j,jk,z419 ! ENDDO420 !ENDDO421 422 !ENDIF423 424 425 426 292 ! free memory 427 293 CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) 428 294 CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v ) 429 CALL wrk_dealloc( jpi, jpj, jpk, zt, zs ) 295 CALL wrk_dealloc( jpi, jpj, jpk, zt, zs ) 296 CALL wrk_dealloc( jpi, jpj, z2d ) 430 297 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 298 CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs ) 431 299 ! 432 300 CALL iom_swap( "nemo" ) ! return back on high-resolution grid
Note: See TracChangeset
for help on using the changeset viewer.
