source: codes/icosagcm/trunk/src/diagnostics/pression.f90

Last change on this file was 548, checked in by dubos, 7 years ago

trunk : reorganize source tree
File size: 2.2 KB
Line 
1MODULE pression_mod
2
3CONTAINS
4
5  SUBROUTINE pression(f_ps,f_p)
6  USE icosa
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
15!$OMP BARRIER
16    DO ind=1,ndomain
17      IF (.NOT. assigned_domain(ind)) CYCLE
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
24!$OMP BARRIER
25 
26  END SUBROUTINE pression
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(:)
33 
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
51  SUBROUTINE compute_pression(ps,p,offset)
52  USE icosa
53  USE disvert_mod
54  USE omp_para
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
61    IF(ap_bp_present) THEN
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
69        ENDDO
70      ENDDO
71    END IF
72
73  END SUBROUTINE compute_pression
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
84
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
98END MODULE pression_mod
Note: See TracBrowser for help on using the repository browser.