Code Folding Fortran

If reporting a bug with the Zeus IDE please post the details here. Please do not post questions here.
Post Reply
RTT
Posts: 8
Joined: Thu Dec 01, 2016 4:01 pm

Code Folding Fortran

Post by RTT »

When the IF( ) statement from IF-ELSE-ENDIF block is written on more than one line it cannot be folded.
jussij
Site Admin
Posts: 2650
Joined: Fri Aug 13, 2004 5:10 pm

Re: Code Folding Fortran

Post by jussij »

Could you try the need xFolder found here: http://www.zeusedit.com/z300/xFolder.zip

Cheers Jussi
RTT
Posts: 8
Joined: Thu Dec 01, 2016 4:01 pm

Re: Code Folding Fortran

Post by RTT »

Thanks. With this DLL I can fold a multiline IF( )THEN block, but it does not work properly.
Everything up to the end of the file is folded
jussij
Site Admin
Posts: 2650
Joined: Fri Aug 13, 2004 5:10 pm

Re: Code Folding Fortran

Post by jussij »

Could you post the smallest sample of code that shows the folding error :?:

You can format code using the Code but found in the tool bar.

Just hit the Code button and put the sample inside the two tags.

Cheers Jussi
RTT
Posts: 8
Joined: Thu Dec 01, 2016 4:01 pm

Re: Code Folding Fortran

Post by RTT »

Code: Select all

      SUBROUTINE KHX20
      IF(LDEBUG>=1)THEN
        CALL VBSIWT
        IF(LDEBUG>=2)THEN
          CALL MTEWRT(ELXYZ   ,NAXES   ,LNODZ   ,'ELXYZ ')
          IF(NTAB==1)CALL VCEWRT(ELPR    ,NPRZ    ,'ELPR  ')
          CALL MTEWRT(CBF   ,NCBF  ,NRHS  ,'CBF   ')
          IF(LPTP==83)THEN
            CALL VCEWRT(ELPRW ,NPRZW ,'ELPRW ')
          ENDIF
          IF(LDBUG1<2)CALL MTEWT3(DISP  ,NDF   ,NDISP ,NRHSTP,'DISP  ')
          IF(LDBUG1<3)CALL MTEWT3(STATVB,LSTATM,NGP   ,NSTPG ,'STATVB')
          CALL VCEWRT(RNGE  ,NAXES ,'RNGE  ')
          CALL VCEWRT(RKO   ,NKO   ,'RKO'   )
          IF(CHECK(421))CALL VCEWRT(DKG   ,NDKG  ,'DKG   ')
          CALL VCLWRT(ILDDAT ,NLDARR ,'ILDDAT')
        ENDIF
      ENDIF
      RETURN
      END
RTT
Posts: 8
Joined: Thu Dec 01, 2016 4:01 pm

Re: Code Folding Fortran

Post by RTT »

Only the innermost IF - ENDIF block (i.e. IF(LPTP==83) ... ) folds.
It folded correctly before I use the recently cent DLL.
jussij
Site Admin
Posts: 2650
Joined: Fri Aug 13, 2004 5:10 pm

Re: Code Folding Fortran

Post by jussij »

Could you try this newer xFolder found here: http://www.zeusedit.com/z300/xFolder.zip

Cheers Jussi
RTT
Posts: 8
Joined: Thu Dec 01, 2016 4:01 pm

Re: Code Folding Fortran

Post by RTT »

Thank you. It works better, but there are still problems.
In this code folding the first IF (i.e. IF(CHECK(80))THEN) folds everything and the code after the corresponding ENDIF
(just before comment "C-code from here to end is lost " ) is lost.

Code: Select all

      SUBROUTINE KHX20
C-----------------------------Additional processing for NL
        IF(CHECK(80))THEN
C                             Compute nodal forces equiv to resid strs
C                             first pass only
          IF(.NOT.VCEZRO(STRSRG(1,NG,1),NDSE).AND.INISTR
     A      .AND..NOT.CHECK(161))
     A      CALL MBTSIG
     A(   NEL        ,NDF        ,NDSE      ,DVOL       ,
     B    B          ,STRSRG(1,NG,1)        ,ELSTN(1,1) )
