source: codes/icosagcm/trunk/src/wind.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: 10.5 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       IF (.NOT. assigned_domain(ind)) CYCLE
16       CALL swap_dimensions(ind)
17       CALL swap_geometry(ind)
18       u=f_u(ind)
19       ulon=f_ulon(ind)
20       ulat=f_ulat(ind)
21       CALL compute_un2ulonlat(u,ulon, ulat)
22    END DO
23
24  END SUBROUTINE un2ulonlat
25
26 
27  SUBROUTINE compute_wind_centered(ue,ucenter)
28  USE icosa
29 
30  IMPLICIT NONE
31  REAL(rstd) :: ue(3*iim*jjm,llm)
32  REAL(rstd) :: ucenter(iim*jjm,3,llm)
33  INTEGER :: i,j,ij,l   
34 
35    DO l=1,llm
36      DO j=jj_begin,jj_end
37        DO i=ii_begin,ii_end
38          ij=(j-1)*iim+i
39          ucenter(ij,:,l)=1/Ai(ij)*                                                                                                &
40                        ( 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,:))  &
41                         + 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,:))          &
42                         + 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,:))          &
43                         + 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,:))    &
44                         + 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,:))&
45                         + 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,:)))
46        ENDDO
47      ENDDO
48    ENDDO
49 
50 END SUBROUTINE compute_wind_centered
51 
52 
53 SUBROUTINE compute_wind_on_edge(ue,uedge)
54  USE icosa
55   
56  IMPLICIT NONE
57  REAL(rstd) :: ue(3*iim*jjm,llm)
58  REAL(rstd) :: uedge(3*iim*jjm,3,llm)
59
60  REAL(rstd) :: ut(3*iim*jjm,llm)
61  INTEGER :: i,j,ij,l     
62   
63    CALL compute_tangential_compound(ue,ut)
64 
65    DO l=1,llm
66      DO j=jj_begin,jj_end
67        DO i=ii_begin,ii_end
68          ij=(j-1)*iim+i
69          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) 
70          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)
71          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)
72        ENDDO
73      ENDDO
74    ENDDO
75 
76 END SUBROUTINE compute_wind_on_edge
77 
78 
79 
80 SUBROUTINE compute_tangential_compound(ue,ut)
81  USE icosa 
82  IMPLICIT NONE
83  REAL(rstd) :: ue(3*iim*jjm,llm)
84  REAL(rstd) :: ut(3*iim*jjm,llm)
85  INTEGER :: i,j,l,ij
86   
87  DO l=1,llm
88    DO j=jj_begin,jj_end
89      DO i=ii_begin,ii_end
90        ij=(j-1)*iim+i
91   
92        ut(ij+u_right,l) = 1/de(ij+u_right) *                                            & 
93                         ( wee(ij+u_right,1,1)*ue(ij+u_rup,l)+                           &
94                           wee(ij+u_right,2,1)*ue(ij+u_lup,l)+                           &
95                           wee(ij+u_right,3,1)*ue(ij+u_left,l)+                          &
96                           wee(ij+u_right,4,1)*ue(ij+u_ldown,l)+                         &
97                           wee(ij+u_right,5,1)*ue(ij+u_rdown,l)+                         & 
98                           wee(ij+u_right,1,2)*ue(ij+t_right+u_ldown,l)+                 &
99                           wee(ij+u_right,2,2)*ue(ij+t_right+u_rdown,l)+                 &
100                           wee(ij+u_right,3,2)*ue(ij+t_right+u_right,l)+                 &
101                           wee(ij+u_right,4,2)*ue(ij+t_right+u_rup,l)+                   &
102                           wee(ij+u_right,5,2)*ue(ij+t_right+u_lup,l) )   
103     
104        ut(ij+u_lup,l) =  1/de(ij+u_lup) *                                           & 
105                         ( wee(ij+u_lup,1,1)*ue(ij+u_left,l)+                        &
106                           wee(ij+u_lup,2,1)*ue(ij+u_ldown,l)+                       &
107                           wee(ij+u_lup,3,1)*ue(ij+u_rdown,l)+                       &
108                           wee(ij+u_lup,4,1)*ue(ij+u_right,l)+                       &
109                           wee(ij+u_lup,5,1)*ue(ij+u_rup,l)+                         & 
110                           wee(ij+u_lup,1,2)*ue(ij+t_lup+u_right,l)+                 &
111                           wee(ij+u_lup,2,2)*ue(ij+t_lup+u_rup,l)+                   &
112                           wee(ij+u_lup,3,2)*ue(ij+t_lup+u_lup,l)+                   &
113                           wee(ij+u_lup,4,2)*ue(ij+t_lup+u_left,l)+                  &
114                           wee(ij+u_lup,5,2)*ue(ij+t_lup+u_ldown,l) )
115
116   
117        ut(ij+u_ldown,l) = 1/de(ij+u_ldown) *   & 
118                         ( wee(ij+u_ldown,1,1)*ue(ij+u_rdown,l)+                      &
119                           wee(ij+u_ldown,2,1)*ue(ij+u_right,l)+                      &
120                           wee(ij+u_ldown,3,1)*ue(ij+u_rup,l)+                        &
121                           wee(ij+u_ldown,4,1)*ue(ij+u_lup,l)+                        &
122                           wee(ij+u_ldown,5,1)*ue(ij+u_left,l)+                       & 
123                           wee(ij+u_ldown,1,2)*ue(ij+t_ldown+u_lup,l)+                &
124                           wee(ij+u_ldown,2,2)*ue(ij+t_ldown+u_left,l)+               &
125                           wee(ij+u_ldown,3,2)*ue(ij+t_ldown+u_ldown,l)+              &
126                           wee(ij+u_ldown,4,2)*ue(ij+t_ldown+u_rdown,l)+              &
127                           wee(ij+u_ldown,5,2)*ue(ij+t_ldown+u_right,l) ) 
128       
129        ENDDO
130      ENDDO
131    ENDDO
132                       
133 END SUBROUTINE compute_tangential_compound
134 
135 SUBROUTINE compute_wind_lonlat_compound(u, ulon, ulat)
136  USE icosa 
137   
138  IMPLICIT NONE
139  REAL(rstd) :: u(3*iim*jjm,3,llm)
140  REAL(rstd) :: ulon(3*iim*jjm,3,llm)
141  REAL(rstd) :: ulat(3*iim*jjm,3,llm)
142
143  INTEGER :: i,j,ij,l     
144   
145 
146    DO l=1,llm
147      DO j=jj_begin-1,jj_end+1
148        DO i=ii_begin-1,ii_end+1
149          ij=(j-1)*iim+i
150          ulon(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elon_e(ij+u_right,:))*elon_e(ij+u_right,:) 
151          ulon(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elon_e(ij+u_lup,:))*elon_e(ij+u_lup,:)
152          ulon(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elon_e(ij+u_ldown,:))*elon_e(ij+u_ldown,:)
153         
154          ulat(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elat_e(ij+u_right,:))*elat_e(ij+u_right,:) 
155          ulat(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elat_e(ij+u_lup,:))*elat_e(ij+u_lup,:) 
156          ulat(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elat_e(ij+u_ldown,:))*elat_e(ij+u_ldown,:) 
157         
158        ENDDO
159      ENDDO
160    ENDDO
161 
162 END SUBROUTINE compute_wind_lonlat_compound
163 
164  SUBROUTINE compute_wind_from_lonlat_compound(ulon, ulat, u)
165  USE icosa 
166   
167  IMPLICIT NONE
168  REAL(rstd) :: u(3*iim*jjm,3,llm)
169  REAL(rstd) :: ulon(3*iim*jjm,llm)
170  REAL(rstd) :: ulat(3*iim*jjm,llm)
171
172  INTEGER :: i,j,ij,l     
173 
174    DO l=1,llm
175      DO j=jj_begin-1,jj_end+1
176        DO i=ii_begin-1,ii_end+1
177          ij=(j-1)*iim+i
178          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,:)
179          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,:)
180          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,:)
181        ENDDO
182      ENDDO
183    ENDDO
184 
185  END SUBROUTINE compute_wind_from_lonlat_compound
186 
187  SUBROUTINE compute_wind2D_from_lonlat_compound(ulon, ulat, u)
188  USE icosa 
189 
190  IMPLICIT NONE
191  REAL(rstd) :: u(3*iim*jjm,3)
192  REAL(rstd) :: ulon(3*iim*jjm)
193  REAL(rstd) :: ulat(3*iim*jjm)
194 
195  INTEGER :: i,j,ij
196 
197  DO j=jj_begin-1,jj_end+1
198     DO i=ii_begin-1,ii_end+1
199        ij=(j-1)*iim+i
200        u(ij+u_right,:)=ulon(ij+u_right)*elon_e(ij+u_right,:)+ ulat(ij+u_right)*elat_e(ij+u_right,:)
201        u(ij+u_lup,:)=ulon(ij+u_lup)*elon_e(ij+u_lup,:) + ulat(ij+u_lup)*elat_e(ij+u_lup,:)
202        u(ij+u_ldown,:)=ulon(ij+u_ldown)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown)*elat_e(ij+u_ldown,:)
203     ENDDO
204  ENDDO
205   
206  END SUBROUTINE compute_wind2D_from_lonlat_compound
207 
208  SUBROUTINE compute_wind_perp_from_lonlat_compound(ulon, ulat, up)
209  USE icosa 
210   
211  IMPLICIT NONE
212  REAL(rstd) :: up(3*iim*jjm,llm)
213  REAL(rstd) :: ulon(3*iim*jjm,llm)
214  REAL(rstd) :: ulat(3*iim*jjm,llm)
215  REAL(rstd) :: u(3*iim*jjm,3,llm)
216
217  INTEGER :: i,j,ij,l     
218 
219   CALL compute_wind_from_lonlat_compound(ulon, ulat, u)
220
221    DO l=1,llm
222      DO j=jj_begin-1,jj_end+1
223        DO i=ii_begin-1,ii_end+1
224          ij=(j-1)*iim+i
225          up(ij+u_right,l)=sum(u(ij+u_right,:,l)*ep_e(ij+u_right,:))
226          up(ij+u_lup,l)=sum(u(ij+u_lup,:,l)*ep_e(ij+u_lup,:))
227          up(ij+u_ldown,l)=sum(u(ij+u_ldown,:,l)*ep_e(ij+u_ldown,:))
228        ENDDO
229      ENDDO
230    ENDDO
231 
232  END SUBROUTINE compute_wind_perp_from_lonlat_compound
233   
234  SUBROUTINE compute_wind2D_perp_from_lonlat_compound(ulon, ulat, up)
235  USE icosa 
236   
237  IMPLICIT NONE
238  REAL(rstd) :: up(3*iim*jjm)
239  REAL(rstd) :: ulon(3*iim*jjm)
240  REAL(rstd) :: ulat(3*iim*jjm)
241  REAL(rstd) :: u(3*iim*jjm,3)
242
243  INTEGER :: i,j,ij 
244 
245  CALL compute_wind2D_from_lonlat_compound(ulon, ulat, u)
246  DO j=jj_begin-1,jj_end+1
247     DO i=ii_begin-1,ii_end+1
248        ij=(j-1)*iim+i
249        up(ij+u_right)=sum(u(ij+u_right,:)*ep_e(ij+u_right,:))
250        up(ij+u_lup)=sum(u(ij+u_lup,:)*ep_e(ij+u_lup,:))
251        up(ij+u_ldown)=sum(u(ij+u_ldown,:)*ep_e(ij+u_ldown,:))
252     ENDDO
253  ENDDO
254   
255  END SUBROUTINE compute_wind2D_perp_from_lonlat_compound
256   
257 SUBROUTINE compute_wind_centered_lonlat_compound(uc, ulon, ulat)
258  USE icosa 
259   
260  IMPLICIT NONE
261  REAL(rstd) :: uc(iim*jjm,3,llm)
262  REAL(rstd) :: ulon(iim*jjm,llm)
263  REAL(rstd) :: ulat(iim*jjm,llm)
264
265  INTEGER :: i,j,ij,l     
266   
267 
268    DO l=1,llm
269      DO j=jj_begin,jj_end
270        DO i=ii_begin,ii_end
271          ij=(j-1)*iim+i
272          ulon(ij,l)=sum(uc(ij,:,l)*elon_i(ij,:))
273          ulat(ij,l)=sum(uc(ij,:,l)*elat_i(ij,:)) 
274        ENDDO
275      ENDDO
276    ENDDO
277 
278 END SUBROUTINE compute_wind_centered_lonlat_compound
279
280 SUBROUTINE compute_un2ulonlat(un, ulon, ulat)
281  USE icosa 
282   
283  IMPLICIT NONE
284  REAL(rstd),INTENT(IN)  :: un(3*iim*jjm,llm)
285  REAL(rstd),INTENT(OUT) :: ulon(iim*jjm,llm)
286  REAL(rstd),INTENT(OUT) :: ulat(iim*jjm,llm)
287
288  REAL(rstd)             :: uc(iim*jjm,3,llm)
289   
290  CALL compute_wind_centered(un,uc) 
291  CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)
292 
293 END SUBROUTINE compute_un2ulonlat
294
295END MODULE wind_mod
Note: See TracBrowser for help on using the repository browser.