Trick for creating a large text file with known, fixed content?

[OP1]

Maybe there is a trick I am not aware of...

Assume I need my code to write a text file which content is fixed (say, a template file, or a mini help file) and which will not be modified by the code execution. The obvious solution is to create a subroutine with as many WRITE statements as there are lines of content to be produced. This becomes quickly cumbersome for larger files. Is there a workaround for this?

Thanks,
Olivier

[andrew_4619]

Why not have some template files in the program folder and just get the program to copy  the file? If it is s windows appliocation there is an sdk copyfile function interface in ifwin.

http://msdn.microsoft.com/en-gb/library/windows/desktop/aa363851(v=vs.85).aspx

[JVanB]

You could just have the code call EXECUTE_COMMAND_LINE to make a copy of the file, or a pair of READ and WRITE statements in a loop could copy it, possibly with a TRIM.  If you don't want your original file to have to be present for the executable to work, you could use the resource compiler to include the original in your executable then READ and WRITE the copy in a loop again.

[OP1]

Thanks - I will look into the resource compiler idea, as the original file(s) cannot be stored independently from the executable.

[Paul_Curtis]

If you initialize your fixed content in a (large) DATA statement as an array of lines, eg

INTEGER, PARAMETER :: numlines =1234

CHARACTER(LEN=80),DIMENSION(numlines) :: helptext

CHARACTER(LEN=2), PARAMETER :: crlf = CHAR(13)//CHAR(10)

DATA helptext (/"line1 ", &

                       "line 2  ",  &   ! and so forth

                       " lastline  "/)

then you can send your text to a file with only a single WRITE statement:

OPEN(3,FILE='HELPFILE.TXT', STATUS=NEW)

WRITE (3,'(10000A)') ((helptext(j)(1:LEN_TRIM(helptext(j)), crlf), j=1, numlines)

CLOSE(3)

[JVanB]

Just for fun I wrote out a working example with gfortran.  It will be slightly different with ifort -- let the other users show us the adjustments.

The input file, MyFile.txt:

Here is MyFile.txt
This is line 2
This is line 3

Since gfortran doesn't come with ifwin, we need to create our own ifwin.f90:

module ifwin
   use ISO_C_BINDING
   use ISO_C_BINDING, only: HANDLE => c_intptr_t
   use ISO_C_BINDING, only: DWORD => c_int32_t
   private
   public HANDLE, DWORD
   public GetLastError
   interface
      function GetLastError() bind(C,name='GetLastError')
         import
         implicit none
         !gcc$ attributes stdcall :: GetLastError
         integer(DWORD) GetLastError
      end function GetLastError
   end interface
   public FindResource
   interface
      function FindResource(hModule,lpName,lpType) bind(C,name='FindResourceA')
         import
         implicit none
         !gcc$ attributes stdcall :: FindResource
         integer(HANDLE) FindResource
         integer(HANDLE), value :: hModule
         character(kind=C_CHAR) lpName(*)
         character(kind=C_CHAR) lpType(*)
      end function FindResource
   end interface
   public LoadResource
   interface
      function LoadResource(hModule,hResInfo) bind(C,name='LoadResource')
         import
         implicit none
         !gcc$ attributes stdcall :: LoadResource
         integer(HANDLE) LoadResource
         integer(HANDLE), value :: hModule
         integer(HANDLE), value :: hResInfo
      end function LoadResource
   end interface
   public SizeofResource
   interface
      function SizeofResource(hModule,hResInfo) bind(C,name='SizeofResource')
         import
         implicit none
         !gcc$ attributes stdcall :: SizeofResource
         integer(DWORD) SizeofResource
         integer(HANDLE), value :: hModule
         integer(HANDLE), value :: hResInfo
      end function SizeofResource
   end interface
   public LockResource
   interface
      function LockResource(hResData) bind(C,name='LockResource')
         import
         implicit none
         !gcc$ attributes stdcall :: LockResource
         type(C_PTR) LockResource
         integer(HANDLE), value :: hResData
      end function LockResource
   end interface
end module ifwin

Then we need a simple txtresource.rc:

MyFile  256  MyFile.txt

And here is Fortran source code that can use the above, txtres.f90:

program txtres
   use ifwin
   use ISO_C_BINDING
   implicit none
   integer(HANDLE) res_HRSRC
   integer(HANDLE) res_HGLOBAL
   integer(DWORD) res_Size
   type(C_PTR) res_LPVOID
   character(len=:,kind=C_CHAR), pointer :: fptr
   integer iunit
   character (80) filename
   integer(C_INTPTR_T) int_lpType
   type(C_PTR) C_lpType
   character(kind=C_CHAR), pointer :: lpType

   int_lpType = 256
   C_lpType = transfer(int_lpType,C_lpType)
   call C_F_POINTER(C_lpType,lpType)
   res_HRSRC = FindResource(0_HANDLE,'MyFile'//achar(0),lpType)
   if(res_HRSRC == 0) then
      write(*,'(a,i0)') 'FindResource failed with error code ',GetLastError()
      stop
   end if
   res_HGLOBAL = LoadResource(0_HANDLE,res_HRSRC)
   if(res_HGLOBAL == 0) then
      write(*,'(a,i0)') 'LoadResource failed with error code ',GetLastError()
      stop
   end if
   res_Size = SizeofResource(0_HANDLE,res_HRSRC)
   if(res_Size == 0) then
      write(*,'(a,i0)') 'SizeofResource failed with error code ',GetLastError()
      stop
   end if
   res_LPVOID = LockResource(res_HGLOBAL)
   if(.NOT.C_ASSOCIATED(res_LPVOID)) then
      write(*,'(a,i0)') 'LockResource failed with error code ',GetLastError()
      stop
   end if
   block
      character(len=res_Size,kind=C_CHAR), pointer :: temp
      call C_F_POINTER(res_LPVOID, temp)
      fptr => temp
   end block
   filename = 'MyOutputFile.txt'
   open(newunit=iunit,file=filename,status='replace',access='stream')
   write(iunit) fptr
end program txtres

The sequence to compile in gfortran is as follows:

gfortran -c ifwin.f90
windres -i txtresource.rc -o txtresource.o
gfortran txtres.f90 ifwin.o txtresource.o -otxtres

Then after running txtres.exe, we get an output file MyOutputFile.txt:

Here is MyFile.txt
This is line 2
This is line 3

[OP1]

Thanks a lot Repeat Offender for your contribution. I agree this could easily be modified so that it can be used with IVF.

[andrew_4619]

Actually with the new release *today* that supports stdcall attribute with bind(c) you only need to replace the lines as below i think!

!gcc$ attributes stdcall  with  !DEC$ attributes stdcall 

[JVanB]

Oh, my!  I wasn't aware that Intel had sdtcall + bind(C) in the works, but now, as you say, it's there in the release notes. Yumyumyum...

Support for the BLOCK construct in today's ifort makes porting easier too, no longer requiring us to change over to a subroutine to get to a scope where we can name the LEN of a character variable pointer.

But what I was anticipating was that ifort users of my example would not want to write their own partial ifwin.mod but rather use the intrinsic version that comes with the compiler.  Certainly in that case we would have to modify the line

res_LPVOID = LockResource(res_HGLOBAL)

to

res_LPVOID = transfer(LockResource(res_HGLOBAL),res_LPVOID)

and maybe some other niggling things the compiler probably would warn us about, and of course invoking rc.exe works differently from windres.exe, but hopefully someone can make this work in ifort pretty quickly.