C-----------------------------Incr.thermal and shrinkage strains
          IF(CHECK(160))THEN
C                             initialise temporary storage
            CALL VCEZER(TMPDAT,NDSE )
C                             thermal - not for woven fabric model
            IF(LPTP/=83)THEN
              CALL VCECPY(STRSTG(1,NG,1),TMPDAT,NDSE )
              CALL VCSUBT(TMPDAT,STRSTG(1,NG,2),TMPDAT,NDSE )
C                             subtract auto.contribution as added later
              IF(CHECK(151))
     A          CALL VCESCL(STRTGL(1,NG,2),TMPDAT,NDSE,-DLAMDT,2 )
            ENDIF
C                             shrinkage
            IF(ISKP/=0)THEN
              CALL VCADDN(TMPDAT ,STATVB(ISK,NG,1) ,TMPDAT ,NDSE )
              CALL VCSUBT(TMPDAT ,STATVB(ISK,NG,2) ,TMPDAT ,NDSE )
            ENDIF
C                             CEB-FIP/Chinese creep strains
            IF(LPTP==86.AND.NACTVE/=2)THEN
C                             recursive creep strain increment
              CALL CRPLOD
     A(   NDSE       ,NPRZ       ,LIC        ,INC        ,DT         ,
     B    CHECK(160) ,CHECK(416) ,
     C    ELPR       ,STATVB(IC,NG,1),STATVB(IC,NG,2))
C                             add incremental creep strain to TMPDAT
              CALL VCADDN(TMPDAT,STATVB(IC,NG,1),TMPDAT,NDSE )
              CALL VCSUBT(TMPDAT,STATVB(IC,NG,2),TMPDAT,NDSE )
            ENDIF
C                             Otherwise for iterative coupling compute
C                             iterative changes
          ELSEIF(CHECK(67))THEN
            CALL VCSUBT(STRSTG(1,NG,1) ,STRSTG(1,NG,3) ,TMPDAT ,NDSE )
          ENDIF
C                             Creep strains - start of new increment or
C                             2nd loop of separate contact-material iter.loops
          IF(((CHECK(160).AND..NOT.CHECK(334)).OR.CHECK(335)).AND.
     A      ICP/=0)THEN
C                             ... calculate incremental change in creep
C                             strain
            CALL VCADDN(TMPDAT,STATVB(IC,NG,1),TMPDAT,NDSE )
            CALL VCSUBT(TMPDAT,STATVB(IC,NG,2),TMPDAT,NDSE )
          ENDIF
C                             Evaluate stress due to inc strain
          IF(.NOT.VCEZRO(TMPDAT,NDSE))
     A      CALL MBTDSN
     A(   NEL        ,NDF        ,NDSE       ,DVOL       ,
     B    B          ,D          ,TMPDAT     ,ELRHS      )
C-----------------------------Remaining NL nodal force processing
C                             Nodal forces due to tangential part of
C                             thermal loading into ELSTN. This will be
C                             added into ELRHS in routine MRESPL
          IF(CHECK(151))THEN
            IF(.NOT.VCEZRO(STRTGL(1,NG,2),NDSE))
     A        CALL MBTDSN
     A(   NEL        ,NDF        ,NDSE       ,DVOL       ,
     B    B          ,D          ,STRTGL(1,NG,2),ELSTN(1,2))
          ENDIF
C                             Nodal forces equivlnt to internal stresses
C                             into col6 of DISP
          IF(REPASS)
     A      CALL MBTSIG
     A(   NEL        ,NDF        ,NDSE       ,DVOL       ,
     B    B          ,STRSGR     ,DISP(1,6,1))
C                             Nodal forces equivlnt to initial stresses
C                             into local array DSP6IN
          IF(CHECK(229).AND.INISTR.AND..NOT.VCEZRO(STRSIG(1,NG,1),NDSE))
     A      CALL MBTSIG
     A(   NEL        ,NDF        ,NDSE       ,DVOL       ,
     B    B          ,STRSIG(1,NG,1),DSP6IN  )
