[913] | 1 | MODULE compute_pression_mod |
---|
| 2 | USE compute_diagnostics_mod |
---|
| 3 | USE icosa |
---|
| 4 | USE omp_para |
---|
| 5 | USE disvert_mod, ONLY : ap, bp, ap_bp_present |
---|
| 6 | IMPLICIT NONE |
---|
| 7 | PRIVATE |
---|
[12] | 8 | |
---|
[913] | 9 | #include "../unstructured/unstructured.h90" |
---|
| 10 | |
---|
| 11 | PUBLIC :: pression, compute_pression_hex, compute_pression_unst, & |
---|
| 12 | pression_mid, compute_pression_mid_hex, compute_pression_mid_unst |
---|
| 13 | |
---|
[12] | 14 | CONTAINS |
---|
| 15 | |
---|
[913] | 16 | #ifdef BEGIN_DYSL |
---|
| 17 | |
---|
| 18 | {%- macro compute_pression(llmax)%} |
---|
| 19 | {%- set inner_loop=caller() %} |
---|
| 20 | {%- set llmax="'%s'"%llmax %} |
---|
| 21 | IF(ap_bp_present) THEN |
---|
| 22 | IF(offset>0) THEN |
---|
| 23 | FORALL_CELLS_EXT('1',{{ llmax }}) |
---|
| 24 | ON_PRIMAL |
---|
| 25 | {{ inner_loop }} |
---|
| 26 | END_BLOCK |
---|
| 27 | END_BLOCK |
---|
| 28 | ELSE |
---|
| 29 | FORALL_CELLS('1',{{ llmax }}) |
---|
| 30 | ON_PRIMAL |
---|
| 31 | {{ inner_loop }} |
---|
| 32 | END_BLOCK |
---|
| 33 | END_BLOCK |
---|
| 34 | END IF |
---|
| 35 | END IF |
---|
| 36 | {%- endmacro %} |
---|
| 37 | |
---|
| 38 | KERNEL(compute_pression) |
---|
| 39 | {% call compute_pression('llm+1') %} |
---|
| 40 | p(CELL) = AP(CELL) + BP(CELL) * ps(HIDX(CELL)) |
---|
| 41 | {% endcall %} |
---|
| 42 | END_BLOCK |
---|
| 43 | |
---|
| 44 | KERNEL(compute_pmid) |
---|
| 45 | {% call compute_pression('llm') %} |
---|
| 46 | pmid(CELL) = .5*(AP(CELL)+AP(UP(CELL)) + (BP(CELL)+BP(UP(CELL))) * ps(HIDX(CELL)) ) |
---|
| 47 | {% endcall %} |
---|
| 48 | END_BLOCK |
---|
| 49 | |
---|
| 50 | #endif END_DYSL |
---|
| 51 | |
---|
[12] | 52 | SUBROUTINE pression(f_ps,f_p) |
---|
| 53 | TYPE(t_field), POINTER :: f_ps(:) |
---|
| 54 | TYPE(t_field), POINTER :: f_p(:) |
---|
| 55 | |
---|
| 56 | REAL(rstd), POINTER :: ps(:) |
---|
| 57 | REAL(rstd), POINTER :: p(:,:) |
---|
| 58 | INTEGER :: ind |
---|
| 59 | |
---|
[295] | 60 | !$OMP BARRIER |
---|
[12] | 61 | DO ind=1,ndomain |
---|
[186] | 62 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
[12] | 63 | CALL swap_dimensions(ind) |
---|
| 64 | CALL swap_geometry(ind) |
---|
| 65 | ps=f_ps(ind) |
---|
| 66 | p=f_p(ind) |
---|
| 67 | CALL compute_pression(ps, p,0) |
---|
| 68 | ENDDO |
---|
[295] | 69 | !$OMP BARRIER |
---|
[12] | 70 | |
---|
| 71 | END SUBROUTINE pression |
---|
[397] | 72 | |
---|
| 73 | SUBROUTINE pression_mid(f_ps,f_pmid) |
---|
| 74 | TYPE(t_field), POINTER :: f_ps(:) |
---|
| 75 | TYPE(t_field), POINTER :: f_pmid(:) |
---|
[12] | 76 | |
---|
[397] | 77 | REAL(rstd), POINTER :: ps(:) |
---|
| 78 | REAL(rstd), POINTER :: pmid(:,:) |
---|
| 79 | INTEGER :: ind |
---|
| 80 | |
---|
| 81 | !$OMP BARRIER |
---|
| 82 | DO ind=1,ndomain |
---|
| 83 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
| 84 | CALL swap_dimensions(ind) |
---|
| 85 | CALL swap_geometry(ind) |
---|
| 86 | ps=f_ps(ind) |
---|
| 87 | pmid=f_pmid(ind) |
---|
| 88 | CALL compute_pression_mid(ps, pmid,0) |
---|
| 89 | ENDDO |
---|
| 90 | !$OMP BARRIER |
---|
| 91 | |
---|
| 92 | END SUBROUTINE pression_mid |
---|
| 93 | |
---|
[913] | 94 | !------------- hexagonal-mesh compute kernels -------- |
---|
| 95 | |
---|
| 96 | #define AP(ij,l) ap(l) |
---|
| 97 | #define BP(ij,l) bp(l) |
---|
| 98 | |
---|
| 99 | SUBROUTINE compute_pression_hex(ps,p,offset) |
---|
[12] | 100 | REAL(rstd),INTENT(IN) :: ps(iim*jjm) |
---|
| 101 | REAL(rstd),INTENT(OUT) :: p(iim*jjm,llm+1) |
---|
| 102 | INTEGER,INTENT(IN) :: offset |
---|
[913] | 103 | INTEGER :: ij,l |
---|
| 104 | #include "../kernels_hex/compute_pression.k90" |
---|
| 105 | END SUBROUTINE compute_pression_hex |
---|
[397] | 106 | |
---|
[913] | 107 | SUBROUTINE compute_pression_mid_hex(ps,pmid,offset) |
---|
[397] | 108 | REAL(rstd),INTENT(IN) :: ps(iim*jjm) |
---|
| 109 | REAL(rstd),INTENT(OUT) :: pmid(iim*jjm,llm) |
---|
| 110 | INTEGER,INTENT(IN) :: offset |
---|
[913] | 111 | INTEGER :: ij,l |
---|
| 112 | #include "../kernels_hex/compute_pmid.k90" |
---|
| 113 | END SUBROUTINE compute_pression_mid_hex |
---|
[12] | 114 | |
---|
[913] | 115 | #undef AP |
---|
| 116 | #undef BP |
---|
[397] | 117 | |
---|
[913] | 118 | !----------- unstructured-mesh compute kernels -------- |
---|
[397] | 119 | |
---|
[913] | 120 | #define AP(l,ij) ap(l) |
---|
| 121 | #define BP(l,ij) bp(l) |
---|
| 122 | |
---|
| 123 | SUBROUTINE compute_pression_unst(ps, p, offset) |
---|
| 124 | FIELD_PS, INTENT(IN) :: ps |
---|
| 125 | FIELD_GEOPOT, INTENT(OUT) :: p |
---|
| 126 | INTEGER, INTENT(IN) :: offset |
---|
| 127 | DECLARE_INDICES |
---|
| 128 | #include "../kernels_unst/compute_pression.k90" |
---|
| 129 | END SUBROUTINE compute_pression_unst |
---|
| 130 | |
---|
| 131 | SUBROUTINE compute_pression_mid_unst(ps, pmid, offset) |
---|
| 132 | FIELD_PS, INTENT(IN) :: ps |
---|
| 133 | FIELD_MASS, INTENT(OUT) :: pmid |
---|
| 134 | INTEGER, INTENT(IN) :: offset |
---|
| 135 | DECLARE_INDICES |
---|
| 136 | #include "../kernels_unst/compute_pmid.k90" |
---|
| 137 | END SUBROUTINE compute_pression_mid_unst |
---|
| 138 | |
---|
| 139 | #undef AP |
---|
| 140 | #undef BP |
---|
| 141 | |
---|
| 142 | END MODULE compute_pression_mod |
---|