[12] | 1 | MODULE pression_mod |
---|
| 2 | |
---|
| 3 | CONTAINS |
---|
| 4 | |
---|
| 5 | SUBROUTINE pression(f_ps,f_p) |
---|
[19] | 6 | USE icosa |
---|
[12] | 7 | IMPLICIT NONE |
---|
| 8 | TYPE(t_field), POINTER :: f_ps(:) |
---|
| 9 | TYPE(t_field), POINTER :: f_p(:) |
---|
| 10 | |
---|
| 11 | REAL(rstd), POINTER :: ps(:) |
---|
| 12 | REAL(rstd), POINTER :: p(:,:) |
---|
| 13 | INTEGER :: ind |
---|
| 14 | |
---|
[295] | 15 | !$OMP BARRIER |
---|
[12] | 16 | DO ind=1,ndomain |
---|
[186] | 17 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
[12] | 18 | CALL swap_dimensions(ind) |
---|
| 19 | CALL swap_geometry(ind) |
---|
| 20 | ps=f_ps(ind) |
---|
| 21 | p=f_p(ind) |
---|
| 22 | CALL compute_pression(ps, p,0) |
---|
| 23 | ENDDO |
---|
[295] | 24 | !$OMP BARRIER |
---|
[12] | 25 | |
---|
| 26 | END SUBROUTINE pression |
---|
[397] | 27 | |
---|
| 28 | SUBROUTINE pression_mid(f_ps,f_pmid) |
---|
| 29 | USE icosa |
---|
| 30 | IMPLICIT NONE |
---|
| 31 | TYPE(t_field), POINTER :: f_ps(:) |
---|
| 32 | TYPE(t_field), POINTER :: f_pmid(:) |
---|
[12] | 33 | |
---|
[397] | 34 | REAL(rstd), POINTER :: ps(:) |
---|
| 35 | REAL(rstd), POINTER :: pmid(:,:) |
---|
| 36 | INTEGER :: ind |
---|
| 37 | |
---|
| 38 | !$OMP BARRIER |
---|
| 39 | DO ind=1,ndomain |
---|
| 40 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
| 41 | CALL swap_dimensions(ind) |
---|
| 42 | CALL swap_geometry(ind) |
---|
| 43 | ps=f_ps(ind) |
---|
| 44 | pmid=f_pmid(ind) |
---|
| 45 | CALL compute_pression_mid(ps, pmid,0) |
---|
| 46 | ENDDO |
---|
| 47 | !$OMP BARRIER |
---|
| 48 | |
---|
| 49 | END SUBROUTINE pression_mid |
---|
| 50 | |
---|
[12] | 51 | SUBROUTINE compute_pression(ps,p,offset) |
---|
[19] | 52 | USE icosa |
---|
[12] | 53 | USE disvert_mod |
---|
[295] | 54 | USE omp_para |
---|
[12] | 55 | IMPLICIT NONE |
---|
| 56 | REAL(rstd),INTENT(IN) :: ps(iim*jjm) |
---|
| 57 | REAL(rstd),INTENT(OUT) :: p(iim*jjm,llm+1) |
---|
| 58 | INTEGER,INTENT(IN) :: offset |
---|
| 59 | INTEGER :: i,j,ij,l |
---|
| 60 | |
---|
[166] | 61 | IF(ap_bp_present) THEN |
---|
[295] | 62 | DO l = ll_begin, ll_endp1 |
---|
| 63 | ! DO l = 1, llm + 1 |
---|
| 64 | DO j=jj_begin-offset,jj_end+offset |
---|
| 65 | DO i=ii_begin-offset,ii_end+offset |
---|
| 66 | ij=(j-1)*iim+i |
---|
| 67 | p(ij,l) = ap(l) + bp(l) * ps(ij) |
---|
| 68 | ENDDO |
---|
[12] | 69 | ENDDO |
---|
| 70 | ENDDO |
---|
[166] | 71 | END IF |
---|
[295] | 72 | |
---|
[12] | 73 | END SUBROUTINE compute_pression |
---|
[397] | 74 | |
---|
| 75 | SUBROUTINE compute_pression_mid(ps,pmid,offset) |
---|
| 76 | USE icosa |
---|
| 77 | USE disvert_mod |
---|
| 78 | USE omp_para |
---|
| 79 | IMPLICIT NONE |
---|
| 80 | REAL(rstd),INTENT(IN) :: ps(iim*jjm) |
---|
| 81 | REAL(rstd),INTENT(OUT) :: pmid(iim*jjm,llm) |
---|
| 82 | INTEGER,INTENT(IN) :: offset |
---|
| 83 | INTEGER :: i,j,ij,l |
---|
[12] | 84 | |
---|
[397] | 85 | IF(ap_bp_present) THEN |
---|
| 86 | DO l = ll_begin, ll_end |
---|
| 87 | DO j=jj_begin-offset,jj_end+offset |
---|
| 88 | DO i=ii_begin-offset,ii_end+offset |
---|
| 89 | ij=(j-1)*iim+i |
---|
| 90 | pmid(ij,l) = 0.5*(ap(l)+ap(l+1) + (bp(l)+bp(l+1)) * ps(ij)) |
---|
| 91 | ENDDO |
---|
| 92 | ENDDO |
---|
| 93 | ENDDO |
---|
| 94 | END IF |
---|
| 95 | |
---|
| 96 | END SUBROUTINE compute_pression_mid |
---|
| 97 | |
---|
[12] | 98 | END MODULE pression_mod |
---|