- Timestamp:
- 2010-09-10T12:32:58+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/zpshde.F90
r2024 r2082 14 14 !! zps_hde : Horizontal DErivative of T, S and rd at the last 15 15 !! ocean level (Z-coord. with Partial Steps) 16 !! zps_hde_trc : Horizontal DErivative of passive tracers at the last17 !! ocean level (Z-coord. with Partial Steps)18 16 !!---------------------------------------------------------------------- 19 17 !! * Modules used … … 31 29 PUBLIC zps_hde ! routine called by step.F90 32 30 PUBLIC zps_hde_init ! routine called by opa.F90 33 #if defined key_top34 PUBLIC zps_hde_trc35 #endif36 31 37 32 !! * module variables … … 49 44 !!---------------------------------------------------------------------- 50 45 CONTAINS 51 SUBROUTINE zps_hde ( kt, ptem, psal, prd , & 52 pgtu, pgsu, pgru, &53 pgtv, pgsv, pgrv)46 47 SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, & 48 prd, pgru, pgrv ) 54 49 !!---------------------------------------------------------------------- 55 50 !! *** ROUTINE zps_hde *** … … 91 86 !! di(rho) = rd~ - rd(i,j,k) or rd (i+1,j,k) - rd~ 92 87 !! 93 !! ** Action : - pgtu, pgsu, pgru: horizontal gradient of T, S 94 !! and rd at U-points 95 !! - pgtv, pgsv, pgrv: horizontal gradient of T, S 88 !! ** Action : - pgtu, pgtv: horizontal gradient of tracer at U/V-points 89 !! - pgru, pgrv: horizontal gradient of rd if present at U/V-points 96 90 !! and rd at V-points 97 91 !!---------------------------------------------------------------------- 98 92 !! * Arguments 99 INTEGER, INTENT( in ) :: kt ! ocean time-step index 100 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: ptem, psal, prd ! 3D T, S and rd fields 101 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out ) :: pgtu, pgsu, pgru ! horizontal grad. of T, S and rd at u-point 102 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out ) :: pgtv, pgsv, pgrv ! horizontal grad. of T, S and rd at v-point 103 !! * Local declarations 104 INTEGER :: ji , jj ! Dummy loop indices 105 INTEGER :: iku, ikv ! partial step level at u- and v-points 106 REAL(wp), DIMENSION(jpi,jpj) :: zti, ztj, zsi, zsj ! interpolated value of T, S 107 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj ! interpolated value of rd 108 REAL(wp), DIMENSION(jpi,jpj) :: zhgi, zhgj ! depth of interpolation for eos2d 109 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 110 111 112 ! Interpolation of T and S at the last ocean level 113 # if defined key_vectopt_loop 114 jj = 1 115 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 116 # else 117 DO jj = 1, jpjm1 118 DO ji = 1, jpim1 119 # endif 120 ! last level 121 iku = mbatu(ji,jj) 122 ikv = mbatv(ji,jj) 123 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 124 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 125 126 ! i- direction 127 IF( ze3wu >= 0. ) THEN ! case 1 128 ! interpolated values of T and S 129 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 130 zti(ji,jj) = ptem(ji+1,jj,iku) + zmaxu * ( ptem(ji+1,jj,iku-1) - ptem(ji+1,jj,iku) ) 131 zsi(ji,jj) = psal(ji+1,jj,iku) + zmaxu * ( psal(ji+1,jj,iku-1) - psal(ji+1,jj,iku) ) 132 ! depth of the partial step level 133 zhgi(ji,jj) = fsdept(ji,jj,iku) 134 ! gradient of T and S 135 pgtu(ji,jj) = umask(ji,jj,1) * ( zti(ji,jj) - ptem(ji,jj,iku) ) 136 pgsu(ji,jj) = umask(ji,jj,1) * ( zsi(ji,jj) - psal(ji,jj,iku) ) 137 138 ELSE ! case 2 139 ! interpolated values of T and S 140 zmaxu = -ze3wu / fse3w(ji,jj,iku) 141 zti(ji,jj) = ptem(ji,jj,iku) + zmaxu * ( ptem(ji,jj,iku-1) - ptem(ji,jj,iku) ) 142 zsi(ji,jj) = psal(ji,jj,iku) + zmaxu * ( psal(ji,jj,iku-1) - psal(ji,jj,iku) ) 143 ! depth of the partial step level 144 zhgi(ji,jj) = fsdept(ji+1,jj,iku) 145 ! gradient of T and S 146 pgtu(ji,jj) = umask(ji,jj,1) * ( ptem(ji+1,jj,iku) - zti (ji,jj) ) 147 pgsu(ji,jj) = umask(ji,jj,1) * ( psal(ji+1,jj,iku) - zsi (ji,jj) ) 148 ENDIF 149 150 ! j- direction 151 IF( ze3wv >= 0. ) THEN ! case 1 152 ! interpolated values of T and S 153 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 154 ztj(ji,jj) = ptem(ji,jj+1,ikv) + zmaxv * ( ptem(ji,jj+1,ikv-1) - ptem(ji,jj+1,ikv) ) 155 zsj(ji,jj) = psal(ji,jj+1,ikv) + zmaxv * ( psal(ji,jj+1,ikv-1) - psal(ji,jj+1,ikv) ) 156 ! depth of the partial step level 157 zhgj(ji,jj) = fsdept(ji,jj,ikv) 158 ! gradient of T and S 159 pgtv(ji,jj) = vmask(ji,jj,1) * ( ztj(ji,jj) - ptem(ji,jj,ikv) ) 160 pgsv(ji,jj) = vmask(ji,jj,1) * ( zsj(ji,jj) - psal(ji,jj,ikv) ) 161 162 ELSE ! case 2 163 ! interpolated values of T and S 164 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 165 ztj(ji,jj) = ptem(ji,jj,ikv) + zmaxv * ( ptem(ji,jj,ikv-1) - ptem(ji,jj,ikv) ) 166 zsj(ji,jj) = psal(ji,jj,ikv) + zmaxv * ( psal(ji,jj,ikv-1) - psal(ji,jj,ikv) ) 167 ! depth of the partial step level 168 zhgj(ji,jj) = fsdept(ji,jj+1,ikv) 169 ! gradient of T and S 170 pgtv(ji,jj) = vmask(ji,jj,1) * ( ptem(ji,jj+1,ikv) - ztj(ji,jj) ) 171 pgsv(ji,jj) = vmask(ji,jj,1) * ( psal(ji,jj+1,ikv) - zsj(ji,jj) ) 172 ENDIF 173 # if ! defined key_vectopt_loop 174 END DO 175 # endif 176 END DO 177 178 ! Compute interpolated rd from zti, zsi, ztj, zsj for the 2 cases at the depth of the partial 179 ! step and store it in zri, zrj for each case 180 CALL eos( zti, zsi, zhgi, zri ) 181 CALL eos( ztj, zsj, zhgj, zrj ) 182 183 184 ! Gradient of density at the last level 185 # if defined key_vectopt_loop 186 jj = 1 187 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 188 # else 189 DO jj = 1, jpjm1 190 DO ji = 1, jpim1 191 # endif 192 iku = mbatu(ji,jj) 193 ikv = mbatv(ji,jj) 194 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 195 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 196 IF( ze3wu >= 0. ) THEN ! i-direction: case 1 197 pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) ) 198 ELSE ! i-direction: case 2 199 pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) 200 ENDIF 201 IF( ze3wv >= 0. ) THEN ! j-direction: case 1 202 pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) ) 203 ELSE ! j-direction: case 2 204 pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) 205 ENDIF 206 # if ! defined key_vectopt_loop 207 END DO 208 # endif 209 END DO 210 211 ! Lateral boundary conditions on each gradient 212 CALL lbc_lnk( pgtu , 'U', -1. ) ; CALL lbc_lnk( pgtv , 'V', -1. ) 213 CALL lbc_lnk( pgsu , 'U', -1. ) ; CALL lbc_lnk( pgsv , 'V', -1. ) 214 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) 215 216 END SUBROUTINE zps_hde 217 218 #if defined key_top 219 !!---------------------------------------------------------------------- 220 !! 'key_top' TOP models 221 !!---------------------------------------------------------------------- 222 SUBROUTINE zps_hde_trc ( kt, kjpt, ptra, pgtru, pgtrv ) 223 !!---------------------------------------------------------------------- 224 !! *** ROUTINE zps_hde_trc *** 225 !! 226 !! ** Purpose : Compute the horizontal derivative of passive tracers 227 !! TRA at u- and v-points with a linear interpolation for z-coordinate 228 !! with partial steps. 229 !! 230 !! ** Method : the same for T & S 231 !! 232 !! ** Action : - pgtru : horizontal gradient of TRA at U-points 233 !! - pgtrv : horizontal gradient of TRA at V-points 234 !!---------------------------------------------------------------------- 235 !! * Arguments 236 INTEGER , INTENT( in ) :: kt ! ocean time-step index 237 INTEGER , INTENT( in ) :: kjpt ! number of tracers 238 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in ) :: ptra ! 4D tracers fields 239 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out ) :: pgtru, pgtrv ! horizontal grad. of TRA u- and v-points 93 INTEGER , INTENT( in ) :: kt ! ocean time-step index 94 INTEGER , INTENT( in ) :: kjpt ! number of tracers 95 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in ) :: pta ! 4D active or passive tracers fields 96 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! horizontal grad. of ptra u- and v-points 97 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( in ), OPTIONAL :: prd ! 3D rd fields 98 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! horizontal grad. of prd u- and v-points 240 99 !! * Local declarations 241 100 INTEGER :: ji, jj, jn ! Dummy loop indices 242 101 INTEGER :: iku, ikv ! partial step level at u- and v-points 243 REAL(wp) :: ztrai, ztraj, ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 244 !!---------------------------------------------------------------------- 245 102 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! interpolated value of tracer 103 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj ! interpolated value of rd 104 REAL(wp), DIMENSION(jpi,jpj) :: zhi, zhj ! depth of interpolation for eos2d 105 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 106 !!---------------------------------------------------------------------- 107 108 109 ! Interpolation of tracers at the last ocean level 246 110 DO jn = 1, kjpt 247 ! Interpolation of passive tracers at the last ocean level248 111 # if defined key_vectopt_loop 249 112 jj = 1 … … 262 125 IF( ze3wu >= 0. ) THEN ! case 1 263 126 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 264 ! interpolated values of passivetracers265 zt rai = ptra(ji+1,jj,iku,jn) + zmaxu * ( ptra(ji+1,jj,iku-1,jn) - ptra(ji+1,jj,iku,jn) )266 ! gradient of passivetracers267 pgt ru(ji,jj,jn) = umask(ji,jj,1) * ( ztrai - ptra(ji,jj,iku,jn) )127 ! interpolated values of tracers 128 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku-1,jn) - pta(ji+1,jj,iku,jn) ) 129 ! gradient of tracers 130 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 268 131 ELSE ! case 2 269 132 zmaxu = -ze3wu / fse3w(ji,jj,iku) 270 ! interpolated values of passivetracers271 zt rai = ptra(ji,jj,iku,jn) + zmaxu * ( ptra(ji,jj,iku-1,jn) - ptra(ji,jj,iku,jn) )272 ! gradient of passivetracers273 pgt ru(ji,jj,jn) = umask(ji,jj,1) * ( ptra(ji+1,jj,iku,jn) - ztrai)133 ! interpolated values of tracers 134 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku-1,jn) - pta(ji,jj,iku,jn) ) 135 ! gradient of tracers 136 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 274 137 ENDIF 275 138 … … 277 140 IF( ze3wv >= 0. ) THEN ! case 1 278 141 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 279 ! interpolated values of passivetracers280 zt raj = ptra(ji,jj+1,ikv,jn) + zmaxv * ( ptra(ji,jj+1,ikv-1,jn) - ptra(ji,jj+1,ikv,jn) )281 ! gradient of passivetracers282 pgt rv(ji,jj,jn) = vmask(ji,jj,1) * ( ztraj - ptra(ji,jj,ikv,jn) )142 ! interpolated values of tracers 143 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv-1,jn) - pta(ji,jj+1,ikv,jn) ) 144 ! gradient of tracers 145 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 283 146 ELSE ! case 2 284 147 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 285 ! interpolated values of passivetracers286 zt raj = ptra(ji,jj,ikv,jn) + zmaxv * ( ptra(ji,jj,ikv-1,jn) - ptra(ji,jj,ikv,jn) )287 ! gradient of passivetracers288 pgt rv(ji,jj,jn) = vmask(ji,jj,1) * ( ptra(ji,jj+1,ikv,jn) - ztraj)148 ! interpolated values of tracers 149 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv-1,jn) - pta(ji,jj,ikv,jn) ) 150 ! gradient of tracers 151 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 289 152 ENDIF 290 153 # if ! defined key_vectopt_loop … … 294 157 295 158 ! Lateral boundary conditions on each gradient 296 CALL lbc_lnk( pgt ru(:,:,jn) , 'U', -1. )297 CALL lbc_lnk( pgt rv(:,:,jn) , 'V', -1. )159 CALL lbc_lnk( pgtu(:,:,jn) , 'U', -1. ) 160 CALL lbc_lnk( pgtv(:,:,jn) , 'V', -1. ) 298 161 299 162 END DO 300 163 301 END SUBROUTINE zps_hde_trc 302 #endif 164 ! horizontal derivative of rd 165 IF( PRESENT( prd ) ) THEN 166 ! depth of the partial step level 167 # if defined key_vectopt_loop 168 jj = 1 169 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 170 # else 171 DO jj = 1, jpjm1 172 DO ji = 1, jpim1 173 # endif 174 iku = mbatu(ji,jj) 175 ikv = mbatv(ji,jj) 176 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 177 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 178 IF( ze3wu >= 0. ) THEN 179 zhi(ji,jj) = fsdept(ji ,jj,iku) 180 ELSE 181 zhi(ji,jj) = fsdept(ji+1,jj,iku) 182 ENDIF 183 IF( ze3wv >= 0. ) THEN 184 zhj(ji,jj) = fsdept(ji,jj ,ikv) 185 ELSE 186 zhj(ji,jj) = fsdept(ji,jj+1,ikv) 187 ENDIF 188 # if ! defined key_vectopt_loop 189 END DO 190 # endif 191 END DO 192 193 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 194 ! step and store it in zri, zrj for each case 195 CALL eos( zti, zhi, zri ) 196 CALL eos( ztj, zhj, zrj ) 197 198 ! Gradient of density at the last level 199 # if defined key_vectopt_loop 200 jj = 1 201 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 202 # else 203 DO jj = 1, jpjm1 204 DO ji = 1, jpim1 205 # endif 206 iku = mbatu(ji,jj) 207 ikv = mbatv(ji,jj) 208 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 209 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 210 IF( ze3wu >= 0. ) THEN ! i-direction: case 1 211 pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) ) 212 ELSE ! i-direction: case 2 213 pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) 214 ENDIF 215 IF( ze3wv >= 0. ) THEN ! j-direction: case 1 216 pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) ) 217 ELSE ! j-direction: case 2 218 pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) 219 ENDIF 220 # if ! defined key_vectopt_loop 221 END DO 222 # endif 223 END DO 224 225 ! Lateral boundary conditions on each gradient 226 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) 227 ! 228 END IF 229 ! 230 END SUBROUTINE zps_hde 303 231 304 232 SUBROUTINE zps_hde_init
Note: See TracChangeset
for help on using the changeset viewer.