source: codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/wind.f90 @ 268

Last change on this file since 268 was 260, checked in by ymipsl, 10 years ago

Implement restartability for dynamico

YM
File size: 13.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       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  SUBROUTINE ulonlat2un(f_ulon, f_ulat,f_u)
27  USE icosa
28  IMPLICIT NONE
29    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! IN : velocity reconstructed at hexagons
30    TYPE(t_field), POINTER :: f_u(:) ! OUT  : normal velocity components on edges
31   
32    REAL(rstd),POINTER :: u(:,:),  ulon(:,:), ulat(:,:)
33    INTEGER :: ind
34
35    DO ind=1,ndomain
36       IF (.NOT. assigned_domain(ind)) CYCLE
37       CALL swap_dimensions(ind)
38       CALL swap_geometry(ind)
39       u=f_u(ind)
40       ulon=f_ulon(ind)
41       ulat=f_ulat(ind)
42       CALL compute_ulonlat2un(ulon, ulat,u)
43    END DO
44
45  END SUBROUTINE ulonlat2un
46 
47  SUBROUTINE compute_wind_centered(ue,ucenter)
48  USE icosa
49 
50  IMPLICIT NONE
51  REAL(rstd) :: ue(3*iim*jjm,llm)
52  REAL(rstd) :: ucenter(iim*jjm,3,llm)
53  INTEGER :: i,j,ij,l   
54 
55    DO l=1,llm
56      DO j=jj_begin,jj_end
57        DO i=ii_begin,ii_end
58          ij=(j-1)*iim+i
59          ucenter(ij,:,l)=1/Ai(ij)*                                                                                                &
60                        ( 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,:))  &
61                         + 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,:))          &
62                         + 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,:))          &
63                         + 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,:))    &
64                         + 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,:))&
65                         + 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,:)))
66        ENDDO
67      ENDDO
68    ENDDO
69 
70 END SUBROUTINE compute_wind_centered
71 
72 
73 SUBROUTINE compute_wind_on_edge(ue,uedge)
74  USE icosa
75   
76  IMPLICIT NONE
77  REAL(rstd) :: ue(3*iim*jjm,llm)
78  REAL(rstd) :: uedge(3*iim*jjm,3,llm)
79
80  REAL(rstd) :: ut(3*iim*jjm,llm)
81  INTEGER :: i,j,ij,l     
82   
83    CALL compute_tangential_compound(ue,ut)
84 
85    DO l=1,llm
86      DO j=jj_begin,jj_end
87        DO i=ii_begin,ii_end
88          ij=(j-1)*iim+i
89          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) 
90          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)
91          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)
92        ENDDO
93      ENDDO
94    ENDDO
95 
96 END SUBROUTINE compute_wind_on_edge
97 
98 
99 
100 SUBROUTINE compute_tangential_compound(ue,ut)
101  USE icosa 
102  IMPLICIT NONE
103  REAL(rstd) :: ue(3*iim*jjm,llm)
104  REAL(rstd) :: ut(3*iim*jjm,llm)
105  INTEGER :: i,j,l,ij
106   
107  DO l=1,llm
108    DO j=jj_begin,jj_end
109      DO i=ii_begin,ii_end
110        ij=(j-1)*iim+i
111   
112        ut(ij+u_right,l) = 1/de(ij+u_right) *                                            & 
113                         ( wee(ij+u_right,1,1)*ue(ij+u_rup,l)+                           &
114                           wee(ij+u_right,2,1)*ue(ij+u_lup,l)+                           &
115                           wee(ij+u_right,3,1)*ue(ij+u_left,l)+                          &
116                           wee(ij+u_right,4,1)*ue(ij+u_ldown,l)+                         &
117                           wee(ij+u_right,5,1)*ue(ij+u_rdown,l)+                         & 
118                           wee(ij+u_right,1,2)*ue(ij+t_right+u_ldown,l)+                 &
119                           wee(ij+u_right,2,2)*ue(ij+t_right+u_rdown,l)+                 &
120                           wee(ij+u_right,3,2)*ue(ij+t_right+u_right,l)+                 &
121                           wee(ij+u_right,4,2)*ue(ij+t_right+u_rup,l)+                   &
122                           wee(ij+u_right,5,2)*ue(ij+t_right+u_lup,l) )   
123     
124        ut(ij+u_lup,l) =  1/de(ij+u_lup) *                                           & 
125                         ( wee(ij+u_lup,1,1)*ue(ij+u_left,l)+                        &
126                           wee(ij+u_lup,2,1)*ue(ij+u_ldown,l)+                       &
127                           wee(ij+u_lup,3,1)*ue(ij+u_rdown,l)+                       &
128                           wee(ij+u_lup,4,1)*ue(ij+u_right,l)+                       &
129                           wee(ij+u_lup,5,1)*ue(ij+u_rup,l)+                         & 
130                           wee(ij+u_lup,1,2)*ue(ij+t_lup+u_right,l)+                 &
131                           wee(ij+u_lup,2,2)*ue(ij+t_lup+u_rup,l)+                   &
132                           wee(ij+u_lup,3,2)*ue(ij+t_lup+u_lup,l)+                   &
133                           wee(ij+u_lup,4,2)*ue(ij+t_lup+u_left,l)+                  &
134                           wee(ij+u_lup,5,2)*ue(ij+t_lup+u_ldown,l) )
135
136   
137        ut(ij+u_ldown,l) = 1/de(ij+u_ldown) *   & 
138                         ( wee(ij+u_ldown,1,1)*ue(ij+u_rdown,l)+                      &
139                           wee(ij+u_ldown,2,1)*ue(ij+u_right,l)+                      &
140                           wee(ij+u_ldown,3,1)*ue(ij+u_rup,l)+                        &
141                           wee(ij+u_ldown,4,1)*ue(ij+u_lup,l)+                        &
142                           wee(ij+u_ldown,5,1)*ue(ij+u_left,l)+                       & 
143                           wee(ij+u_ldown,1,2)*ue(ij+t_ldown+u_lup,l)+                &
144                           wee(ij+u_ldown,2,2)*ue(ij+t_ldown+u_left,l)+               &
145                           wee(ij+u_ldown,3,2)*ue(ij+t_ldown+u_ldown,l)+              &
146                           wee(ij+u_ldown,4,2)*ue(ij+t_ldown+u_rdown,l)+              &
147                           wee(ij+u_ldown,5,2)*ue(ij+t_ldown+u_right,l) ) 
148       
149        ENDDO
150      ENDDO
151    ENDDO
152                       
153 END SUBROUTINE compute_tangential_compound
154 
155 SUBROUTINE compute_wind_lonlat_compound(u, ulon, ulat)
156  USE icosa 
157   
158  IMPLICIT NONE
159  REAL(rstd) :: u(3*iim*jjm,3,llm)
160  REAL(rstd) :: ulon(3*iim*jjm,3,llm)
161  REAL(rstd) :: ulat(3*iim*jjm,3,llm)
162
163  INTEGER :: i,j,ij,l     
164   
165 
166    DO l=1,llm
167      DO j=jj_begin-1,jj_end+1
168        DO i=ii_begin-1,ii_end+1
169          ij=(j-1)*iim+i
170          ulon(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elon_e(ij+u_right,:))*elon_e(ij+u_right,:) 
171          ulon(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elon_e(ij+u_lup,:))*elon_e(ij+u_lup,:)
172          ulon(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elon_e(ij+u_ldown,:))*elon_e(ij+u_ldown,:)
173         
174          ulat(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elat_e(ij+u_right,:))*elat_e(ij+u_right,:) 
175          ulat(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elat_e(ij+u_lup,:))*elat_e(ij+u_lup,:) 
176          ulat(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elat_e(ij+u_ldown,:))*elat_e(ij+u_ldown,:) 
177         
178        ENDDO
179      ENDDO
180    ENDDO
181 
182 END SUBROUTINE compute_wind_lonlat_compound
183 
184  SUBROUTINE compute_wind_from_lonlat_compound(ulon, ulat, u)
185  USE icosa 
186   
187  IMPLICIT NONE
188  REAL(rstd) :: u(3*iim*jjm,3,llm)
189  REAL(rstd) :: ulon(3*iim*jjm,llm)
190  REAL(rstd) :: ulat(3*iim*jjm,llm)
191
192  INTEGER :: i,j,ij,l     
193 
194    DO l=1,llm
195      DO j=jj_begin-1,jj_end+1
196        DO i=ii_begin-1,ii_end+1
197          ij=(j-1)*iim+i
198          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,:)
199          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,:)
200          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,:)
201        ENDDO
202      ENDDO
203    ENDDO
204 
205  END SUBROUTINE compute_wind_from_lonlat_compound
206 
207  SUBROUTINE compute_wind_centered_from_lonlat_compound(ulon, ulat, u)
208  USE icosa 
209   
210  IMPLICIT NONE
211  REAL(rstd) :: u(iim*jjm,3,llm)
212  REAL(rstd) :: ulon(iim*jjm,llm)
213  REAL(rstd) :: ulat(iim*jjm,llm)
214
215  INTEGER :: i,j,ij,l     
216  DO l=1,llm
217      DO j=jj_begin-1,jj_end+1
218        DO i=ii_begin-1,ii_end+1
219          ij=(j-1)*iim+i
220          u(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ ulat(ij,l)*elat_i(ij,:)
221        ENDDO
222      ENDDO
223    ENDDO
224 
225  END SUBROUTINE compute_wind_centered_from_lonlat_compound
226 
227  SUBROUTINE compute_wind2D_from_lonlat_compound(ulon, ulat, u)
228  USE icosa 
229 
230  IMPLICIT NONE
231  REAL(rstd) :: u(3*iim*jjm,3)
232  REAL(rstd) :: ulon(3*iim*jjm)
233  REAL(rstd) :: ulat(3*iim*jjm)
234 
235  INTEGER :: i,j,ij
236 
237  DO j=jj_begin-1,jj_end+1
238     DO i=ii_begin-1,ii_end+1
239        ij=(j-1)*iim+i
240        u(ij+u_right,:)=ulon(ij+u_right)*elon_e(ij+u_right,:)+ ulat(ij+u_right)*elat_e(ij+u_right,:)
241        u(ij+u_lup,:)=ulon(ij+u_lup)*elon_e(ij+u_lup,:) + ulat(ij+u_lup)*elat_e(ij+u_lup,:)
242        u(ij+u_ldown,:)=ulon(ij+u_ldown)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown)*elat_e(ij+u_ldown,:)
243     ENDDO
244  ENDDO
245   
246  END SUBROUTINE compute_wind2D_from_lonlat_compound
247 
248  SUBROUTINE compute_wind_perp_from_lonlat_compound(ulon, ulat, up)
249  USE icosa 
250   
251  IMPLICIT NONE
252  REAL(rstd) :: up(3*iim*jjm,llm)
253  REAL(rstd) :: ulon(3*iim*jjm,llm)
254  REAL(rstd) :: ulat(3*iim*jjm,llm)
255  REAL(rstd) :: u(3*iim*jjm,3,llm)
256
257  INTEGER :: i,j,ij,l     
258 
259   CALL compute_wind_from_lonlat_compound(ulon, ulat, u)
260
261    DO l=1,llm
262      DO j=jj_begin-1,jj_end+1
263        DO i=ii_begin-1,ii_end+1
264          ij=(j-1)*iim+i
265          up(ij+u_right,l)=sum(u(ij+u_right,:,l)*ep_e(ij+u_right,:))
266          up(ij+u_lup,l)=sum(u(ij+u_lup,:,l)*ep_e(ij+u_lup,:))
267          up(ij+u_ldown,l)=sum(u(ij+u_ldown,:,l)*ep_e(ij+u_ldown,:))
268        ENDDO
269      ENDDO
270    ENDDO
271 
272  END SUBROUTINE compute_wind_perp_from_lonlat_compound
273   
274  SUBROUTINE compute_wind2D_perp_from_lonlat_compound(ulon, ulat, up)
275  USE icosa 
276   
277  IMPLICIT NONE
278  REAL(rstd) :: up(3*iim*jjm)
279  REAL(rstd) :: ulon(3*iim*jjm)
280  REAL(rstd) :: ulat(3*iim*jjm)
281  REAL(rstd) :: u(3*iim*jjm,3)
282
283  INTEGER :: i,j,ij 
284 
285  CALL compute_wind2D_from_lonlat_compound(ulon, ulat, u)
286  DO j=jj_begin-1,jj_end+1
287     DO i=ii_begin-1,ii_end+1
288        ij=(j-1)*iim+i
289        up(ij+u_right)=sum(u(ij+u_right,:)*ep_e(ij+u_right,:))
290        up(ij+u_lup)=sum(u(ij+u_lup,:)*ep_e(ij+u_lup,:))
291        up(ij+u_ldown)=sum(u(ij+u_ldown,:)*ep_e(ij+u_ldown,:))
292     ENDDO
293  ENDDO
294   
295  END SUBROUTINE compute_wind2D_perp_from_lonlat_compound
296   
297 SUBROUTINE compute_wind_centered_lonlat_compound(uc, ulon, ulat)
298  USE icosa 
299   
300  IMPLICIT NONE
301  REAL(rstd) :: uc(iim*jjm,3,llm)
302  REAL(rstd) :: ulon(iim*jjm,llm)
303  REAL(rstd) :: ulat(iim*jjm,llm)
304
305  INTEGER :: i,j,ij,l     
306   
307 
308    DO l=1,llm
309      DO j=jj_begin,jj_end
310        DO i=ii_begin,ii_end
311          ij=(j-1)*iim+i
312          ulon(ij,l)=sum(uc(ij,:,l)*elon_i(ij,:))
313          ulat(ij,l)=sum(uc(ij,:,l)*elat_i(ij,:)) 
314        ENDDO
315      ENDDO
316    ENDDO
317 
318 END SUBROUTINE compute_wind_centered_lonlat_compound
319
320 SUBROUTINE compute_wind_centered_from_wind_lonlat_centered(ulon, ulat,uc)
321  USE icosa 
322   
323  IMPLICIT NONE
324  REAL(rstd) :: ulon(iim*jjm,llm)
325  REAL(rstd) :: ulat(iim*jjm,llm)
326  REAL(rstd) :: uc(iim*jjm,3,llm)
327
328  INTEGER :: i,j,ij,l     
329   
330 
331    DO l=1,llm
332      DO j=jj_begin,jj_end
333        DO i=ii_begin,ii_end
334          ij=(j-1)*iim+i
335          uc(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ulat(ij,l)*elat_i(ij,:)
336        ENDDO
337      ENDDO
338    ENDDO
339 
340 END SUBROUTINE compute_wind_centered_from_wind_lonlat_centered
341
342
343
344 SUBROUTINE compute_wind_perp_from_wind_centered(uc,un)
345  USE icosa 
346   
347  IMPLICIT NONE
348  REAL(rstd),INTENT(IN)   :: uc(iim*jjm,3,llm)
349  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm)
350
351  INTEGER :: i,j,ij,l     
352   
353 
354    DO l=1,llm
355      DO j=jj_begin,jj_end
356        DO i=ii_begin,ii_end
357          ij=(j-1)*iim+i
358          un(ij+u_right,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:))
359          un(ij+u_lup,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:))
360          un(ij+u_ldown,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:))
361         ENDDO
362      ENDDO
363    ENDDO
364 
365 END SUBROUTINE compute_wind_perp_from_wind_centered
366
367
368 SUBROUTINE compute_un2ulonlat(un, ulon, ulat)
369  USE icosa 
370   
371  IMPLICIT NONE
372  REAL(rstd),INTENT(IN)  :: un(3*iim*jjm,llm)
373  REAL(rstd),INTENT(OUT) :: ulon(iim*jjm,llm)
374  REAL(rstd),INTENT(OUT) :: ulat(iim*jjm,llm)
375
376  REAL(rstd)             :: uc(iim*jjm,3,llm)
377   
378  CALL compute_wind_centered(un,uc) 
379  CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)
380 
381 END SUBROUTINE compute_un2ulonlat
382
383 SUBROUTINE compute_ulonlat2un(ulon, ulat,un)
384  USE icosa 
385   
386  IMPLICIT NONE
387  REAL(rstd),INTENT(IN) :: ulon(iim*jjm,llm)
388  REAL(rstd),INTENT(IN) :: ulat(iim*jjm,llm)
389  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm)
390
391  REAL(rstd)             :: uc(iim*jjm,3,llm)
392   
393    CALL compute_wind_centered_from_wind_lonlat_centered(ulon, ulat, uc) 
394    CALL compute_wind_perp_from_wind_centered(uc, un)
395 
396 END SUBROUTINE compute_ulonlat2un
397
398
399END MODULE wind_mod
Note: See TracBrowser for help on using the repository browser.