| 1 | #ifndef MS_SUA |
|---|
| 2 | # include <stdio.h> |
|---|
| 3 | # include <stdlib.h> |
|---|
| 4 | #endif |
|---|
| 5 | #if defined( DM_PARALLEL ) && ! defined( STUBMPI ) |
|---|
| 6 | # include <mpi.h> |
|---|
| 7 | #endif |
|---|
| 8 | |
|---|
| 9 | #ifndef CRAY |
|---|
| 10 | # ifdef NOUNDERSCORE |
|---|
| 11 | # define COLLECT_ON_COMM collect_on_comm |
|---|
| 12 | # define COLLECT_ON_COMM0 collect_on_comm0 |
|---|
| 13 | # define DIST_ON_COMM dist_on_comm |
|---|
| 14 | # define DIST_ON_COMM0 dist_on_comm0 |
|---|
| 15 | # define INT_PACK_DATA int_pack_data |
|---|
| 16 | # define INT_GET_TI_HEADER_C int_get_ti_header_c |
|---|
| 17 | # define INT_GEN_TI_HEADER_C int_gen_ti_header_c |
|---|
| 18 | # else |
|---|
| 19 | # ifdef F2CSTYLE |
|---|
| 20 | # define COLLECT_ON_COMM collect_on_comm__ |
|---|
| 21 | # define COLLECT_ON_COMM0 collect_on_comm0__ |
|---|
| 22 | # define DIST_ON_COMM dist_on_comm__ |
|---|
| 23 | # define DIST_ON_COMM0 dist_on_comm0__ |
|---|
| 24 | # define INT_PACK_DATA int_pack_data__ |
|---|
| 25 | # define INT_GET_TI_HEADER_C int_get_ti_header_c__ |
|---|
| 26 | # define INT_GEN_TI_HEADER_C int_gen_ti_header_c__ |
|---|
| 27 | # else |
|---|
| 28 | # define COLLECT_ON_COMM collect_on_comm_ |
|---|
| 29 | # define COLLECT_ON_COMM0 collect_on_comm0_ |
|---|
| 30 | # define DIST_ON_COMM dist_on_comm_ |
|---|
| 31 | # define DIST_ON_COMM0 dist_on_comm0_ |
|---|
| 32 | # define INT_PACK_DATA int_pack_data_ |
|---|
| 33 | # define INT_GET_TI_HEADER_C int_get_ti_header_c_ |
|---|
| 34 | # define INT_GEN_TI_HEADER_C int_gen_ti_header_c_ |
|---|
| 35 | # endif |
|---|
| 36 | # endif |
|---|
| 37 | #endif |
|---|
| 38 | |
|---|
| 39 | COLLECT_ON_COMM ( int * comm, int * typesize , |
|---|
| 40 | void * inbuf, int *ninbuf , void * outbuf, int * noutbuf ) |
|---|
| 41 | { |
|---|
| 42 | col_on_comm ( comm, typesize , |
|---|
| 43 | inbuf, ninbuf , outbuf, noutbuf, 1 ) ; |
|---|
| 44 | } |
|---|
| 45 | |
|---|
| 46 | /* collect on node 0*/ |
|---|
| 47 | COLLECT_ON_COMM0 ( int * comm, int * typesize , |
|---|
| 48 | void * inbuf, int *ninbuf , void * outbuf, int * noutbuf ) |
|---|
| 49 | { |
|---|
| 50 | col_on_comm ( comm, typesize , |
|---|
| 51 | inbuf, ninbuf , outbuf, noutbuf, 0 ) ; |
|---|
| 52 | } |
|---|
| 53 | |
|---|
| 54 | int |
|---|
| 55 | col_on_comm ( int * Fcomm, int * typesize , |
|---|
| 56 | void * inbuf, int *ninbuf , void * outbuf, int * noutbuf, int sw ) |
|---|
| 57 | { |
|---|
| 58 | #if defined( DM_PARALLEL ) && ! defined(STUBMPI) |
|---|
| 59 | int mytask, ntasks, p ; |
|---|
| 60 | int *recvcounts ; |
|---|
| 61 | int *displace ; |
|---|
| 62 | int noutbuf_loc ; |
|---|
| 63 | int root_task ; |
|---|
| 64 | MPI_Comm *comm, dummy_comm ; |
|---|
| 65 | int ierr ; |
|---|
| 66 | |
|---|
| 67 | comm = &dummy_comm ; |
|---|
| 68 | *comm = MPI_Comm_f2c( *Fcomm ) ; |
|---|
| 69 | MPI_Comm_size ( *comm, &ntasks ) ; |
|---|
| 70 | MPI_Comm_rank ( *comm, &mytask ) ; |
|---|
| 71 | recvcounts = (int *) malloc( ntasks * sizeof(int)) ; |
|---|
| 72 | displace = (int *) malloc( ntasks * sizeof(int)) ; |
|---|
| 73 | root_task = ( sw == 0 ) ? 0 : ntasks-1 ; |
|---|
| 74 | |
|---|
| 75 | /* collect up recvcounts */ |
|---|
| 76 | ierr = MPI_Gather( ninbuf , 1 , MPI_INT , recvcounts , 1 , MPI_INT , root_task , *comm ) ; |
|---|
| 77 | #ifndef MS_SUA |
|---|
| 78 | if ( ierr != 0 ) fprintf(stderr,"%s %d MPI_Gather returns %d\n",__FILE__,__LINE__,ierr ) ; |
|---|
| 79 | #endif |
|---|
| 80 | |
|---|
| 81 | if ( mytask == root_task ) { |
|---|
| 82 | |
|---|
| 83 | /* figure out displacements */ |
|---|
| 84 | for ( p = 1 , displace[0] = 0 , noutbuf_loc = recvcounts[0] ; p < ntasks ; p++ ) { |
|---|
| 85 | displace[p] = displace[p-1]+recvcounts[p-1] ; |
|---|
| 86 | noutbuf_loc = noutbuf_loc + recvcounts[p] ; |
|---|
| 87 | } |
|---|
| 88 | |
|---|
| 89 | if ( noutbuf_loc > * noutbuf ) |
|---|
| 90 | { |
|---|
| 91 | #ifndef MS_SUA |
|---|
| 92 | fprintf(stderr,"FATAL ERROR: collect_on_comm: noutbuf_loc (%d) > noutbuf (%d)\n", |
|---|
| 93 | noutbuf_loc , * noutbuf ) ; |
|---|
| 94 | fprintf(stderr,"WILL NOT perform the collection operation\n") ; |
|---|
| 95 | #endif |
|---|
| 96 | MPI_Abort(MPI_COMM_WORLD,1) ; |
|---|
| 97 | } |
|---|
| 98 | |
|---|
| 99 | /* multiply everything by the size of the type */ |
|---|
| 100 | for ( p = 0 ; p < ntasks ; p++ ) { |
|---|
| 101 | displace[p] *= *typesize ; |
|---|
| 102 | recvcounts[p] *= *typesize ; |
|---|
| 103 | } |
|---|
| 104 | } |
|---|
| 105 | |
|---|
| 106 | ierr = MPI_Gatherv( inbuf , *ninbuf * *typesize , MPI_CHAR , |
|---|
| 107 | outbuf , recvcounts , displace, MPI_CHAR , |
|---|
| 108 | root_task , *comm ) ; |
|---|
| 109 | #ifndef MS_SUA |
|---|
| 110 | if ( ierr != 0 ) fprintf(stderr,"%s %d MPI_Gatherv returns %d\n",__FILE__,__LINE__,ierr ) ; |
|---|
| 111 | #endif |
|---|
| 112 | |
|---|
| 113 | free(recvcounts) ; |
|---|
| 114 | free(displace) ; |
|---|
| 115 | #endif |
|---|
| 116 | return(0) ; |
|---|
| 117 | } |
|---|
| 118 | |
|---|
| 119 | |
|---|
| 120 | DIST_ON_COMM ( int * comm, int * typesize , |
|---|
| 121 | void * inbuf, int *ninbuf , void * outbuf, int * noutbuf ) |
|---|
| 122 | { |
|---|
| 123 | dst_on_comm ( comm, typesize , |
|---|
| 124 | inbuf, ninbuf , outbuf, noutbuf, 1 ) ; |
|---|
| 125 | } |
|---|
| 126 | |
|---|
| 127 | DIST_ON_COMM0 ( int * comm, int * typesize , |
|---|
| 128 | void * inbuf, int *ninbuf , void * outbuf, int * noutbuf ) |
|---|
| 129 | { |
|---|
| 130 | dst_on_comm ( comm, typesize , |
|---|
| 131 | inbuf, ninbuf , outbuf, noutbuf, 0 ) ; |
|---|
| 132 | } |
|---|
| 133 | |
|---|
| 134 | dst_on_comm ( int * Fcomm, int * typesize , |
|---|
| 135 | void * inbuf, int *ninbuf , void * outbuf, int * noutbuf, int sw ) |
|---|
| 136 | { |
|---|
| 137 | #if defined(DM_PARALLEL) && ! defined(STUBMPI) |
|---|
| 138 | int mytask, ntasks, p ; |
|---|
| 139 | int *sendcounts ; |
|---|
| 140 | int *displace ; |
|---|
| 141 | int noutbuf_loc ; |
|---|
| 142 | int root_task ; |
|---|
| 143 | MPI_Comm *comm, dummy_comm ; |
|---|
| 144 | |
|---|
| 145 | comm = &dummy_comm ; |
|---|
| 146 | *comm = MPI_Comm_f2c( *Fcomm ) ; |
|---|
| 147 | MPI_Comm_size ( *comm, &ntasks ) ; |
|---|
| 148 | MPI_Comm_rank ( *comm, &mytask ) ; |
|---|
| 149 | sendcounts = (int *) malloc( ntasks * sizeof(int)) ; |
|---|
| 150 | displace = (int *) malloc( ntasks * sizeof(int)) ; |
|---|
| 151 | root_task = ( sw == 0 ) ? 0 : ntasks-1 ; |
|---|
| 152 | |
|---|
| 153 | /* collect up sendcounts */ |
|---|
| 154 | MPI_Gather( noutbuf , 1 , MPI_INT , sendcounts , 1 , MPI_INT , root_task , *comm ) ; |
|---|
| 155 | |
|---|
| 156 | if ( mytask == root_task ) { |
|---|
| 157 | |
|---|
| 158 | /* figure out displacements */ |
|---|
| 159 | for ( p = 1 , displace[0] = 0 , noutbuf_loc = sendcounts[0] ; p < ntasks ; p++ ) { |
|---|
| 160 | displace[p] = displace[p-1]+sendcounts[p-1] ; |
|---|
| 161 | noutbuf_loc = noutbuf_loc + sendcounts[p] ; |
|---|
| 162 | } |
|---|
| 163 | |
|---|
| 164 | /* multiply everything by the size of the type */ |
|---|
| 165 | for ( p = 0 ; p < ntasks ; p++ ) { |
|---|
| 166 | displace[p] *= *typesize ; |
|---|
| 167 | sendcounts[p] *= *typesize ; |
|---|
| 168 | } |
|---|
| 169 | } |
|---|
| 170 | |
|---|
| 171 | MPI_Scatterv( inbuf , sendcounts , displace, MPI_CHAR , |
|---|
| 172 | outbuf , *noutbuf * *typesize , MPI_CHAR , |
|---|
| 173 | root_task , *comm ) ; |
|---|
| 174 | |
|---|
| 175 | free(sendcounts) ; |
|---|
| 176 | free(displace) ; |
|---|
| 177 | #endif |
|---|
| 178 | return(0) ; |
|---|
| 179 | } |
|---|
| 180 | |
|---|
| 181 | #ifndef MS_SUA |
|---|
| 182 | #ifndef MACOS |
|---|
| 183 | # include <malloc.h> |
|---|
| 184 | # include <sys/resource.h> |
|---|
| 185 | #endif |
|---|
| 186 | |
|---|
| 187 | #if 0 |
|---|
| 188 | int getrusage( |
|---|
| 189 | int who, |
|---|
| 190 | struct rusage *r_usage); |
|---|
| 191 | #endif |
|---|
| 192 | |
|---|
| 193 | #if 0 |
|---|
| 194 | extern int outy ; |
|---|
| 195 | extern int maxstug, nouty, maxouty ; |
|---|
| 196 | #endif |
|---|
| 197 | |
|---|
| 198 | #if 0 |
|---|
| 199 | #include <unistd.h> |
|---|
| 200 | #include <sys/times.h> |
|---|
| 201 | /* used internally for chasing memory leaks on ibm */ |
|---|
| 202 | rlim_ () |
|---|
| 203 | { |
|---|
| 204 | #ifndef MACOS |
|---|
| 205 | |
|---|
| 206 | struct rusage r_usage ; |
|---|
| 207 | struct mallinfo minf ; |
|---|
| 208 | struct tms tm ; |
|---|
| 209 | long tick, tock ; |
|---|
| 210 | |
|---|
| 211 | tick = sysconf( _SC_CLK_TCK ) ; |
|---|
| 212 | times( &tm ) ; |
|---|
| 213 | tock = (tm.tms_utime + tm.tms_stime)*tick ; |
|---|
| 214 | |
|---|
| 215 | getrusage ( RUSAGE_SELF, &r_usage ) ; |
|---|
| 216 | if ( tock != 0 ) { |
|---|
| 217 | #ifndef MS_SUA |
|---|
| 218 | fprintf(stderr,"sm %ld d %ld s %ld maxrss %ld %d %d %ld\n",r_usage.ru_ixrss/tock,r_usage.ru_idrss/tock,r_usage.ru_isrss/tock, r_usage.ru_maxrss,tick,tock,r_usage.ru_ixrss) ; |
|---|
| 219 | #endif |
|---|
| 220 | } |
|---|
| 221 | minf = mallinfo() ; |
|---|
| 222 | #ifndef MS_SUAL |
|---|
| 223 | fprintf(stderr,"a %ld usm %ld fsm %ld uord %ld ford %ld hblkhd %d\n",minf.arena,minf.usmblks,minf.fsmblks,minf.uordblks,minf.fordblks,minf.hblkhd) ; |
|---|
| 224 | #endif |
|---|
| 225 | # if 0 |
|---|
| 226 | fprintf(stderr," outy %d nouty %d maxstug %d maxouty %d \n", outy, nouty, maxstug, maxouty ) ; |
|---|
| 227 | # endif |
|---|
| 228 | #endif |
|---|
| 229 | } |
|---|
| 230 | #endif |
|---|
| 231 | #endif |
|---|
| 232 | |
|---|
