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

Last change on this file since 428 was 428, checked in by dubos, 8 years ago

theta-related cleanup
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  USE exner_mod
51  IMPLICIT NONE
52    TYPE(t_field), POINTER :: f_ps(:)
53    TYPE(t_field), POINTER :: f_theta_rhodz(:)
54    TYPE(t_field), POINTER :: f_temp(:)
55 
56    REAL(rstd), POINTER :: ps(:)
57    REAL(rstd), POINTER :: theta_rhodz(:,:,:)
58    REAL(rstd), POINTER :: temp(:,:)
59    REAL(rstd), POINTER :: p(:,:)
60    INTEGER :: ind
61
62    DO ind=1,ndomain
63      IF (.NOT. assigned_domain(ind)) CYCLE
64      CALL swap_dimensions(ind)
65      CALL swap_geometry(ind)
66      ps=f_ps(ind)
67      p=f_p(ind)
68      theta_rhodz=f_theta_rhodz(ind)
69      temp=f_temp(ind)
70
71!$OMP BARRIER
72      CALL compute_pression(ps,p,0)
73!$OMP BARRIER
74      CALL compute_theta_rhodz2temperature(p, theta_rhodz(:,:,1),temp,0)
75    ENDDO
76!$OMP BARRIER
77 
78  END SUBROUTINE theta_rhodz2temperature
79 
80  SUBROUTINE temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
81  USE icosa
82  USE pression_mod
83  USE exner_mod
84  IMPLICIT NONE
85    TYPE(t_field), POINTER :: f_ps(:)
86    TYPE(t_field), POINTER :: f_theta_rhodz(:)
87    TYPE(t_field), POINTER :: f_temp(:)
88 
89    REAL(rstd), POINTER :: ps(:)
90    REAL(rstd), POINTER :: theta_rhodz(:,:,:)
91    REAL(rstd), POINTER :: temp(:,:)
92    REAL(rstd), POINTER :: p(:,:)
93    INTEGER :: ind
94
95    DO ind=1,ndomain
96      IF (.NOT. assigned_domain(ind)) CYCLE
97      CALL swap_dimensions(ind)
98      CALL swap_geometry(ind)
99      ps=f_ps(ind)
100      p=f_p(ind)
101      theta_rhodz=f_theta_rhodz(ind)
102      temp=f_temp(ind)
103
104!$OMP BARRIER
105      CALL compute_pression(ps,p,0)
106!$OMP BARRIER
107      CALL compute_temperature2theta_rhodz(p, temp, theta_rhodz(:,:,1), 0)
108    ENDDO
109!$OMP BARRIER
110 
111  END SUBROUTINE temperature2theta_rhodz
112 
113 
114   
115  SUBROUTINE theta2theta_rhodz(f_ps,f_theta,f_theta_rhodz)
116  USE icosa
117  IMPLICIT NONE
118    TYPE(t_field), POINTER :: f_ps(:)
119    TYPE(t_field), POINTER :: f_theta(:)
120    TYPE(t_field), POINTER :: f_theta_rhodz(:)
121 
122    REAL(rstd), POINTER :: ps(:)
123    REAL(rstd), POINTER :: theta(:,:)
124    REAL(rstd), POINTER :: theta_rhodz(:,:)
125    INTEGER :: ind
126
127!$OMP BARRIER
128    DO ind=1,ndomain
129      IF (.NOT. assigned_domain(ind)) CYCLE
130      CALL swap_dimensions(ind)
131      CALL swap_geometry(ind)
132      ps=f_ps(ind)
133      theta=f_theta(ind)
134      theta_rhodz=f_theta_rhodz(ind)
135      CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0)
136    ENDDO
137!$OMP BARRIER
138 
139  END SUBROUTINE theta2theta_rhodz
140 
141  SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset)
142  USE icosa
143  USE disvert_mod
144  USE omp_para
145  IMPLICIT NONE
146    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
147    REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm)
148    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
149    INTEGER,INTENT(IN) :: offset
150    REAL(rstd) :: rhodz
151    INTEGER :: i,j,ij,l
152   
153!$OMP BARRIER
154    DO    l    = ll_begin, ll_end
155      DO j=jj_begin-offset,jj_end+offset
156        DO i=ii_begin-offset,ii_end+offset
157          ij=(j-1)*iim+i
158          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
159          theta_rhodz(ij,l) = theta(ij,l) * rhodz
160        ENDDO
161      ENDDO
162    ENDDO
163!$OMP BARRIER
164
165
166  END SUBROUTINE compute_theta2theta_rhodz
167
168  SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset)
169  USE icosa
170  USE disvert_mod
171  USE omp_para
172  IMPLICIT NONE
173    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
174    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
175    REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm)
176    INTEGER,INTENT(IN) :: offset
177    REAL(rstd) :: rhodz
178    INTEGER :: i,j,ij,l
179
180!$OMP BARRIER
181    DO    l    = ll_begin, ll_end
182      DO j=jj_begin-offset,jj_end+offset
183        DO i=ii_begin-offset,ii_end+offset
184          ij=(j-1)*iim+i
185          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
186          theta(ij,l) = theta_rhodz(ij,l) / rhodz
187        ENDDO
188      ENDDO
189    ENDDO
190!$OMP BARRIER
191
192   
193  END SUBROUTINE compute_theta_rhodz2theta
194
195
196
197
198
199
200  SUBROUTINE compute_theta_rhodz2temperature(p,theta_rhodz,temp,offset)
201  USE icosa
202  USE pression_mod
203  USE exner_mod
204  USE omp_para
205  IMPLICIT NONE
206    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
207    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
208    REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm)
209    INTEGER,INTENT(IN) :: offset
210    REAL(rstd) :: pk_ij
211    INTEGER :: i,j,ij,l
212       
213! flush p
214!$OMP BARRIER
215    DO    l    = ll_begin, ll_end
216      DO j=jj_begin-offset,jj_end+offset
217        DO i=ii_begin-offset,ii_end+offset
218          ij=(j-1)*iim+i
219          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
220          temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk_ij
221        ENDDO
222      ENDDO
223    ENDDO
224!$OMP BARRIER
225   
226   
227  END SUBROUTINE compute_theta_rhodz2temperature
228
229  SUBROUTINE compute_temperature2theta_rhodz(p,temp,theta_rhodz,offset)
230  USE icosa
231  USE pression_mod
232  USE exner_mod
233  USE omp_para
234  IMPLICIT NONE
235    REAL(rstd),INTENT(IN)  :: p(iim*jjm,llm+1)
236    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
237    REAL(rstd),INTENT(IN)  :: temp(iim*jjm,llm)
238    INTEGER,INTENT(IN) :: offset
239    REAL(rstd) :: pk_ij
240    INTEGER :: i,j,ij,l
241
242       
243! flush p
244!$OMP BARRIER
245
246    DO    l    = ll_begin, ll_end
247      DO j=jj_begin-offset,jj_end+offset
248        DO i=ii_begin-offset,ii_end+offset
249          ij=(j-1)*iim+i
250          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
251          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / pk_ij
252        ENDDO
253      ENDDO
254    ENDDO
255!$OMP BARRIER
256   
257  END SUBROUTINE compute_temperature2theta_rhodz
258   
259END MODULE theta2theta_rhodz_mod
Note: See TracBrowser for help on using the repository browser.