C                             add centripetal load stiffness to RHS
          IF(REPASS.AND..NOT.CHECK(102).AND..NOT.VCEZRO(CBF(4,1),6))
     A      CALL CENTPL
     A(   NAXES      ,LNODZ      ,NDF        ,NW         ,DENS       ,
     B    CBF(4,1)   ,CBF(5,1)   ,CBF(6,1)   ,CBF(7,1)   ,CBF(8,1)   ,
     C    CBF(9,1)   ,DVOL       ,.FALSE.    ,.FALSE.    ,
     D    DISP(1,JSP,1),WN       ,ELRHS      )
C---------------------------------------------------------------------
C                            Add Viscoelastic Component to D Matrix
C---------------------------------------------------------------------
          IF(IVEP>0.AND.(CHECK(213).OR.CHECK(43)).AND.NT>0.AND.
     A       (.NOT.CHECK(334)))THEN
            CALL DMTVSE
     A(   IVEP       ,LIVE       ,MDL        ,NAXES      ,NDSE       ,
     B    NDSE1      ,NDSE2      ,NEL        ,NG         ,NVSET      ,
     C    DT         ,TEMP       ,RSPTIM     ,CHK384     ,CHECK(179) ,
     D    CHECK(227) ,
     E    ELPRV              ,STRSG(1,NG,1)      ,STRSG(1,NG,2)      ,
     E    STATVB(IVE,NG,1)   ,STATVB(IVE,NG,2)   ,
     F    ELXYZG(1,NG)       ,D                  ,DRCMGP(1,NG+IPG)   )
C                             Skip out on error
            IF(CHK384)GOTO 900
          ENDIF
        ENDIF
C-code from here to end is  lost when IF(CHECK(80))THEN is folded
      a=b
      c=b
      RETURN
      END

jussij
Site Admin
Posts: 2650
Joined: Fri Aug 13, 2004 5:10 pm

Re: Code Folding Fortran

Post by jussij »

This problem is caused by this section of code:

Code: Select all

         IF(.NOT.VCEZRO(STRSRG(1,NG,1),NDSE).AND.INISTR
    A      .AND..NOT.CHECK(161))
    A      CALL MBTSIG
    A(   NEL        ,NDF        ,NDSE      ,DVOL       ,
    B    B          ,STRSRG(1,NG,1)        ,ELSTN(1,1) )
The cause of the problem is the folder is marking that line as a fold point when in fact it is not :(

If that code had been written as follows it would then fold correctly:

Code: Select all

         IF(.NOT.VCEZRO(STRSRG(1,NG,1),NDSE).AND.INISTR.AND..NOT.CHECK(161))
    A      CALL MBTSIG
Unfortunately there is no way to fix this as the folder only ever has knowledge of the current line :(

By this I mean the folder has to make it's fold point decision based on this line of code:

Code: Select all

    IF(.NOT.VCEZRO(STRSRG(1,NG,1),NDSE).AND.INISTR
At the time it is trying to determine if the line of code is a fold point it does not have access to this line of code:

Code: Select all

    A      .AND..NOT.CHECK(161))
Cheers Jussi
RTT
Posts: 8
Joined: Thu Dec 01, 2016 4:01 pm

Re: Code Folding Fortran

Post by RTT »

Thank you. It is a pity it cannot be fixed. I liked better your way of fold presentation than Notepad++, which can fold the code correctly.
I cannot understand your last comment that the 'Folder' does not have access to the next line.
This IF folds correctly

Code: Select all

          IF(((CHECK(160).AND..NOT.CHECK(334)).OR.CHECK(335)).AND.
     A      ICP/=0)THEN
            ......
          ENDIF
I presume access to the next line after the next line is required for this code

Code: Select all

         IF(.NOT.VCEZRO(STRSRG(1,NG,1),NDSE).AND.INISTR
     A      .AND..NOT.CHECK(161))
     A      CALL MBTSIG
 
jussij
Site Admin
Posts: 2650
Joined: Fri Aug 13, 2004 5:10 pm

Re: Code Folding Fortran

Post by jussij »

It is a pity it cannot be fixed.
Naturally this could be fixed with some major re-working of the current Zeus code folding code, but with the current design there is no simple fix to this issue :(
I cannot understand your last comment that the 'Folder' does not have access to the next line.
The current Zeus folder design means it does not have enough information to answer the fold question correctly.

Hence the reason it gets the fold question wrong :(

Cheers Jussi
Post Reply