|
iMOAB
|
00001 00002 SUBROUTINE errorout(ierr, message) 00003 integer ierr 00004 character (*) message 00005 if (ierr.ne.0) then 00006 print *, message 00007 call exit (1) 00008 end if 00009 return 00010 end 00011 00012 00013 program fdriver 00014 C include '/home/iulian/3rdparty/mpich-3.1/install/include/mpif.h' 00015 include 'mpif.h' 00016 integer ierr, num_procs, my_id 00017 integer pid 00018 character*10 appname 00019 character*132 filename 00020 character*150 readopts 00021 integer ngv, nge, ndim, nparts 00022 integer nghlay 00023 integer nverts(3), nelem(3), nblocks(3), nsbc(3), ndbc(3); 00024 C large enough work arrays 00025 integer iwork(100000) 00026 real*8 dwork(100000) 00027 C indices in work arrays for vertex ids, ranks, coordinates 00028 integer vID, vRA, vCO 00029 C 00030 C indices for free memory (index in integer or double work arrays) 00031 integer ifree, dfree 00032 C size of coordinates array 00033 integer nCO 00034 integer bID 00035 C for some tags in the file 00036 character*20 tagname1, tagname2 00037 integer tagtype(2), enttype(2), num_co 00038 integer tagindex(2) 00039 integer stags(2), itags(2), ntsync 00040 00041 integer eRA, beID, eID 00042 C vertice per element, number of elements in block 00043 integer vpere, nebl, blockID 00044 C iWORK(eCO) start for connectivity 00045 integer sizeconn, eCO 00046 C IWORK(egID) , IWORK(elID) starts for global el ID, local elem ID 00047 integer egID, elID, eOWN 00048 integer iTAG, dTAG 00049 00050 C indices for surface BC element, reference surf BC, value 00051 integer isBC, irBC, ivBC 00052 00053 00054 00055 character*100 outfile, wopts 00056 00057 call MPI_INIT ( ierr ) 00058 call errorout(ierr, 'fail to initialize MPI') 00059 00060 c find out MY process ID, and how many processes were started. 00061 00062 call MPI_COMM_RANK (MPI_COMM_WORLD, my_id, ierr) 00063 call errorout(ierr, 'fail to get MPI rank') 00064 00065 call MPI_COMM_SIZE (MPI_COMM_WORLD, num_procs, ierr) 00066 call errorout(ierr, 'fail to get MPI size') 00067 00068 if (my_id .eq. 0) then 00069 print *, " I'm process ", my_id, " out of ", 00070 & num_procs, " processes." 00071 00072 end if 00073 00074 ierr = iMOAB_InitializeFortran() 00075 call errorout(ierr, 'fail to initialize iMOAB') 00076 00077 appname = 'PROTEUS'//CHAR(0) 00078 00079 ierr = iMOAB_RegisterFortranApplication(appname, MPI_COMM_WORLD, 00080 & pid) 00081 call errorout(ierr, 'fail to register application') 00082 C 00083 filename ='p8ex1.h5m'//CHAR(0) 00084 ierr = iMOAB_ReadHeaderInfo ( filename, ngv, nge, ndim, nparts) 00085 call errorout(ierr, 'fail to read header info') 00086 00087 00088 if (0.eq.my_id) then 00089 print *, filename, ' has ', nparts, ' parts in partition', 00090 & ngv, ' vertices ', nge, ' elements of dimension ', ndim 00091 endif 00092 00093 readopts='PARALLEL=READ_PART;PARTITION=PARALLEL_PARTITION;'// 00094 & 'PARALLEL_RESOLVE_SHARED_ENTS'//CHAR(0) 00095 00096 C number of ghost layers needed by application 00097 nghlay = 1 00098 ierr = iMOAB_LoadMesh(pid, filename, readopts, nghlay) 00099 call errorout(ierr, 'fail to read file in parallel') 00100 00101 C number of 00102 ierr = iMOAB_GetMeshInfo(pid, nverts, nelem, nblocks, nsbc, ndbc) 00103 call errorout(ierr, 'fail to get mesh info') 00104 00105 vID = 1 00106 ierr = iMOAB_GetVertexID(pid, nverts(3), IWORK(vID) ) 00107 call errorout(ierr, 'failed to get vertex id info') 00108 00109 vRA = vID + nverts(3) 00110 ierr = iMOAB_GetVertexOwnership(pid, nverts(3), IWORK(vRA) ) 00111 call errorout(ierr, 'failed to get vertex owner ranks') 00112 00113 ifree = vRA + nverts(3) 00114 00115 C double * coords = (double*) malloc(3*nverts[2]*sizeof(double)); 00116 vCO = 1 00117 nCO = 3 * nverts(3) 00118 00119 ierr = iMOAB_GetVisibleVerticesCoordinates(pid, nCO, DWORK(vCO)) 00120 call errorout(ierr, 'failed to get coordinates') 00121 dfree = vCO + 3 * nverts(3) 00122 00123 bID = ifree 00124 ierr = iMOAB_GetBlockID(pid, nblocks(3), IWORK(bID)) 00125 call errorout(ierr, 'failed to get block info') 00126 ifree = ifree + nblocks(3) 00127 00128 C the 2 tags used in this example exist in the file, already 00129 C first tag, INTFIELD is on vertices, integer 00130 C second tag DFIELD is on elements, double 00131 tagtype(1)=0 !dense, int 00132 tagtype(2)=1 !dense, double 00133 enttype(1)=0 ! on verts 00134 enttype(2)=1 ! on elem 00135 num_co = 1 00136 tagname1 ='INTFIELD'//CHAR(0) 00137 ierr = iMOAB_DefineTagStorage(pid, tagname1, tagtype(1), num_co, 00138 & tagindex(1) ) 00139 call errorout(ierr, 'failed to get tag INTFIELD') 00140 00141 tagname2 ='DFIELD'//CHAR(0) 00142 ierr = iMOAB_DefineTagStorage(pid, tagname2, tagtype(2), num_co, 00143 & tagindex(2) ) 00144 call errorout(ierr, 'failed to get tag DFIELD') 00145 00146 00147 C synchronize one of the tags only, just to see what happens 00148 C put in the sync array just first tag index (INTFIELD) 00149 ntsync =1 00150 stags(1) = tagIndex(1) 00151 itags(1) = tagType(1) 00152 00153 ierr = iMOAB_SynchronizeTags(pid, ntsync, stags, itags ) 00154 call errorout(ierr, 'failed to sync tag INTFIELD') 00155 00156 C start printing some information, retrieved from each task 00157 do irk=0, num_procs-1 00158 if (irk .eq. my_id) then 00159 00160 C printf some of the block info */ 00161 print *, 'on rank ', my_id, ' there are ' 00162 print *, nverts(3), ' visible vertices of which ',nverts(1), 00163 & ' local ', nverts(2), ' ghost' 00164 print *, nblocks(3), ' visible blocks' 00165 print *, nsbc(3), ' visible Neumann BCs' 00166 print *, ndbc(3), ' visible dirichlet BCs' 00167 00168 print *, 'on rank ', my_id, ' vertex info:' 00169 do i=1,nverts(3) 00170 write(*, 100) i, IWORK(vRA+i-1), IWORK( vID+i-1), 00171 & DWORK(vCO+3*i-3), DWORK(vCO+3*i-2), DWORK(vCO+3*i-1) 00172 100 FORMAT(' vertex local id ', I3, ' rank ID', I3, ' global ID:' 00173 & , I3, ' coords:', 3F11.3) 00174 enddo 00175 eID = ifree 00176 beID = eID + nelem(3) 00177 eRA = beID + nelem(3) 00178 ierr = iMOAB_GetVisibleElementsInfo(pid, nelem(3),IWORK(eID), 00179 & IWORK(eRA), IWORK(beID) ) 00180 call errorout(ierr, 'failed to get all elem info') 00181 ifree = eRA + nelem(3) 00182 do i=1, nelem(3) 00183 write(*, 101) IWORK(eID+i-1), IWORK(eRA+i-1), IWORK(beID+i-1) 00184 101 FORMAT( ' global ID ', I5, ' rank: ', 00185 & I3, ' block ID: ' I4) 00186 enddo 00187 00188 do i=1,nblocks(3) 00189 00190 print *,' block index:', i, ' block ID ', IWORK(bID+i-1) 00191 blockID = IWORK(bID+i-1) 00192 ierr = iMOAB_GetBlockInfo(pid, blockID , vpere, nebl) 00193 call errorout(ierr, 'failed to elem block info') 00194 print *, ' has' , nebl, ' elements with ', vpere, 'verts' 00195 00196 sizeconn = nebl * vpere 00197 eCO = ifree 00198 ierr = iMOAB_GetBlockElementConnectivities(pid, blockID, 00199 & sizeconn, IWORK(eCO) ) 00200 call errorout(ierr, 'failed to get block elem connectivity') 00201 00202 ifree = ifree + sizeconn 00203 eOWN = ifree 00204 ierr = iMOAB_GetElementOwnership(pid, blockID, nebl, 00205 & IWORK(eOWN)) 00206 call errorout(ierr, 'failed to get block elem ownership') 00207 ifree = ifree+nebl 00208 00209 egID = ifree 00210 elID = ifree + nebl 00211 ierr = iMOAB_GetElementID(pid, blockID, nebl, 00212 & IWORK(egID), IWORK(elID) ) 00213 call errorout(ierr, 'failed to get block elem IDs') 00214 ifree = elID + nebl 00215 00216 do j=1, nebl 00217 write (*, 102) j, IWORK(eOWN+j-1),IWORK(egID+j-1), 00218 & IWORK(elID+j-1), (IWORK(eCO-1+(j-1)*vpere+k), k=1,vpere) 00219 102 FORMAT(' elem ', I3, ' owned by', I3, ' gid:', I3, ' lid:', 00220 & I3, ' : ', 10I5) 00221 enddo 00222 00223 enddo 00224 00225 00226 C query int tag values on vertices 00227 iTAG= ifree 00228 00229 ierr = iMOAB_GetIntTagStorage(pid, tagname1, nverts(3), 00230 & enttype(1), IWORK(iTAG) ) 00231 call errorout(ierr, 'failed to get INTFIELD tag') 00232 ifree = iTAG + nverts(3) 00233 print * , 'INTFIELD tag values' 00234 write(*, 103) (IWORK(iTAG+k-1), k=1,nverts(3) ) 00235 103 FORMAT (10I8) 00236 00237 dTAG = dfree 00238 C query double tag values on elements 00239 00240 ierr = iMOAB_GetDoubleTagStorage(pid, tagname2, nelem(3), 00241 & entType(2), DWORK(dTAG) ) 00242 call errorout(ierr, 'failed to get DFIELD tag') 00243 dfree = dTAG + nelem(3) 00244 print *, 'DFIELD tag values: (not exchanged) ' 00245 write (*, 104) (DWORK(dTAG+k-1), k=1,nelem(3) ) 00246 104 FORMAT ( 10F7.2 ) 00247 00248 00249 C query surface BCs 00250 isBC = ifree 00251 irBC = isBC + nsbc(3) 00252 ivBC = irBC + nsbc(3) 00253 00254 ierr = iMOAB_GetPointerToSurfaceBC(pid, nsbc(3), IWORK(isBC), 00255 & IWORK(irBC), IWORK(ivBC)) 00256 call errorout(ierr, 'failed to get surf boundary conditions') 00257 ifree = ivBC + nsbc(3) 00258 print * , 'Surface boundary conditions ' 00259 write (*, 105) (IWORK(isBC+k-1), 00260 & IWORK(irBC+k-1), IWORK(ivBC+k-1), k=1, nsbc(3)) 00261 105 FORMAT (' elem localID: ', I3, ' side:', I1, ' val:', I4) 00262 00263 C query vertex BCs 00264 00265 iveBC = ifree 00266 ivaBC = iveBC + ndbc(3) 00267 00268 ierr = iMOAB_GetPointerToVertexBC(pid, ndbc(3), IWORK(iveBC), 00269 & IWORK(ivaBC)) 00270 call errorout(ierr, 'failed to get vertex boundary conditions') 00271 ifree = ivaBC + ndbc(3) 00272 00273 print *, ' Vertex boundary conditions:' 00274 write (*, 106) (IWORK(iveBC+k-1), 00275 & IWORK(ivaBC+k-1), k=1, ndbc(3)) 00276 106 FORMAT (' vertex: ', I3, ' BC:', I6 ) 00277 00278 endif 00279 call MPI_Barrier(MPI_COMM_WORLD, ierr) 00280 call errorout(ierr, 'fail at barrier') 00281 00282 enddo 00283 00284 00285 outfile = 'fnew.h5m'//CHAR(0) 00286 wopts = 'PARALLEL=WRITE_PART'//CHAR(0) 00287 ierr = iMOAB_WriteMesh(pid, outfile, wopts) 00288 call errorout(ierr, 'fail to write the mesh file') 00289 00290 00291 ierr = iMOAB_DeregisterApplication(pid) 00292 call errorout(ierr, 'fail to deregister application') 00293 00294 ierr = iMOAB_Finalize() 00295 call errorout(ierr, 'fail to finalize iMOAB') 00296 00297 00298 call MPI_FINALIZE ( ierr ) 00299 call errorout(ierr, 'fail to finalize MPI') 00300 00301 stop 00302 end
1.7.6.1 
