How to write output to a string in fortran? - fortran

I need to write a formated output to a string DTSTR. It use to work under layhe fortran but not gfortran
INTEGER*2 MON,DAY,YEAR,HR,MINUTE,SEC,HUND
CHARACTER DY*2
CHARACTER DTSTR*24
COMMON /RD/ DTSTR
...
...
WRITE(DTSTR,10)MON,DAY,YEAR,HR,MINUTE,DY,' ]'
10 FORMAT('[ ',I2,'-',I2.2,'-',I4,2X,I2,':',I2.2,1X,2A2)
it empty just a empty line. If i use following it correctly output. But i want to store this string. Is it possible to do that with gnu fortran.
WRITE(*,10)MON,DAY,YEAR,HR,MINUTE,DY,' ]'
update
I am trying to compile following file. I think the problem might be with the COMMON.
PROGRAM HELO
CALL DOTIME
WRITE(*,5700)DTSTR
5700 FORMAT(24X,A24/)
END
SUBROUTINE DOTIME
C
IMPLICIT NONE
INTEGER*2 MON,DAY,YEAR,HR,MINUTE,SEC,HUND
CHARACTER DY*2
CHARACTER DTSTR*24
COMMON /RD/ DTSTR
integer values(8)
call date_and_time(VALUES=values)
YEAR = values(1)
MON = values(2)
DAY = values(3)
HR = values(5)
MINUTE = values(6)
SEC = values(7)
HUND = values(8)
C =================================================
C
C Incompitable function => CALL GETDAT(YEAR,MON,DAY)
C Incompitable function => GETTIM(HR,MINUTE,SEC,HUND)
IF(HR .GE. 12)THEN
IF(HR .NE. 12)HR=HR-12
DY='PM'
ELSE
DY='AM'
ENDIF
WRITE(DTSTR,10)MON,DAY,YEAR,HR,MINUTE,DY,' ]'
10 FORMAT('[ ',I2,'-',I2.2,'-',I4,2X,I2,':',I2.2,1X,2A2)
RETURN
END

Hmm? It works just fine for me:
program testwrite
implicit none
INTEGER :: MON,DAY,YEAR,HR,MINUTE,SEC,HUND
CHARACTER(LEN=2) :: DY
CHARACTER(LEN=24) :: DTSTR
MON = 4
DAY = 27
YEAR= 2010
HR = 13
MINUTE = 27
SEC = 0
HUND = 0
DY ='WE'
WRITE(DTSTR,10)MON,DAY,YEAR,HR,MINUTE,DY,' ]'
10 FORMAT('[ ',I2,'-',I2.2,'-',I4,2X,I2,':',I2.2,1X,2A2)
print *,'<',trim(DTSTR),'>'
end program testwrite
gives
<[ 4-27-2010 13:27 WE ]>
just as one would expect. Works with several versions of gfortran I have kicking around.
Update: Yes, the problem is in your common block. The common block isn't declared in the main program. But really, it's much simpler and much, much better practice just to pass the string as an argument:
PROGRAM HELO
IMPLICIT NONE
CHARACTER(LEN=24) :: DTSTR
CALL DOTIME(DTSTR)
WRITE(*,5700)DTSTR
5700 FORMAT(24X,A24/)
END
SUBROUTINE DOTIME(DTSTR)
C
IMPLICIT NONE
INTEGER*2 MON,DAY,YEAR,HR,MINUTE,SEC,HUND
CHARACTER DY*2
CHARACTER(LEN=24), INTENT(OUT) :: DTSTR

Related

Problems with unformatted file write/read compatibility between Intel Fortran and gfortran [duplicate]

