Changeset 5601 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90
- Timestamp:
- 2015-07-16T11:04:29+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90
r5105 r5601 24 24 USE oce ! ocean dynamics and active tracers 25 25 USE dom_oce , ONLY : lk_vvl 26 USE trd mod_oce! tracers trends26 USE trd_oce ! tracers trends 27 27 USE trdtra ! tracers trends 28 28 USE in_out_manager ! I/O manager … … 123 123 ! 2. upstream advection with initial mass fluxes & intermediate update 124 124 ! -------------------------------------------------------------------- 125 !DO jk = 2, jpkm1 ! Interior value126 ! DO jj = 1, jpj127 ! DO ji = 1, jpi128 ! IF( ptb(ji,jj,jk,jn) .NE. ptb(ji,jj,jk,jn) )WRITE(narea+200,*)"ADVtb",ptb(ji,jj,jk,jn) ; call flush(narea+200)129 ! IF( ptn(ji,jj,jk,jn) .NE. ptn(ji,jj,jk,jn) )WRITE(narea+200,*)"ADVtn",ptb(ji,jj,jk,jn) ; call flush(narea+200)130 ! IF( pun(ji,jj,jk) .NE. pun(ji,jj,jk) )WRITE(narea+200,*)"ADVun",pun(ji,jj,jk) ; call flush(narea+200)131 ! IF( pvn(ji,jj,jk) .NE. pvn(ji,jj,jk) )WRITE(narea+200,*)"ADVvn",pvn(ji,jj,jk) ; call flush(narea+200)132 ! IF( pwn(ji,jj,jk) .NE. pwn(ji,jj,jk) )WRITE(narea+200,*)"ADVwn",pwn(ji,jj,jk) ; call flush(narea+200)133 ! END DO134 ! END DO135 ! END DO136 ! ji=117 ; jj=211 ; jk=74137 ! ji=ji-nimpp_crs+1 ; jj=jj-njmpp_crs+1138 ! IF( ji .GE. 2 .AND. ji .LE. jpi_crs-1 .AND. jj .GE. 2 .AND. jj .LE. jpj_crs-1 )THEN139 ! WRITE(narea+5000,*)"tvd =======> kt ",kt140 ! WRITE(narea+5000,*)ptb(ji,jj,jk,jn),ptn(ji,jj,jk,jn)141 ! WRITE(narea+5000,*)pun(ji-1,jj,jk),pun(ji,jj,jk)142 ! WRITE(narea+5000,*)pvn(ji,jj-1,jk),pun(ji,jj,jk)143 ! WRITE(narea+5000,*)pwn(ji,jj,jk),pwn(ji,jj,jk+1)144 ! ENDIF145 125 146 126 ! upstream tracer flux in the i and j direction … … 173 153 END DO 174 154 END DO 175 !WRITE(numout,*) 'test_tra', maxval(pta(:,:,:,1)) , kt176 !WRITE(numout,*) 'test_tra', minval(pta(:,:,:,1)) , kt177 155 ! total advective trend 178 156 DO jk = 1, jpkm1 … … 188 166 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 189 167 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask_crs(ji,jj,jk) 190 !iji=117 ; ijj=211 ; ijk=74 191 !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1 192 !IF( ji==iji .AND. jj==ijj )THEN 193 !WRITE(narea+5000,*)"test ",jk,zwx(ji,jj,jk) , zwx(ji-1,jj ,jk ), & 194 ! zwy(ji,jj,jk) , zwy(ji ,jj-1,jk ),zwz(ji,jj,jk),zwz(ji ,jj ,jk+1) 195 !ENDIF 196 !IF( ztra .NE. 0._wp )WRITE(narea+6000,*)"buga ",kt,ji,jj,jk,mbathy_crs(ji,jj), & 197 ! zwx(ji,jj,jk) , zwx(ji-1,jj ,jk ),zwy(ji,jj,jk) , zwy(ji ,jj-1,jk ),zwz(ji,jj,jk),zwz(ji ,jj ,jk+1) 198 END DO 199 END DO 200 END DO 201 !IF(narea==267)WRITE(narea+5000,*)"1 pta(17,6,74,1) = ",pta(17,6,74,1) 202 !zmin=MINVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_min(zmin) 203 !zmax=MAXVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_max(zmax) 204 !IF(lwp)WRITE(numout,*)"trcadvtvdcrs a ",kt,zmin,zmax 205 206 !WRITE(numout,*) 'test_tra', maxval(pta(:,:,:,jk)) , kt 207 !WRITE(numout,*) 'test_tra', minval(pta(:,:,:,jk)) , kt 168 END DO 169 END DO 170 END DO 208 171 ! ! Lateral boundary conditions on zwi (unchanged sign) 209 172 CALL crs_lbc_lnk( zwi, 'T', 1. ) … … 226 189 DO jj = 1, jpjm1 227 190 DO ji = 1, fs_jpim1 ! vector opt. 228 !iji=117 ; ijj=211 ; ijk=74229 !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1230 !IF( ji==iji .AND. jj==ijj )THEN231 !WRITE(narea+5000,*)"antidiffxy ",jk,pun(ji,jj,jk),ptn(ji,jj,jk,jn),ptn(ji+1,jj,jk,jn),zwx(ji,jj,jk)232 !WRITE(narea+5000,*)"antidiffxy ",jk,pvn(ji,jj,jk),ptn(ji,jj,jk,jn),ptn(ji,jj+1,jk,jn),zwy(ji,jj,jk)233 !ENDIF234 191 zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 235 192 zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) 236 !iji=117 ; ijj=211 ; ijk=74 237 !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1 238 !IF( ji==iji .AND. jj==ijj )THEN 239 !WRITE(narea+5000,*)"antidiffxy ",jk,zwx(ji,jj,jk),zwy(ji,jj,jk) 240 !ENDIF 241 END DO 242 END DO 243 END DO 244 ! WRITE(numout,*) 'test6456_trb_sbc', pta(10,10,1,1), kt 193 END DO 194 END DO 195 END DO 245 196 ! antidiffusive flux on k 246 197 zwz(:,:,1) = 0.e0 ! Surface value … … 250 201 DO ji = 1, jpi 251 202 zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk) 252 !iji=117 ; ijj=211 ; ijk=74253 !iji=iji-nimpp+1 ; ijj=ijj-njmpp+1254 !IF( ji==iji .AND. jj==ijj )THEN255 !WRITE(narea+5000,*)"antidiffz ",jk,zwz(ji,jj,jk)256 !ENDIF257 203 END DO 258 204 END DO … … 263 209 ! 4. monotonicity algorithm 264 210 ! ------------------------- 265 !DO jk = 2, jpkm1 ! Interior value266 ! DO jj = 1, jpj267 ! DO ji = 1, jpi268 ! IF( ptb(ji,jj,jk,jn) .NE. ptb(ji,jj,jk,jn) )WRITE(narea+200,*)"ADV1",ptb(ji,jj,jk,jn) ; call flush(narea+200)269 ! IF( zwx(ji,jj,jk) .NE. zwx(ji,jj,jk) )WRITE(narea+200,*)"ADV2",zwx(ji,jj,jk) ; call flush(narea+200)270 ! IF( zwy(ji,jj,jk) .NE. zwy(ji,jj,jk) )WRITE(narea+200,*)"ADV3",zwy(ji,jj,jk) ; call flush(narea+200)271 ! IF( zwz(ji,jj,jk) .NE. zwz(ji,jj,jk) )WRITE(narea+200,*)"ADV4",zwz(ji,jj,jk) ; call flush(narea+200)272 ! IF( zwi(ji,jj,jk) .NE. zwi(ji,jj,jk) )WRITE(narea+200,*)"ADV5",zwi(ji,jj,jk) ; call flush(narea+200)273 ! IF( tmask_crs(ji,jj,jk) .NE. tmask_crs(ji,jj,jk) )WRITE(narea+200,*)"ADV6",tmask_crs(ji,jj,jk) ; call flush(narea+200)274 ! END DO275 ! END DO276 !END DO277 278 211 CALL nonosc_crs( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt ) 279 280 !IF( narea==267 )THEN281 !DO jk=1,jpk-1282 !WRITE(narea+5000,*)"toto",jk,zwx(16,6,jk),zwx(17,6,jk),zwy(17,5,jk),zwy(17,6,jk),zwz(17,6,jk),zwz(17,6,jk+1)283 !ENDDO284 !ENDIF285 212 286 213 ! 5. final trend with corrected fluxes … … 298 225 299 226 300 !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN 301 !WRITE(narea+5000,*)"correc ",jk,ptb(ji,jj,jk,1),pta(ji,jj,jk,1),zwx(ji,jj,jk) , zwx(ji-1,jj ,jk ), & 302 ! zwy(ji,jj,jk) , zwy(ji ,jj-1,jk ),zwz(ji,jj,jk),zwz(ji ,jj ,jk+1) 303 !ENDIF 304 305 306 !IF( ztra .NE. 0._wp )WRITE(narea+6000,*)"bugb ",kt,ji,jj,jk,mbathy_crs(ji,jj), & 307 ! zwx(ji,jj,jk) , zwx(ji-1,jj ,jk ),zwy(ji,jj,jk) , zwy(ji ,jj-1,jk ),zwz(ji,jj,jk),zwz(ji ,jj ,jk+1) 308 END DO 309 END DO 310 END DO 311 !IF(narea==267)WRITE(narea+5000,*)"2 pta(17,6,74,1) = ",pta(17,6,74,1) 312 !zmin=MINVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_min(zmin) 313 !zmax=MAXVAL( pta(2:jpi-1,2:jpj-1,2:jpk,1),mask=(tmask(2:jpi-1,2:jpj-1,2:jpk)==1)) ; CALL mpp_max(zmax) 314 !IF(lwp)WRITE(numout,*)"trcadvtvdcrs b ",kt,zmin,zmax 315 316 !WRITE(numout,*) 'test_tra', maxval(pta(:,:,:,jk)) , kt 317 !WRITE(numout,*) 'test_tra', minval(pta(:,:,:,jk)) , kt 318 !WRITE(numout,*) 'test6456_trb_sbc', pta(10,10,1,1), kt 227 END DO 228 END DO 229 END DO 230 319 231 ! ! trend diagnostics (contribution of upstream fluxes) 320 232 IF( l_trd ) THEN … … 323 235 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 324 236 325 CALL trd_tra( kt, cdtype, jn, jptra_ trd_xad, ztrdx, pun, ptn(:,:,:,jn) )326 CALL trd_tra( kt, cdtype, jn, jptra_ trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )327 CALL trd_tra( kt, cdtype, jn, jptra_ trd_zad, ztrdz, pwn, ptn(:,:,:,jn) )237 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 238 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 239 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 328 240 END IF 329 241 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) … … 339 251 ! 340 252 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd') 341 ! IF(lwp) WRITE(numout,*) 'TEST2', pta342 !WRITE(numout,*) 'test6456_trb_sbc', pta(10,10,1,1), kt343 253 ! 344 254 END SUBROUTINE tra_adv_tvd_crs … … 434 344 zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 435 345 zcu = ( 0.5 + SIGN( 0.5 , paa(ji,jj,jk) ) ) 436 !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN437 ! WRITE(narea+5000,*)"nonosc ",jk438 ! WRITE(narea+5000,*)"paa",zbetdo(ji,jj,jk),zbetup(ji+1,jj,jk),zbetup(ji,jj,jk),zbetdo(ji+1,jj,jk)439 ! WRITE(narea+5000,*)"paa",zau,zbu,zcu, paa(ji,jj,jk)440 !ENDIF441 346 paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1.e0 - zcu) * zbu ) 442 !IF( narea==267 .AND. ji==17 .AND. jj==6 )WRITE(narea+5000,*)"paa",paa(ji,jj,jk)443 347 444 348 zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 445 349 zbv = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 446 350 zcv = ( 0.5 + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 447 !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN448 ! WRITE(narea+5000,*)"pbb",zbetdo(ji,jj,jk),zbetup(ji,jj+1,jk),zbetup(ji,jj,jk),zbetdo(ji,jj+1,jk)449 ! WRITE(narea+5000,*)"pbb",zav,zbv,zcv, pbb(ji,jj,jk)450 !ENDIF451 351 pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1.e0 - zcv) * zbv ) 452 !IF( narea==267 .AND. ji==17 .AND. jj==6 )WRITE(narea+5000,*)"pbb",pbb(ji,jj,jk)453 352 454 353 ! monotonic flux in the k direction, i.e. pcc … … 457 356 zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 458 357 zc = ( 0.5 + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 459 !IF( narea==267 .AND. ji==17 .AND. jj==6 )THEN460 ! WRITE(narea+5000,*)"pcc",zbetdo(ji,jj,jk+1),zbetup(ji,jj,jk),zbetup(ji,jj,jk+1),zbetdo(ji,jj,jk)461 ! WRITE(narea+5000,*)"pcc",za,zb,zc, pcc(ji,jj,jk+1)462 !ENDIF463 358 pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1.e0 - zc) * zb ) 464 !IF( narea==267 .AND. ji==17 .AND. jj==6 )WRITE(narea+5000,*)"pcc",pcc(ji,jj,jk+1)465 359 END DO 466 360 END DO 467 361 END DO 468 362 469 !IF( narea==267 )THEN470 !DO jk=1,jpk-1471 !WRITE(narea+5000,*)"nono",jk,paa(16,6,jk),paa(17,6,jk),pbb(17,5,jk),pbb(17,6,jk),pcc(17,6,jk),pcc(17,6,jk+1)472 !ENDDO473 !ENDIF474 475 363 CALL crs_lbc_lnk( paa, 'U', -1. ) ; CALL crs_lbc_lnk( pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 476 !IF( narea==267 )THEN477 !DO jk=1,jpk-1478 !WRITE(narea+5000,*)"nono1",jk,paa(16,6,jk),paa(17,6,jk),pbb(17,5,jk),pbb(17,6,jk),pcc(17,6,jk),pcc(17,6,jk+1)479 !!ENDDO480 !ENDIF481 364 ! 482 365 CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
Note: See TracChangeset
for help on using the changeset viewer.
