- Timestamp:
- 2015-01-20T15:26:13+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r3294 r5038 40 40 41 41 SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, & 42 prd, pgru, pgrv ) 42 & prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv, & 43 & sgtu, sgtv, sgru, sgrv, smru, smrv, sgzu, sgzv, sge3ru, sge3rv ) 43 44 !!---------------------------------------------------------------------- 44 45 !! *** ROUTINE zps_hde *** … … 74 75 !! Idem for di(s) and dj(s) 75 76 !! 76 !! For rho, we call eos _insitu_2d which will compute rd~(t~,s~) at77 !! the good depth zh from interpolated T and S for the different78 !! formulationof the equation of state (eos).77 !! For rho, we call eos which will compute rd~(t~,s~) at the right 78 !! depth zh from interpolated T and S for the different formulations 79 !! of the equation of state (eos). 79 80 !! Gradient formulation for rho : 80 !! di(rho) = rd~ - rd(i,j,k) orrd(i+1,j,k) - rd~81 !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ 81 82 !! 82 !! ** Action : - pgtu, pgtv: horizontal gradient of tracer at u- & v-points 83 !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 83 !! ** 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 84 89 !!---------------------------------------------------------------------- 85 !86 90 INTEGER , INTENT(in ) :: kt ! ocean time-step index 87 91 INTEGER , INTENT(in ) :: kjpt ! number of tracers 88 92 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 89 93 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) 90 95 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 91 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad. of prd at u- & v-pts 96 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) 92 104 ! 93 105 INTEGER :: ji, jj, jn ! Dummy loop indices 94 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points95 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars96 REAL(wp), POINTER, DIMENSION(:,: ) :: zri, zrj, zhi, zhj97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zti, ztj ! interpolated value of tracer106 INTEGER :: iku, ikv, ikum1, ikvm1,ikup1, ikvp1 ! partial step level (ocean bottom level) at u- and v-points 107 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv, zdzwu, zdzwv, zdzwuip1, zdzwvjp1 ! temporary scalars 108 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 109 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! 98 110 !!---------------------------------------------------------------------- 99 111 ! 100 112 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde') 101 113 ! 102 CALL wrk_alloc( jpi, jpj, zri, zrj, zhi, zhj ) 103 CALL wrk_alloc( jpi, jpj, kjpt, zti, ztj ) 114 pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 115 sgtu(:,:,:)=0.0_wp ; sgtv(:,:,:)=0.0_wp ; 116 zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ; 117 zhi (:,: )=0.0_wp ; zhj (:,: )=0.0_wp ; 104 118 ! 105 119 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 106 120 ! 107 # if defined key_vectopt_loop 108 jj = 1 109 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 110 # else 111 DO jj = 1, jpjm1 112 DO ji = 1, jpim1 113 # endif 121 DO jj = 1, jpjm1 122 DO ji = 1, jpim1 114 123 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 115 124 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 116 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 117 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 125 ! (ISF) case partial step top and bottom in adjacent cell in vertical 126 ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 127 ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 128 ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 129 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 130 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 118 131 ! 119 132 ! i- direction … … 121 134 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 122 135 ! interpolated values of tracers 123 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )136 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 124 137 ! gradient of tracers 125 pgtu(ji,jj,jn) = umask(ji,jj, 1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )138 pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 126 139 ELSE ! case 2 127 140 zmaxu = -ze3wu / fse3w(ji,jj,iku) 128 141 ! interpolated values of tracers 129 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )130 ! gradient of tracers 131 pgtu(ji,jj,jn) = umask(ji,jj, 1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )142 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 143 ! gradient of tracers 144 pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 132 145 ENDIF 133 146 ! … … 136 149 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 137 150 ! interpolated values of tracers 138 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )139 ! gradient of tracers 140 pgtv(ji,jj,jn) = vmask(ji,jj, 1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )151 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 152 ! gradient of tracers 153 pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 141 154 ELSE ! case 2 142 155 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 143 156 ! interpolated values of tracers 144 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 145 ! gradient of tracers 146 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 147 ENDIF 148 # if ! defined key_vectopt_loop 149 END DO 150 # endif 157 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 158 ! gradient of tracers 159 pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 160 ENDIF 161 END DO 151 162 END DO 152 163 CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond. … … 156 167 ! horizontal derivative of density anomalies (rd) 157 168 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 158 # if defined key_vectopt_loop 159 jj = 1 160 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 161 # else 162 DO jj = 1, jpjm1 163 DO ji = 1, jpim1 164 # endif 169 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 170 pgzu(:,:)=0.0_wp ; pgzv(:,:)=0.0_wp ; 171 pmru(:,:)=0.0_wp ; pmru(:,:)=0.0_wp ; 172 pge3ru(:,:)=0.0_wp ; pge3rv(:,:)=0.0_wp ; 173 DO jj = 1, jpjm1 174 DO ji = 1, jpim1 165 175 iku = mbku(ji,jj) 166 176 ikv = mbkv(ji,jj) 167 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 168 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 169 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji ,jj,iku) ! i-direction: case 1 170 ELSE ; zhi(ji,jj) = fsdept(ji+1,jj,iku) ! - - case 2 171 ENDIF 172 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj ,ikv) ! j-direction: case 1 173 ELSE ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) ! - - case 2 174 ENDIF 175 # if ! defined key_vectopt_loop 176 END DO 177 # endif 178 END DO 179 177 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 178 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 179 180 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) - ze3wu ! i-direction: case 1 181 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) + ze3wu ! - - case 2 182 ENDIF 183 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) - ze3wv ! j-direction: case 1 184 ELSE ; zhj(ji,jj) = fsdept(ji,jj ,ikv) + ze3wv ! - - case 2 185 ENDIF 186 END DO 187 END DO 188 180 189 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 181 190 ! step and store it in zri, zrj for each case … … 184 193 185 194 ! Gradient of density at the last level 186 # if defined key_vectopt_loop 187 jj = 1 188 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 189 # else 190 DO jj = 1, jpjm1 191 DO ji = 1, jpim1 192 # endif 193 iku = mbku(ji,jj) 194 ikv = mbkv(ji,jj) 195 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 196 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 197 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj) - prd(ji,jj,iku) ) ! i: 1 198 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 199 ENDIF 200 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 201 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 202 ENDIF 203 # if ! defined key_vectopt_loop 204 END DO 205 # endif 206 END DO 207 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions 195 DO jj = 1, jpjm1 196 DO ji = 1, jpim1 197 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 198 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! last and before last ocean level at u- & v-points 199 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 200 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 201 IF( ze3wu >= 0._wp ) THEN 202 pgzu(ji,jj) = (fsde3w(ji+1,jj,iku) - ze3wu) - fsde3w(ji,jj,iku) 203 pgru(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj) - prd(ji,jj,iku) ) ! i: 1 204 pmru(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj) + prd(ji,jj,iku) ) ! i: 1 205 pge3ru(ji,jj) = umask(ji,jj,iku) & 206 * ( (fse3w(ji+1,jj,iku) - ze3wu )* ( zri(ji ,jj ) + prd(ji+1,jj,ikum1) + 2._wp) & 207 - fse3w(ji ,jj,iku) * ( prd(ji ,jj,iku) + prd(ji ,jj,ikum1) + 2._wp) ) ! j: 2 208 ELSE 209 pgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) + ze3wu) 210 pgru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 211 pmru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2 212 pge3ru(ji,jj) = umask(ji,jj,iku) & 213 * ( fse3w(ji+1,jj,iku) * ( prd(ji+1,jj,iku) + prd(ji+1,jj,ikum1) + 2._wp) & 214 -(fse3w(ji ,jj,iku) + ze3wu) * ( zri(ji ,jj ) + prd(ji ,jj,ikum1) + 2._wp) ) ! j: 2 215 ENDIF 216 IF( ze3wv >= 0._wp ) THEN 217 pgzv(ji,jj) = (fsde3w(ji,jj+1,ikv) - ze3wv) - fsde3w(ji,jj,ikv) 218 pgrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 219 pmrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1 220 pge3rv(ji,jj) = vmask(ji,jj,ikv) & 221 * ( (fse3w(ji,jj+1,ikv) - ze3wv )* ( zrj(ji,jj ) + prd(ji,jj+1,ikvm1) + 2._wp) & 222 - fse3w(ji,jj ,ikv) * ( prd(ji,jj ,ikv) + prd(ji,jj ,ikvm1) + 2._wp) ) ! j: 2 223 ELSE 224 pgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) + ze3wv) 225 pgrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 226 pmrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2 227 pge3rv(ji,jj) = vmask(ji,jj,ikv) & 228 * ( fse3w(ji,jj+1,ikv) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikvm1) + 2._wp) & 229 -(fse3w(ji,jj ,ikv) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikvm1) + 2._wp) ) ! j: 2 230 ENDIF 231 END DO 232 END DO 233 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions 234 CALL lbc_lnk( pmru , 'U', 1. ) ; CALL lbc_lnk( pmrv , 'V', 1. ) ! Lateral boundary conditions 235 CALL lbc_lnk( pgzu , 'U', -1. ) ; CALL lbc_lnk( pgzv , 'V', -1. ) ! Lateral boundary conditions 236 CALL lbc_lnk( pge3ru , 'U', -1. ) ; CALL lbc_lnk( pge3rv , 'V', -1. ) ! Lateral boundary conditions 208 237 ! 209 238 END IF 210 ! 211 CALL wrk_dealloc( jpi, jpj, zri, zrj, zhi, zhj ) 212 CALL wrk_dealloc( jpi, jpj, kjpt, zti, ztj ) 239 ! (ISH) compute grui and gruvi 240 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! 241 DO jj = 1, jpjm1 242 DO ji = 1, jpim1 243 iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1 244 ikv = mikv(ji,jj) ; ikvp1 = mikv(ji,jj) + 1 245 ! 246 ! (ISF) case partial step top and bottom in adjacent cell in vertical 247 ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 248 ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 249 ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 250 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 251 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)) 252 ! i- direction 253 IF( ze3wu >= 0._wp ) THEN ! case 1 254 zmaxu = ze3wu / fse3w(ji+1,jj,iku+1) 255 ! interpolated values of tracers 256 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 ! gradient of tracers 258 sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 259 ELSE ! case 2 260 zmaxu = - ze3wu / fse3w(ji,jj,iku+1) 261 ! interpolated values of tracers 262 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) ) 263 ! gradient of tracers 264 sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 265 ENDIF 266 ! 267 ! j- direction 268 IF( ze3wv >= 0._wp ) THEN ! case 1 269 zmaxv = ze3wv / fse3w(ji,jj+1,ikv+1) 270 ! interpolated values of tracers 271 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 ! gradient of tracers 273 sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 274 ELSE ! case 2 275 zmaxv = - ze3wv / fse3w(ji,jj,ikv+1) 276 ! interpolated values of tracers 277 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) ) 278 ! gradient of tracers 279 sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 280 ENDIF 281 END DO!! 282 END DO!! 283 CALL lbc_lnk( sgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( sgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 284 ! 285 END DO 286 287 ! horizontal derivative of density anomalies (rd) 288 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 ; 293 294 DO jj = 1, jpjm1 295 DO ji = 1, jpim1 296 iku = miku(ji,jj) 297 ikv = mikv(ji,jj) 298 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 299 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)) 300 301 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu ! i-direction: case 1 302 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) - ze3wu ! - - case 2 303 ENDIF 304 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) + ze3wv ! j-direction: case 1 305 ELSE ; zhj(ji,jj) = fsdept(ji,jj ,ikv) - ze3wv ! - - case 2 306 ENDIF 307 END DO 308 END DO 309 310 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 311 ! step and store it in zri, zrj for each case 312 CALL eos( zti, zhi, zri ) 313 CALL eos( ztj, zhj, zrj ) 314 315 ! Gradient of density at the last level 316 DO jj = 1, jpjm1 317 DO ji = 1, jpim1 318 iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1 319 ikv = mikv(ji,jj) ; ikvp1 = mikv(ji,jj) + 1 320 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 321 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 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: 1 325 smru (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) + prd(ji,jj,iku) ) ! i: 1 326 sge3ru(ji,jj) = umask(ji,jj,iku+1) & 327 * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj ) + prd(ji+1,jj,iku+1) + 2._wp) & 328 - fse3w(ji ,jj,iku+1) * (prd(ji,jj,iku) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 1 329 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: 2 332 smru (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2 333 sge3ru(ji,jj) = umask(ji,jj,iku+1) & 334 * ( fse3w(ji+1,jj,iku+1) * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp) & 335 -(fse3w(ji ,jj,iku+1) + ze3wu) * (zri(ji,jj ) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 2 336 ENDIF 337 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: 1 340 smrv (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1 341 sge3rv(ji,jj) = vmask(ji,jj,ikv+1) & 342 * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj ) + prd(ji,jj+1,ikv+1) + 2._wp) & 343 - fse3w(ji,jj ,ikv+1) * ( prd(ji,jj,ikv) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 1 344 ! + 2 due to the formulation in density and not in anomalie in hpg sco 345 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: 2 348 smrv (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2 349 sge3rv(ji,jj) = vmask(ji,jj,ikv+1) & 350 * ( fse3w(ji,jj+1,ikv+1) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 351 -(fse3w(ji,jj ,ikv+1) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 2 352 ENDIF 353 END DO 354 END DO 355 CALL lbc_lnk( sgru , 'U', -1. ) ; CALL lbc_lnk( sgrv , 'V', -1. ) ! Lateral boundary conditions 356 CALL lbc_lnk( smru , 'U', 1. ) ; CALL lbc_lnk( smrv , 'V', 1. ) ! Lateral boundary conditions 357 CALL lbc_lnk( sgzu , 'U', -1. ) ; CALL lbc_lnk( sgzv , 'V', -1. ) ! Lateral boundary conditions 358 CALL lbc_lnk( sge3ru , 'U', -1. ) ; CALL lbc_lnk( sge3rv , 'V', -1. ) ! Lateral boundary conditions 359 ! 360 END IF 213 361 ! 214 362 IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde')
Note: See TracChangeset
for help on using the changeset viewer.