- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r5217 r6808 11 11 !! other variables needed to be passed to TOP 12 12 !!---------------------------------------------------------------------- 13 USE oce ! ocean dynamics and tracers14 USE dom_oce ! ocean space and time domain15 USE ldftra_oce ! ocean active tracers: lateral physics16 USE sbc_oce ! Surface boundary condition: ocean fields17 USE zdf_oce ! vertical physics: ocean fields18 USE zdfddm ! vertical physics: double diffusion19 USE lbclnk ! ocean lateral boundary conditions (or mpp link)20 USE in_out_manager ! I/O manager21 USE timing ! preformance summary22 USE wrk_nemo ! working array23 13 USE crs 24 14 USE crsdom 25 15 USE crslbclnk 26 USE iom 16 USE oce ! ocean dynamics and tracers 17 USE dom_oce ! ocean space and time domain 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE zdf_oce ! vertical physics: ocean fields 20 USE ldftra ! ocean active tracers: lateral diffusivity & EIV coefficients 21 USE zdfddm ! vertical physics: double diffusion 22 ! 23 USE in_out_manager ! I/O manager 24 USE iom ! 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE timing ! preformance summary 27 USE wrk_nemo ! working array 27 28 28 29 IMPLICIT NONE … … 31 32 PUBLIC crs_fld ! routines called by step.F90 32 33 33 34 34 !! * Substitutions 35 # include "zdfddm_substitute.h90"36 # include "domzgr_substitute.h90"37 35 # include "vectopt_loop_substitute.h90" 38 36 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)37 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 40 38 !! $Id$ 41 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 52 50 !! 2. At time of output, rescale [1] by dimension and time 53 51 !! to yield the spatial and temporal average. 54 !! See. diawri_dimg.h90,sbcmod.F9052 !! See. sbcmod.F90 55 53 !! 56 54 !! ** Method : 57 55 !!---------------------------------------------------------------------- 58 !! 59 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 !! 62 INTEGER :: ji, jj, jk ! dummy loop indices 63 !! 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 65 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs 66 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 67 REAL(wp) :: z2dcrsu, z2dcrsv 68 !! 69 !!---------------------------------------------------------------------- 56 INTEGER, INTENT(in) :: kt ! ocean time-step index 57 ! 58 INTEGER :: ji, jj, jk ! dummy loop indices 59 REAL(wp) :: z2dcrsu, z2dcrsv ! local scalars 60 ! 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e3 62 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zt_crs 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs, zs_crs 64 !!---------------------------------------------------------------------- 70 65 ! 71 72 66 IF( nn_timing == 1 ) CALL timing_start('crs_fld') 73 67 74 68 ! Initialize arrays 75 CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w )76 CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v )77 CALL wrk_alloc( jpi, jpj, jpk, zt, zs)78 ! 79 CALL wrk_alloc( jpi_crs, jpj_crs, jpk,zt_crs, zs_crs )69 CALL wrk_alloc( jpi,jpj,jpk, ze3t, ze3w ) 70 CALL wrk_alloc( jpi,jpj,jpk, ze3u, ze3v ) 71 CALL wrk_alloc( jpi,jpj,jpk, zt , zs ) 72 ! 73 CALL wrk_alloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs ) 80 74 81 75 ! Depth work arrrays 82 z fse3t(:,:,:) = fse3t(:,:,:)83 z fse3u(:,:,:) = fse3u(:,:,:)84 z fse3v(:,:,:) = fse3v(:,:,:)85 z fse3w(:,:,:) = fse3w(:,:,:)76 ze3t(:,:,:) = e3t_n(:,:,:) 77 ze3u(:,:,:) = e3u_n(:,:,:) 78 ze3v(:,:,:) = e3v_n(:,:,:) 79 ze3w(:,:,:) = e3w_n(:,:,:) 86 80 87 81 IF( kt == nit000 ) THEN … … 111 105 ! Temperature 112 106 zt(:,:,:) = tsn(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp 113 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=z fse3t, psgn=1.0 )107 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 114 108 tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 115 109 … … 120 114 ! Salinity 121 115 zs(:,:,:) = tsn(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp 122 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=z fse3t, psgn=1.0 )116 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 123 117 tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 124 118 … … 127 121 128 122 ! U-velocity 129 CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=z fse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )123 CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 130 124 ! 131 125 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 138 132 END DO 139 133 END DO 140 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=z fse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )141 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=z fse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )134 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 135 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 142 136 143 137 CALL iom_put( "uoce" , un_crs ) ! i-current … … 146 140 147 141 ! V-velocity 148 CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=z fse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )142 CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 149 143 ! 150 144 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 157 151 END DO 158 152 END DO 159 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=z fse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )160 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=z fse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )153 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 154 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 161 155 162 156 CALL iom_put( "voce" , vn_crs ) ! i-current … … 166 160 167 161 ! Kinetic energy 168 CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=z fse3t, psgn=1.0 )162 CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 169 163 CALL iom_put( "eken", rke_crs ) 170 164 171 ! Horizontal divergence ( following OPA_SRC/DYN/div cur.F90 )165 ! Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 ) 172 166 DO jk = 1, jpkm1 173 167 DO ji = 2, jpi_crsm1 … … 192 186 IF( ln_crs_wn ) THEN 193 187 CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 194 ! CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=z fse3w )188 ! CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 195 189 ELSE 196 190 wn_crs(:,:,jpk) = 0._wp … … 203 197 204 198 ! avt, avs 199 !!gm BUG TOP always uses avs !!! 205 200 SELECT CASE ( nn_crs_kz ) 206 201 CASE ( 0 ) 207 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=z fse3w, psgn=1.0 )202 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 208 203 CASE ( 1 ) 209 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=z fse3w, psgn=1.0 )204 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 210 205 CASE ( 2 ) 211 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=z fse3w, psgn=1.0 )206 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 212 207 END SELECT 213 208 ! … … 215 210 216 211 ! sbc fields 217 CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=z fse3t, psgn=1.0 )212 CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0 ) 218 213 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 ) 219 214 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 ) … … 237 232 238 233 ! free memory 239 CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )240 CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v )241 CALL wrk_dealloc( jpi, jpj, jpk, zt, zs)242 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk,zt_crs, zs_crs )234 CALL wrk_dealloc( jpi,jpj,jpk, ze3t, ze3w ) 235 CALL wrk_dealloc( jpi,jpj,jpk, ze3u, ze3v ) 236 CALL wrk_dealloc( jpi,jpj,jpk, zt , zs ) 237 CALL wrk_dealloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs ) 243 238 ! 244 239 CALL iom_swap( "nemo" ) ! return back on high-resolution grid
Note: See TracChangeset
for help on using the changeset viewer.