source: codes/icosagcm/devel/src/diagnostics/theta_rhodz.f90 @ 913

Last change on this file since 913 was 913, checked in by dubos, 5 years ago

devel : compute_pression for unstructured mesh
File size: 6.3 KB
Line 
1MODULE theta2theta_rhodz_mod
2  USE icosa
3  USE field_mod
4  USE compute_diagnostics_mod
5  IMPLICIT NONE
6  PRIVATE
7
8  TYPE(t_field), POINTER, SAVE  :: f_p(:)
9
10  PUBLIC :: init_theta2theta_rhodz, theta_rhodz2theta, &
11       theta_rhodz2temperature, temperature2theta_rhodz, &
12       theta2theta_rhodz, &
13       compute_theta2theta_rhodz, compute_theta_rhodz2theta
14
15CONTAINS
16 
17  SUBROUTINE init_theta2theta_rhodz
18    CALL allocate_field(f_p,field_t,type_real,llm+1,name='p (theta2theta_rhodz_mod)')   
19  END SUBROUTINE init_theta2theta_rhodz
20
21
22  SUBROUTINE theta_rhodz2theta(f_ps,f_theta_rhodz,f_theta)
23    TYPE(t_field), POINTER :: f_ps(:)
24    TYPE(t_field), POINTER :: f_theta_rhodz(:)
25    TYPE(t_field), POINTER :: f_theta(:)
26 
27    REAL(rstd), POINTER :: ps(:)
28    REAL(rstd), POINTER :: theta_rhodz(:,:)
29    REAL(rstd), POINTER :: theta(:,:)
30    INTEGER :: ind
31
32!$OMP BARRIER
33    DO ind=1,ndomain
34      IF (.NOT. assigned_domain(ind)) CYCLE
35      CALL swap_dimensions(ind)
36      CALL swap_geometry(ind)
37      ps=f_ps(ind)
38      theta_rhodz=f_theta_rhodz(ind)
39      theta=f_theta(ind)
40      CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0)
41    ENDDO
42!$OMP BARRIER
43 
44  END SUBROUTINE theta_rhodz2theta
45
46  SUBROUTINE theta_rhodz2temperature(f_ps,f_theta_rhodz,f_temp)
47    TYPE(t_field), POINTER :: f_ps(:)
48    TYPE(t_field), POINTER :: f_theta_rhodz(:)
49    TYPE(t_field), POINTER :: f_temp(:)
50 
51    REAL(rstd), POINTER :: ps(:)
52    REAL(rstd), POINTER :: theta_rhodz(:,:,:)
53    REAL(rstd), POINTER :: temp(:,:)
54    REAL(rstd), POINTER :: p(:,:)
55    INTEGER :: ind
56
57    DO ind=1,ndomain
58      IF (.NOT. assigned_domain(ind)) CYCLE
59      CALL swap_dimensions(ind)
60      CALL swap_geometry(ind)
61      ps=f_ps(ind)
62      p=f_p(ind)
63      theta_rhodz=f_theta_rhodz(ind)
64      temp=f_temp(ind)
65
66!$OMP BARRIER
67      CALL compute_pression(ps,p,0)
68!$OMP BARRIER
69      CALL compute_theta_rhodz2temperature(p, theta_rhodz(:,:,1),temp,0)
70    ENDDO
71!$OMP BARRIER
72 
73  END SUBROUTINE theta_rhodz2temperature
74 
75  SUBROUTINE temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
76  USE exner_mod
77  IMPLICIT NONE
78    TYPE(t_field), POINTER :: f_ps(:)
79    TYPE(t_field), POINTER :: f_theta_rhodz(:)
80    TYPE(t_field), POINTER :: f_temp(:)
81 
82    REAL(rstd), POINTER :: ps(:)
83    REAL(rstd), POINTER :: theta_rhodz(:,:,:)
84    REAL(rstd), POINTER :: temp(:,:)
85    REAL(rstd), POINTER :: p(:,:)
86    INTEGER :: ind
87
88    DO ind=1,ndomain
89      IF (.NOT. assigned_domain(ind)) CYCLE
90      CALL swap_dimensions(ind)
91      CALL swap_geometry(ind)
92      ps=f_ps(ind)
93      p=f_p(ind)
94      theta_rhodz=f_theta_rhodz(ind)
95      temp=f_temp(ind)
96
97!$OMP BARRIER
98      CALL compute_pression(ps,p,0)
99!$OMP BARRIER
100      CALL compute_temperature2theta_rhodz(p, temp, theta_rhodz(:,:,1), 0)
101    ENDDO
102!$OMP BARRIER
103 
104  END SUBROUTINE temperature2theta_rhodz
105 
106 
107   
108  SUBROUTINE theta2theta_rhodz(f_ps,f_theta,f_theta_rhodz)
109    TYPE(t_field), POINTER :: f_ps(:)
110    TYPE(t_field), POINTER :: f_theta(:)
111    TYPE(t_field), POINTER :: f_theta_rhodz(:)
112 
113    REAL(rstd), POINTER :: ps(:)
114    REAL(rstd), POINTER :: theta(:,:)
115    REAL(rstd), POINTER :: theta_rhodz(:,:)
116    INTEGER :: ind
117
118!$OMP BARRIER
119    DO ind=1,ndomain
120      IF (.NOT. assigned_domain(ind)) CYCLE
121      CALL swap_dimensions(ind)
122      CALL swap_geometry(ind)
123      ps=f_ps(ind)
124      theta=f_theta(ind)
125      theta_rhodz=f_theta_rhodz(ind)
126      CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0)
127    ENDDO
128!$OMP BARRIER
129 
130  END SUBROUTINE theta2theta_rhodz
131 
132  SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset)
133  USE disvert_mod
134  USE omp_para
135    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
136    REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm)
137    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
138    INTEGER,INTENT(IN) :: offset
139    REAL(rstd) :: rhodz
140    INTEGER :: i,j,ij,l
141   
142!$OMP BARRIER
143    DO    l    = ll_begin, ll_end
144      DO j=jj_begin-offset,jj_end+offset
145        DO i=ii_begin-offset,ii_end+offset
146          ij=(j-1)*iim+i
147          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
148          theta_rhodz(ij,l) = theta(ij,l) * rhodz
149        ENDDO
150      ENDDO
151    ENDDO
152!$OMP BARRIER
153
154
155  END SUBROUTINE compute_theta2theta_rhodz
156
157  SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset)
158  USE disvert_mod
159  USE omp_para
160    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
161    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
162    REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm)
163    INTEGER,INTENT(IN) :: offset
164    REAL(rstd) :: rhodz
165    INTEGER :: i,j,ij,l
166
167!$OMP BARRIER
168    DO    l    = ll_begin, ll_end
169      DO j=jj_begin-offset,jj_end+offset
170        DO i=ii_begin-offset,ii_end+offset
171          ij=(j-1)*iim+i
172          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
173          theta(ij,l) = theta_rhodz(ij,l) / rhodz
174        ENDDO
175      ENDDO
176    ENDDO
177!$OMP BARRIER
178
179   
180  END SUBROUTINE compute_theta_rhodz2theta
181
182
183
184
185
186
187  SUBROUTINE compute_theta_rhodz2temperature(p,theta_rhodz,temp,offset)
188  USE exner_mod
189  USE omp_para
190    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
191    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
192    REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm)
193    INTEGER,INTENT(IN) :: offset
194    REAL(rstd) :: pk_ij
195    INTEGER :: i,j,ij,l
196       
197! flush p
198!$OMP BARRIER
199    DO    l    = ll_begin, ll_end
200      DO j=jj_begin-offset,jj_end+offset
201        DO i=ii_begin-offset,ii_end+offset
202          ij=(j-1)*iim+i
203          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
204          temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk_ij
205        ENDDO
206      ENDDO
207    ENDDO
208!$OMP BARRIER
209   
210   
211  END SUBROUTINE compute_theta_rhodz2temperature
212
213  SUBROUTINE compute_temperature2theta_rhodz(p,temp,theta_rhodz,offset)
214  USE exner_mod
215  USE omp_para
216    REAL(rstd),INTENT(IN)  :: p(iim*jjm,llm+1)
217    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
218    REAL(rstd),INTENT(IN)  :: temp(iim*jjm,llm)
219    INTEGER,INTENT(IN) :: offset
220    REAL(rstd) :: pk_ij
221    INTEGER :: i,j,ij,l
222
223       
224! flush p
225!$OMP BARRIER
226
227    DO    l    = ll_begin, ll_end
228      DO j=jj_begin-offset,jj_end+offset
229        DO i=ii_begin-offset,ii_end+offset
230          ij=(j-1)*iim+i
231          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
232          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / pk_ij
233        ENDDO
234      ENDDO
235    ENDDO
236!$OMP BARRIER
237   
238  END SUBROUTINE compute_temperature2theta_rhodz
239   
240END MODULE theta2theta_rhodz_mod
Note: See TracBrowser for help on using the repository browser.