source: codes/icosagcm/trunk/src/domain.f90 @ 15

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

Update on 3D dynamic

YM
File size: 6.6 KB
Line 
1MODULE domain_mod
2  USE domain_param
3
4  TYPE t_domain
5    INTEGER :: face
6    INTEGER :: iim
7    INTEGER :: jjm
8    INTEGER :: ii_begin
9    INTEGER :: jj_begin
10    INTEGER :: ii_end
11    INTEGER :: jj_end
12    INTEGER :: ii_nb
13    INTEGER :: jj_nb
14    INTEGER :: ii_begin_glo
15    INTEGER :: jj_begin_glo
16    INTEGER :: ii_end_glo
17    INTEGER :: jj_end_glo
18    INTEGER,POINTER  :: assign_domain(:,:)
19    INTEGER,POINTER  :: assign_i(:,:)
20    INTEGER,POINTER  :: assign_j(:,:)
21    REAL,POINTER     :: xyz(:,:,:)
22    REAL,POINTER     :: neighbour(:,:,:,:)
23    INTEGER,POINTER  :: delta(:,:)
24    REAL,POINTER     :: vertex(:,:,:,:)
25    LOGICAL,POINTER  :: own(:,:)
26    INTEGER,POINTER  :: ne(:,:,:)
27   
28    INTEGER :: t_right
29    INTEGER :: t_rup
30    INTEGER :: t_lup
31    INTEGER :: t_left
32    INTEGER :: t_ldown
33    INTEGER :: t_rdown
34
35    INTEGER :: u_right
36    INTEGER :: u_rup
37    INTEGER :: u_lup
38    INTEGER :: u_left
39    INTEGER :: u_ldown
40    INTEGER :: u_rdown
41
42    INTEGER :: z_rup
43    INTEGER :: z_up
44    INTEGER :: z_lup
45    INTEGER :: z_ldown
46    INTEGER :: z_down
47    INTEGER :: z_rdown
48   
49    INTEGER :: t_pos(6)
50    INTEGER :: u_pos(6)
51    INTEGER :: z_pos(6)
52     
53  END TYPE t_domain
54
55  TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain(:)
56  INTEGER :: ndomain
57
58
59CONTAINS
60
61  SUBROUTINE create_domain
62  USE grid_param
63  IMPLICIT NONE
64  INTEGER :: ind,nf,ni,nj,i,j
65  INTEGER :: quotient, rest
66  TYPE(t_domain),POINTER :: d
67 
68    ndomain=nsplit_i*nsplit_j*nb_face
69    ALLOCATE(domain(ndomain))
70 
71    ind=0
72    DO nf=1,nb_face
73      DO nj=1,nsplit_i
74        DO ni=1,nsplit_j
75          ind=ind+1
76          d=>domain(ind)
77          quotient=(iim_glo/nsplit_i)
78          rest=MOD(iim_glo,nsplit_i)
79          IF (ni-1 < rest) THEN
80            d%ii_nb=quotient+1
81            d%ii_begin_glo=(quotient+1)*(ni-1)+1
82          ELSE
83            d%ii_nb=quotient
84            d%ii_begin_glo=(quotient+1)*rest+(ni-1-rest) * quotient+1
85          ENDIF
86          d%ii_end_glo=d%ii_begin_glo+d%ii_nb-1
87       
88          quotient=(jjm_glo/nsplit_j)
89          rest=MOD(jjm_glo,nsplit_j)
90          IF (nj-1 < rest) THEN
91            d%jj_nb=quotient+1
92            d%jj_begin_glo=(quotient+1)*(nj-1)+1
93          ELSE
94            d%jj_nb=quotient
95            d%jj_begin_glo=(quotient+1)*rest+(nj-1-rest) * quotient+1
96          ENDIF
97
98          d%jj_end_glo=d%jj_begin_glo+d%jj_nb-1
99          d%iim=d%ii_nb+2*halo
100          d%jjm=d%jj_nb+2*halo
101          d%ii_begin=halo+1
102          d%jj_begin=halo+1
103          d%ii_end=d%ii_begin+d%ii_nb-1
104          d%jj_end=d%jj_begin+d%jj_nb-1
105          d%face=nf       
106          ALLOCATE(d%assign_domain(d%iim,d%jjm))
107          ALLOCATE(d%assign_i(d%iim,d%jjm))
108          ALLOCATE(d%assign_j(d%iim,d%jjm))
109          ALLOCATE(d%delta(d%iim,d%jjm))
110          ALLOCATE(d%xyz(3,d%iim,d%jjm))
111          ALLOCATE(d%vertex(3,0:5,d%iim,d%jjm))
112          ALLOCATE(d%neighbour(3,0:5,d%iim,d%jjm))
113          ALLOCATE(d%own(d%iim,d%jjm))
114          ALLOCATE(d%ne(0:5,d%iim,d%jjm))
115        END DO
116      END DO
117    END DO
118   
119  END SUBROUTINE create_domain
120 
121 
122  SUBROUTINE assign_cell
123  USE metric
124  IMPLICIT NONE
125    INTEGER :: ind_d,ind,ind2
126    INTEGER :: nf
127    INTEGER :: i,j,k,ii,jj
128    TYPE(t_domain),POINTER :: d
129     
130   
131    DO ind_d=1,ndomain
132      d=>domain(ind_d)
133      nf=d%face
134      DO j=d%jj_begin,d%jj_end
135        DO i=d%ii_begin,d%ii_end
136          ii=d%ii_begin_glo-d%ii_begin+i
137          jj=d%jj_begin_glo-d%jj_begin+j
138          ind=vertex_glo(ii,jj,nf)%ind
139          IF (cell_glo(ind)%assign_face==nf) THEN
140            cell_glo(ind)%assign_domain=ind_d
141            cell_glo(ind)%assign_i=i
142            cell_glo(ind)%assign_j=j
143          ENDIF
144        ENDDO
145      ENDDO
146    ENDDO
147   
148    DO ind_d=1,ndomain
149      d=>domain(ind_d)
150      nf=d%face
151      DO j=d%jj_begin-1,d%jj_end+1
152        DO i=d%ii_begin-1,d%ii_end+1
153          ii=d%ii_begin_glo-d%ii_begin+i
154          jj=d%jj_begin_glo-d%jj_begin+j
155          ind=vertex_glo(ii,jj,nf)%ind
156          d%assign_domain(i,j)=cell_glo(ind)%assign_domain
157          d%assign_i(i,j)=cell_glo(ind)%assign_i
158          d%assign_j(i,j)=cell_glo(ind)%assign_j
159          d%delta(i,j)=vertex_glo(ii,jj,nf)%delta
160          DO k=0,5
161            ind2=vertex_glo(ii,jj,nf)%neighbour(k)
162            d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:)
163            d%ne(k,i,j)=vertex_glo(ii,jj,nf)%ne(k)
164          ENDDO
165          d%xyz(:,i,j)=cell_glo(ind)%xyz(:)
166          IF (d%assign_domain(i,j)==ind_d) THEN
167           d%own(i,j)=.TRUE.
168          ELSE
169           d%own(i,j)=.FALSE.
170          ENDIF
171        ENDDO
172      ENDDO
173    ENDDO   
174  END SUBROUTINE assign_cell
175
176  SUBROUTINE compute_boundary
177  USE spherical_geom_mod
178  IMPLICIT NONE
179    INTEGER :: ind_d
180    INTEGER :: i,j,k
181    TYPE(t_domain),POINTER :: d 
182    REAL(rstd) :: ng1(3),ng2(3) 
183
184    DO ind_d=1,ndomain
185      d=>domain(ind_d)
186      DO j=d%jj_begin-1,d%jj_end+1
187        DO i=d%ii_begin-1,d%ii_end+1
188          DO k=0,5
189            ng1=d%neighbour(:,MOD(k,6),i,j)
190            ng2=d%neighbour(:,MOD(k+1,6),i,j)
191            IF (sqrt(sum((ng1-ng2)**2))<1e-16) ng2=d%neighbour(:,MOD(k+2,6),i,j)
192            CALL circumcenter(d%xyz(:,i,j),ng1,ng2,d%vertex(:,k,i,j))
193          ENDDO
194        ENDDO
195      ENDDO
196    ENDDO       
197  END SUBROUTINE compute_boundary
198
199  SUBROUTINE set_neighbour_indice
200  USE metric
201  IMPLICIT NONE
202    INTEGER :: ind_d
203    TYPE(t_domain),POINTER :: d 
204   
205    DO ind_d=1,ndomain
206      d=>domain(ind_d)
207      d%t_right=1
208      d%t_left=-1
209      d%t_rup=d%iim
210      d%t_lup=d%iim-1
211      d%t_ldown=-d%iim
212      d%t_rdown=-d%iim+1
213     
214      d%u_right=0
215      d%u_lup=d%iim*d%jjm
216      d%u_ldown=2*d%iim*d%jjm
217     
218      d%u_rup=d%t_rup+d%u_ldown
219      d%u_left=d%t_left+d%u_right
220      d%u_rdown=d%t_rdown+d%u_lup
221     
222      d%z_up=0
223      d%z_down=d%iim*d%jjm
224      d%z_rup=d%t_rup+d%z_down
225      d%z_lup=d%t_lup+d%z_down
226      d%z_ldown=d%t_ldown+d%z_up
227      d%z_rdown=d%t_rdown+d%z_up
228     
229      d%t_pos(right)=d%t_right
230      d%t_pos(rup)=d%t_rup
231      d%t_pos(lup)=d%t_lup
232      d%t_pos(left)=d%t_left
233      d%t_pos(ldown)=d%t_ldown
234      d%t_pos(rdown)=d%t_rdown
235
236      d%u_pos(right)=d%u_right
237      d%u_pos(rup)=d%u_rup
238      d%u_pos(lup)=d%u_lup
239      d%u_pos(left)=d%u_left
240      d%u_pos(ldown)=d%u_ldown
241      d%u_pos(rdown)=d%u_rdown
242     
243      d%z_pos(vrup)=d%z_rup
244      d%z_pos(vup)=d%z_up
245      d%z_pos(vlup)=d%z_lup
246      d%z_pos(vldown)=d%z_ldown
247      d%z_pos(vdown)=d%z_down
248      d%z_pos(vrdown)=d%z_rdown
249     
250    ENDDO 
251 
252  END SUBROUTINE set_neighbour_indice
253     
254     
255         
256  SUBROUTINE compute_domain
257  IMPLICIT NONE
258 
259    CALL create_domain
260    CALL assign_cell
261    CALL compute_boundary
262    CALL set_neighbour_indice
263     
264  END SUBROUTINE compute_domain
265         
266END MODULE domain_mod 
267 
Note: See TracBrowser for help on using the repository browser.