Changeset 10418 for NEMO/trunk/src
- Timestamp:
- 2018-12-19T15:18:03+01:00 (5 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/ICE/icedyn_adv_umx.F90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icedyn_adv_umx.F90
r10413 r10418 35 35 REAL(wp) :: z1_120 = 1._wp / 120._wp ! =1/120 36 36 37 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: z1_ai,amaxu, amaxv37 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: amaxu, amaxv 38 38 39 LOGICAL ll_dens40 41 39 ! advect H all the way (and get V=H*A at the end) 42 40 LOGICAL :: ll_thickness = .FALSE. … … 124 122 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box, zua_ho, zva_ho 125 123 REAL(wp), DIMENSION(jpi,jpj) :: zhvar 126 REAL(wp), DIMENSION(jpi,jpj) :: za i_b, zai_a, z1_ai_b124 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2, z1_ai, z1_aip 127 125 !!---------------------------------------------------------------------- 128 126 ! … … 160 158 END DO 161 159 162 IF(.NOT. ALLOCATED(z1_ai)) ALLOCATE(z1_ai(jpi,jpj))163 160 IF( ll_zeroup2 ) THEN 164 161 IF(.NOT. ALLOCATED(amaxu)) ALLOCATE(amaxu (jpi,jpj)) … … 171 168 172 169 IF( ll_ADVopw ) THEN 173 ll_dens=.FALSE.174 170 zamsk = 1._wp 175 171 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zudy, zvdx, zcu_box, zcv_box, pato_i(:,:), pato_i(:,:) ) ! Open water area 172 zamsk = 0._wp 176 173 ELSE 177 za i_b(:,:) = SUM( pa_i(:,:,:), dim=3 )174 zati1(:,:) = SUM( pa_i(:,:,:), dim=3 ) 178 175 ENDIF 179 176 180 177 DO jl = 1, jpl 181 178 ! 182 WHERE( pa_i(:,:,jl) >= epsi20 ) ; z1_ai_b(:,:) = 1._wp / pa_i(:,:,jl) 183 ELSEWHERE ; z1_ai_b(:,:) = 0. 179 WHERE( pa_i(:,:,jl) >= epsi20 ) ; z1_ai(:,:) = 1._wp / pa_i(:,:,jl) 180 ELSEWHERE ; z1_ai(:,:) = 0. 181 END WHERE 182 ! 183 WHERE( pa_ip(:,:,jl) >= epsi20 ) ; z1_aip(:,:) = 1._wp / pa_ip(:,:,jl) 184 ELSEWHERE ; z1_aip(:,:) = 0. 184 185 END WHERE 185 186 ! … … 197 198 ! 198 199 zamsk = 1._wp 199 ll_dens=.TRUE. 200 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zudy, zvdx, zcu_box, zcv_box, pa_i(:,:,jl), pa_i(:,:,jl), zua_ho, zva_ho ) ! Ice area 201 ll_dens=.FALSE. 202 203 WHERE( pa_i(:,:,jl) >= epsi20 ) ; z1_ai(:,:) = 1._wp / pa_i(:,:,jl) 204 ELSEWHERE ; z1_ai(:,:) = 0. 205 END WHERE 206 200 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zudy, zvdx, zcu_box, zcv_box, pa_i(:,:,jl), pa_i(:,:,jl), & ! Ice area 201 & zua_ho, zva_ho ) 202 zamsk = 0._wp 203 ! 207 204 IF( ll_thickness ) THEN 208 205 zua_ho(:,:) = zudy(:,:) 209 206 zva_ho(:,:) = zvdx(:,:) 210 207 ENDIF 211 212 z amsk = 0._wp ; zhvar(:,:) = pv_i (:,:,jl) * z1_ai_b(:,:)213 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), pv_i (:,:,jl) ) 208 ! 209 zhvar(:,:) = pv_i(:,:,jl) * z1_ai(:,:) 210 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), pv_i (:,:,jl) ) ! Ice volume 214 211 IF( ll_thickness ) pv_i(:,:,jl) = zhvar(:,:) * pa_i(:,:,jl) 215 216 z amsk = 0._wp ; zhvar(:,:) = pv_s (:,:,jl) * z1_ai_b(:,:)217 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), pv_s (:,:,jl) ) 212 ! 213 zhvar(:,:) = pv_s(:,:,jl) * z1_ai(:,:) 214 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), pv_s (:,:,jl) ) ! Snw volume 218 215 IF( ll_thickness ) pv_s(:,:,jl) = zhvar(:,:) * pa_i(:,:,jl) 219 220 z amsk = 0._wp ; zhvar(:,:) = psv_i(:,:,jl) * z1_ai_b(:,:)221 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), psv_i(:,:,jl) ) 222 223 z amsk = 0._wp ; zhvar(:,:) = poa_i(:,:,jl) * z1_ai_b(:,:)224 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), poa_i(:,:,jl) ) 225 216 ! 217 zhvar(:,:) = psv_i(:,:,jl) * z1_ai(:,:) 218 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), psv_i(:,:,jl) ) ! Salt content 219 ! 220 zhvar(:,:) = poa_i(:,:,jl) * z1_ai(:,:) 221 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), poa_i(:,:,jl) ) ! Age content 222 ! 226 223 DO jk = 1, nlay_i 227 z amsk = 0._wp ; zhvar(:,:) = pe_i(:,:,jk,jl) * z1_ai_b(:,:)228 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar(:,:), pe_i(:,:,jk,jl) ) 229 END DO 230 224 zhvar(:,:) = pe_i(:,:,jk,jl) * z1_ai(:,:) 225 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar(:,:), pe_i(:,:,jk,jl) ) ! Ice heat content 226 END DO 227 ! 231 228 DO jk = 1, nlay_s 232 zamsk = 0._wp ; zhvar(:,:) = pe_s(:,:,jk,jl) * z1_ai_b(:,:) 233 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar(:,:), pe_s(:,:,jk,jl) ) ! Snw heat content 234 END DO 235 ! 236 IF ( ln_pnd_H12 ) THEN ! melt ponds (must be the last ones to be advected because of z1_ai_b...) 237 ! 238 WHERE( pa_ip(:,:,jl) >= epsi20 ) ; z1_ai_b(:,:) = 1._wp / pa_ip(:,:,jl) 239 ELSEWHERE ; z1_ai_b(:,:) = 0. 240 END WHERE 229 zhvar(:,:) = pe_s(:,:,jk,jl) * z1_ai(:,:) 230 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar(:,:), pe_s(:,:,jk,jl) ) ! Snw heat content 231 END DO 232 ! 233 IF ( ln_pnd_H12 ) THEN 241 234 ! 242 235 zamsk = 1._wp 243 ll_dens=.TRUE. 244 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zudy, zvdx, zcu_box, zcv_box, pa_ip(:,:,jl), pa_ip(:,:,jl), zua_ho, zva_ho ) ! mp fractio!n 245 ll_dens=.FALSE. 246 247 WHERE( pa_ip(:,:,jl) >= epsi20 ) ; z1_ai(:,:) = 1._wp / pa_ip(:,:,jl) 248 ELSEWHERE ; z1_ai(:,:) = 0. 249 END WHERE 250 251 zamsk = 0._wp ; zhvar(:,:) = pv_ip(:,:,jl) * z1_ai_b(:,:) 252 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), pv_ip(:,:,jl) ) ! mp volume 253 ENDIF 254 ! 255 ! 256 END DO 257 236 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zudy, zvdx, zcu_box, zcv_box, pa_ip(:,:,jl), pa_ip(:,:,jl), & ! mp fraction 237 & zua_ho, zva_ho ) 238 zamsk = 0._wp 239 240 zhvar(:,:) = pv_ip(:,:,jl) * z1_ai(:,:) 241 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho , zva_ho , zcu_box, zcv_box, zhvar(:,:), pv_ip(:,:,jl) ) ! mp volume 242 ENDIF 243 ! 244 ! 245 END DO 246 ! 258 247 IF( .NOT. ll_ADVopw ) THEN 259 za i_a(:,:) = SUM( pa_i(:,:,:), dim=3 )248 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 260 249 DO jj = 2, jpjm1 261 250 DO ji = fs_2, fs_jpim1 262 pato_i(ji,jj) = pato_i(ji,jj) - ( za i_a(ji,jj) - zai_b(ji,jj) ) &263 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) *zdt251 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & ! Open water area 252 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) )*r1_e1e2t(ji,jj)*zdt 264 253 END DO 265 254 END DO 266 255 CALL lbc_lnk( pato_i(:,:), 'T', 1. ) 267 256 ENDIF 268 257 ! 269 258 END DO 270 259 ! … … 306 295 ! upstream (_ups) advection with initial mass fluxes 307 296 ! --------------------------------------------------- 308 IF( ll_clem ) zfu_ups=0.; zfv_ups=0.309 297 310 298 IF( ll_gurvan .AND. pamsk==0. ) THEN … … 321 309 IF( .NOT. ll_upsxy ) THEN 322 310 323 ! fluxes 311 ! fluxes in both x-y directions 324 312 DO jj = 1, jpjm1 325 313 DO ji = 1, fs_jpim1 … … 335 323 336 324 ELSE 337 ! 1 if advection of A338 ! z1_ai already defined IF advection of other tracers339 IF( pamsk == 1. ) z1_ai(:,:) = 1._wp340 325 ! 341 326 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! … … 359 344 ELSE 360 345 zpt(ji,jj) = ( pt(ji,jj) - ( zfu_ups(ji,jj) - zfu_ups(ji-1,jj) ) * pdt * r1_e1e2t(ji,jj) & 361 & + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) )&362 & * tmask(ji,jj,1)346 & + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 347 & ) * tmask(ji,jj,1) 363 348 ENDIF 364 349 ELSE … … 457 442 zt_ups(ji,jj) = ( pt (ji,jj) + pdt * ztra ) * tmask(ji,jj,1) 458 443 ELSE 459 zt_ups(ji,jj) = ( pt (ji,jj) + pdt * ztra + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 460 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) ) * tmask(ji,jj,1) 444 zt_ups(ji,jj) = ( pt (ji,jj) + pdt * ztra + ( pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) & 445 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) ) & 446 & * r1_e1e2t(ji,jj) * (1.-pamsk) ) * tmask(ji,jj,1) 461 447 ENDIF 462 448 ELSE … … 517 503 ! Rachid trick 518 504 ! ------------ 519 IF( ll_clem ) THEN505 IF( ll_clem ) THEN 520 506 IF( pamsk == 0. ) THEN 521 507 DO jj = 1, jpjm1 … … 557 543 ENDIF 558 544 559 ! output upstream trend of concentration and high order fluxes 560 ! ------------------------------------------------------------ 561 IF( ll_dens ) THEN 562 ! high order u*a 545 ! output high order fluxes u*a 546 ! ---------------------------- 547 IF( PRESENT( pua_ho ) ) THEN 563 548 DO jj = 1, jpjm1 564 549 DO ji = 1, fs_jpim1 565 pua_ho (ji,jj) = zfu_ho (ji,jj) 566 pva_ho (ji,jj) = zfv_ho (ji,jj) 567 END DO 568 END DO 569 !!CALL lbc_lnk( pua_ho, 'U', -1. ) ! clem: not needed I think 570 !!CALL lbc_lnk( pva_ho, 'V', -1. ) 550 pua_ho(ji,jj) = zfu_ho(ji,jj) 551 pva_ho(ji,jj) = zfv_ho(ji,jj) 552 END DO 553 END DO 571 554 ENDIF 572 555 … … 577 560 DO jj = 2, jpjm1 578 561 DO ji = fs_2, fs_jpim1 579 ztra = - ( zfu_ho(ji,jj) - zfu_ho(ji-1,jj) + zfv_ho(ji,jj) - zfv_ho(ji,jj-1) ) & ! Div(uaH) or Div(ua) 580 & * r1_e1e2t(ji,jj) * pdt 581 582 !!IF( ptc(ji,jj)+ztra < 0._wp ) THEN 583 !! ztra = - ( zfu_ups(ji,jj) - zfu_ups(ji-1,jj) + zfv_ups(ji,jj) - zfv_ups(ji,jj-1) ) & ! Div(uaH) or Div(ua) 584 !! & * r1_e1e2t(ji,jj) * pdt 585 !!ENDIF 586 !!IF( ptc(ji,jj)+ztra < 0._wp ) THEN 587 !! WRITE(numout,*) 'Tc<0 ',ptc(ji,jj)+ztra 588 !! ztra = 0._wp 589 !!ENDIF 562 ztra = - ( zfu_ho(ji,jj) - zfu_ho(ji-1,jj) + zfv_ho(ji,jj) - zfv_ho(ji,jj-1) ) * r1_e1e2t(ji,jj) * pdt 590 563 591 564 ptc(ji,jj) = ( ptc(ji,jj) + ztra ) * tmask(ji,jj,1) … … 637 610 DO jj = 1, jpjm1 638 611 DO ji = 1, fs_jpim1 639 pfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( pt(ji,jj) + pt(ji+1,jj) ) 640 pfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( pt(ji,jj) + pt(ji,jj+1) ) 612 IF( ll_clem ) THEN 613 pfu_ho(ji,jj) = 0.5 * pu(ji,jj) * ( pt(ji,jj) + pt(ji+1,jj) ) 614 pfv_ho(ji,jj) = 0.5 * pv(ji,jj) * ( pt(ji,jj) + pt(ji,jj+1) ) 615 ELSE 616 pfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( pt(ji,jj) + pt(ji+1,jj) ) 617 pfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( pt(ji,jj) + pt(ji,jj+1) ) 618 ENDIF 641 619 END DO 642 620 END DO … … 657 635 ELSE !-- alternate directions --! 658 636 ! 659 IF( pamsk == 1. ) z1_ai(:,:) = 1._wp660 !661 637 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! 662 638 ! … … 664 640 DO jj = 1, jpjm1 665 641 DO ji = 1, fs_jpim1 666 pfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( pt(ji,jj) + pt(ji+1,jj) ) 642 IF( ll_clem ) THEN 643 pfu_ho(ji,jj) = 0.5 * pu(ji,jj) * ( pt(ji,jj) + pt(ji+1,jj) ) 644 ELSE 645 pfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( pt(ji,jj) + pt(ji+1,jj) ) 646 ENDIF 667 647 END DO 668 648 END DO … … 674 654 DO ji = fs_2, fs_jpim1 ! vector opt. 675 655 IF( ll_clem ) THEN 676 zzt(ji,jj) = ( pt(ji,jj) - ( pfu_ho(ji,jj) - pfu_ho(ji-1,jj) ) * pdt * r1_e1e2t(ji,jj) * z1_ai(ji,jj) ) * tmask(ji,jj,1) 656 zzt(ji,jj) = ( pt(ji,jj) - ( pfu_ho(ji,jj) - pfu_ho(ji-1,jj) ) * pdt * r1_e1e2t(ji,jj) & 657 & + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) ) & 658 & * tmask(ji,jj,1) 677 659 ELSE 678 zzt(ji,jj) = ( ptc(ji,jj) - ( pfu_ho(ji,jj) - pfu_ho(ji-1,jj) ) * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) * z1_ai(ji,jj)660 zzt(ji,jj) = ( ptc(ji,jj) - ( pfu_ho(ji,jj) - pfu_ho(ji-1,jj) ) * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 679 661 ENDIF 680 662 END DO … … 685 667 DO jj = 1, jpjm1 686 668 DO ji = 1, fs_jpim1 687 pfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( zzt(ji,jj) + zzt(ji,jj+1) ) 669 IF( ll_clem ) THEN 670 pfv_ho(ji,jj) = 0.5 * pv(ji,jj) * ( zzt(ji,jj) + zzt(ji,jj+1) ) 671 ELSE 672 pfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( zzt(ji,jj) + zzt(ji,jj+1) ) 673 ENDIF 688 674 END DO 689 675 END DO … … 696 682 DO jj = 1, jpjm1 697 683 DO ji = 1, fs_jpim1 698 pfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( pt(ji,jj) + pt(ji,jj+1) ) 684 IF( ll_clem ) THEN 685 pfv_ho(ji,jj) = 0.5 * pv(ji,jj) * ( pt(ji,jj) + pt(ji,jj+1) ) 686 ELSE 687 pfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( pt(ji,jj) + pt(ji,jj+1) ) 688 ENDIF 699 689 END DO 700 690 END DO … … 706 696 DO ji = fs_2, fs_jpim1 ! vector opt. 707 697 IF( ll_clem ) THEN 708 zzt(ji,jj) = ( pt(ji,jj) - ( pfv_ho(ji,jj) - pfv_ho(ji,jj-1) ) * pdt * r1_e1e2t(ji,jj) * z1_ai(ji,jj) ) * tmask(ji,jj,1) 698 zzt(ji,jj) = ( pt(ji,jj) - ( pfv_ho(ji,jj) - pfv_ho(ji,jj-1) ) * pdt * r1_e1e2t(ji,jj) & 699 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) ) & 700 & * tmask(ji,jj,1) 709 701 ELSE 710 zzt(ji,jj) = ( ptc(ji,jj) - ( pfv_ho(ji,jj) - pfv_ho(ji,jj-1) ) * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) * z1_ai(ji,jj)702 zzt(ji,jj) = ( ptc(ji,jj) - ( pfv_ho(ji,jj) - pfv_ho(ji,jj-1) ) * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 711 703 ENDIF 712 704 END DO … … 717 709 DO jj = 1, jpjm1 718 710 DO ji = 1, fs_jpim1 719 pfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( zzt(ji,jj) + zzt(ji+1,jj) ) 711 IF( ll_clem ) THEN 712 pfu_ho(ji,jj) = 0.5 * pu(ji,jj) * ( zzt(ji,jj) + zzt(ji+1,jj) ) 713 ELSE 714 pfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( zzt(ji,jj) + zzt(ji+1,jj) ) 715 ENDIF 720 716 END DO 721 717 END DO … … 787 783 ELSE 788 784 zzt(ji,jj) = ( pt(ji,jj) - ( pfu_ho(ji,jj) - pfu_ho(ji-1,jj) ) * pdt * r1_e1e2t(ji,jj) & 789 & + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) ) * tmask(ji,jj,1) 785 & + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 786 & ) * tmask(ji,jj,1) 790 787 ENDIF 791 788 ELSE … … 842 839 ELSE 843 840 zzt(ji,jj) = ( pt(ji,jj) - ( pfv_ho(ji,jj) - pfv_ho(ji,jj-1) ) * pdt * r1_e1e2t(ji,jj) & 844 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) ) * tmask(ji,jj,1) 841 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 842 & ) * tmask(ji,jj,1) 845 843 ENDIF 846 844 ELSE … … 1259 1257 & - ( pfv_ho(ji,jj) - pfv_ho(ji,jj-1) ) * pdt * r1_e1e2t(ji,jj) & 1260 1258 & + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 1261 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) ) * tmask(ji,jj,1) 1259 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 1260 & ) * tmask(ji,jj,1) 1262 1261 ENDIF 1263 1262 IF( zzt(ji,jj) < 0._wp ) THEN … … 1280 1279 & - ( pfv_ho(ji,jj) - pfv_ho(ji,jj-1) ) * pdt * r1_e1e2t(ji,jj) & 1281 1280 & + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 1282 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) ) * tmask(ji,jj,1) 1281 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 1282 & ) * tmask(ji,jj,1) 1283 1283 ENDIF 1284 1284 IF( zzt(ji,jj) < 0._wp ) THEN … … 1294 1294 & - ( pfv_ho(ji,jj) - pfv_ho(ji,jj-1) ) * pdt * r1_e1e2t(ji,jj) & 1295 1295 & + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 1296 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) ) * tmask(ji,jj,1) 1296 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 1297 & ) * tmask(ji,jj,1) 1297 1298 ENDIF 1298 1299 IF( zzt(ji,jj) < 0._wp ) THEN … … 1332 1333 CALL lbc_lnk_multi( zti_low, 'T', 1., ztj_low, 'T', 1. ) 1333 1334 1334 1335 !! this does not work 1335 !! this does not work ?? 1336 1336 !! DO jj = 2, jpjm1 1337 1337 !! DO ji = fs_2, fs_jpim1 … … 1440 1440 ! 1441 1441 IF( ll_HgradU .AND. .NOT.ll_gurvan ) THEN 1442 zneg2 = ( pt(ji,jj) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) ) * ( 1. - pamsk ) 1443 zpos2 = ( - pt(ji,jj) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) - pt(ji,jj) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) ) * ( 1. - pamsk ) 1442 zneg2 = ( pt(ji,jj) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1443 & ) * ( 1. - pamsk ) 1444 zpos2 = ( - pt(ji,jj) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) - pt(ji,jj) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) & 1445 & ) * ( 1. - pamsk ) 1444 1446 ELSE 1445 1447 zneg2 = 0. ; zpos2 = 0. … … 1447 1449 ! 1448 1450 ! ! up & down beta terms 1449 ! zbetup(ji,jj) = ( zup - pt_low(ji,jj) ) / ( zpos + zsml ) * e1e2t(ji,jj) * z1_dt1450 ! zbetdo(ji,jj) = ( pt_low(ji,jj) - zdo ) / ( zneg + zsml ) * e1e2t(ji,jj) * z1_dt1451 1452 1451 IF( (zpos+zpos2) > 0. ) THEN ; zbetup(ji,jj) = MAX( 0._wp, zup - pt_low(ji,jj) ) / (zpos+zpos2) * e1e2t(ji,jj) * z1_dt 1453 1452 ELSE ; zbetup(ji,jj) = 0. ! zbig … … 1544 1543 & - ( pfv_ho(ji,jj) - pfv_ho(ji,jj-1) ) * pdt * r1_e1e2t(ji,jj) & 1545 1544 & + pt(ji,jj) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 1546 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) ) * tmask(ji,jj,1) 1545 & + pt(ji,jj) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) & 1546 & ) * tmask(ji,jj,1) 1547 1547 ENDIF 1548 1548 IF( zzt(ji,jj) < -epsi20 ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
