Changeset 6786 for branches/2015/dev_r5003_MERCATOR6_CRS
- Timestamp:
- 2016-07-04T17:49:36+02:00 (8 years ago)
- Location:
- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r6772 r6786 75 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs , ztmp 76 76 REAL(wp), POINTER, DIMENSION(:,:) :: z2d,z2d_crs 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs, zerr_crs,zmax_crs 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp_crs 79 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: avte_crs 80 REAL(wp) :: z2dcrsu, z2dcrsv 81 REAL(wp) :: z1_2dt 82 REAL(wp) :: icnt1,icnt2 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs 78 REAL(wp):: z2dcrsu, z2dcrsv 79 REAL(wp):: z1_2dt 83 80 INTEGER :: i,j,ijis,ijie,ijjs,ijje 84 REAL(wp) :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z85 REAL(wp) :: zerr, zerr0, zerr1, zmean86 INTEGER,DIMENSION(4,3) :: ind87 REAL(wp),DIMENSION(4) :: zwgt88 81 INTEGER :: iji,ijj 89 82 INTEGER :: jl,jm,jn 90 REAL(wp) :: zmin,zmax,zsuma0,zsuma1,zsuma2,zsuma3,zsumb0,zsumb1,zsumb2,zsumb3,zsumb491 83 !! 92 84 !!---------------------------------------------------------------------- … … 100 92 CALL wrk_alloc( jpi, jpj, z2d ) 101 93 ! 102 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) 103 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) 104 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) 94 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 105 95 CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs ) 106 96 … … 165 155 CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u ) 166 156 CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v ) 157 CALL iom_put("e2e3u_crs",e2e3u_crs) 158 CALL iom_put("e2e3u_msk",e2e3u_msk) 159 CALL iom_put("e1e3v_crs",e1e3v_crs) 160 CALL iom_put("e1e3v_msk",e1e3v_msk) 167 161 ! 168 162 CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=zs_crs, p_e3_max_crs=e3t_max_0_crs) … … 262 256 CASE ( 5 ) 263 257 #if defined key_zdftke 264 CALL crs_dom_ope( en , 'VOL', 'W', tmask, en_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )265 CALL crs_dom_ope( taum , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )266 CALL crs_dom_ope( rn2(:,:,:), 'VOL', 'W', tmask, rn2_crs , p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )258 CALL crs_dom_ope( en , 'VOL', 'W', tmask, en_crs , p_e12=e1e2t, p_e3=zfse3w , psgn=1.0 ) 259 CALL crs_dom_ope( taum , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 260 CALL crs_dom_ope( rn2(:,:,:), 'VOL', 'W', tmask, rn2_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 ) 267 261 IF( kt==nit000 )CALL tke_avn_ini_crs 268 262 CALL tke_avn_crs 269 263 CALL zdf_evd_crs(kt) 270 264 #endif 271 CASE ( 6 )272 273 avte_crs(:,:,:,:) = 0._wp274 ztmp(:,:,:)=1.275 276 zt(:,:,:) = 0._wp277 zs(:,:,:) = 0._wp278 DO jk=2,jpk279 WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) / fse3w(:,:,jk)280 zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk)281 ENDDO282 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )283 CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )284 zt_crs=tmask_crs*zt_crs285 WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,1) = zt_crs / zs_crs286 287 zt(:,:,:) = 0._wp288 zs(:,:,:) = 0._wp289 DO jk=2,jpk290 WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) / fse3w(:,:,jk)291 zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk)292 ENDDO293 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )294 CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )295 zt_crs=tmask_crs*zt_crs296 WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,2) = zt_crs / zs_crs297 298 zt(:,:,:) = 0._wp299 zs(:,:,:) = 0._wp300 DO jk=2,jpk301 WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) + &302 & rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk)303 zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk)304 ENDDO305 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )306 CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )307 zt_crs=tmask_crs*zt_crs308 WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,3) = zt_crs / zs_crs309 310 zt(:,:,:) = 0._wp311 zs(:,:,:) = 0._wp312 DO jk=2,jpk313 WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) - &314 & rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk)315 zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk)316 ENDDO317 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )318 CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 )319 zt_crs=tmask_crs*zt_crs320 WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,4) = zt_crs / zs_crs321 322 CALL iom_put( "avte_crs1", avte_crs(:,:,:,1) ) ! Kz323 CALL iom_put( "avte_crs2", avte_crs(:,:,:,2) ) ! Kz324 CALL iom_put( "avte_crs3", avte_crs(:,:,:,3) ) ! Kz325 CALL iom_put( "avte_crs4", avte_crs(:,:,:,4) ) ! Kz326 327 CALL crs_dom_ope( avt, 'MED', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 )328 CALL iom_put( "zs_crs", zs_crs ) ! Kzlogvol329 330 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, zmax_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )331 CALL iom_put( "zmax_crs", zmax_crs ) ! Kzlogvol332 avt_crs=zs_crs333 334 335 zerr0=0.01336 337 icnt1=0338 icnt2=0339 340 zt_crs(:,:,:)=0._wp341 zerr_crs(:,:,:)=0._wp342 DO ji=1,jpi_crs343 DO jj=1,jpj_crs344 DO jk=1,jpk345 346 347 zwgt(1:4)=0._wp348 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 ; ENDDO349 IF( SUM(zwgt(1:4)) .NE. 0._wp ) THEN350 zmean = SUM( zwgt(1:4)*avte_crs(ji,jj,jk,1:4)) / SUM(zwgt(1:4) )351 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) ) )352 ELSE353 zmean=0._wp354 zerr=1.e10355 ENDIF356 357 zerr_crs(ji,jj,jk)=zerr358 359 IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )zt_crs(ji,jj,jk)=zmean360 IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )avt_crs(ji,jj,jk)=zmean361 362 IF( tmask_crs(ji,jj,jk) == 1 ) icnt1=icnt1+1363 IF( tmask_crs(ji,jj,jk) == 1 .AND. zerr .LE. zerr0 .AND. zmean .GT. 0._wp ) icnt2=icnt2+1364 365 ENDDO366 ENDDO367 ENDDO368 369 CALL iom_put( "zt_crs", zt_crs ) ! Kz370 CALL iom_put( "zerr_crs", zerr_crs ) ! Kz371 265 372 266 END SELECT … … 477 371 CALL wrk_dealloc( jpi, jpj, jpk, zt, zs, ztmp ) 478 372 CALL wrk_dealloc( jpi, jpj, z2d ) 479 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) 480 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) 481 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) 373 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 482 374 CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs ) 483 375 ! -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
r6772 r6786 43 43 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 44 44 CALL iom_put( TRIM(cltra), trn(:,:,:,jn) ) 45 ENDIF46 45 END DO 47 46 !
Note: See TracChangeset
for help on using the changeset viewer.