QR_MUMPS
 All Classes Files Functions Variables Enumerations Enumerator Pages
qrm_prnt_array.F90
Go to the documentation of this file.
1 !! ##############################################################################################
2 !!
3 !! Copyright 2012 CNRS, INPT
4 !!
5 !! This file is part of qr_mumps.
6 !!
7 !! qr_mumps is free software: you can redistribute it and/or modify
8 !! it under the terms of the GNU Lesser General Public License as
9 !! published by the Free Software Foundation, either version 3 of
10 !! the License, or (at your option) any later version.
11 !!
12 !! qr_mumps is distributed in the hope that it will be useful,
13 !! but WITHOUT ANY WARRANTY; without even the implied warranty of
14 !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 !! GNU Lesser General Public License for more details.
16 !!
17 !! You can find a copy of the GNU Lesser General Public License
18 !! in the qr_mumps/doc directory.
19 !!
20 !! ##############################################################################################
21 
22 
23 !!##############################################################################################
33 
34 
35 subroutine qrm_prnt_iarray(a, lab, unit)
36  ! Function: qrm_prnt_iarray
37  !
38  ! *Input*:
39  !
40  ! *Output*:
41  !
42 
43  integer :: a(:)
44  character :: lab*(*)
45  integer, optional :: unit
46  integer :: mn, mx, s, i, lg, iunit
47  character :: fmt*10, fmt2*10
48 
49 
50  if(present(unit)) then
51  iunit = unit
52  else
53  iunit = 6
54  end if
55 
56  write(iunit,'(a15,"= [ ")',advance='no')lab
57  do i=1, size(a)
58  mx = abs(a(i))
59  lg = 10
60  s = 1
61  do
62  if (lg .gt. mx) exit
63  s = s+1
64  lg=lg*10
65  end do
66  if(a(i) .lt. 0) s = s+1
67  fmt=''
68  write(fmt,'(i4)')s
69  fmt=adjustl(fmt)
70  write(fmt2,'("(i",a4,",2x)")')fmt(1:4)
71  write(iunit,fmt2,advance='no')a(i)
72  end do
73 
74  write(iunit,'(" ];")')
75  write(iunit,'(" ")')
76 
77  return
78 
79 end subroutine qrm_prnt_iarray
80 
81 
82 subroutine qrm_prnt_sarray(a, lab, digits, unit)
83  ! Function: qrm_prnt_iarray
84  !
85  ! *Input*:
86  !
87  ! *Output*:
88  !
89 
90  real(kind(1.e0)) :: a(:)
91  character :: lab*(*)
92  integer :: digits
93  integer, optional :: unit
94 
95  integer :: mn, mx, s, i, lg, iunit
96  character :: fmt*12, fmt2*12
97 
98 
99  if(present(unit)) then
100  iunit = unit
101  else
102  iunit = 6
103  end if
104 
105  write(iunit,'(a15,"= [ ")',advance='no')lab
106  do i=1, size(a)
107  mx = floor(abs(a(i)))
108  lg = 10
109  s = 1
110  do
111  if (lg .gt. mx) exit
112  s = s+1
113  lg=lg*10
114  end do
115  if(a(i) .lt. 0) s = s+1
116  fmt=''
117  write(fmt,'(i4,".",i2)')s+1+digits,digits
118  fmt=adjustl(fmt)
119  write(fmt2,'("(f",a5,",2x)")')fmt(1:5)
120  write(iunit,fmt2,advance='no')a(i)
121  end do
122 
123  write(iunit,'(" ];")')
124  write(iunit,'(" ")')
125 
126  return
127 
128 end subroutine qrm_prnt_sarray
129 
130 
131 
132 subroutine qrm_prnt_darray(a, lab, digits, unit)
133  ! Function: qrm_prnt_iarray
134  !
135  ! *Input*:
136  !
137  ! *Output*:
138  !
139 
140  real(kind(1.d0)) :: a(:)
141  character :: lab*(*)
142  integer :: digits
143  integer, optional :: unit
144 
145  integer :: mn, mx, s, i, lg, iunit
146  character :: fmt*12, fmt2*12
147 
148 
149  if(present(unit)) then
150  iunit = unit
151  else
152  iunit = 6
153  end if
154 
155  write(iunit,'(a15,"= [ ")',advance='no')lab
156  do i=1, size(a)
157  mx = floor(abs(a(i)))
158  lg = 10
159  s = 1
160  do
161  if (lg .gt. mx) exit
162  s = s+1
163  lg=lg*10
164  end do
165  if(a(i) .lt. 0) s = s+1
166  fmt=''
167  write(fmt,'(i4,".",i2)')s+1+digits,digits
168  fmt=adjustl(fmt)
169  write(fmt2,'("(f",a5,",2x)")')fmt(1:5)
170  write(iunit,fmt2,advance='no')a(i)
171  end do
172 
173  write(iunit,'(" ];")')
174  write(iunit,'(" ")')
175 
176  return
177 
178 end subroutine qrm_prnt_darray
179 
180 
181 
182 
183 
184 
185 subroutine qrm_prnt_carray(a, lab, digits, unit)
186  ! Function: qrm_prnt_carray
187  !
188  ! *Input*:
189  !
190  ! *Output*:
191  !
192 
193  complex(kind(1.e0)) :: a(:)
194  character :: lab*(*)
195  integer :: digits
196  integer, optional :: unit
197 
198  integer :: mn, mx, s, i, lg, iunit
199  character :: fmt*12, fmt2*12, fmt3*12
200 
201 
202  if(present(unit)) then
203  iunit = unit
204  else
205  iunit = 6
206  end if
207 
208  write(iunit,'(a15,"= [ ")',advance='no')lab
209  do i=1, size(a)
210  mx = floor(abs(real(a(i))))
211  lg = 10
212  s = 1
213  do
214  if (lg .gt. mx) exit
215  s = s+1
216  lg=lg*10
217  end do
218  if(real(a(i)) .lt. 0) s = s+1
219  fmt=''
220  write(fmt,'(i4,".4")')s+5
221  fmt=adjustl(fmt)
222  write(fmt2,'("(f",a5,","","",")')fmt(1:5)
223 
224  mx = floor(abs(aimag(a(i))))
225  lg = 10
226  s = 1
227  do
228  if (lg .gt. mx) exit
229  s = s+1
230  lg=lg*10
231  end do
232  if(aimag(a(i)) .lt. 0) s = s+1
233  fmt=''
234  write(fmt,'(i4,".",i2)')s+1+digits,digits
235  fmt=adjustl(fmt)
236  write(fmt3,'("f",a5,",2x)")')fmt(1:5)
237 
238  write(iunit,fmt2//fmt3,advance='no')a(i)
239  end do
240 
241  write(iunit,'(" ];")')
242  write(iunit,'(" ")')
243 
244  return
245 
246 end subroutine qrm_prnt_carray
247 
248 
249 
250 subroutine qrm_prnt_zarray(a, lab, digits, unit)
251  ! Function: qrm_prnt_zarray
252  !
253  ! *Input*:
254  !
255  ! *Output*:
256  !
257 
258  complex(kind(1.d0)) :: a(:)
259  character :: lab*(*)
260  integer :: digits
261  integer, optional :: unit
262 
263  integer :: mn, mx, s, i, lg, iunit
264  character :: fmt*12, fmt2*12, fmt3*12
265 
266 
267  if(present(unit)) then
268  iunit = unit
269  else
270  iunit = 6
271  end if
272 
273  write(iunit,'(a15,"= [ ")',advance='no')lab
274  do i=1, size(a)
275  mx = floor(abs(real(a(i))))
276  lg = 10
277  s = 1
278  do
279  if (lg .gt. mx) exit
280  s = s+1
281  lg=lg*10
282  end do
283  if(real(a(i)) .lt. 0) s = s+1
284  fmt=''
285  write(fmt,'(i4,".4")')s+5
286  fmt=adjustl(fmt)
287  write(fmt2,'("(f",a5,","","",")')fmt(1:5)
288 
289  mx = floor(abs(aimag(a(i))))
290  lg = 10
291  s = 1
292  do
293  if (lg .gt. mx) exit
294  s = s+1
295  lg=lg*10
296  end do
297  if(aimag(a(i)) .lt. 0) s = s+1
298  fmt=''
299  write(fmt,'(i4,".",i2)')s+1+digits,digits
300  fmt=adjustl(fmt)
301  write(fmt3,'("f",a5,",2x)")')fmt(1:5)
302 
303  write(iunit,fmt2//fmt3,advance='no')a(i)
304  end do
305 
306  write(iunit,'(" ];")')
307  write(iunit,'(" ")')
308 
309  return
310 
311 end subroutine qrm_prnt_zarray
subroutine qrm_prnt_carray(a, lab, digits, unit)
* s
Definition: secs.c:43
subroutine qrm_prnt_darray(a, lab, digits, unit)
subroutine qrm_prnt_iarray(a, lab, unit)
subroutine qrm_prnt_sarray(a, lab, digits, unit)
subroutine qrm_prnt_zarray(a, lab, digits, unit)
int i
Definition: secs.c:40