Ignore:
Timestamp:
09/30/20 23:22:33 (4 years ago)
Author:
dubos
Message:

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:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/parallel/transfert_mpi_collectives.f90

    r963 r1055  
    11MODULE transfert_mpi_collectives_mod 
    2 IMPLICIT NONE 
     2  IMPLICIT NONE 
    33 
    44  INTERFACE bcast_mpi 
    5     MODULE PROCEDURE bcast_mpi_c,                                                     & 
    6                      bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, & 
    7                      bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, & 
    8                      bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4 
     5     MODULE PROCEDURE bcast_mpi_c 
     6     MODULE PROCEDURE bcast_mpi_i, bcast_mpi_i1, bcast_mpi_i2, bcast_mpi_i3, bcast_mpi_i4 
     7     MODULE PROCEDURE bcast_mpi_r, bcast_mpi_r1, bcast_mpi_r2, bcast_mpi_r3, bcast_mpi_r4 
     8     MODULE PROCEDURE bcast_mpi_l, bcast_mpi_l1, bcast_mpi_l2, bcast_mpi_l3, bcast_mpi_l4 
    99  END INTERFACE 
    1010 
    … …  
    1212 
    1313  SUBROUTINE gather_field(field_loc,field_glo) 
    14   USE field_mod 
    15   USE domain_mod 
    16   USE mpi_mod 
    17   USE mpipara 
    18   IMPLICIT NONE 
     14    USE field_mod 
     15    USE domain_mod 
     16    USE mpi_mod 
     17    USE mpipara 
    1918    TYPE(t_field),POINTER :: field_loc(:) 
    2019    TYPE(t_field),POINTER :: field_glo(:) 
    … …  
    2524 
    2625    IF (.NOT. using_mpi) THEN 
    27  
    28       DO ind_loc=1,ndomain 
    29         IF (field_loc(ind_loc)%ndim==2) field_glo(ind_loc)%rval2d=field_loc(ind_loc)%rval2d 
    30         IF (field_loc(ind_loc)%ndim==3) field_glo(ind_loc)%rval3d=field_loc(ind_loc)%rval3d 
    31         IF (field_loc(ind_loc)%ndim==4) field_glo(ind_loc)%rval4d=field_loc(ind_loc)%rval4d 
    32       ENDDO 
     26       DO ind_loc=1,ndomain 
     27          field_glo(ind_loc)%rval4d=field_loc(ind_loc)%rval4d 
     28       ENDDO 
    3329 
    3430    ELSE 
    35  
    36       nreq=ndomain 
    37       IF (mpi_rank==0) nreq=nreq+ndomain_glo 
    38       ALLOCATE(mpi_req(nreq)) 
    39       ALLOCATE(status(MPI_STATUS_SIZE,nreq)) 
    40  
    41  
    42       ireq=0 
    43       IF (mpi_rank==0) THEN 
    44         DO ind_glo=1,ndomain_glo 
     31       nreq=ndomain 
     32       IF (mpi_rank==0) nreq=nreq+ndomain_glo 
     33       ALLOCATE(mpi_req(nreq)) 
     34       ALLOCATE(status(MPI_STATUS_SIZE,nreq)) 
     35 
     36       ireq=0 
     37       IF (mpi_rank==0) THEN 
     38          DO ind_glo=1,ndomain_glo 
     39             ireq=ireq+1 
     40             CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   & 
     41                  domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
     42          ENDDO 
     43       ENDIF 
     44 
     45       DO ind_loc=1,ndomain 
    4546          ireq=ireq+1 
    46  
    47           IF (field_glo(ind_glo)%ndim==2) THEN 
    48             CALL MPI_IRECV(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   & 
    49                          domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
    50  
    51           ELSE IF (field_glo(ind_glo)%ndim==3) THEN 
    52             CALL MPI_IRECV(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   & 
    53                          domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
    54  
    55           ELSE IF (field_glo(ind_glo)%ndim==4) THEN 
    56             CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   & 
    57                          domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
    58           ENDIF 
    59  
    60         ENDDO 
    61       ENDIF 
    62  
    63       DO ind_loc=1,ndomain 
    64         ireq=ireq+1 
    65  
    66         IF (field_loc(ind_loc)%ndim==2) THEN 
    67           CALL MPI_ISEND(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   & 
    68                          0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    69         ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
    70           CALL MPI_ISEND(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   & 
    71                          0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    72         ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
    7347          CALL MPI_ISEND(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   & 
    74                          0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    75         ENDIF 
    76  
    77       ENDDO 
    78  
    79       CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 
     48               0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     49       ENDDO 
     50 
     51       CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 
    8052 
    8153    ENDIF 
    … …  
    8456 
    8557  SUBROUTINE bcast_field(field_glo) 
    86   USE field_mod 
    87   USE domain_mod 
    88   USE mpi_mod 
    89   USE mpipara 
    90   IMPLICIT NONE 
     58    USE field_mod 
     59    USE domain_mod 
     60    USE mpi_mod 
     61    USE mpipara 
    9162    TYPE(t_field),POINTER :: field_glo(:) 
    9263    INTEGER :: ind_glo 
    9364 
    94     IF (.NOT. using_mpi) THEN 
    95  
    96 ! nothing to do 
    97  
    98     ELSE 
    99  
    100       DO ind_glo=1,ndomain_glo 
    101  
    102           IF (field_glo(ind_glo)%ndim==2) THEN 
    103             CALL MPI_BCAST(field_glo(ind_glo)%rval2d, size(field_glo(ind_glo)%rval2d) , MPI_REAL8, 0, comm_icosa, ierr) 
    104           ELSE IF (field_glo(ind_glo)%ndim==3) THEN 
    105             CALL MPI_BCAST(field_glo(ind_glo)%rval3d, size(field_glo(ind_glo)%rval3d) , MPI_REAL8, 0, comm_icosa, ierr) 
    106           ELSE IF (field_glo(ind_glo)%ndim==4) THEN 
    107             CALL MPI_BCAST(field_glo(ind_glo)%rval4d, size(field_glo(ind_glo)%rval4d) , MPI_REAL8, 0, comm_icosa, ierr) 
    108           ENDIF 
    109  
    110         ENDDO 
    111       ENDIF 
     65    IF (using_mpi) THEN 
     66       DO ind_glo=1,ndomain_glo 
     67          CALL MPI_BCAST(field_glo(ind_glo)%rval4d, size(field_glo(ind_glo)%rval4d) , MPI_REAL8, 0, comm_icosa, ierr) 
     68       ENDDO 
     69    ENDIF 
    11270 
    11371  END SUBROUTINE bcast_field 
    11472 
    11573  SUBROUTINE scatter_field(field_glo,field_loc) 
    116   USE field_mod 
    117   USE domain_mod 
    118   USE mpi_mod 
    119   USE mpipara 
    120   IMPLICIT NONE 
     74    USE field_mod 
     75    USE domain_mod 
     76    USE mpi_mod 
     77    USE mpipara 
    12178    TYPE(t_field),POINTER :: field_glo(:) 
    12279    TYPE(t_field),POINTER :: field_loc(:) 
    … …  
    12784 
    12885    IF (.NOT. using_mpi) THEN 
    129  
    130       DO ind_loc=1,ndomain 
    131         IF (field_loc(ind_loc)%ndim==2) field_loc(ind_loc)%rval2d=field_glo(ind_loc)%rval2d 
    132         IF (field_loc(ind_loc)%ndim==3) field_loc(ind_loc)%rval3d=field_glo(ind_loc)%rval3d 
    133         IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d 
    134       ENDDO 
     86       DO ind_loc=1,ndomain 
     87          field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d 
     88       ENDDO 
    13589 
    13690    ELSE 
    137  
    138       nreq=ndomain 
    139       IF (mpi_rank==0) nreq=nreq+ndomain_glo 
    140       ALLOCATE(mpi_req(nreq)) 
    141       ALLOCATE(status(MPI_STATUS_SIZE,nreq)) 
    142  
    143  
    144       ireq=0 
    145       IF (mpi_rank==0) THEN 
    146         DO ind_glo=1,ndomain_glo 
     91       nreq=ndomain 
     92       IF (mpi_rank==0) nreq=nreq+ndomain_glo 
     93       ALLOCATE(mpi_req(nreq)) 
     94       ALLOCATE(status(MPI_STATUS_SIZE,nreq)) 
     95 
     96       ireq=0 
     97       IF (mpi_rank==0) THEN 
     98          DO ind_glo=1,ndomain_glo 
     99             ireq=ireq+1 
     100             CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   & 
     101                  domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
     102          ENDDO 
     103       ENDIF 
     104 
     105       DO ind_loc=1,ndomain 
    147106          ireq=ireq+1 
    148  
    149           IF (field_glo(ind_glo)%ndim==2) THEN 
    150             CALL MPI_ISEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   & 
    151                          domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
    152  
    153           ELSE IF (field_glo(ind_glo)%ndim==3) THEN 
    154             CALL MPI_ISEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   & 
    155                          domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
    156  
    157           ELSE IF (field_glo(ind_glo)%ndim==4) THEN 
    158             CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   & 
    159                          domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
    160           ENDIF 
    161  
    162         ENDDO 
    163       ENDIF 
    164  
    165       DO ind_loc=1,ndomain 
    166         ireq=ireq+1 
    167  
    168         IF (field_loc(ind_loc)%ndim==2) THEN 
    169           CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   & 
    170                          0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    171         ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
    172           CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   & 
    173                          0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    174         ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
    175107          CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   & 
    176                          0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    177         ENDIF 
    178  
    179       ENDDO 
    180  
    181       CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 
     108               0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     109       ENDDO 
     110 
     111       CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 
    182112 
    183113    ENDIF 
    … …  
    185115  END SUBROUTINE scatter_field 
    186116 
    187 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    188 !! Definition des Broadcast --> 4D   !! 
    189 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    190  
    191 !! -- Les chaine de charactï¿œre -- !! 
    192  
    193   SUBROUTINE bcast_mpi_c(var1) 
    194   IMPLICIT NONE 
    195     CHARACTER(LEN=*),INTENT(INOUT) :: Var1 
    196  
    197     CALL bcast_mpi_cgen(Var1,len(Var1)) 
    198  
    199   END SUBROUTINE bcast_mpi_c 
    200  
    201 !! -- Les entiers -- !! 
    202  
    203   SUBROUTINE bcast_mpi_i(var) 
    204   USE mpipara 
    205   IMPLICIT NONE 
    206     INTEGER,INTENT(INOUT) :: Var 
    207  
    208     INTEGER               :: var_tmp(1) 
    209  
    210     IF (is_mpi_master) var_tmp(1)=var 
    211     CALL bcast_mpi_igen(Var_tmp,1) 
    212     var=var_tmp(1) 
    213  
    214   END SUBROUTINE bcast_mpi_i 
    215  
    216   SUBROUTINE bcast_mpi_i1(var) 
    217   IMPLICIT NONE 
    218     INTEGER,INTENT(INOUT) :: Var(:) 
    219  
    220     CALL bcast_mpi_igen(Var,size(Var)) 
    221  
    222   END SUBROUTINE bcast_mpi_i1 
    223  
    224   SUBROUTINE bcast_mpi_i2(var) 
    225   IMPLICIT NONE 
    226     INTEGER,INTENT(INOUT) :: Var(:,:) 
    227  
    228     CALL bcast_mpi_igen(Var,size(Var)) 
    229  
    230   END SUBROUTINE bcast_mpi_i2 
    231  
    232   SUBROUTINE bcast_mpi_i3(var) 
    233   IMPLICIT NONE 
    234     INTEGER,INTENT(INOUT) :: Var(:,:,:) 
    235  
    236     CALL bcast_mpi_igen(Var,size(Var)) 
    237  
    238   END SUBROUTINE bcast_mpi_i3 
    239  
    240   SUBROUTINE bcast_mpi_i4(var) 
    241   IMPLICIT NONE 
    242     INTEGER,INTENT(INOUT) :: Var(:,:,:,:) 
    243  
    244     CALL bcast_mpi_igen(Var,size(Var)) 
    245  
    246   END SUBROUTINE bcast_mpi_i4 
    247  
    248  
    249 !! -- Les reels -- !! 
    250  
    251   SUBROUTINE bcast_mpi_r(var) 
    252   USE mpipara 
    253   IMPLICIT NONE 
    254     REAL,INTENT(INOUT) :: Var 
    255     REAL               :: var_tmp(1) 
    256  
    257     IF (is_mpi_master) var_tmp(1)=var 
    258     CALL bcast_mpi_rgen(Var_tmp,1) 
    259     var=var_tmp(1) 
    260  
    261   END SUBROUTINE bcast_mpi_r 
    262  
    263   SUBROUTINE bcast_mpi_r1(var) 
    264   IMPLICIT NONE 
    265     REAL,INTENT(INOUT) :: Var(:) 
    266  
    267     CALL bcast_mpi_rgen(Var,size(Var)) 
    268  
    269   END SUBROUTINE bcast_mpi_r1 
    270  
    271   SUBROUTINE bcast_mpi_r2(var) 
    272   IMPLICIT NONE 
    273     REAL,INTENT(INOUT) :: Var(:,:) 
    274  
    275     CALL bcast_mpi_rgen(Var,size(Var)) 
    276  
    277   END SUBROUTINE bcast_mpi_r2 
    278  
    279   SUBROUTINE bcast_mpi_r3(var) 
    280   IMPLICIT NONE 
    281     REAL,INTENT(INOUT) :: Var(:,:,:) 
    282  
    283     CALL bcast_mpi_rgen(Var,size(Var)) 
    284  
    285   END SUBROUTINE bcast_mpi_r3 
    286  
    287   SUBROUTINE bcast_mpi_r4(var) 
    288   IMPLICIT NONE 
    289     REAL,INTENT(INOUT) :: Var(:,:,:,:) 
    290  
    291     CALL bcast_mpi_rgen(Var,size(Var)) 
    292  
    293   END SUBROUTINE bcast_mpi_r4 
    294  
    295 !! -- Les booleans -- !! 
    296  
    297   SUBROUTINE bcast_mpi_l(var) 
    298   USE mpipara 
    299   IMPLICIT NONE 
    300     LOGICAL,INTENT(INOUT) :: Var 
    301     LOGICAL               :: var_tmp(1) 
    302  
    303     IF (is_mpi_master) var_tmp(1)=var 
    304     CALL bcast_mpi_lgen(Var_tmp,1) 
    305     var=var_tmp(1) 
    306  
    307   END SUBROUTINE bcast_mpi_l 
    308  
    309   SUBROUTINE bcast_mpi_l1(var) 
    310   IMPLICIT NONE 
    311     LOGICAL,INTENT(INOUT) :: Var(:) 
    312  
    313     CALL bcast_mpi_lgen(Var,size(Var)) 
    314  
    315   END SUBROUTINE bcast_mpi_l1 
    316  
    317   SUBROUTINE bcast_mpi_l2(var) 
    318   IMPLICIT NONE 
    319     LOGICAL,INTENT(INOUT) :: Var(:,:) 
    320  
    321     CALL bcast_mpi_lgen(Var,size(Var)) 
    322  
    323   END SUBROUTINE bcast_mpi_l2 
    324  
    325   SUBROUTINE bcast_mpi_l3(var) 
    326   IMPLICIT NONE 
    327     LOGICAL,INTENT(INOUT) :: Var(:,:,:) 
    328  
    329     CALL bcast_mpi_lgen(Var,size(Var)) 
    330  
    331   END SUBROUTINE bcast_mpi_l3 
    332  
    333   SUBROUTINE bcast_mpi_l4(var) 
    334   IMPLICIT NONE 
    335     LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) 
    336  
    337     CALL bcast_mpi_lgen(Var,size(Var)) 
    338  
    339   END SUBROUTINE bcast_mpi_l4 
    340  
    341 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    342 !! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES ! 
    343 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     117  !===================  Broadcast routines for strings ==================! 
    344118 
    345119  SUBROUTINE bcast_mpi_cgen(var,nb) 
    346120    USE mpi_mod 
    347121    USE mpipara 
    348     IMPLICIT NONE 
    349  
    350122    CHARACTER(LEN=*),INTENT(INOUT) :: Var 
    351123    INTEGER,INTENT(IN) :: nb 
    352  
    353124    IF (.NOT. using_mpi) RETURN 
    354  
    355125    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,comm_icosa,ierr) 
    356  
    357126  END SUBROUTINE bcast_mpi_cgen 
    358127 
    359  
     128  SUBROUTINE bcast_mpi_c(var1) 
     129    CHARACTER(LEN=*),INTENT(INOUT) :: Var1 
     130    CALL bcast_mpi_cgen(Var1,len(Var1)) 
     131  END SUBROUTINE bcast_mpi_c 
     132 
     133  !============= Broadcast routines for INTEGER scalars and arrays ============! 
    360134 
    361135  SUBROUTINE bcast_mpi_igen(var,nb) 
    362136    USE mpi_mod 
    363137    USE mpipara 
    364     IMPLICIT NONE 
    365     INTEGER,INTENT(IN) :: nb 
    366     INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var 
    367  
    368     IF (.NOT. using_mpi) RETURN 
    369  
    370     CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,comm_icosa,ierr) 
    371  
     138    INTEGER, INTENT(IN) :: nb 
     139    INTEGER, DIMENSION(nb), INTENT(INOUT) :: var 
     140    IF (using_mpi) CALL MPI_BCAST(Var, nb, MPI_INTEGER, mpi_master, comm_icosa, ierr) 
    372141  END SUBROUTINE bcast_mpi_igen 
    373142 
    374  
    375  
     143  SUBROUTINE bcast_mpi_i(var) 
     144    USE mpipara 
     145    INTEGER, INTENT(INOUT) :: var 
     146    INTEGER                :: var_tmp(1) 
     147    IF (is_mpi_master) var_tmp(1)=var 
     148    CALL bcast_mpi_igen(var_tmp,1) 
     149    var=var_tmp(1) 
     150  END SUBROUTINE bcast_mpi_i 
     151 
     152  SUBROUTINE bcast_mpi_i1(var) 
     153    INTEGER, INTENT(INOUT) :: var(:) 
     154    CALL bcast_mpi_igen(var,size(var)) 
     155  END SUBROUTINE bcast_mpi_i1 
     156 
     157  SUBROUTINE bcast_mpi_i2(var) 
     158    INTEGER, INTENT(INOUT) :: var(:,:) 
     159    CALL bcast_mpi_igen(var,size(var)) 
     160  END SUBROUTINE bcast_mpi_i2 
     161 
     162  SUBROUTINE bcast_mpi_i3(var) 
     163    INTEGER, INTENT(INOUT) :: var(:,:,:) 
     164    CALL bcast_mpi_igen(var,size(var)) 
     165  END SUBROUTINE bcast_mpi_i3 
     166 
     167  SUBROUTINE bcast_mpi_i4(var) 
     168    INTEGER, INTENT(INOUT) :: var(:,:,:,:) 
     169    CALL bcast_mpi_igen(var,size(var)) 
     170  END SUBROUTINE bcast_mpi_i4 
     171 
     172  !============= Broadcast routines for REAL scalars and arrays ============! 
    376173 
    377174  SUBROUTINE bcast_mpi_rgen(var,nb) 
    378175    USE mpi_mod 
    379176    USE mpipara 
    380     IMPLICIT NONE 
    381     INTEGER,INTENT(IN) :: nb 
    382     REAL,DIMENSION(nb),INTENT(INOUT) :: Var 
    383  
    384     IF (.NOT. using_mpi) RETURN 
    385  
    386     CALL MPI_BCAST(Var,nb,MPI_REAL8,mpi_master,comm_icosa,ierr) 
    387  
     177    INTEGER, INTENT(IN) :: nb 
     178    REAL, DIMENSION(nb), INTENT(INOUT) :: var 
     179    IF (using_mpi) CALL MPI_BCAST(Var, nb, MPI_REAL8, mpi_master, comm_icosa, ierr) 
    388180  END SUBROUTINE bcast_mpi_rgen 
    389181 
    390  
    391  
     182  SUBROUTINE bcast_mpi_r(var) 
     183    USE mpipara 
     184    REAL, INTENT(INOUT) :: var 
     185    REAL                :: var_tmp(1) 
     186    IF (is_mpi_master) var_tmp(1)=var 
     187    CALL bcast_mpi_rgen(var_tmp,1) 
     188    var=var_tmp(1) 
     189  END SUBROUTINE bcast_mpi_r 
     190 
     191  SUBROUTINE bcast_mpi_r1(var) 
     192    REAL, INTENT(INOUT) :: var(:) 
     193    CALL bcast_mpi_rgen(var,size(var)) 
     194  END SUBROUTINE bcast_mpi_r1 
     195 
     196  SUBROUTINE bcast_mpi_r2(var) 
     197    REAL, INTENT(INOUT) :: var(:,:) 
     198    CALL bcast_mpi_rgen(var,size(var)) 
     199  END SUBROUTINE bcast_mpi_r2 
     200 
     201  SUBROUTINE bcast_mpi_r3(var) 
     202    REAL, INTENT(INOUT) :: var(:,:,:) 
     203    CALL bcast_mpi_rgen(var,size(var)) 
     204  END SUBROUTINE bcast_mpi_r3 
     205 
     206  SUBROUTINE bcast_mpi_r4(var) 
     207    REAL, INTENT(INOUT) :: var(:,:,:,:) 
     208    CALL bcast_mpi_rgen(var,size(var)) 
     209  END SUBROUTINE bcast_mpi_r4 
     210 
     211  !============= Broadcast routines for LOGICAL scalars and arrays ============! 
    392212 
    393213  SUBROUTINE bcast_mpi_lgen(var,nb) 
    394214    USE mpi_mod 
    395215    USE mpipara 
    396     IMPLICIT NONE 
    397     INTEGER,INTENT(IN) :: nb 
    398     LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var 
    399  
    400     IF (.NOT. using_mpi) RETURN 
    401  
    402     CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,comm_icosa,ierr) 
    403  
     216    INTEGER, INTENT(IN) :: nb 
     217    LOGICAL, DIMENSION(nb), INTENT(INOUT) :: var 
     218    IF (using_mpi) CALL MPI_BCAST(Var, nb, MPI_LOGICAL, mpi_master, comm_icosa, ierr) 
    404219  END SUBROUTINE bcast_mpi_lgen 
    405220 
     221  SUBROUTINE bcast_mpi_l(var) 
     222    USE mpipara 
     223    LOGICAL, INTENT(INOUT) :: var 
     224    LOGICAL                :: var_tmp(1) 
     225    IF (is_mpi_master) var_tmp(1)=var 
     226    CALL bcast_mpi_lgen(var_tmp,1) 
     227    var=var_tmp(1) 
     228  END SUBROUTINE bcast_mpi_l 
     229 
     230  SUBROUTINE bcast_mpi_l1(var) 
     231    LOGICAL, INTENT(INOUT) :: var(:) 
     232    CALL bcast_mpi_lgen(var,size(var)) 
     233  END SUBROUTINE bcast_mpi_l1 
     234 
     235  SUBROUTINE bcast_mpi_l2(var) 
     236    LOGICAL, INTENT(INOUT) :: var(:,:) 
     237    CALL bcast_mpi_lgen(var,size(var)) 
     238  END SUBROUTINE bcast_mpi_l2 
     239 
     240  SUBROUTINE bcast_mpi_l3(var) 
     241    LOGICAL, INTENT(INOUT) :: var(:,:,:) 
     242    CALL bcast_mpi_lgen(var,size(var)) 
     243  END SUBROUTINE bcast_mpi_l3 
     244 
     245  SUBROUTINE bcast_mpi_l4(var) 
     246    LOGICAL, INTENT(INOUT) :: var(:,:,:,:) 
     247    CALL bcast_mpi_lgen(var,size(var)) 
     248  END SUBROUTINE bcast_mpi_l4 
    406249 
    407250END MODULE transfert_mpi_collectives_mod 
    408  
    409  
    410  
    411  
    412  
Note: See TracChangeset for help on using the changeset viewer.