Changeset 2144 for branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC
- Timestamp:
- 2010-10-04T15:21:41+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl.F90
r2122 r2144 138 138 139 139 140 SUBROUTINE tra_bbl_dif( pt rab, ptraa, kjpt )140 SUBROUTINE tra_bbl_dif( ptb, pta, kjpt ) 141 141 !!---------------------------------------------------------------------- 142 142 !! *** ROUTINE tra_bbl_dif *** … … 155 155 !! convection is satified) 156 156 !! 157 !! ** Action : pt raa increased by the bbl diffusive trend157 !! ** Action : pta increased by the bbl diffusive trend 158 158 !! 159 159 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. … … 161 161 !!---------------------------------------------------------------------- 162 162 INTEGER , INTENT(in ) :: kjpt ! number of tracers 163 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt rab ! before and now tracer fields164 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt raa ! tracer trend163 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 164 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 165 165 !! 166 166 INTEGER :: ji, jj, jn ! dummy loop indices 167 167 INTEGER :: ik ! local integers 168 168 REAL(wp) :: zbtr ! local scalars 169 REAL(wp), DIMENSION(jpi,jpj) :: zptb ! temporary array 169 170 !!---------------------------------------------------------------------- 170 171 ! … … 172 173 DO jn = 1, kjpt ! tracer loop 173 174 ! ! =========== 175 # if defined key_vectopt_loop 176 DO jj = 1, 1 ! vector opt. (forced unrolling) 177 DO ji = 1, jpij 178 #else 179 DO jj = 1, jpj 180 DO ji = 1, jpi 181 #endif 182 ik = mbkt(ji,jj) ! bottom T-level index 183 zptb(ji,jj) = ptb(ji,jj,ik,jn) ! bottom before T and S 184 END DO 185 END DO 186 ! ! Compute the trend 174 187 # if defined key_vectopt_loop 175 188 DO jj = 1, 1 ! vector opt. (forced unrolling) … … 179 192 DO ji = 2, jpim1 180 193 # endif 181 ik = mbkt(ji,jj) ! bottom T-level index182 zbtr = e1e2t_r(ji,jj) / fse3t(ji,jj,ik)183 ptraa(ji,jj,ik,jn) = ptraa(ji,jj,ik,jn) &184 & + ( ahu_bbl(ji ,jj) * ( ptrab(ji+1,jj ,ik,jn) - ptrab(ji ,jj ,ik,jn) ) &185 & - ahu_bbl(ji ,jj) * ( ptrab(ji ,jj ,ik,jn) - ptrab(ji-1,jj ,ik,jn) ) &186 & + ahv_bbl(ji ,jj) * ( ptrab(ji ,jj+1,ik,jn) - ptrab(ji ,jj ,ik,jn) ) &187 & - ahv_bbl(ji ,jj) * ( ptrab(ji ,jj ,ik,jn) - ptrab(ji ,jj-1,ik,jn) ) ) * zbtr194 ik = mbkt(ji,jj) ! bottom T-level index 195 zbtr = e1e2t_r(ji,jj) / fse3t(ji,jj,ik) 196 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & 197 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & 198 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) & 199 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 200 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) * zbtr 188 201 END DO 189 202 END DO … … 194 207 195 208 196 SUBROUTINE tra_bbl_adv( pt rab, ptraa, kjpt )209 SUBROUTINE tra_bbl_adv( ptb, pta, kjpt ) 197 210 !!---------------------------------------------------------------------- 198 211 !! *** ROUTINE trc_bbl *** … … 212 225 !!---------------------------------------------------------------------- 213 226 INTEGER , INTENT(in ) :: kjpt ! number of tracers 214 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt rab ! before and now tracer fields215 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt raa ! tracer trend227 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 228 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 216 229 !! 217 230 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 240 253 ! ! up -slope T-point (shelf bottom point) 241 254 zbtr = e1e2t_r(iis,jj) / fse3t(iis,jj,ikus) 242 ztra = zu_bbl * ( pt rab(iid,jj,ikus,jn) - ptrab(iis,jj,ikus,jn) ) * zbtr243 pt raa(iis,jj,ikus,jn) = ptraa(iis,jj,ikus,jn) + ztra255 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 256 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 244 257 ! 245 258 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 246 259 zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,jk) 247 ztra = zu_bbl * ( pt rab(iid,jj,jk+1,jn) - ptrab(iid,jj,jk,jn) ) * zbtr248 pt raa(iid,jj,jk,jn) = ptraa(iid,jj,jk,jn) + ztra260 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 261 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 249 262 END DO 250 263 ! 251 264 zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,ikud) 252 ztra = zu_bbl * ( pt rab(iis,jj,ikus,jn) - ptrab(iid,jj,ikud,jn) ) * zbtr253 pt raa(iid,jj,ikud,jn) = ptraa(iid,jj,ikud,jn) + ztra265 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 266 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 254 267 ENDIF 255 268 ! … … 262 275 ! up -slope T-point (shelf bottom point) 263 276 zbtr = e1e2t_r(ji,ijs) / fse3t(ji,ijs,ikvs) 264 ztra = zv_bbl * ( pt rab(ji,ijd,ikvs,jn) - ptrab(ji,ijs,ikvs,jn) ) * zbtr265 pt raa(ji,ijs,ikvs,jn) = ptraa(ji,ijs,ikvs,jn) + ztra277 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 278 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 266 279 ! 267 280 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 268 281 zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,jk) 269 ztra = zv_bbl * ( pt rab(ji,ijd,jk+1,jn) - ptrab(ji,ijd,jk,jn) ) * zbtr270 pt raa(ji,ijd,jk,jn) = ptraa(ji,ijd,jk,jn) + ztra282 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 283 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 271 284 END DO 272 285 ! ! down-slope T-point (deep bottom point) 273 286 zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,ikvd) 274 ztra = zv_bbl * ( pt rab(ji,ijs,ikvs,jn) - ptrab(ji,ijd,ikvd,jn) ) * zbtr275 pt raa(ji,ijd,ikvd,jn) = ptraa(ji,ijd,ikvd,jn) + ztra287 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 288 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 276 289 ENDIF 277 290 END DO
Note: See TracChangeset
for help on using the changeset viewer.