Changeset 5600 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
 Timestamp:
 20150715T17:46:12+02:00 (5 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5034 r5600 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,jk1,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,jk1,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(ji1,jj,jk) + zftv(ji,jj,jk)  zftv(ji,jj1,jk) ) 219 229 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra … … 225 235 ! 226 236 ! "Poleward" diffusive heat or salt transports (TS 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 downgradient 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 downgradient 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 idirection 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 downgradient diffusive transports (#1043) 255 CALL lbc_lnk( z2d, 'U', 1. ) 256 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in idirection 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 idirection259 END IF260 #endif 266 z2d(:,:) =  rau0_rcp * z2d(:,:) ! note sign is reversed to give downgradient diffusive transports (#1043) 267 CALL lbc_lnk( z2d, 'V', 1. ) 268 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in idirection 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,jk1)291 zcoef0 =  fsahtw(ji,jj,jk) * wmask(ji,jj,jk) 281 292 ! 282 293 zmsku = 1./MAX( umask(ji ,jj,jk1) + umask(ji1,jj,jk) &
Note: See TracChangeset
for help on using the changeset viewer.