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

Last change on this file since 187 was 186, checked in by ymipsl, 10 years ago

Add new openMP parallelism based on distribution of domains on threads. There is no more limitation of number of threads by MPI process.

YM
File size: 5.2 KB
Line 
1MODULE theta2theta_rhodz_mod
2
3CONTAINS
4 
5  SUBROUTINE theta_rhodz2theta(f_ps,f_theta_rhodz,f_theta)
6  USE icosa
7  IMPLICIT NONE
8    TYPE(t_field), POINTER :: f_ps(:)
9    TYPE(t_field), POINTER :: f_theta_rhodz(:)
10    TYPE(t_field), POINTER :: f_theta(:)
11 
12    REAL(rstd), POINTER :: ps(:)
13    REAL(rstd), POINTER :: theta_rhodz(:,:)
14    REAL(rstd), POINTER :: theta(:,:)
15    INTEGER :: ind
16
17    DO ind=1,ndomain
18      IF (.NOT. assigned_domain(ind)) CYCLE
19      CALL swap_dimensions(ind)
20      CALL swap_geometry(ind)
21      ps=f_ps(ind)
22      theta_rhodz=f_theta_rhodz(ind)
23      theta=f_theta(ind)
24      CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0)
25    ENDDO
26 
27  END SUBROUTINE theta_rhodz2theta
28
29  SUBROUTINE theta_rhodz2temperature(f_ps,f_theta_rhodz,f_temp)
30  USE icosa
31  IMPLICIT NONE
32    TYPE(t_field), POINTER :: f_ps(:)
33    TYPE(t_field), POINTER :: f_theta_rhodz(:)
34    TYPE(t_field), POINTER :: f_temp(:)
35 
36    REAL(rstd), POINTER :: ps(:)
37    REAL(rstd), POINTER :: theta_rhodz(:,:)
38    REAL(rstd), POINTER :: temp(:,:)
39    INTEGER :: ind
40
41    DO ind=1,ndomain
42      IF (.NOT. assigned_domain(ind)) CYCLE
43      CALL swap_dimensions(ind)
44      CALL swap_geometry(ind)
45      ps=f_ps(ind)
46      theta_rhodz=f_theta_rhodz(ind)
47      temp=f_temp(ind)
48      CALL compute_theta_rhodz2temperature(ps, theta_rhodz,temp,0)
49    ENDDO
50 
51  END SUBROUTINE theta_rhodz2temperature
52   
53  SUBROUTINE theta2theta_rhodz(f_ps,f_theta,f_theta_rhodz)
54  USE icosa
55  IMPLICIT NONE
56    TYPE(t_field), POINTER :: f_ps(:)
57    TYPE(t_field), POINTER :: f_theta(:)
58    TYPE(t_field), POINTER :: f_theta_rhodz(:)
59 
60    REAL(rstd), POINTER :: ps(:)
61    REAL(rstd), POINTER :: theta(:,:)
62    REAL(rstd), POINTER :: theta_rhodz(:,:)
63    INTEGER :: ind
64
65    DO ind=1,ndomain
66      IF (.NOT. assigned_domain(ind)) CYCLE
67      CALL swap_dimensions(ind)
68      CALL swap_geometry(ind)
69      ps=f_ps(ind)
70      theta=f_theta(ind)
71      theta_rhodz=f_theta_rhodz(ind)
72      CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0)
73    ENDDO
74 
75  END SUBROUTINE theta2theta_rhodz
76 
77  SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset)
78  USE icosa
79  USE pression_mod
80  IMPLICIT NONE
81    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
82    REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm)
83    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
84    INTEGER,INTENT(IN) :: offset
85    INTEGER :: i,j,ij,l
86    REAL(rstd),ALLOCATABLE,SAVE :: p(:,:)
87!$OMP THREADPRIVATE(p)
88
89    ALLOCATE( p(iim*jjm,llm+1))
90    CALL compute_pression(ps,p,offset)
91   
92    DO    l    = 1, llm
93      DO j=jj_begin-offset,jj_end+offset
94        DO i=ii_begin-offset,ii_end+offset
95          ij=(j-1)*iim+i
96          theta_rhodz(ij,l) = theta(ij,l) * (p(ij,l)-p(ij,l+1))/g
97        ENDDO
98      ENDDO
99    ENDDO
100
101    DEALLOCATE( p)
102
103  END SUBROUTINE compute_theta2theta_rhodz
104
105  SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset)
106  USE icosa
107  USE pression_mod
108  IMPLICIT NONE
109    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
110    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
111    REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm)
112    INTEGER,INTENT(IN) :: offset
113    INTEGER :: i,j,ij,l
114    REAL(rstd),SAVE,ALLOCATABLE :: p(:,:)
115!$OMP THREADPRIVATE(p)
116
117    ALLOCATE( p(iim*jjm,llm+1))
118
119    CALL compute_pression(ps,p,offset)
120   
121    DO    l    = 1, llm
122      DO j=jj_begin-offset,jj_end+offset
123        DO i=ii_begin-offset,ii_end+offset
124          ij=(j-1)*iim+i
125          theta(ij,l) = theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g)
126        ENDDO
127      ENDDO
128    ENDDO
129
130    DEALLOCATE( p)
131   
132  END SUBROUTINE compute_theta_rhodz2theta
133
134  SUBROUTINE compute_theta_rhodz2temperature(ps,theta_rhodz,temp,offset)
135  USE icosa
136  USE pression_mod
137  USE exner_mod
138  IMPLICIT NONE
139    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
140    REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
141    REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm)
142    INTEGER,INTENT(IN) :: offset
143    INTEGER :: i,j,ij,l
144    REAL(rstd) :: p(iim*jjm,llm+1)
145    REAL(rstd) :: pk(iim*jjm,llm)
146    REAL(rstd) :: pks(iim*jjm)
147
148    CALL compute_pression(ps,p,offset)
149    CALL compute_exner(ps,p,pks,pk,offset)
150       
151    DO    l    = 1, llm
152      DO j=jj_begin-offset,jj_end+offset
153        DO i=ii_begin-offset,ii_end+offset
154          ij=(j-1)*iim+i
155          temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk(ij,l) / cpp
156        ENDDO
157      ENDDO
158    ENDDO
159   
160  END SUBROUTINE compute_theta_rhodz2temperature
161
162  SUBROUTINE compute_temperature2theta_rhodz(ps,temp,theta_rhodz,offset)
163  USE icosa
164  USE pression_mod
165  USE exner_mod
166  IMPLICIT NONE
167    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
168    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
169    REAL(rstd),INTENT(IN) :: temp(iim*jjm,llm)
170    INTEGER,INTENT(IN) :: offset
171    INTEGER :: i,j,ij,l
172    REAL(rstd) :: p(iim*jjm,llm+1)
173    REAL(rstd) :: pk(iim*jjm,llm)
174    REAL(rstd) :: pks(iim*jjm)
175
176    CALL compute_pression(ps,p,offset)
177    CALL compute_exner(ps,p,pks,pk,offset)
178       
179    DO    l    = 1, llm
180      DO j=jj_begin-offset,jj_end+offset
181        DO i=ii_begin-offset,ii_end+offset
182          ij=(j-1)*iim+i
183          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / (pk(ij,l) / cpp )
184        ENDDO
185      ENDDO
186    ENDDO
187   
188  END SUBROUTINE compute_temperature2theta_rhodz
189   
190END MODULE theta2theta_rhodz_mod
Note: See TracBrowser for help on using the repository browser.