source: codes/icosagcm/trunk/src/transfert.f90 @ 20

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

Update on 3D dynamic

YM
File size: 9.0 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)%assign_domain(i,j)
231        src_iim=domain(src_domain)%iim
232        src_i=domain(ind)%assign_i(i,j)
233        src_j=domain(ind)%assign_j(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       
239        req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos)
240        req%src_domain(req%size)=src_domain
241        req%src_ind(req%size)=src_n+domain(src_domain)%u_pos(src_pos)
242
243        req%target_i(req%size)=i
244        req%target_j(req%size)=j
245        req%src_i(req%size)=domain(ind)%assign_i(i,j)
246        req%src_j(req%size)=domain(ind)%assign_j(i,j)
247       
248!        PRINT *,ind,i,j,"src_delta",src_delta
249
250      ELSE IF (req%type_field==field_z) THEN
251        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
252
253        src_domain=domain(ind)%assign_domain(i,j)
254        src_iim=domain(src_domain)%iim
255        src_i=domain(ind)%assign_i(i,j)
256        src_j=domain(ind)%assign_j(i,j)
257        src_n=(src_j-1)*src_iim+src_i
258        src_delta=domain(ind)%delta(i,j)
259       
260        src_pos=MOD(pos-1+src_delta+6,6)+1
261       
262        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos)
263        req%src_domain(req%size)=src_domain
264        req%src_ind(req%size)=src_n+domain(src_domain)%z_pos(src_pos)
265      ENDIF
266  END SUBROUTINE request_add_point
267 
268 
269  SUBROUTINE transfert_request(field,request)
270  USE field_mod
271  USE domain_mod
272  IMPLICIT NONE
273    TYPE(t_field),POINTER :: field(:)
274    TYPE(t_request),POINTER :: request(:)
275    REAL(rstd),POINTER :: rval2d(:) 
276    REAL(rstd),POINTER :: rval3d(:,:) 
277    REAL(rstd),POINTER :: rval4d(:,:,:) 
278    INTEGER :: ind
279    TYPE(t_request),POINTER :: req
280    INTEGER :: n
281    REAL(rstd) :: var1,var2
282   
283    DO ind=1,ndomain
284      req=>request(ind)
285      rval2d=>field(ind)%rval2d
286      rval3d=>field(ind)%rval3d
287      rval4d=>field(ind)%rval4d
288     
289      IF (field(ind)%data_type==type_real) THEN
290        IF (field(ind)%ndim==2) THEN
291          DO n=1,req%size
292            rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n))
293          ENDDO
294        ELSE IF (field(ind)%ndim==3) THEN
295          DO n=1,req%size
296            rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:)
297          ENDDO
298        ELSE IF (field(ind)%ndim==4) THEN
299          DO n=1,req%size
300            rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:)
301          ENDDO
302        ENDIF
303      ENDIF       
304
305    ENDDO
306   
307  END SUBROUTINE transfert_request
308
309END MODULE transfert_mod
310     
311       
312       
313       
314     
Note: See TracBrowser for help on using the repository browser.