API tools faq
paste
Guest User

Untitled

a guest
Apr 19th, 2018
97
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 9.25 KB | None | 0 0
raw download clone embed print report
  1. c------------------------------------------------------------------
  2. c
  3. c module name - mumps_data
  4. c
  5. c------------------------------------------------------------------
  6. c
  7. c computer - machine independent
  8. c
  9. c latest revision - Oct 04
  10. c
  11. c purpose - module stores a [dz]mumps_struc object and
  12. c interface routines to control MUMPS
  13. c
  14. c-----------------------------------------------------------------------
  15. module mumps_data
  16. c
  17. c use non-preprocessed include statement since preprocessor objects
  18. c to un-paired quotation marks
  19. #if C_MODE
  20. include 'zmumps_struc.h'
  21. #else
  22. include 'dmumps_struc.h'
  23. #endif
  24. c
  25. save
  26. c
  27. #if C_MODE
  28. type(zmumps_struc) :: mumps_par
  29. #else
  30. type(dmumps_struc) :: mumps_par
  31. #endif
  32. c
  33. integer, parameter :: mumps_histlen = 100
  34. integer :: mumps_nrhist(2)
  35. integer :: mumps_nrdof_total(2,mumps_histlen)
  36. integer :: mumps_nrdof_inter(2,mumps_histlen)
  37. integer :: mumps_store_inter(2,mumps_histlen)
  38. integer :: mumps_store_addit(2,mumps_histlen)
  39. double precision :: mumps_input_time(2,mumps_histlen)
  40. double precision :: mumps_solve_time(2,mumps_histlen)
  41. double precision :: mumps_total_time(2,mumps_histlen)
  42. c
  43. contains
  44. c
  45. c
  46. c-----------------------------------------------------------------------
  47. c INITIALIZE MUMPS FOR THE FIRST TIME (BEGINNING OF MAIN)
  48. c-----------------------------------------------------------------------
  49. subroutine start_mumps
  50. #include "syscom.blk"
  51. include 'mpif.h'
  52. c
  53. c ...set an MPI communicator for all MUMPS processors
  54. mumps_par%comm = MPI_COMM_WORLD
  55. c
  56. c ...indicate that host processor should participate in the
  57. c factorization and solve phases (this is a sequential code)
  58. mumps_par%par = 1
  59. c
  60. #if C_MODE
  61. c unsymmetric
  62. mumps_par%sym = 0
  63. #else
  64. c symmetric and positive definite (2 = general symmetric)
  65. mumps_par%sym = 1
  66. #endif
  67. c
  68. mumps_nrhist = 0
  69. mumps_nrdof_total = 0
  70. mumps_nrdof_inter = 0
  71. mumps_store_inter = 0
  72. mumps_store_addit = 0
  73. mumps_input_time = 0.d0
  74. mumps_solve_time = 0.d0
  75. mumps_total_time = 0.d0
  76. c
  77. end subroutine start_mumps
  78. c
  79. c
  80. c-----------------------------------------------------------------------
  81. c TERMINATE MUMPS FOR THE LAST TIME (END OF MAIN)
  82. c-----------------------------------------------------------------------
  83. subroutine end_mumps
  84. #include "syscom.blk"
  85. include 'mpif.h'
  86. call mpi_finalize(ierr)
  87. end subroutine end_mumps
  88. c
  89. c
  90. c-----------------------------------------------------------------------
  91. c INITIALIZE MUMPS
  92. c-----------------------------------------------------------------------
  93. subroutine alloc_mumps
  94. c
  95. c ...initialize an instance of MUMPS
  96. mumps_par%job = -1
  97. #if C_MODE
  98. call zmumps(mumps_par)
  99. #else
  100. call dmumps(mumps_par)
  101. #endif
  102. c
  103. c ...set control flags
  104. #if C_MODE
  105. c error output stream (non-positive to suppress)
  106. mumps_par%icntl(1) = 0
  107. c diagnostic, statistics and warnings
  108. mumps_par%icntl(2) = 0
  109. c global information
  110. mumps_par%icntl(3) = 0
  111. c printing level
  112. mumps_par%icntl(4) = 0
  113. c input matrix in element format
  114. mumps_par%icntl(5) = 1
  115. c column permutation for zero-free diagonal (automatic)
  116. mumps_par%icntl(6) = 7
  117. c pivot order (automatic)
  118. mumps_par%icntl(7) = 7
  119. c scaling (automatic)
  120. mumps_par%icntl(8) = 7
  121. c no transpose
  122. mumps_par%icntl(9) = 1
  123. c max steps for iterative refinement
  124. mumps_par%icntl(10) = 0
  125. c statistics info
  126. mumps_par%icntl(11) = 0
  127. c controls parallelism
  128. mumps_par%icntl(12) = 0
  129. c use ScaLAPACK for root node
  130. mumps_par%icntl(13) = 0
  131. c percentage increase in estimated workspace
  132. mumps_par%icntl(14) = 20
  133. c
  134. c matrix distribution for assembled input
  135. mumps_par%icntl(18) = 0
  136. c nonzero for Schur complement
  137. mumps_par%icntl(19) = 0
  138. #else
  139. c error output stream (non-positive to suppress)
  140. mumps_par%icntl(1) = 0
  141. c diagnostic, statistics and warnings
  142. mumps_par%icntl(2) = 0
  143. c global information
  144. mumps_par%icntl(3) = 0
  145. c printing level
  146. mumps_par%icntl(4) = 2
  147. c input matrix in element format
  148. mumps_par%icntl(5) = 1
  149. c column permutation for zero-free diagonal (automatic)
  150. c mumps_par%icntl(6) = 7
  151. c pivot order (automatic)
  152. c mumps_par%icntl(7) = 7
  153. c scaling (automatic)
  154. c mumps_par%icntl(8) = 7
  155. c no transpose
  156. mumps_par%icntl(9) = 1
  157. c max steps for iterative refinement
  158. c mumps_par%icntl(10) = 0
  159. c statistics info
  160. c mumps_par%icntl(11) = 0
  161. c controls parallelism
  162. c mumps_par%icntl(12) = 0
  163. c use ScaLAPACK for root node
  164. c mumps_par%icntl(13) = 0
  165. c percentage increase in estimated workspace
  166. mumps_par%icntl(14) = 0
  167. c
  168. c matrix distribution for assembled input
  169. c mumps_par%icntl(18) = 0
  170. c nonzero for Schur complement
  171. c mumps_par%icntl(19) = 0
  172. #endif
  173. c
  174. end subroutine alloc_mumps
  175. c
  176. c
  177. c-----------------------------------------------------------------------
  178. c RUN MUMPS SOLVE (LU FACTORIZATION)
  179. c-----------------------------------------------------------------------
  180. subroutine run_mumps_solve(Idec)
  181. #include "syscom.blk"
  182. c
  183. iprint=0
  184. c
  185. c start clock for solution time
  186. if (MUMPS_PAR%MYID == 0) then
  187. call start_clock(iclock)
  188. endif
  189. c
  190. c analysis, factorization and solve
  191. #if C_MODE
  192. mumps_par%job = 1
  193. call zmumps(mumps_par)
  194. mumps_par%job = 2
  195. call zmumps(mumps_par)
  196. #else
  197. mumps_par%job = 1
  198. call dmumps(mumps_par)
  199. c
  200. mumps_par%job = 2
  201. call dmumps(mumps_par)
  202. #endif
  203. c
  204. c ...check for errors
  205. if (mumps_par%info(1).ne.0) then
  206. write (*,*) 'mumps_par%job=',mumps_par%job
  207. write (*,*) 'mumps_par%info=',mumps_par%info
  208. stop1
  209. endif
  210. c
  211. c ...host processor
  212. if (MUMPS_PAR%MYID == 0) then
  213. c
  214. c .....check for errors
  215. if (mumps_par%info(1).ne.0) then
  216. write (*,*) 'mumps_par%job=',mumps_par%job
  217. write (*,*) 'mumps_par%info=',mumps_par%info
  218. stop1
  219. endif
  220. c
  221. c .....record total factorization time
  222. call stop_clock(dtime,iclock)
  223. mumps_solve_time(Idec,mumps_nrhist(Idec)) = dtime
  224. if (iprint>=1) then
  225. write(*,1002) dtime
  226. 1002 format('MUMPS SOLUTION TIME: ',f9.4,'s')
  227. endif
  228. c
  229. c .....print statistical information
  230. if (mumps_par%icntl(11)>0) then
  231. write(*,1010) mumps_par%rinfog(10)
  232. write(*,1011) mumps_par%rinfog(11)
  233. 1010 format('cond1(A) = ',e15.8)
  234. 1011 format('cond2(A) = ',e15.8)
  235. endif
  236. endif
  237. c
  238. end subroutine run_mumps_solve
  239. c
  240. c-----------------------------------------------------------------------
  241. c BACKWARD ELIMINATION
  242. c-----------------------------------------------------------------------
  243.  
  244. subroutine run_mumps_rhs
  245. #include "syscom.blk"
  246. #if C_MODE
  247. mumps_par%job = 3
  248. call zmumps(mumps_par)
  249. #else
  250. mumps_par%job = 3
  251. call dmumps(mumps_par)
  252. #endif
  253. c
  254. c ...check for errors
  255. if (mumps_par%info(1).ne.0) then
  256. write (*,*) 'mumps_par%job=',mumps_par%job
  257. write (*,*) 'mumps_par%info=',mumps_par%info
  258. stop1
  259. endif
  260. c
  261. end subroutine run_mumps_rhs
  262. c
  263. c-----------------------------------------------------------------------
  264. c TERMINATE MUMPS
  265. c-----------------------------------------------------------------------
  266. subroutine dealloc_mumps
  267. c
  268. c ...terminate an instance of MUMPS
  269. mumps_par%job = -2
  270. #if C_MODE
  271. call zmumps(mumps_par)
  272. #else
  273. call dmumps(mumps_par)
  274. #endif
  275. c
  276. end subroutine dealloc_mumps
  277. c
  278. c
  279. c-----------------------------------------------------------------------
  280. c PRINT MUMPS DATA
  281. c-----------------------------------------------------------------------
  282. c
  283. subroutine print_mumps_data(Idec)
  284. #include "syscom.blk"
  285. c
  286. if (Idec==1 .or. Idec==3) then
  287. c
  288. c .....print coarse grid results
  289. write(*,2000)
  290. write(*,2002)
  291. do i=1,mumps_nrhist(1)
  292. write(*,2001) mumps_nrdof_total(1,i),mumps_nrdof_inter(1,i),
  293. . mumps_store_inter(1,i),mumps_store_addit(1,i),
  294. . mumps_input_time(1,i),mumps_solve_time(1,i),
  295. . mumps_total_time(1,i)
  296. enddo
  297. endif
  298. if (Idec==2 .or. Idec==3) then
  299. c
  300. c .....print fine grid results
  301. if (Idec==2) write(*,2000)
  302. write(*,2002)
  303. do i=1,mumps_nrhist(2)
  304. write(*,2001) mumps_nrdof_total(2,i),mumps_nrdof_inter(2,i),
  305. . mumps_store_inter(2,i),mumps_store_addit(2,i),
  306. . mumps_input_time(2,i),mumps_solve_time(2,i),
  307. . mumps_total_time(2,i)
  308. enddo
  309. endif
  310. write(*,2002)
  311.  
  312. 2000 format(' NRDOFB NRDOFI STORAGE INPUT SOLUTION TOTAL')
  313. 2001 format(i7,1x,i7,1x,i4,'+',i3,1x,f7.2,3x,f7.2,1x,f7.2)
  314. 2002 format('--------------------------------------------------')
  315. c
  316. end subroutine print_mumps_data
  317.  
  318. end module mumps_data
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!