- Timestamp:
- 2015-07-16T13:55:15+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r4990 r5602 28 28 USE in_out_manager ! I/O manager 29 29 USE iom ! I/O library 30 #if defined key_diaar531 30 USE phycst ! physical constants 32 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 #endif34 32 USE wrk_nemo ! Memory Allocation 35 33 USE timing ! Timing … … 106 104 ! 107 105 INTEGER :: ji, jj, jk, jn ! dummy loop indices 106 INTEGER :: ikt 108 107 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 109 108 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 110 109 REAL(wp) :: zcoef0, zbtr, ztra ! - - 111 #if defined key_diaar5112 REAL(wp) :: zztmp ! local scalar113 #endif114 110 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 115 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw … … 149 145 END DO 150 146 END DO 147 148 ! partial cell correction 151 149 IF( ln_zps ) THEN ! partial steps correction at the last ocean level 152 150 DO jj = 1, jpjm1 153 151 DO ji = 1, fs_jpim1 ! vector opt. 154 152 ! IF useless if zpshde defines pgu everywhere 155 IF (mbku(ji,jj) > 1) zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 156 IF (mbkv(ji,jj) > 1) zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 157 ! (ISF) 153 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 154 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 155 END DO 156 END DO 157 ENDIF 158 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the first wet level beneath a cavity 159 DO jj = 1, jpjm1 160 DO ji = 1, fs_jpim1 ! vector opt. 158 161 IF (miku(ji,jj) > 1) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 159 162 IF (mikv(ji,jj) > 1) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) 160 163 END DO 161 164 END DO 162 END IF165 END IF 163 166 164 167 !!---------------------------------------------------------------------- 165 168 !! II - horizontal trend (full) 166 169 !!---------------------------------------------------------------------- 167 !CDIR PARALLEL DO PRIVATE( zdk1t ) 168 ! ! =============== 169 DO jj = 1, jpj ! Horizontal slab 170 ! ! =============== 171 DO ji = 1, jpi ! vector opt. 172 DO jk = mikt(ji,jj), jpkm1 173 ! 1. Vertical tracer gradient at level jk and jk+1 174 ! ------------------------------------------------ 175 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 176 zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 177 ! 178 IF( jk == mikt(ji,jj) ) THEN ; zdkt(ji,jj,jk) = zdk1t(ji,jj,jk) 179 ELSE ; zdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 180 ENDIF 170 !!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t ) 171 ! 1. Vertical tracer gradient at level jk and jk+1 172 ! ------------------------------------------------ 173 ! 174 ! interior value 175 DO jk = 2, jpkm1 176 DO jj = 1, jpj 177 DO ji = 1, jpi ! vector opt. 178 zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) 179 ! 180 zdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn ) ) * wmask(ji,jj,jk) 181 181 END DO 182 182 END DO 183 183 END DO 184 185 ! 2. Horizontal fluxes 186 ! -------------------- 187 DO jj = 1 , jpjm1 188 DO ji = 1, fs_jpim1 ! vector opt. 189 DO jk = mikt(ji,jj), jpkm1 184 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 185 zdk1t(:,:,1) = ( ptb(:,:,1,jn ) - ptb(:,:,2,jn) ) * wmask(:,:,2) 186 zdkt (:,:,1) = zdk1t(:,:,1) 187 IF ( ln_isfcav ) THEN 188 DO jj = 1, jpj 189 DO ji = 1, jpi ! vector opt. 190 ikt = mikt(ji,jj) ! surface level 191 zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1) 192 zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt) 193 END DO 194 END DO 195 END IF 196 197 ! 2. Horizontal fluxes 198 ! -------------------- 199 DO jk = 1, jpkm1 200 DO jj = 1 , jpjm1 201 DO ji = 1, fs_jpim1 ! vector opt. 190 202 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 191 203 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) … … 208 220 END DO 209 221 END DO 210 END DO211 222 212 223 ! II.4 Second derivative (divergence) and add to the general trend 213 224 ! ---------------------------------------------------------------- 214 DO jj = 2 , jpjm1 215 DO ji = fs_2, fs_jpim1 ! vector opt. 216 DO jk = mikt(ji,jj), jpkm1 217 zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 225 DO jj = 2 , jpjm1 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 218 228 ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 219 229 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra … … 225 235 ! 226 236 ! "Poleward" diffusive heat or salt transports (T-S case only) 227 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN237 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 228 238 ! note sign is reversed to give down-gradient diffusive transports (#1043) 229 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( -zftv(:,:,:) )230 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( -zftv(:,:,:) )239 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 240 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 231 241 ENDIF 232 242 233 #if defined key_diaar5 234 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN235 z2d(:,:) = 0._wp236 ! note sign is reversed to give down-gradient diffusive transports (#1043)237 zztmp = -1.0_wp * rau0 * rcp238 DO jk = 1, jpkm1239 DO jj = 2, jpjm1240 DO ji = fs_2, fs_jpim1 ! vector opt.241 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)243 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 244 ! 245 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 246 z2d(:,:) = 0._wp 247 DO jk = 1, jpkm1 248 DO jj = 2, jpjm1 249 DO ji = fs_2, fs_jpim1 ! vector opt. 250 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 251 END DO 242 252 END DO 243 253 END DO 244 END DO 245 z2d(:,:) = zztmp * z2d(:,:) 246 CALL lbc_lnk( z2d, 'U', -1. ) 247 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 248 z2d(:,:) = 0._wp 249 DO jk = 1, jpkm1 250 DO jj = 2, jpjm1 251 DO ji = fs_2, fs_jpim1 ! vector opt. 252 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 254 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 255 CALL lbc_lnk( z2d, 'U', -1. ) 256 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 257 ! 258 z2d(:,:) = 0._wp 259 DO jk = 1, jpkm1 260 DO jj = 2, jpjm1 261 DO ji = fs_2, fs_jpim1 ! vector opt. 262 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 263 END DO 253 264 END DO 254 265 END DO 255 END DO256 z2d(:,:) = zztmp * z2d(:,:)257 CALL lbc_lnk( z2d, 'V', -1. )258 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction259 END IF260 #endif 266 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 267 CALL lbc_lnk( z2d, 'V', -1. ) 268 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 269 END IF 270 ! 271 ENDIF 261 272 262 273 !!---------------------------------------------------------------------- … … 278 289 DO jj = 2, jpjm1 279 290 DO ji = fs_2, fs_jpim1 ! vector opt. 280 zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)291 zcoef0 = - fsahtw(ji,jj,jk) * wmask(ji,jj,jk) 281 292 ! 282 293 zmsku = 1./MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) &
Note: See TracChangeset
for help on using the changeset viewer.