This question already has answers here:
Unexpected "padding" in a Fortran unformatted file
(4 answers)
Closed 2 years ago.
I am trying to use a code on both Windows with an Intel compiler and on Mac OS with gfortran 6.5.0 and can't get the gfortran version to read parts of an unformatted file written on Windows. I wrote a test code that has the problematic section and verified it works in writing and reading the file on the Intel compiler and on the gfortran compiler. However, if I comment out the write portion and just try to read the file written on the Windows side of the machine (Parallels) with the gfortran version, some of the data is not read properly. I'm including the test code below. The "cel(1), f_ei,f_en,f_egyro,f_wall,f_ex,f_wallBC =" data are not read correctly (the data before that are read in properly, however). Is there some incompatibility in unformatted files?
PROGRAM Testo
IMPLICIT NONE
INTEGER, PARAMETER :: ncelMAX=6800
REAL*8 :: dt
LOGICAL :: MagON,BFmesh
INTEGER :: nslice_Ver, nslice_verzr, nslice_Edg, nslice_edgzr
INTEGER :: nFluid, nChrge, nCel, nBCs, nEdg, nVer , nCelzr, nBCszr, nEdgzr, &
nVerzr, MinSliceCel, MaxSliceCel, MinSliceCelzr, MaxSliceCelzr
TYPE cell_obj
INTEGER*4 verNo(4),edgNo(4)
INTEGER*4 Bln !BField Mesh
REAL*8 f_ei,f_en,f_egyro,f_wall,f_ex, f_wallBC
END TYPE cell_obj
TYPE(cell_obj) cel(ncelMAX)
dt = 2.0E-8
MagON = .TRUE.
BFmesh = .TRUE.
nslice_Ver = 1
nslice_verzr = 2
nslice_Edg = 3
nslice_edgzr = 4
nFluid = 3
nChrge = 3
nCel = 3000
nBCs = 4000
nEdg = 5000
nVer = 6000
nCelzr = 7000
nBCszr = 8000
nEdgzr = 9000
nVerzr = 10000
MinSliceCel = 100
MaxSliceCel = 200
MinSliceCelzr = 300
MaxSliceCelzr = 400
cel(1)%verNo(1) = 1
cel(1)%verNo(2) = 2
cel(1)%verNo(3) = 3
cel(1)%verNo(4) = 4
cel(1)%edgNo(1) = 1
cel(1)%edgNo(2) = 2
cel(1)%edgNo(3) = 3
cel(1)%edgNo(4) = 4
cel(1)%Bln = 1000
cel(1)%f_ei = 2.0E6
cel(1)%f_en = 2.0E7
cel(1)%f_egyro = 2.0E8
cel(1)%f_wall = 3.0E6
cel(1)%f_ex = 3.0E7
cel(1)%f_wallBC = 3.0E8
OPEN(UNIT=10,FILE='restartData_TEST',FORM='UNFORMATTED')
REWIND(10)
WRITE(10) dt, MagON, nslice_Ver, nslice_Edg, nslice_verzr, nslice_edgzr, BFmesh
WRITE(10) nFluid, nChrge, nCel, nBCs, nEdg, nVer , nCelzr, nBCszr, nEdgzr, nVerzr, MinSliceCel, MaxSliceCel,MinSliceCelzr,MaxSliceCelzr
WRITE(10) cel
CLOSE(10)
OPEN(UNIT=10,FILE='restartData_TEST',FORM='UNFORMATTED')
REWIND(10)
READ(10) dt,MagON,nslice_Ver,nslice_Edg, nslice_verzr, nslice_edgzr, BFmesh
PRINT *, "First line = ", dt,MagON,nslice_Ver,nslice_Edg, nslice_verzr, nslice_edgzr, BFmesh
READ(10) nFluid, nChrge, nCel, nBCs, nEdg, nVer , nCelzr, nBCszr, nEdgzr, nVerzr, MinSliceCel, MaxSliceCel,MinSliceCelzr,MaxSliceCelzr
PRINT *, "Second line = ", nFluid, nChrge, nCel, nBCs, nEdg, nVer , nCelzr, nBCszr, nEdgzr, nVerzr, MinSliceCel, MaxSliceCel,MinSliceCelzr,MaxSliceCelzr
READ(10) cel
PRINT *, "cel(1), verNo(4),edgNo(4) = ",cel(1)%verNo(1),cel(1)%verNo(2),cel(1)%verNo(3),cel(1)%verNo(4),cel(1)%edgNo(1),cel(1)%edgNo(2),cel(1)%edgNo(3),cel(1)%edgNo(4)
PRINT *, "cel(1), Bln = ",cel(1)%Bln
PRINT *, "cel(1), f_ei,f_en,f_egyro,f_wall,f_ex,f_wallBC = ",cel(1)%f_ei,cel(1)%f_en,cel(1)%f_egyro,cel(1)%f_wall,cel(1)%f_ex,cel(1)%f_wallBC
PAUSE 'DONE'
END PROGRAM Testo
There is absolutely no guarantee of the portability of Fortran unformatted files - if you don't use exactly the same hardware and compiler combination (down to the version of the compiler) all bets are off. If you need portability use a formatted file, or possibly stream I/O, or probably best one of the portable data formats such as netcdf (https://www.unidata.ucar.edu/software/netcdf/) or hdf5 (https://www.hdfgroup.org/solutions/hdf5/)
Also please don't use the non standard real*8 and integer*4 - see Fortran 90 kind parameter for how to do it properly

