source: trunk/ICOSA_LMDZ/src/distrib_icosa_lmdz.f90 @ 3628

Last change on this file since 3628 was 3626, checked in by emillour, 10 days ago

Dynamico-Mars:
Cleanup: add some "only" clauses to all the "use" to help
identifying connections between Dynamico, the interface and the physics.
EM
File size: 7.2 KB
Line 
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! from LMDZ
29  USE mod_phys_lmdz_omp_data, ONLY: klon_omp_begin, klon_omp_end
30! from dynamico
31  USE domain_mod, ONLY: domain, ndomain
32  USE dimensions, ONLY: ii_begin, ii_end, jj_begin, jj_end, iim
33  USE dimensions, ONLY: swap_dimensions
34  IMPLICIT NONE
35    INTEGER :: pos,pos_tmp,nindex
36    INTEGER :: ind, i,j,ij
37   
38    ALLOCATE(distrib_physic(ndomain))
39   
40    ndomain_distrib=0
41    pos=0
42    DO ind=1,ndomain
43      CALL swap_dimensions(ind)
44
45! first guess to determine number of indices for this domain
46      pos_tmp=pos
47      nindex=0
48      DO j=jj_begin,jj_end
49        DO i=ii_begin,ii_end
50          IF (domain(ind)%own(i,j)) THEN
51            pos_tmp=pos_tmp+1
52            IF (pos_tmp >= klon_omp_begin .AND. pos_tmp <= klon_omp_end) nindex=nindex+1
53          ENDIF
54        ENDDO
55      ENDDO
56
57! fill the index array
58
59      IF (nindex>0) THEN
60        ndomain_distrib=ndomain_distrib+1
61        ALLOCATE(distrib_physic(ndomain_distrib)%index(nindex))
62        distrib_physic(ndomain_distrib)%nindex=nindex
63        distrib_physic(ndomain_distrib)%domain_ind=ind
64       
65        nindex=0
66        DO j=jj_begin,jj_end
67          DO i=ii_begin,ii_end
68            ij=(j-1)*iim+i
69            IF (domain(ind)%own(i,j)) THEN
70              pos=pos+1
71              IF (pos >= klon_omp_begin .AND. pos <= klon_omp_end) THEN
72                nindex=nindex+1
73                distrib_physic(ndomain_distrib)%index(nindex)=ij
74              ENDIF
75            ENDIF
76          ENDDO
77        ENDDO
78      ELSE
79        pos=pos_tmp
80      ENDIF
81   
82    ENDDO
83       
84  END SUBROUTINE init_distrib_icosa_lmdz
85                 
86  SUBROUTINE transfer_icosa_to_lmdz1d(f_field_icosa, field_lmdz)
87! from dynamico
88  USE prec, ONLY: rstd
89  USE field_mod, ONLY: t_field, ASSIGNMENT(=)
90  IMPLICIT NONE
91    TYPE(t_field),POINTER :: f_field_icosa(:)
92    REAL(rstd)         :: field_lmdz(:)
93    REAL(rstd),POINTER :: field_icosa(:)
94    INTEGER         :: pos, nindex,ind,i
95    INTEGER,POINTER :: index(:)
96   
97!$OMP BARRIER
98    pos=0
99    DO ind=1,ndomain_distrib
100      field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
101      index=>distrib_physic(ind)%index
102      nindex=distrib_physic(ind)%nindex
103      DO i=1,nindex
104        pos=pos+1
105        field_lmdz(pos)=field_icosa(index(i))
106      ENDDO
107    ENDDO
108   
109  END SUBROUTINE  transfer_icosa_to_lmdz1d
110 
111  SUBROUTINE transfer_icosa_to_lmdz2d(f_field_icosa, field_lmdz)
112! from dynamico
113  USE prec, ONLY: rstd
114  USE field_mod, ONLY: t_field, ASSIGNMENT(=)
115  IMPLICIT NONE
116    TYPE(t_field),POINTER :: f_field_icosa(:)
117    REAL(rstd)         :: field_lmdz(:,:)
118
119    REAL(rstd),POINTER :: field_icosa(:,:)
120    INTEGER         :: pos, nindex,ind,i
121    INTEGER,POINTER :: index(:)
122    INTEGER :: l
123   
124!$OMP BARRIER
125    DO l=1,size(field_lmdz,2) 
126      pos=0
127      DO ind=1,ndomain_distrib
128        field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
129        index=>distrib_physic(ind)%index
130        nindex=distrib_physic(ind)%nindex
131        DO i=1,nindex
132          pos=pos+1
133          field_lmdz(pos,l)=field_icosa(index(i),l)
134        ENDDO
135      ENDDO
136    ENDDO
137   
138  END SUBROUTINE  transfer_icosa_to_lmdz2d
139
140
141   
142  SUBROUTINE transfer_icosa_to_lmdz3d(f_field_icosa, field_lmdz)
143! from dynamico
144  USE prec, ONLY: rstd
145  USE field_mod, ONLY: t_field, ASSIGNMENT(=)
146  IMPLICIT NONE
147    TYPE(t_field),POINTER :: f_field_icosa(:)
148    REAL(rstd)         :: field_lmdz(:,:,:)
149    REAL(rstd),POINTER :: field_icosa(:,:,:)
150    INTEGER         :: pos, nindex,ind,i
151    INTEGER,POINTER :: index(:)
152    INTEGER :: l,q
153
154!$OMP BARRIER
155    DO q=1,size(field_lmdz,3) 
156      DO l=1,size(field_lmdz,2) 
157        pos=0
158        DO ind=1,ndomain_distrib
159          field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
160          index=>distrib_physic(ind)%index
161          nindex=distrib_physic(ind)%nindex
162          DO i=1,nindex
163            pos=pos+1
164            field_lmdz(pos,l,q)=field_icosa(index(i),l,q)
165          ENDDO
166        ENDDO
167      ENDDO
168    ENDDO
169   
170  END SUBROUTINE  transfer_icosa_to_lmdz3d
171     
172  SUBROUTINE transfer_lmdz1d_to_icosa(field_lmdz,f_field_icosa)
173! from dynamico
174  USE prec, ONLY: rstd
175  USE field_mod, ONLY: t_field, ASSIGNMENT(=)
176  IMPLICIT NONE
177    REAL(rstd)         :: field_lmdz(:)
178    TYPE(t_field),POINTER :: f_field_icosa(:)
179    REAL(rstd),POINTER :: field_icosa(:)
180    INTEGER         :: pos, nindex,ind,i
181    INTEGER,POINTER :: index(:)
182   
183!$OMP BARRIER
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_icosa(index(i))=field_lmdz(pos)
192      ENDDO
193    ENDDO
194  END SUBROUTINE  transfer_lmdz1d_to_icosa
195
196  SUBROUTINE transfer_lmdz2d_to_icosa(field_lmdz,f_field_icosa)
197! from dynamico
198  USE prec, ONLY: rstd
199  USE field_mod, ONLY: t_field, ASSIGNMENT(=)
200  IMPLICIT NONE
201    REAL(rstd)         :: field_lmdz(:,:)
202    TYPE(t_field),POINTER :: f_field_icosa(:)
203    REAL(rstd),POINTER :: field_icosa(:,:)
204    INTEGER         :: pos, nindex,ind,i
205    INTEGER,POINTER :: index(:)
206    INTEGER :: l
207   
208!$OMP BARRIER
209    DO l=1,size(field_lmdz,2) 
210      pos=0
211      DO ind=1,ndomain_distrib
212        field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
213        index=>distrib_physic(ind)%index
214        nindex=distrib_physic(ind)%nindex
215        DO i=1,nindex
216          pos=pos+1
217          field_icosa(index(i),l)=field_lmdz(pos,l)
218        ENDDO
219      ENDDO
220    ENDDO
221 
222  END SUBROUTINE transfer_lmdz2d_to_icosa   
223
224
225  SUBROUTINE transfer_lmdz3d_to_icosa(field_lmdz,f_field_icosa)
226! from dynamico
227  USE prec, ONLY: rstd
228  USE field_mod, ONLY: t_field, ASSIGNMENT(=)
229  IMPLICIT NONE
230    REAL(rstd)         :: field_lmdz(:,:,:)
231    TYPE(t_field),POINTER :: f_field_icosa(:)
232    REAL(rstd),POINTER :: field_icosa(:,:,:)
233    INTEGER         :: pos, nindex,ind,i
234    INTEGER,POINTER :: index(:)
235    INTEGER :: l,q
236   
237!$OMP BARRIER
238    DO q=1,size(field_lmdz,3) 
239      DO l=1,size(field_lmdz,2) 
240        pos=0
241        DO ind=1,ndomain_distrib
242          field_icosa=f_field_icosa(distrib_physic(ind)%domain_ind)
243          index=>distrib_physic(ind)%index
244          nindex=distrib_physic(ind)%nindex
245          DO i=1,nindex
246            pos=pos+1
247            field_icosa(index(i),l,q)=field_lmdz(pos,l,q)
248          ENDDO
249        ENDDO
250      ENDDO
251    ENDDO
252 
253  END SUBROUTINE transfer_lmdz3d_to_icosa   
254
255END MODULE distrib_icosa_lmdz_mod
Note: See TracBrowser for help on using the repository browser.