Changeset 5443 for branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
 Timestamp:
 20150619T17:18:00+02:00 (5 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r5234 r5443 106 106 ENDIF 107 107 ! 108 zwi(:,:,:) = 0.e0 ; zwz(:,:,:) = 0.e0108 zwi(:,:,:) = 0.e0 ; 109 109 ! 110 110 ! ! =========== 111 111 DO jn = 1, kjpt ! tracer loop 112 112 ! ! =========== 113 ! 1. Bottom value : flux set to zero113 ! 1. Bottom and k=1 value : flux set to zero 114 114 !  115 115 zwx(:,:,jpk) = 0.e0 ; zwz(:,:,jpk) = 0.e0 116 116 zwy(:,:,jpk) = 0.e0 ; zwi(:,:,jpk) = 0.e0 117 117 118 zwz(:,:,1 ) = 0._wp 118 119 ! 2. upstream advection with initial mass fluxes & intermediate update 119 120 !  … … 134 135 135 136 ! upstream tracer flux in the k direction 137 ! Interior value 138 DO jk = 2, jpkm1 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 142 zfm_wk = pwn(ji,jj,jk)  ABS( pwn(ji,jj,jk) ) 143 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk1,jn) ) * wmask(ji,jj,jk) 144 END DO 145 END DO 146 END DO 136 147 ! Surface value 137 148 IF( lk_vvl ) THEN 138 DO jj = 1, jpj 139 DO ji = 1, jpi 140 zwz(ji,jj, mikt(ji,jj) ) = 0.e0 ! volume variable 141 END DO 142 END DO 149 IF ( ln_isfcav ) THEN 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 zwz(ji,jj, mikt(ji,jj) ) = 0.e0 ! volume variable 153 END DO 154 END DO 155 ELSE 156 zwz(:,:,1) = 0.e0 ! volume variable 157 END IF 143 158 ELSE 144 DO jj = 1, jpj 145 DO ji = 1, jpi 146 zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface 147 END DO 148 END DO 159 IF ( ln_isfcav ) THEN 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface 163 END DO 164 END DO 165 ELSE 166 zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface 167 END IF 149 168 ENDIF 150 ! Interior value151 DO jj = 1, jpj152 DO ji = 1, jpi153 DO jk = mikt(ji,jj)+1, jpkm1154 zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )155 zfm_wk = pwn(ji,jj,jk)  ABS( pwn(ji,jj,jk) )156 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk1,jn) )157 END DO158 END DO159 END DO160 169 161 170 ! total advective trend … … 184 193 END IF 185 194 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 186 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN187 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )188 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )195 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 196 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 197 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 189 198 ENDIF 190 199 … … 202 211 203 212 ! antidiffusive flux on k 204 zwz(:,:,1) = 0.e0 ! Surface value 205 ! 206 DO jj = 1, jpj 207 DO ji = 1, jpi 208 ik=mikt(ji,jj) 209 ! surface value 210 zwz(ji,jj,1:ik) = 0.e0 211 ! Interior value 212 DO jk = mikt(ji,jj)+1, jpkm1 213 ! Interior value 214 DO jk = 2, jpkm1 215 DO jj = 1, jpj 216 DO ji = 1, jpi 213 217 zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk1,jn) )  zwz(ji,jj,jk) 214 218 END DO 215 219 END DO 216 220 END DO 221 ! surface value 222 IF ( ln_isfcav ) THEN 223 DO jj = 1, jpj 224 DO ji = 1, jpi 225 zwz(ji,jj,mikt(ji,jj)) = 0.e0 226 END DO 227 END DO 228 ELSE 229 zwz(:,:,1) = 0.e0 230 END IF 217 231 CALL lbc_lnk( zwx, 'U', 1. ) ; CALL lbc_lnk( zwy, 'V', 1. ) ! Lateral bondary conditions 218 232 CALL lbc_lnk( zwz, 'W', 1. ) … … 250 264 END IF 251 265 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 252 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN253 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) ) + htr_adv(:)254 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) ) + str_adv(:)266 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 267 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 268 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 255 269 ENDIF 256 270 ! … … 358 372 359 373 ! upstream tracer flux in the k direction 360 ! Surface value361 IF( lk_vvl ) THEN ; zwz(:,:, 1 ) = 0._wp ! volume variable362 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface363 ENDIF364 374 ! Interior value 365 375 DO jk = 2, jpkm1 … … 372 382 END DO 373 383 END DO 384 ! Surface value 385 IF( lk_vvl ) THEN 386 IF ( ln_isfcav ) THEN 387 DO jj = 1, jpj 388 DO ji = 1, jpi 389 zwz(ji,jj, mikt(ji,jj) ) = 0.e0 ! volume variable + isf 390 END DO 391 END DO 392 ELSE 393 zwz(:,:,1) = 0.e0 ! volume variable + no isf 394 END IF 395 ELSE 396 IF ( ln_isfcav ) THEN 397 DO jj = 1, jpj 398 DO ji = 1, jpi 399 zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface + isf 400 END DO 401 END DO 402 ELSE 403 zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface + no isf 404 END IF 405 ENDIF 374 406 375 407 ! total advective trend … … 398 430 END IF 399 431 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 400 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN401 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )402 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )432 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 433 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 434 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 403 435 ENDIF 404 436 … … 524 556 END IF 525 557 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 526 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN527 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) ) + htr_adv(:)528 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) ) + str_adv(:)558 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 559 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 560 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 529 561 ENDIF 530 562 ! … … 580 612 & paft * tmask + zbig * ( 1._wp  tmask ) ) 581 613 582 DO j j = 2, jpjm1583 DO ji = fs_2, fs_jpim1 ! vector opt.584 DO jk = mikt(ji,jj), jpkm1585 ikm1 = MAX(jk1,mikt(ji,jj))586 z2dtt = p2dt(jk)587 614 DO jk = 1, jpkm1 615 ikm1 = MAX(jk1,1) 616 z2dtt = p2dt(jk) 617 DO jj = 2, jpjm1 618 DO ji = fs_2, fs_jpim1 ! vector opt. 619 588 620 ! search maximum in neighbourhood 589 621 zup = MAX( zbup(ji ,jj ,jk ), &
Note: See TracChangeset
for help on using the changeset viewer.