Here's the full code of my subprogram, SUBROUTINE FOPEN, followed by the full code of another subroutine it calls, SUBROUTINE GETFILENAME, and that of a utility subprogram, SUBROUTINE PARSEPATH, the purpose of which will be obvious.
What happens is that, at statement label 10, FOPEN calls GETFILENAME, WHICH USES DISLIN to display a filename requester dialog, which reads the filename the user enters into the dialog, and returns the file pathname via GETFILENAME back to FOPEN.
Immediately after statement label 10, FOPEN then stores the input filename in string variable InF (only for readability), and then uses InF as the filename in the statement,
OPEN(UNIT=LUI,
+ FILE=TRIM(InF),
+ STATUS='OLD',
+ ERR=50,
+ IOSTAT=IOCODE,
+ IOMSG=IOMSG)
SUBROUTINE FOpen
C ----------------
C jw / 25-07-12 1st draft started
C jw / 25-08-12 last rev.
C In any un-saved data then prompt to call FSave or FSaveAS if reqd.
C CALL ClearAllData
C CALL GetFileName
C Open the named INPUT file as a READ file on LUI at:
C TRIM(F%Path)//TRIM(F%Name)//'.'//TRIM(F%I%Ext).
C CALL ReadInput(LU)
C Close LUI
C Call the function CHANGED() to obtain a new ChkSUM
C Open the new OUTPUT file as a WRITE file on LUO at:
C TRIM(F%Path)//TRIM(F%Name)//'.rtf' .
C Leave LUO open.
C RETURN
USE Dislin
USE LUnits
USE Files
USE Params
USE WinSTUFF
USE Titles
CHARACTER*132 InF, OuF, BkF
CHARACTER*160 ErrPrmt
CHARACTER DateToday*9, IOMSG*120, I2CHAR*16
LOGICAL EXISTS, IsOPEN, DELETABLE, SavedIfWanted, CHANGED
INTEGER YN
C If any un-saved data then prompt to call FSave or FSaveAS as reqd.
IF(F%Named.AND.CHANGED()) THEN
CALL SWGWTH(-54)
ISel=3
CALL DWGlis
+ ('You still have unSAVEd data. SAVE it or lose it.',
+ 'Save|Save-AS|Continue without SAVing|Go back|Quit', ISel)
IF(ISel.EQ.1) THEN
CALL fSave
ELSE IF(ISel.EQ.2) THEN
CALL fSaveAs
ELSE IF(ISel.EQ.3) THEN
CONTINUE
ELSE IF(ISel.EQ.4) THEN
RETURN
ELSE
CALL CloseALL ! (ISel.EQ.4)
END IF
END IF
CALL CloseALL
CALL ClearAllData
UDat = DateToday()
NMATS = 0
NMTYP = 0
NNODE = 0
NMEMB = 0
NPRES = 0
NSPRI = 0
NLCAS = 0
IPAGE = 0
ILINE = 0
IF(F%I%OPEN) THEN
CLOSE(LUI)
LUISET = .FALSE.
F%I%OPEN = .FALSE.
F%I%LU = 0
END IF
CALL LUinit
10 CALL GetFileName(.TRUE.)
C InF = TRIM(F%NAME)//'.'//TRIM(F%I%EXT)
InF = TRIM(F%Path)//TRIM(F%Name)//'.'//TRIM(F%I%Ext)
Li = LEN_TRIM(InF)
C BAK FILE
BkF = TRIM(F%NAME)//'.'//'bak'
Lb = LEN_TRIM(BkF)
C OUTPUT FILE
OuF = TRIM(F%NAME)//'.rtf'
Lo = LEN_TRIM(OuF)
C INPUT FILE
C Attempt to open existing file
C -----------------------------
OPEN(UNIT=LUI,
+ FILE=TRIM(InF),
+ STATUS='OLD',
+ ERR=50,
+ IOSTAT=IOCODE,
+ IOMSG=IOMSG)
C File-open succeeded
C -------------------
C No ERR, set file-opened flag, read the file and close it
F%Named = .TRUE.
F%I%EXISTS = .TRUE.
LUISET = .TRUE.
F%I%OPEN = .TRUE.
F%I%LU = LUI
C Attempt to create and open an empty Output file
C -----------------------------------------------
IF(.NOT.EXISTS(TRIM(F%NAME)//'.rtf')
+ .OR. SavedIfWanted(LU,TRIM(F%NAME)//'.rtf'))
+ OPEN(UNIT=LUO,
+ FILE=TRIM(F%NAME)//'.rtf',
+ STATUS='NEW',
+ ERR=51,
+ IOSTAT=IOCODE)
C File-open succeeded
C -------------------
C No ERR, so say so and set the file-opened flag
LUOSET=.TRUE.
F%Named = .TRUE.
F%O%EXISTS = .TRUE.
F%O%OPEN = .TRUE.
F%O%LU = LUO
C Succesfully opened both an input file
C and the corresponding output file
C -------------------------------------
C Read the input data and close the input file
C Then initialise the output file
C
CALL SCRmsg('Reading input data from file '//TRIM(InF)//'.',
+ .FALSE.)
C -------------------
CALL ReadINput(LUI)
C -------------------
CLOSE(LUI, STATUS='KEEP',ERR=60,IOSTAT=IOCODE)
LUISET = .FALSE.
F%I%OPEN = .FALSE.
F%I%LU = 0
CALL SCRmsg('Output file ready for results: '//
+TRIM(F%NAME)//'.rtf',.FALSE.)
C All done successfully
C ---------------------
MORE = .TRUE.
CALL SENDOK
RETURN
C Failed to open an input file
C ----------------------------
50 IF(.NOT.EXISTS(TRIM(InF))) THEN
ErrPrmt='File '//TRIM(InF)//' not found.'
CALL PERROR(ErrPrmt)
ELSE
ErrPrmt='Unable to open file '//TRIM(InF)//'.'
CALL PERROR(ErrPrmt)
END IF
GO TO 90
C Failed to open an output file
C -----------------------------
51 ErrPrmt='Unable to open file '//TRIM(OuF)//'.'
GO TO 90
C Failed to close the input file
C ----------------------------
60 ErrPrmt='Unable to close file '//TRIM(InF)//'.'
CALL PERROR(ErrPrmt)
C GO TO 90
C Error recovery
C --------------
90 IF(F%I%OPEN) THEN
CALL ClearAllData
CLOSE(LUI)
LUISET = .FALSE.
F%I%OPEN = .FALSE.
F%I%LU = 0
END IF
IF(F%O%OPEN) THEN
CLOSE(LUO)
LUISET = .FALSE.
F%I%OPEN = .FALSE.
F%I%LU = 0
END IF
YN=1
CALL DWGBUT
+ ('ERROR: '//TRIM(ErrPrmt)//'|'//
+ 'IOSTAT error code '//TRIM(ADJUSTL(I2CHAR(IOCODE,iDum)))//'.|'//
+ TRIM(IOMSG)//'.||'//
+ 'Retry opening an input file?|'//
+ ' - YES to do so|'//
+ ' - NO to cancel',YN)
IF(YN.EQ.0) THEN
RETURN
ELSE
GO TO 10
END IF
RETURN
END
SUBROUTINE GetFileName(ChangePath)
C ----------------------------------
C jw / 25-07-12 1st draft started
C jw / 15-02-14 last rev.
C On returning from this subroutine:
C The INPUT file pathname should be stored in
C TRIM(F%Path)//TRIM(F%Name)//'.'//TRIM(F%I%Ext).
C F%I%Exists should indicate whether the INPUT file already exists.
C F%I%OPEN should indicate whether it is already open.
C F%bakExists should indicate whether the a BAK file already exists.
C (It should not be open).
C F%O%Exists should indicate whether the OUTPUT file already exists.
C F%O%OPEN should indicate whether it is already open.
USE Dislin
USE Files
LOGICAL EXISTS, ChangePath
C IF(F%Named) RETURN
C Input filename not yet known
F%Path = REPEAT(' ',128)
F%Name = REPEAT(' ',96)
F%I%Exists = .FALSE.
F%I%OPEN = .FALSE.
F%BAKexists = .FALSE.
F%BAKdeletable = .FALSE.
CALL SWGOPT('STANDARD','DIALOG') !Use STANDARD file dialog boxes
C Prompt user for a data input Path\filename.ext
F%Path = ' '
10 CALL DWGfil('Structure DATA filename',F%Path,'*.*')
CALL SWGOPT('TOP','DIALOG') !Keep all other dialog boxes on top
C Was a file actually selected or named by the user?
IF(LEN(F%Path).EQ.0) THEN
C No.
CALL BailOut('No input file provided.$', 'OPTIONS', 'YES')
RETURN
END IF
F%Named = .TRUE.
CALL ParsePath(F%PATH,F%Name,F%I%Ext)
IF(LEN_TRIM(F%I%Ext).EQ.0) F%I%Ext='ins'
F%O%Ext = 'rtf'
C Set the current directory to that of the chosen file
IF(ChangePath) CALL CHDIR(F%Path,iDone)
C INPUT FILE
C Does the named INPUT file already exist?
F%I%Exists=EXISTS(TRIM(F%Path)//TRIM(F%Name)//'.'//TRIM(F%I%Ext))
IF(F%I%Exists) THEN
C Yes, it exists
C Is it OPEN?
INQUIRE
+ (FILE=TRIM(F%Path)//TRIM(F%Name)//'.'//TRIM(F%I%Ext),
+ OPENED=F%I%OPEN)
C Is there a 'bak' file?
F%BAKexists = EXISTS(TRIM(F%Path)//TRIM(F%Name)//'.bak')
END IF
C OUTPUT FILE
F%O%Exists = EXISTS(TRIM(F%Path)//TRIM(F%Name)//'.rtf')
IF(F%I%Exists) THEN
C Yes, it exists
C Is it OPEN?
INQUIRE
+ (FILE=TRIM(F%Path)//TRIM(F%Name)//'.rtf',
+ OPENED=F%O%OPEN)
END IF
RETURN
END
SUBROUTINE ParsePath(PATH,NAME,EXT)
C -----------------------------------
C Parse PATHname into PATH (no filename), NAME and EXT
CHARACTER PATH*128, NAME*32, EXT*6
iLen=LEN(Trim(AdjustL(PATH)))
iBsl=INDEX(PATH,'\',.TRUE.)
iDot=INDEX(PATH,'.',.TRUE.)
IF(iDot.GT.iBsl) THEN
LenEXT=iLen-iDot
EXT(1:LenEXT) = PATH(iDot+1:iLen)
ELSE
iDot=iLEN+1
LenEXT=0
EXT=REPEAT(' ',12)
END IF
LenNAM=iDot-iBsl
NAME(1:LenNAM) = PATH(iBsl+1:iDot-1)
PATH=TRIM(PATH(1:iBsl)//REPEAT(' ',LenNAM+LenEXT+1))
C NAME=TRIM(NAME)//'.'//TRIM(EXT)
RETURN
END
The error I have reported is being thrown by FOPEN, using my error trap code.
Originally, I had the FOPEN assign only the filename, not the whole pathname, to string variable InF, using the statement you see commented out in my code, namely,
InF = TRIM(F%NAME)//'.'//TRIM(F%I%EXT)
This was the position until a few minutes ago. I had found that Windows was handling the path for me (I guess by remembering the path that was last used when DISLIN obtained a filename from a dialog box. All I had to do in the OPEN statement was give the filename, not the complete path. My error trap code quotes the filename it is having trouble with, and it had been correctly received from DISLIN. The filename was just, 'Hastings.ins'.
This was working perfectly well, as long as I ran the executable from inside SF.
I have now amended the code of FOPEN to substitute this assignment for the one referred to above:
InF = TRIM(F%Path)//TRIM(F%Name)//'.'//TRIM(F%I%Ext)
On re-testing the program, I have found EXACTLY THE SAME FLAWED BEHAVIOUR as before.
It all works when run from inside SF, but when the executable is run directly from Windows, it gives this error message (I hope you can see my screenshot):
----
John