Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r2779 r3294 20 20 USE lib_mpp ! distributed memory computing library 21 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 USE wrk_nemo ! Memory allocation 23 USE timing ! Timing 22 24 23 25 IMPLICIT NONE 24 26 PRIVATE 25 27 26 PUBLIC dom_vvl ! called by domain.F9027 PUBLIC dom_vvl_ alloc ! called by nemogcm.F9028 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ee_t, ee_u, ee_v, ee_f !: ??? 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mut , muu , muv , muf !: ???28 PUBLIC dom_vvl ! called by domain.F90 29 PUBLIC dom_vvl_2 ! called by domain.F90 30 PUBLIC dom_vvl_alloc ! called by nemogcm.F90 31 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mut , muu , muv , muf !: 1/H_0 at t-,u-,v-,f-points 31 33 32 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra … … 49 51 ! 50 52 ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) , & 51 & ee_t(jpi,jpj) , ee_u(jpi,jpj) , ee_v(jpi,jpj) , ee_f(jpi,jpj) , &52 53 & r2dt (jpk) , STAT=dom_vvl_alloc ) 53 54 ! … … 62 63 !! *** ROUTINE dom_vvl *** 63 64 !! 64 !! ** Purpose : compute coefficients muX at T-U-V-F points to spread65 !! ssh over the whole water column (scale factors)66 !! ----------------------------------------------------------------------67 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released68 USE wrk_nemo, ONLY: zs_t => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3 ! 2D workspace65 !! ** Purpose : compute mu coefficients at t-, u-, v- and f-points to 66 !! spread ssh over the whole water column (scale factors) 67 !! set the before and now ssh at u- and v-points 68 !! (also f-point in now case) 69 !!---------------------------------------------------------------------- 69 70 ! 70 71 INTEGER :: ji, jj, jk ! dummy loop indices 71 REAL(wp) :: zcoefu , zcoefv , zcoeff ! local scalars 72 REAL(wp) :: zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1 ! - - 73 !!---------------------------------------------------------------------- 74 75 IF( wrk_in_use(2, 1,2,3) ) THEN 76 CALL ctl_stop('dom_vvl: requested workspace arrays unavailable') ; RETURN 77 ENDIF 78 72 REAL(wp) :: zcoefu, zcoefv , zcoeff ! local scalars 73 REAL(wp) :: zvt , zvt_ip1, zvt_jp1, zvt_ip1jp1 ! - - 74 REAL(wp), POINTER, DIMENSION(:,:) :: zee_t, zee_u, zee_v, zee_f ! 2D workspace 75 !!---------------------------------------------------------------------- 76 ! 77 IF( nn_timing == 1 ) CALL timing_start('dom_vvl') 78 ! 79 CALL wrk_alloc( jpi, jpj, zee_t, zee_u, zee_v, zee_f ) 80 ! 79 81 IF(lwp) THEN 80 82 WRITE(numout,*) … … 97 99 98 100 ! !== mu computation ==! 99 ee_t(:,:) = fse3t_0(:,:,1) ! Lower bound : thickness of the first model level100 ee_u(:,:) = fse3u_0(:,:,1)101 ee_v(:,:) = fse3v_0(:,:,1)102 ee_f(:,:) = fse3f_0(:,:,1)101 zee_t(:,:) = fse3t_0(:,:,1) ! Lower bound : thickness of the first model level 102 zee_u(:,:) = fse3u_0(:,:,1) 103 zee_v(:,:) = fse3v_0(:,:,1) 104 zee_f(:,:) = fse3f_0(:,:,1) 103 105 DO jk = 2, jpkm1 ! Sum of the masked vertical scale factors 104 ee_t(:,:) =ee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk)105 ee_u(:,:) =ee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk)106 ee_v(:,:) =ee_v(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)106 zee_t(:,:) = zee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk) 107 zee_u(:,:) = zee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk) 108 zee_v(:,:) = zee_v(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk) 107 109 DO jj = 1, jpjm1 ! f-point : fmask=shlat at coasts, use the product of umask 108 ee_f(:,jj) =ee_f(:,jj) + fse3f_0(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)110 zee_f(:,jj) = zee_f(:,jj) + fse3f_0(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 109 111 END DO 110 112 END DO 111 113 ! ! Compute and mask the inverse of the local depth at T, U, V and F points 112 ee_t(:,:) = 1. /ee_t(:,:) * tmask(:,:,1)113 ee_u(:,:) = 1. /ee_u(:,:) * umask(:,:,1)114 ee_v(:,:) = 1. /ee_v(:,:) * vmask(:,:,1)114 zee_t(:,:) = 1._wp / zee_t(:,:) * tmask(:,:,1) 115 zee_u(:,:) = 1._wp / zee_u(:,:) * umask(:,:,1) 116 zee_v(:,:) = 1._wp / zee_v(:,:) * vmask(:,:,1) 115 117 DO jj = 1, jpjm1 ! f-point case fmask cannot be used 116 ee_f(:,jj) = 1. /ee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1)117 END DO 118 CALL lbc_lnk( ee_f, 'F', 1. )! lateral boundary condition on ee_f118 zee_f(:,jj) = 1._wp / zee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1) 119 END DO 120 CALL lbc_lnk( zee_f, 'F', 1. ) ! lateral boundary condition on ee_f 119 121 ! 120 122 DO jk = 1, jpk ! mu coefficients 121 mut(:,:,jk) = ee_t(:,:) * tmask(:,:,jk) ! T-point at T levels122 muu(:,:,jk) = ee_u(:,:) * umask(:,:,jk) ! U-point at T levels123 muv(:,:,jk) = ee_v(:,:) * vmask(:,:,jk) ! V-point at T levels123 mut(:,:,jk) = zee_t(:,:) * tmask(:,:,jk) ! T-point at T levels 124 muu(:,:,jk) = zee_u(:,:) * umask(:,:,jk) ! U-point at T levels 125 muv(:,:,jk) = zee_v(:,:) * vmask(:,:,jk) ! V-point at T levels 124 126 END DO 125 127 DO jk = 1, jpk ! F-point : fmask=shlat at coasts, use the product of umask 126 128 DO jj = 1, jpjm1 127 muf(:,jj,jk) = ee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk) ! at T levels128 END DO 129 muf(:,jpj,jk) = 0. e0129 muf(:,jj,jk) = zee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk) ! at T levels 130 END DO 131 muf(:,jpj,jk) = 0._wp 130 132 END DO 131 133 CALL lbc_lnk( muf, 'F', 1. ) ! lateral boundary condition … … 139 141 END DO 140 142 141 ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations142 ! for ssh and scale factors143 zs_t (:,:) = e1t(:,:) * e2t(:,:)144 zs_u_1(:,:) = 0.5 / ( e1u(:,:) * e2u(:,:) )145 zs_v_1(:,:) = 0.5 / ( e1v(:,:) * e2v(:,:) )146 147 143 DO jj = 1, jpjm1 ! initialise before and now Sea Surface Height at u-, v-, f-points 148 144 DO ji = 1, jpim1 ! NO vector opt. 149 zcoefu = umask(ji,jj,1) * zs_u_1(ji,jj)150 zcoefv = vmask(ji,jj,1) * zs_v_1(ji,jj)151 zcoeff = 0. 5 * umask(ji,jj,1) * umask(ji,jj+1,1) / ( e1f(ji,jj) * e2f(ji,jj))152 ! before fields153 zv _t_ij = zs_t(ji ,jj ) * sshb(ji ,jj )154 zv _t_ip1j = zs_t(ji+1,jj ) * sshb(ji+1,jj )155 zv _t_ijp1 = zs_t(ji ,jj+1) * sshb(ji ,jj+1)156 sshu_b(ji,jj) = zcoefu * ( zv _t_ij + zv_t_ip1j)157 sshv_b(ji,jj) = zcoefv * ( zv _t_ij + zv_t_ijp1 )158 ! now fields159 zv _t_ij = zs_t(ji ,jj ) * sshn(ji ,jj )160 zv _t_ip1j = zs_t(ji+1,jj ) * sshn(ji+1,jj )161 zv _t_ijp1 = zs_t(ji ,jj+1) * sshn(ji ,jj+1)162 zv _t_ip1jp1 = zs_t(ji ,jj+1) * sshn(ji,jj+1)163 sshu_n(ji,jj) = zcoefu * ( zv _t_ij + zv_t_ip1j)164 sshv_n(ji,jj) = zcoefv * ( zv _t_ij + zv_t_ijp1 )165 sshf_n(ji,jj) = zcoeff * ( zv _t_ij + zv_t_ip1j + zv_t_ijp1 + zv_t_ip1jp1 )145 zcoefu = 0.50_wp / ( e1u(ji,jj) * e2u(ji,jj) ) * umask(ji,jj,1) 146 zcoefv = 0.50_wp / ( e1v(ji,jj) * e2v(ji,jj) ) * vmask(ji,jj,1) 147 zcoeff = 0.25_wp / ( e1f(ji,jj) * e2f(ji,jj) ) * umask(ji,jj,1) * umask(ji,jj+1,1) 148 ! 149 zvt = e1e2t(ji ,jj ) * sshb(ji ,jj ) ! before fields 150 zvt_ip1 = e1e2t(ji+1,jj ) * sshb(ji+1,jj ) 151 zvt_jp1 = e1e2t(ji ,jj+1) * sshb(ji ,jj+1) 152 sshu_b(ji,jj) = zcoefu * ( zvt + zvt_ip1 ) 153 sshv_b(ji,jj) = zcoefv * ( zvt + zvt_jp1 ) 154 ! 155 zvt = e1e2t(ji ,jj ) * sshn(ji ,jj ) ! now fields 156 zvt_ip1 = e1e2t(ji+1,jj ) * sshn(ji+1,jj ) 157 zvt_jp1 = e1e2t(ji ,jj+1) * sshn(ji ,jj+1) 158 zvt_ip1jp1 = e1e2t(ji+1,jj+1) * sshn(ji+1,jj+1) 159 sshu_n(ji,jj) = zcoefu * ( zvt + zvt_ip1 ) 160 sshv_n(ji,jj) = zcoefv * ( zvt + zvt_jp1 ) 161 sshf_n(ji,jj) = zcoeff * ( zvt + zvt_ip1 + zvt_jp1 + zvt_ip1jp1 ) 166 162 END DO 167 163 END DO … … 169 165 CALL lbc_lnk( sshv_n, 'V', 1. ) ; CALL lbc_lnk( sshv_b, 'V', 1. ) 170 166 CALL lbc_lnk( sshf_n, 'F', 1. ) 171 172 ! initialise before scale factors at (u/v)-points 173 ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 174 DO jk = 1, jpkm1 175 DO jj = 1, jpjm1 176 DO ji = 1, jpim1 177 zv_t_ij = zs_t(ji ,jj ) * fse3t_b(ji ,jj ,jk) 178 zv_t_ip1j = zs_t(ji+1,jj ) * fse3t_b(ji+1,jj ,jk) 179 zv_t_ijp1 = zs_t(ji ,jj+1) * fse3t_b(ji ,jj+1,jk) 180 fse3u_b(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 181 fse3v_b(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 182 END DO 183 END DO 184 END DO 185 CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. ) ! lateral boundary conditions 186 CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. ) 187 ! Add initial scale factor to scale factor anomaly 188 fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:) 189 fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 190 ! 191 IF( wrk_not_released(2, 1,2,3) ) CALL ctl_stop('dom_vvl: failed to release workspace arrays') 167 ! 168 CALL wrk_dealloc( jpi, jpj, zee_t, zee_u, zee_v, zee_f ) 169 ! 170 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl') 192 171 ! 193 172 END SUBROUTINE dom_vvl 194 173 174 175 SUBROUTINE dom_vvl_2( kt, pe3u_b, pe3v_b ) 176 !!---------------------------------------------------------------------- 177 !! *** ROUTINE dom_vvl_2 *** 178 !! 179 !! ** Purpose : compute the vertical scale factors at u- and v-points 180 !! in variable volume case. 181 !! 182 !! ** Method : In variable volume case (non linear sea surface) the 183 !! the vertical scale factor at velocity points is computed 184 !! as the average of the cell surface weighted e3t. 185 !! It uses the sea surface heigth so it have to be initialized 186 !! after ssh is read/set 187 !!---------------------------------------------------------------------- 188 INTEGER , INTENT(in ) :: kt ! ocean time-step index 189 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe3u_b, pe3v_b ! before vertical scale factor at u- & v-pts 190 ! 191 INTEGER :: ji, jj, jk ! dummy loop indices 192 INTEGER :: iku, ikv ! local integers 193 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 194 REAL(wp) :: zvt ! local scalars 195 !!---------------------------------------------------------------------- 196 ! 197 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_2') 198 ! 199 IF( lwp .AND. kt == nit000 ) THEN 200 WRITE(numout,*) 201 WRITE(numout,*) 'dom_vvl_2 : Variable volume, fse3t_b initialization' 202 WRITE(numout,*) '~~~~~~~~~ ' 203 pe3u_b(:,:,jpk) = fse3u_0(:,:,jpk) 204 pe3v_b(:,:,jpk) = fse3u_0(:,:,jpk) 205 ENDIF 206 207 DO jk = 1, jpkm1 ! set the before scale factors at u- & v-points 208 DO jj = 2, jpjm1 209 DO ji = fs_2, fs_jpim1 210 zvt = fse3t_b(ji,jj,jk) * e1e2t(ji,jj) 211 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1e2t(ji+1,jj) ) / ( e1u(ji,jj) * e2u(ji,jj) ) 212 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e1e2t(ji,jj+1) ) / ( e1v(ji,jj) * e2v(ji,jj) ) 213 END DO 214 END DO 215 END DO 216 217 ! Correct scale factors at locations that have been individually modified in domhgr 218 ! Such modifications break the relationship between e1e2t and e1u*e2u etc. Recompute 219 ! scale factors ignoring the modified metric. 220 ! ! ===================== 221 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 222 ! ! ===================== 223 IF( nn_cla == 0 ) THEN 224 ! 225 ii0 = 139 ; ii1 = 140 ! Gibraltar Strait (e2u was modified) 226 ij0 = 102 ; ij1 = 102 227 DO jk = 1, jpkm1 ! set the before scale factors at u-points 228 DO jj = mj0(ij0), mj1(ij1) 229 DO ji = mi0(ii0), mi1(ii1) 230 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 231 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 232 END DO 233 END DO 234 END DO 235 ! 236 ii0 = 160 ; ii1 = 160 ! Bab el Mandeb (e2u and e1v were modified) 237 ij0 = 88 ; ij1 = 88 238 DO jk = 1, jpkm1 ! set the before scale factors at u-points 239 DO jj = mj0(ij0), mj1(ij1) 240 DO ji = mi0(ii0), mi1(ii1) 241 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 242 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 243 END DO 244 END DO 245 END DO 246 DO jk = 1, jpkm1 ! set the before scale factors at v-points 247 DO jj = mj0(ij0), mj1(ij1) 248 DO ji = mi0(ii0), mi1(ii1) 249 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 250 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 251 END DO 252 END DO 253 END DO 254 ENDIF 255 256 ii0 = 145 ; ii1 = 146 ! Danish Straits (e2u was modified) 257 ij0 = 116 ; ij1 = 116 258 DO jk = 1, jpkm1 ! set the before scale factors at u-points 259 DO jj = mj0(ij0), mj1(ij1) 260 DO ji = mi0(ii0), mi1(ii1) 261 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 262 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 263 END DO 264 END DO 265 END DO 266 ! 267 ENDIF 268 ! ! ===================== 269 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 270 ! ! ===================== 271 272 ii0 = 281 ; ii1 = 282 ! Gibraltar Strait (e2u was modified) 273 ij0 = 200 ; ij1 = 200 274 DO jk = 1, jpkm1 ! set the before scale factors at u-points 275 DO jj = mj0(ij0), mj1(ij1) 276 DO ji = mi0(ii0), mi1(ii1) 277 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 278 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 279 END DO 280 END DO 281 END DO 282 283 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u was modified) 284 ij0 = 208 ; ij1 = 208 285 DO jk = 1, jpkm1 ! set the before scale factors at u-points 286 DO jj = mj0(ij0), mj1(ij1) 287 DO ji = mi0(ii0), mi1(ii1) 288 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 289 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 290 END DO 291 END DO 292 END DO 293 294 ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v was modified) 295 ij0 = 124 ; ij1 = 125 296 DO jk = 1, jpkm1 ! set the before scale factors at v-points 297 DO jj = mj0(ij0), mj1(ij1) 298 DO ji = mi0(ii0), mi1(ii1) 299 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 300 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 301 END DO 302 END DO 303 END DO 304 305 ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v was modified) [closed from bathy_11 on] 306 ij0 = 124 ; ij1 = 125 307 DO jk = 1, jpkm1 ! set the before scale factors at v-points 308 DO jj = mj0(ij0), mj1(ij1) 309 DO ji = mi0(ii0), mi1(ii1) 310 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 311 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 312 END DO 313 END DO 314 END DO 315 316 ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v was modified) 317 ij0 = 124 ; ij1 = 125 318 DO jk = 1, jpkm1 ! set the before scale factors at v-points 319 DO jj = mj0(ij0), mj1(ij1) 320 DO ji = mi0(ii0), mi1(ii1) 321 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 322 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 323 END DO 324 END DO 325 END DO 326 327 ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v was modified) 328 ij0 = 124 ; ij1 = 125 329 DO jk = 1, jpkm1 ! set the before scale factors at v-points 330 DO jj = mj0(ij0), mj1(ij1) 331 DO ji = mi0(ii0), mi1(ii1) 332 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 333 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 334 END DO 335 END DO 336 END DO 337 338 ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v was modified) 339 ij0 = 141 ; ij1 = 142 340 DO jk = 1, jpkm1 ! set the before scale factors at v-points 341 DO jj = mj0(ij0), mj1(ij1) 342 DO ji = mi0(ii0), mi1(ii1) 343 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 344 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 345 END DO 346 END DO 347 END DO 348 349 ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v was modified) 350 ij0 = 141 ; ij1 = 142 351 DO jk = 1, jpkm1 ! set the before scale factors at v-points 352 DO jj = mj0(ij0), mj1(ij1) 353 DO ji = mi0(ii0), mi1(ii1) 354 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 355 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 356 END DO 357 END DO 358 END DO 359 360 ! 361 ENDIF 362 ! ! ====================== 363 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration 364 ! ! ====================== 365 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u was modified) 366 ij0 = 327 ; ij1 = 327 367 DO jk = 1, jpkm1 ! set the before scale factors at u-points 368 DO jj = mj0(ij0), mj1(ij1) 369 DO ji = mi0(ii0), mi1(ii1) 370 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 371 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 372 END DO 373 END DO 374 END DO 375 ! 376 ii0 = 627 ; ii1 = 628 ! Bosphore Strait (e2u was modified) 377 ij0 = 343 ; ij1 = 343 378 DO jk = 1, jpkm1 ! set the before scale factors at u-points 379 DO jj = mj0(ij0), mj1(ij1) 380 DO ji = mi0(ii0), mi1(ii1) 381 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 382 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 383 END DO 384 END DO 385 END DO 386 ! 387 ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u was modified) 388 ij0 = 232 ; ij1 = 232 389 DO jk = 1, jpkm1 ! set the before scale factors at u-points 390 DO jj = mj0(ij0), mj1(ij1) 391 DO ji = mi0(ii0), mi1(ii1) 392 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 393 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 394 END DO 395 END DO 396 END DO 397 ! 398 ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u was modified) 399 ij0 = 232 ; ij1 = 232 400 DO jk = 1, jpkm1 ! set the before scale factors at u-points 401 DO jj = mj0(ij0), mj1(ij1) 402 DO ji = mi0(ii0), mi1(ii1) 403 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 404 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 405 END DO 406 END DO 407 END DO 408 ! 409 ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u was modified) 410 ij0 = 270 ; ij1 = 270 411 DO jk = 1, jpkm1 ! set the before scale factors at u-points 412 DO jj = mj0(ij0), mj1(ij1) 413 DO ji = mi0(ii0), mi1(ii1) 414 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 415 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 416 END DO 417 END DO 418 END DO 419 ! 420 ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v was modified) 421 ij0 = 232 ; ij1 = 233 422 DO jk = 1, jpkm1 ! set the before scale factors at v-points 423 DO jj = mj0(ij0), mj1(ij1) 424 DO ji = mi0(ii0), mi1(ii1) 425 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 426 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 427 END DO 428 END DO 429 END DO 430 ! 431 ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v was modified) 432 ij0 = 276 ; ij1 = 276 433 DO jk = 1, jpkm1 ! set the before scale factors at v-points 434 DO jj = mj0(ij0), mj1(ij1) 435 DO ji = mi0(ii0), mi1(ii1) 436 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 437 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 438 END DO 439 END DO 440 END DO 441 ! 442 ENDIF 443 ! End of individual corrections to scale factors 444 445 IF( ln_zps ) THEN ! minimum of the e3t at partial cell level 446 DO jj = 2, jpjm1 447 DO ji = fs_2, fs_jpim1 448 iku = mbku(ji,jj) 449 ikv = mbkv(ji,jj) 450 pe3u_b(ji,jj,iku) = MIN( fse3t_b(ji,jj,iku), fse3t_b(ji+1,jj ,iku) ) 451 pe3v_b(ji,jj,ikv) = MIN( fse3t_b(ji,jj,ikv), fse3t_b(ji ,jj+1,ikv) ) 452 END DO 453 END DO 454 ENDIF 455 456 pe3u_b(:,:,:) = pe3u_b(:,:,:) - fse3u_0(:,:,:) ! anomaly to avoid zero along closed boundary/extra halos 457 pe3v_b(:,:,:) = pe3v_b(:,:,:) - fse3v_0(:,:,:) 458 CALL lbc_lnk( pe3u_b(:,:,:), 'U', 1. ) ! lateral boundary conditions 459 CALL lbc_lnk( pe3v_b(:,:,:), 'V', 1. ) 460 pe3u_b(:,:,:) = pe3u_b(:,:,:) + fse3u_0(:,:,:) ! recover the full scale factor 461 pe3v_b(:,:,:) = pe3v_b(:,:,:) + fse3v_0(:,:,:) 462 ! 463 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_2') 464 ! 465 END SUBROUTINE dom_vvl_2 466 195 467 #else 196 468 !!---------------------------------------------------------------------- … … 200 472 SUBROUTINE dom_vvl 201 473 END SUBROUTINE dom_vvl 474 SUBROUTINE dom_vvl_2(kdum, pudum, pvdum ) 475 USE par_kind 476 INTEGER , INTENT(in ) :: kdum 477 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pudum, pvdum 478 END SUBROUTINE dom_vvl_2 202 479 #endif 203 480
Note: See TracChangeset
for help on using the changeset viewer.
