Quote:reidar wrote:But anyway

reidar · ‎02-09-2018

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 ?

Arjen_Markus · ‎02-09-2018

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.

reidar · ‎02-09-2018

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

mecej4 · ‎02-09-2018

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 shall

be 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*(*).

mecej4 · ‎02-09-2018

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).

reidar · ‎02-09-2018

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?

mecej4 · ‎02-09-2018

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.

reidar · ‎02-09-2018

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.

andrew_4619 · ‎02-09-2018

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.

reidar · ‎02-10-2018

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..

reidar · ‎02-10-2018

.. 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

Steve_Lionel · ‎02-10-2018

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.)

reidar · ‎02-14-2018

OK, thanks a lot

Character substring dimension error