source: codes/icosagcm/trunk/src/diagnostics/theta_rhodz.f90 @ 548

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

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