source: codes/icosagcm/trunk/src/mpipara.F90 @ 176

Last change on this file since 176 was 171, checked in by ymipsl, 11 years ago
  • XIOS integration -

Compiling with "-with_xios" option. Adapt path to find XIOS library (arch.path)
Retro-compatible with the old output. If xios is not present, dynamico will use the standard writefield function.
Need to have the iodef.xml configuration file in the exec directory

YM
File size: 2.9 KB
Line 
1MODULE mpipara
2
3  INTEGER,SAVE :: mpi_rank
4  INTEGER,SAVE :: mpi_size
5 
6  INTEGER,SAVE :: comm_icosa
7  INTEGER,SAVE :: ierr
8  LOGICAL,SAVE :: using_mpi
9  LOGICAL,SAVE :: is_mpi_root
10 
11  INTERFACE allocate_mpi_buffer
12    MODULE PROCEDURE allocate_mpi_buffer_r2, allocate_mpi_buffer_r3,allocate_mpi_buffer_r4
13  END INTERFACE allocate_mpi_buffer
14
15CONTAINS
16
17  SUBROUTINE init_mpipara
18  USE mpi_mod
19#ifdef CPP_USING_XIOS
20  USE xios
21#endif
22  IMPLICIT NONE
23
24    using_mpi=.FALSE.
25#ifdef CPP_USING_MPI
26    using_mpi=.TRUE. 
27#endif
28   
29    IF (using_mpi) THEN
30      CALL MPI_INIT(ierr)
31
32#ifdef CPP_USING_XIOS
33      CALL xios_initialize("icosagcm",return_comm=comm_icosa)
34#else
35     comm_icosa=MPI_COMM_WORLD
36#endif
37      CALL MPI_COMM_SIZE(comm_icosa,mpi_size,ierr)
38      CALL MPI_COMM_RANK(comm_icosa,mpi_rank,ierr)
39      PRINT *, 'MPI Process ', mpi_rank, '/', mpi_size
40    ELSE
41      comm_icosa=-1
42      mpi_size=1
43      mpi_rank=0
44    ENDIF
45   
46    IF (mpi_rank==0) THEN
47      is_mpi_root=.TRUE.
48    ELSE
49      is_mpi_root=.FALSE.
50    ENDIF
51   
52  END SUBROUTINE  init_mpipara
53
54  SUBROUTINE finalize_mpipara
55  USE mpi_mod
56  IMPLICIT NONE
57   
58    IF (using_mpi) CALL MPI_FINALIZE(ierr)
59   
60   END SUBROUTINE  finalize_mpipara
61   
62
63  SUBROUTINE allocate_mpi_buffer_r2(buffer,length)
64  USE ISO_C_BINDING
65  USE mpi_mod
66  USE prec
67  IMPLICIT NONE
68    REAL(rstd), POINTER :: buffer(:)
69    INTEGER,INTENT(IN)  :: length
70
71    TYPE(C_PTR)         :: base_ptr
72    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
73    INTEGER :: real_size,ierr
74   
75    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
76    size=length*real_size
77   
78    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
79    CALL C_F_POINTER(base_ptr, buffer, (/ length /))
80
81   END SUBROUTINE allocate_mpi_buffer_r2
82
83  SUBROUTINE allocate_mpi_buffer_r3(buffer,length,dim3)
84  USE ISO_C_BINDING
85  USE mpi_mod
86  USE prec
87    IMPLICIT NONE
88    REAL(rstd), POINTER :: buffer(:,:)
89    INTEGER,INTENT(IN)  :: length
90    INTEGER,INTENT(IN)  :: dim3
91
92    TYPE(C_PTR)         :: base_ptr
93    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
94    INTEGER :: real_size,ierr
95   
96    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
97    size=length*real_size*dim3
98   
99    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
100    CALL C_F_POINTER(base_ptr, buffer, (/ length,dim3 /))
101   
102   END SUBROUTINE allocate_mpi_buffer_r3
103
104  SUBROUTINE allocate_mpi_buffer_r4(buffer,length,dim3,dim4)
105  USE ISO_C_BINDING
106  USE mpi_mod
107  USE prec
108  IMPLICIT NONE
109    REAL(rstd), POINTER :: buffer(:,:,:)
110    INTEGER,INTENT(IN)  :: length
111    INTEGER,INTENT(IN)  :: dim3
112    INTEGER,INTENT(IN)  :: dim4
113
114    TYPE(C_PTR)         :: base_ptr
115    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
116    INTEGER :: real_size,ierr
117   
118    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
119    size=length*real_size*dim3*dim4
120   
121    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
122    CALL C_F_POINTER(base_ptr, buffer, (/ length, dim3, dim4 /))
123   
124   END SUBROUTINE allocate_mpi_buffer_r4
125   
126END MODULE mpipara
Note: See TracBrowser for help on using the repository browser.