- Timestamp:
- 2016-07-01T18:02:45+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r6101 r6772 24 24 USE crs 25 25 USE crsdom 26 USE domvvl 27 USE domvvl_crs 26 28 USE crslbclnk 27 29 USE iom … … 32 34 USE zdftke_crs 33 35 34 !USE ieee_arithmetic36 USE ieee_arithmetic 35 37 36 38 IMPLICIT NONE … … 77 79 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: avte_crs 78 80 REAL(wp) :: z2dcrsu, z2dcrsv 79 REAL(wp) :: zmin,zmax,icnt1,icnt2 81 REAL(wp) :: z1_2dt 82 REAL(wp) :: icnt1,icnt2 80 83 INTEGER :: i,j,ijis,ijie,ijjs,ijje 81 84 REAL(wp) :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z … … 85 88 INTEGER :: iji,ijj 86 89 INTEGER :: jl,jm,jn 90 REAL(wp) :: zmin,zmax,zsuma0,zsuma1,zsuma2,zsuma3,zsumb0,zsumb1,zsumb2,zsumb3,zsumb4 87 91 !! 88 92 !!---------------------------------------------------------------------- … … 101 105 CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs ) 102 106 103 ! Depth work arrrays104 zfse3t(:,:,:) = fse3t(:,:,:)105 zfse3u(:,:,:) = fse3u(:,:,:)106 zfse3v(:,:,:) = fse3v(:,:,:)107 zfse3w(:,:,:) = fse3w(:,:,:)108 107 109 108 IF( kt == nit000 ) THEN … … 124 123 emp_b_crs(:,: ) = 0._wp ! emp 125 124 rnf_crs (:,: ) = 0._wp ! runoff 125 rnf_b_crs(:,: ) = 0._wp ! runoff 126 126 fr_i_crs (:,: ) = 0._wp ! ice cover 127 127 ENDIF … … 129 129 CALL iom_swap( "nemo_crs" ) ! swap on the coarse grid 130 130 131 ! 2. Coarsen fields at each time step 132 ! -------------------------------------------------------- 131 !--------------------------------------------------------------------------------------------------- 132 !variables domaine au temps before : swap 133 !--------------------------------------------------------------------------------------------------- 134 #if defined key_vvl 135 e3t_b_crs(:,:,:) = e3t_n_crs(:,:,:) 136 e3u_b_crs(:,:,:) = e3u_n_crs(:,:,:) 137 e3v_b_crs(:,:,:) = e3v_n_crs(:,:,:) 138 e3w_b_crs(:,:,:) = e3w_n_crs(:,:,:) 139 e3t_n_crs(:,:,:) = e3t_a_crs(:,:,:) 140 e3u_n_crs(:,:,:) = e3u_a_crs(:,:,:) 141 e3v_n_crs(:,:,:) = e3v_a_crs(:,:,:) 142 e3w_n_crs(:,:,:) = e3w_a_crs(:,:,:) 143 #endif 144 145 IF( kt /= nit000 )THEN 146 tsb_crs(:,:,:,jp_tem) = tsn_crs(:,:,:,jp_tem) 147 tsb_crs(:,:,:,jp_sal) = tsn_crs(:,:,:,jp_sal) 148 ub_crs(:,:,:) = un_crs(:,:,:) 149 vb_crs(:,:,:) = vn_crs(:,:,:) 150 sshb_crs(:,:) = sshb_crs(:,:) 151 emp_b_crs(:,:) = emp_crs(:,:) 152 rnf_b_crs(:,:) = rnf_crs(:,:) 153 rb2_crs(:,:,:) = rn2_crs(:,:,:) 154 ENDIF 155 156 !--------------------------------------------------------------------------------------------------- 157 !variables domaine au temps now : 158 !--------------------------------------------------------------------------------------------------- 159 #if defined key_vvl 160 zfse3t(:,:,:) = e3t_n(:,:,:) 161 zfse3u(:,:,:) = e3u_n(:,:,:) 162 zfse3v(:,:,:) = e3v_n(:,:,:) 163 zfse3w(:,:,:) = e3w_n(:,:,:) 164 165 CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u ) 166 CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v ) 167 ! 168 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) 169 CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=zs_crs, p_e3_max_crs=e3w_max_0_crs) 170 CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs , cd_type='U', p_mask=umask, p_e3_crs=zs_crs, p_e3_max_crs=e3u_max_0_crs) 171 CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs , cd_type='V', p_mask=vmask, p_e3_crs=zs_crs, p_e3_max_crs=e3v_max_0_crs) 172 173 CALL crs_dom_ope( gdepw_n, 'MAX', 'T', tmask, gdept_n_crs, p_e3=zfse3t, psgn=1.0 ) 174 CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 ) 175 176 CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t ) 177 CALL iom_put("ocean_volume_crs_t",ocean_volume_crs_t) 178 ! 179 bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)*tmask_crs(:,:,:) 180 ! 181 r1_bt_crs(:,:,:) = 0._wp 182 WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:) 183 184 CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w ) 185 186 #endif 187 188 #if defined key_vvl 189 zfse3t(:,:,:) = e3t_n(:,:,:) 190 zfse3u(:,:,:) = e3u_n(:,:,:) 191 zfse3v(:,:,:) = e3v_n(:,:,:) 192 zfse3w(:,:,:) = e3w_n(:,:,:) 193 CALL iom_put("e3t",e3t_n_crs) 194 CALL iom_put("e3u",e3u_n_crs) 195 CALL iom_put("e3v",e3v_n_crs) 196 CALL iom_put("e3w",e3w_n_crs) 197 #else 198 zfse3t(:,:,:) = e3t_0(:,:,:) 199 zfse3u(:,:,:) = e3u_0(:,:,:) 200 zfse3v(:,:,:) = e3v_0(:,:,:) 201 zfse3w(:,:,:) = e3w_0(:,:,:) 202 #endif 133 203 134 204 ! Temperature 135 zt(:,:,:) = tsb(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp136 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )137 tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:)138 205 zt(:,:,:) = tsn(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp 139 206 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) … … 143 210 CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) ) ! sst 144 211 145 !n2 before146 zt(:,:,:) = rn2b(:,:,:) ; zt_crs(:,:,:) = 0._wp147 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 151 212 ! Salinity 152 zs(:,:,:) = tsb(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp153 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )154 tsb_crs(:,:,:,jp_sal) = zs_crs(:,:,:)155 213 zs(:,:,:) = tsn(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp 156 214 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) … … 161 219 162 220 ! U-velocity 163 CALL crs_dom_ope( ub, 'SUM', 'U', umask, ub_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )164 221 CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 165 !cbr166 ub_crs(:,:,:) = ub_crs(:,:,:)*umask_crs(:,:,:)167 222 un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:) 168 ! 169 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp 223 CALL iom_put( "uoce" , un_crs ) ! i-current 224 225 ! V-velocity 226 CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 227 vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:) 228 CALL iom_put( "voce" , vn_crs ) ! i-current 229 230 ! Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) 231 hdivn_crs(:,:,:)=0._wp 232 170 233 DO jk = 1, jpkm1 171 DO jj = 2, jpjm1 172 DO ji = 2, jpim1 173 zt(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 174 zs(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 175 END DO 176 END DO 177 END DO 178 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 179 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 180 181 CALL iom_put( "uoce" , un_crs ) ! i-current 182 CALL iom_put( "uocet" , zt_crs ) ! uT 183 CALL iom_put( "uoces" , zs_crs ) ! uS 184 185 ! V-velocity 186 CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 187 CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 188 vb_crs(:,:,:) = vb_crs(:,:,:)*vmask_crs(:,:,:) 189 vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:) 190 ! 191 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp 192 DO jk = 1, jpkm1 193 DO jj = 2, jpjm1 194 DO ji = 2, jpim1 195 zt(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 196 zs(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 197 END DO 198 END DO 199 END DO 200 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 201 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 202 203 CALL iom_put( "voce" , vn_crs ) ! i-current 204 CALL iom_put( "vocet" , zt_crs ) ! vT 205 CALL iom_put( "voces" , zs_crs ) ! vS 206 207 208 ! Kinetic energy 209 CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 210 CALL iom_put( "eken", rke_crs ) 211 212 ! Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) 213 DO jk = 1, jpkm1 214 DO ji = 2, jpi_crsm1 215 DO jj = 2, jpj_crsm1 216 IF( tmask_crs(ji,jj,jk ) > 0 ) THEN 217 !z2dcrsu = ( un_crs(ji ,jj ,jk) * crs_surfu_wgt(ji ,jj ,jk) ) & 218 ! & - ( un_crs(ji-1,jj ,jk) * crs_surfu_wgt(ji-1,jj ,jk) ) 219 !z2dcrsv = ( vn_crs(ji ,jj ,jk) * crs_surfv_wgt(ji ,jj ,jk) ) & 220 ! & - ( vn_crs(ji ,jj-1,jk) * crs_surfv_wgt(ji ,jj-1,jk) ) 221 ! 222 !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 223 z2dcrsu = ( un_crs(ji ,jj ,jk) * e2e3u_msk(ji ,jj ,jk) ) & 224 & - ( un_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) ) 225 z2dcrsv = ( vn_crs(ji ,jj ,jk) * e1e3v_msk(ji ,jj ,jk) ) & 226 & - ( vn_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk) ) 227 ! 228 !cbr 229 !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 ) 230 !bug2: mm test que bug1: on n'obtient tjs pas zero 231 !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) 232 !exp (117,211,74) : e1*e2*e3=235206030060.005 / ocean_volume_crs_t * facvol = 235205585307.810 233 ! e1*e2*e3-cean_volume_crs_t * facvol/(cean_volume_crs_t * facvol) ~1.e-6) 234 IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) 235 236 z2dcrsu = ( ub_crs(ji ,jj ,jk) * e2e3u_msk(ji ,jj ,jk) ) & 237 & - ( ub_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) ) 238 z2dcrsv = ( vb_crs(ji ,jj ,jk) * e1e3v_msk(ji ,jj ,jk) ) & 239 & - ( vb_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk) ) 240 ! 241 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) ) 242 ENDIF 234 DO jj = 2,jpj_crs 235 DO ji = 2,jpi_crs 236 z2dcrsu = ( un_crs(ji ,jj ,jk) * e2e3u_msk(ji ,jj ,jk) ) & 237 & - ( un_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) ) 238 z2dcrsv = ( vn_crs(ji ,jj ,jk) * e1e3v_msk(ji ,jj ,jk) ) & 239 & - ( vn_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk) ) 240 241 hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) 243 242 ENDDO 244 243 ENDDO … … 248 247 CALL iom_put( "hdiv", hdivn_crs ) 249 248 250 251 ! W-velocity252 IF( ln_crs_wn ) THEN253 CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )254 ELSE255 wn_crs(:,:,jpk) = 0._wp256 DO jk = jpkm1, 1, -1257 wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk)258 WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp ) wn_crs(:,:,jk) = wn_crs(:,:,jk) /e1e2w_msk(:,:,jk)259 ENDDO260 ENDIF261 262 CALL iom_put( "woce", wn_crs ) ! vertical velocity263 ! free memory264 249 265 250 ! avt, avs … … 276 261 CALL crs_dom_ope( avt, 'MED', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 277 262 CASE ( 5 ) 263 #if defined key_zdftke 278 264 CALL crs_dom_ope( en , 'VOL', 'W', tmask, en_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 279 265 CALL crs_dom_ope( taum , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) … … 282 268 CALL tke_avn_crs 283 269 CALL zdf_evd_crs(kt) 270 #endif 284 271 CASE ( 6 ) 285 272 … … 295 282 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 296 283 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,zmax298 zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax299 284 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,zmax301 285 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,zmax303 286 304 287 zt(:,:,:) = 0._wp … … 310 293 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 311 294 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,zmax313 zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax314 295 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,zmax316 296 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,zmax318 297 319 298 zt(:,:,:) = 0._wp … … 326 305 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 327 306 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,zmax329 zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax330 307 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,zmax332 308 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,zmax334 309 335 310 zt(:,:,:) = 0._wp … … 342 317 CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 343 318 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,zmax345 zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax346 319 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,zmax348 320 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,zmax350 321 351 322 CALL iom_put( "avte_crs1", avte_crs(:,:,:,1) ) ! Kz … … 353 324 CALL iom_put( "avte_crs3", avte_crs(:,:,:,3) ) ! Kz 354 325 CALL iom_put( "avte_crs4", avte_crs(:,:,:,4) ) ! Kz 355 !--------------------- 326 356 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 ) 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 328 CALL iom_put( "zs_crs", zs_crs ) ! Kzlogvol 359 !--------------------- ok360 329 361 330 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 331 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 !-------------------------nok366 332 avt_crs=zs_crs 367 333 … … 379 345 380 346 381 !--------------382 347 zwgt(1:4)=0._wp 383 348 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 349 IF( SUM(zwgt(1:4)) .NE. 0._wp ) THEN 386 350 zmean = SUM( zwgt(1:4)*avte_crs(ji,jj,jk,1:4)) / SUM(zwgt(1:4) ) … … 390 354 zerr=1.e10 391 355 ENDIF 392 !--------------393 356 394 357 zerr_crs(ji,jj,jk)=zerr … … 400 363 IF( tmask_crs(ji,jj,jk) == 1 .AND. zerr .LE. zerr0 .AND. zmean .GT. 0._wp ) icnt2=icnt2+1 401 364 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 365 ENDDO 366 ENDDO 367 ENDDO 368 414 369 CALL iom_put( "zt_crs", zt_crs ) ! Kz 415 370 CALL iom_put( "zerr_crs", zerr_crs ) ! Kz … … 419 374 CALL iom_put( "avt", avt_crs ) ! Kz 420 375 421 !deja dasn step CALL zdf_mxl_crs(kt)422 423 424 ! sbc fields425 426 CALL crs_dom_ope( sshb , 'VOL', 'T', tmask, sshb_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 )427 376 CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 ) 428 CALL crs_dom_ope( ssha , 'VOL', 'T', tmask, ssha_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 )429 377 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 ) 430 378 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 ) … … 432 380 CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0 ) 433 381 CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 434 CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 382 #if defined key_vvl 383 CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 ) 384 #else 385 CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_0_crs, p_e3=zfse3w, psgn=1.0 ) 386 #endif 387 435 388 CALL crs_dom_ope( emp , 'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 389 436 390 CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 437 391 CALL crs_dom_ope( sfx , 'SUM', 'T', tmask, sfx_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) … … 453 407 CALL iom_put( "ice_cover", fr_i_crs ) ! ice cover output 454 408 409 #if defined key_vvl 410 !--------------------------------------------------------------------------------------------------- 411 !variables au temps after 412 !--------------------------------------------------------------------------------------------------- 413 414 zfse3t(:,:,:) = 1._wp 415 zt(:,:,:) = tmask(:,:,:) 416 ssha(:,:) = ssha(:,:) * tmask(:,:,1) 417 CALL crs_dom_ope( ssha , 'VOL', 'T', zt, ssha_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 ) 418 CALL crs_lbc_lnk( ssha_crs, 'T', 1.0 ) !!!!!!!!!!!!!!!!!!! pas utile !!!!!!!!!!!!!!!!!!!!!!!!! 419 420 zfse3t(:,:,:) = e3t_a(:,:,:) 421 zfse3u(:,:,:) = e3u_a(:,:,:) 422 zfse3v(:,:,:) = e3v_a(:,:,:) 423 CALL dom_vvl_interpol( zfse3t(:,:,:), zfse3w(:,:,:), 'W' ) 424 425 CALL crs_dom_sfc( umask, 'U', zt_crs, zs_crs, p_e2=e2u, p_e3=zfse3u ) ! zt_crs=e2e3u_crs,zs_crs=e2e3u_msk 426 CALL crs_dom_sfc( vmask, 'V', zt_crs, zs_crs, p_e1=e2v, p_e3=zfse3v ) ! zt_crs=e1e3v_crs,zs_crs=e1e3v_msk 427 CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=e3t_a_crs, p_e3_max_crs=zs_crs) 428 CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=e3w_a_crs, p_e3_max_crs=zs_crs) 429 CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs , cd_type='U', p_mask=umask, p_e3_crs=e3u_a_crs, p_e3_max_crs=zs_crs) 430 CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs , cd_type='V', p_mask=vmask, p_e3_crs=e3v_a_crs, p_e3_max_crs=zs_crs) 431 432 433 DO jk = 1, jpk 434 DO ji = 1, jpi_crs 435 DO jj = 1, jpj_crs 436 IF( e3t_a_crs(ji,jj,jk) == 0._wp ) e3t_a_crs(ji,jj,jk) = e3t_1d(jk) 437 IF( e3w_a_crs(ji,jj,jk) == 0._wp ) e3w_a_crs(ji,jj,jk) = e3w_1d(jk) 438 IF( e3u_a_crs(ji,jj,jk) == 0._wp ) e3u_a_crs(ji,jj,jk) = e3t_1d(jk) 439 IF( e3v_a_crs(ji,jj,jk) == 0._wp ) e3v_a_crs(ji,jj,jk) = e3t_1d(jk) 440 ENDDO 441 ENDDO 442 ENDDO 443 444 !zt_crs=ocean_volume_crs_t ; zs_crs=facvol_t after time !!! 445 CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, zt_crs, zs_crs ) 446 447 #endif 448 449 #if defined key_vvl 450 z1_2dt = 1._wp / ( 2. * rdt ) ! set time step size (Euler/Leapfrog) 451 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1._wp / rdt 452 wn_crs(:,:,jpk) = 0._wp 453 DO jk = jpkm1, 1, -1 454 wn_crs(:,:,jk) = wn_crs(:,:,jk+1)*e1e2w_msk(:,:,jk+1) - ( hdivn_crs(:,:,jk) & 455 & + z1_2dt * e1e2w_crs(:,:,jk) * ( e3t_a_crs(:,:,jk) - e3t_b_crs(:,:,jk) ) ) * tmask_crs(:,:,jk) 456 WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp ) wn_crs(:,:,jk) = wn_crs(:,:,jk) /e1e2w_msk(:,:,jk) 457 ENDDO 458 #else 459 IF( ln_crs_wn ) THEN 460 CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 461 ELSE 462 wn_crs(:,:,jpk) = 0._wp 463 DO jk = jpkm1, 1, -1 464 wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk) 465 WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp ) wn_crs(:,:,jk) = wn_crs(:,:,jk) /e1e2w_msk(:,:,jk) 466 ENDDO 467 ENDIF 468 469 #endif 470 CALL crs_lbc_lnk( wn_crs, 'W', 1.0 ) !!!!!!!pas utile, nan ?????????????????????? 471 wn_crs(:,:,:) = wn_crs(:,:,:) * tmask_crs(:,:,:) 472 CALL iom_put( "woce", wn_crs ) ! vertical velocity 473 455 474 ! free memory 456 475 CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )
Note: See TracChangeset
for help on using the changeset viewer.
