Changeset 1900 for palm/trunk/SOURCE/pmc_general_mod.f90
- Timestamp:
- May 4, 2016 3:27:53 PM (8 years ago)
- File:
-
- 1 moved
-
palm/trunk/SOURCE/pmc_general_mod.f90 (moved) (moved from palm/trunk/SOURCE/pmc_general.f90) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_general_mod.f90
r1899 r1900 1 MODULE pmc_general1 MODULE pmc_general 2 2 3 3 !--------------------------------------------------------------------------------! … … 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! re-formatted to match PALM style, file renamed again 23 23 ! 24 24 ! Former revisions: … … 54 54 55 55 #if defined( __parallel ) 56 use, intrinsic :: iso_c_binding57 58 USE kinds56 USE, INTRINSIC :: ISO_C_BINDING 57 58 USE kinds 59 59 60 60 #if defined( __mpifh ) … … 64 64 #endif 65 65 66 IMPLICIT none67 PRIVATE 68 SAVE69 70 ! return status 71 INTEGER,parameter,PUBLIC :: PMC_STATUS_OK = 072 INTEGER,parameter,PUBLIC :: PMC_STATUS_ERROR = -173 INTEGER,parameter,PUBLIC :: PMC_DA_NAME_ERR = 1074 75 INTEGER,parameter,PUBLIC :: PMC_MAX_ARRAY = 32 !Max Number of Array which can be coupled76 INTEGER,parameter,PUBLIC :: PMC_MAX_MODELL = 6477 INTEGER,parameter,PUBLIC :: DA_Desclen = 878 INTEGER,parameter,PUBLIC :: DA_Namelen = 16 79 80 TYPE, PUBLIC :: xy_ind ! Pair of indices in horizontal plane81 INTEGER:: i82 INTEGER:: j83 END TYPE84 85 TYPE, PUBLIC :: ArrayDef86 INTEGER :: coupleIndex87 INTEGER :: NrDims ! Number of Dimensions88 INTEGER,DIMENSION(4) :: A_dim ! Size of dimensions89 TYPE(c_ptr) :: data ! Pointer of data in server space90 TYPE(c_ptr), DIMENSION(2) :: po_data ! Base Pointers, PMC_S_Set_Active_data_array sets active pointer91 INTEGER(idp) :: SendIndex ! index in Send Buffer92 INTEGER(idp) :: RecvIndex ! index in Receive Buffer93 INTEGER :: SendSize ! size in Send Buffer94 INTEGER :: RecvSize ! size in Receiver Buffer95 TYPE (c_ptr) :: SendBuf ! Pointer of Data in Send buffer96 TYPE (c_ptr) :: RecvBuf ! Pointer of Data in ReceiveSbuffer97 CHARACTER(len=8) :: Name ! Name of Array98 99 Type(ArrayDef),POINTER :: next100 END TYPE ArrayDef101 102 TYPE (ArrayDef), PUBLIC, POINTER :: next; 103 104 TYPE, PUBLIC :: PeDef 105 INTEGER :: Nr_arrays=0 ! Number of arrays which will be transfered in this run106 INTEGER :: NrEle ! Number of Elemets, same for all arrays107 TYPE (xy_ind), POINTER,DIMENSION(:) :: locInd ! xy index local array for remote PE108 TYPE( ArrayDef), POINTER, DIMENSION(:) :: array_list ! List of Data Arrays to be transfered109 END TYPE PeDef110 111 TYPE, PUBLIC :: ClientDef 112 INTEGER(idp) :: TotalBufferSize113 INTEGER :: model_comm ! Communicator of this model114 INTEGER :: inter_comm ! Inter communicator model and client115 INTEGER :: intra_comm ! Intracommunicator model and client116 INTEGER :: model_rank ! Rank of this model117 INTEGER :: model_npes ! Number of PEsthis model118 INTEGER :: inter_npes ! Number of PEs clientmodel119 INTEGER :: intra_rank ! rank within intra_comm120 INTEGER :: win_server_client ! MPI RMA for preparing data on server AND client side121 TYPE (PeDef), DIMENSION(:), POINTER :: PEs ! List of all Client PEs122 END TYPE ClientDef123 124 TYPE, PUBLIC :: DA_NameDef ! Data Array Name Definition 125 INTEGER :: couple_index ! Unique Number of Array126 CHARACTER(len=DA_Desclen) :: ServerDesc ! Server array description127 CHARACTER(len=DA_Namelen) :: NameOnServer ! Name of array within Server128 CHARACTER(len=DA_Desclen) :: ClientDesc ! Client array description129 CHARACTER(len=DA_Namelen) :: NameOnClient ! Name of array within Client130 END TYPE DA_NameDef131 132 INTERFACE PMC_G_SetName 133 MODULE procedure PMC_G_SetName134 end INTERFACE PMC_G_SetName135 136 INTERFACE PMC_sort 137 MODULE procedure sort_2d_i138 end INTERFACE PMC_sort139 140 PUBLIC PMC_G_SetName, PMC_sort 141 66 IMPLICIT NONE 67 68 PRIVATE 69 SAVE 70 71 INTEGER, PARAMETER, PUBLIC :: da_desclen = 8 !< 72 INTEGER, PARAMETER, PUBLIC :: da_namelen = 16 !< 73 INTEGER, PARAMETER, PUBLIC :: pmc_da_name_err = 10 !< 74 INTEGER, PARAMETER, PUBLIC :: pmc_max_array = 32 !< max # of arrays which can be coupled 75 INTEGER, PARAMETER, PUBLIC :: pmc_max_models = 64 !< 76 INTEGER, PARAMETER, PUBLIC :: pmc_status_ok = 0 !< 77 INTEGER, PARAMETER, PUBLIC :: pmc_status_error = -1 !< 78 79 80 TYPE, PUBLIC :: xy_ind !< pair of indices in horizontal plane 81 INTEGER :: i 82 INTEGER :: j 83 END TYPE 84 85 TYPE, PUBLIC :: arraydef 86 INTEGER :: coupleindex !< 87 INTEGER :: nrdims !< number of dimensions 88 INTEGER, DIMENSION(4) :: a_dim !< size of dimensions 89 TYPE(C_PTR) :: data !< pointer of data in server space 90 TYPE(C_PTR), DIMENSION(2) :: po_data !< base pointers, 91 !< pmc_s_set_active_data_array 92 !< sets active pointer 93 INTEGER(idp) :: SendIndex !< index in send buffer 94 INTEGER(idp) :: RecvIndex !< index in receive buffer 95 INTEGER :: SendSize !< size in send buffer 96 INTEGER :: RecvSize !< size in receive buffer 97 TYPE(C_PTR) :: SendBuf !< data pointer in send buffer 98 TYPE(C_PTR) :: RecvBuf !< data pointer in receive buffer 99 CHARACTER(LEN=8) :: Name !< name of array 100 TYPE(arraydef), POINTER :: next 101 END TYPE arraydef 102 103 TYPE(arraydef), PUBLIC, POINTER :: next 104 105 TYPE, PUBLIC :: pedef 106 INTEGER :: nr_arrays = 0 !< number of arrays which will be transfered 107 INTEGER :: nrele !< number of elements, same for all arrays 108 TYPE(xy_ind), POINTER, DIMENSION(:) :: locInd !< xy index local array for remote PE 109 TYPE(arraydef), POINTER, DIMENSION(:) :: array_list !< list of data arrays to be transfered 110 END TYPE pedef 111 112 TYPE, PUBLIC :: clientdef 113 INTEGER(idp) :: totalbuffersize !< 114 INTEGER :: model_comm !< communicator of this model 115 INTEGER :: inter_comm !< inter communicator model and client 116 INTEGER :: intra_comm !< intra communicator model and client 117 INTEGER :: model_rank !< rank of this model 118 INTEGER :: model_npes !< number of PEs this model 119 INTEGER :: inter_npes !< number of PEs client model 120 INTEGER :: intra_rank !< rank within intra_comm 121 INTEGER :: win_server_client !< MPI RMA for preparing data on server AND client side 122 TYPE(pedef), DIMENSION(:), POINTER :: pes !< list of all client PEs 123 END TYPE clientdef 124 125 TYPE, PUBLIC :: da_namedef !< data array name definition 126 INTEGER :: couple_index !< unique number of array 127 CHARACTER(LEN=da_desclen) :: serverdesc !< server array description 128 CHARACTER(LEN=da_namelen) :: nameonserver !< name of array within server 129 CHARACTER(LEN=da_desclen) :: clientdesc !< client array description 130 CHARACTER(LEN=da_namelen) :: nameonclient !< name of array within client 131 END TYPE da_namedef 132 133 INTERFACE pmc_g_setname 134 MODULE PROCEDURE pmc_g_setname 135 END INTERFACE pmc_g_setname 136 137 INTERFACE pmc_sort 138 MODULE PROCEDURE sort_2d_i 139 END INTERFACE pmc_sort 140 141 PUBLIC pmc_g_setname, pmc_sort 142 142 143 143 CONTAINS 144 SUBROUTINE PMC_G_SetName (myClient, couple_index, aName) 145 IMPLICIT none 146 147 TYPE(ClientDef),INTENT(INOUT) :: myClient 148 INTEGER,INTENT(IN) :: couple_index 149 CHARACTER(LEN=*) :: aName 150 151 INTEGER :: i 152 TYPE(ArrayDef),POINTER :: ar 153 TYPE(PeDef),POINTER :: aPE 154 155 ! 156 !-- Assign array to next free index in array_list. 157 !-- Set name of array in ArrayDef structure 158 do i=1,myClient%inter_npes 159 aPE => myClient%PEs(i) 160 aPE%Nr_arrays = aPE%Nr_arrays+1 161 aPE%array_list(aPE%Nr_arrays)%name = aName 162 aPE%array_list(aPE%Nr_arrays)%coupleIndex = couple_index 163 end do 164 165 return 166 end SUBROUTINE PMC_G_SetName 167 168 169 SUBROUTINE sort_2d_i (array,sort_ind) 170 IMPLICIT none 171 INTEGER,DIMENSION(:,:),INTENT(INOUT) :: array 172 INTEGER,INTENT(IN) :: sort_ind 173 174 !-- local Variables 175 INTEGER :: i,j,n 176 INTEGER,DIMENSION(size(array,1)) :: tmp 177 178 n = size(array,2) 179 do j=1,n-1 180 do i=j+1,n 181 if(array(sort_ind,i) < array(sort_ind,j) ) then 182 tmp = array(:,i) 183 array(:,i) = array(:,j) 184 array(:,j) = tmp 185 end if 186 end do 187 end do 188 189 return 190 END SUBROUTINE sort_2d_i 144 145 SUBROUTINE pmc_g_setname( myclient, couple_index, aname ) 146 147 IMPLICIT NONE 148 149 CHARACTER(LEN=*) :: aname !< 150 INTEGER, INTENT(IN) :: couple_index !< 151 TYPE(clientdef), INTENT(INOUT) :: myclient !< 152 153 INTEGER :: i !< 154 155 TYPE(arraydef), POINTER :: ar !< 156 TYPE(pedef), POINTER :: ape !< 157 158 ! 159 !-- Assign array to next free index in array list. 160 !-- Set name of array in arraydef structure 161 DO i = 1, myclient%inter_npes 162 163 ape => myclient%pes(i) 164 ape%nr_arrays = ape%nr_arrays + 1 165 ape%array_list(ape%nr_arrays)%name = aname 166 ape%array_list(ape%nr_arrays)%coupleindex = couple_index 167 168 ENDDO 169 170 END SUBROUTINE pmc_g_setname 171 172 173 174 SUBROUTINE sort_2d_i( array, sort_ind ) 175 176 IMPLICIT NONE 177 178 INTEGER, INTENT(IN) :: sort_ind 179 INTEGER, DIMENSION(:,:), INTENT(INOUT) :: array 180 181 INTEGER :: i !< 182 INTEGER :: j !< 183 INTEGER :: n !< 184 185 INTEGER, DIMENSION(SIZE(array,1)) :: tmp !< 186 187 n = SIZE(array,2) 188 189 DO j = 1, n-1 190 DO i = j+1, n 191 192 IF ( array(sort_ind,i) < array(sort_ind,j) ) THEN 193 tmp = array(:,i) 194 array(:,i) = array(:,j) 195 array(:,j) = tmp 196 ENDIF 197 198 ENDDO 199 ENDDO 200 201 END SUBROUTINE sort_2d_i 191 202 192 203 #endif 193 endMODULE pmc_general204 END MODULE pmc_general
Note: See TracChangeset
for help on using the changeset viewer.
