![(please configure the [header_logo] section in trac.ini)](/dynamico/chrome/site/your_project_logo.png){kind=logo}
Changeset 844
- Timestamp:
- 05/03/19 19:16:45 (5 years ago)
- Location:
- codes/icosagcm/devel/src/dynamics
- Files:
-
- 1 added
- 2 edited
-
caldyn_hevi.f90 (modified) (1 diff)
-
caldyn_kernels_hevi.F90 (modified) (2 diffs)
-
compute_caldyn_Coriolis.F90 (added)
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/dynamics/caldyn_hevi.f90
r842 r844 7 7 USE compute_theta_mod, ONLY : compute_theta 8 8 USE compute_caldyn_kv_mod, ONLY : compute_caldyn_kv 9 USE compute_caldyn_Coriolis_mod, ONLY : compute_caldyn_Coriolis 9 10 IMPLICIT NONE 10 11 PRIVATE -
codes/icosagcm/devel/src/dynamics/caldyn_kernels_hevi.F90
r842 r844 13 13 LOGICAL, SAVE :: debug_hevi_solver = .FALSE. 14 14 15 PUBLIC :: compute_caldyn_Coriolis, & 16 compute_caldyn_slow_hydro, compute_caldyn_slow_NH, & 15 PUBLIC :: compute_caldyn_slow_hydro, compute_caldyn_slow_NH, & 17 16 compute_caldyn_solver, compute_caldyn_fast 18 17 … … 434 433 435 434 END SUBROUTINE compute_caldyn_fast 436 437 SUBROUTINE compute_caldyn_Coriolis(hflux,theta,qu, convm,dtheta_rhodz,du)438 REAL(rstd),INTENT(IN) :: hflux(3*iim*jjm,llm) ! hflux in kg/s439 REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm,nqdyn) ! active scalars440 REAL(rstd),INTENT(IN) :: qu(3*iim*jjm,llm)441 REAL(rstd),INTENT(OUT) :: convm(iim*jjm,llm) ! mass flux convergence442 REAL(rstd),INTENT(OUT) :: dtheta_rhodz(iim*jjm,llm,nqdyn)443 REAL(rstd),INTENT(INOUT) :: du(3*iim*jjm,llm)444 445 REAL(rstd) :: Ftheta(3*iim*jjm,llm) ! potential temperature flux446 REAL(rstd) :: uu_right, uu_lup, uu_ldown, du_trisk, divF447 INTEGER :: ij,iq,l,kdown448 449 CALL trace_start("compute_caldyn_Coriolis")450 451 IF(dysl_caldyn_coriolis) THEN452 453 #include "../kernels_hex/coriolis.k90"454 455 ELSE456 #define FTHETA(ij) Ftheta(ij,1)457 458 DO l=ll_begin, ll_end459 ! compute theta flux460 DO iq=1,nqdyn461 !DIR$ SIMD462 DO ij=ij_begin_ext,ij_end_ext463 FTHETA(ij+u_right) = 0.5*(theta(ij,l,iq)+theta(ij+t_right,l,iq)) &464 * hflux(ij+u_right,l)465 FTHETA(ij+u_lup) = 0.5*(theta(ij,l,iq)+theta(ij+t_lup,l,iq)) &466 * hflux(ij+u_lup,l)467 FTHETA(ij+u_ldown) = 0.5*(theta(ij,l,iq)+theta(ij+t_ldown,l,iq)) &468 * hflux(ij+u_ldown,l)469 END DO470 ! horizontal divergence of fluxes471 !DIR$ SIMD472 DO ij=ij_begin,ij_end473 ! dtheta_rhodz = -div(flux.theta)474 dtheta_rhodz(ij,l,iq)= &475 -1./Ai(ij)*(ne_right*FTHETA(ij+u_right) + &476 ne_rup*FTHETA(ij+u_rup) + &477 ne_lup*FTHETA(ij+u_lup) + &478 ne_left*FTHETA(ij+u_left) + &479 ne_ldown*FTHETA(ij+u_ldown) + &480 ne_rdown*FTHETA(ij+u_rdown) )481 END DO482 END DO483 484 !DIR$ SIMD485 DO ij=ij_begin,ij_end486 ! convm = -div(mass flux), sign convention as in Ringler et al. 2012, eq. 21487 convm(ij,l)= -1./Ai(ij)*(ne_right*hflux(ij+u_right,l) + &488 ne_rup*hflux(ij+u_rup,l) + &489 ne_lup*hflux(ij+u_lup,l) + &490 ne_left*hflux(ij+u_left,l) + &491 ne_ldown*hflux(ij+u_ldown,l) + &492 ne_rdown*hflux(ij+u_rdown,l))493 END DO ! ij494 END DO ! llm495 496 !!! Compute potential vorticity (Coriolis) contribution to du497 SELECT CASE(caldyn_conserv)498 499 CASE(conserv_energy) ! energy-conserving TRiSK500 501 DO l=ll_begin,ll_end502 !DIR$ SIMD503 DO ij=ij_begin,ij_end504 uu_right = &505 wee(ij+u_right,1,1)*hflux(ij+u_rup,l)*(qu(ij+u_right,l)+qu(ij+u_rup,l))+ &506 wee(ij+u_right,2,1)*hflux(ij+u_lup,l)*(qu(ij+u_right,l)+qu(ij+u_lup,l))+ &507 wee(ij+u_right,3,1)*hflux(ij+u_left,l)*(qu(ij+u_right,l)+qu(ij+u_left,l))+ &508 wee(ij+u_right,4,1)*hflux(ij+u_ldown,l)*(qu(ij+u_right,l)+qu(ij+u_ldown,l))+ &509 wee(ij+u_right,5,1)*hflux(ij+u_rdown,l)*(qu(ij+u_right,l)+qu(ij+u_rdown,l))+ &510 wee(ij+u_right,1,2)*hflux(ij+t_right+u_ldown,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_ldown,l))+ &511 wee(ij+u_right,2,2)*hflux(ij+t_right+u_rdown,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_rdown,l))+ &512 wee(ij+u_right,3,2)*hflux(ij+t_right+u_right,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_right,l))+ &513 wee(ij+u_right,4,2)*hflux(ij+t_right+u_rup,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_rup,l))+ &514 wee(ij+u_right,5,2)*hflux(ij+t_right+u_lup,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_lup,l))515 uu_lup = &516 wee(ij+u_lup,1,1)*hflux(ij+u_left,l)*(qu(ij+u_lup,l)+qu(ij+u_left,l)) + &517 wee(ij+u_lup,2,1)*hflux(ij+u_ldown,l)*(qu(ij+u_lup,l)+qu(ij+u_ldown,l)) + &518 wee(ij+u_lup,3,1)*hflux(ij+u_rdown,l)*(qu(ij+u_lup,l)+qu(ij+u_rdown,l)) + &519 wee(ij+u_lup,4,1)*hflux(ij+u_right,l)*(qu(ij+u_lup,l)+qu(ij+u_right,l)) + &520 wee(ij+u_lup,5,1)*hflux(ij+u_rup,l)*(qu(ij+u_lup,l)+qu(ij+u_rup,l)) + &521 wee(ij+u_lup,1,2)*hflux(ij+t_lup+u_right,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_right,l)) + &522 wee(ij+u_lup,2,2)*hflux(ij+t_lup+u_rup,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_rup,l)) + &523 wee(ij+u_lup,3,2)*hflux(ij+t_lup+u_lup,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_lup,l)) + &524 wee(ij+u_lup,4,2)*hflux(ij+t_lup+u_left,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_left,l)) + &525 wee(ij+u_lup,5,2)*hflux(ij+t_lup+u_ldown,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_ldown,l))526 uu_ldown = &527 wee(ij+u_ldown,1,1)*hflux(ij+u_rdown,l)*(qu(ij+u_ldown,l)+qu(ij+u_rdown,l)) + &528 wee(ij+u_ldown,2,1)*hflux(ij+u_right,l)*(qu(ij+u_ldown,l)+qu(ij+u_right,l)) + &529 wee(ij+u_ldown,3,1)*hflux(ij+u_rup,l)*(qu(ij+u_ldown,l)+qu(ij+u_rup,l)) + &530 wee(ij+u_ldown,4,1)*hflux(ij+u_lup,l)*(qu(ij+u_ldown,l)+qu(ij+u_lup,l)) + &531 wee(ij+u_ldown,5,1)*hflux(ij+u_left,l)*(qu(ij+u_ldown,l)+qu(ij+u_left,l)) + &532 wee(ij+u_ldown,1,2)*hflux(ij+t_ldown+u_lup,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_lup,l)) + &533 wee(ij+u_ldown,2,2)*hflux(ij+t_ldown+u_left,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_left,l)) + &534 wee(ij+u_ldown,3,2)*hflux(ij+t_ldown+u_ldown,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_ldown,l)) + &535 wee(ij+u_ldown,4,2)*hflux(ij+t_ldown+u_rdown,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_rdown,l)) + &536 wee(ij+u_ldown,5,2)*hflux(ij+t_ldown+u_right,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_right,l))537 du(ij+u_right,l) = du(ij+u_right,l) + .5*uu_right538 du(ij+u_lup,l) = du(ij+u_lup,l) + .5*uu_lup539 du(ij+u_ldown,l) = du(ij+u_ldown,l) + .5*uu_ldown540 ENDDO541 ENDDO542 543 CASE(conserv_gassmann) ! energy-conserving TRiSK modified by Gassmann (2018)544 545 DO l=ll_begin,ll_end546 !DIR$ SIMD547 DO ij=ij_begin,ij_end548 uu_right = &549 wee(ij+u_right,1,1)*hflux(ij+u_rup,l) *qu(ij+t_right+u_lup,l)+ &550 wee(ij+u_right,2,1)*hflux(ij+u_lup,l) *qu(ij+u_rup,l)+ &551 .5*wee(ij+u_right,3,1)*hflux(ij+u_left,l)*(qu(ij+u_right,l)+qu(ij+u_left,l))+ &552 wee(ij+u_right,4,1)*hflux(ij+u_ldown,l)*qu(ij+u_rdown,l)+ &553 wee(ij+u_right,5,1)*hflux(ij+u_rdown,l)*qu(ij+t_right+u_ldown,l)+ &554 wee(ij+u_right,1,2)*hflux(ij+t_right+u_ldown,l)*qu(ij+u_rdown,l)+ &555 wee(ij+u_right,2,2)*hflux(ij+t_right+u_rdown,l)*qu(ij+t_right+u_ldown,l)+ &556 .5*wee(ij+u_right,3,2)*hflux(ij+t_right+u_right,l)*(qu(ij+u_right,l)+qu(ij+t_right+u_right,l))+ &557 wee(ij+u_right,4,2)*hflux(ij+t_right+u_rup,l)*qu(ij+t_right+u_lup,l)+ &558 wee(ij+u_right,5,2)*hflux(ij+t_right+u_lup,l)*qu(ij+u_rup,l)559 uu_lup = &560 wee(ij+u_lup,1,1)*hflux(ij+u_left,l)*qu(ij+t_lup+u_ldown,l) + &561 wee(ij+u_lup,2,1)*hflux(ij+u_ldown,l)*qu(ij+u_left,l) + &562 .5*wee(ij+u_lup,3,1)*hflux(ij+u_rdown,l)*(qu(ij+u_lup,l)+qu(ij+u_rdown,l)) + &563 wee(ij+u_lup,4,1)*hflux(ij+u_right,l)*qu(ij+u_rup,l) + &564 wee(ij+u_lup,5,1)*hflux(ij+u_rup,l)*qu(ij+t_lup+u_right,l)+ &565 wee(ij+u_lup,1,2)*hflux(ij+t_lup+u_right,l)*qu(ij+u_rup,l) + &566 wee(ij+u_lup,2,2)*hflux(ij+t_lup+u_rup,l)*qu(ij+t_lup+u_right,l) + &567 .5*wee(ij+u_lup,3,2)*hflux(ij+t_lup+u_lup,l)*(qu(ij+u_lup,l)+qu(ij+t_lup+u_lup,l)) + &568 wee(ij+u_lup,4,2)*hflux(ij+t_lup+u_left,l)*qu(ij+t_lup+u_ldown,l) + &569 wee(ij+u_lup,5,2)*hflux(ij+t_lup+u_ldown,l)*qu(ij+u_left,l)570 uu_ldown = &571 wee(ij+u_ldown,1,1)*hflux(ij+u_rdown,l)*qu(ij+t_ldown,l+u_right) + &572 wee(ij+u_ldown,2,1)*hflux(ij+u_right,l)*qu(ij+u_rdown,l) + &573 .5*wee(ij+u_ldown,3,1)*hflux(ij+u_rup,l)*(qu(ij+u_ldown,l)+qu(ij+u_rup,l)) + &574 wee(ij+u_ldown,4,1)*hflux(ij+u_lup,l)*qu(ij+u_left,l) + &575 wee(ij+u_ldown,5,1)*hflux(ij+u_left,l)*qu(ij+t_ldown+u_lup,l) + &576 wee(ij+u_ldown,1,2)*hflux(ij+t_ldown+u_lup,l)*qu(ij+u_left,l) + &577 wee(ij+u_ldown,2,2)*hflux(ij+t_ldown+u_left,l)*qu(ij+t_ldown+u_lup,l) + &578 .5*wee(ij+u_ldown,3,2)*hflux(ij+t_ldown+u_ldown,l)*(qu(ij+u_ldown,l)+qu(ij+t_ldown+u_ldown,l)) + &579 wee(ij+u_ldown,4,2)*hflux(ij+t_ldown+u_rdown,l)*qu(ij+t_ldown+u_right,l) + &580 wee(ij+u_ldown,5,2)*hflux(ij+t_ldown+u_right,l)*qu(ij+u_rdown,l)581 du(ij+u_right,l) = du(ij+u_right,l) + uu_right582 du(ij+u_lup,l) = du(ij+u_lup,l) + uu_lup583 du(ij+u_ldown,l) = du(ij+u_ldown,l) + uu_ldown584 ENDDO585 ENDDO586 587 CASE(conserv_enstrophy) ! enstrophy-conserving TRiSK588 589 DO l=ll_begin,ll_end590 !DIR$ SIMD591 DO ij=ij_begin,ij_end592 uu_right = &593 wee(ij+u_right,1,1)*hflux(ij+u_rup,l)+ &594 wee(ij+u_right,2,1)*hflux(ij+u_lup,l)+ &595 wee(ij+u_right,3,1)*hflux(ij+u_left,l)+ &596 wee(ij+u_right,4,1)*hflux(ij+u_ldown,l)+ &597 wee(ij+u_right,5,1)*hflux(ij+u_rdown,l)+ &598 wee(ij+u_right,1,2)*hflux(ij+t_right+u_ldown,l)+ &599 wee(ij+u_right,2,2)*hflux(ij+t_right+u_rdown,l)+ &600 wee(ij+u_right,3,2)*hflux(ij+t_right+u_right,l)+ &601 wee(ij+u_right,4,2)*hflux(ij+t_right+u_rup,l)+ &602 wee(ij+u_right,5,2)*hflux(ij+t_right+u_lup,l)603 uu_lup = &604 wee(ij+u_lup,1,1)*hflux(ij+u_left,l)+ &605 wee(ij+u_lup,2,1)*hflux(ij+u_ldown,l)+ &606 wee(ij+u_lup,3,1)*hflux(ij+u_rdown,l)+ &607 wee(ij+u_lup,4,1)*hflux(ij+u_right,l)+ &608 wee(ij+u_lup,5,1)*hflux(ij+u_rup,l)+ &609 wee(ij+u_lup,1,2)*hflux(ij+t_lup+u_right,l)+ &610 wee(ij+u_lup,2,2)*hflux(ij+t_lup+u_rup,l)+ &611 wee(ij+u_lup,3,2)*hflux(ij+t_lup+u_lup,l)+ &612 wee(ij+u_lup,4,2)*hflux(ij+t_lup+u_left,l)+ &613 wee(ij+u_lup,5,2)*hflux(ij+t_lup+u_ldown,l)614 uu_ldown = &615 wee(ij+u_ldown,1,1)*hflux(ij+u_rdown,l)+ &616 wee(ij+u_ldown,2,1)*hflux(ij+u_right,l)+ &617 wee(ij+u_ldown,3,1)*hflux(ij+u_rup,l)+ &618 wee(ij+u_ldown,4,1)*hflux(ij+u_lup,l)+ &619 wee(ij+u_ldown,5,1)*hflux(ij+u_left,l)+ &620 wee(ij+u_ldown,1,2)*hflux(ij+t_ldown+u_lup,l)+ &621 wee(ij+u_ldown,2,2)*hflux(ij+t_ldown+u_left,l)+ &622 wee(ij+u_ldown,3,2)*hflux(ij+t_ldown+u_ldown,l)+ &623 wee(ij+u_ldown,4,2)*hflux(ij+t_ldown+u_rdown,l)+ &624 wee(ij+u_ldown,5,2)*hflux(ij+t_ldown+u_right,l)625 626 du(ij+u_right,l) = du(ij+u_right,l) + uu_right*qu(ij+u_right,l)627 du(ij+u_lup,l) = du(ij+u_lup,l) + uu_lup*qu(ij+u_lup,l)628 du(ij+u_ldown,l) = du(ij+u_ldown,l) + uu_ldown*qu(ij+u_ldown,l)629 END DO630 END DO631 CASE DEFAULT632 STOP633 END SELECT634 #undef FTHETA635 636 END IF ! dysl637 638 CALL trace_end("compute_caldyn_Coriolis")639 640 END SUBROUTINE compute_caldyn_Coriolis641 435 642 436 SUBROUTINE compute_caldyn_slow_hydro(u,rhodz,hv, hflux,Kv,du, zero)
Note: See TracChangeset
for help on using the changeset viewer.
