- Timestamp:
- 2015-02-20T20:11:47+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5094_UKMO_ISFCLEAN/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r4990 r5098 8 8 !! - ! 2004-03 (C. Ethe) adapted for passive tracers 9 9 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 10 !! 3.6 ! 2014-11 (P. Mathiot) Add zps_hde_isf (needed to open a cavity) 10 11 !!====================================================================== 11 12 … … 27 28 PRIVATE 28 29 29 PUBLIC zps_hde ! routine called by step.F90 30 PUBLIC zps_hde ! routine called by step.F90 31 PUBLIC zps_hde_isf ! routine called by step.F90 30 32 31 33 !! * Substitutions … … 40 42 41 43 SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, & 42 & prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv, & 43 & sgtu, sgtv, sgru, sgrv, smru, smrv, sgzu, sgzv, sge3ru, sge3rv ) 44 & prd, pgru, pgrv ) 44 45 !!---------------------------------------------------------------------- 45 46 !! *** ROUTINE zps_hde *** … … 82 83 !! 83 84 !! ** Action : compute for top and bottom interfaces 84 !! - pgtu, pgtv, sgtu, sgtv: horizontal gradient of tracer at u- & v-points 85 !! - pgru, pgrv, sgru, sgtv: horizontal gradient of rho (if present) at u- & v-points 86 !! - pmru, pmrv, smru, smrv: horizontal sum of rho at u- & v- point (used in dynhpg with vvl) 87 !! - pgzu, pgzv, sgzu, sgzv: horizontal gradient of z at u- and v- point (used in dynhpg with vvl) 88 !! - pge3ru, pge3rv, sge3ru, sge3rv: horizontal gradient of rho weighted by local e3w at u- & v-points 85 !! - pgtu, pgtv: horizontal gradient of tracer at u- & v-points 86 !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 89 87 !!---------------------------------------------------------------------- 90 88 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 92 90 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 93 91 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 94 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: sgtu, sgtv ! hor. grad. of stra at u- & v-pts (ISF)95 92 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 96 93 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 97 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmru, pmrv ! hor. sum of prd at u- & v-pts (bottom)98 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzu, pgzv ! hor. grad of z at u- & v-pts (bottom)99 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3ru, pge3rv ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom)100 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: sgru, sgrv ! hor. grad of prd at u- & v-pts (top)101 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: smru, smrv ! hor. sum of prd at u- & v-pts (top)102 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: sgzu, sgzv ! hor. grad of z at u- & v-pts (top)103 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: sge3ru, sge3rv ! hor. grad of prd weighted by local e3w at u- & v-pts (top)104 94 ! 105 95 INTEGER :: ji, jj, jn ! Dummy loop indices … … 113 103 ! 114 104 pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 115 sgtu(:,:,:)=0.0_wp ; sgtv(:,:,:)=0.0_wp ; 105 zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ; 106 zhi (:,: )=0.0_wp ; zhj (:,: )=0.0_wp ; 107 ! 108 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 109 ! 110 DO jj = 1, jpjm1 111 DO ji = 1, jpim1 112 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 113 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 114 ! (ISF) case partial step top and bottom in adjacent cell in vertical 115 ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 116 ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 117 ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 118 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 119 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 120 ! 121 ! i- direction 122 IF( ze3wu >= 0._wp ) THEN ! case 1 123 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 124 ! interpolated values of tracers 125 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 126 ! gradient of tracers 127 pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 128 ELSE ! case 2 129 zmaxu = -ze3wu / fse3w(ji,jj,iku) 130 ! interpolated values of tracers 131 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 132 ! gradient of tracers 133 pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 134 ENDIF 135 ! 136 ! j- direction 137 IF( ze3wv >= 0._wp ) THEN ! case 1 138 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 139 ! interpolated values of tracers 140 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 141 ! gradient of tracers 142 pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 143 ELSE ! case 2 144 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 145 ! interpolated values of tracers 146 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 147 ! gradient of tracers 148 pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 149 ENDIF 150 END DO 151 END DO 152 CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 153 ! 154 END DO 155 156 ! horizontal derivative of density anomalies (rd) 157 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 158 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 159 DO jj = 1, jpjm1 160 DO ji = 1, jpim1 161 iku = mbku(ji,jj) 162 ikv = mbkv(ji,jj) 163 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 164 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 165 166 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) - ze3wu ! i-direction: case 1 167 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) + ze3wu ! - - case 2 168 ENDIF 169 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) - ze3wv ! j-direction: case 1 170 ELSE ; zhj(ji,jj) = fsdept(ji,jj ,ikv) + ze3wv ! - - case 2 171 ENDIF 172 END DO 173 END DO 174 175 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 176 ! step and store it in zri, zrj for each case 177 CALL eos( zti, zhi, zri ) 178 CALL eos( ztj, zhj, zrj ) 179 180 ! Gradient of density at the last level 181 DO jj = 1, jpjm1 182 DO ji = 1, jpim1 183 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 184 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! last and before last ocean level at u- & v-points 185 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 186 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 187 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj) - prd(ji,jj,iku) ) ! i: 1 188 ELSE ; pgru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 189 ENDIF 190 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 191 ELSE ; pgrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 192 ENDIF 193 END DO 194 END DO 195 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions 196 ! 197 END IF 198 ! 199 IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde') 200 ! 201 END SUBROUTINE zps_hde 202 ! 203 SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, & 204 & prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv, & 205 & pgtui, pgtvi, pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi ) 206 !!---------------------------------------------------------------------- 207 !! *** ROUTINE zps_hde *** 208 !! 209 !! ** Purpose : Compute the horizontal derivative of T, S and rho 210 !! at u- and v-points with a linear interpolation for z-coordinate 211 !! with partial steps. 212 !! 213 !! ** Method : In z-coord with partial steps, scale factors on last 214 !! levels are different for each grid point, so that T, S and rd 215 !! points are not at the same depth as in z-coord. To have horizontal 216 !! gradients again, we interpolate T and S at the good depth : 217 !! Linear interpolation of T, S 218 !! Computation of di(tb) and dj(tb) by vertical interpolation: 219 !! di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~ 220 !! dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~ 221 !! This formulation computes the two cases: 222 !! CASE 1 CASE 2 223 !! k-1 ___ ___________ k-1 ___ ___________ 224 !! Ti T~ T~ Ti+1 225 !! _____ _____ 226 !! k | |Ti+1 k Ti | | 227 !! | |____ ____| | 228 !! ___ | | | ___ | | | 229 !! 230 !! case 1-> e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then 231 !! t~ = t(i+1,j ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) 232 !! ( t~ = t(i ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1) ) 233 !! or 234 !! case 2-> e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then 235 !! t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) 236 !! ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) 237 !! Idem for di(s) and dj(s) 238 !! 239 !! For rho, we call eos which will compute rd~(t~,s~) at the right 240 !! depth zh from interpolated T and S for the different formulations 241 !! of the equation of state (eos). 242 !! Gradient formulation for rho : 243 !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ 244 !! 245 !! ** Action : compute for top and bottom interfaces 246 !! - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points 247 !! - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points 248 !! - pmru, pmrv, pmrui, pmrvi: horizontal sum of rho at u- & v- point (used in dynhpg with vvl) 249 !! - pgzu, pgzv, pgzui, pgzvi: horizontal gradient of z at u- and v- point (used in dynhpg with vvl) 250 !! - pge3ru, pge3rv, pge3rui, pge3rvi: horizontal gradient of rho weighted by local e3w at u- & v-points 251 !!---------------------------------------------------------------------- 252 INTEGER , INTENT(in ) :: kt ! ocean time-step index 253 INTEGER , INTENT(in ) :: kjpt ! number of tracers 254 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 255 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 256 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 257 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 258 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 259 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmru, pmrv ! hor. sum of prd at u- & v-pts (bottom) 260 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzu, pgzv ! hor. grad of z at u- & v-pts (bottom) 261 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3ru, pge3rv ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom) 262 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 263 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmrui, pmrvi ! hor. sum of prd at u- & v-pts (top) 264 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzui, pgzvi ! hor. grad of z at u- & v-pts (top) 265 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3rui, pge3rvi ! hor. grad of prd weighted by local e3w at u- & v-pts (top) 266 ! 267 INTEGER :: ji, jj, jn ! Dummy loop indices 268 INTEGER :: iku, ikv, ikum1, ikvm1,ikup1, ikvp1 ! partial step level (ocean bottom level) at u- and v-points 269 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv, zdzwu, zdzwv, zdzwuip1, zdzwvjp1 ! temporary scalars 270 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 271 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! 272 !!---------------------------------------------------------------------- 273 ! 274 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde_isf') 275 ! 276 pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 277 pgtui(:,:,:)=0.0_wp ; pgtvi(:,:,:)=0.0_wp ; 116 278 zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ; 117 279 zhi (:,: )=0.0_wp ; zhj (:,: )=0.0_wp ; … … 256 418 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) ) 257 419 ! gradient of tracers 258 sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )420 pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 259 421 ELSE ! case 2 260 422 zmaxu = - ze3wu / fse3w(ji,jj,iku+1) … … 262 424 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) ) 263 425 ! gradient of tracers 264 sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )426 pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 265 427 ENDIF 266 428 ! … … 271 433 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) ) 272 434 ! gradient of tracers 273 sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )435 pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 274 436 ELSE ! case 2 275 437 zmaxv = - ze3wv / fse3w(ji,jj,ikv+1) … … 277 439 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) ) 278 440 ! gradient of tracers 279 sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )441 pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 280 442 ENDIF 281 443 END DO!! 282 444 END DO!! 283 CALL lbc_lnk( sgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( sgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond.445 CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 284 446 ! 285 447 END DO … … 287 449 ! horizontal derivative of density anomalies (rd) 288 450 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 289 sgru(:,:) =0.0_wp ; sgrv(:,:) =0.0_wp ;290 sgzu(:,:) =0.0_wp ; sgzv(:,:) =0.0_wp ;291 smru(:,:) =0.0_wp ; smru(:,:) =0.0_wp ;292 sge3ru(:,:)=0.0_wp ; sge3rv(:,:)=0.0_wp ;451 pgrui(:,:) =0.0_wp ; pgrvi(:,:) =0.0_wp ; 452 pgzui(:,:) =0.0_wp ; pgzvi(:,:) =0.0_wp ; 453 pmrui(:,:) =0.0_wp ; pmrui(:,:) =0.0_wp ; 454 pge3rui(:,:)=0.0_wp ; pge3rvi(:,:)=0.0_wp ; 293 455 294 456 DO jj = 1, jpjm1 … … 321 483 ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 322 484 IF( ze3wu >= 0._wp ) THEN 323 sgzu(ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku)324 sgru(ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) - prd(ji,jj,iku) ) ! i: 1325 smru(ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) + prd(ji,jj,iku) ) ! i: 1326 sge3ru(ji,jj) = umask(ji,jj,iku+1) &485 pgzui (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku) 486 pgrui (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) - prd(ji,jj,iku) ) ! i: 1 487 pmrui (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) + prd(ji,jj,iku) ) ! i: 1 488 pge3rui(ji,jj) = umask(ji,jj,iku+1) & 327 489 * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj ) + prd(ji+1,jj,iku+1) + 2._wp) & 328 490 - fse3w(ji ,jj,iku+1) * (prd(ji,jj,iku) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 1 329 491 ELSE 330 sgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)331 sgru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2332 smru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2333 sge3ru(ji,jj) = umask(ji,jj,iku+1) &492 pgzui (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu) 493 pgrui (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 494 pmrui (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2 495 pge3rui(ji,jj) = umask(ji,jj,iku+1) & 334 496 * ( fse3w(ji+1,jj,iku+1) * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp) & 335 497 -(fse3w(ji ,jj,iku+1) + ze3wu) * (zri(ji,jj ) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 2 336 498 ENDIF 337 499 IF( ze3wv >= 0._wp ) THEN 338 sgzv(ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv)339 sgrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1340 smrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1341 sge3rv(ji,jj) = vmask(ji,jj,ikv+1) &500 pgzvi (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv) 501 pgrvi (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 502 pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1 503 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) & 342 504 * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj ) + prd(ji,jj+1,ikv+1) + 2._wp) & 343 505 - fse3w(ji,jj ,ikv+1) * ( prd(ji,jj,ikv) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 1 344 506 ! + 2 due to the formulation in density and not in anomalie in hpg sco 345 507 ELSE 346 sgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv)347 sgrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2348 smrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2349 sge3rv(ji,jj) = vmask(ji,jj,ikv+1) &508 pgzvi (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv) 509 pgrvi (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 510 pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2 511 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) & 350 512 * ( fse3w(ji,jj+1,ikv+1) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 351 513 -(fse3w(ji,jj ,ikv+1) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 2 … … 353 515 END DO 354 516 END DO 355 CALL lbc_lnk( sgru , 'U', -1. ) ; CALL lbc_lnk( sgrv, 'V', -1. ) ! Lateral boundary conditions356 CALL lbc_lnk( smru , 'U', 1. ) ; CALL lbc_lnk( smrv, 'V', 1. ) ! Lateral boundary conditions357 CALL lbc_lnk( sgzu , 'U', -1. ) ; CALL lbc_lnk( sgzv, 'V', -1. ) ! Lateral boundary conditions358 CALL lbc_lnk( sge3ru , 'U', -1. ) ; CALL lbc_lnk( sge3rv, 'V', -1. ) ! Lateral boundary conditions517 CALL lbc_lnk( pgrui , 'U', -1. ) ; CALL lbc_lnk( pgrvi , 'V', -1. ) ! Lateral boundary conditions 518 CALL lbc_lnk( pmrui , 'U', 1. ) ; CALL lbc_lnk( pmrvi , 'V', 1. ) ! Lateral boundary conditions 519 CALL lbc_lnk( pgzui , 'U', -1. ) ; CALL lbc_lnk( pgzvi , 'V', -1. ) ! Lateral boundary conditions 520 CALL lbc_lnk( pge3rui , 'U', -1. ) ; CALL lbc_lnk( pge3rvi , 'V', -1. ) ! Lateral boundary conditions 359 521 ! 360 522 END IF 361 523 ! 362 IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde') 363 ! 364 END SUBROUTINE zps_hde 365 524 IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde_isf') 525 ! 526 END SUBROUTINE zps_hde_isf 366 527 !!====================================================================== 367 528 END MODULE zpshde
Note: See TracChangeset
for help on using the changeset viewer.
