source: codes/icosagcm/trunk/src/wind.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: 9.2 KB
Line 
1MODULE wind_mod
2
3CONTAINS
4
5  SUBROUTINE un2ulonlat(f_u, f_ulon, f_ulat)
6  USE icosa
7  IMPLICIT NONE
8    TYPE(t_field), POINTER :: f_u(:) ! IN  : normal velocity components on edges
9    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! OUT : velocity reconstructed at hexagons
10   
11    REAL(rstd),POINTER :: u(:,:),  ulon(:,:), ulat(:,:)
12    INTEGER :: ind
13
14    DO ind=1,ndomain
15       CALL swap_dimensions(ind)
16       CALL swap_geometry(ind)
17       u=f_u(ind)
18       ulon=f_ulon(ind)
19       ulat=f_ulat(ind)
20       CALL compute_un2ulonlat(u,ulon, ulat)
21    END DO
22
23  END SUBROUTINE un2ulonlat
24
25 
26  SUBROUTINE compute_wind_centered(ue,ucenter)
27  USE icosa
28 
29  IMPLICIT NONE
30  REAL(rstd) :: ue(3*iim*jjm,llm)
31  REAL(rstd) :: ucenter(iim*jjm,3,llm)
32  INTEGER :: i,j,ij,l   
33 
34    DO l=1,llm
35      DO j=jj_begin,jj_end
36        DO i=ii_begin,ii_end
37          ij=(j-1)*iim+i
38          ucenter(ij,:,l)=1/Ai(ij)*                                                                                                &
39                        ( ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:))  &
40                         + ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:))          &
41                         + ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:))          &
42                         + ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:))    &
43                         + ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))&
44                         + ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:)))
45        ENDDO
46      ENDDO
47    ENDDO
48 
49 END SUBROUTINE compute_wind_centered
50 
51 
52 SUBROUTINE compute_wind_on_edge(ue,uedge)
53  USE icosa
54   
55  IMPLICIT NONE
56  REAL(rstd) :: ue(3*iim*jjm,llm)
57  REAL(rstd) :: uedge(3*iim*jjm,3,llm)
58
59  REAL(rstd) :: ut(3*iim*jjm,llm)
60  INTEGER :: i,j,ij,l     
61   
62    CALL compute_tangential_compound(ue,ut)
63 
64    DO l=1,llm
65      DO j=jj_begin,jj_end
66        DO i=ii_begin,ii_end
67          ij=(j-1)*iim+i
68          uedge(ij+u_right,:,l)=ue(ij+u_right,l)*ep_e(ij+u_right,:)*ne(ij,right) + ut(ij+u_right,l)*et_e(ij+u_right,:)*ne(ij,right) 
69          uedge(ij+u_lup,:,l)=ue(ij+u_lup,l)*ep_e(ij+u_lup,:)*ne(ij,lup) + ut(ij+u_lup,l)*et_e(ij+u_lup,:)*ne(ij,lup)
70          uedge(ij+u_ldown,:,l)=ue(ij+u_ldown,l)*ep_e(ij+u_ldown,:)*ne(ij,ldown) + ut(ij+u_ldown,l)*et_e(ij+u_ldown,:)*ne(ij,ldown)
71        ENDDO
72      ENDDO
73    ENDDO
74 
75 END SUBROUTINE compute_wind_on_edge
76 
77 
78 
79 SUBROUTINE compute_tangential_compound(ue,ut)
80  USE icosa 
81  IMPLICIT NONE
82  REAL(rstd) :: ue(3*iim*jjm,llm)
83  REAL(rstd) :: ut(3*iim*jjm,llm)
84  INTEGER :: i,j,l,ij
85   
86  DO l=1,llm
87    DO j=jj_begin,jj_end
88      DO i=ii_begin,ii_end
89        ij=(j-1)*iim+i
90   
91        ut(ij+u_right,l) = 1/de(ij+u_right) *                                            & 
92                         ( wee(ij+u_right,1,1)*ue(ij+u_rup,l)+                           &
93                           wee(ij+u_right,2,1)*ue(ij+u_lup,l)+                           &
94                           wee(ij+u_right,3,1)*ue(ij+u_left,l)+                          &
95                           wee(ij+u_right,4,1)*ue(ij+u_ldown,l)+                         &
96                           wee(ij+u_right,5,1)*ue(ij+u_rdown,l)+                         & 
97                           wee(ij+u_right,1,2)*ue(ij+t_right+u_ldown,l)+                 &
98                           wee(ij+u_right,2,2)*ue(ij+t_right+u_rdown,l)+                 &
99                           wee(ij+u_right,3,2)*ue(ij+t_right+u_right,l)+                 &
100                           wee(ij+u_right,4,2)*ue(ij+t_right+u_rup,l)+                   &
101                           wee(ij+u_right,5,2)*ue(ij+t_right+u_lup,l) )   
102     
103        ut(ij+u_lup,l) =  1/de(ij+u_lup) *                                           & 
104                         ( wee(ij+u_lup,1,1)*ue(ij+u_left,l)+                        &
105                           wee(ij+u_lup,2,1)*ue(ij+u_ldown,l)+                       &
106                           wee(ij+u_lup,3,1)*ue(ij+u_rdown,l)+                       &
107                           wee(ij+u_lup,4,1)*ue(ij+u_right,l)+                       &
108                           wee(ij+u_lup,5,1)*ue(ij+u_rup,l)+                         & 
109                           wee(ij+u_lup,1,2)*ue(ij+t_lup+u_right,l)+                 &
110                           wee(ij+u_lup,2,2)*ue(ij+t_lup+u_rup,l)+                   &
111                           wee(ij+u_lup,3,2)*ue(ij+t_lup+u_lup,l)+                   &
112                           wee(ij+u_lup,4,2)*ue(ij+t_lup+u_left,l)+                  &
113                           wee(ij+u_lup,5,2)*ue(ij+t_lup+u_ldown,l) )
114
115   
116        ut(ij+u_ldown,l) = 1/de(ij+u_ldown) *   & 
117                         ( wee(ij+u_ldown,1,1)*ue(ij+u_rdown,l)+                      &
118                           wee(ij+u_ldown,2,1)*ue(ij+u_right,l)+                      &
119                           wee(ij+u_ldown,3,1)*ue(ij+u_rup,l)+                        &
120                           wee(ij+u_ldown,4,1)*ue(ij+u_lup,l)+                        &
121                           wee(ij+u_ldown,5,1)*ue(ij+u_left,l)+                       & 
122                           wee(ij+u_ldown,1,2)*ue(ij+t_ldown+u_lup,l)+                &
123                           wee(ij+u_ldown,2,2)*ue(ij+t_ldown+u_left,l)+               &
124                           wee(ij+u_ldown,3,2)*ue(ij+t_ldown+u_ldown,l)+              &
125                           wee(ij+u_ldown,4,2)*ue(ij+t_ldown+u_rdown,l)+              &
126                           wee(ij+u_ldown,5,2)*ue(ij+t_ldown+u_right,l) ) 
127       
128        ENDDO
129      ENDDO
130    ENDDO
131                       
132 END SUBROUTINE compute_tangential_compound
133 
134 SUBROUTINE compute_wind_lonlat_compound(u, ulon, ulat)
135  USE icosa 
136   
137  IMPLICIT NONE
138  REAL(rstd) :: u(3*iim*jjm,3,llm)
139  REAL(rstd) :: ulon(3*iim*jjm,3,llm)
140  REAL(rstd) :: ulat(3*iim*jjm,3,llm)
141
142  INTEGER :: i,j,ij,l     
143   
144 
145    DO l=1,llm
146      DO j=jj_begin-1,jj_end+1
147        DO i=ii_begin-1,ii_end+1
148          ij=(j-1)*iim+i
149          ulon(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elon_e(ij+u_right,:))*elon_e(ij+u_right,:) 
150          ulon(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elon_e(ij+u_lup,:))*elon_e(ij+u_lup,:)
151          ulon(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elon_e(ij+u_ldown,:))*elon_e(ij+u_ldown,:)
152         
153          ulat(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elat_e(ij+u_right,:))*elat_e(ij+u_right,:) 
154          ulat(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elat_e(ij+u_lup,:))*elat_e(ij+u_lup,:) 
155          ulat(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elat_e(ij+u_ldown,:))*elat_e(ij+u_ldown,:) 
156         
157        ENDDO
158      ENDDO
159    ENDDO
160 
161 END SUBROUTINE compute_wind_lonlat_compound
162 
163  SUBROUTINE compute_wind_from_lonlat_compound(ulon, ulat, u)
164  USE icosa 
165   
166  IMPLICIT NONE
167  REAL(rstd) :: u(3*iim*jjm,3,llm)
168  REAL(rstd) :: ulon(3*iim*jjm,llm)
169  REAL(rstd) :: ulat(3*iim*jjm,llm)
170
171  INTEGER :: i,j,ij,l     
172 
173    DO l=1,llm
174      DO j=jj_begin-1,jj_end+1
175        DO i=ii_begin-1,ii_end+1
176          ij=(j-1)*iim+i
177          u(ij+u_right,:,l)=ulon(ij+u_right,l)*elon_e(ij+u_right,:)+ ulat(ij+u_right,l)*elat_e(ij+u_right,:)
178          u(ij+u_lup,:,l)=ulon(ij+u_lup,l)*elon_e(ij+u_lup,:) + ulat(ij+u_lup,l)*elat_e(ij+u_lup,:)
179          u(ij+u_ldown,:,l)=ulon(ij+u_ldown,l)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown,l)*elat_e(ij+u_ldown,:)
180        ENDDO
181      ENDDO
182    ENDDO
183 
184  END SUBROUTINE compute_wind_from_lonlat_compound
185 
186  SUBROUTINE compute_wind_perp_from_lonlat_compound(ulon, ulat, up)
187  USE icosa 
188   
189  IMPLICIT NONE
190  REAL(rstd) :: up(3*iim*jjm,llm)
191  REAL(rstd) :: ulon(3*iim*jjm,llm)
192  REAL(rstd) :: ulat(3*iim*jjm,llm)
193  REAL(rstd) :: u(3*iim*jjm,3,llm)
194
195  INTEGER :: i,j,ij,l     
196 
197   CALL compute_wind_from_lonlat_compound(ulon, ulat, u)
198
199    DO l=1,llm
200      DO j=jj_begin-1,jj_end+1
201        DO i=ii_begin-1,ii_end+1
202          ij=(j-1)*iim+i
203          up(ij+u_right,l)=sum(u(ij+u_right,:,l)*ep_e(ij+u_right,:))
204          up(ij+u_lup,l)=sum(u(ij+u_lup,:,l)*ep_e(ij+u_lup,:))
205          up(ij+u_ldown,l)=sum(u(ij+u_ldown,:,l)*ep_e(ij+u_ldown,:))
206        ENDDO
207      ENDDO
208    ENDDO
209 
210  END SUBROUTINE compute_wind_perp_from_lonlat_compound
211   
212 SUBROUTINE compute_wind_centered_lonlat_compound(uc, ulon, ulat)
213  USE icosa 
214   
215  IMPLICIT NONE
216  REAL(rstd) :: uc(iim*jjm,3,llm)
217  REAL(rstd) :: ulon(iim*jjm,llm)
218  REAL(rstd) :: ulat(iim*jjm,llm)
219
220  INTEGER :: i,j,ij,l     
221   
222 
223    DO l=1,llm
224      DO j=jj_begin,jj_end
225        DO i=ii_begin,ii_end
226          ij=(j-1)*iim+i
227          ulon(ij,l)=sum(uc(ij,:,l)*elon_i(ij,:))
228          ulat(ij,l)=sum(uc(ij,:,l)*elat_i(ij,:)) 
229        ENDDO
230      ENDDO
231    ENDDO
232 
233 END SUBROUTINE compute_wind_centered_lonlat_compound
234
235 SUBROUTINE compute_un2ulonlat(un, ulon, ulat)
236  USE icosa 
237   
238  IMPLICIT NONE
239  REAL(rstd),INTENT(IN)  :: un(3*iim*jjm,llm)
240  REAL(rstd),INTENT(OUT) :: ulon(iim*jjm,llm)
241  REAL(rstd),INTENT(OUT) :: ulat(iim*jjm,llm)
242
243  REAL(rstd)             :: uc(iim*jjm,3,llm)
244   
245  CALL compute_wind_centered(un,uc) 
246  CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)
247 
248 END SUBROUTINE compute_un2ulonlat
249
250END MODULE wind_mod
Note: See TracBrowser for help on using the repository browser.