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

Last change on this file since 155 was 151, checked in by ymipsl, 11 years ago

Implementation of mixte parallelism MPI/OpenMP into src directory

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