- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
In a program I declare:
CHARACTER*4 PREVFILE
CHARACTER*60 PRINTFILE
In the program the following is checked:
IF(Printfile(1:4).NE.PREVFILE)LOWPAGE=0
During execution, the program fails with the message:
forrtl: severe (408): fort: (18) Dummy character variable ‘PRINTFILE has
length 60 which is greater than actual variable length 4.
The program is about to be migrated from CVF to IVF, I do not understand what is wrong.
Can anyone give me a tip ?
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
From the message I see that you are using this in a subroutine. So we need to see how you invoke that and how the variables and dummy arguments are actually declared. The best way is a small program that exhibits the offending behaviour.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Well, here it comes. Maybe I should add I use similar construction in IVF, In fact derived from this.. CH*****----------------------------------------------------------------- SUBROUTINE GRAFMODE(VMODE,DOCMODE,Printfile,NOC,PIC,PSIZE,WTITLE) c----------------------------------------------------------------------- c Purpose: Set videomode and document mode (POSTscript or HPGL2) c by call at initializing a program. c c Input: C c VMODE = Pointer to graphical mode,see"MODE". (Integer ) C DOCMODE = Document mode (POST, HPGL2) (Character*6) c Printfile = Output print-file (Character ) C NOC = Number of characters in file name (Integer) C PIC = Plot type P = portrait, L= landscape (Character ) c PSIZE = Page size A3, A4 or A5 (Character ) c WTITLE = Window title. (Character ) C C Out/input to ENDPICTURE c By common FILEX: c LOWPAGE = Twiddle factor. c = 0 if print at upper part only (A5 plot) c = 1 if print at both upper and lower or only at lower c part if A5 plot. C c By common PROGEND: c FF_MISSING= Logical variable=.TRUE. when to print PUSP0PG (HPGL); c CPY_PIC = Logical variable=.TRUE. when key "C" has been pressed. c Programmed 25th. May 1994 by RJT ! INCLUDE 'FGRAPH.FD' MS Power Station ! USE DFLIB USE DFLIB INTEGER*4 MAXX, MAXY,NPIX(2),TFX,TFY,LOWPAGE,IPLOT,VMODE,ALFA CHARACTER*34 LINTYP(8) / ! Max. =8 + 'UL1,100 ', + 'UL2,80,10,0,10 ', + 'UL3,25,25,25,25 ', + 'UL4,60,10,0,10,0,10,10 ', + 'UL5,20,10,10,10,10,10,10,10,10 ', + 'UL6,40,10,0,10,0,10,0,10,0,10,0,10', + 'UL7,40,10,0,10,0,10,0,10,0,10,0,10', + 'UL8,12,13,12,13,12,13,12,13 '/ c + 'UL9,75,7,11,7 ', c + 'UL8,40,10,0,10,0,10,0,10,0,10,0,10', CHARACTER*4 EXT,PREVFILE CHARACTER*6 DRIVER,AUXDRV,DOCMODE CHARACTER*(*) PIC,PSIZE CHARACTER*(*) WTITLE CHARACTER*60 PSFILE,PRINTFILE ! CHARACTER*(*) PSFILE,PRINTFILE ! 23/6-05 CHARACTER*50 INI_HPGL2 LOGICAL FF_MISSING,CPY_PIC LOGICAL wstatus TYPE (windowconfig) myscreen COMMON/GRAPH_DEV/DRIVER,AUXDRV,NPIX,IFTYPE(3),IDEVP COMMON/FILEX/IDNR,PSFILE,LOWPAGE,IPLOT ! Variables are set in this routine COMMON/PROGEND/FF_MISSING,CPY_PIC INI_HPGL2='%-1BBPINLO1PW0.30' EXT='. ' ALFA=0 IVM=0 IF(Printfile(1:4).NE.PREVFILE)LOWPAGE=0 ! If file name is changed ! start from top 17/12-98 PREVFILE=Printfile(1:4) IF(DOCMODE(1:4).EQ.'POST')THEN NPIX(1)=830 NPIX(2)=580 PIXH=580. PIXV=830. ELSEIF(DOCMODE(1:5).EQ.'HPGL2')THEN NPIX(1)=830 NPIX(2)=580 PIXH=11500. PIXV= 8000. ENDIF IF(VMODE.NE.0)THEN DRIVER='GRAF' ! SUBROUTINE OPEN_WINDOW(IDEV,MAXX,MAXY,IWX,IWY,WTITLE) ! CALL OPEN_WINDOW(6,maxx,maxy,200,200,WTITLE//char(0)) IF(VMODE.GT.0)then CALL graphicsmode(maxx,maxy,WTITLE//char(0)) else call Get_VIDEO (maxx,maxy) !iwret,ihret) 22/1-04 endif !OPEN(UNIT=6,FILE='USER',TITLE=WTITLE) if(maxy.ne.0)NPIX(1)=maxy ! 11/11-03 if(maxx.ne.0)NPIX(2)=maxx ! NPIX(1)=maxy ! NPIX(2)=maxx ENDIF IF(DOCMODE(1:4).eq.'POST'.or.IVM.eq.18)THEN AUXDRV='POST' IDEVP=65 IPLOT=66 if(IDNR.le.0)IDNR=1 INDX=INDEX(Printfile(1:NOC),'.') if(indx.eq.0)indx=1 ! PSFILE(1:30)='' PSFILE ='' WRITE(PSFILE(1:INDX-1),FMT='(A)')PRINTFILE(1:INDX-1) c WRITE(PSFILE(INDX:INDX+2),FMT='(1H.,I2.2)')IDNR IF(PRINTFILE(INDX+1:INDX+3).ne.'REP')THEN WRITE(PSFILE(INDX:INDX+2),FMT='(3H.PS)') OPEN(UNIT=IPLOT,FILE=PSFILE,err=999) ENDIF OPEN(UNIT=IDEVP,FILE='PDUMP.SCR',err=500) GOTO 501 500 OPEN(UNIT=IDEVP,FILE='PDUMP1.SCR',err=998) ! Alternative 501 REWIND(UNIT=IDEVP) WRITE(IDEVP,FMT='(T1,"%! PS-Adobe")') ! WRITE(IDEVP, ! + FMT='(T1,"%-------- PS-Adobe PS driver ------------- ")') WRITE(IDEVP, + FMT='(T1,"%-------- TVA Ver.4.6.2 - 2007 by RJT----")') ! call PAGEINI IF(PSIZE(1:2).EQ.'A3')THEN PIXH=830. PIXV=1160. LOWPAGE=1 ELSEIF(PSIZE(1:2).EQ.'A4')THEN ! PIXH=580. ! PIXV=830. PIXH=560. ! 20/11-2000 PIXV=798. TFX=40 TFY=35 LOWPAGE=1 ELSEIF(PSIZE(1:2).EQ.'A5')THEN PIXH=480. PIXV=360. PIC(1:1)='P' IF(LOWPAGE.NE.1)THEN TFX=70 TFY=430 FF_MISSING=.FALSE. ELSEIF(LOWPAGE.EQ.1)THEN TFX=0 TFY=-500*npix(1)/480 PIXH=0. ! scaling must not PIXV=0. ! be changed !! FF_MISSING=.TRUE. ENDIF ENDIF IF(PIC(1:1).EQ.'P')THEN SCALY=PIXV/FLOAT(NPIX(1)) SCALX=PIXH/FLOAT(NPIX(2)) if(scaly.gt.1.45)scaly=1.45 if(scalx.gt.0.85)scalx=0.85 ELSEIF(PIC(1:1).EQ.'L')THEN SCALY=PIXH/FLOAT(NPIX(1)) SCALX=PIXV/FLOAT(NPIX(2)) if(scaly.gt.1.10)scaly=1.10 if(scalx.gt.1.20)scalx=1.20 TFX=580 TFY=30 ALFA=90 ENDIF WRITE(IDEVP,FMT='(T5,I4,1H ,I4,10H translate)')TFX,TFY WRITE(IDEVP,FMT='(T5,I4,7H rotate)')ALFA IF(SCALX.NE.0.AND.SCALY.NE.0.)THEN WRITE(IDEVP,FMT='(T5,2F5.2,6H scale)')SCALX,SCALY ENDIF ENDIF c HPGL-2 Plotting........................ IF(DOCMODE(1:5).eq.'HPGL2')THEN PIXH=11500. PIXV= 8000. IDEVP=65 IPLOT=66 AUXDRV='HPGL2' if(IDNR.le.0)IDNR=1 INDX=INDEX(Printfile(1:NOC),'.') PSFILE(1:30)=' ' WRITE(PSFILE(1:INDX-1),FMT='(A)')PRINTFILE(1:INDX-1) c WRITE(PSFILE(INDX:INDX+2),FMT='(1H.,I2.2)')IDNR WRITE(PSFILE(INDX:INDX+3),FMT='(4H.HGL)') OPEN(UNIT=IPLOT,FILE=PSFILE,err=999) OPEN(UNIT=IDEVP,FILE='PDUMP.SCR',err=998) REWIND(UNIT=IDEVP) C A-3 IF(PSIZE(1:2).EQ.'A3')THEN WRITE(*,*)' A3 - HPGL error ' PIXH=830. PIXV=1160. LOWPAGE=1 C A-4 "Landscape and Portrait.......................... ELSEIF(PSIZE(1:2).EQ.'A4')THEN IF(FF_MISSING)THEN WRITE(IPLOT,FMT='(T5,8HPUSP0PG;)') FF_MISSING=.FALSE. ENDIF WRITE(IDEVP,FMT='(T5,2A)')CHAR(27),INI_HPGL2 IPX1=300 IPY1=300 IPX2=11400 IPY2=7900 LOWPAGE=1 IF(PIC(1:1).EQ.'L')THEN WRITE(IDEVP,FMT='(T5,2HPS,I5,1H,,I5, + 7HRO000IP,3(I5,1H,),I5,5HNP8PC)')int(PIXH), + int(PIXV),IPX1,IPY1,IPX2,IPY2 WRITE(IDEVP,FMT='(T5,4HSC0,,I5,3H,0,,I5,3HSP1 + )')NPIX(2),NPIX(1) ELSEIF(PIC(1:1).EQ.'P')THEN WRITE(IDEVP,FMT='(T5,2HPS,I5,1H,,I5, + 30HRO270IP300,300,7900,10800NP8PC)') + int(PIXH),int(PIXV) WRITE(IDEVP,FMT='(T5,4HSC0,,I5,3H,0,,I5,3HSP1)') + NPIX(2),NPIX(1) ENDIF C A-5 Portrait.......................... ELSEIF(PSIZE(1:2).EQ.'A5')THEN PIC(1:1)='P' IPX1=300 IPX2=7900 IF(LOWPAGE.NE.1)THEN IF(FF_MISSING)THEN WRITE(IPLOT,FMT='(T5,8HPUSP0PG;)') FF_MISSING=.FALSE. ENDIF WRITE(IDEVP,FMT='(T5,2A)')CHAR(27),INI_HPGL2 IPY1=5850 IPY2=10800 WRITE(IDEVP,FMT='(T5,2HPS,I5,1H,,I5, + 7HRO270IP,3(I5,1H,),I5,5HNP8PC)')int(PIXH), + int(PIXV),IPX1,IPY1,IPX2,IPY2 ELSEIF(LOWPAGE.EQ.1)THEN IPY1=300 IPY2=5650 WRITE(IDEVP,FMT='(T5,2HIP,3(I5,1H,),I5, + 5HNP8PC)')IPX1,IPY1,IPX2,IPY2 ENDIF WRITE(IDEVP,FMT='(T5,4HSC0,,I5,3H,0,,I5,3HSP1)') + NPIX(2),NPIX(1) ENDIF ! End paper size WRITE(IDEVP,FMT='(T5,A,9(/T5,A))')(LINTYP(I),I=1,8) ENDIF ! End HPGL RETURN 998 call message_box( +'** Error occured when oppening intermediate file'//'PDUMP.SCR') !998 WRITE(*,*)' *** ERRROR AT OPENING FILE PDUMP.SCR ***' ! read(*,*) RETURN 999 call message_box( +'** Error occured when oppening file'//PSFILE) !999 WRITE(*,*)' *** ERRROR AT OPENING FILE',PSFILE,' ***' ! read(*,*) RETURN END
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
From 12.4.1.2 of the Fortran 2003 Standard:
12.4.1.2 Actual arguments associated with dummy data objects: ...
If a scalar dummy argument is of type default character, the length len of the dummy argument shallbe less than or equal to the length of the actual argument.
The following program has a mismatch of lengths of character arguments (actual arguments shorter than declared size of dummy argument). In this simple code, the mismatch can be discovered at compile time, and IFort issues a compile time message whereas CVF does not.
program tchar character*4 :: c4 = 'ABCD' call sub(c4) contains subroutine sub(str) character*40 :: str character*4 :: d4 = 'PQRS' if(str == d4)then print *,'Match' else print *,'No match' endif return end subroutine end program
Had the subroutine been an external subroutine and in a separate source file, the mismatch could be discovered only at run-time and only if checks have been enabled.
One fix is to declare the dummy argument as character*(*).
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The code in #3 is malformed, probably because of "cut-and-paste". It is apparently fixed form ('+' used as continuation indicator in col. 6 in Line 43, for example), yet has many statements beginning before col. 7 (Line 40, for example, begins in col. 2).
More importantly, you did not show the CALL to the subroutine and the declaration of PRINTFILE in the caller (or the first caller in a chain where PRINTFILE is passed as an argument through a series of subprograms).
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thank you for feedback. As I wrote in #3, I apply a similar construction in IVF that works fine. But anyway, I always have considered that a string, for example Printfile(1:4) to be a substring of Printfile(1:60) with a length = 4. Right or wrong?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
reidar wrote:
But anyway, I always have considered that a string, for example Printfile(1:4) to be a substring of Printfile(1:60) with a length = 4. Right or wrong?
Sure, but the string length checking is performed at subroutine entry. At that point, there is no knowing whether, later in the subroutine, you will use only 4 characters or the full declared length.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
mecej4, you have good points in your post #3. In the calling statement I had just dummy arguments.. With that issue fixed the problem was solved.. Thank you all.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Also note that in #3 PREVFILE is uninintialised. The code relies on PREVFILE having "save" status and it having non-matching junk (or blanks) in it the first time though. Powerstation if I recall correctly stored locals in static memory and inintialised strings as blanks.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi all, yes, , I set the Qsave switch. It works for integers and real, I am not sure about character variables.. I thank you all for your kind contribution..
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
.. just another issue, I have in the source file forgotten to replace the "USE DFLIB" ... The program is compiled and linked (!!?) , and it's possible start. But should "USE DFLIB" be replaced by "USE IFQWIN" ? DFLIB is from the Digital Fortran days, following Microsoft Fortran. After DF then CVF if I rem correctly? Any comments from Steve would be appreciated and welcome.
Cheers for now, Reidar
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
It depends on what you were using DFLIB for. If it is QuickWin, then USE IFQWIN. DFLIB is more than that, though - it also uses IFCORE and some things from IFPORT. Note that the module names didn't change when DVF became CVF.
I don't see a problem with your continuing to USE DFLIB, but if you can identify what you had that there for, it might be better to use one (or more) of the IF modules. See https://software.intel.com/en-us/articles/migrating-from-compaq-visual-fortran for more details. (By the way, the sources to all the modules are in the installed compiler's Include folder.)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
OK, thanks a lot

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page