V3FIT
write_mod.f90
1  MODULE write_mod
2 !-------------------------------------------------------------------------------
3 !WRITE-WRITEs output in standardized formats
4 !
5 !WRITE_MOD is an F90 module of standarized output routines
6 !
7 !References:
8 !
9 ! W.A.Houlberg 7/2001
10 !
11 !Contains PUBLIC routines:
12 !
13 ! WRITE_OUT1 -writes 1D data
14 ! WRITE_C -writes character variables
15 ! WRITE_IR -writes integer and real variables
16 ! WRITE_LINE -writes a line
17 ! WRITE_LINE_IR -writes a writes a line plus integer and real numbers
18 !
19 !Comments:
20 !
21 ! The modernization of the code structure into an F90 module takes advantage of
22 ! some of the more attractive features of F90:
23 ! -use of KIND for precision declarations
24 ! -optional arguments for I/O
25 ! -generic names for all intrinsic functions
26 ! -compilation using either free or fixed form
27 ! -no common blocks or other deprecated Fortran features
28 ! -dynamic and automatic alocation of variables
29 ! -array syntax for vector operations
30 !-------------------------------------------------------------------------------
31  USE spec_kind_mod
32  IMPLICIT NONE
33 
34 !-------------------------------------------------------------------------------
35 ! Public procedures
36 !-------------------------------------------------------------------------------
37  CONTAINS
38 
39  SUBROUTINE write_out1(nout,c_nout,nx,nv,values,names,units,k_lr, &
40  & LABEL)
41 !-------------------------------------------------------------------------------
42 !WRITE_OUT1 writes 1D data to one of several files
43 !References:
44 ! W.A.Houlberg 7/2001
45 !Input:
46 ! nout -output file unit number [-]
47 ! c_nout -type of output file [character]
48 ! -'1d' for graphical post-processing file
49 ! -'sum' for summary file
50 ! -'netcdf' for netcdf file
51 ! nx -no. of variables [-]
52 ! nv -no. of points [-]
53 ! values(nx,nv) -values [-]
54 ! names(nv) -names of variables [character]
55 ! units(nv) -units of variables [character]
56 ! k_lr -option for shifting names and units [-]
57 ! =-1 shift left (remove leading blanks)
58 ! =+1 shift right (insert leading blanks)
59 ! =else no shift
60 !Optional input:
61 ! LABEL -label to insert as break in output file
62 !-------------------------------------------------------------------------------
63 
64 !Declaration of input variables
65  CHARACTER(len=*), INTENT(IN) :: &
66  & c_nout,names(:),units(:)
67 
68  INTEGER, INTENT(IN) :: &
69  & k_lr,nout,nx,nv
70 
71  REAL(KIND=rspec), INTENT(IN) :: &
72  & values(:,:)
73 
74 !Declaration of optional input variables
75  CHARACTER(len=*), INTENT(IN), OPTIONAL :: &
76  & label
77 
78 !Declaration of local variables
79  CHARACTER(len=120) :: &
80  & l
81 
82  CHARACTER(len=15) :: &
83  & cdum(6)
84 
85  CHARACTER(len=15), ALLOCATABLE :: &
86  & n(:),u(:)
87 
88  INTEGER :: &
89  & i,j,nx5,nv5,idum(5)
90 
91  REAL(KIND=rspec) :: &
92  & rdum(5)
93 
94  REAL(KIND=rspec), ALLOCATABLE :: &
95  & v(:,:)
96 
97 !-------------------------------------------------------------------------------
98 !Initialization
99 !-------------------------------------------------------------------------------
100 !Pad arrays to an even multiple of 5
101  nx5=((nx+4)/5)*5
102  nv5=((nv+4)/5)*5
103 
104 !Allocate padded temporary arrays
105  ALLOCATE(n(1:nv5),u(1:nv5),v(1:nx5,1:nv5))
106  n(:)='dummy'
107  u(:)='-'
108  v(:,:)=0.0_rspec
109 
110 !Copy and pad info
111  n(1:nv)=names(1:nv)
112  u(1:nv)=units(1:nv)
113  v(1:nx,1:nv)=values(1:nx,1:nv)
114 
115 !Shift names and units right, left, or leave untouched
116 
117  IF(k_lr == -1) THEN
118 
119  n(:)=adjustl(n)
120  u(:)=adjustl(u)
121 
122  ELSEIF(k_lr == 1) THEN
123 
124  n(:)=adjustr(n)
125  u(:)=adjustr(u)
126 
127  ENDIF
128 
129 !-------------------------------------------------------------------------------
130 !Print data to 1D file
131 !-------------------------------------------------------------------------------
132  IF(c_nout == '1d') THEN
133 
134 !Number of profiles and radial nodes
135  idum(1)=nv
136  idum(2)=nx
137  rdum(1)=0.0_rspec
138  CALL write_ir(nout,2,idum,0,rdum,15,0)
139 
140 !Names
141  DO j=1,nv5/5
142 
143  CALL write_c(nout,5,n(5*j-4),15)
144 
145  ENDDO
146 
147 !Units
148  DO j=1,nv5/5
149 
150  CALL write_c(nout,5,u(5*j-4),15)
151 
152  ENDDO
153 
154 !Values
155  idum(:)=0
156 
157  DO j=1,nv5
158 
159  DO i=1,nx5/5
160 
161  CALL write_ir(nout,0,idum,5,v(1+5*(i-1),j),15,2)
162 
163  ENDDO
164 
165  ENDDO
166 
167  ENDIF
168 
169 !-------------------------------------------------------------------------------
170 !Print data to summary file
171 !-------------------------------------------------------------------------------
172  IF(c_nout == 'sum') THEN
173 
174 !Label
175  IF(PRESENT(label)) CALL write_line(nout,label,1,1)
176 
177  l=''
178 
179  DO j=1,nv5/5
180 
181 !Names
182  cdum(1)=' i'
183  cdum(2:6)=n(5*(j-1)+1:5)
184  CALL write_line(nout,l,0,0)
185  CALL write_c(nout,6,cdum,15)
186 
187 !Units
188  cdum(1)=' -'
189  cdum(2:6)=u(5*(j-1)+1:5)
190  CALL write_c(nout,6,cdum,15)
191 
192 !Values
193  DO i=1,nx
194 
195  idum(1)=i
196  rdum(1:5)=v(i,5*(j-1)+1:5)
197  CALL write_ir(nout,1,idum,5,rdum,15,2)
198 
199  ENDDO
200 
201  ENDDO
202 
203  ENDIF
204 
205  END SUBROUTINE write_out1
206 
207  SUBROUTINE write_c(nout,n_c,c,n_l)
208 !-------------------------------------------------------------------------------
209 !WRITE_C writes out n_c character variables in fields of length n_l
210 !References:
211 ! W.A.Houlberg 7/2001
212 !Input:
213 ! nout -output file unit number [-]
214 ! n_c -number of character variables [-]
215 ! c(n_c) -column headings [character]
216 ! n_l -length of field [-]
217 !Comments:
218 ! This routine can be used to write out a set of column headings, variable
219 ! names or other appications that use a set of character strings
220 !-------------------------------------------------------------------------------
221 
222 !Declaration of input variables
223  INTEGER, INTENT(IN) :: &
224  & n_c, &
225  & n_l, &
226  & nout
227 
228  CHARACTER(len=*), INTENT(IN) :: &
229  & c(1:n_c)
230 
231 !Declaration of local variables
232  CHARACTER(len=30) :: &
233  & char
234 
235  CHARACTER(len=2) :: &
236  & c_c,c_l
237 
238  INTEGER :: &
239  & i
240 
241 !Use internal write to set number and length of fields
242  WRITE(c_c,'(i2)') n_c
243  WRITE(c_l,'(i2)') n_l
244 
245 !Set format
246  char='(1x,'//c_c//'a'//c_l//')'
247 
248 !Write
249  WRITE(nout,char) (c(i),i=1,n_c)
250 
251  END SUBROUTINE write_c
252 
253  SUBROUTINE write_ir(nout,n_i,i,n_r,r,n_l,k_format)
254 !-------------------------------------------------------------------------------
255 !WRITE_IR writes n_i integer variables followed by n_r real variables
256 !References:
257 ! W.A.Houlberg 7/2001
258 !Input:
259 ! nout -output file unit number [-]
260 ! n_i -number of integer variables [-]
261 ! i(n_i) -integer array [-]
262 ! n_r -number of real variables [-]
263 ! r(n_r) -real array [arb]
264 ! n_l -length of field [-]
265 ! k_format -real format option [-]
266 ! =1 use f
267 ! =2 use 1pe
268 ! =else use e
269 !-------------------------------------------------------------------------------
270 
271 !Declaration of input variables
272  INTEGER, INTENT(IN) :: &
273  & k_format, &
274  & n_i, &
275  & n_l, &
276  & n_r, &
277  & nout, &
278  & i(1:n_i)
279 
280  REAL(KIND=rspec), INTENT(IN) :: &
281  & r(1:n_r)
282 
283 !Declaration of local variables
284  CHARACTER(len=30) :: &
285  & char
286 
287  CHARACTER(len=2) &
288  & c_i,c_l,cp6_l,cp8_l,c_r
289 
290  INTEGER :: &
291  & j
292 
293 !Use internal write to set number and length of fields
294  WRITE(c_i,'(i2)') n_i
295  WRITE(c_l,'(i2)') n_l
296  IF(c_l(1:1) == ' ') c_l(1:1)='0'
297  WRITE(cp6_l,'(i2)') n_l-6
298  IF(cp6_l(1:1) == ' ') cp6_l(1:1)='0'
299  WRITE(cp8_l,'(i2)') n_l-8
300  IF(cp8_l(1:1) == ' ') cp8_l(1:1)='0'
301  WRITE(c_r,'(i2)') n_r
302 
303 !Set format
304  IF(n_i == 0) THEN
305 
306  !Real data only
307  IF(k_format == 1) THEN
308 
309  !f format
310  char='(1x,'//c_r//'(f'//c_l//'.'//cp6_l//'))'
311 
312  ELSEIF(k_format == 2) THEN
313 
314  !1pe format
315  char='(1x,'//c_r//'(1pe'//c_l//'.'//cp8_l//'))'
316 
317  ELSE
318 
319  !e format
320  char='(1x,'//c_r//'(e'//c_l//'.'//cp8_l//'))'
321 
322  ENDIF
323 
324  WRITE(nout,char) (r(j),j=1,n_r)
325 
326  ELSEIF(n_r == 0) THEN
327 
328  !Integer data only
329  char='(1x,'//c_i//'(i'//c_l//'))'
330  WRITE(nout,char) (i(j),j=1,n_i)
331 
332  ELSE
333 
334  !Both integer and real data
335  IF(k_format == 1) THEN
336 
337  !f format
338  char='(1x,'//c_i//'(i'//c_l//'),'//c_r &
339  & //'(f'//c_l//'.'//cp6_l//'))'
340 
341  ELSEIF(k_format == 2) THEN
342 
343  !1pe format
344  char='(1x,'//c_i//'(i'//c_l//'),'//c_r &
345  & //'(1pe'//c_l//'.'//cp8_l//'))'
346 
347  ELSE
348 
349  !e format
350  char='(1x,'//c_i//'(i'//c_l//'),'//c_r &
351  & //'(e'//c_l//'.'//cp8_l//'))'
352 
353  ENDIF
354 
355 !Output line
356  WRITE(nout,char) (i(j),j=1,n_i),(r(j),j=1,n_r)
357 
358  ENDIF
359 
360  END SUBROUTINE write_ir
361 
362  SUBROUTINE write_line(nout,label,k_above,k_below)
363 !-------------------------------------------------------------------------------
364 !WRITE_LINE writes a line (character string) preceeded by k_above blank lines
365 ! and followed by k_below blank lines
366 !References:
367 ! W.A.Houlberg 7/2001
368 !Input:
369 ! nout -output file unit number [-]
370 ! label -label to be printed [character]
371 ! k_above -number of blank lines above label [-]
372 ! k_below -number of blanklines below label [-]
373 !-------------------------------------------------------------------------------
374 
375 !Declaration of input variables
376  CHARACTER(len=*), INTENT(IN) :: &
377  & label
378 
379  INTEGER, INTENT(IN) :: &
380  & k_above,k_below, &
381  & nout
382 
383 !Declaration of local variables
384  INTEGER :: &
385  & j
386 
387 !Blank lines before text
388  IF(k_above > 0) THEN
389 
390  DO j=1,k_above !Over leading lines
391 
392  WRITE(nout,'( )')
393 
394  ENDDO !Over leading lines
395 
396  ENDIF
397 
398 !Text line
399  WRITE(nout,'(a)') label
400 
401 !Blank lines after text
402  IF(k_below > 0) THEN
403 
404  DO j=1,k_below !Over trailing lines
405 
406  WRITE(nout,'( )')
407 
408  ENDDO !Over trailing lines
409 
410  ENDIF
411 
412  END SUBROUTINE write_line
413 
414  SUBROUTINE write_line_ir(nout,label,n_i,i,n_r,r,n_l,k_format)
415 !-------------------------------------------------------------------------------
416 !WRITE_LINE_IR writes a line followed by n_i integer numbers and n_r real
417 ! numbers
418 !References:
419 ! W.A.Houlberg 7/2001
420 !Input:
421 ! nout -output file unit number [-]
422 ! label -label to be printed [character]
423 ! n_i -number of integer variables [-]
424 ! i(n_i) -integer array [-]
425 ! n_r -number of real variables [-]
426 ! r(n_r) -real array [-]
427 ! n_l -length of field [-]
428 ! k_format -format option for real variables [-]
429 ! =1 use f
430 ! =2 use 1pe
431 ! =else use e
432 !-------------------------------------------------------------------------------
433 
434 !Declaration of input variables
435  CHARACTER(len=*), INTENT(IN) :: &
436  & label
437 
438  INTEGER, INTENT(IN) :: &
439  & k_format, &
440  & n_i,n_l,n_r, &
441  & nout, &
442  & i(1:n_i)
443 
444  REAL(KIND=rspec), INTENT(IN) :: &
445  & r(1:n_r)
446 
447 !Declaration of local variables
448  CHARACTER(len=30) :: &
449  & char
450 
451  CHARACTER(len=2) :: &
452  & c_i,c_l,c_r
453 
454  INTEGER :: &
455  & j
456 
457 !Use internal write to set number and length of fields
458  WRITE(c_i,'(i2)') n_i
459  WRITE(c_r,'(i2)') n_r
460  WRITE(c_l,'(i2)') n_l
461 
462 !Set format
463  IF(n_i == 0) THEN
464 
465  !Real data only
466  IF(k_format == 1) THEN
467 
468  !f format
469  char='(a48,'//c_r//'(f'//c_l//'.6))'
470 
471  ELSEIF(k_format == 2) THEN
472 
473  !1pe format
474  char='(a48,'//c_r//'(1pe'//c_l//'.4))'
475 
476  ELSE
477 
478  !e format
479  char='(a48,'//c_r//'(e'//c_l//'.4))'
480 
481  ENDIF
482 
483  WRITE(nout,char) label,(r(j),j=1,n_r)
484 
485  ELSEIF(n_r == 0) THEN
486 
487  !Integer data only
488  char='(a48,'//c_i//'(i'//c_l//'))'
489  WRITE(nout,char) label,(i(j),j=1,n_i)
490 
491  ELSE
492 
493  !Both integer and real data
494  IF(k_format == 1) THEN
495 
496  !f format
497  char='(a48,'//c_i//'(i12),'//c_r//'(f'//c_l//'.6))'
498 
499  ELSEIF(k_format == 2) THEN
500 
501  !1pe format
502  char='(a48,'//c_i//'(i12),'//c_r//'(1pe'//c_l//'.4))'
503 
504  ELSE
505 
506  !e format
507  char='(a48,'//c_i//'(i12),'//c_r//'(e'//c_l//'.4))'
508 
509  ENDIF
510 
511 !Output line
512  WRITE(nout,char) label,(i(j),j=1,n_i),(r(j),j=1,n_r)
513 
514  ENDIF
515 
516  END SUBROUTINE write_line_ir
517 
518  END MODULE write_mod
Generated on Thu Mar 5 2020 15:49:25 for V3FIT by   doxygen 1.8.17