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

Last change on this file since 3557 was 2000, checked in by emillour, 6 years ago

Dynamico-physics interfaces:

  • some OpenMP fixes.
  • small bug fix: in Dynamico vertical flux is positive when upwards, but in the physics positive is downwards, so change the sign when sending values to the physics.

EM

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