MODULE crsfld !!====================================================================== !! *** MODULE crsdfld *** !! Ocean coarsening : coarse ocean fields !!===================================================================== !! 2012-07 (J. Simeon, C. Calone, G. Madec, C. Ethe) !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! crs_fld : create the standard output files for coarse grid and prep !! other variables needed to be passed to TOP !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE ldftra_oce ! ocean active tracers: lateral physics USE sbc_oce ! Surface boundary condition: ocean fields USE zdf_oce ! vertical physics: ocean fields USE zdfddm ! vertical physics: double diffusion USe zdfmxl USE lbclnk ! ocean lateral boundary conditions (or mpp link) USE in_out_manager ! I/O manager USE timing ! preformance summary USE wrk_nemo ! working array USE crs USE crsdom USE crslbclnk USE iom USE zdfmxl_crs USE eosbn2 USE zdfevd_crs USE zdftke USE zdftke_crs ! USE ieee_arithmetic IMPLICIT NONE PRIVATE PUBLIC crs_fld ! routines called by step.F90 !! * Substitutions # include "zdfddm_substitute.h90" # include "domzgr_substitute.h90" # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 3.3 , NEMO Consortium (2010) !! $Id $ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE crs_fld( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE crs_fld *** !! !! ** Purpose : Basic output of coarsened dynamics and tracer fields !! NETCDF format is used by default !! 1. Accumulate in time the dimensionally-weighted fields !! 2. At time of output, rescale [1] by dimension and time !! to yield the spatial and temporal average. !! See. diawri_dimg.h90, sbcmod.F90 !! !! ** Method : !!---------------------------------------------------------------------- !! INTEGER, INTENT( in ) :: kt ! ocean time-step index !! INTEGER :: ji, jj, jk ! dummy loop indices !! REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs , ztmp REAL(wp), POINTER, DIMENSION(:,:) :: z2d,z2d_crs REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs, zerr_crs,zmax_crs REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp_crs REAL(wp), POINTER, DIMENSION(:,:,:,:) :: avte_crs REAL(wp) :: z2dcrsu, z2dcrsv REAL(wp) :: zmin,zmax,icnt1,icnt2 INTEGER :: i,j,ijis,ijie,ijjs,ijje REAL(wp) :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z REAL(wp) :: zerr, zerr0, zerr1, zmean INTEGER,DIMENSION(4,3) :: ind REAL(wp),DIMENSION(4) :: zwgt INTEGER :: iji,ijj INTEGER :: jl,jm,jn !! !!---------------------------------------------------------------------- IF( nn_timing == 1 ) CALL timing_start('crs_fld') ! Initialize arrays CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w ) CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v ) CALL wrk_alloc( jpi, jpj, jpk, zt, zs , ztmp ) CALL wrk_alloc( jpi, jpj, z2d ) ! CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) CALL wrk_alloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) CALL wrk_alloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs ) ! Depth work arrrays zfse3t(:,:,:) = fse3t(:,:,:) zfse3u(:,:,:) = fse3u(:,:,:) zfse3v(:,:,:) = fse3v(:,:,:) zfse3w(:,:,:) = fse3w(:,:,:) IF( kt == nit000 ) THEN tsn_crs (:,:,:,:) = 0._wp ! temp/sal array, now un_crs (:,:,: ) = 0._wp ! u-velocity vn_crs (:,:,: ) = 0._wp ! v-velocity wn_crs (:,:,: ) = 0._wp ! w avt_crs (:,:,: ) = 0._wp ! avt hdivb_crs(:,:,: ) = 0._wp ! hdiv hdivn_crs(:,:,: ) = 0._wp ! hdiv rke_crs (:,:,: ) = 0._wp ! rke sshn_crs (:,: ) = 0._wp ! ssh utau_crs (:,: ) = 0._wp ! taux vtau_crs (:,: ) = 0._wp ! tauy wndm_crs (:,: ) = 0._wp ! wind speed qsr_crs (:,: ) = 0._wp ! qsr emp_crs (:,: ) = 0._wp ! emp emp_b_crs(:,: ) = 0._wp ! emp rnf_crs (:,: ) = 0._wp ! runoff fr_i_crs (:,: ) = 0._wp ! ice cover ENDIF CALL iom_swap( "nemo_crs" ) ! swap on the coarse grid ! 2. Coarsen fields at each time step ! -------------------------------------------------------- ! Temperature zt(:,:,:) = tsb(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:) zt(:,:,:) = tsn(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) ) ! temp CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) ) ! sst !n2 before zt(:,:,:) = rn2b(:,:,:) ; zt_crs(:,:,:) = 0._wp CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) rb2_crs(:,:,:) = zt_crs(:,:,:) CALL iom_put("rb2_crs",rb2_crs) ! Salinity zs(:,:,:) = tsb(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) tsb_crs(:,:,:,jp_sal) = zs_crs(:,:,:) zs(:,:,:) = tsn(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) tsn_crs(:,:,:,jp_sal) = zs_crs(:,:,:) CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) ) ! sal CALL iom_put( "sss" , tsn_crs(:,:,1,jp_sal) ) ! sss ! U-velocity CALL crs_dom_ope( ub, 'SUM', 'U', umask, ub_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) !cbr ub_crs(:,:,:) = ub_crs(:,:,:)*umask_crs(:,:,:) un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:) ! zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp DO jk = 1, jpkm1 DO jj = 2, jpjm1 DO ji = 2, jpim1 zt(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) zs(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) END DO END DO END DO CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) CALL iom_put( "uoce" , un_crs ) ! i-current CALL iom_put( "uocet" , zt_crs ) ! uT CALL iom_put( "uoces" , zs_crs ) ! uS ! V-velocity CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) vb_crs(:,:,:) = vb_crs(:,:,:)*vmask_crs(:,:,:) vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:) ! zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp DO jk = 1, jpkm1 DO jj = 2, jpjm1 DO ji = 2, jpim1 zt(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) zs(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) END DO END DO END DO CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) CALL iom_put( "voce" , vn_crs ) ! i-current CALL iom_put( "vocet" , zt_crs ) ! vT CALL iom_put( "voces" , zs_crs ) ! vS ! Kinetic energy CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) CALL iom_put( "eken", rke_crs ) ! Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) DO jk = 1, jpkm1 DO ji = 2, jpi_crsm1 DO jj = 2, jpj_crsm1 IF( tmask_crs(ji,jj,jk ) > 0 ) THEN !z2dcrsu = ( un_crs(ji ,jj ,jk) * crs_surfu_wgt(ji ,jj ,jk) ) & ! & - ( un_crs(ji-1,jj ,jk) * crs_surfu_wgt(ji-1,jj ,jk) ) !z2dcrsv = ( vn_crs(ji ,jj ,jk) * crs_surfv_wgt(ji ,jj ,jk) ) & ! & - ( vn_crs(ji ,jj-1,jk) * crs_surfv_wgt(ji ,jj-1,jk) ) ! !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) z2dcrsu = ( un_crs(ji ,jj ,jk) * e2e3u_msk(ji ,jj ,jk) ) & & - ( un_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) ) z2dcrsv = ( vn_crs(ji ,jj ,jk) * e1e3v_msk(ji ,jj ,jk) ) & & - ( vn_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk) ) ! !cbr !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 ) !bug2: mm test que bug1: on n'obtient tjs pas zero !on a la div calculée via ocean_volume_crs_t puis w via e3t_crs ; or ,e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk) NE ocean_volume_crs_t*crs_volt_wgt(ji,jj,jk) !exp (117,211,74) : e1*e2*e3=235206030060.005 / ocean_volume_crs_t * facvol = 235205585307.810 ! e1*e2*e3-cean_volume_crs_t * facvol/(cean_volume_crs_t * facvol) ~1.e-6) IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) z2dcrsu = ( ub_crs(ji ,jj ,jk) * e2e3u_msk(ji ,jj ,jk) ) & & - ( ub_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) ) z2dcrsv = ( vb_crs(ji ,jj ,jk) * e1e3v_msk(ji ,jj ,jk) ) & & - ( vb_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk) ) ! IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivb_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk) ) ENDIF ENDDO ENDDO ENDDO CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 ) ! CALL iom_put( "hdiv", hdivn_crs ) ! W-velocity IF( ln_crs_wn ) THEN CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) ELSE wn_crs(:,:,jpk) = 0._wp DO jk = jpkm1, 1, -1 wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk) WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp ) wn_crs(:,:,jk) = wn_crs(:,:,jk) /e1e2w_msk(:,:,jk) ENDDO ENDIF CALL iom_put( "woce", wn_crs ) ! vertical velocity ! free memory ! avt, avs SELECT CASE ( nn_crs_kz ) CASE ( 0 ) CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) CASE ( 1 ) CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) CASE ( 2 ) CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) CASE ( 3 ) CALL crs_dom_ope( avt, 'LOGVOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 ) CASE ( 4 ) CALL crs_dom_ope( avt, 'MED', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) CASE ( 5 ) CALL crs_dom_ope( en , 'VOL', 'W', tmask, en_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) CALL crs_dom_ope( taum , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) CALL crs_dom_ope( rn2(:,:,:), 'VOL', 'W', tmask, rn2_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) IF( kt==nit000 )CALL tke_avn_ini_crs CALL tke_avn_crs CALL zdf_evd_crs(kt) CASE ( 6 ) avte_crs(:,:,:,:) = 0._wp ztmp(:,:,:)=1. zt(:,:,:) = 0._wp zs(:,:,:) = 0._wp DO jk=2,jpk WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) / fse3w(:,:,jk) zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk) ENDDO CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax zt_crs=tmask_crs*zt_crs zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,1) = zt_crs / zs_crs 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 zt(:,:,:) = 0._wp zs(:,:,:) = 0._wp DO jk=2,jpk WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) / fse3w(:,:,jk) zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk) ENDDO CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax zt_crs=tmask_crs*zt_crs zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,2) = zt_crs / zs_crs 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 zt(:,:,:) = 0._wp zs(:,:,:) = 0._wp DO jk=2,jpk WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) + & & rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk) zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk) ENDDO CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax zt_crs=tmask_crs*zt_crs zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,3) = zt_crs / zs_crs 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 zt(:,:,:) = 0._wp zs(:,:,:) = 0._wp DO jk=2,jpk WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) - & & rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk) zt(:,:,jk)= avt(:,:,jk) * zs(:,:,jk) ENDDO CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax zt_crs=tmask_crs*zt_crs zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,4) = zt_crs / zs_crs 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 CALL iom_put( "avte_crs1", avte_crs(:,:,:,1) ) ! Kz CALL iom_put( "avte_crs2", avte_crs(:,:,:,2) ) ! Kz CALL iom_put( "avte_crs3", avte_crs(:,:,:,3) ) ! Kz CALL iom_put( "avte_crs4", avte_crs(:,:,:,4) ) ! Kz !--------------------- CALL crs_dom_ope( avt, 'MED', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 ) !? 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) CALL iom_put( "zs_crs", zs_crs ) ! Kzlogvol !--------------------- ok CALL crs_dom_ope( avt, 'VOL', 'W', tmask, zmax_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) WRITE(narea+200,*)"zmax_crs ",SHAPE(zmax_crs) ; call flush(narea+200) CALL iom_put( "zmax_crs", zmax_crs ) ! Kzlogvol 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) !-------------------------nok avt_crs=zs_crs zerr0=0.01 icnt1=0 icnt2=0 zt_crs(:,:,:)=0._wp zerr_crs(:,:,:)=0._wp DO ji=1,jpi_crs DO jj=1,jpj_crs DO jk=1,jpk !-------------- zwgt(1:4)=0._wp 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 !-------------- IF( SUM(zwgt(1:4)) .NE. 0._wp ) THEN zmean = SUM( zwgt(1:4)*avte_crs(ji,jj,jk,1:4)) / SUM(zwgt(1:4) ) 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) ) ) ELSE zmean=0._wp zerr=1.e10 ENDIF !-------------- zerr_crs(ji,jj,jk)=zerr IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )zt_crs(ji,jj,jk)=zmean IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )avt_crs(ji,jj,jk)=zmean IF( tmask_crs(ji,jj,jk) == 1 ) icnt1=icnt1+1 IF( tmask_crs(ji,jj,jk) == 1 .AND. zerr .LE. zerr0 .AND. zmean .GT. 0._wp ) icnt2=icnt2+1 !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) !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) !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) ENDDO ENDDO ENDDO 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) 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) CALL mpp_sum(icnt1) CALL mpp_sum(icnt2) IF(lwp)WRITE(numout,*)"TOTO",kt,icnt1,icnt2 CALL iom_put( "zt_crs", zt_crs ) ! Kz CALL iom_put( "zerr_crs", zerr_crs ) ! Kz END SELECT ! CALL iom_put( "avt", avt_crs ) ! Kz !deja dasn step CALL zdf_mxl_crs(kt) ! sbc fields CALL crs_dom_ope( sshb , 'VOL', 'T', tmask, sshb_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 ) CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 ) CALL crs_dom_ope( ssha , 'VOL', 'T', tmask, ssha_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 ) CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 ) CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 ) CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0 ) CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) CALL crs_dom_ope( emp , 'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) CALL crs_dom_ope( sfx , 'SUM', 'T', tmask, sfx_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) z2d=REAL(nmln,wp) CALL crs_dom_ope( z2d , 'MAX', 'T', tmask, z2d_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) nmln_crs=INT(z2d_crs) nmln_crs=MAX(nlb10,nmln_crs) CALL iom_put( "ssh" , sshn_crs ) ! ssh output CALL iom_put( "utau" , utau_crs ) ! i-tau output CALL iom_put( "vtau" , vtau_crs ) ! j-tau output CALL iom_put( "wspd" , wndm_crs ) ! wind speed output CALL iom_put( "runoffs" , rnf_crs ) ! runoff output CALL iom_put( "qsr" , qsr_crs ) ! qsr output CALL iom_put( "empmr" , emp_crs ) ! water flux output CALL iom_put( "saltflx" , sfx_crs ) ! salt flux output CALL iom_put( "ice_cover", fr_i_crs ) ! ice cover output ! free memory CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v ) CALL wrk_dealloc( jpi, jpj, jpk, zt, zs, ztmp ) CALL wrk_dealloc( jpi, jpj, z2d ) CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs ) ! CALL iom_swap( "nemo" ) ! return back on high-resolution grid ! IF( nn_timing == 1 ) CALL timing_stop('crs_fld') ! END SUBROUTINE crs_fld !!====================================================================== END MODULE crsfld