Changeset 849 for codes/icosagcm/devel
- Timestamp:
- 05/05/19 12:53:47 (5 years ago)
- Location:
- codes/icosagcm/devel/src/dynamics
- Files:
-
- 1 added
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/dynamics/caldyn_hevi.f90
r844 r849 8 8 USE compute_caldyn_kv_mod, ONLY : compute_caldyn_kv 9 9 USE compute_caldyn_Coriolis_mod, ONLY : compute_caldyn_Coriolis 10 USE compute_caldyn_slow_hydro_mod, ONLY : compute_caldyn_slow_hydro 10 11 IMPLICIT NONE 11 12 PRIVATE -
codes/icosagcm/devel/src/dynamics/caldyn_kernels_hevi.F90
r844 r849 13 13 LOGICAL, SAVE :: debug_hevi_solver = .FALSE. 14 14 15 PUBLIC :: compute_caldyn_slow_ hydro, compute_caldyn_slow_NH, &15 PUBLIC :: compute_caldyn_slow_NH, & 16 16 compute_caldyn_solver, compute_caldyn_fast 17 17 … … 434 434 END SUBROUTINE compute_caldyn_fast 435 435 436 SUBROUTINE compute_caldyn_slow_hydro(u,rhodz,hv, hflux,Kv,du, zero)437 LOGICAL, INTENT(IN) :: zero438 REAL(rstd),INTENT(IN) :: u(3*iim*jjm,llm) ! prognostic "velocity"439 REAL(rstd),INTENT(IN) :: Kv(2*iim*jjm,llm) ! kinetic energy at vertices440 REAL(rstd),INTENT(IN) :: hv(2*iim*jjm,llm) ! height/mass averaged to vertices441 REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm)442 REAL(rstd),INTENT(OUT) :: hflux(3*iim*jjm,llm) ! hflux in kg/s443 REAL(rstd),INTENT(INOUT) :: du(3*iim*jjm,llm)444 445 REAL(rstd) :: berni(iim*jjm,llm) ! Bernoulli function446 REAL(rstd) :: berni1(iim*jjm) ! Bernoulli function447 REAL(rstd) :: uu_right, uu_lup, uu_ldown, ke, uu448 INTEGER :: ij,l449 450 CALL trace_start("compute_caldyn_slow_hydro")451 452 IF(dysl_slow_hydro) THEN453 454 #define BERNI(ij,l) berni(ij,l)455 #include "../kernels_hex/caldyn_slow_hydro.k90"456 #undef BERNI457 458 ELSE459 460 #define BERNI(ij) berni1(ij)461 462 DO l = ll_begin, ll_end463 ! Compute mass fluxes464 IF (caldyn_conserv==conserv_energy) CALL test_message(req_qu)465 466 IF(caldyn_kinetic==kinetic_trisk) THEN467 !DIR$ SIMD468 DO ij=ij_begin_ext,ij_end_ext469 uu_right=0.5*(rhodz(ij,l)+rhodz(ij+t_right,l))*u(ij+u_right,l)470 uu_lup=0.5*(rhodz(ij,l)+rhodz(ij+t_lup,l))*u(ij+u_lup,l)471 uu_ldown=0.5*(rhodz(ij,l)+rhodz(ij+t_ldown,l))*u(ij+u_ldown,l)472 uu_right= uu_right*le_de(ij+u_right)473 uu_lup = uu_lup *le_de(ij+u_lup)474 uu_ldown= uu_ldown*le_de(ij+u_ldown)475 hflux(ij+u_right,l)=uu_right476 hflux(ij+u_lup,l) =uu_lup477 hflux(ij+u_ldown,l)=uu_ldown478 ENDDO479 ELSE ! mass flux deriving from consistent kinetic energy480 !DIR$ SIMD481 DO ij=ij_begin_ext,ij_end_ext482 uu_right=0.5*(hv(ij+z_rup,l)+hv(ij+z_rdown,l))*u(ij+u_right,l)483 uu_lup=0.5*(hv(ij+z_up,l)+hv(ij+z_lup,l))*u(ij+u_lup,l)484 uu_ldown=0.5*(hv(ij+z_ldown,l)+hv(ij+z_down,l))*u(ij+u_ldown,l)485 uu_right= uu_right*le_de(ij+u_right)486 uu_lup = uu_lup *le_de(ij+u_lup)487 uu_ldown= uu_ldown*le_de(ij+u_ldown)488 hflux(ij+u_right,l)=uu_right489 hflux(ij+u_lup,l) =uu_lup490 hflux(ij+u_ldown,l)=uu_ldown491 ENDDO492 END IF493 494 ! Compute Bernoulli=kinetic energy495 IF(caldyn_kinetic==kinetic_trisk) THEN496 !DIR$ SIMD497 DO ij=ij_begin,ij_end498 BERNI(ij) = &499 1/(4*Ai(ij))*(le_de(ij+u_right)*u(ij+u_right,l)**2 + &500 le_de(ij+u_rup)*u(ij+u_rup,l)**2 + &501 le_de(ij+u_lup)*u(ij+u_lup,l)**2 + &502 le_de(ij+u_left)*u(ij+u_left,l)**2 + &503 le_de(ij+u_ldown)*u(ij+u_ldown,l)**2 + &504 le_de(ij+u_rdown)*u(ij+u_rdown,l)**2 )505 ENDDO506 ELSE507 !DIR$ SIMD508 DO ij=ij_begin,ij_end509 BERNI(ij) = Riv(ij,vup) *Kv(ij+z_up,l) + &510 Riv(ij,vlup) *Kv(ij+z_lup,l) + &511 Riv(ij,vldown)*Kv(ij+z_ldown,l) + &512 Riv(ij,vdown) *Kv(ij+z_down,l) + &513 Riv(ij,vrdown)*Kv(ij+z_rdown,l) + &514 Riv(ij,vrup) *Kv(ij+z_rup,l)515 END DO516 END IF517 ! Compute du=-grad(Bernoulli)518 IF(zero) THEN519 !DIR$ SIMD520 DO ij=ij_begin,ij_end521 du(ij+u_right,l) = ne_right*(BERNI(ij)-BERNI(ij+t_right))522 du(ij+u_lup,l) = ne_lup*(BERNI(ij)-BERNI(ij+t_lup))523 du(ij+u_ldown,l) = ne_ldown*(BERNI(ij)-BERNI(ij+t_ldown))524 END DO525 ELSE526 !DIR$ SIMD527 DO ij=ij_begin,ij_end528 du(ij+u_right,l) = du(ij+u_right,l) + &529 ne_right*(BERNI(ij)-BERNI(ij+t_right))530 du(ij+u_lup,l) = du(ij+u_lup,l) + &531 ne_lup*(BERNI(ij)-BERNI(ij+t_lup))532 du(ij+u_ldown,l) = du(ij+u_ldown,l) + &533 ne_ldown*(BERNI(ij)-BERNI(ij+t_ldown))534 END DO535 END IF536 END DO537 538 #undef BERNI539 540 END IF ! dysl541 CALL trace_end("compute_caldyn_slow_hydro")542 END SUBROUTINE compute_caldyn_slow_hydro543 436 544 437 SUBROUTINE compute_caldyn_slow_NH(u,rhodz,Phi,W, F_el,gradPhi2,w_il, hflux,du,dPhi,dW)
Note: See TracChangeset
for help on using the changeset viewer.