source: codes/icosagcm/trunk/src/theta_rhodz.f90 @ 322

Last change on this file since 322 was 322, checked in by dubos, 9 years ago

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