source: codes/icosagcm/trunk/src/transfert.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: 9.1 KB
Line 
1MODULE transfert_mod
2USE genmod
3 
4  TYPE t_request
5    INTEGER :: type_field
6    INTEGER :: max_size
7    INTEGER :: size
8    INTEGER,POINTER :: src_domain(:)
9    INTEGER,POINTER :: src_i(:)
10    INTEGER,POINTER :: src_j(:)
11    INTEGER,POINTER :: src_ind(:)
12    INTEGER,POINTER :: target_ind(:)
13    INTEGER,POINTER :: target_i(:)
14    INTEGER,POINTER :: target_j(:)
15  END TYPE t_request
16 
17  TYPE(t_request),POINTER :: req_i1(:)
18  TYPE(t_request),POINTER :: req_e1(:)
19 
20CONTAINS
21
22  SUBROUTINE init_transfert
23  USE domain_mod
24  USE dimensions
25  USE field_mod
26  USE metric
27  IMPLICIT NONE
28  INTEGER :: ind,i,j
29 
30    CALL create_request(field_t,req_i1)
31
32    DO ind=1,ndomain
33      CALL swap_dimensions(ind)
34      DO i=ii_begin,ii_end+1
35        CALL request_add_point(ind,i,jj_begin-1,req_i1)
36      ENDDO
37
38      DO j=jj_begin,jj_end
39        CALL request_add_point(ind,ii_end+1,j,req_i1)
40      ENDDO   
41      DO i=ii_begin,ii_end
42        CALL request_add_point(ind,i,jj_end+1,req_i1)
43      ENDDO   
44
45      DO j=jj_begin,jj_end+1
46        CALL request_add_point(ind,ii_begin-1,j,req_i1)
47      ENDDO   
48   
49      DO i=ii_begin,ii_end
50        CALL request_add_point(ind,i,jj_begin,req_i1)
51      ENDDO
52
53      DO j=jj_begin,jj_end
54        CALL request_add_point(ind,ii_end,j,req_i1)
55      ENDDO   
56   
57      DO i=ii_begin,ii_end
58        CALL request_add_point(ind,i,jj_end,req_i1)
59      ENDDO   
60
61      DO j=jj_begin,jj_end
62        CALL request_add_point(ind,ii_begin,j,req_i1)
63      ENDDO   
64   
65    ENDDO
66 
67 
68    CALL create_request(field_u,req_e1)
69    DO ind=1,ndomain
70      CALL swap_dimensions(ind)
71      DO i=ii_begin,ii_end
72        CALL request_add_point(ind,i,jj_begin-1,req_e1,rup)
73        CALL request_add_point(ind,i+1,jj_begin-1,req_e1,lup)
74      ENDDO
75
76      DO j=jj_begin,jj_end
77        CALL request_add_point(ind,ii_end+1,j,req_e1,left)
78        CALL request_add_point(ind,ii_end+1,j-1,req_e1,lup)
79      ENDDO   
80   
81      DO i=ii_begin,ii_end
82        CALL request_add_point(ind,i,jj_end+1,req_e1,ldown)
83        CALL request_add_point(ind,i-1,jj_end+1,req_e1,rdown)
84      ENDDO   
85
86      DO j=jj_begin,jj_end
87        CALL request_add_point(ind,ii_begin-1,j,req_e1,right)
88        CALL request_add_point(ind,ii_begin-1,j+1,req_e1,rdown)
89      ENDDO   
90
91      DO i=ii_begin+1,ii_end-1
92        CALL request_add_point(ind,i,jj_begin,req_e1,right)
93        CALL request_add_point(ind,i,jj_end,req_e1,right)
94      ENDDO
95   
96      DO j=jj_begin+1,jj_end-1
97        CALL request_add_point(ind,ii_begin,j,req_e1,rup)
98        CALL request_add_point(ind,ii_end,j,req_e1,rup)
99      ENDDO   
100
101      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e1,left)
102      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e1,ldown)
103      CALL request_add_point(ind,ii_begin+1,jj_end,req_e1,left)
104      CALL request_add_point(ind,ii_end,jj_begin+1,req_e1,ldown)
105     
106    ENDDO
107 
108  END SUBROUTINE init_transfert
109 
110  SUBROUTINE create_request(type_field,request)
111  USE domain_mod
112  USE field_mod
113  IMPLICIT NONE
114    INTEGER :: type_field
115    TYPE(t_request),POINTER :: request(:)
116    TYPE(t_request),POINTER :: req
117    TYPE(t_domain),POINTER :: d
118    INTEGER :: ind
119    INTEGER :: max_size
120       
121    ALLOCATE(request(ndomain))
122
123    DO ind=1,ndomain
124      req=>request(ind)
125      d=>domain(ind)
126      IF (type_field==field_t) THEN
127        Max_size=2*(d%iim+2)+2*(d%jjm+2)
128      ELSE IF (type_field==field_u) THEN
129        Max_size=3*(2*(d%iim+2)+2*(d%jjm+2))
130      ELSE IF (type_field==field_z) THEN
131        Max_size=2*(2*(d%iim+2)+2*(d%jjm+2))
132      ENDIF
133
134      req%type_field=type_field
135      req%max_size=max_size*2
136      req%size=0
137      ALLOCATE(req%src_domain(req%max_size))
138      ALLOCATE(req%src_ind(req%max_size))
139      ALLOCATE(req%target_ind(req%max_size))
140      ALLOCATE(req%src_i(req%max_size))
141      ALLOCATE(req%src_j(req%max_size))
142      ALLOCATE(req%target_i(req%max_size))
143      ALLOCATE(req%target_j(req%max_size))
144    ENDDO
145 
146  END SUBROUTINE create_request
147
148  SUBROUTINE reallocate_request(req)
149  IMPLICIT NONE
150    TYPE(t_request),POINTER :: req
151     
152    INTEGER,POINTER :: src_domain(:)
153    INTEGER,POINTER :: src_ind(:)
154    INTEGER,POINTER :: target_ind(:)
155    INTEGER,POINTER :: src_i(:)
156    INTEGER,POINTER :: src_j(:)
157    INTEGER,POINTER :: target_i(:)
158    INTEGER,POINTER :: target_j(:)
159
160    PRINT *,"REALLOCATE_REQUEST"
161    src_domain=>req%src_domain
162    src_ind=>req%src_ind
163    target_ind=>req%target_ind
164    src_i=>req%src_i
165    src_j=>req%src_j
166    target_i=>req%target_i
167    target_j=>req%target_j
168!    req%max_size=req%max_size*2
169    ALLOCATE(req%src_domain(req%max_size*2))
170    ALLOCATE(req%src_ind(req%max_size*2))
171    ALLOCATE(req%target_ind(req%max_size*2))
172    ALLOCATE(req%src_i(req%max_size*2))
173    ALLOCATE(req%src_j(req%max_size*2))
174    ALLOCATE(req%target_i(req%max_size*2))
175    ALLOCATE(req%target_j(req%max_size*2))
176   
177    req%src_domain(1:req%max_size)=src_domain(:)
178    req%src_ind(1:req%max_size)=src_ind(:)
179    req%target_ind(1:req%max_size)=target_ind(:)
180    req%src_i(1:req%max_size)=src_i(:)
181    req%src_j(1:req%max_size)=src_j(:)
182    req%target_i(1:req%max_size)=target_i(:)
183    req%target_j(1:req%max_size)=target_j(:)
184   
185    req%max_size=req%max_size*2
186         
187    DEALLOCATE(src_domain)
188    DEALLOCATE(src_ind)
189    DEALLOCATE(target_ind)
190    DEALLOCATE(src_i)
191    DEALLOCATE(src_j)
192    DEALLOCATE(target_i)
193    DEALLOCATE(target_j)
194
195  END SUBROUTINE reallocate_request
196
197     
198    SUBROUTINE request_add_point(ind,i,j,request,pos)
199    USE domain_mod
200    USE field_mod
201    IMPLICIT NONE
202      INTEGER,INTENT(IN)            ::  ind
203      INTEGER,INTENT(IN)            :: i
204      INTEGER,INTENT(IN)            :: j
205      TYPE(t_request),POINTER :: request(:)
206      INTEGER,INTENT(IN),OPTIONAL  :: pos
207     
208      INTEGER :: src_domain
209      INTEGER :: src_iim,src_i,src_j,src_n,src_pos,src_delta
210      TYPE(t_request),POINTER :: req
211      TYPE(t_domain),POINTER :: d
212     
213      req=>request(ind)
214      d=>domain(ind)
215     
216      IF (req%max_size==req%size) CALL reallocate_request(req)
217      req%size=req%size+1
218      IF (req%type_field==field_t) THEN
219        src_domain=domain(ind)%assign_domain(i,j)
220        src_iim=domain(src_domain)%iim
221        src_i=domain(ind)%assign_i(i,j)
222        src_j=domain(ind)%assign_j(i,j)
223
224        req%target_ind(req%size)=(j-1)*d%iim+i
225        req%src_domain(req%size)=src_domain
226        req%src_ind(req%size)=(src_j-1)*src_iim+src_i
227      ELSE IF (req%type_field==field_u) THEN
228        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
229
230        src_domain=domain(ind)%edge_assign_domain(pos-1,i,j)
231        src_iim=domain(src_domain)%iim
232        src_i=domain(ind)%edge_assign_i(pos-1,i,j)
233        src_j=domain(ind)%edge_assign_j(pos-1,i,j)
234        src_n=(src_j-1)*src_iim+src_i
235        src_delta=domain(ind)%delta(i,j)
236       
237!        src_pos=MOD(pos-1+src_delta+6,6)+1
238        src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1
239               
240        req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos)
241        req%src_domain(req%size)=src_domain
242        req%src_ind(req%size)=src_n+domain(src_domain)%u_pos(src_pos)
243
244!        req%target_i(req%size)=i
245!        req%target_j(req%size)=j
246!        req%src_i(req%size)=domain(ind)%assign_i(i,j)
247!        req%src_j(req%size)=domain(ind)%assign_j(i,j)
248       
249!        PRINT *,"1--->",ind,i,j,pos
250!        PRINT *,"2--->",src_domain,src_i,src_j,src_pos
251
252      ELSE IF (req%type_field==field_z) THEN
253        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
254
255        src_domain=domain(ind)%assign_domain(i,j)
256        src_iim=domain(src_domain)%iim
257        src_i=domain(ind)%assign_i(i,j)
258        src_j=domain(ind)%assign_j(i,j)
259        src_n=(src_j-1)*src_iim+src_i
260        src_delta=domain(ind)%delta(i,j)
261       
262        src_pos=MOD(pos-1+src_delta+6,6)+1
263       
264        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos)
265        req%src_domain(req%size)=src_domain
266        req%src_ind(req%size)=src_n+domain(src_domain)%z_pos(src_pos)
267      ENDIF
268  END SUBROUTINE request_add_point
269 
270 
271  SUBROUTINE transfert_request(field,request)
272  USE field_mod
273  USE domain_mod
274  IMPLICIT NONE
275    TYPE(t_field),POINTER :: field(:)
276    TYPE(t_request),POINTER :: request(:)
277    REAL(rstd),POINTER :: rval2d(:) 
278    REAL(rstd),POINTER :: rval3d(:,:) 
279    REAL(rstd),POINTER :: rval4d(:,:,:) 
280    INTEGER :: ind
281    TYPE(t_request),POINTER :: req
282    INTEGER :: n
283    REAL(rstd) :: var1,var2
284   
285    DO ind=1,ndomain
286      req=>request(ind)
287      rval2d=>field(ind)%rval2d
288      rval3d=>field(ind)%rval3d
289      rval4d=>field(ind)%rval4d
290     
291      IF (field(ind)%data_type==type_real) THEN
292        IF (field(ind)%ndim==2) THEN
293          DO n=1,req%size
294            rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n))
295          ENDDO
296        ELSE IF (field(ind)%ndim==3) THEN
297          DO n=1,req%size
298            rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:)
299          ENDDO
300        ELSE IF (field(ind)%ndim==4) THEN
301          DO n=1,req%size
302            rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:)
303          ENDDO
304        ENDIF
305      ENDIF       
306
307    ENDDO
308   
309  END SUBROUTINE transfert_request
310
311END MODULE transfert_mod
312     
313       
314       
315       
316     
Note: See TracBrowser for help on using the repository browser.