[827] | 1 | MODULE compute_pvort_only_mod |
---|
[939] | 2 | USE grid_param |
---|
[1027] | 3 | USE prec, ONLY : rstd |
---|
[827] | 4 | IMPLICIT NONE |
---|
| 5 | PRIVATE |
---|
| 6 | |
---|
| 7 | #include "../unstructured/unstructured.h90" |
---|
| 8 | |
---|
| 9 | PUBLIC :: compute_pvort_only_hex, compute_pvort_only_unst |
---|
| 10 | |
---|
| 11 | CONTAINS |
---|
[840] | 12 | |
---|
[852] | 13 | #if BEGIN_DYSL |
---|
| 14 | |
---|
| 15 | KERNEL(pvort_only) |
---|
| 16 | FORALL_CELLS_EXT() |
---|
| 17 | ON_DUAL |
---|
| 18 | etav = 0.d0 |
---|
| 19 | FORALL_EDGES |
---|
| 20 | etav = etav + SIGN*u(EDGE) |
---|
| 21 | END_BLOCK |
---|
| 22 | hv=0. |
---|
| 23 | FORALL_VERTICES |
---|
| 24 | hv = hv + RIV2*rhodz(VERTEX) |
---|
| 25 | END_BLOCK |
---|
| 26 | qv(DUAL_CELL) = (etav + FV*AV )/(hv*AV) |
---|
| 27 | END_BLOCK |
---|
| 28 | END_BLOCK |
---|
| 29 | |
---|
| 30 | FORALL_CELLS() |
---|
| 31 | ON_EDGES |
---|
| 32 | qu(EDGE)=0.5d0*(qv(VERTEX1)+qv(VERTEX2)) |
---|
| 33 | END_BLOCK |
---|
| 34 | END_BLOCK |
---|
| 35 | END_BLOCK |
---|
| 36 | |
---|
| 37 | #endif END_DYSL |
---|
| 38 | |
---|
[1027] | 39 | !-------------- Wrappers for F2008 conformity ----------------- |
---|
| 40 | |
---|
| 41 | SUBROUTINE compute_pvort_only_unst(u,rhodz,qu,qv,hv_) |
---|
| 42 | REAL(rstd),INTENT(IN) :: u(:,:) |
---|
| 43 | REAL(rstd),INTENT(INOUT) :: rhodz(:,:) |
---|
| 44 | REAL(rstd),INTENT(OUT) :: qu(:,:), qv(:,:), hv_(:,:) |
---|
| 45 | CALL compute_pvort_only_unst_(u,rhodz,qu,qv,hv_) |
---|
| 46 | END SUBROUTINE compute_pvort_only_unst |
---|
| 47 | |
---|
| 48 | SUBROUTINE compute_pvort_only_hex(u,rhodz,qu,qv,hv_) |
---|
| 49 | REAL(rstd),INTENT(IN) :: u(:,:) |
---|
| 50 | REAL(rstd),INTENT(INOUT) :: rhodz(:,:) |
---|
| 51 | REAL(rstd),INTENT(OUT) :: qu(:,:), qv(:,:), hv_(:,:) |
---|
| 52 | CALL compute_pvort_only_hex_(u,rhodz,qu,qv,hv_) |
---|
| 53 | END SUBROUTINE compute_pvort_only_hex |
---|
| 54 | |
---|
| 55 | !-------------------------------------------------------------- |
---|
| 56 | |
---|
| 57 | SUBROUTINE compute_pvort_only_unst_(u,rhodz,qu,qv, hv_) |
---|
[827] | 58 | USE ISO_C_BINDING, only : C_DOUBLE, C_FLOAT |
---|
[939] | 59 | USE geometry, ONLY : Riv2, Av, fv |
---|
| 60 | USE data_unstructured_mod, ONLY : enter_trace, exit_trace, id_pvort_only, & |
---|
| 61 | dual_deg, dual_edge, dual_ne, dual_vertex, up, down |
---|
[827] | 62 | FIELD_MASS :: rhodz |
---|
| 63 | FIELD_U :: u,qu |
---|
| 64 | FIELD_Z :: qv, hv_ |
---|
| 65 | DECLARE_INDICES |
---|
| 66 | DECLARE_EDGES |
---|
| 67 | DECLARE_VERTICES |
---|
| 68 | NUM :: etav, hv |
---|
| 69 | START_TRACE(id_pvort_only, 1,1,2) ! primal, dual, edge |
---|
| 70 | #include "../kernels_unst/pvort_only.k90" |
---|
| 71 | STOP_TRACE |
---|
[1027] | 72 | END SUBROUTINE compute_pvort_only_unst_ |
---|
[827] | 73 | |
---|
[1027] | 74 | SUBROUTINE compute_pvort_only_hex_(u,rhodz,qu,qv,hv_) |
---|
[827] | 75 | USE icosa |
---|
| 76 | USE trace, ONLY : trace_start, trace_end |
---|
| 77 | USE caldyn_vars_mod, ONLY : dysl_pvort_only |
---|
| 78 | USE omp_para, ONLY : ll_begin, ll_end |
---|
| 79 | REAL(rstd),INTENT(IN) :: u(iim*3*jjm,llm) |
---|
| 80 | REAL(rstd),INTENT(INOUT) :: rhodz(iim*jjm,llm) |
---|
| 81 | REAL(rstd),INTENT(OUT) :: qu(iim*3*jjm,llm) |
---|
| 82 | REAL(rstd),INTENT(OUT) :: qv(iim*2*jjm,llm) |
---|
| 83 | REAL(rstd),INTENT(OUT) :: hv_(iim*2*jjm,llm) |
---|
| 84 | |
---|
| 85 | INTEGER :: ij,l |
---|
| 86 | REAL(rstd) :: etav,hv,radius_m2 |
---|
| 87 | |
---|
| 88 | CALL trace_start("compute_pvort_only") |
---|
| 89 | !!! Compute shallow-water potential vorticity |
---|
| 90 | IF(dysl_pvort_only) THEN |
---|
| 91 | #include "../kernels_hex/pvort_only.k90" |
---|
| 92 | ELSE |
---|
| 93 | |
---|
| 94 | radius_m2=radius**(-2) |
---|
| 95 | DO l = ll_begin,ll_end |
---|
| 96 | !DIR$ SIMD |
---|
| 97 | DO ij=ij_begin_ext,ij_end_ext |
---|
| 98 | etav= 1./Av(ij+z_up)*( ne_rup * u(ij+u_rup,l) & |
---|
| 99 | + ne_left * u(ij+t_rup+u_left,l) & |
---|
| 100 | - ne_lup * u(ij+u_lup,l) ) |
---|
| 101 | hv = Riv2(ij,vup) * rhodz(ij,l) & |
---|
| 102 | + Riv2(ij+t_rup,vldown) * rhodz(ij+t_rup,l) & |
---|
| 103 | + Riv2(ij+t_lup,vrdown) * rhodz(ij+t_lup,l) |
---|
| 104 | qv(ij+z_up,l) = ( etav+fv(ij+z_up) )/hv |
---|
| 105 | hv_(ij+z_up,l) = hv |
---|
| 106 | |
---|
| 107 | etav = 1./Av(ij+z_down)*( ne_ldown * u(ij+u_ldown,l) & |
---|
| 108 | + ne_right * u(ij+t_ldown+u_right,l) & |
---|
| 109 | - ne_rdown * u(ij+u_rdown,l) ) |
---|
| 110 | hv = Riv2(ij,vdown) * rhodz(ij,l) & |
---|
| 111 | + Riv2(ij+t_ldown,vrup) * rhodz(ij+t_ldown,l) & |
---|
| 112 | + Riv2(ij+t_rdown,vlup) * rhodz(ij+t_rdown,l) |
---|
| 113 | qv(ij+z_down,l) =( etav+fv(ij+z_down) )/hv |
---|
| 114 | hv_(ij+z_down,l) = hv |
---|
| 115 | ENDDO |
---|
| 116 | |
---|
| 117 | !DIR$ SIMD |
---|
| 118 | DO ij=ij_begin,ij_end |
---|
| 119 | qu(ij+u_right,l) = 0.5*(qv(ij+z_rdown,l)+qv(ij+z_rup,l)) |
---|
| 120 | qu(ij+u_lup,l) = 0.5*(qv(ij+z_up,l)+qv(ij+z_lup,l)) |
---|
| 121 | qu(ij+u_ldown,l) = 0.5*(qv(ij+z_ldown,l)+qv(ij+z_down,l)) |
---|
| 122 | END DO |
---|
| 123 | |
---|
| 124 | ENDDO |
---|
| 125 | |
---|
| 126 | END IF ! dysl |
---|
| 127 | CALL trace_end("compute_pvort_only") |
---|
| 128 | |
---|
[1027] | 129 | END SUBROUTINE compute_pvort_only_hex_ |
---|
[827] | 130 | |
---|
| 131 | END MODULE compute_pvort_only_mod |
---|
[852] | 132 | |
---|