Changeset 4628 for palm/trunk/SOURCE/shared_memory_io_mod.f90
- Timestamp:
- Jul 29, 2020 7:23:03 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/shared_memory_io_mod.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/shared_memory_io_mod.f90
r4620 r4628 25 25 ! ----------------- 26 26 ! $Id$ 27 ! extensions required for MPI-I/O of particle data to restart files 28 ! 29 ! 4620 2020-07-22 14:11:16Z raasch 27 30 ! bugfix: variable definition changed 28 31 ! … … 85 88 USE kinds, & 86 89 ONLY: dp, & 90 idp, & 91 isp, & 87 92 iwp, & 88 93 sp, & … … 192 197 PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3d_64 193 198 PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3d_32 199 PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3di_32 200 PROCEDURE, PASS(this), PUBLIC :: sm_allocate_shared_3di_64 194 201 195 202 GENERIC, PUBLIC :: sm_allocate_shared => & 196 sm_allocate_shared_1d_64, sm_allocate_shared_1d_32, & 197 sm_allocate_shared_2d_64, sm_allocate_shared_2d_32, & 198 sm_allocate_shared_2di, sm_allocate_shared_3d_64, & 199 sm_allocate_shared_3d_32, sm_allocate_shared_1di 203 sm_allocate_shared_1d_64, sm_allocate_shared_1d_32, & 204 sm_allocate_shared_2d_64, sm_allocate_shared_2d_32, & 205 sm_allocate_shared_2di, sm_allocate_shared_3d_64, & 206 sm_allocate_shared_3d_32, sm_allocate_shared_1di, & 207 sm_allocate_shared_3di_32, sm_allocate_shared_3di_64 200 208 #endif 201 209 END TYPE sm_class … … 1030 1038 END SUBROUTINE sm_allocate_shared_3d_32 1031 1039 1040 1041 !--------------------------------------------------------------------------------------------------! 1042 ! Description: 1043 ! ------------ 1044 !> Allocate shared 3d-REAL (32 bit) array on ALL threads 1045 !--------------------------------------------------------------------------------------------------! 1046 SUBROUTINE sm_allocate_shared_3di_32( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win ) 1047 1048 IMPLICIT NONE 1049 1050 CLASS(sm_class), INTENT(inout) :: this 1051 1052 INTEGER :: disp_unit 1053 INTEGER, INTENT(IN) :: d1e 1054 INTEGER, INTENT(IN) :: d1s 1055 INTEGER, INTENT(IN) :: d2e 1056 INTEGER, INTENT(IN) :: d2s 1057 INTEGER, INTENT(IN) :: d3e 1058 INTEGER, INTENT(IN) :: d3s 1059 INTEGER, SAVE :: pe_from = 0 1060 INTEGER, INTENT(OUT) :: win 1061 1062 INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size 1063 INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize 1064 1065 INTEGER, DIMENSION(3) :: buf_shape 1066 1067 INTEGER(isp), DIMENSION(:,:,:), POINTER :: buf 1068 INTEGER(isp), DIMENSION(:,:,:), POINTER :: p3 1069 1070 TYPE(C_PTR), SAVE :: base_ptr 1071 TYPE(C_PTR), SAVE :: rem_ptr 1072 1073 1074 IF ( this%no_shared_memory_in_this_run ) RETURN 1075 ! 1076 !-- Allocate shared memory on node rank 0 threads. 1077 IF ( this%sh_rank == pe_from ) THEN 1078 wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 ) 1079 ELSE 1080 wsize = 1 1081 ENDIF 1082 1083 wsize = wsize * isp ! Please note, size is always in bytes, independently of the displacement 1084 ! unit 1085 1086 CALL MPI_WIN_ALLOCATE_SHARED( wsize, isp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr ) 1087 ! 1088 !-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from) 1089 CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr ) 1090 ! 1091 !-- Convert C- to Fortran-pointer 1092 buf_shape(3) = d3e - d3s + 1 1093 buf_shape(2) = d2e - d2s + 1 1094 buf_shape(1) = d1e - d1s + 1 1095 CALL C_F_POINTER( rem_ptr, buf, buf_shape ) 1096 p3(d1s:,d2s:,d3s:) => buf 1097 ! 1098 !-- Allocate shared memory in round robin on all PEs of a node. 1099 pe_from = MOD( pe_from, this%sh_npes ) 1100 1101 END SUBROUTINE sm_allocate_shared_3di_32 1102 1103 1104 !--------------------------------------------------------------------------------------------------! 1105 ! Description: 1106 ! ------------ 1107 !> Allocate shared 3d-REAL (64 bit) array on ALL threads 1108 !--------------------------------------------------------------------------------------------------! 1109 SUBROUTINE sm_allocate_shared_3di_64( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win ) 1110 1111 IMPLICIT NONE 1112 1113 CLASS(sm_class), INTENT(inout) :: this !< 1114 1115 INTEGER :: disp_unit !< 1116 INTEGER, INTENT(IN) :: d1e !< 1117 INTEGER, INTENT(IN) :: d1s !< 1118 INTEGER, INTENT(IN) :: d2e !< 1119 INTEGER, INTENT(IN) :: d2s !< 1120 INTEGER, INTENT(IN) :: d3e !< 1121 INTEGER, INTENT(IN) :: d3s !< 1122 INTEGER, SAVE :: pe_from = 0 !< 1123 INTEGER, INTENT(OUT) :: win !< 1124 1125 INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_size !< 1126 INTEGER(KIND=MPI_ADDRESS_KIND) :: wsize !< 1127 1128 INTEGER, DIMENSION(3) :: buf_shape !< 1129 1130 INTEGER(idp), DIMENSION(:,:,:), POINTER :: buf !< 1131 INTEGER(idp), DIMENSION(:,:,:), POINTER :: p3 !< 1132 1133 TYPE(C_PTR), SAVE :: base_ptr !< 1134 TYPE(C_PTR), SAVE :: rem_ptr !< 1135 1136 1137 IF ( this%no_shared_memory_in_this_run ) RETURN 1138 ! 1139 !-- Allocate shared memory on node rank 0 threads. 1140 IF ( this%sh_rank == pe_from ) THEN 1141 wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 ) 1142 ELSE 1143 wsize = 1 1144 ENDIF 1145 1146 wsize = wsize * idp ! Please note, size is always in bytes, independently of the displacement 1147 ! unit 1148 1149 CALL MPI_WIN_ALLOCATE_SHARED( wsize, idp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr ) 1150 ! 1151 !-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from) 1152 CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr ) 1153 ! 1154 !-- Convert C- to Fortran-pointer 1155 buf_shape(3) = d3e - d3s + 1 1156 buf_shape(2) = d2e - d2s + 1 1157 buf_shape(1) = d1e - d1s + 1 1158 CALL C_F_POINTER( rem_ptr, buf, buf_shape ) 1159 p3(d1s:,d2s:,d3s:) => buf 1160 ! 1161 !-- Allocate shared memory in round robin on all PEs of a node. 1162 pe_from = MOD( pe_from, this%sh_npes ) 1163 1164 END SUBROUTINE sm_allocate_shared_3di_64 1165 1032 1166 #endif 1033 1167
Note: See TracChangeset
for help on using the changeset viewer.
