Code Folding Fortran
Posted: Thu Dec 01, 2016 4:12 pm
When the IF( ) statement from IF-ELSE-ENDIF block is written on more than one line it cannot be folded.
Use this forum to ask for help, submit a bug report or make a suggestion.
http://www.zeusedit.com/zBB3/
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
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
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) )
Code: Select all
IF(.NOT.VCEZRO(STRSRG(1,NG,1),NDSE).AND.INISTR.AND..NOT.CHECK(161))
A CALL MBTSIG
Code: Select all
IF(.NOT.VCEZRO(STRSRG(1,NG,1),NDSE).AND.INISTR
Code: Select all
A .AND..NOT.CHECK(161))
Code: Select all
IF(((CHECK(160).AND..NOT.CHECK(334)).OR.CHECK(335)).AND.
A ICP/=0)THEN
......
ENDIF
Code: Select all
IF(.NOT.VCEZRO(STRSRG(1,NG,1),NDSE).AND.INISTR
A .AND..NOT.CHECK(161))
A CALL MBTSIG
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 issueIt is a pity it cannot be fixed.
The current Zeus folder design means it does not have enough information to answer the fold question correctly.I cannot understand your last comment that the 'Folder' does not have access to the next line.