39 SUBROUTINE write_out1(nout,c_nout,nx,nv,values,names,units,k_lr, &
65 CHARACTER(len=*),
INTENT(IN) ::
68 INTEGER,
INTENT(IN) ::
71 REAL(KIND=rspec),
INTENT(IN) ::
75 CHARACTER(len=*),
INTENT(IN),
OPTIONAL ::
85 CHARACTER(len=15),
ALLOCATABLE ::
94 REAL(KIND=rspec),
ALLOCATABLE ::
105 ALLOCATE(n(1:nv5),u(1:nv5),v(1:nx5,1:nv5))
113 v(1:nx,1:nv)=values(1:nx,1:nv)
122 ELSEIF(k_lr == 1)
THEN
132 IF(c_nout ==
'1d')
THEN
138 CALL write_ir(nout,2,idum,0,rdum,15,0)
143 CALL write_c(nout,5,n(5*j-4),15)
150 CALL write_c(nout,5,u(5*j-4),15)
161 CALL write_ir(nout,0,idum,5,v(1+5*(i-1),j),15,2)
172 IF(c_nout ==
'sum')
THEN
175 IF(
PRESENT(label))
CALL write_line(nout,label,1,1)
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)
189 cdum(2:6)=u(5*(j-1)+1:5)
190 CALL write_c(nout,6,cdum,15)
196 rdum(1:5)=v(i,5*(j-1)+1:5)
197 CALL write_ir(nout,1,idum,5,rdum,15,2)
205 END SUBROUTINE write_out1
207 SUBROUTINE write_c(nout,n_c,c,n_l)
223 INTEGER,
INTENT(IN) ::
228 CHARACTER(len=*),
INTENT(IN) ::
242 WRITE(c_c,
'(i2)') n_c
243 WRITE(c_l,
'(i2)') n_l
246 char=
'(1x,'//c_c//
'a'//c_l//
')'
249 WRITE(nout,char) (c(i),i=1,n_c)
251 END SUBROUTINE write_c
253 SUBROUTINE write_ir(nout,n_i,i,n_r,r,n_l,k_format)
272 INTEGER,
INTENT(IN) ::
280 REAL(KIND=rspec),
INTENT(IN) ::
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
307 IF(k_format == 1)
THEN
310 char=
'(1x,'//c_r//
'(f'//c_l//
'.'//cp6_l//
'))'
312 ELSEIF(k_format == 2)
THEN
315 char=
'(1x,'//c_r//
'(1pe'//c_l//
'.'//cp8_l//
'))'
320 char=
'(1x,'//c_r//
'(e'//c_l//
'.'//cp8_l//
'))'
324 WRITE(nout,char) (r(j),j=1,n_r)
326 ELSEIF(n_r == 0)
THEN
329 char=
'(1x,'//c_i//
'(i'//c_l//
'))'
330 WRITE(nout,char) (i(j),j=1,n_i)
335 IF(k_format == 1)
THEN
338 char=
'(1x,'//c_i//
'(i'//c_l//
'),'//c_r
339 & //
'(f'//c_l//
'.'//cp6_l//
'))'
341 ELSEIF(k_format == 2)
THEN
344 char=
'(1x,'//c_i//
'(i'//c_l//
'),'//c_r
345 & //
'(1pe'//c_l//
'.'//cp8_l//
'))'
350 char=
'(1x,'//c_i//
'(i'//c_l//
'),'//c_r
351 & //
'(e'//c_l//
'.'//cp8_l//
'))'
356 WRITE(nout,char) (i(j),j=1,n_i),(r(j),j=1,n_r)
360 END SUBROUTINE write_ir
362 SUBROUTINE write_line(nout,label,k_above,k_below)
376 CHARACTER(len=*),
INTENT(IN) ::
379 INTEGER,
INTENT(IN) ::
399 WRITE(nout,
'(a)') label
412 END SUBROUTINE write_line
414 SUBROUTINE write_line_ir(nout,label,n_i,i,n_r,r,n_l,k_format)
435 CHARACTER(len=*),
INTENT(IN) ::
438 INTEGER,
INTENT(IN) ::
444 REAL(KIND=rspec),
INTENT(IN) ::
458 WRITE(c_i,
'(i2)') n_i
459 WRITE(c_r,
'(i2)') n_r
460 WRITE(c_l,
'(i2)') n_l
466 IF(k_format == 1)
THEN
469 char=
'(a48,'//c_r//
'(f'//c_l//
'.6))'
471 ELSEIF(k_format == 2)
THEN
474 char=
'(a48,'//c_r//
'(1pe'//c_l//
'.4))'
479 char=
'(a48,'//c_r//
'(e'//c_l//
'.4))'
483 WRITE(nout,char) label,(r(j),j=1,n_r)
485 ELSEIF(n_r == 0)
THEN
488 char=
'(a48,'//c_i//
'(i'//c_l//
'))'
489 WRITE(nout,char) label,(i(j),j=1,n_i)
494 IF(k_format == 1)
THEN
497 char=
'(a48,'//c_i//
'(i12),'//c_r//
'(f'//c_l//
'.6))'
499 ELSEIF(k_format == 2)
THEN
502 char=
'(a48,'//c_i//
'(i12),'//c_r//
'(1pe'//c_l//
'.4))'
507 char=
'(a48,'//c_i//
'(i12),'//c_r//
'(e'//c_l//
'.4))'
512 WRITE(nout,char) label,(i(j),j=1,n_i),(r(j),j=1,n_r)
516 END SUBROUTINE write_line_ir