source: codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/theta_rhodz.f90 @ 314

Last change on this file since 314 was 221, checked in by ymipsl, 10 years ago

Creating temporary dynamico/lmdz/saturn branche

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.