source: codes/icosagcm/trunk/jsrc/parallel/transfert_mpi_collectives.f90 @ 1055

Last change on this file since 1055 was 1055, checked in by dubos, 4 years ago

Simplify base/field.f90 to reduce repetitive code
Generate remaining repetitive code in base/field.f90 and parallel/transfert_mpi_collectives from a template
File size: 4.8 KB
Line 
1MODULE transfert_mpi_collectives_mod
2  IMPLICIT NONE
3
4  {%- set ranks = ( (1,':'), (2,':,:'), (3,':,:,:'), (4,':,:,:,:') ) %}
5  {%- set types = ( ('i','INTEGER','MPI_INTEGER'),
6  ('r','REAL','MPI_REAL8'), ('l','LOGICAL','MPI_LOGICAL') ) %}
7
8  INTERFACE bcast_mpi
9     MODULE PROCEDURE bcast_mpi_c
10     {%- for tn, tp, mpi in types %}
11     MODULE PROCEDURE bcast_mpi_{{tn}} {%- for rk, junk in ranks %}, bcast_mpi_{{tn}}{{rk}} {%- endfor %}
12     {%- endfor %}
13  END INTERFACE bcast_mpi
14
15CONTAINS
16
17  SUBROUTINE gather_field(field_loc,field_glo)
18    USE field_mod
19    USE domain_mod
20    USE mpi_mod
21    USE mpipara
22    TYPE(t_field),POINTER :: field_loc(:)
23    TYPE(t_field),POINTER :: field_glo(:)
24    INTEGER, ALLOCATABLE :: mpi_req(:)
25    INTEGER, ALLOCATABLE :: status(:,:)
26    INTEGER :: ireq,nreq
27    INTEGER :: ind_glo,ind_loc
28
29    IF (.NOT. using_mpi) THEN
30       DO ind_loc=1,ndomain
31          field_glo(ind_loc)%rval4d=field_loc(ind_loc)%rval4d
32       ENDDO
33
34    ELSE
35       nreq=ndomain
36       IF (mpi_rank==0) nreq=nreq+ndomain_glo
37       ALLOCATE(mpi_req(nreq))
38       ALLOCATE(status(MPI_STATUS_SIZE,nreq))
39
40       ireq=0
41       IF (mpi_rank==0) THEN
42          DO ind_glo=1,ndomain_glo
43             ireq=ireq+1
44             CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
45                  domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
46          ENDDO
47       ENDIF
48
49       DO ind_loc=1,ndomain
50          ireq=ireq+1
51          CALL MPI_ISEND(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
52               0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
53       ENDDO
54
55       CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
56
57    ENDIF
58
59  END SUBROUTINE gather_field
60
61  SUBROUTINE bcast_field(field_glo)
62    USE field_mod
63    USE domain_mod
64    USE mpi_mod
65    USE mpipara
66    TYPE(t_field),POINTER :: field_glo(:)
67    INTEGER :: ind_glo
68
69    IF (using_mpi) THEN
70       DO ind_glo=1,ndomain_glo
71          CALL MPI_BCAST(field_glo(ind_glo)%rval4d, size(field_glo(ind_glo)%rval4d) , MPI_REAL8, 0, comm_icosa, ierr)
72       ENDDO
73    ENDIF
74
75  END SUBROUTINE bcast_field
76
77  SUBROUTINE scatter_field(field_glo,field_loc)
78    USE field_mod
79    USE domain_mod
80    USE mpi_mod
81    USE mpipara
82    TYPE(t_field),POINTER :: field_glo(:)
83    TYPE(t_field),POINTER :: field_loc(:)
84    INTEGER, ALLOCATABLE :: mpi_req(:)
85    INTEGER, ALLOCATABLE :: status(:,:)
86    INTEGER :: ireq,nreq
87    INTEGER :: ind_glo,ind_loc
88
89    IF (.NOT. using_mpi) THEN
90       DO ind_loc=1,ndomain
91          field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d
92       ENDDO
93
94    ELSE
95       nreq=ndomain
96       IF (mpi_rank==0) nreq=nreq+ndomain_glo
97       ALLOCATE(mpi_req(nreq))
98       ALLOCATE(status(MPI_STATUS_SIZE,nreq))
99
100       ireq=0
101       IF (mpi_rank==0) THEN
102          DO ind_glo=1,ndomain_glo
103             ireq=ireq+1
104             CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
105                  domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
106          ENDDO
107       ENDIF
108       
109       DO ind_loc=1,ndomain
110          ireq=ireq+1
111          CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
112               0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
113       ENDDO
114       
115       CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
116
117    ENDIF
118
119  END SUBROUTINE scatter_field
120
121  !===================  Broadcast routines for strings ==================!
122
123  SUBROUTINE bcast_mpi_cgen(var,nb)
124    USE mpi_mod
125    USE mpipara
126    CHARACTER(LEN=*),INTENT(INOUT) :: Var
127    INTEGER,INTENT(IN) :: nb
128    IF (.NOT. using_mpi) RETURN
129    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,comm_icosa,ierr)
130  END SUBROUTINE bcast_mpi_cgen
131
132  SUBROUTINE bcast_mpi_c(var1)
133    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
134    CALL bcast_mpi_cgen(Var1,len(Var1))
135  END SUBROUTINE bcast_mpi_c
136 
137  {%- for tn, tp, mpi in types %}
138
139  !============= Broadcast routines for {{tp}} scalars and arrays ============!
140
141  SUBROUTINE bcast_mpi_{{tn}}gen(var,nb)
142    USE mpi_mod
143    USE mpipara
144    INTEGER, INTENT(IN) :: nb
145    {{tp}}, DIMENSION(nb), INTENT(INOUT) :: var
146    IF (using_mpi) CALL MPI_BCAST(Var, nb, {{mpi}}, mpi_master, comm_icosa, ierr)
147  END SUBROUTINE bcast_mpi_{{tn}}gen
148
149  SUBROUTINE bcast_mpi_{{tn}}(var)
150    USE mpipara
151    {{tp}}, INTENT(INOUT) :: var
152    {{tp}}                :: var_tmp(1)
153    IF (is_mpi_master) var_tmp(1)=var
154    CALL bcast_mpi_{{tn}}gen(var_tmp,1)
155    var=var_tmp(1)
156  END SUBROUTINE bcast_mpi_{{tn}}
157
158  {%- for rank, shape in ranks %}
159
160  SUBROUTINE bcast_mpi_{{tn}}{{rank}}(var)
161    {{tp}}, INTENT(INOUT) :: var({{shape}})
162    CALL bcast_mpi_{{tn}}gen(var,size(var))
163  END SUBROUTINE bcast_mpi_{{tn}}{{rank}}
164  {%- endfor %}
165  {%- endfor %}
166
167END MODULE transfert_mpi_collectives_mod
Note: See TracBrowser for help on using the repository browser.