source: codes/icosagcm/trunk/src/wind.f90 @ 38

Last change on this file since 38 was 38, checked in by ymipsl, 12 years ago

bug correction for compilation

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