- Timestamp:
- 2015-12-16T10:25:22+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r5836 r6060 33 33 34 34 !! * Substitutions 35 # include "zdfddm_substitute.h90"36 # include "domzgr_substitute.h90"37 35 # include "vectopt_loop_substitute.h90" 38 36 !!---------------------------------------------------------------------- … … 61 59 REAL(wp) :: z2dcrsu, z2dcrsv ! local scalars 62 60 ! 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: z fse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e361 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e3 64 62 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zt_crs 65 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs, zs_crs … … 69 67 70 68 ! Initialize arrays 71 CALL wrk_alloc( jpi,jpj,jpk, z fse3t, zfse3w )72 CALL wrk_alloc( jpi,jpj,jpk, z fse3u, zfse3v )73 CALL wrk_alloc( jpi,jpj,jpk, zt , zs)74 ! 75 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 ) 76 74 77 75 ! Depth work arrrays 78 z fse3t(:,:,:) = fse3t(:,:,:)79 z fse3u(:,:,:) = fse3u(:,:,:)80 z fse3v(:,:,:) = fse3v(:,:,:)81 z fse3w(:,:,:) = fse3w(:,:,:)76 ze3t(:,:,:) = e3t_n(:,:,:) 77 ze3u(:,:,:) = e3u_n(:,:,:) 78 ze3v(:,:,:) = e3v_n(:,:,:) 79 ze3w(:,:,:) = e3w_n(:,:,:) 82 80 83 81 IF( kt == nit000 ) THEN … … 107 105 ! Temperature 108 106 zt(:,:,:) = tsn(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp 109 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 ) 110 108 tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 111 109 … … 116 114 ! Salinity 117 115 zs(:,:,:) = tsn(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp 118 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 ) 119 117 tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 120 118 … … 123 121 124 122 ! U-velocity 125 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 ) 126 124 ! 127 125 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 134 132 END DO 135 133 END DO 136 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 )137 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 ) 138 136 139 137 CALL iom_put( "uoce" , un_crs ) ! i-current … … 142 140 143 141 ! V-velocity 144 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 ) 145 143 ! 146 144 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 153 151 END DO 154 152 END DO 155 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 )156 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 ) 157 155 158 156 CALL iom_put( "voce" , vn_crs ) ! i-current … … 162 160 163 161 ! Kinetic energy 164 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 ) 165 163 CALL iom_put( "eken", rke_crs ) 166 164 … … 188 186 IF( ln_crs_wn ) THEN 189 187 CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 190 ! 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 ) 191 189 ELSE 192 190 wn_crs(:,:,jpk) = 0._wp … … 199 197 200 198 ! avt, avs 199 !!gm BUG TOP always uses avs !!! 201 200 SELECT CASE ( nn_crs_kz ) 202 201 CASE ( 0 ) 203 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 ) 204 203 CASE ( 1 ) 205 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 ) 206 205 CASE ( 2 ) 207 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 ) 208 207 END SELECT 209 208 ! … … 211 210 212 211 ! sbc fields 213 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 ) 214 213 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 ) 215 214 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 ) … … 233 232 234 233 ! free memory 235 CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )236 CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v )237 CALL wrk_dealloc( jpi, jpj, jpk, zt, zs)238 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 ) 239 238 ! 240 239 CALL iom_swap( "nemo" ) ! return back on high-resolution grid
Note: See TracChangeset
for help on using the changeset viewer.