source: ICOSA_LMDZ/src/distrib_icosa_lmdz.f90 @ 4738

Last change on this file since 4738 was 4498, checked in by Laurent Fairhead, 20 months ago

Switching repository for the LMDZ / DYNAMICO interface from HEAT to LMDZ
Initial revision immported is 457
File size: 8.3 KB
RevLine 
[4498]1MODULE distrib_icosa_lmdz_mod
2 
3  TYPE t_distrib_physic
4    INTEGER,POINTER :: index(:)    ! list of index used for thread entering in lmdz physic
5    INTEGER         :: nindex      ! number of index used
6    INTEGER         :: domain_ind  ! index of the related domain
7  END TYPE t_distrib_physic
8 
9  INTEGER, SAVE :: ndomain_distrib    ! number of domain needed for thread data
10!$OMP THREADPRIVATE(ndomain_distrib)
11
12  TYPE(t_distrib_physic),ALLOCATABLE, SAVE :: distrib_physic(:)
13!$OMP THREADPRIVATE(distrib_physic) 
14
15
16  INTERFACE transfer_icosa_to_lmdz
17    MODULE PROCEDURE transfer_icosa_to_lmdz1d,transfer_icosa_to_lmdz2d,transfer_icosa_to_lmdz3d
18  END INTERFACE transfer_icosa_to_lmdz
19
20  INTERFACE transfer_lmdz_to_icosa
21    MODULE PROCEDURE transfer_lmdz1d_to_icosa,transfer_lmdz2d_to_icosa,transfer_lmdz3d_to_icosa
22  END INTERFACE transfer_lmdz_to_icosa
23     
24CONTAINS
25
26
27  SUBROUTINE init_distrib_icosa_lmdz
28  USE mod_phys_lmdz_omp_data, ONLY: klon_omp_begin, klon_omp_end
29  USE domain_mod
30  USE dimensions
31  USE nudging_mod, ONLY : lam_halo_scheme
32  IMPLICIT NONE
33    INTEGER :: pos,pos_tmp,nindex
34    INTEGER :: ind, i,j,ij,h
35    LOGICAL,ALLOCATABLE :: outside(:,:)
36    LOGICAL,ALLOCATABLE :: outside_tmp(:,:)
37    LOGICAL,POINTER :: out(:,:)
38    ALLOCATE(distrib_physic(ndomain))
39   
40    ndomain_distrib=0
41    pos=0
42    DO ind=1,ndomain
43      CALL swap_dimensions(ind)
44      ALLOCATE(outside(ii_begin:ii_end,jj_begin:jj_end)) ! for limited area
45      ALLOCATE(outside_tmp(ii_begin-1:ii_end+1,jj_begin-1:jj_end+1)) ! for limited area
46      out=>domain(ind)%outside
47      DO j=jj_begin,jj_end
48        DO i=ii_begin,ii_end
49          outside(i,j)=  out(i+1,j)     .OR. & ! right
50                         out(i,j+1    ) .OR. & ! rup
51                         out(i-1  ,j+1) .OR. & ! lup
52                         out(i-1  ,j)   .OR. & !left
53                         out(i    ,j-1) .OR. & !ldown
54                         out(i+1,j-1)          !rdown   
55        ENDDO
56      ENDDO
57      outside_tmp=.FALSE.
58      outside_tmp(ii_begin:ii_end,jj_begin:jj_end)=outside
59     
60      DO h=1,lam_halo_scheme-1 ! do not compute physic on limited area halo
61        DO j=jj_begin,jj_end
62          DO i=ii_begin,ii_end
63              outside(i,j) = outside_tmp(i,j)       .OR. &
64                             outside_tmp(i+1,j)     .OR. & ! right
65                             outside_tmp(i,j+1    ) .OR. & ! rup
66                             outside_tmp(i-1  ,j+1) .OR. & ! lup
67                             outside_tmp(i-1  ,j)   .OR. & !left
68                             outside_tmp(i    ,j-1) .OR. & !ldown
69                             outside_tmp(i+1,j-1)          !rdown
70          ENDDO
71        ENDDO
72        outside_tmp(ii_begin:ii_end,jj_begin:jj_end)=outside
73      ENDDO
74     
75     
76! first guess to determine number of indices for this domain
77      pos_tmp=pos
78      nindex=0
79      DO j=jj_begin,jj_end
80        DO i=ii_begin,ii_end
81          IF (domain(ind)%own(i,j) .AND. .NOT. outside(i,j)) THEN
82            pos_tmp=pos_tmp+1
83            IF (pos_tmp >= klon_omp_begin .AND. pos_tmp <= klon_omp_end) nindex=nindex+1
84          ENDIF
85        ENDDO
86      ENDDO
87
88! fill the index array
89
90      IF (nindex>0) THEN
91        ndomain_distrib=ndomain_distrib+1
92        ALLOCATE(distrib_physic(ndomain_distrib)%index(nindex))
93        distrib_physic(ndomain_distrib)%nindex=nindex
94        distrib_physic(ndomain_distrib)%domain_ind=ind
95       
96        nindex=0
97        DO j=jj_begin,jj_end
98          DO i=ii_begin,ii_end
99            ij=(j-1)*iim+i
100            IF (domain(ind)%own(i,j) .AND. .NOT. outside(i,j)) THEN
101              pos=pos+1
102              IF (pos >= klon_omp_begin .AND. pos <= klon_omp_end) THEN
103                nindex=nindex+1
104                distrib_physic(ndomain_distrib)%index(nindex)=ij
105              ENDIF
106            ENDIF
107          ENDDO
108        ENDDO
109      ELSE
110        pos=pos_tmp
111      ENDIF
112   
113      DEALLOCATE(outside)
114      DEALLOCATE(outside_tmp)
115    ENDDO
116       
117  END SUBROUTINE init_distrib_icosa_lmdz
118                 
119  SUBROUTINE transfer_icosa_to_lmdz1d(f_field_icosa, field_lmdz)
120  USE field_mod
121  IMPLICIT NONE
122    TYPE(t_field),POINTER :: f_field_icosa(:)
123    REAL(rstd)         :: field_lmdz(:)
124    REAL(rstd),POINTER :: field_icosa(:)
125    INTEGER         :: pos, nindex,ind,i
126    INTEGER,POINTER :: index(:)
127   
128!$OMP BARRIER
129    pos=0
130    DO ind=1,ndomain_distrib
131      field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
132      index=>distrib_physic(ind)%index
133      nindex=distrib_physic(ind)%nindex
134      DO i=1,nindex
135        pos=pos+1
136        field_lmdz(pos)=field_icosa(index(i))
137      ENDDO
138    ENDDO
139   
140  END SUBROUTINE  transfer_icosa_to_lmdz1d
141 
142  SUBROUTINE transfer_icosa_to_lmdz2d(f_field_icosa, field_lmdz)
143  USE field_mod
144  IMPLICIT NONE
145    TYPE(t_field),POINTER :: f_field_icosa(:)
146    REAL(rstd)         :: field_lmdz(:,:)
147
148    REAL(rstd),POINTER :: field_icosa(:,:)
149    INTEGER         :: pos, nindex,ind,i
150    INTEGER,POINTER :: index(:)
151    INTEGER :: l
152   
153!$OMP BARRIER
154    DO l=1,size(field_lmdz,2) 
155      pos=0
156      DO ind=1,ndomain_distrib
157        field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
158        index=>distrib_physic(ind)%index
159        nindex=distrib_physic(ind)%nindex
160        DO i=1,nindex
161          pos=pos+1
162          field_lmdz(pos,l)=field_icosa(index(i),l)
163        ENDDO
164      ENDDO
165    ENDDO
166   
167  END SUBROUTINE  transfer_icosa_to_lmdz2d
168
169
170   
171  SUBROUTINE transfer_icosa_to_lmdz3d(f_field_icosa, field_lmdz)
172  USE field_mod
173  IMPLICIT NONE
174    TYPE(t_field),POINTER :: f_field_icosa(:)
175    REAL(rstd)         :: field_lmdz(:,:,:)
176    REAL(rstd),POINTER :: field_icosa(:,:,:)
177    INTEGER         :: pos, nindex,ind,i
178    INTEGER,POINTER :: index(:)
179    INTEGER :: l,q
180
181!$OMP BARRIER
182    DO q=1,size(field_lmdz,3) 
183      DO l=1,size(field_lmdz,2) 
184        pos=0
185        DO ind=1,ndomain_distrib
186          field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
187          index=>distrib_physic(ind)%index
188          nindex=distrib_physic(ind)%nindex
189          DO i=1,nindex
190            pos=pos+1
191            field_lmdz(pos,l,q)=field_icosa(index(i),l,q)
192          ENDDO
193        ENDDO
194      ENDDO
195    ENDDO
196   
197  END SUBROUTINE  transfer_icosa_to_lmdz3d
198     
199  SUBROUTINE transfer_lmdz1d_to_icosa(field_lmdz,f_field_icosa)
200  USE field_mod
201  IMPLICIT NONE
202    REAL(rstd)         :: field_lmdz(:)
203    TYPE(t_field),POINTER :: f_field_icosa(:)
204    REAL(rstd),POINTER :: field_icosa(:)
205    INTEGER         :: pos, nindex,ind,i
206    INTEGER,POINTER :: index(:)
207   
208!$OMP BARRIER
209    pos=0
210    DO ind=1,ndomain_distrib
211      field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
212      index=>distrib_physic(ind)%index
213      nindex=distrib_physic(ind)%nindex
214      DO i=1,nindex
215        pos=pos+1
216        field_icosa(index(i))=field_lmdz(pos)
217      ENDDO
218    ENDDO
219  END SUBROUTINE  transfer_lmdz1d_to_icosa
220
221  SUBROUTINE transfer_lmdz2d_to_icosa(field_lmdz,f_field_icosa)
222  USE field_mod
223  IMPLICIT NONE
224    REAL(rstd)         :: field_lmdz(:,:)
225    TYPE(t_field),POINTER :: f_field_icosa(:)
226    REAL(rstd),POINTER :: field_icosa(:,:)
227    INTEGER         :: pos, nindex,ind,i
228    INTEGER,POINTER :: index(:)
229    INTEGER :: l
230   
231!$OMP BARRIER
232    DO l=1,size(field_lmdz,2) 
233      pos=0
234      DO ind=1,ndomain_distrib
235        field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
236        index=>distrib_physic(ind)%index
237        nindex=distrib_physic(ind)%nindex
238        DO i=1,nindex
239          pos=pos+1
240          field_icosa(index(i),l)=field_lmdz(pos,l)
241        ENDDO
242      ENDDO
243    ENDDO
244 
245  END SUBROUTINE transfer_lmdz2d_to_icosa   
246
247
248  SUBROUTINE transfer_lmdz3d_to_icosa(field_lmdz,f_field_icosa)
249  USE field_mod
250  IMPLICIT NONE
251    REAL(rstd)         :: field_lmdz(:,:,:)
252    TYPE(t_field),POINTER :: f_field_icosa(:)
253    REAL(rstd),POINTER :: field_icosa(:,:,:)
254    INTEGER         :: pos, nindex,ind,i
255    INTEGER,POINTER :: index(:)
256    INTEGER :: l,q
257   
258!$OMP BARRIER
259    DO q=1,size(field_lmdz,3) 
260      DO l=1,size(field_lmdz,2) 
261        pos=0
262        DO ind=1,ndomain_distrib
263          field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
264          index=>distrib_physic(ind)%index
265          nindex=distrib_physic(ind)%nindex
266          DO i=1,nindex
267            pos=pos+1
268            field_icosa(index(i),l,q)=field_lmdz(pos,l,q)
269          ENDDO
270        ENDDO
271      ENDDO
272    ENDDO
273 
274  END SUBROUTINE transfer_lmdz3d_to_icosa   
275
276END MODULE distrib_icosa_lmdz_mod
Note: See TracBrowser for help on using the repository browser.