Usenet 1994 October

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume12 / ffccc / part07 < prev next >

Wrap

Text File | 1990-05-14 | 47.3 KB | 1,489 lines

Newsgroups: comp.sources.misc organization: CERN, Geneva, Switzerland keywords: fortran subject: v12i093: Floppy - Fortran Coding Convention Checker Part 07/11 from: julian@cernvax.cern.ch (julian bunn) Sender: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) Posting-number: Volume 12, Issue 93 Submitted-by: julian@cernvax.cern.ch (julian bunn) Archive-name: ffccc/part07 #!/bin/sh echo 'Start of Floppy, part 07 of 11:' echo 'x - CCLASS.h' sed 's/^X//' > CCLASS.h << '/' X*IF DEF,NEVER X*----------------------------------------------------------------------- X*--- contains statement classification information X* NCLASS no. of (internal) classes X* NPRIOR no. of priority statements X* NHEADR no. of header statements X* IIF internal number of the logical IF X* IEND internal number of END statement X* IFORMT internal number of the FORMAT statement X* ILL - - - illegal - X* ISTMDS(MCLASS,MXSTAT) control words being X* 1 = first ch. in SNAM X* 2 = last ch. in SNAM X* 3 = first ch. in SSTM X* 4 = last ch. in SSTM X* 5 = last significant ch. in SSTM X* 6 = external reference number ( class ) X* 7 = priority ( if 0, any order) X* 8 = char. in descr. after which to start name X* scan. if 99, start after match string. X* 9 = stop name scan at stmt. end X* 10 = statement number classifier, being X* 0 if statement cannot contain stmt. numbers X* 1 if (one) stmt. number must follow key immed. X* 2 if all stmt. no.s are inside first bracket X* 3 if all stmt. no.s follow immed. first bracket X* 4 if (one) after FMT=, or second in first br. X* 11 = exec flag ( 0 = non-executable) X* 12 = names flag ( 0 = no names, 1 = one, 2 = any) X* 13 = special treatement flag ( if 1) +2 * smflag X* where smflag = 1 allows for simple keyword match X* 14 = routine header flag (0 no, 1 yes) X* 15 = type flag: X* 0 if types valid for all names X* 1 if separate types for first name + rest X* 2 if special treatment (IMPLICIT) X* to this, 10 is added if only names outside X* brackets to be taken, +10 for COMMON X* 16 = n1 = no. of types for first or all X* 17 to 16 + n1 = types X* 17 + n1 = n2 X* 18 + n1 to 21 = types for rest (0 filled) X* IALPHA(2,27) for letters 1 to 26 (A to Z), X* first and last class under that letter. X* ( keys are in alphabetic order) X* 27 for those not starting with any key. X* if not specified otherwise, those will be X* processed last X* IPRIOR(MXSTAT) refs of priority statements X* IHEADR(MXSTAT) refs of header statements X*----------------------------------------------------------------------- X*EI / echo 'x - INUSER.f' sed 's/^X//' > INUSER.f << '/' X SUBROUTINE INUSER X*----------------------------------------------------------------------- X* reads command lines, compacts them (blanks outside strings suppressed) X* finds no. of OR-sets, marks strings with '{}' X* X* Output : common blocks (mis-)used for input decoding only X* NLINES = total number of lines read X* NSTAMM = total number of commands X* NFLINE(I) = first line of command I X* NLLINE(I) = last - - X* NLTYPE(J) = pos. of last character, or of ';' in command line J X* NSSTRT(I) = first command of OR-set number I X* NSEND(I) = last - - X* X* Output correctly stored for later use: X* NORSET = number of OR-sets X*----------------------------------------------------------------------- X include 'PARAM.h' X include 'ALCAZA.h' X include 'STATE.h' X include 'KEYCOM.h' X CHARACTER*1 STEMP,SQUOTE X include 'CONVEX.h' X* X N=0 X WRITE (MPUNIT,10020) X 10 CONTINUE X READ (MCUNIT,'(A)',END=20) SIMA(N+1) X N=N+1 X WRITE(MPUNIT,'(1X,A)') SIMA(N) X IF (SIMA(N)(1:3).EQ.'END') GOTO 20 X IF(N.EQ.MXSIMA) THEN X WRITE (MPUNIT,10030) N X ELSE X GOTO 10 X ENDIF X 20 CONTINUE X WRITE (MPUNIT,10040) X NLINES=N X*--- suppress blanks outside strings, and in strings to be replaced X* find end of each line X N=0 X NFLINE(1)=1 X IN=0 X IR=0 X IS=0 X DO 50 I=1,NLINES X NPOS=0 X DO 30 J=1,MXLINE X STEMP=SIMA(I)(J:J) X IF (INDEX(SPILL,STEMP).NE.0) THEN X*--- illegal character encountered - replace by '/' X WRITE (MPUNIT,10010) STEMP X STEMP='/' X ENDIF X IF (IN.EQ.1) THEN X*--- inside quote string X IF (STEMP.EQ.SQUOTE) THEN X IN=0 X STEMP='}' X IR=0 X ELSEIF (STEMP.EQ.'''') THEN X IS=1-IS X ENDIF X IF(STEMP.NE.' '.OR.IR+IS.GT.0) THEN X NPOS=NPOS+1 X SIMA(I)(NPOS:NPOS)=STEMP X ENDIF X ELSE X*--- outside quote string X IF (STEMP.NE.' ') THEN X IF (STEMP.EQ.''''.OR.STEMP.EQ.'"') THEN X IN=1 X SQUOTE=STEMP X STEMP='{' X ELSEIF(STEMP.EQ.'=') THEN X IR=1 X ENDIF X NPOS=NPOS+1 X SIMA(I)(NPOS:NPOS)=STEMP X IF (STEMP.EQ.';') THEN X N=N+1 X NLLINE(N)=I X NFLINE(N+1)=I+1 X GOTO 40 X ENDIF X ENDIF X ENDIF X 30 CONTINUE X 40 CONTINUE X NLTYPE(I)=NPOS X 50 CONTINUE X IF(NLINES.GT.0) THEN X IF (IN.NE.0) THEN X WRITE (MPUNIT,10050) X K=MIN(NLTYPE(NLINES)+1,MXLINE) X SIMA(NLINES)(K:K)='}' X NLTYPE(NLINES)=K X ENDIF X K=NLTYPE(NLINES) X STEMP=SIMA(NLINES)(K:K) X IF(STEMP.NE.';') THEN X WRITE (MPUNIT,10000) X IF (K.EQ.MXLINE.AND.STEMP.EQ.'}') SIMA(NLINES)(K-1:K-1)= X + STEMP X K=MIN(K+1,MXLINE) X SIMA(NLINES)(K:K)=';' X NLTYPE(NLINES)=K X ENDIF X ENDIF X NSTAMM=N X*--- now find number of OR-sets X NORSET=1 X NSSTRT(1)=1 X DO 60 I=1,NSTAMM X IF (SIMA(NFLINE(I))(1:3).EQ.'OR;') THEN X NSEND(NORSET)=I-1 X IF (NORSET.EQ.MXORST) THEN X WRITE (MPUNIT,10060) NORSET X GOTO 999 X ENDIF X NORSET=NORSET+1 X NSSTRT(NORSET)=I X ENDIF X 60 CONTINUE X NSEND(NORSET)=NSTAMM X10000 FORMAT(/1X,8('*-*-'),' WARNING - missing ";" added at end',/) X10010 FORMAT(/1X,8('*-*-'),' WARNING - illegal character ',A, X +' replaced by "/"') X10020 FORMAT(///1X,8('++++'),' Input Commands ',8('++++'),//) X10030 FORMAT(//1X,8('*-*-'),' WARNING - max. buffer size for input', X +' = ',I5,' lines reached, rest ignored',/) X10040 FORMAT(//1X,8('++++'),' End of Commands ',8('++++'),//) X10050 FORMAT(//1X,8('*-*-'),' WARNING - unclosed string in commands', X +' closed at the very end',/) X10060 FORMAT(//1X,8('*-*-'),' WARNING - max. number of OR-sets =', I5, X +' reached, remainder ignored',/) X 999 END / echo 'x - MARKST.f' sed 's/^X//' > MARKST.f << '/' X SUBROUTINE MARKST(OPTION,IERR) X*----------------------------------------------------------------------- X* X* in SSTA, suppresses multiple blanks outside strings, puts strings X* in special characters, X* '{' and '}'. strings may be either ...H, or be X* included in single or double quotes. X* X*--- input X* OPTION (character) 'FULL' or 'PART' to extract X* all, or just start (up to first bracket) X* NCHST number of ch. in SSTA X* X*--- output X* IERR = 0 if everything OK, =1 if illegal characters found, X* or unclosed string. X* SSTA COMMON/ALCAZA/ FORTRAN fields 7-72 of SIMA X* NCHST COMMON/STATE/ last non-blank in SSTA X* X* X*----------------------------------------------------------------------- X include 'PARAM.h' X include 'ALCAZA.h' X include 'CURSTA.h' X CHARACTER STEMP*1,SKEEP*1,SDUM*100,OPTION*4 X LOGICAL POSS,SPOSS,PARTFL,LASTBL X include 'CONVEX.h' X PARTFL=OPTION.EQ.'PART' X NCH=0 X NDUM=0 X ISKIP=0 X*--- ISKIP = 0 outside string X* = -1 inside hollerith string (nH...) X* = +1 inside character string (' or ") X NHOLL=0 X IERR=0 X POSS=.FALSE. X SPOSS=.FALSE. X STEMP=' ' X J=0 X 10 CONTINUE X J=J+1 X IF (J.GT.NCHST) GOTO 20 X LASTBL=STEMP.NE.' ' X STEMP=SSTA(J:J) X IF (PARTFL) THEN X IF (STEMP.EQ.'(')GOTO 30 X ENDIF X IF (INDEX(SPILL,STEMP).NE.0) THEN X*--- illegal character X GOTO 40 X ENDIF X IF (ISKIP.EQ.0) THEN X*--- not in string X IF (STEMP.EQ.' ') THEN X IF (LASTBL) THEN X NCH=NCH+1 X SSTR(NCH:NCH)=' ' X ENDIF X ELSEIF (NUMCH(STEMP)) THEN X IF (POSS) THEN X*--- count for ..H may start or continue X IF (NHOLL.LT.10000) NHOLL=10*NHOLL+ICVAL(STEMP)-ICVAL('0' X + ) X NDUM=NDUM+1 X*--- buffer digits X SDUM(NDUM:NDUM)=STEMP X ELSE X NCH=NCH+1 X SSTR(NCH:NCH)=STEMP X ENDIF X ELSEIF (ALPHCH(STEMP)) THEN X IF (NDUM.EQ.0) THEN X*--- no digits (= holl. count ) buffered X POSS=.FALSE. X NCH=NCH+1 X SSTR(NCH:NCH)=STEMP X ELSE X IF (STEMP.EQ.'H') THEN X NCH=NCH+1 X SSTR(NCH:NCH)='{' X ISKIP=-1 X SSTR(NCH+1:NCH+NDUM)=SDUM(:NDUM) X NCH=NCH+NDUM+1 X SSTR(NCH:NCH)=STEMP X ELSE X*--- other alphabetic ch. than H X POSS=.FALSE. X NHOLL=0 X SSTR(NCH+1:NCH+NDUM)=SDUM(:NDUM) X NCH=NCH+NDUM+1 X SSTR(NCH:NCH)=STEMP X ENDIF X NDUM=0 X ENDIF X ELSE X*--- special character X SPOSS=SPOSS.OR.STEMP.NE.'*' X*--- holl. count cannot start after '*' X POSS=SPOSS X IF (NDUM.NE.0) THEN X SSTR(NCH+1:NCH+NDUM)=SDUM(:NDUM) X NCH=NCH+NDUM X NDUM=0 X ENDIF X NHOLL=0 X IF (STEMP.EQ.''''.OR.STEMP.EQ.'"') THEN X ISKIP=1 X SKEEP=STEMP X NCH=NCH+1 X SSTR(NCH:NCH)='{' X ENDIF X NCH=NCH+1 X SSTR(NCH:NCH)=STEMP X*--- following ENDIF for IF(STEMP.EQ.' ') THEN etc. X ENDIF X ELSEIF (ISKIP.LT.0) THEN X*--- inside a holl. string X NHOLL=NHOLL-1 X NCH=NCH+1 X SSTR(NCH:NCH)=STEMP X IF (NHOLL.EQ.0) THEN X*--- end of holl. string reached X ISKIP=0 X NCH=NCH+1 X SSTR(NCH:NCH)='}' X ENDIF X ELSE X*--- ISKIP GT 0 X IF (STEMP.EQ.''''.AND.SSTA(J+1:J+1).EQ.''''.AND.J.LT.NCHST) X + THEN X SSTR(NCH+1:NCH+2)=SSTA(J:J+1) X J=J+1 X NCH=NCH+2 X ELSEIF (SKEEP.EQ.STEMP) THEN X*--- end of string X ISKIP=0 X NCH=NCH+1 X SSTR(NCH:NCH)=STEMP X NCH=NCH+1 X SSTR(NCH:NCH)='}' X ELSE X NCH=NCH+1 X SSTR(NCH:NCH)=STEMP X ENDIF X ENDIF X GOTO 10 X 20 CONTINUE X IF(NDUM.GT.0) THEN X*--- still some lonely digits hanging around X SSTR(NCH+1:NCH+NDUM)=SDUM(:NDUM) X NCH=NCH+NDUM X ENDIF X IF (ISKIP.NE.0) GOTO 40 X 30 NCHST=NCH X SSTA(:NCH)=SSTR(:NCH) X GOTO 999 X 40 CONTINUE X*--- illegal - either unclosed string, or illegal character X IERR=1 X 999 END / echo 'x - MIXMOD.f' sed 's/^X//' > MIXMOD.f << '/' X SUBROUTINE MIXMOD(NGLOBF) XC! Checks for Mixed Mode expressions X include 'PARAM.h' X include 'ALCAZA.h' X include 'CLASS.h' X include 'CURSTA.h' X include 'FLWORK.h' X include 'KEYCOM.h' X include 'TYPDEF.h' X include 'JOBSUM.h' X include 'STATE.h' X include 'FLAGS.h' X include 'USIGNO.h' X include 'USLIST.h' X include 'USGCOM.h' X include 'USSTMT.h' X include 'USUNIT.h' X include 'USARGS.h' X include 'USLTYD.h' X include 'STACK.h' X CHARACTER*1 STYP X CHARACTER*(LOPER) SOPT X INTEGER ISTART(2),IFINIS(2) X CHARACTER*6 CREL(11) X CHARACTER*256 STEMP X INTEGER LPS(256) X INTEGER LREL(11) X DATA CREL /'.EQV. ','.NEQV.','.OR. ','.AND. ','.NOT. ', X & '.GT. ','.GE. ','.LT. ','.LE. ','.EQ. ', X & '.NE. '/ X DATA LREL /5,6,4,5,5,4,4,4,4,4,4/ XC XC CALLED FROM URTERM FOR EACH STATEMENT IN THE MODULE XC X ICL1 = ICURCL(1) X ICL2 = ICURCL(2) XC XC RETURN UNLESS AN ASSIGNMENT STATEMENT XC X IF(LIFF(ICL1)) THEN X IF(.NOT.LASIGN(ICL2)) RETURN X IUP = 2 XC find end of IF X JPT = INDEX(SSTA(:NCHST),'(') X CALL SKIPLV(SSTA,JPT+1,NCHST,.FALSE.,KND,ILEV) X ISTART(1) = JPT+1 X ISTART(2) = KND+1 X IFINIS(1) = KND-1 X IFINIS(2) = NCHST X ELSE IF(LASIGN(ICL1)) THEN X IUP = 1 X KND = NCHST X ISTART(1) = 1 X IFINIS(1) = NCHST X ELSE X RETURN X ENDIF XC loop over parts of the statement X DO 20 IPART=1,IUP XC zero stack address X NLEVL = 0 X IF(IPART.EQ.1) THEN X ICL=ICL1 X ELSE X ICL=ICL2 X IF(.NOT.LASIGN(ICL)) GOTO 20 X ENDIF XC KST and KND mark the start and end of the assignment part of the statement X KST = ISTART(IPART) X KND = IFINIS(IPART) XC WRITE(6,'(A,A)') ' Statement : ',SSTA(KST:KND) XC this part of statement is an assignment or is inside IF clause XC move from left to right, character by character X NLO1 = 1 X ICHR = KST X 5 CONTINUE X IF(ICHR.EQ.KND+1) THEN XC put end of expression operator X CALL PUTOPT('END',3,ICHR,IERR) X IF(IERR.GT.0) GOTO 25 X IF(IERR.LT.0) THEN X NGLOBF = NGLOBF + 1 X GOTO 40 X ENDIF X GOTO 20 X ENDIF X IF(SSTA(ICHR:ICHR).EQ.' ') THEN XC ignore blanks X ICHR = ICHR + 1 X GOTO 5 X ENDIF XC NLO is the index to the statement name last found X NLO = NLO1 X ICHRE = 0 XC find if this character is start of a name X DO 10 ISN=NLO,NSNAME X IF(NSSTRT(ISN).NE.ICHR) GOTO 10 X NLO1 = ISN + 1 X ICHRE = NSEND(ISN) XC convert the name type to the smaller subset X CALL TY2TYP(ISN,STYP) XC add this operand to the stack X CALL PUTOPA(SNAMES(ISN+ISNAME),STYP,ICHR,ICHRE,IERR) X IF(IERR.NE.0) GOTO 30 X ICHR = ICHRE + 1 XC go for the next character after this name X GOTO 5 X 10 CONTINUE XC next name is at NLO1 X IF(NLO1.GT.NSNAME) THEN X IFIN = KND X ELSE X IFIN = NSSTRT(NLO1)-1 X ENDIF X ISTA = ICHR XC analyse this part of statement (ISTA:IFIN) since it is XC not a name, may be an operator X ILEN = IFIN-ISTA+1 X CALL GETOPT(SSTA(ISTA:IFIN),ILEN,SOPT,LOPT,IERR) X IF(IERR.NE.0) GOTO 15 XC found an operator of length LOPT, called SOPT XC put the operator on the stack X CALL PUTOPT(SOPT,LOPT,ICHR,IERR) X IF(IERR.GT.0) GOTO 15 X IF(IERR.LT.0) THEN X NGLOBF = NGLOBF + 1 X ENDIF X ICHR = ICHR + LOPT X GOTO 5 X 15 CONTINUE XC not a name, not an operator, so XC check if start of a constant. Remove blanks first X 98 NC=0 X DO 97 IC=ISTA,IFIN X IF(SSTA(IC:IC).EQ.' ') GOTO 97 X NC=NC+1 X LPS(NC)=IC-ISTA X STEMP(NC:NC) = SSTA(IC:IC) X 97 CONTINUE XC remove .EQ. etc which confuse GETCON X DO 95 IREL=1,11 X LP=INDEX(STEMP(:NC),CREL(IREL)(:LREL(IREL))) X IF(LP.EQ.0) GOTO 95 X IFIN = ISTA + LPS(LP) - 1 X GOTO 98 X 95 CONTINUE X CALL GETCON(SSTA,ISTA,IFIN,KLCH,STYP) X IF(KLCH.NE.0) THEN XC found a constant. place on the stack X CALL PUTOPA(SSTA(ISTA:KLCH),STYP,ICHR,KLCH,IERR) X IF(IERR.NE.0) GOTO 35 X ICHR = KLCH + 1 X GOTO 5 X ENDIF XC not a name,operand or constant. this is an error. type the offender X LCST = MIN(70,NCHST) X WRITE(MZUNIT,500) SSTA(1:LCST) X 20 CONTINUE X GOTO 40 X 25 CONTINUE X 30 CONTINUE X 35 CONTINUE X 40 CONTINUE X RETURN X 500 FORMAT(1X,'!!! NON-FATAL ERROR IN MIXMOD ...', X +' UNABLE TO PARSE: ',A) X END / echo 'x - PRENUM.f' sed 's/^X//' > PRENUM.f << '/' X SUBROUTINE PRENUM X*----------------------------------------------------------------------- X* X* Makes a list of statement numbers, replaces old by new in label field X* X*----------------------------------------------------------------------- X include 'PARAM.h' X include 'ALCAZA.h' X include 'FLAGS.h' X include 'CLASS.h' X include 'STATE.h' X include 'KEYCOM.h' X include 'FLWORK.h' X LOGICAL FORMFL,RETFL,ENDFL X NSTANU=0 X N=0 X DO 10 I=1,NSTAMM X IF (ICLASS(I,1).NE.0) THEN X NN=NEXTIN(SIMA(NFLINE(I)),1,5) X IF (NN.NE.0) THEN X N=N+1 X IWS(N)=NN X ENDIF X ENDIF X 10 CONTINUE X IF (N.EQ.0) GOTO 999 X CALL SORTSP(N,IWS,NSTANU) X IF(NSTANU.GT.MAXNUM) THEN X WRITE (MPUNIT,10000) MAXNUM,SCROUT X NSTANU=0 X GOTO 999 X ENDIF X*--- get values for starts, steps etc. X DO 20 IKY=1,NGLSET X IF (KEYREF(IKY,1).EQ.7) GOTO 30 X 20 CONTINUE X GOTO 120 X 30 CONTINUE X KKS=KEYREF(IKY,3) X*--- start and step for normal statements X KST=KEYINT(KKS+1) X NST=KEYINT(KKS+2) X*--- FORMAT statements X KFOR=KEYINT(KKS+3) X NFOR=KEYINT(KKS+4) X*--- RETURN X KRET=KEYINT(KKS+5) X NRET=KEYINT(KKS+6) X*--- END X NEND=KEYINT(KKS+7) X FORMFL=KFOR.GT.0 X RETFL=KRET.GT.0 X ENDFL=NEND.GT.0 X KST=KST-NST X KFOR=KFOR-NFOR X KRET=KRET-NRET X DO 40 I=1,NSTANU X KSTANU(I)=IWS(I) X KSTARE(I)=0 X 40 CONTINUE X*--- count FORMAT statements which have to be displaced X NF=0 X DO 70 I=1,NSTAMM X ICL=ICLASS(I,1) X IF (ICL.NE.0) THEN X IF(ICL.EQ.IIF) ICL=ICLASS(I,2) X NN=NEXTIN(SIMA(NFLINE(I)),1,5) X IF (NN.NE.0) THEN X*--- find statement number in sorted table. X* The value of 40 for switching from direct to binary search is X* valid for VAX/780, but probably reasonable elsewhere as well. X IF (NSTANU.LE.40) THEN X DO 50 J=1,NSTANU X IF (KSTANU(J).EQ.NN) GOTO 60 X 50 CONTINUE X GOTO 120 X 60 CONTINUE X IPOS=J X ELSE X CALL BINSRC(NN,KSTANU,NSTANU,IPOS,LAST) X IF (IPOS.EQ.0) GOTO 120 X ENDIF X IF(KSTARE(IPOS).EQ.0) THEN X IF (FORMFL.AND.ICL.EQ.IFORMT) THEN X KFOR=KFOR+NFOR X NEW=KFOR X ELSEIF (RETFL.AND.ICL.EQ.IRETUR) THEN X KRET=KRET+NRET X NEW=KRET X ELSEIF (ENDFL.AND.ICL.EQ.IEND) THEN X NEW=NEND X ELSE X KST=KST+NST X NEW=KST X ENDIF X KSTARE(IPOS)=NEW X ENDIF X IF (ACTION(14).AND.ICL.EQ.IFORMT.AND.NF.LT.1000) THEN X*--- remember FORMAT statements to be put at end X NF=NF+1 X IWS(NF)=I X IWS(1000+NF)=NFLINE(I) X IWS(2000+NF)=NLLINE(I) X IWS(3000+NF)=ICLASS(I,1) X IWS(4000+NF)=ICLASS(I,2) X IWS(5000+NF)=IMODIF(I) X ENDIF X ENDIF X ENDIF X 70 CONTINUE X IF(NF.GT.0) THEN X*--- put FORMAT statements in front of last statement X DO 80 ILAST=NSTAMM,1,-1 X IF(ICLASS(ILAST,1).NE.0) GOTO 90 X 80 CONTINUE X 90 CONTINUE X*--- ILAST is last FORTRAN statement X IS=IWS(1) X K=IS-1 X N=1 X DO 100 I=IS,ILAST-1 X IF (I.EQ.IWS(N).AND.N.LE.NF) THEN X N=N+1 X ELSE X K=K+1 X NFLINE(K)=NFLINE(I) X NLLINE(K)=NLLINE(I) X ICLASS(K,1)=ICLASS(I,1) X ICLASS(K,2)=ICLASS(I,2) X IMODIF(K)=IMODIF(I) X ENDIF X 100 CONTINUE X K=ILAST-NF-1 X DO 110 I=1,NF X NFLINE(K+I)=IWS(1000+I) X NLLINE(K+I)=IWS(2000+I) X ICLASS(K+I,1)=IWS(3000+I) X ICLASS(K+I,2)=IWS(4000+I) X IMODIF(K+I)=IWS(5000+I) X 110 CONTINUE X ENDIF X GOTO 999 X 120 CONTINUE X WRITE (MPUNIT,10010) SCROUT X NSTANU=0 X10000 FORMAT(/' ++++++ Warning - more than',I5,' statement numbers', X +'in routine ',A,' , not renumbered') X10010 FORMAT(/' ++++++ Warning - serious error in routine PRENUM ', X +'when processing routine ',A,' , not renumbered') X 999 END / echo 'x - REFORM.f' sed 's/^X//' > REFORM.f << '/' X SUBROUTINE REFORM X*----------------------------------------------------------------------- X* X* Re-formats the statement after a change. X* X*---Input X* SSTA, NCHST X*--- Output X* SIMA, and NFLINE, NLLINE, NLINES possibly updated. X* X*----------------------------------------------------------------------- X include 'PARAM.h' X include 'ALCAZA.h' X include 'FLAGS.h' X include 'CURSTA.h' X include 'STATE.h' X include 'JOBSUM.h' X include 'FLWORK.h' X include 'CLASS.h' X*--- RETRY flag for second attempt without indentation if overflow X LOGICAL RETRY X*--- IUPPER = line fill of SIMA, max. indented statement starts in X* IMAX+7 X DATA IUPPER/72/, IMAX/30/ X RETRY=.TRUE. X NMOD=IMODIF(NSTREF) X I1=NFLINE(NSTREF) X 10 CONTINUE X*--- start of complete statement reformatting X IF(RETRY) THEN X*--- get user indentation X INU=NLBLPS(SIMA(I1),7,IMAX+6) X IF(ACTION(21)) THEN X*--- indent corresponding to level (from PROIND) X INB=6+MIN(IMAX,INDFAC*INDCNT) X*--- return if not modified and indentation correct X IF (IMODIF(NSTREF).LT.10.AND.INU.EQ.INB) THEN X DO 20 I=I1+1,NLLINE(NSTREF) X IF(NLTYPE(I).EQ.2) THEN X IF(NLBLPS(SIMA(I),7,IMAX+6).NE.INU) GOTO 30 X ENDIF X 20 CONTINUE X GOTO 999 X ENDIF X 30 CONTINUE X IF(NMOD.LT.10) NMOD=NMOD+10 X ELSE X INB=INU X ENDIF X ELSE X*--- second pass - try without indentation X INB=6 X ENDIF X NEWOUT=0 X INSTR=0 X INTRA=0 X IPTRA=0 X LTRA=0 X LAST=0 X 40 CONTINUE X NEWOUT=NEWOUT+1 X*--- start of a new line (statement number pre-set in PROCES or RENUMB) X IF(NEWOUT.EQ.20) THEN X IF (RETRY) THEN X RETRY=.FALSE. X GOTO 10 X ELSE X WRITE (MPUNIT,10000) X CALL FLPRNT(1,'OVERFLOW',NLLINE(NSTREF)-NFLINE(NSTREF)+1, X + SIMA(NFLINE(NSTREF)),NDUMMY) X NSTATC(6)=NSTATC(6)+1 X STATUS(11)=.TRUE. X GOTO 999 X ENDIF X ELSEIF(NEWOUT.GT.1) THEN X IF(INSTR.GE.0) THEN X SNEWST(NEWOUT)(1:6)=' +' X ELSE X*--- split statement into several at '<' X SNEWST(NEWOUT)(1:6)=' ' X INSTR=0 X ENDIF X ENDIF X*--- clear rest of statement X SNEWST(NEWOUT)(7:MXLINE)=' ' X IF(INSTR.EQ.0) THEN X*--- outside string X IPS=INB X ELSE X IPS=6 X ENDIF X IF(IPTRA.LT.LTRA) THEN X*--- add those items already prepared by call to NXITEM X L=MIN(IUPPER-IPS,LTRA-IPTRA) X SNEWST(NEWOUT)(IPS+1:IPS+L)=SSTA(IPTRA+1:IPTRA+L) X IPTRA=IPTRA+L X IPS=IPS+L X IF (IPTRA.LT.LTRA) GOTO 40 X ENDIF X INSTR=0 X IPT=LAST X 50 CONTINUE X IF (IPT.EQ.NCHST) GOTO 60 X*--- chop into nice little pieces X CALL NXITEM(SSTA,IPT+1,NCHST,LAST) X IF(SSTA(IPT+1:IPT+1).EQ.' ') THEN X IF (IPS.LT.IUPPER) IPS=IPS+1 X IPT=IPT+1 X IF (IPT.EQ.NCHST) GOTO 60 X ENDIF X IF(SSTA(IPT+1:IPT+1).EQ.'{') THEN X IPTRA=IPT+1 X ELSEIF(SSTA(IPT+1:IPT+1).EQ.'<') THEN X*--- split statement into several X IPTRA=LTRA X INSTR=-1 X GOTO 40 X ELSE X IPTRA=IPT X ENDIF X IF(SSTA(LAST:LAST).EQ.'}') THEN X LTRA=LAST-1 X ELSE X LTRA=LAST X ENDIF X L=LTRA-IPTRA X IF(L.LE.0) THEN X IPT=LAST X GOTO 50 X ENDIF X IF(L.LE.IUPPER-IPS) THEN X SNEWST(NEWOUT)(IPS+1:IPS+L)=SSTA(IPTRA+1:LTRA) X IPS=IPS+L X IPT=LAST X GOTO 50 X ELSE X IF (L.GT.IUPPER-INB) THEN X*--- split X SNEWST(NEWOUT)(IPS+1:IUPPER)=SSTA(IPTRA+1:) X INSTR=1 X IPTRA=IPTRA+IUPPER-IPS X ELSE X INSTR=0 X ENDIF X*--- start a new line X GOTO 40 X ENDIF X 60 CONTINUE X IF(ACTION(28)) THEN X*--- right-adjust GOTO statements X IF(ICURCL(1).EQ.IIF) THEN X ICLE=ISTMDS(6,ICURCL(2)) X ELSE X ICLE=ISTMDS(6,ICURCL(1)) X ENDIF X IF(ICLE.EQ.37) THEN X CALL MATCH('#GOTO@;',1,7,SNEWST(NEWOUT),7, X + LASTNB(SNEWST(NEWOUT),7,72), .FALSE.,KPOS,ILEV,NSPEC, X + IWS,IWS(1001)) X IF(KPOS.GT.0.AND.KPOS.LT.72) THEN X DO 70 I=72,7,-1 X SNEWST(NEWOUT)(I:I)=SNEWST(NEWOUT)(KPOS:KPOS) X IF(SNEWST(NEWOUT)(I:I).EQ.'G') GOTO 80 X KPOS=KPOS-1 X 70 CONTINUE X 80 CONTINUE X SNEWST(NEWOUT)(KPOS:I-1)=' ' X ENDIF X ENDIF X ENDIF X IMODIF(NSTREF)=NMOD X*--- re-formatted statement now in SNEWST X10000 FORMAT(/' +++++++++ WARNING - re-formatting leads to overflow, X + statement not changed:') X 999 END / echo 'x - RENUMB.f' sed 's/^X//' > RENUMB.f << '/' X SUBROUTINE RENUMB X*----------------------------------------------------------------------- X* X* Processes one routine statement by statement: X* filtering, replacements X* X*----------------------------------------------------------------------- X include 'PARAM.h' X include 'ALCAZA.h' X include 'CLASS.h' X include 'FLAGS.h' X include 'CURSTA.h' X include 'STATE.h' X include 'JOBSUM.h' X include 'FLWORK.h' X include 'CONDEC.h' X DIMENSION IKL(3) X* IKL(1) = last ch. of 'FMT=' or 0 X* IKL(2) = 'ERR=' X* IKL(3) = 'END=' X LOGICAL FMTFL X*--- FMTFL true when 'FMT=' found X CHARACTER SKL(3)*5,STEMP*1,STEMP3*3, SBUFF*5 X X DATA SKL/'#FMT=','#ERR=','#END='/ X include 'CONDAT.h' X*--- if no statement numbers, return X IF (NSTANU.EQ.0) GOTO 999 X*--- replace statement number if any X NN=NEXTIN(SIMA(NFLINE(NSTREF)),1,5) X IF (NN.NE.0) THEN X*--- get number from table X IF (NSTANU.LE.40) THEN X DO 10 J=1,NSTANU X IF (NN.EQ.KSTANU(J)) GOTO 20 X 10 CONTINUE X J=0 X 20 CONTINUE X ELSE X CALL BINSRC(NN,KSTANU,NSTANU,J,L) X ENDIF X IF (J.GT.0) THEN X NN=KSTARE(J) X ELSE X NN=0 X ENDIF X IF(NN.GT.0) THEN X IF (IMODIF(NSTREF).LT.10) IMODIF(NSTREF)=IMODIF(NSTREF)+10 X WRITE (SNEWST(1),'(I5)') NN X ENDIF X ENDIF X NMOD=IMODIF(NSTREF) X ICL=ICURCL(1) X IF(ICL.EQ.IIF) THEN X*--- get class of second part X ICL=ICURCL(2) X*--- ISTIND specifies tpyes X ISTIND=ISTMDS(10,ICL) X IF (ISTIND.EQ.0) GOTO 999 X*--- set pointer after first bracket X IPT=INDEX(SSTA(:NCHST),'(') X IF (IPT.EQ.0) GOTO 999 X CALL SKIPLV(SSTA,IPT+1,NCHST,.FALSE.,IPT,ILEV) X IF (IPT.EQ.0) GOTO 999 X SSTR(:IPT)=SSTA(:IPT) X IPS=IPT X ELSE X ISTIND=ISTMDS(10,ICL) X IF (ISTIND.EQ.0) GOTO 999 X IPT=0 X IPS=0 X*--- IPS = pointer in new string SSTR, IPT in old SSTA X ENDIF X*--- now IPT in front of statement X* X*--- treat the five different cases X IF(ISTIND.EQ.1) THEN X*--- one number, directly behind key X KFCH=0 X CALL SKIPTP(2,SSTA,IPT+1,NCHST,.FALSE.,IPTT,ILEV) X IF(IPTT.EQ.0.OR.IPTT.EQ.NCHST) GOTO 60 X STEMP=SSTA(IPTT+1:IPTT+1) X IF(STEMP.EQ.' '.AND.IPTT+2.LE.NCHST) STEMP=SSTA(IPTT+2:IPTT+2) X IF(NUMCH(STEMP)) THEN X CALL GETINT(SSTA,IPT+1,NCHST,KFCH,KLCH,NN) X ENDIF X GOTO 60 X ENDIF X*--- for all other cases, find bracket X LL=INDEX(SSTA(IPT+1:NCHST),'(')+IPT X IF (LL.EQ.IPT) GOTO 999 X CALL SKIPLV(SSTA,LL+1,NCHST,.FALSE.,LR,ILEV) X IF (LR.EQ.0) GOTO 999 X*--- first bracket between LL and LR X*--- look for 'FMT=' etc. X DO 30 I=1,3 X CALL MATCH(SKL(I),1,5,SSTA,LL,LR,.FALSE.,IKL(I),ILEV,NSPEC,IWS, X + IWS) X IF (I.EQ.1) FMTFL=IKL(1).GT.0 X 30 CONTINUE X N=0 X*--- count and order X DO 40 I=1,3 X IF (IKL(I).GT.0) THEN X N=N+1 X IKL(N)=IKL(I) X ENDIF X 40 CONTINUE X IF (N.GT.1) THEN X CALL SORTSP(N,IKL,NSPEC) X ELSE X NSPEC=N X ENDIF X*--- NFL is a flag for different passes X NFL=0 X 50 CONTINUE X KFCH=0 X IF (ISTIND.EQ.2) THEN X*--- all numbers inside first bracket X CALL GETINT(SSTA,LL+1,LR,KFCH,KLCH,NN) X LL=KLCH X ELSEIF (ISTIND.EQ.3) THEN X*--- all numbers follow first bracket X CALL GETINT(SSTA,LR+1,NCHST,KFCH,KLCH,NN) X LR=KLCH X ELSEIF (ISTIND.EQ.4) THEN X*--- inside first bracket 'FMT=' etc., X* or if no 'FMT=', second item X IF (.NOT.FMTFL) THEN X CALL POSCH(',',SSTA,LL+1,LR-1,.FALSE.,0,IPOS,ILEV) X IF(IPOS.EQ.0) GOTO 999 X CALL GETNBL(SSTA(IPOS+1:LR),STEMP,N) X IF(N.GT.0.AND.NUMCH(STEMP)) THEN X CALL GETINT(SSTA,IPOS+1,LR,KFCH,KLCH,NN) X LL=KLCH X ENDIF X ELSE X NFL=NFL+1 X IF (NFL.LE.NSPEC) THEN X CALL GETNBL(SSTA(IKL(NFL)+1:LR),STEMP,N) X IF(N.GT.0.AND.NUMCH(STEMP)) THEN X CALL GETINT(SSTA,IKL(NFL)+1,LR,KFCH,KLCH,NN) X LL=KLCH X ENDIF X ENDIF X ENDIF X ELSEIF (ISTIND.EQ.5) THEN X*--- alternate returns, '(*' or ',*' X IF (NFL.EQ.0) THEN X STEMP3='#(*' X ELSE X STEMP3='#,*' X ENDIF X NFL=NFL+1 X CALL MATCH(STEMP3,1,3,SSTA,LL,LR,.FALSE.,KPOS,ILEV,NSPEC,IWS, X + IWS) X IF (KPOS.GT.0) THEN X LL=KPOS X CALL GETINT(SSTA,LL+1,LR,KFCH,KLCH,NN) X LL=KLCH X ENDIF X ENDIF X 60 CONTINUE X*--- if KFCH > 0, number found X IF (KFCH.GT.0) THEN X IF (NMOD.LT.10) NMOD=NMOD+10 X*--- transmit part up to pointer X N=KFCH-IPT-1 X IF (N.GT.0) THEN X SSTR(IPS+1:IPS+N)=SSTA(IPT+1:IPT+N) X IPS=IPS+N X IPT=KLCH X ENDIF X*--- get number from table X IF (NSTANU.LE.40) THEN X DO 70 J=1,NSTANU X IF (NN.EQ.KSTANU(J)) GOTO 80 X 70 CONTINUE X J=0 X 80 CONTINUE X ELSE X CALL BINSRC(NN,KSTANU,NSTANU,J,L) X ENDIF X IF (J.GT.0) THEN X NN=KSTARE(J) X ELSE X NN=0 X ENDIF X*--- add to SSTR X WRITE (SBUFF,'(I5)') NN X DO 90 J=1,5 X STEMP=SBUFF(J:J) X IF (STEMP.NE.' ') THEN X IPS=IPS+1 X SSTR(IPS:IPS)=STEMP X ENDIF X 90 CONTINUE X FMTFL=.TRUE. X IF (ISTIND.GT.1) GOTO 50 X ENDIF X IF (NFL.EQ.1.AND.ISTIND.EQ.5) GOTO 50 X IF (.NOT.FMTFL.AND.ISTIND.EQ.4) THEN X FMTFL=.TRUE. X GOTO 50 X ENDIF X*--- transfer rest X N=NCHST-IPT X IF (N.GT.0) THEN X SSTR(IPS+1:IPS+N)=SSTA(IPT+1:NCHST) X IPS=IPS+N X ENDIF X IF (NMOD.GT.10) THEN X IF (IPS.LE.MXLENG) THEN X IMODIF(NSTREF)=NMOD X NCHST=IPS X SSTA(:IPS)=SSTR(:IPS) X ELSE X WRITE (MPUNIT,10000) X CALL FLPRNT(1,'OVERFLOW',NLLINE(NSTREF)-NFLINE(NSTREF)+1, X + SIMA(NFLINE(NSTREF)),NDUMMY) X NSTATC(6)=NSTATC(6)+1 X STATUS(11)=.TRUE. X ENDIF X ENDIF X10000 FORMAT(/' ++++++ Warning - renumbering would lead to overflow', X +' in following statement, not done') X 999 END / echo 'x - TREEST.f' sed 's/^X//' > TREEST.f << '/' X SUBROUTINE TREEST(MODE) X*----------------------------------------------------------------------- X* X*--- Prepares TREE file output (called for each statement) X* X*---Input X* MODE =0 : headerless routine start X* >0 : normal routine start, or statement X*----------------------------------------------------------------------- X include 'PARAM.h' X include 'ALCAZA.h' X include 'TREECOM.h' X include 'STATE.h' X include 'FLAGS.h' X include 'CLASS.h' X include 'CURSTA.h' X CHARACTER SNAME*(MXNMCH),STEMP*1 X LOGICAL LEXARS X NCALLP=NCALLD X IF(MODE.EQ.0) THEN X*--- headerless routine start X NCALLR=NCALLR+1 X ICALLR(NCALLR)=0 X CALLER(NCALLR)=SCROUT X ELSE X*--- external class number X ICLE=ISTMDS(6,ICURCL(1)) X*--- routine header or entry X IF(ISTMDS(14,ICURCL(1)).NE. 0.OR.ICLE.EQ.29) THEN X IF(ICLE.EQ.29) THEN X SNAME=SNAMES(ISNAME+1) X ELSE X SNAME=SCROUT X ENDIF X*--- keep argument name list X NARGEL=MAX(0,MIN(NSNAME-1,NOARG)) X DO 10 I=1,NARGEL X SARGEL(I)=SNAMES(ISNAME+I+1) X 10 CONTINUE X*--- add routine name to list X IF(NCALLR.LT.KENT) THEN X*--- keep statement ref. for callers X ICALLR(NCALLR+1)=NSTREF X CALLER(NCALLR+1)=SNAME X NCALLR=NCALLR+1 X ENDIF X ELSEIF(ICLE.EQ.31) THEN X*--- EXTERNAL statement - keep names X DO 20 I=1,NSNAME X IF(NEXEL.LT.KALL) THEN X NEXEL=NEXEL+1 X SEXEL(NEXEL)=SNAMES(ISNAME+I) X ENDIF X 20 CONTINUE X ELSEIF(ISTMDS(11,ICURCL(1)).NE.0) THEN X*--- executable - scan all names X IF(ICURCL(1).EQ.IIF) THEN X ICLE=ISTMDS(6,ICURCL(2)) X IND=INDEX(SSTA,'(') X CALL SKIPLV(SSTA,IND+1,NCHST,.FALSE., IPT,ILEV) X ELSE X ICLE=ISTMDS(6,ICURCL(1)) X IPT=0 X ENDIF X IF(ICLE.EQ.7) THEN X*--- subroutine call X DO 30 I=1,NSNAME X IF(NSSTRT(I).GT.IPT) GOTO 40 X 30 CONTINUE X GOTO 999 X 40 CONTINUE X*--- keep name ref. of call X ISTC=I X*--- check against argument list, drop if argument X DO 50 J=1,NARGEL X IF(SNAMES(ISNAME+I).EQ.SARGEL(J)) GOTO 55 X 50 CONTINUE X IF(NCALLD.LT.KALL) THEN X NCALLD=NCALLD+1 X CALLED(NCALLD)=SNAMES(ISNAME+I) X CEDARG(NCALLD)=' ' X IND=INDEX(SSTA(IPT+1:NCHST),'(') X IF(IND.GT.0) THEN X CALL ARGTYP(SSTA,.FALSE.,IPT+IND,NCHST, X + CEDARG(NCALLD)) X ENDIF X ENDIF X ELSE X ISTC=0 X ENDIF X 55 CONTINUE X DO 70 I=1,NSNAME X IF(I.EQ.ISTC) GOTO 70 X IF((ITBIT(NAMTYP(ISNAME+I),17).NE.0 X + .AND.SNAMES(ISNAME+I).NE.SCROUT) X + .OR.ITBIT(NAMTYP(ISNAME+I),12).NE.0) THEN X*--- name is a function, or EXTERNAL X*--- check against argument list, drop if argument X DO 60 J=1,NARGEL X IF(SNAMES(ISNAME+I).EQ.SARGEL(J)) GOTO 70 X 60 CONTINUE X IF(NCALLD.LT.KALL) THEN X IPT=NSEND(I)+1 X IF(LEXARS(I)) THEN X*--- name appears as argument to another routine X NCALLD=NCALLD+1 X CALLED(NCALLD)=SNAMES(ISNAME+I) X CEDARG(NCALLD)='$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ X +$$$$$$$$$$$$$$$$$$' X ELSE X STEMP=SSTA(IPT:IPT) X IF(STEMP.EQ.' ') THEN X IPT=IPT+1 X STEMP=SSTA(IPT:IPT) X ENDIF X IF(STEMP.EQ.'(') THEN X CALL SKIPLV(SSTA,IPT+1,NCHST,.FALSE., IPOS, X + ILEV) X IF(IPOS.GT.0) THEN X NCALLD=NCALLD+1 X CALLED(NCALLD)=SNAMES(ISNAME+I) X CEDARG(NCALLD)=' ' X CALL ARGTYP(SSTA,.FALSE.,IPT,IPOS, X + CEDARG(NCALLD)) X ENDIF X ENDIF X ENDIF X ENDIF X ENDIF X 70 CONTINUE X ENDIF X ENDIF X*--- suppress multiple subsequent called routines with identical X* argument type lists X IF(NCALLP.GT.0.AND.NCALLD.GT.NCALLP) THEN X IF(CALLED(NCALLD).EQ.CALLED(NCALLD-1) X + .AND.CEDARG(NCALLD).EQ.CEDARG(NCALLD-1)) NCALLD=NCALLD-1 X ENDIF X 999 END / echo 'x - floppy.l' sed 's/^X//' > floppy.l << '/' X.TH floppy 1 "3rd May 1990" "CERN" X.SH NAME Xfloppy \- Fortran coding convention checker and code tidier X.SH SYNOPSIS X.B floppy X[ X.B \-l X] [ X.B \-c rules X] [ X.B \-f X] [ X.B \-o old file X] [ X.B \-i names X] [ X.B \-j number X] [ X.B \-F X] [ X.B \-G X] [ X.B \-r start[,step] X] [ X.B \-s start[,step] X] [ X.B \-n new fortran X] [ file ] X.SH DESCRIPTION X.I Floppy Xis a tool which allows a file of Fortran 77 code to be checked against Xa set of common coding conventions. Floppy also allows the source Fortran Xto be reformatted and tidied in various ways. X.PP XNote that, before passing code through Floppy, it should have Xbeen compiled, preferably with the ANSI compiler flag, to check Xfor errors. Otherwise, the results from using Floppy are Xunpredictable. Note also that non-standard Fortran statements X(such as "include" directives or lower-case) are treated as X.B comments Xby Floppy, and thus ignored. X X.SH OPTIONS X.IP \fB\-l\fR 12 XThe X.I logging Xoption causes Floppy to produce a verbose description of the selected options. X.IP \fB\-c\ rules \fR 12 XThe X.I checks Xoption indicates which rules Floppy should check. The checks may be specified as Xa series of comma-separated numbers (see below), or as one of the following: X.RS 12 X.IP standard 12 XThe standard set of rules will be checked (those marked * in the list below). X.IP a 12 XALL rules in the available list will be checked. X.IP n 12 XNO rules will be checked. (Useful when just tidying code.) X.PP XNote that, if selecting individual rule numbers, 99 is taken to mean ALL Xrules, and -99 to mean NO rules. Specifying a negative rule number excludes Xthat rule. So to check all rules except 1,5,7 and 31, you can use X.br X.RS 12 X.I -c99,-1,-5,-7,-31 X.RE 12 X X.RE X.IP \fB\-f\fR 12 XThe X.I full Xqualifier specifies Xthat all source code lines should be listed, rather than Xjust those in breach of any specified rules. X X.IP \fB\-o\ old file\fR 12 XUse a previously-generated file of rule numbers, ignore names etc. XThe X.I old Xtag should be set to the file name, which is generated by Xappending .old to the previous source Fortran file name. X X.IP \fB\-i\ names\fR 12 XSpecify a list of Fortran module and variable names to be ignored Xwhen the rules are checked. Specify module names by prepending the Xname with a # sign. The list of names should be separated by commas. XNote also that the names should be uppercase, to conform with the XF77 standard. For example, X.br X.I -i#GOOBAR,FOOBAR Xwill cause subroutine GOOBAR to be ignored, and any references to the Xvariable FOOBAR. X X.PP X XThe following options apply to code tidying: X X.IP \fB\-j\ [number]\fR 12 XThe X.I indent Xoption causes all DO loops and IF...THEN...ENDIF clauses to be Xindented by the specified number of spaces to the right. The default Xvalue is 3 spaces, the maximum allowed is 5. X X.IP \fB\-F\fR 12 XSpecifies that all FORMAT statements be grouped together at the end Xof each module. X X.IP \fB\-G\fR 12 XSpecifies that all GOTO n clauses are right adjusted to column 72. X X.IP \fB\-s\ start,[step]\fR 12 XSpecify that all labelled statements be re-numbered, starting at X.I start Xand stepping by X.I step. XThe default value for X.I step Xis 10. X X.IP \fB\-r\ start,[step]\fR 12 XSpecify that all FORMAT statements be re-numbered, starting at X.I start Xand stepping by X.I step. XThe default value for X.I step Xis 10. X X.IP \fB\-n\ new fortran\fR 12 XCauses the new Fortran file to be called X.I new fortran. XIf this option is not given, then the new Fortran file Xwill have the name of the source Fortran, appended by X.I .out X X.SH CODING CONVENTION LIST X XThe full list of rules is as follows: X.br X.(l X* 1 Avoid comment lines after end of module X.br X* 2 End all program modules with the END statement X.br X* 3 Declared COMMON blocks must be used in the module X.br X* 4 COMPLEX and DOUBLEPRECISION vars at end of COMMON X.br X* 5 COMMON block definitions should not change X.br X* 6 Variable names should be 6 or fewer characters long X.br X 7 Variables in COMMON should be 6 characters long X.br X 8 Variables not in COMMON should be <6 characters X.br X* 9 Integer variables should begin with I to N X.br X* 10 Variable names should not equal FORTRAN keywords X.br X* 11 Avoid comment lines before module declaration X.br X* 12 Module names should not equal intrinsic functions X.br X* 13 First statement in a module should be declaration X.br X* 14 Module should begin with at least 3 comment lines X.br X 15 Comment lines should begin with a C X.br X* 16 No comment lines between continuations X.br X* 17 Avoid non-standard variable types eg INTEGER*2 X.br X* 18 Avoid multiple COMMON definitions per line X.br X* 19 Do not dimension COMMON variables outside COMMON X.br X* 20 Avoid embedded blanks in variable names X.br X* 21 Avoid embedded blanks in syntactic entities X.br X* 22 Avoid the use of PRINT statements (use WRITE) X.br X 23 Do not give the END statement a label X.br X* 24 Avoid WRITE(* construction X.br X 25 Avoid WRITE statement in a FUNCTION X.br X* 26 Avoid the use of PAUSE statements X.br X* 27 Statement labels should not begin in column 1 X.br X* 28 Always preceede STOP by a descriptive WRITE X.br X* 29 Avoid the use of ENTRY in FUNCTIONS X.br X* 30 Avoid using I/O in FUNCTIONs X.br X 31 Avoid the use of the alternate RETURN statement X.br X* 32 COMMON block names should not equal variable names X.br X* 33 Avoid use of obsolete CERN library routines X.br X 34 Avoid FUNCTION names the same as intrinsics X.br X* 35 Local functions should be declared EXTERNAL X.br X* 36 Module names should all be different X.br X* 37 Avoid expressions of mixed mode eg A=B/I X.br X* 38 Length of passed CHARACTER variables should be * X.br X* 39 Order of statements should conform ! X.br X* 40 Separate Statement Functions by comment lines X.br X* 41 No names in Statement Function definitions elsewhere X.br X 42 Use LLT,LGT etc to compare CHARACTER vars. in IFs X.br X 43 Variables (not COMMON, not PARAMs) <6 characters X.br X* 44 Passed arguments should be dimensioned * in module X.br X.)l X X.SH SEE ALSO X.PP Xf77(1) / echo 'Part 07 of Floppy complete.' exit