- Timestamp:
- 2015-12-17T16:48:41+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r5602 r6101 27 27 USE iom 28 28 USE zdfmxl_crs 29 USE eosbn2 30 USE zdfevd_crs 31 USE zdftke 32 USE zdftke_crs 33 34 ! USE ieee_arithmetic 29 35 30 36 IMPLICIT NONE … … 40 46 !!---------------------------------------------------------------------- 41 47 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 42 !! $Id $48 !! $Id $ 43 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 50 !!---------------------------------------------------------------------- … … 65 71 !! 66 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs 73 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs , ztmp 68 74 REAL(wp), POINTER, DIMENSION(:,:) :: z2d,z2d_crs 69 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs, zerr_crs,zmax_crs 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp_crs 77 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: avte_crs 70 78 REAL(wp) :: z2dcrsu, z2dcrsv 71 REAL(wp) :: zmin,zmax 79 REAL(wp) :: zmin,zmax,icnt1,icnt2 72 80 INTEGER :: i,j,ijis,ijie,ijjs,ijje 73 81 REAL(wp) :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z 82 REAL(wp) :: zerr, zerr0, zerr1, zmean 83 INTEGER,DIMENSION(4,3) :: ind 84 REAL(wp),DIMENSION(4) :: zwgt 74 85 INTEGER :: iji,ijj 86 INTEGER :: jl,jm,jn 75 87 !! 76 88 !!---------------------------------------------------------------------- … … 81 93 CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w ) 82 94 CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v ) 83 CALL wrk_alloc( jpi, jpj, jpk, zt, zs )95 CALL wrk_alloc( jpi, jpj, jpk, zt, zs , ztmp ) 84 96 CALL wrk_alloc( jpi, jpj, z2d ) 85 97 ! 86 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 98 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) 99 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) 100 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) 87 101 CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs ) 88 102 … … 129 143 CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) ) ! sst 130 144 131 145 !n2 before 146 zt(:,:,:) = rn2b(:,:,:) ; zt_crs(:,:,:) = 0._wp 147 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 148 rb2_crs(:,:,:) = zt_crs(:,:,:) 149 CALL iom_put("rb2_crs",rb2_crs) 150 132 151 ! Salinity 133 152 zs(:,:,:) = tsb(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp … … 252 271 CASE ( 2 ) 253 272 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 273 CASE ( 3 ) 274 CALL crs_dom_ope( avt, 'LOGVOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 ) 275 CASE ( 4 ) 276 CALL crs_dom_ope( avt, 'MED', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 277 CASE ( 5 ) 278 CALL crs_dom_ope( en , 'VOL', 'W', tmask, en_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 279 CALL crs_dom_ope( taum , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 280 CALL crs_dom_ope( rn2(:,:,:), 'VOL', 'W', tmask, rn2_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 281 IF( kt==nit000 )CALL tke_avn_ini_crs 282 CALL tke_avn_crs 283 CALL zdf_evd_crs(kt) 284 CASE ( 6 ) 285 286 avte_crs(:,:,:,:) = 0._wp 287 ztmp(:,:,:)=1. 288 289 zt(:,:,:) = 0._wp 290 zs(:,:,:) = 0._wp 291 DO jk=2,jpk 292 WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) / fse3w(:,:,jk) 293 zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk) 294 ENDDO 295 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 296 CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 297 zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 298 zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 299 zt_crs=tmask_crs*zt_crs 300 zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 301 WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,1) = zt_crs / zs_crs 302 zmin=MINVAL(avte_crs(:,:,:,1));zmax=MAXVAL(avte_crs(:,:,:,1));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 303 304 zt(:,:,:) = 0._wp 305 zs(:,:,:) = 0._wp 306 DO jk=2,jpk 307 WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) / fse3w(:,:,jk) 308 zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk) 309 ENDDO 310 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 311 CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 312 zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax 313 zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax 314 zt_crs=tmask_crs*zt_crs 315 zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 316 WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,2) = zt_crs / zs_crs 317 zmin=MINVAL(avte_crs(:,:,:,2));zmax=MAXVAL(avte_crs(:,:,:,2));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax 318 319 zt(:,:,:) = 0._wp 320 zs(:,:,:) = 0._wp 321 DO jk=2,jpk 322 WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) + & 323 & rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk) 324 zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk) 325 ENDDO 326 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 327 CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 328 zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax 329 zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax 330 zt_crs=tmask_crs*zt_crs 331 zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax 332 WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,3) = zt_crs / zs_crs 333 zmin=MINVAL(avte_crs(:,:,:,3));zmax=MAXVAL(avte_crs(:,:,:,3));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax 334 335 zt(:,:,:) = 0._wp 336 zs(:,:,:) = 0._wp 337 DO jk=2,jpk 338 WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) - & 339 & rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk) 340 zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk) 341 ENDDO 342 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 343 CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 344 zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax 345 zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax 346 zt_crs=tmask_crs*zt_crs 347 zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax 348 WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,4) = zt_crs / zs_crs 349 zmin=MINVAL(avte_crs(:,:,:,4));zmax=MAXVAL(avte_crs(:,:,:,4));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax 350 351 CALL iom_put( "avte_crs1", avte_crs(:,:,:,1) ) ! Kz 352 CALL iom_put( "avte_crs2", avte_crs(:,:,:,2) ) ! Kz 353 CALL iom_put( "avte_crs3", avte_crs(:,:,:,3) ) ! Kz 354 CALL iom_put( "avte_crs4", avte_crs(:,:,:,4) ) ! Kz 355 !--------------------- 356 CALL crs_dom_ope( avt, 'MED', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 ) 357 !? zmin=MINVAL(zs_crs*tmask_crs);zmax=MAXVAL(zs_crs*tmask_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"logvol zs_crs*tmask ",zmin,zmax ; call flush(numout) 358 CALL iom_put( "zs_crs", zs_crs ) ! Kzlogvol 359 !--------------------- ok 360 361 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, zmax_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 362 WRITE(narea+200,*)"zmax_crs ",SHAPE(zmax_crs) ; call flush(narea+200) 363 CALL iom_put( "zmax_crs", zmax_crs ) ! Kzlogvol 364 zmin=MINVAL(zmax_crs*tmask_crs);zmax=MAXVAL(zmax_crs*tmask_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"vol zmax_crs*tmask ",zmin,zmax ; call flush(numout) 365 !-------------------------nok 366 avt_crs=zs_crs 367 368 369 zerr0=0.01 370 371 icnt1=0 372 icnt2=0 373 374 zt_crs(:,:,:)=0._wp 375 zerr_crs(:,:,:)=0._wp 376 DO ji=1,jpi_crs 377 DO jj=1,jpj_crs 378 DO jk=1,jpk 379 380 381 !-------------- 382 zwgt(1:4)=0._wp 383 DO jm=1,4 ; IF( avte_crs(ji,jj,jk,jm) .GE. 0._wp .AND. avte_crs(ji,jj,jk,jm) .LE. zmax_crs(ji,jj,jk) ) zwgt(jm) = 1._wp ; ENDDO 384 !-------------- 385 IF( SUM(zwgt(1:4)) .NE. 0._wp ) THEN 386 zmean = SUM( zwgt(1:4)*avte_crs(ji,jj,jk,1:4)) / SUM(zwgt(1:4) ) 387 zerr = SQRT(SUM( zwgt(1:4)*(avte_crs(ji,jj,jk,1:4)-zmean)*(avte_crs(ji,jj,jk,1:4)-zmean) ) / SUM(zwgt(1:4) ) ) 388 ELSE 389 zmean=0._wp 390 zerr=1.e10 391 ENDIF 392 !-------------- 393 394 zerr_crs(ji,jj,jk)=zerr 395 396 IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )zt_crs(ji,jj,jk)=zmean 397 IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )avt_crs(ji,jj,jk)=zmean 398 399 IF( tmask_crs(ji,jj,jk) == 1 ) icnt1=icnt1+1 400 IF( tmask_crs(ji,jj,jk) == 1 .AND. zerr .LE. zerr0 .AND. zmean .GT. 0._wp ) icnt2=icnt2+1 401 402 !IF( ieee_is_nan( zt_crs(ji,jj,jk)) )WRITE(narea+200,*)"NANMEANEFF ",ji,jj,jk,tmask_crs(ji,jj,jk) ; call flush(narea+200) 403 !IF( ieee_is_nan( zs_crs(ji,jj,jk)) )WRITE(narea+200,*)"NANLOG ",ji,jj,jk,tmask_crs(ji,jj,jk) ; call flush(narea+200) 404 !IF( ieee_is_nan( avt_crs(ji,jj,jk)) )WRITE(narea+200,*)"NANAVT ",ji,jj,jk,tmask_crs(ji,jj,jk) ; call flush(narea+200) 405 ENDDO 406 ENDDO 407 ENDDO 408 zmin=MINVAL(avt_crs);zmax=MAXVAL(avt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avt_crs ",zmin,zmax ; call flush(numout) 409 zmin=MINVAL(avt_crs*tmask_crs);zmax=MAXVAL(avt_crs*tmask_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avt_crs*tmask ",zmin,zmax ; call flush(numout) 410 411 CALL mpp_sum(icnt1) 412 CALL mpp_sum(icnt2) 413 IF(lwp)WRITE(numout,*)"TOTO",kt,icnt1,icnt2 414 CALL iom_put( "zt_crs", zt_crs ) ! Kz 415 CALL iom_put( "zerr_crs", zerr_crs ) ! Kz 416 254 417 END SELECT 255 418 ! … … 293 456 CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) 294 457 CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v ) 295 CALL wrk_dealloc( jpi, jpj, jpk, zt, zs 458 CALL wrk_dealloc( jpi, jpj, jpk, zt, zs, ztmp ) 296 459 CALL wrk_dealloc( jpi, jpj, z2d ) 297 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 460 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) 461 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) 462 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) 298 463 CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs ) 299 464 !
Note: See TracChangeset
for help on using the changeset viewer.
