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

Last change on this file since 1046 was 1046, checked in by ymipsl, 4 years ago

Introduce modification from A. Durocher github to make held&suarez testcase working on GPU

YM & AD
File size: 6.8 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, ondevice=.false.)
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,ondevice=.false.)
135    ENDDO
136!$OMP BARRIER
137 
138  END SUBROUTINE theta2theta_rhodz
139 
140  SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset, ondevice)
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    LOGICAL, INTENT(IN) :: ondevice
150    REAL(rstd) :: rhodz
151    INTEGER :: i,j,ij,l
152   
153!$OMP BARRIER
154    !$acc parallel loop collapse(3) default(present) async if(ondevice)
155    DO    l    = ll_begin, ll_end
156      DO j=jj_begin-offset,jj_end+offset
157        DO i=ii_begin-offset,ii_end+offset
158          ij=(j-1)*iim+i
159          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
160          theta_rhodz(ij,l) = theta(ij,l) * rhodz
161        ENDDO
162      ENDDO
163    ENDDO
164!$OMP BARRIER
165
166
167  END SUBROUTINE compute_theta2theta_rhodz
168
169  SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset,ondevice)
170  USE icosa
171  USE disvert_mod
172  USE omp_para
173  IMPLICIT NONE
174    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
175    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
176    REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm)
177    INTEGER,INTENT(IN) :: offset
178    LOGICAL, INTENT(IN) :: ondevice
179    REAL(rstd) :: rhodz
180    INTEGER :: i,j,ij,l
181
182!$OMP BARRIER
183    !$acc parallel loop collapse(3) default(present) async if(ondevice)
184    DO    l    = ll_begin, ll_end
185      DO j=jj_begin-offset,jj_end+offset
186        DO i=ii_begin-offset,ii_end+offset
187          ij=(j-1)*iim+i
188          rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g
189          theta(ij,l) = theta_rhodz(ij,l) / rhodz
190        ENDDO
191      ENDDO
192    ENDDO
193!$OMP BARRIER
194
195   
196  END SUBROUTINE compute_theta_rhodz2theta
197
198
199
200
201
202
203  SUBROUTINE compute_theta_rhodz2temperature(p,theta_rhodz,temp,offset)
204  USE icosa
205  USE pression_mod
206  USE exner_mod
207  USE omp_para
208  IMPLICIT NONE
209    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
210    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
211    REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm)
212    INTEGER,INTENT(IN) :: offset
213    REAL(rstd) :: pk_ij
214    INTEGER :: i,j,ij,l
215       
216! flush p
217!$OMP BARRIER
218    DO    l    = ll_begin, ll_end
219      DO j=jj_begin-offset,jj_end+offset
220        DO i=ii_begin-offset,ii_end+offset
221          ij=(j-1)*iim+i
222          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
223          temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk_ij
224        ENDDO
225      ENDDO
226    ENDDO
227!$OMP BARRIER
228   
229   
230  END SUBROUTINE compute_theta_rhodz2temperature
231
232  SUBROUTINE compute_temperature2theta_rhodz(p,temp,theta_rhodz,offset)
233  USE icosa
234  USE pression_mod
235  USE exner_mod
236  USE omp_para
237  IMPLICIT NONE
238    REAL(rstd),INTENT(IN)  :: p(iim*jjm,llm+1)
239    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
240    REAL(rstd),INTENT(IN)  :: temp(iim*jjm,llm)
241    INTEGER,INTENT(IN) :: offset
242    REAL(rstd) :: pk_ij
243    INTEGER :: i,j,ij,l
244
245       
246! flush p
247!$OMP BARRIER
248
249    DO    l    = ll_begin, ll_end
250      DO j=jj_begin-offset,jj_end+offset
251        DO i=ii_begin-offset,ii_end+offset
252          ij=(j-1)*iim+i
253          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
254          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / pk_ij
255        ENDDO
256      ENDDO
257    ENDDO
258!$OMP BARRIER
259   
260  END SUBROUTINE compute_temperature2theta_rhodz
261   
262END MODULE theta2theta_rhodz_mod
Note: See TracBrowser for help on using the repository browser.