[913] | 1 | MODULE compute_pression_mod |
---|
| 2 | USE compute_diagnostics_mod |
---|
| 3 | USE icosa |
---|
| 4 | USE omp_para |
---|
[955] | 5 | USE disvert_mod, ONLY : ap, bp, ap_bp_present, ptop, caldyn_eta, eta_lag |
---|
[913] | 6 | IMPLICIT NONE |
---|
| 7 | PRIVATE |
---|
[12] | 8 | |
---|
[913] | 9 | #include "../unstructured/unstructured.h90" |
---|
| 10 | |
---|
| 11 | PUBLIC :: pression, compute_pression_hex, compute_pression_unst, & |
---|
[955] | 12 | pression_mid, compute_pression_mid_hex, compute_pression_mid_unst, & |
---|
| 13 | hydrostatic_pressure, compute_hydrostatic_pressure_unst, compute_hydrostatic_pressure_hex |
---|
[913] | 14 | |
---|
[12] | 15 | CONTAINS |
---|
| 16 | |
---|
[913] | 17 | #ifdef BEGIN_DYSL |
---|
| 18 | |
---|
| 19 | {%- macro compute_pression(llmax)%} |
---|
| 20 | {%- set inner_loop=caller() %} |
---|
| 21 | {%- set llmax="'%s'"%llmax %} |
---|
| 22 | IF(ap_bp_present) THEN |
---|
| 23 | IF(offset>0) THEN |
---|
| 24 | FORALL_CELLS_EXT('1',{{ llmax }}) |
---|
| 25 | ON_PRIMAL |
---|
| 26 | {{ inner_loop }} |
---|
| 27 | END_BLOCK |
---|
| 28 | END_BLOCK |
---|
| 29 | ELSE |
---|
| 30 | FORALL_CELLS('1',{{ llmax }}) |
---|
| 31 | ON_PRIMAL |
---|
| 32 | {{ inner_loop }} |
---|
| 33 | END_BLOCK |
---|
| 34 | END_BLOCK |
---|
| 35 | END IF |
---|
| 36 | END IF |
---|
| 37 | {%- endmacro %} |
---|
| 38 | |
---|
| 39 | KERNEL(compute_pression) |
---|
| 40 | {% call compute_pression('llm+1') %} |
---|
| 41 | p(CELL) = AP(CELL) + BP(CELL) * ps(HIDX(CELL)) |
---|
| 42 | {% endcall %} |
---|
| 43 | END_BLOCK |
---|
| 44 | |
---|
| 45 | KERNEL(compute_pmid) |
---|
| 46 | {% call compute_pression('llm') %} |
---|
| 47 | pmid(CELL) = .5*(AP(CELL)+AP(UP(CELL)) + (BP(CELL)+BP(UP(CELL))) * ps(HIDX(CELL)) ) |
---|
| 48 | {% endcall %} |
---|
| 49 | END_BLOCK |
---|
| 50 | |
---|
| 51 | #endif END_DYSL |
---|
| 52 | |
---|
[12] | 53 | SUBROUTINE pression(f_ps,f_p) |
---|
| 54 | TYPE(t_field), POINTER :: f_ps(:) |
---|
| 55 | TYPE(t_field), POINTER :: f_p(:) |
---|
| 56 | |
---|
| 57 | REAL(rstd), POINTER :: ps(:) |
---|
| 58 | REAL(rstd), POINTER :: p(:,:) |
---|
| 59 | INTEGER :: ind |
---|
| 60 | |
---|
[295] | 61 | !$OMP BARRIER |
---|
[12] | 62 | DO ind=1,ndomain |
---|
[186] | 63 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
[12] | 64 | CALL swap_dimensions(ind) |
---|
| 65 | CALL swap_geometry(ind) |
---|
| 66 | ps=f_ps(ind) |
---|
| 67 | p=f_p(ind) |
---|
| 68 | CALL compute_pression(ps, p,0) |
---|
| 69 | ENDDO |
---|
[295] | 70 | !$OMP BARRIER |
---|
[12] | 71 | |
---|
| 72 | END SUBROUTINE pression |
---|
[397] | 73 | |
---|
| 74 | SUBROUTINE pression_mid(f_ps,f_pmid) |
---|
| 75 | TYPE(t_field), POINTER :: f_ps(:) |
---|
| 76 | TYPE(t_field), POINTER :: f_pmid(:) |
---|
[12] | 77 | |
---|
[397] | 78 | REAL(rstd), POINTER :: ps(:) |
---|
| 79 | REAL(rstd), POINTER :: pmid(:,:) |
---|
| 80 | INTEGER :: ind |
---|
| 81 | |
---|
| 82 | !$OMP BARRIER |
---|
| 83 | DO ind=1,ndomain |
---|
| 84 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
| 85 | CALL swap_dimensions(ind) |
---|
| 86 | CALL swap_geometry(ind) |
---|
| 87 | ps=f_ps(ind) |
---|
| 88 | pmid=f_pmid(ind) |
---|
| 89 | CALL compute_pression_mid(ps, pmid,0) |
---|
| 90 | ENDDO |
---|
| 91 | !$OMP BARRIER |
---|
| 92 | |
---|
| 93 | END SUBROUTINE pression_mid |
---|
| 94 | |
---|
[955] | 95 | SUBROUTINE hydrostatic_pressure(f_rhodz, f_theta_rhodz, f_ps, f_p) |
---|
| 96 | TYPE(t_field), POINTER :: f_rhodz(:), f_theta_rhodz(:), f_ps(:), f_p(:) |
---|
| 97 | REAL(rstd), POINTER :: ps(:), rhodz(:,:), p(:,:), theta_rhodz(:,:,:) |
---|
| 98 | INTEGER :: ind |
---|
| 99 | DO ind=1,ndomain |
---|
| 100 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
| 101 | CALL swap_dimensions(ind) |
---|
| 102 | CALL swap_geometry(ind) |
---|
| 103 | rhodz=f_rhodz(ind) |
---|
| 104 | theta_rhodz=f_theta_rhodz(ind) |
---|
| 105 | ps=f_ps(ind) |
---|
| 106 | p=f_p(ind) |
---|
| 107 | CALL compute_hydrostatic_pressure(rhodz, theta_rhodz, ps, p) |
---|
| 108 | ENDDO |
---|
| 109 | END SUBROUTINE hydrostatic_pressure |
---|
| 110 | |
---|
[913] | 111 | !------------- hexagonal-mesh compute kernels -------- |
---|
| 112 | |
---|
| 113 | #define AP(ij,l) ap(l) |
---|
| 114 | #define BP(ij,l) bp(l) |
---|
| 115 | |
---|
| 116 | SUBROUTINE compute_pression_hex(ps,p,offset) |
---|
[12] | 117 | REAL(rstd),INTENT(IN) :: ps(iim*jjm) |
---|
| 118 | REAL(rstd),INTENT(OUT) :: p(iim*jjm,llm+1) |
---|
| 119 | INTEGER,INTENT(IN) :: offset |
---|
[913] | 120 | INTEGER :: ij,l |
---|
| 121 | #include "../kernels_hex/compute_pression.k90" |
---|
| 122 | END SUBROUTINE compute_pression_hex |
---|
[397] | 123 | |
---|
[913] | 124 | SUBROUTINE compute_pression_mid_hex(ps,pmid,offset) |
---|
[397] | 125 | REAL(rstd),INTENT(IN) :: ps(iim*jjm) |
---|
| 126 | REAL(rstd),INTENT(OUT) :: pmid(iim*jjm,llm) |
---|
| 127 | INTEGER,INTENT(IN) :: offset |
---|
[913] | 128 | INTEGER :: ij,l |
---|
| 129 | #include "../kernels_hex/compute_pmid.k90" |
---|
| 130 | END SUBROUTINE compute_pression_mid_hex |
---|
[12] | 131 | |
---|
[913] | 132 | #undef AP |
---|
| 133 | #undef BP |
---|
[397] | 134 | |
---|
[955] | 135 | SUBROUTINE compute_hydrostatic_pressure_hex(rhodz, theta_rhodz, ps, pk) |
---|
| 136 | REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm) ! mass per unit surface in each model level |
---|
| 137 | REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm, nqdyn) ! dynamical tracers (theta/entropy) |
---|
| 138 | REAL(rstd),INTENT(OUT) :: ps(iim*jjm) ! surface pressure, diagnosed if Lagrangian vertical coordinate |
---|
| 139 | REAL(rstd),INTENT(OUT) :: pk(iim*jjm,llm) ! pressure at full levels |
---|
| 140 | INTEGER :: ij,l, ij_omp_begin_ext, ij_omp_end_ext |
---|
| 141 | !$OMP BARRIER |
---|
| 142 | CALL distrib_level(ij_begin_ext,ij_end_ext, ij_omp_begin_ext,ij_omp_end_ext) |
---|
| 143 | #include "../kernels_hex/compute_hydrostatic_pressure.k90" |
---|
| 144 | !$OMP BARRIER |
---|
| 145 | END SUBROUTINE compute_hydrostatic_pressure_hex |
---|
| 146 | |
---|
[913] | 147 | !----------- unstructured-mesh compute kernels -------- |
---|
[397] | 148 | |
---|
[913] | 149 | #define AP(l,ij) ap(l) |
---|
| 150 | #define BP(l,ij) bp(l) |
---|
| 151 | |
---|
| 152 | SUBROUTINE compute_pression_unst(ps, p, offset) |
---|
| 153 | FIELD_PS, INTENT(IN) :: ps |
---|
| 154 | FIELD_GEOPOT, INTENT(OUT) :: p |
---|
| 155 | INTEGER, INTENT(IN) :: offset |
---|
| 156 | DECLARE_INDICES |
---|
| 157 | #include "../kernels_unst/compute_pression.k90" |
---|
| 158 | END SUBROUTINE compute_pression_unst |
---|
| 159 | |
---|
| 160 | SUBROUTINE compute_pression_mid_unst(ps, pmid, offset) |
---|
| 161 | FIELD_PS, INTENT(IN) :: ps |
---|
| 162 | FIELD_MASS, INTENT(OUT) :: pmid |
---|
| 163 | INTEGER, INTENT(IN) :: offset |
---|
| 164 | DECLARE_INDICES |
---|
| 165 | #include "../kernels_unst/compute_pmid.k90" |
---|
| 166 | END SUBROUTINE compute_pression_mid_unst |
---|
| 167 | |
---|
| 168 | #undef AP |
---|
| 169 | #undef BP |
---|
| 170 | |
---|
[955] | 171 | SUBROUTINE compute_hydrostatic_pressure_unst(rhodz, theta_rhodz, ps, pk) |
---|
[956] | 172 | FIELD_MASS, INTENT(IN) :: rhodz |
---|
| 173 | FIELD_THETA, INTENT(IN) :: theta_rhodz |
---|
| 174 | FIELD_PS, INTENT(OUT) :: ps |
---|
| 175 | FIELD_MASS, INTENT(OUT) :: pk |
---|
[955] | 176 | DECLARE_INDICES |
---|
| 177 | #include "../kernels_unst/compute_hydrostatic_pressure.k90" |
---|
| 178 | END SUBROUTINE compute_hydrostatic_pressure_unst |
---|
| 179 | |
---|
| 180 | |
---|
[913] | 181 | END MODULE compute_pression_mod |
---|