Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90 (modified) (5 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
- Property svn:eol-style deleted
r1152 r2528 1 1 MODULE zpshde 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE zpshde *** 4 !! z-coordinate - partial step : Horizontal Derivative 5 !!============================================================================== 4 !! z-coordinate + partial step : Horizontal Derivative at ocean bottom level 5 !!====================================================================== 6 !! History : OPA ! 2002-04 (A. Bozec) Original code 7 !! NEMO 1.0 ! 2002-08 (G. Madec E. Durand) Optimization and Free form 8 !! - ! 2004-03 (C. Ethe) adapted for passive tracers 9 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 10 !!====================================================================== 6 11 7 12 !!---------------------------------------------------------------------- … … 9 14 !! ocean level (Z-coord. with Partial Steps) 10 15 !!---------------------------------------------------------------------- 11 !! * Modules used 12 USE dom_oce ! ocean space domain variables 13 USE oce ! ocean dynamics and tracers variables 16 USE oce ! ocean: dynamics and tracers variables 17 USE dom_oce ! domain: ocean variables 14 18 USE phycst ! physical constants 19 USE eosbn2 ! ocean equation of state 15 20 USE in_out_manager ! I/O manager 16 USE eosbn2 ! ocean equation of state17 21 USE lbclnk ! lateral boundary conditions (or mpp link) 18 22 … … 20 24 PRIVATE 21 25 22 !! * Routine accessibility 23 PUBLIC zps_hde ! routine called by step.F90 24 25 !! * module variables 26 INTEGER, DIMENSION(jpi,jpj) :: & 27 mbatu, mbatv ! bottom ocean level index at U- and V-points 26 PUBLIC zps_hde ! routine called by step.F90 28 27 29 28 !! * Substitutions … … 31 30 # include "vectopt_loop_substitute.h90" 32 31 !!---------------------------------------------------------------------- 33 !!---------------------------------------------------------------------- 34 !! OPA 9.0 , LOCEAN-IPSL (2005) 35 !! $Id$ 36 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 32 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 33 !! $Id$ 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 35 !!---------------------------------------------------------------------- 38 36 CONTAINS 39 37 40 SUBROUTINE zps_hde ( kt, ptem, psal, prd , & 41 pgtu, pgsu, pgru, & 42 pgtv, pgsv, pgrv ) 38 SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, & 39 prd, pgru, pgrv ) 43 40 !!---------------------------------------------------------------------- 44 41 !! *** ROUTINE zps_hde *** 45 42 !! 46 !! ** Purpose : Compute the horizontal derivative of T, S and r d43 !! ** Purpose : Compute the horizontal derivative of T, S and rho 47 44 !! at u- and v-points with a linear interpolation for z-coordinate 48 45 !! with partial steps. … … 78 75 !! formulation of the equation of state (eos). 79 76 !! Gradient formulation for rho : 80 !! di(rho) = rd~ - rd(i,j,k) or rd (i+1,j,k) - rd~ 81 !! 82 !! ** Action : - pgtu, pgsu, pgru: horizontal gradient of T, S 83 !! and rd at U-points 84 !! - pgtv, pgsv, pgrv: horizontal gradient of T, S 85 !! and rd at V-points 86 !! 87 !! History : 88 !! 8.5 ! 02-04 (A. Bozec) Original code 89 !! 8.5 ! 02-08 (G. Madec E. Durand) Optimization and Free form 77 !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ 78 !! 79 !! ** Action : - pgtu, pgtv: horizontal gradient of tracer at u- & v-points 80 !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 90 81 !!---------------------------------------------------------------------- 91 !! * Arguments 92 INTEGER, INTENT( in ) :: kt ! ocean time-step index 93 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: & 94 ptem, psal, prd ! 3D T, S and rd fields 95 REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) :: & 96 pgtu, pgsu, pgru, & ! horizontal grad. of T, S and rd at u- 97 pgtv, pgsv, pgrv ! and v-points of the partial step level 98 99 !! * Local declarations 100 INTEGER :: ji, jj, & ! Dummy loop indices 101 iku,ikv ! partial step level at u- and v-points 102 REAL(wp), DIMENSION(jpi,jpj) :: & 103 zti, ztj, zsi, zsj, & ! interpolated value of T, S 104 zri, zrj, & ! and rd 105 zhgi, zhgj ! depth of interpolation for eos2d 106 REAL(wp) :: & 107 ze3wu, ze3wv, & ! temporary scalars 108 zmaxu1, zmaxu2, & ! " " 109 zmaxv1, zmaxv2 ! " " 110 111 ! Initialization (first time-step only): compute mbatu and mbatv 112 IF( kt == nit000 ) THEN 113 mbatu(:,:) = 0 114 mbatv(:,:) = 0 115 DO jj = 1, jpjm1 116 DO ji = 1, fs_jpim1 ! vector opt. 117 mbatu(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji+1,jj ) ) - 1, 2 ) 118 mbatv(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji ,jj+1) ) - 1, 2 ) 119 END DO 120 END DO 121 zti(:,:) = FLOAT( mbatu(:,:) ) 122 ztj(:,:) = FLOAT( mbatv(:,:) ) 123 ! lateral boundary conditions: T-point, sign unchanged 124 CALL lbc_lnk( zti , 'U', 1. ) 125 CALL lbc_lnk( ztj , 'V', 1. ) 126 mbatu(:,:) = MAX( INT( zti(:,:) ), 2 ) 127 mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 ) 128 ENDIF 129 130 131 ! Interpolation of T and S at the last ocean level 82 INTEGER , INTENT(in ) :: kt ! ocean time-step index 83 INTEGER , INTENT(in ) :: kjpt ! number of tracers 84 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 85 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 86 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 87 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad. of prd at u- & v-pts 88 !! 89 INTEGER :: ji, jj, jn ! Dummy loop indices 90 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points 91 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! interpolated value of tracer 92 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj ! interpolated value of rd 93 REAL(wp), DIMENSION(jpi,jpj) :: zhi, zhj ! depth of interpolation for eos2d 94 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 95 !!---------------------------------------------------------------------- 96 97 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 98 ! 132 99 # if defined key_vectopt_loop 133 100 jj = 1 134 101 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 135 102 # else 136 DO jj = 1, jpjm1 137 DO ji = 1, jpim1 138 # endif 139 ! last level 140 iku = mbatu(ji,jj) 141 ikv = mbatv(ji,jj) 142 143 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 144 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 145 zmaxu1 = ze3wu / fse3w(ji+1,jj ,iku) 146 zmaxu2 = -ze3wu / fse3w(ji ,jj ,iku) 147 zmaxv1 = ze3wv / fse3w(ji ,jj+1,ikv) 148 zmaxv2 = -ze3wv / fse3w(ji ,jj ,ikv) 149 150 ! i- direction 151 152 IF( ze3wu >= 0. ) THEN ! case 1 153 ! interpolated values of T and S 154 zti(ji,jj) = ptem(ji+1,jj,iku) + zmaxu1 * ( ptem(ji+1,jj,iku-1) - ptem(ji+1,jj,iku) ) 155 zsi(ji,jj) = psal(ji+1,jj,iku) + zmaxu1 * ( psal(ji+1,jj,iku-1) - psal(ji+1,jj,iku) ) 156 ! depth of the partial step level 157 zhgi(ji,jj) = fsdept(ji,jj,iku) 158 ! gradient of T and S 159 pgtu(ji,jj) = umask(ji,jj,1) * ( zti(ji,jj) - ptem(ji,jj,iku) ) 160 pgsu(ji,jj) = umask(ji,jj,1) * ( zsi(ji,jj) - psal(ji,jj,iku) ) 161 162 ELSE ! case 2 163 ! interpolated values of T and S 164 zti(ji,jj) = ptem(ji,jj,iku) + zmaxu2 * ( ptem(ji,jj,iku-1) - ptem(ji,jj,iku) ) 165 zsi(ji,jj) = psal(ji,jj,iku) + zmaxu2 * ( psal(ji,jj,iku-1) - psal(ji,jj,iku) ) 166 ! depth of the partial step level 167 zhgi(ji,jj) = fsdept(ji+1,jj,iku) 168 ! gradient of T and S 169 pgtu(ji,jj) = umask(ji,jj,1) * ( ptem(ji+1,jj,iku) - zti (ji,jj) ) 170 pgsu(ji,jj) = umask(ji,jj,1) * ( psal(ji+1,jj,iku) - zsi (ji,jj) ) 171 ENDIF 172 173 ! j- direction 174 175 IF( ze3wv >= 0. ) THEN ! case 1 176 ! interpolated values of T and S 177 ztj(ji,jj) = ptem(ji,jj+1,ikv) + zmaxv1 * ( ptem(ji,jj+1,ikv-1) - ptem(ji,jj+1,ikv) ) 178 zsj(ji,jj) = psal(ji,jj+1,ikv) + zmaxv1 * ( psal(ji,jj+1,ikv-1) - psal(ji,jj+1,ikv) ) 179 ! depth of the partial step level 180 zhgj(ji,jj) = fsdept(ji,jj,ikv) 181 ! gradient of T and S 182 pgtv(ji,jj) = vmask(ji,jj,1) * ( ztj(ji,jj) - ptem(ji,jj,ikv) ) 183 pgsv(ji,jj) = vmask(ji,jj,1) * ( zsj(ji,jj) - psal(ji,jj,ikv) ) 184 185 ELSE ! case 2 186 ! interpolated values of T and S 187 ztj(ji,jj) = ptem(ji,jj,ikv) + zmaxv2 * ( ptem(ji,jj,ikv-1) - ptem(ji,jj,ikv) ) 188 zsj(ji,jj) = psal(ji,jj,ikv) + zmaxv2 * ( psal(ji,jj,ikv-1) - psal(ji,jj,ikv) ) 189 ! depth of the partial step level 190 zhgj(ji,jj) = fsdept(ji,jj+1,ikv) 191 ! gradient of T and S 192 pgtv(ji,jj) = vmask(ji,jj,1) * ( ptem(ji,jj+1,ikv) - ztj(ji,jj) ) 193 pgsv(ji,jj) = vmask(ji,jj,1) * ( psal(ji,jj+1,ikv) - zsj(ji,jj) ) 194 ENDIF 103 DO jj = 1, jpjm1 104 DO ji = 1, jpim1 105 # endif 106 iku = mbku(ji,jj) ; ikum1 = MAX( iku , 1 ) ! last and before last ocean level at u- & v-points 107 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv , 1 ) ! if level first is a p-step, ik.m1=1 108 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 109 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 110 ! 111 ! i- direction 112 IF( ze3wu >= 0._wp ) THEN ! case 1 113 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 114 ! interpolated values of tracers 115 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 116 ! gradient of tracers 117 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 118 ELSE ! case 2 119 zmaxu = -ze3wu / fse3w(ji,jj,iku) 120 ! interpolated values of tracers 121 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 122 ! gradient of tracers 123 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 124 ENDIF 125 ! 126 ! j- direction 127 IF( ze3wv >= 0._wp ) THEN ! case 1 128 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 129 ! interpolated values of tracers 130 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 131 ! gradient of tracers 132 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 133 ELSE ! case 2 134 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 135 ! interpolated values of tracers 136 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 137 ! gradient of tracers 138 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 139 ENDIF 195 140 # if ! defined key_vectopt_loop 141 END DO 142 # endif 196 143 END DO 197 # endif 144 CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 145 ! 198 146 END DO 199 147 200 ! Compute interpolated rd from zti, zsi, ztj, zsj for the 2 cases at the depth of the partial 201 ! step and store it in zri, zrj for each case 202 CALL eos( zti, zsi, zhgi, zri ) 203 CALL eos( ztj, zsj, zhgj, zrj ) 204 205 206 ! Gradient of density at the last level 148 ! horizontal derivative of density anomalies (rd) 149 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 207 150 # if defined key_vectopt_loop 208 151 jj = 1 209 152 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 210 153 # else 211 DO jj = 1, jpjm1 212 DO ji = 1, jpim1 213 # endif 214 iku = mbatu(ji,jj) 215 ikv = mbatv(ji,jj) 216 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 217 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 218 IF( ze3wu >= 0. ) THEN ! i-direction: case 1 219 pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) ) 220 ELSE ! i-direction: case 2 221 pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) 222 ENDIF 223 IF( ze3wv >= 0. ) THEN ! j-direction: case 1 224 pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) ) 225 ELSE ! j-direction: case 2 226 pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) 227 ENDIF 154 DO jj = 1, jpjm1 155 DO ji = 1, jpim1 156 # endif 157 iku = mbku(ji,jj) 158 ikv = mbkv(ji,jj) 159 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 160 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 161 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji ,jj,iku) ! i-direction: case 1 162 ELSE ; zhi(ji,jj) = fsdept(ji+1,jj,iku) ! - - case 2 163 ENDIF 164 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj ,ikv) ! j-direction: case 1 165 ELSE ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) ! - - case 2 166 ENDIF 228 167 # if ! defined key_vectopt_loop 168 END DO 169 # endif 229 170 END DO 230 # endif 231 END DO 232 233 ! Lateral boundary conditions on each gradient 234 CALL lbc_lnk( pgtu , 'U', -1. ) ; CALL lbc_lnk( pgtv , 'V', -1. ) 235 CALL lbc_lnk( pgsu , 'U', -1. ) ; CALL lbc_lnk( pgsv , 'V', -1. ) 236 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) 237 171 172 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 173 ! step and store it in zri, zrj for each case 174 CALL eos( zti, zhi, zri ) ; CALL eos( ztj, zhj, zrj ) 175 176 ! Gradient of density at the last level 177 # if defined key_vectopt_loop 178 jj = 1 179 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 180 # else 181 DO jj = 1, jpjm1 182 DO ji = 1, jpim1 183 # endif 184 iku = mbku(ji,jj) 185 ikv = mbkv(ji,jj) 186 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 187 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 188 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj) - prd(ji,jj,iku) ) ! i: 1 189 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 190 ENDIF 191 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 192 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 193 ENDIF 194 # if ! defined key_vectopt_loop 195 END DO 196 # endif 197 END DO 198 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions 199 ! 200 END IF 201 ! 238 202 END SUBROUTINE zps_hde 239 203
Note: See TracChangeset
for help on using the changeset viewer.
