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

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

correction for compiling with gfortran (line too long)
improvement for splitting domain
Call twice transfert request for field u is no longer necessary

YM
File size: 7.6 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 
169 SUBROUTINE compute_wind_centered_lonlat_compound(uc, ulon, ulat)
170  USE icosa 
171   
172  IMPLICIT NONE
173  REAL(rstd) :: uc(3*iim*jjm,3,llm)
174  REAL(rstd) :: ulon(3*iim*jjm,3,llm)
175  REAL(rstd) :: ulat(3*iim*jjm,3,llm)
176
177  INTEGER :: i,j,ij,l     
178   
179 
180    DO l=1,llm
181      DO j=jj_begin,jj_end
182        DO i=ii_begin,ii_end
183          ij=(j-1)*iim+i
184          ulon(ij,:,l)=sum(uc(ij,:,l)*elon_i(ij,:))*elon_i(ij,:) 
185          ulat(ij,:,l)=sum(uc(ij,:,l)*elat_i(ij,:))**elat_i(ij,:) 
186        ENDDO
187      ENDDO
188    ENDDO
189 
190 END SUBROUTINE compute_wind_centered_lonlat_compound
191
192
193END MODULE wind_mod
Note: See TracBrowser for help on using the repository browser.