Arrays, functions, variables, and size() in Fortran 90

I'm very new to this language and have an assignment to convert some code from Fortran 77 to 90 and fix the code. I'm supposed to do the following:
Remove the implicit statement.
Convert array notation to fixed-shape [meaning IRAN(32) should be IRAN(:)]
Use the size() function to check the array size.
Any help on what to do here would be greatly appreciated. Based on the source code, I think I'm supposed to make a main program, then make subprogram makevec, which uses permutation function px(i); I'm not sure how to do this. Does this sound correct? What about the names of the variables? I looked up some of them (such as iran) and they seem to be related to random number generator modules (but again, I'm not sure of anything in this paragraph). I also found the modules "mod_kinds.F" and "ran_state.F" online but am not sure if they would help the purpose of this program.
I already removed the implicit statement in my program, declared some variables in the main program, and replaced the if loops with "select case (iran(i)." I also got rid of "return" and made everything lowercase.
Here is the source code :
SUBROUTINE MAKEVEC(NVAR,NOFIX,NRANFIX,IRAN,X,VALFIX,RANFIXEST,PX)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION IRAN(32),X(30),VALFIX(20),PX(32),RANFIXEST(20)
C THIS ROUTINE, CALLED BY MAIN, INPUTS NVAR, NOFIX, NRANFIX, IRAN,
C X, VALFIX, AND RANFIXEST, AND RETURNS PX(I) = A COMBINATION OF THE
C VALUES IN X, VALFIX, AND RANFIXEST, IN THE PROPER ORDER (AS
C DETERMINED BY IRAN).
NNNVAR = 0
NNNFIX = 0
NNNRANFIX = 0
DO I = 1,NVAR+NOFIX+NRANFIX
IF(IRAN(I) .EQ. 1) THEN
NNNVAR = NNNVAR+1
PX(I) = X(NNNVAR)
ENDIF
IF(IRAN(I) .EQ. 0) THEN
NNNFIX = NNNFIX+1
PX(I) = VALFIX(NNNFIX)
ENDIF
IF(IRAN(I) .EQ. 2) THEN
NNNRANFIX = NNNRANFIX+1
PX(I) = RANFIXEST(NNNRANFIX)
ENDIF
END DO
c write (,) "Initialized IG",NNNVAR,NNNFIX,NNNRANFIX
RETURN
END
This is what I have done so far (I know there is a lot of pseudocode and this won't compile):
program Initialized_IG
implicit none
interface
subroutine makevec(var,nofix,nranfix,iran,x,valfix,&
ranfixest,px)
real, intent (in) :: nvar,nofix,nranfix,iran,x,valfix,&
ranfixest
real, intent (out) :: px(i)
REAL(kind=8) :: i
real, dimension(32) :: iran, px
real, dimension(30) :: x
real, dimension(20) :: valfix, ranfixest
integer :: i,nnnvar,nofix,nranfix,sum
sum = nvar + nofix + nranfix
end interface
nnnvar = 0
nnnfix = 0
nnnranfix = 0
CALL RANDOM_NUMBER(i)
call subroutine makevec
select case (iran(i))
case (1)
nnnvar = nnnvar+1
px(i) = x(nnnvar)
case (0)
nnnfix = nnnfix+1
px(i) = valfix(nnnfix)
case (2)
nnnranfix = nnnranfix+1
px(i) = ranfixest(nnnranfix)
end select
write (*,*) "Initialized IG", nnnvar,nnnfix,nnnranfix
end program Initialized_IG

Fortran code gives outputs with only certain files

I have 4 .mtx files that I am reading the values from. Two of them run perfectly when read from with no issues and produce the correct outputs into a .DAT file. However, the last 2 are extremely large files; it appears the code correctly reads from the files and runs, but I get no outputs and no errors when reading from these 2...not even the code timer prints the time. Any help is much appreciated! Here is the code:
program proj2matrixC40
implicit none
integer,parameter::dp=selected_real_kind(15,307)
! Set Global Variables
real(kind=dp), allocatable::Ax(:,:),A(:,:),Iglobal(:,:)
integer::At(1,3)
integer::nnz,w,n,k,ii,ff,kk
real(kind=dp)::t1,t2
call cpu_time(t1)
open(unit=78,file="e40r5000.mtx",status='old')
read(78,*) At
close(unit=78)
nnz = At(1,3)
n = At(1,1)
k = 40
kk = 35
allocate(Ax(nnz+1,3),A(nnz,3),Iglobal(k,k))
open(unit=61,file="e40r5000.mtx",status='old')
do w=1,nnz+1
read(61,*) Ax(w,:)
end do
open (unit = 53, file = "proj2matrixC40points.dat")
do ff=1,k
do ii=1,k
Iglobal(ii,ff) = (ii/ff)*(ff/ii)
end do
end do
A(1:nnz,:) = Ax(2:nnz+1,:)
call Arno(A)
call cpu_time(t2)
print '("Time elapsed = ",f10.8," seconds")', (t2 - t1)
contains
subroutine Arno(a)
real(kind=dp), intent(in)::a(:,:)
real(kind=dp),dimension(k,k)::H
real(kind=dp),dimension(k,k+1)::u,q,qconj
real(kind=dp),dimension(k,1)::x0
integer::j,f
call random_number(x0)
q(:,1) = x0(:,1)/norm2(x0(:,1))
do f=1,k
call spmat(a,q(:,f),u(:,f))
do j=1,f
qconj(j,:) = (q(:,j))
H(j,f) = dot_product(qconj(j,:),u(:,f))
u(:,f) = u(:,f) - H(j,f)*q(:,j)
end do
if (f.lt.k) then
H(f+1,f) = norm2(u(:,f))
if (H(f+1,f)==0) then
print *, "Matrix is reducible"
stop
end if
q(:,f+1) = u(:,f)/H(f+1,f)
end if
if (f==k) then
call qrit(H)
end if
end do
end subroutine
! QR Iteration with Shifts Subroutine
subroutine qrit(a)
real(kind=dp), intent(in)::a(:,:)
real(kind=dp)::sigmak
real(kind=dp),dimension(kk,k)::dia
real(kind=dp),dimension(k,k)::Qfinal,Rfinal,HH
real(kind=dp),dimension(k,k,kk)::H0,needQR
integer::v,z
HH = a
H0(:,:,1) = HH
do v=1,kk
sigmak = H0(k,k,v)
if (v-1==0) then
needQR(:,:,v) = HH - sigmak*Iglobal
else
needQR(:,:,v) = H0(:,:,v-1) - sigmak*Iglobal
end if
call givens2(needQR(:,:,v),Rfinal,Qfinal)
H0(:,:,v) = matmul(Rfinal,Qfinal) + sigmak*Iglobal
do z = 1,k
dia(v,z) = H0(z,z,v)
write(53,*) v," ", dia(v,z) ! Write values to .DAT file
end do
end do
end subroutine
! Sparse Matrix Vector Multiplication Subroutine
subroutine spmat(a,b,c)
real(kind=dp), intent(in)::a(:,:)
real(kind=dp), intent(in), dimension(k,1)::b
real(kind=dp), intent(out), dimension(k,1)::c
integer::m,rowi,columni
real(kind=dp), dimension(k,1)::x,y
x = b
y(:,1) = 0
do m = 1,nnz
rowi = a(m,1)
columni = a(m,2)
y(rowi,1) = y(rowi,1) + a(m,3)*x(columni,1)
end do
c(:,1) = y(:,1)
end subroutine
! QR Factorization Givens Rotations Subroutine
subroutine givens2(a,Rfinal,Qfinal)
real(kind=dp), intent(in)::a(:,:)
real(kind=dp), dimension(k,k,(k*k))::G,QQ
real(kind=dp), dimension(k,k), intent(out)::Rfinal,Qfinal
real(kind=dp), dimension(k,k)::I2,y,aa
real(kind=dp), dimension(1,k)::ek1,ek2
real(kind=dp)::c,s
integer::kt,m,nn,j,i,l,p
m = size(a,1)
nn = size(a,2)
aa = a
i = 1
do kt=1,nn-1
do j=m,kt+1,-1
if (aa(j,kt).eq.0) then
continue
else
ek1(1,:) = 0
ek2(1,:) = 0
do p=1,m
do l=1,m
I2(l,p) = (l/p)*(p/l)
end do
end do
c = aa(kt,kt)/sqrt(aa(kt,kt)**2 + aa(j,kt)**2)
s = aa(j,kt)/sqrt(aa(kt,kt)**2 + aa(j,kt)**2)
ek1(1,kt) = c
ek1(1,j) = s
ek2(1,kt) = -s
ek2(1,j) = c
I2(kt,:) = ek1(1,:)
I2(j,:) = ek2(1,:)
G(:,:,i) = I2
if (i.eq.1) then
QQ(:,:,i) = G(:,:,i)
else
QQ(:,:,i) = matmul(G(:,:,i),QQ(:,:,i-1))
end if
y = matmul(G(:,:,i),aa)
aa = y
if (kt.eq.nn-1) then
if (j.eq.kt+1) then
Qfinal = transpose(QQ(:,:,i))
Rfinal = aa
end if
end if
i = i + 1
end if
end do
end do
end subroutine
end program proj2matrixC40
A couple notes. The line which I put asterisks around (for this question) call mat_print('H',H) can't be deleted otherwise I get the wrong answers (this is strange...thoughts?). Also so your computer won't freeze opening the big files, their names are 'e40r5000.mtx' and 's3dkt3m2.mtx' (these are the two I have issues with). I am using gfortran version 8.1.0
Here is the link to the files
https://1drv.ms/f/s!AjG0dE43DVddaJfY62ABE8Yq3CI
When you need to add a call to a subroutine that shouldn't actually change anything in order to get things working, you probably have a memory corruption. This happens most often when you access arrays outside of their boundaries.
I have compiled it with some run time checks:
gfortran -o p2m -g -O0 -fbacktrace -fcheck=all -Wall proj2mat.f90
And it's already giving me some issues:
It's warning me about implicit type conversions. That shouldn't be too much of an issue if you trust your data.
In line 46 you have an array length mismatch (x0(:, 1) has length 40, q(:,1) is 41)
Similarly on line 108 (x=b) x is really large, but b is only 41 long.
I have stopped now, but I implore you to go through your code and clean it up. Use the compiler options above which will let you know when and where there is an array bound violation.

Reading multiple files and storing data in fortran 77 [duplicate]

I have a program in Fortran that saves the results to a file. At the moment I open the file using
OPEN (1, FILE = 'Output.TXT')
However, I now want to run a loop, and save the results of each iteration to the files 'Output1.TXT', 'Output2.TXT', 'Output3.TXT', and so on.
Is there an easy way in Fortran to constuct filenames from the loop counter i?
you can write to a unit, but you can also write to a string
program foo
character(len=1024) :: filename
write (filename, "(A5,I2)") "hello", 10
print *, trim(filename)
end program
Please note (this is the second trick I was talking about) that you can also build a format string programmatically.
program foo
character(len=1024) :: filename
character(len=1024) :: format_string
integer :: i
do i=1, 10
if (i < 10) then
format_string = "(A5,I1)"
else
format_string = "(A5,I2)"
endif
write (filename,format_string) "hello", i
print *, trim(filename)
enddo
end program
A much easier solution IMHO ...................
character(len=8) :: fmt ! format descriptor
fmt = '(I5.5)' ! an integer of width 5 with zeros at the left
i1= 59
write (x1,fmt) i1 ! converting integer to string using a 'internal file'
filename='output'//trim(x1)//'.dat'
! ====> filename: output00059.dat
Well here is a simple function which will return the left justified string version of an integer:
character(len=20) function str(k)
! "Convert an integer to string."
integer, intent(in) :: k
write (str, *) k
str = adjustl(str)
end function str
And here is a test code:
program x
integer :: i
do i=1, 100
open(11, file='Output'//trim(str(i))//'.txt')
write (11, *) i
close (11)
end do
end program x
I already showed this elsewhere on SO (How to use a variable in the format specifier statement? , not an exact duplicate IMHO), but I think it is worthwhile to place it here. It is possible to use the techniques from other answers for this question to make a simple function
function itoa(i) result(res)
character(:),allocatable :: res
integer,intent(in) :: i
character(range(i)+2) :: tmp
write(tmp,'(i0)') i
res = trim(tmp)
end function
which you can use after without worrying about trimming and left-adjusting and without writing to a temporary variable:
OPEN(1, FILE = 'Output'//itoa(i)//'.TXT')
It requires Fortran 2003 because of the allocatable string.
For a shorten version.
If all the indices are smaller than 10, then use the following:
do i=0,9
fid=100+i
fname='OUTPUT'//NCHAR(i+48) //'.txt'
open(fid, file=fname)
!....
end do
For a general version:
character(len=5) :: charI
do i = 0,100
fid = 100 + i
write(charI,"(A)"), i
fname ='OUTPUT' // trim(charI) // '.txt'
open(fid, file=fname)
end do
That's all.
I've tried #Alejandro and #user2361779 already but it gives me an unsatisfied result such as file 1.txt or file1 .txt instead of file1.txt. However i find the better solution:
...
integer :: i
character(len=5) :: char_i ! use your maximum expected len
character(len=32) :: filename
write(char_i, '(I5)') i ! convert integer to char
write(filename, '("path/to/file/", A, ".dat")') trim(adjustl(char_i))
...
Explanation:
e.g. set i = 10 and write(char_i, '(I5)') i
char_i gives " 10" ! this is original value of char_i
adjustl(char_i) gives "10 " ! adjust char_i to the left
trim(adjustl(char_i)) gives "10" ! adjust char_i to the left then remove blank space on the right
I think this is a simplest solution that give you a dynamical length filename without any legacy blank spaces from integer to string conversion process.
Try the following:
....
character(len=30) :: filename ! length depends on expected names
integer :: inuit
....
do i=1,n
write(filename,'("output",i0,".txt")') i
open(newunit=iunit,file=filename,...)
....
close(iunit)
enddo
....
Where "..." means other appropriate code for your purpose.
To convert an integer to a string:
integer :: i
character* :: s
if (i.LE.9) then
s=char(48+i)
else if (i.GE.10) then
s=char(48+(i/10))// char(48-10*(i/10)+i)
endif
Here is my subroutine approach to this problem. it transforms an integer in the range 0 : 9999 as a character. For example, the INTEGER 123 is transformed into the character 0123. hope it helps.
P.S. - sorry for the comments; they make sense in Romanian :P
subroutine nume_fisier (i,filename_tot)
implicit none
integer :: i
integer :: integer_zeci,rest_zeci,integer_sute,rest_sute,integer_mii,rest_mii
character(1) :: filename1,filename2,filename3,filename4
character(4) :: filename_tot
! Subrutina ce transforma un INTEGER de la 0 la 9999 in o serie de CARACTERE cu acelasi numar
! pentru a fi folosite in numerotarea si denumirea fisierelor de rezultate.
if(i<=9) then
filename1=char(48+0)
filename2=char(48+0)
filename3=char(48+0)
filename4=char(48+i)
elseif(i>=10.and.i<=99) then
integer_zeci=int(i/10)
rest_zeci=mod(i,10)
filename1=char(48+0)
filename2=char(48+0)
filename3=char(48+integer_zeci)
filename4=char(48+rest_zeci)
elseif(i>=100.and.i<=999) then
integer_sute=int(i/100)
rest_sute=mod(i,100)
integer_zeci=int(rest_sute/10)
rest_zeci=mod(rest_sute,10)
filename1=char(48+0)
filename2=char(48+integer_sute)
filename3=char(48+integer_zeci)
filename4=char(48+rest_zeci)
elseif(i>=1000.and.i<=9999) then
integer_mii=int(i/1000)
rest_mii=mod(i,1000)
integer_sute=int(rest_mii/100)
rest_sute=mod(rest_mii,100)
integer_zeci=int(rest_sute/10)
rest_zeci=mod(rest_sute,10)
filename1=char(48+integer_mii)
filename2=char(48+integer_sute)
filename3=char(48+integer_zeci)
filename4=char(48+rest_zeci)
endif
filename_tot=''//filename1//''//filename2//''//filename3//''//filename4//''
return
end subroutine nume_fisier

Optimizing Fortran ascii file IO

I'm working on a project where I need to write some existing data to disk as ascii. I have something that works, but the IO itself is quite expensive and I'd like to optimise it further.
The data is basically an array of reals, however some of the columns store encoded strings which need to be recast as character strings (don't ask!). The input and output of this problem are beyond my control, I am receiving this real array and need to write it out as ascii.
I know that writing the array in one go as an unformatted write is faster, but this doesn't deal with the string columns correctly. Any ideas?
Here is some example code:
program test
implicit none
integer(kind=4), parameter :: nrows = 5000
integer(kind=4), parameter :: ncols = 400
integer, parameter :: real_kind = 8
integer(kind=4) :: i,j, handle
character(len=256) :: value_str
character(len=1) :: delimiter
real(kind=real_kind) :: data(nrows,ncols)
delimiter = " "
data(:,:) = 999.999
! Some examples of the "string columns"
data(:,10) = transfer(' foo ',data(1,1))
data(:,20) = transfer(' bar ',data(1,1))
handle=10
open(handle,file="out.txt",status="replace", access="stream")
do i=1,nrows
do j=1,ncols
! If this column contains encoded strings then recast
if((j==10).or.(j==20))then
write(handle) delimiter
value_str = transfer(data(i,j),value_str(1:real_kind))
write(handle) trim(value_str)
else
write(value_str,*) data(i,j)
write(handle) trim(value_str)
endif
enddo
write(handle) new_line('x')
enddo
close(handle)
end program test
gfortran test.F90 -o test.x
time test.x
real 0m2.65s
user 0m2.24s
sys 0m0.04s
Edit: removed "if(j/=1)" from original test.F90 code sample in response to comment.
Use the free formatting and have the system handle more for you. In this proposition, I handle the transfer beforehand and use a single loop to write the data to file. This is handy if you have only few columns of character data like the 2 in your example.
Your code will look like this
program test
implicit none
integer(kind=4), parameter :: nrows = 5000
integer(kind=4), parameter :: ncols = 400
integer, parameter :: real_kind = 8
integer, parameter :: pos1 = 10 ! I like named constants
integer, parameter :: pos2 = 20 ! I like named constants
integer(kind=4) :: i,j, handle
character(len=256) :: value_str
character(len=1) :: delimiter
real(kind=real_kind) :: data(nrows,ncols)
character(real_kind), dimension(nrows,2) :: cdata ! two columns array for
delimiter = " "
data(:,:) = 999.999
! Some examples of the "string columns"
data(:,pos1) = transfer(' foo ',data(1,1))
data(:,pos2) = transfer(' bar ',data(1,1))
handle=10
open(handle,file="out.txt",status="replace", form="formatted")
! Transfer beforehand
cdata(:,1) = transfer( data(:,pos1), cdata(1,1) )
cdata(:,2) = transfer( data(:,pos2), cdata(1,1) )
do i=1,nrows
write(handle,*) data(i,1:pos1-1), cdata(i,1)&
, data(i,pos1+1:pos2-1), cdata(i,2)&
, data(i,pos2+1:)
enddo
close(handle)
end program test
and give this timing
time ./test.x
real 0m1.696s
user 0m1.661s
sys 0m0.029s
instead of
time ./test.x
real 0m2.654s
user 0m2.616s
sys 0m0.032s
On my computer