C**********************************************************************C C PURPOSE : TO CALCULATE INDUSTRY MEANS AND MEDIANS FOR SELECT FIRMS, C FOR A NUMBER OF BUILT-IN RATIOS. USES DATA FROM THE C C COMPUSTAT ANNUAL INDUSTRIAL AND RESEARCH FILES. C C C C C C C C AUTHOR : PREMAL P. VORA C C (FPV@PSU.EDU) C C C C DATE : AUGUST 2000 C C C C C C OS : UNIX (EXCEPT FOR FILENAMES, NOTHING IN THIS PROGRAM IS C C IS SYSTEM-SPECIFIC) C C C C LANGUAGE: FORTRAN 77 WITH EXTENSIONS C C (EXTENSIONS: LONG VARIABLE NAMES, '!' COMMENTS) C C LIBRARY : THE IMSL SORT SUBROUTINE SVRGP IS CALLED C ***********************************************************************C IMPLICIT NONE c----------------------------------------------------------------------c c THE FOLLOWING PARAMETERS ARE ALL USER-DEFINED. SEE THE DOCUMENT c c INDUSTIO.PDF FOR AN EXPLANATION OF WHAT THESE PARAMETERS MEAN c c DEFAULT VALUES ARE: c c MAXSIZE=999 c c MINSIZE=10 c c RATIOS=9 c c BEGYR=-2 c c ENDYR=0 c c NFIRMS=5 c c----------------------------------------------------------------------c INTEGER MAXSIZE PARAMETER (MAXSIZE=999) ! MAX FIRMS EXPECTED IN INDUSTRY ! INTEGER MINSIZE PARAMETER (MINSIZE=10)! MIN NUMBER OF FIRMS REQUIRED IN INDUSTRY ! INTEGER RATIOS PARAMETER (RATIOS=9) ! HOW MANY DIFFERENT RATIOS APPEAR IN STUDY ! INTEGER BEGYR, ENDYR ! BEGINNING AND END OF THE YEARS THAT RATIOS! PARAMETER(BEGYR=-2,ENDYR=1 )!BE CALCULATED. RELATIVE TO EVENT YEAR INTEGER NFIRMS PARAMETER (NFIRMS=5 ) ! NUMBER OF FIRMS IN INPUT FILE ! c-----END OF THE USER-DEFINED PARAMETER SECTION------------------------c c----------------------------------------------------------------------c INTEGER YEARIN ! HOW MANY YEARS THE ! PARAMETER (YEARIN=20) ! RATIOS ARE CALCULATED FOR ! REAL NULL PARAMETER (NULL=-0.001) CHARACTER*6 CNUMEV(NFIRMS), FIRMNAME*80 ! CNUMS OF SELECT FIRMS ! CHARACTER*6 CNUMIND(MAXSIZE) ! CNUMS OF INDUSTRY FIRMS ! CHARACTER*30 RATIONAM(RATIOS) ! NAMES OF THE RATIOS ! INTEGER D(0:2), EVTYR(NFIRMS), INDDIGIT INTEGER BEGW, ENDW ! BEGINNING AND END PASSED TO THE WRITERAT ! C----------------------------------------------------------------------C C D(.) CONTAINS THE 4-, 3-, AND 2-DIGIT CODES OF THE INDUSTRIES C C THAT THE CURRENT FIRM IS IN. EVTYR(L) IS EVENT YEAR IN YYYY FORMAT C IF INDDIGIT=0 THEN INDUSTRY=FIRMS IN THE 4-DIGIT SIC CODE, C C (=1, 3-DIGIT), (=2,2-DIGIT). C C----------------------------------------------------------------------C INTEGER H, I, J, K, L INTEGER NRAT ! N RATIO...DEFINED WHEN GOING THROUGH LOOPS ! INTEGER DLBAR, DUBAR ! LOWER AND UPPER BOUNDS OF THE INDUSTRY SIC ! INTEGER INDCT(0:RATIOS) ! COUNTS NUMBER OF FIRMS IN INDUSTRY FOR EVERY ! ! RATIO, INDCT(0) KNOWS HOW MANY TIMES OPERROA ! INTEGER DNUMIN(NFIRMS) ! DNUMS OF SELECT FIRMS ! LOGICAL INFOUND/.FALSE./ ! CHECKS WHETHER THE IN-SAMPLE FIRM WAS FOUND! LOGICAL SAMEDNUM ! IS THE NEW FIRM IN THE SAME DNUM? ! LOGICAL SAMECNUM ! DOES THE NEW FIRM HAVE THE SAME CNUM? ! LOGICAL SAMEEVYR ! NEW FIRM HAVE THE SAME EVENT YEAR? ! C----------------------------------------------------------------------C C EVFIFRAC CONTAINS THE RATIOS FOR THE FIRMS THAT EXPERIENCE THE EVENT C C INDFRAC CONTAINS THE RATIOS THE INDUSTRY THAT THE EVENT FIRM IS IN C C----------------------------------------------------------------------C REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) ! RATIOS OF SELECT FIRMS ! REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) ! RATIOS OF THE INDUSTRY FIRMS ! REAL VALID(MAXSIZE,YEARIN,RATIOS)! WILL CONTAIN THE DATA THAT IS VALID ! INTEGER VALIDCT(YEARIN,RATIOS)! THE COUNT OF VALID OBSERVATIONS ! REAL RA(MAXSIZE) ! SVRGP VARIABLE ! INTEGER IPERM(MAXSIZE) ! SVRGP VARIABLE ! REAL MEAN(YEARIN,RATIOS), MED(YEARIN,RATIOS) ! MEAN AND MEDIAN HERE ! INTEGER NCO/0/ ! NUMBER OF TIMES THE COMPUSTAT DATA IS ACCESSED ! c----------------------------------------------------------------------c c-----THE FOLLOWING VARIABLES KEEP A TALLY FOR THE LOG-----------------c INTEGER NREAD/0/,NFOUND/0/,NINDUS/0/ ! CHARACTER*1 FIRMFOUND(NFIRMS), INDFILLED(NFIRMS) ! C NREAD COUNTS HOW MANY FIRMS WERE READ IN FROM fdnumin.txt ! C NFOUND COUNTS HOW MANY SELECT FIRMS WERE FOUND IN COMPUSTAT DATA ! C NINDUS COUNTS FOR HOW MANY FIRMS INDUSTRY RATIOS WERE CALCULATED ! C FIRMFOUND (Y,N) KEEPS A TAB ON WHETHER THE FIRM WAS FOUND OR NO ! C INDFILLED (Y,N) KEEPS A TAB ON WHETHER THE INDUSTRY WAS POPULATED! c----------------------------------------------------------------------c c----------------------------------------------------------------------c C-----THE FOLLOWING ARE ALL UNITS OF FILES THAT ARE USED---------------C INTEGER DATAIN, RDATAIN, FDATAIN, FIRMIN, RATIOOUT, LOGFILE INTEGER INFILE ! A "POINTER" TO WHICH INPUT FILE SHOULD BE USED C C----------------------------------------------------------------------C C THE VARIABLES THAT ARE DEFINED BELOW COME FROM THE INA.F C C COMPUSTAT DATA ACCESS FILE C C------------------------------------- --------------------------------C CHARACTER*28 CONAME,INAME CHARACTER CNUM*6,SMBL*8,EIN*10,CIC*3 CHARACTER CPSPIN*1,CSSPIN*2,CSSPII*1,SPDRC*2,SPDRCF*2 CHARACTER SUBDBT*2,SPCPRC*2,NAICS*6 CHARACTER*2 AFTNT(70,20) REAL DATA(350,20) INTEGER DNUM,REC,FILE,ZLIST,FYR(20),YEARA(20),XREL INTEGER STK,DUP,UCODE(20) INTEGER STATE,COUNTY,FINC,SOURCE(20) PRINT *, 'EXECUTION BEGINS....' C----------------------------------------------------------------------C C INITIALIZE ALL THE VARIABLES THAT NEED TO BE INITIALIZED HERE. C C----------------------------------------------------------------------C DATA DATAIN, FIRMIN, RATIOOUT, LOGFILE/11,12,21,24/! DEFAULT FILE UNITS ! DATA RDATAIN, FDATAIN/13,14/ DO I=1,NFIRMS FIRMFOUND(I) = 'N' ! THE DEFAULT IS FIRM AND ! INDFILLED(I) = 'Y' ! INDUSTRY ARE NOT FOUND ! DO J=1,YEARIN ! SET THE DEFAULT RATIOS ! DO K=1,RATIOS ! FOR THE IN-SAMPLE FIRMS ! EVFIFRAC(I,J,K) = -0.001 ! AS MISSING. ! ENDDO ! ! ENDDO ENDDO CALL RESETINDCT(RATIOS,INDCT) ! INITIALIZE THE COUNT OF ! ! FIRMS IN THE INDUSTRY ! CALL NAMERATIOS(RATIONAM,RATIOS) ! GIVE NAME TO EACH RATIO ! SAMEDNUM=.FALSE. ! INITIALIZE THESE VARIABLES ! SAMECNUM=.FALSE. ! ! SAMEEVYR=.FALSE. ! ! NCO=0 C----------------------------------------------------------------------------C C OPEN ALL THE FILES HERE C C----------------------------------------------------------------------------C OPEN (DATAIN,ACCESS='SEQUENTIAL', STATUS='OLD', READONLY, ! . FORM='UNFORMATTED', ! . FILE='/wrds/compustat/seqdata/ina.bin') ! INDUSTRIAL FILE ! OPEN (RDATAIN, ACCESS='SEQUENTIAL', STATUS='OLD', READONLY, ! . FORM='UNFORMATTED', ! COMPUSTAT RESEARCH ! . FILE='/wrds/compustat/seqdata/res.bin') ! FILE ! OPEN (FDATAIN, ACCESS='SEQUENTIAL', STATUS='OLD', READONLY, ! . FORM='UNFORMATTED', ! COMPUSTAT RESEARCH ! . FILE='/wrds/compustat/seqdata/fca.bin') ! FILE ! ! OPEN (FIRMIN,FILE='fdnumin.txt') ! CONTAINS INPUT DNUMS ! c OPEN (FIRMIN,FILE='f1.txt') ! CONTAINS INPUT DNUMS ! ! ! OPEN (RATIOOUT,FILE='ratios.csv') ! OUTPUT FILE ! OPEN (LOGFILE,FILE='industio.log') ! LOG FILE SUMMARIZES RUN ! C----------------------------------------------------------------------------! 1 FORMAT(A3) C-----THIS IS THE BIG LOOP THAT CONTROLS THE PROGRAM-------------------C DO 2000, L=1, NFIRMS c----------------------------------------------------------------------c C-------READ AND PRINT EACH FIRM'S HEADER RECORD-----------------------C READ(FIRMIN,42,END=2002) EVTYR(L), DNUMIN(L), CNUMEV(L), FIRMNAME PRINT *, 'INPUT FIRM NUMBER ',L, ' DNUM ', DNUMIN(L), . ' CNUM ',CNUMEV(L) 42 FORMAT(I4,5X,I4,1X,A6,1X,A30) NREAD = NREAD + 1 ! INCREMENT THE COUNT OF FIRMS READ IN ! IF(L .GT. 1) THEN ! IF NOT FIRST FIRM, THEN WRITE LINES ! WRITE(RATIOOUT,*) ! BEFORE THE PREVIOUS FIRM'S DATA ! WRITE(RATIOOUT,*) WRITE(RATIOOUT,*) ENDIF c----------------------------------------------------------------------c C------WRITE THE NAME, ETC. REGARDING THE FIRM TO OUTPUT FILE----------c WRITE(RATIOOUT,44) FIRMNAME, EVTYR(L), DNUMIN(L), CNUMEV(L) 44 FORMAT(A30,',',I4,',',I4,',',A6) C----------------------------------------------------------------------C C THIS IS THE CODE THAT CHECKS FOR WHETHER THE NEW FIRM THAT WAS C C READ HAS ANY CHARACTERISTIC SIMILAR TO THE 'OLD' FIRM...THEN C C PROCEED. C C----------------------------------------------------------------------C IF(L .GT. 1) THEN CALL SETSAME(L,CNUMEV,DNUMIN,EVTYR,SAMECNUM,SAMEDNUM,SAMEEVYR, . NFIRMS) D PRINT *, SAMEDNUM, SAMECNUM, SAMEEVYR ENDIF C----------------------------------------------------------------------C C BASED ON THE DEGREE OF SIMILARITY BETWEEN THE FIRM JUST READ C C AND THE FIRM BEFORE, DETERMINE WHAT NEEDS TO BE DONE, DO IT C C AND CONTINUE AT THE APPROPRIATE PLACE. C C----------------------------------------------------------------------C IF(L .GT. 1) THEN IF(SAMECNUM) THEN C PRINT*, 'SAME CNUM.' INFOUND = .TRUE. FIRMFOUND(L) = 'Y' NFOUND = NFOUND + 1 NINDUS = NINDUS + 1 CALL COPYEVFI(NFIRMS,YEARIN,RATIOS,EVFIFRAC,L)! COPY OLD TO NEW ! CALL DETFYR(EVTYR(L),YEARA,BEGYR,ENDYR,BEGW,ENDW) CALL WRITINDCT(INDCT(0),INDDIGIT,RATIOOUT) ! WRITE COUNT ! DO 25, H=1,RATIOS CALL WRITERAT(RATIOOUT,RATIONAM(H),FIRMNAME,EVFIFRAC, . BEGW,ENDW,MED,MEAN,VALIDCT,NFIRMS,YEARIN,RATIOS, . L,H,LOGFILE) 25 CONTINUE GOTO 2000 ELSEIF(SAMEDNUM) THEN C PRINT*, 'SAME DNUM.' INFOUND = .FALSE.! RESETS WHETHER THE SELECT FIRM WAS FOUND ! NINDUS = NINDUS + 1 CALL DETFYR(EVTYR(L),YEARA,BEGYR,ENDYR,BEGW,ENDW) CALL PULLPUSH(INDCT,INDFRAC,EVFIFRAC,L,NFIRMS,YEARIN, . RATIOS,MAXSIZE,CNUMEV(L-1),CNUMEV(L),DNUMIN(L-1), . DNUMIN(L),CNUMEV,CNUMIND,INFOUND,NFOUND,FIRMFOUND, . LOGFILE) CALL WRITINDCT(INDCT(0),INDDIGIT,RATIOOUT) CALL RESETVAL(MAXSIZE,YEARIN,RATIOS,VALIDCT,VALID,MEAN,MED) CALL LOOP1100(RATIOS,YEARIN,MAXSIZE,RATIOOUT,INDCT,VALIDCT, . IPERM,BEGW,ENDW,INDFRAC,VALID,EVFIFRAC,NULL,MED,MEAN, . RATIONAM,FIRMNAME,RA,NFIRMS,LOGFILE,L) GOTO 2000 ELSE INFOUND = .FALSE.! RESETS WHETHER THE SELECT FIRM WAS FOUND ! ENDIF ENDIF C------------------------------------------------------------------------------C C SINCE THERE'S NO CONNECTION BETWEEN THIS FIRM AND THE LAST FIRM C C THEN START LOOKING FOR INDUSTRY FIRMS ON THE FILES. C C------------------------------------------------------------------------------C D(0)=DNUMIN(L) ! THIS ARRAY STORES THE RESPECTIVE 4-, 3-, ! D(1)=DNUMIN(L)/10 * 10 ! AND 2-DIGIT SIC CODES W.R.T. THE IN- ! D(2)=DNUMIN(L)/100 * 100 ! SAMPLE FIRM THAT WAS JUST READ ! INDDIGIT=0 ! START WITH THE 4-DIGIT SIC CODE ! 50 CONTINUE INFILE=DATAIN ! BEGIN WITH THE INDUSTRIAL ANNUAL DATA ! C----------------------------------------------------------------------C C SET INDCT, VALIDCT, VALID, ALL TO ZERO C C----------------------------------------------------------------------C CALL RESETINDCT(RATIOS,INDCT) CALL RESETVAL(MAXSIZE,YEARIN,RATIOS,VALIDCT,VALID,MEAN,MED) 124 FORMAT(A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT(A10,1X,I5,5(F12.4,1X)) C----------------------------------------------------------------------C C THE FOLLOWING TWO LINES SET THE LOWER AND UPPER BOUND FOR CHECKING C C WHETHER THE COMPUSTAT FIRM IS TO BE INCLUDED IN THE STUDY OR NO C C----------------------------------------------------------------------C DLBAR = D(INDDIGIT)/10**INDDIGIT * 10**INDDIGIT DUBAR = D(INDDIGIT) + 10**INDDIGIT -1 100 CONTINUE C----------------------------------------------------------------------C C C C NOW READ THE C O M P U S T A T DATA C C C C----------------------------------------------------------------------C READ(INFILE,END=1040)DNUM,CNUM,CIC,REC,FILE,ZLIST,INAME,CONAME, . SMBL,FYR,YEARA,XREL,STK,DUP,UCODE,STATE,COUNTY,FINC, . SOURCE,CPSPIN,CSSPIN,CSSPII,SPDRC,SPDRCF,SUBDBT,SPCPRC, . EIN,NAICS,AFTNT,DATA NCO = NCO + 1 ! INCREMENT THE NUMBER OF FIRMS RETRIEVED ! C----------------------------------------------------------------------C C NEXT LINE JUST KEEPS OUTPUT GOING TO SCREEN TO TELL USER C C PROGRAM IS STILL RUNNING C C----------------------------------------------------------------------C IF(INT(NCO/1000)*1000.EQ.NCO) THEN PRINT*,'COMPANY: ',NCO ENDIF C------------------------------------------------------------------------------C C IF THE DNUM OF THE FIRM READ FROM COMPUSTAT IS LESS THAN THE LOWER BOUND C C OF THE FIRMS TO BE INCLUDED, THEN KEEP READING COMPUSTAT DATA... C C------------------------------------------------------------------------------C IF(((DNUM/10**INDDIGIT) * 10**INDDIGIT) .LT. DLBAR) THEN GOTO 100 ELSE C----------------------------------------------------------------------C C DNUM OF COMPUSTAT RETRIEVED FIRM IS GREATER THAN OR EQUAL TO C C THE DNUM OF THE IN-SAMPLE FIRM. IF EQUAL THEN MOVE THIS FIRM TO C C INDFRAC, ELSE CHECK IF SUFFICIENT FIRMS HAVE BEEN RETRIEVED C C----------------------------------------------------------------------C C---------------------------------------------------------------------C C FOLLOWING TESTS WHETHER ALL COMPANIES IN WILDCARD SEARCH HAVE C C BEEN RETRIEVED ALREADY C C---------------------------------------------------------------------C IF((DNUM .EQ. 0) .OR. . (((DNUM/10**INDDIGIT) * 10**INDDIGIT) .GT. DUBAR)) THEN C PRINT *, 'GO TO 1040 CALLED' GOTO 1040 ELSE C----------------------------------------------------------------------C C RETRIEVED DATA IS PROCESSED IN THE SECTION BELOW FOR C C EACH COMPANY THAT MEETS THE WILDCARD SEARCH CRITERIA C C----------------------------------------------------------------------C 132 FORMAT(I4,1X,A6,1X,A30) D PRINT *, DNUM, CNUM, CONAME INDCT(0) = INDCT(0) + 1 C--------CALL: OPERATING RETURN ON ASSETS-----------------------------C CALL OPERROA(DATA,CNUMEV(L),CNUM,INDCT(1),L, . YEARA,INFOUND,NFOUND,FIRMFOUND,LOGFILE,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME,CNUMIND,CNUMEV, . INDDIGIT) C--------CALL: CURRENT RATIO ------------------------------------------C NRAT=2 ! WHICH RATIO IS BEING CALCULATED ! CALL CURRENT(DATA,CNUMEV(L),CNUM,INDCT(NRAT),L, . YEARA,LOGFILE,NRAT,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) C--------CALL: QUICK RATIO --------------------------------------------C NRAT=3 ! WHICH RATIO IS BEING CALCULATED ! CALL QUICK(DATA,CNUMEV(L),CNUM,INDCT(NRAT),L, . YEARA,LOGFILE,NRAT,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) C--------CALL: NET PROFIT MARGIN --------------------------------------C NRAT=4 ! WHICH RATIO IS BEING CALCULATED ! CALL NPM(DATA,CNUMEV(L),CNUM,INDCT(NRAT),L, . YEARA,LOGFILE,NRAT,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) C--------CALL: RETURN ON EQUITY ---------------------------------------C NRAT=5 ! WHICH RATIO IS BEING CALCULATED ! CALL ROE(DATA,CNUMEV(L),CNUM,INDCT(NRAT),L, . YEARA,LOGFILE,NRAT,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) C--------CALL: TOTAL ASSET TURNOVER -----------------------------------C NRAT=6 ! WHICH RATIO IS BEING CALCULATED ! CALL TATURN(DATA,CNUMEV(L),CNUM,INDCT(NRAT),L, . YEARA,LOGFILE,NRAT,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) C--------CALL: INVENTORY TURNOVER -------------------------------------C NRAT=7 ! WHICH RATIO IS BEING CALCULATED ! CALL INVTURN(DATA,CNUMEV(L),CNUM,INDCT(NRAT),L, . YEARA,LOGFILE,NRAT,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) C--------CALL: TIMES INTEREST EARNED ----------------------------------C NRAT=8 ! WHICH RATIO IS BEING CALCULATED ! CALL TIMESINT(DATA,CNUMEV(L),CNUM,INDCT(NRAT),L, . YEARA,LOGFILE,NRAT,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) C--------CALL: DEBT RATIO ---------------------------------------------C NRAT=9 ! WHICH RATIO IS BEING CALCULATED ! CALL DEBTRAT(DATA,CNUMEV(L),CNUM,INDCT(NRAT),L, . YEARA,LOGFILE,NRAT,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) c----------------------------------------------------------------------c c THE FOLLOWING CALL GENERIC STATEMENT CALLS A GENERIC SUBROUTINE c c THAT CAN BE MODIFIED TO CREATE A NEW USER-DEFINED RATIO. AT THE c c END OF THIS FILE, A 'SUBROUTINE GENERIC' HAS BEEN PROVIDED THAT c c CAN BE MODIFIED TO CALCULATE THE USER-DEFINED RATIO. SEE THE c c industio.pdf MANUAL FOR MORE INFORMATION ON CREATING NEW RATIOS c c----------------------------------------------------------------------c C NRAT=10 ! WHICH RATIO IS BEING CALCULATED ! C CALL GENERIC(DATA,CNUMEV(L),CNUM,INDCT(NRAT),L, C . YEARA,LOGFILE,NRAT,INDFRAC,EVFIFRAC, C . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) 157 FORMAT(F3.0,I2,6(F12.4)) ENDIF !IF ((DNUM .EQ. 0) .OR. (DNUM .GT. ILOOP)) THEN ! ENDIF ! IF (DNUM .LT. DNUMIN) THEN ! GO TO 100 1040 CONTINUE ! REACHING 1040 MEANS EITHER THAT THE ! IF(INFILE .EQ. DATAIN) THEN ! EOF HAS BEEN REACHED FOR INFILE OR ! INFILE=RDATAIN ! THAT DUBAR HAS BEEN REACHED FOR THE ! C PRINT*, 'DONE WITH INA...NOW OFF TO RESEARCH FILE...' GOTO 100 ! LAST FIRM THAT WAS READ IN. THIS ! ELSEIF(INFILE .EQ. RDATAIN) THEN ! EOF HAS BEEN REACHED FOR INFILE OR ! INFILE=FDATAIN ! THAT DUBAR HAS BEEN REACHED FOR THE ! C PRINT*, 'DONE WITH RES...NOW OFF TO FULL COVERAGE FILE...' GOTO 100 ! LAST FIRM THAT WAS READ IN. THIS ! ENDIF ! CODE DETERMINES WHAT'S NEXT. ! C------------------------------------------------------------------------------C C BASED THE NUMBER OF FIRMS THAT HAVE BEEN IDENTIFIED AS IN INDUSTRY, C C DECIDE WHETHER TO GO TO THE 3- OR 2-DIGIT SIC CODE. ALSO, IF C C BASED ON THE 2-DIGIT SIC CODE THERE AREN'T SUFFICIENT FIRMS THEN WRITE C C NULLS TO THE OUTPUT FILE AND PROCEED TO THE NEXT INPUT FIRM. C C------------------------------------------------------------------------------C IF(INDCT(0) .LT. MINSIZE) THEN IF(INDDIGIT .EQ. 2) THEN INDFILLED(L) = 'N' ! INDUSTRY WAS NOT FILLED ! C WRITE(RATIOOUT,1042) INDCT(1), MINSIZE C WRITE(RATIOOUT,1041) GOTO 2000 ELSE REWIND(DATAIN) REWIND(RDATAIN) INDDIGIT = INDDIGIT + 1 GOTO 50 ENDIF ENDIF 1041 FORMAT('THIS INPUT FIRM WAS SKIPPED SINCE MINSIZE WAS NOT MET') 1042 FORMAT('ONLY ',I4,' FIRMS IN 2-DIGIT SIC...USER REQUIRES ', I5) C----------------------------------------------------------------------C C IF THE PROGRAM REACHES THIS SECTION BASED ON THE IFS ABOVE, THEN C C THE INDUSTRY DATA HAS BEEN LOADED INTO INDFRAC & A SUFFICIENT C C NUMBER OF FIRMS HAVE BEEN FOUND. NOW DO THE REST OF C C THE STUDY: WRITING OUT RATIOS FOR THE IN-SAMPLE FIRM, CLEANING C C DATA, CALCULATING THE MEANS AND MEDIANS, THEN WRITING IT ALL OUT C C----------------------------------------------------------------------C NINDUS = NINDUS + 1 C----------------------------------------------------------------------C C FIGURE OUT WHICH YEARS DATA NEEDS TO BE WRITTEN OUT FOR C C----------------------------------------------------------------------C CALL DETFYR(EVTYR(L),YEARA,BEGYR,ENDYR,BEGW,ENDW) CALL WRITINDCT(INDCT(0),INDDIGIT,RATIOOUT) CALL LOOP1100(RATIOS,YEARIN,MAXSIZE,RATIOOUT,INDCT,VALIDCT, . IPERM,BEGW,ENDW,INDFRAC,VALID,EVFIFRAC,NULL,MED,MEAN, . RATIONAM,FIRMNAME,RA,NFIRMS,LOGFILE,L) 2000 CONTINUE 2002 CONTINUE CALL WRITELOG(LOGFILE,MAXSIZE,MINSIZE,RATIOS,BEGYR,ENDYR,NFIRMS, . NREAD,NFOUND,NINDUS,EVTYR,DNUMIN,CNUMEV,FIRMFOUND,INDFILLED) STOP '...EXECUTION ENDS!' END C----------------------------------------------------------------------C C----------------------------------------------------------------------C C----------------------------------------------------------------------C C----------------------------------------------------------------------C C S U B R O U T I N E S BEGIN HERE C C----------------------------------------------------------------------C C----------------------------------------------------------------------C C----------------------------------------------------------------------C C----------------------------------------------------------------------C c----------------------------------------------------------------------c c DETERMINES WHICH DATA IS VALID AND RETURNS ONLY VALID DATA c C----------------------------------------------------------------------C SUBROUTINE CLEAN(RATIOS,YEARIN,MAXSIZE,ID,WC,V,VC,H) ! C----------------------------------------------------------------------C IMPLICIT NONE ! INTEGER RATIOS, YEARIN, MAXSIZE ! REAL ID(MAXSIZE,YEARIN,RATIOS), V(MAXSIZE,YEARIN,RATIOS) ! INTEGER WC(RATIOS), VC(YEARIN,RATIOS), H ! ! INTEGER I, J, K ! ! ! ! ! ! D PRINT*, 'CLEAN ENTERED' ! ! DO 20, I=1, YEARIN ! K=0 ! DO 10, J=1, MIN(MAXSIZE,WC(H)) ! IF((ID(J,I,H) .LT. -0.008) .OR. (ID(J,I,H) .GT. ! . -0.001)) THEN ! VC(I,H)=VC(I,H)+1 ! IF (VC(I,H) .GT. MAXSIZE) THEN ! IF MORE THAN MAXSIZE FIRMS ARE ! VC(I,H) = MAXSIZE ! FOUND IN THE INDUSTRY THEN ONLY ! ELSE ! MAXSIZE FIRMS ARE PROCESSED ! V(VC(I,H),I,H)=ID(J,I,H) ! ELSE PROCESS ALL THE FIRMS IN ! ENDIF ! THE INDUSTRY ! ENDIF ! 10 CONTINUE ! 20 CONTINUE ! D PRINT*, 'CLEAN EXITED' ! END ! SUBROUTINE CLEAN ! C----------------------------------------------------------------------C C CALCULATE THE MEAN FOR THE DATA THAT IS SENT HERE C C----------------------------------------------------------------------C SUBROUTINE MEAN_S(N,RA,M) ! C----------------------------------------------------------------------C IMPLICIT NONE ! ! INTEGER N ! REAL RA(N), M ! REAL SUM ! INTEGER I ! ! ! ! D PRINT*, 'ENTERING MEAN_S' ! SUM=0.0 ! ! DO 10 I=1,N ! SUM=SUM+RA(I) ! 10 CONTINUE ! M=SUM/N ! ! D PRINT*, 'LEAVING MEAN_S' ! END ! SUBROUTINE MEAN ! c----------------------------------------------------------------------c c CALCULATE THE MEDIAN FOR THE DATA THAT IS SENT HERE c C----------------------------------------------------------------------C SUBROUTINE MEDIAN_S(N,RA,MED) ! C----------------------------------------------------------------------C IMPLICIT NONE ! ! INTEGER N ! REAL RA(N), MED ! ! ! ! ! D PRINT*, 'ENTERED MEDIAN_S' ! IF( (N/2)*2 .EQ. N) THEN ! MED= (RA(N/2) + RA(N/2 +1) )/2 ! ELSE ! MED = RA(N/2 +1) ! ENDIF ! IF(N .EQ. 0) MED=-0.001 ! ! D PRINT*, 'LEAVING MEDIAN_S' ! END ! SUBROUTINE MEDIAN ! C--------BEGIN... OPERATING ROA -------------------------------------C SUBROUTINE OPERROA(DATA,CNUMIN,CNUM,INDCT,L, . YEARA,INFOUND,NFOUND,FIRMFOUND,TRACE,INDFRAC,EVFIFRAC, . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME,CNUMIND,CNUMEV, . INDDIGIT) C----------------------------------------------------------------------C IMPLICIT NONE CHARACTER CNUM*6, CNUMIN*6, CONAME*28 INTEGER INDCT, L, YEARA(20), NFOUND, TRACE INTEGER NFIRMS, YEARIN, RATIOS, MAXSIZE, INDDIGIT CHARACTER*1 FIRMFOUND(NFIRMS) CHARACTER*6 CNUMIND(MAXSIZE), CNUMEV(NFIRMS) LOGICAL INFOUND REAL DATA(350,20) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) INTEGER J, K D PRINT *, 'OPERROA ENTERED' IF(CNUMIN .NE. CNUM) THEN ! IF FIRM ISN'T IN-SAMPLE ! INDCT=INDCT+1 ! THEN INCREMENT NUMBER FIRMS! WRITE(TRACE,2) CNUM 2 FORMAT('IN OPERROA THIS IS IN THE INDUSTRY: ',A6) IF(INDCT .GT. MAXSIZE) THEN ! HOWEVER, IF THE INDUSTRY ! RETURN ! SAMPLE EXCEEDS THE MAXSIZE ! ENDIF ! OF INDFRAC ARRAY....RETURN ! CNUMIND(INDCT) = CNUM K=0 DO 122, J=1, 20 K=K+1 IF((DATA(13,J) .LT. -0.008) .OR. (DATA(13,J) . .GT. -0.001)) THEN IF(DATA(6,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(13,J), DATA(6,J), DATA(13,J)/DATA(6,J) INDFRAC(INDCT,K,1) = DATA(13,J) / DATA(6,J) ELSE INDFRAC(INDCT,K,1)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,1)= -0.001 ENDIF 122 CONTINUE 124 FORMAT('OPERROA:',A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT(A10,1X,I5,5(F12.4,1X)) 126 FORMAT('OPERROA:',2(F12.4,1X)) ELSE ! IF (CNUMIN .NE. CNUM) THEN ! ! THIS IS THE IN-SAMPLE FIRM ! INFOUND = .TRUE. ! THE IN-SAMPLE FIRM WAS FOUND ! CNUMEV(L) = CNUM c PRINT*, 'INDDIGIT=', INDDIGIT IF (FIRMFOUND(L) .EQ. 'N') THEN ! INCREMENT NFOUND ! NFOUND = NFOUND + 1 ! ONLY IF THE FIRM HASN'T ! ENDIF ! BEEN 'FOUND' YET ! FIRMFOUND(L) = 'Y' K=0 DO 136, J=1, 20 K=K+1 C WRITE(TRACE,126) DATA(13,J), DATA(6,J) IF((DATA(13,J) .LT. -0.008) .OR. (DATA(13,J) . .GT. -0.001)) THEN IF(DATA(6,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(13,J), DATA(6,J), DATA(13,J)/DATA(6,J) EVFIFRAC(L,K,1) = DATA(13,J) / DATA(6,J) ELSE EVFIFRAC(L,K,1)= -0.001 ENDIF ELSE EVFIFRAC(L,K,1)= -0.001 ENDIF 136 CONTINUE ENDIF ! IF (CNUMIN .NE. CNUM) THEN ! D PRINT *, 'OPERROA EXITED' END ! SUBROUTINE OPERROA ! C--------END...OPERATING ROA.------------------------------------------------C c----------------------------------------------------------------------c c CALCULATES THE CURRENT ASSETS/CURRENT LIABILITIES RATIO c C----------------------------------------------------------------------C SUBROUTINE CURRENT(DATA,CNUMIN,CNUM,INDCT,L, ! . YEARA,TRACE,NRAT,INDFRAC,EVFIFRAC, ! . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) ! C----------------------------------------------------------------------C IMPLICIT NONE CHARACTER CNUM*6, CNUMIN*6, CONAME*28 INTEGER INDCT, L, YEARA(20), TRACE INTEGER NRAT, NFIRMS, YEARIN, RATIOS, MAXSIZE REAL DATA(350,20) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) INTEGER J, K D PRINT *, 'CURRENT ENTERED' 124 FORMAT('CURRENT:',A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT('CURRENT:',A10,1X,I5,5(F12.4,1X)) IF(CNUMIN .NE. CNUM) THEN ! IF FIRM ISN'T IN-SAMPLE ! INDCT=INDCT+1 ! THEN INCREMENT NUMBER FIRMS! IF(INDCT .GT. MAXSIZE) THEN ! HOWEVER, IF THE INDUSTRY ! RETURN ! SAMPLE EXCEEDS THE MAXSIZE ! ENDIF ! OF INDFRAC ARRAY....RETURN ! K=0 DO 137, J=1,20 K=K+1 IF ((DATA(4,J) .LT. -0.008) .OR. (DATA(4,J) . .GT. -0.001)) THEN IF ((DATA(5,J) .LT. -0.008) .OR. (DATA(5,J) . .GT. -0.001)) THEN IF (DATA(5,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(4,J), DATA(5,J), DATA(4,J)/DATA(5,J) INDFRAC(INDCT,K,NRAT) = DATA(4,J) / DATA(5,J) ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF 137 CONTINUE ELSE ! IF (CNUMIN .NE. CNUM) THEN ! ! THIS IS THE IN-SAMPLE FIRM ! K=0 DO 138, J=1,20 K=K+1 IF((DATA(4,J) .LT. -0.008) .OR. (DATA(4,J) . .GT. -0.001)) THEN IF ((DATA(5,J) .LT. -0.008) .OR. (DATA(5,J) . .GT. -0.001)) THEN IF(DATA(5,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(4,J), DATA(5,J), DATA(4,J)/DATA(5,J) EVFIFRAC(L,K,NRAT) = DATA(4,J) / DATA(5,J) ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF 138 CONTINUE ENDIF D PRINT *, 'CURRENT EXITED' END C--------END: CURRENT RATIO -----------------------------------------------C c----------------------------------------------------------------------c C CALCULATES (CURRENT ASSETS - INVENTORIES)/CURRENT LIABILITIES c C----------------------------------------------------------------------C SUBROUTINE QUICK(DATA,CNUMIN,CNUM,INDCT,L, ! . YEARA,TRACE,NRAT,INDFRAC,EVFIFRAC, ! . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) ! C----------------------------------------------------------------------C IMPLICIT NONE CHARACTER CNUM*6, CNUMIN*6, CONAME*28 INTEGER INDCT, L, YEARA(20), TRACE INTEGER NRAT, NFIRMS, YEARIN, RATIOS, MAXSIZE REAL DATA(350,20) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) INTEGER J, K D PRINT *, 'QUICK ENTERED' 124 FORMAT('QUICK:',A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT('QUICK:',A10,1X,I5,5(F12.4,1X)) IF(CNUMIN .NE. CNUM) THEN ! IF FIRM ISN'T IN-SAMPLE ! INDCT=INDCT+1 ! THEN INCREMENT NUMBER FIRMS! IF(INDCT .GT. MAXSIZE) THEN ! HOWEVER, IF THE INDUSTRY ! RETURN ! SAMPLE EXCEEDS THE MAXSIZE ! ENDIF ! OF INDFRAC ARRAY....RETURN ! K=0 DO 137, J=1,20 K=K+1 IF ((DATA(4,J) .LT. -0.008) .OR. (DATA(4,J) . .GT. -0.001)) THEN IF ((DATA(3,J) .LT. -0.008) .OR. (DATA(3,J) . .GT. -0.001)) THEN IF ((DATA(5,J) .LT. -0.008) .OR. (DATA(5,J) . .GT. -0.001)) THEN IF (DATA(5,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J),DATA(4,J), DATA C . (3,J), DATA(5,J), (DATA(4,J)-DATA(3,J))/DATA(5,J) INDFRAC(INDCT,K,NRAT) = (DATA(4,J)-DATA(3,J)) . / DATA(5,J) ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF 137 CONTINUE ELSE ! IF (CNUMIN .NE. CNUM) THEN ! ! THIS IS THE IN-SAMPLE FIRM ! K=0 DO 138, J=1,20 K=K+1 IF ((DATA(4,J) .LT. -0.008) .OR. (DATA(4,J) . .GT. -0.001)) THEN IF ((DATA(3,J) .LT. -0.008) .OR. (DATA(3,J) . .GT. -0.001)) THEN IF ((DATA(5,J) .LT. -0.008) .OR. (DATA(5,J) . .GT. -0.001)) THEN IF (DATA(5,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J),DATA(4,J), DATA C . (3,J), DATA(5,J), (DATA(4,J)-DATA(3,J))/DATA(5,J) EVFIFRAC(L,K,NRAT) = (DATA(4,J)-DATA(3,J)) . / DATA(5,J) ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF 138 CONTINUE ENDIF D PRINT *, 'QUICK EXITED' END C--------END: QUICK RATIO -----------------------------------------------C c----------------------------------------------------------------------c C CALCULATES NET PROFIT MARGIN c C----------------------------------------------------------------------C SUBROUTINE NPM(DATA,CNUMIN,CNUM,INDCT,L, ! . YEARA,TRACE,NRAT,INDFRAC,EVFIFRAC, ! . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) ! C----------------------------------------------------------------------C IMPLICIT NONE CHARACTER CNUM*6, CNUMIN*6, CONAME*28 INTEGER INDCT, L, YEARA(20), TRACE INTEGER NRAT, NFIRMS, YEARIN, RATIOS, MAXSIZE REAL DATA(350,20) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) INTEGER J, K D PRINT *, ' NPM ENTERED' 124 FORMAT(' NPM:',A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT(' NPM:',A10,1X,I5,5(F12.4,1X)) IF(CNUMIN .NE. CNUM) THEN ! IF FIRM ISN'T IN-SAMPLE ! INDCT=INDCT+1 ! THEN INCREMENT NUMBER FIRMS! IF(INDCT .GT. MAXSIZE) THEN ! HOWEVER, IF THE INDUSTRY ! RETURN ! SAMPLE EXCEEDS THE MAXSIZE ! ENDIF ! OF INDFRAC ARRAY....RETURN ! K=0 DO 137, J=1,20 K=K+1 IF ((DATA(18,J) .LT. -0.008) .OR. (DATA(18,J) . .GT. -0.001)) THEN IF ((DATA(12,J) .LT. -0.008) .OR. (DATA(12,J) . .GT. -0.001)) THEN IF (DATA(12,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(18,J), DATA(12,J), DATA(18,J)/DATA(12,J) INDFRAC(INDCT,K,NRAT) = DATA(18,J) / DATA(12,J) ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF 137 CONTINUE ELSE ! IF (CNUMIN .NE. CNUM) THEN ! ! THIS IS THE IN-SAMPLE FIRM ! K=0 DO 138, J=1,20 K=K+1 IF((DATA(18,J) .LT. -0.008) .OR. (DATA(18,J) . .GT. -0.001)) THEN IF ((DATA(12,J) .LT. -0.008) .OR. (DATA(12,J) . .GT. -0.001)) THEN IF(DATA(12,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(18,J), DATA(12,J), DATA(18,J)/DATA(12,J) EVFIFRAC(L,K,NRAT) = DATA(18,J) / DATA(12,J) ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF 138 CONTINUE ENDIF D PRINT *, ' NPM EXITED' END C--------END: NPM RATIO -------------------------------------------------C c----------------------------------------------------------------------c c CALCULATES RETURN ON EQUITY c C----------------------------------------------------------------------C SUBROUTINE ROE (DATA,CNUMIN,CNUM,INDCT,L, ! . YEARA,TRACE,NRAT,INDFRAC,EVFIFRAC, ! . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) ! C----------------------------------------------------------------------C IMPLICIT NONE CHARACTER CNUM*6, CNUMIN*6, CONAME*28 INTEGER INDCT, L, YEARA(20), TRACE INTEGER NRAT, NFIRMS, YEARIN, RATIOS, MAXSIZE REAL DATA(350,20) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) INTEGER J, K D PRINT *, 'ROE ENTERED' 124 FORMAT('ROE :',A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT('ROE :',A10,1X,I5,5(F12.4,1X)) IF(CNUMIN .NE. CNUM) THEN ! IF FIRM ISN'T IN-SAMPLE ! INDCT=INDCT+1 ! THEN INCREMENT NUMBER FIRMS! IF(INDCT .GT. MAXSIZE) THEN ! HOWEVER, IF THE INDUSTRY ! RETURN ! SAMPLE EXCEEDS THE MAXSIZE ! ENDIF ! OF INDFRAC ARRAY....RETURN ! K=0 DO 137, J=1,20 K=K+1 IF ((DATA(237,J) .LT. -0.008) .OR. (DATA(237,J) . .GT. -0.001)) THEN IF ((DATA(60,J) .LT. -0.008) .OR. (DATA(60,J) . .GT. -0.001)) THEN IF (DATA(60,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(237,J), DATA(60,J), DATA(237,J)/DATA(60,J) INDFRAC(INDCT,K,NRAT) = DATA(237,J) / DATA(60,J) ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF 137 CONTINUE ELSE ! IF (CNUMIN .NE. CNUM) THEN ! ! THIS IS THE IN-SAMPLE FIRM ! K=0 DO 138, J=1,20 K=K+1 IF((DATA(237,J) .LT. -0.008) .OR. (DATA(237,J) . .GT. -0.001)) THEN IF ((DATA(60,J) .LT. -0.008) .OR. (DATA(60,J) . .GT. -0.001)) THEN IF(DATA(60,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(237,J), DATA(60,J), DATA(237,J)/DATA(60,J) EVFIFRAC(L,K,NRAT) = DATA(237,J) / DATA(60,J) ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF 138 CONTINUE ENDIF D PRINT *, 'ROE EXITED' END C--------END: ROE RATIO -----------------------------------------------C c----------------------------------------------------------------------c c CALCULATES TOTAL ASSET TURNOVER c C----------------------------------------------------------------------C SUBROUTINE TATURN(DATA,CNUMIN,CNUM,INDCT,L, ! . YEARA,TRACE,NRAT,INDFRAC,EVFIFRAC, ! . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) ! C----------------------------------------------------------------------C IMPLICIT NONE CHARACTER CNUM*6, CNUMIN*6, CONAME*28 INTEGER INDCT, L, YEARA(20), TRACE INTEGER NRAT, NFIRMS, YEARIN, RATIOS, MAXSIZE REAL DATA(350,20) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) INTEGER J, K D PRINT *, 'TATURN ENTERED' 124 FORMAT('TATURN:',A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT('TATURN:',A10,1X,I5,5(F12.4,1X)) IF(CNUMIN .NE. CNUM) THEN ! IF FIRM ISN'T IN-SAMPLE ! INDCT=INDCT+1 ! THEN INCREMENT NUMBER FIRMS! IF(INDCT .GT. MAXSIZE) THEN ! HOWEVER, IF THE INDUSTRY ! RETURN ! SAMPLE EXCEEDS THE MAXSIZE ! ENDIF ! OF INDFRAC ARRAY....RETURN ! K=0 DO 137, J=1,20 K=K+1 IF ((DATA(12,J) .LT. -0.008) .OR. (DATA(12,J) . .GT. -0.001)) THEN IF ((DATA(6,J) .LT. -0.008) .OR. (DATA(6,J) . .GT. -0.001)) THEN IF (DATA(6,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(12,J), DATA(6,J), DATA(12,J)/DATA(6,J) INDFRAC(INDCT,K,NRAT) = DATA(12,J) / DATA(6,J) ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF 137 CONTINUE ELSE ! IF (CNUMIN .NE. CNUM) THEN ! ! THIS IS THE IN-SAMPLE FIRM ! K=0 DO 138, J=1,20 K=K+1 IF((DATA(12,J) .LT. -0.008) .OR. (DATA(12,J) . .GT. -0.001)) THEN IF ((DATA(6,J) .LT. -0.008) .OR. (DATA(6,J) . .GT. -0.001)) THEN IF(DATA(6,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(12,J), DATA(6,J), DATA(12,J)/DATA(6,J) EVFIFRAC(L,K,NRAT) = DATA(12,J) / DATA(6,J) ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF 138 CONTINUE ENDIF D PRINT *, 'TATURN EXITED' END C--------END: TATURN RATIO -------------------------------------------C c----------------------------------------------------------------------c c CALCULATES INVENTORY TURNOVER c C----------------------------------------------------------------------C SUBROUTINE INVTURN(DATA,CNUMIN,CNUM,INDCT,L, ! . YEARA,TRACE,NRAT,INDFRAC,EVFIFRAC, ! . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) ! C----------------------------------------------------------------------C IMPLICIT NONE CHARACTER CNUM*6, CNUMIN*6, CONAME*28 INTEGER INDCT, L, YEARA(20), TRACE INTEGER NRAT, NFIRMS, YEARIN, RATIOS, MAXSIZE REAL DATA(350,20) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) INTEGER J, K D PRINT *, 'INVTURN ENTERED' 124 FORMAT('INVTURN:',A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT('INVTURN:',A10,1X,I5,5(F12.4,1X)) IF(CNUMIN .NE. CNUM) THEN ! IF FIRM ISN'T IN-SAMPLE ! INDCT=INDCT+1 ! THEN INCREMENT NUMBER FIRMS! IF(INDCT .GT. MAXSIZE) THEN ! HOWEVER, IF THE INDUSTRY ! RETURN ! SAMPLE EXCEEDS THE MAXSIZE ! ENDIF ! OF INDFRAC ARRAY....RETURN ! K=0 DO 137, J=1,20 K=K+1 IF ((DATA(12,J) .LT. -0.008) .OR. (DATA(12,J) . .GT. -0.001)) THEN IF ((DATA(3,J) .LT. -0.008) .OR. (DATA(3,J) . .GT. -0.001)) THEN IF (DATA(3,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(12,J), DATA(3,J), DATA(12,J)/DATA(3,J) INDFRAC(INDCT,K,NRAT) = DATA(12,J) / DATA(3,J) ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF 137 CONTINUE ELSE ! IF (CNUMIN .NE. CNUM) THEN ! ! THIS IS THE IN-SAMPLE FIRM ! K=0 DO 138, J=1,20 K=K+1 IF((DATA(12,J) .LT. -0.008) .OR. (DATA(12,J) . .GT. -0.001)) THEN IF ((DATA(3,J) .LT. -0.008) .OR. (DATA(3,J) . .GT. -0.001)) THEN IF(DATA(3,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(12,J), DATA(3,J), DATA(12,J)/DATA(3,J) EVFIFRAC(L,K,NRAT) = DATA(12,J) / DATA(3,J) ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF 138 CONTINUE ENDIF D PRINT *, 'INVTURN EXITED' END C--------END: INVTURN RATIO ------------------------------------------C c----------------------------------------------------------------------c c CALCULATES TIMES INTEREST EARNED RATIO c C----------------------------------------------------------------------C SUBROUTINE TIMESINT(DATA,CNUMIN,CNUM,INDCT,L, ! . YEARA,TRACE,NRAT,INDFRAC,EVFIFRAC, ! . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) ! C----------------------------------------------------------------------C IMPLICIT NONE CHARACTER CNUM*6, CNUMIN*6, CONAME*28 INTEGER INDCT, L, YEARA(20), TRACE INTEGER NRAT, NFIRMS, YEARIN, RATIOS, MAXSIZE REAL DATA(350,20) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) INTEGER J, K D PRINT *, 'TIMESINT ENTERED' 124 FORMAT('TIMESINT:',A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT('TIMESINT:',A10,1X,I5,5(F12.4,1X)) IF(CNUMIN .NE. CNUM) THEN ! IF FIRM ISN'T IN-SAMPLE ! INDCT=INDCT+1 ! THEN INCREMENT NUMBER FIRMS! IF(INDCT .GT. MAXSIZE) THEN ! HOWEVER, IF THE INDUSTRY ! RETURN ! SAMPLE EXCEEDS THE MAXSIZE ! ENDIF ! OF INDFRAC ARRAY....RETURN ! K=0 DO 137, J=1,20 K=K+1 IF ((DATA(13,J) .LT. -0.008) .OR. (DATA(13,J) . .GT. -0.001)) THEN IF ((DATA(15,J) .LT. -0.008) .OR. (DATA(15,J) . .GT. -0.001)) THEN IF (DATA(15,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(13,J), DATA(15,J), DATA(13,J)/DATA(15,J) INDFRAC(INDCT,K,NRAT) = DATA(13,J) / DATA(15,J) ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF 137 CONTINUE ELSE ! IF (CNUMIN .NE. CNUM) THEN ! ! THIS IS THE IN-SAMPLE FIRM ! K=0 DO 138, J=1,20 K=K+1 IF((DATA(13,J) .LT. -0.008) .OR. (DATA(13,J) . .GT. -0.001)) THEN IF ((DATA(15,J) .LT. -0.008) .OR. (DATA(15,J) . .GT. -0.001)) THEN IF(DATA(15,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(13,J), DATA(15,J), DATA(13,J)/DATA(15,J) EVFIFRAC(L,K,NRAT) = DATA(13,J) / DATA(15,J) ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF 138 CONTINUE ENDIF D PRINT *, 'TIMESINT EXITED' END C--------END: TIMESINT RATIO -----------------------------------------C c----------------------------------------------------------------------c c CALCULATES LONG-TERM DEBT/TOTAL ASSETS c C----------------------------------------------------------------------C SUBROUTINE DEBTRAT(DATA,CNUMIN,CNUM,INDCT,L, ! . YEARA,TRACE,NRAT,INDFRAC,EVFIFRAC, ! . NFIRMS,YEARIN,RATIOS,MAXSIZE,CONAME) ! C----------------------------------------------------------------------C IMPLICIT NONE CHARACTER CNUM*6, CNUMIN*6, CONAME*28 INTEGER INDCT, L, YEARA(20), TRACE INTEGER NRAT, NFIRMS, YEARIN, RATIOS, MAXSIZE REAL DATA(350,20) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) INTEGER J, K D PRINT *, 'DEBTRAT ENTERED' 124 FORMAT('DEBTRAT:',A15,1X,I5,F12.4,1X,F12.4,1X,F12.4) 125 FORMAT('DEBTRAT:',A10,1X,I5,5(F12.4,1X)) IF(CNUMIN .NE. CNUM) THEN ! IF FIRM ISN'T IN-SAMPLE ! INDCT=INDCT+1 ! THEN INCREMENT NUMBER FIRMS! IF(INDCT .GT. MAXSIZE) THEN ! HOWEVER, IF THE INDUSTRY ! RETURN ! SAMPLE EXCEEDS THE MAXSIZE ! ENDIF ! OF INDFRAC ARRAY....RETURN ! K=0 DO 137, J=1,20 K=K+1 IF ((DATA(9,J) .LT. -0.008) .OR. (DATA(9,J) . .GT. -0.001)) THEN IF ((DATA(6,J) .LT. -0.008) .OR. (DATA(6,J) . .GT. -0.001)) THEN IF (DATA(6,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(9,J), DATA(6,J), DATA(9,J)/DATA(6,J) INDFRAC(INDCT,K,NRAT) = DATA(9,J) / DATA(6,J) ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF ELSE INDFRAC(INDCT,K,NRAT)= -0.001 ENDIF 137 CONTINUE ELSE ! IF (CNUMIN .NE. CNUM) THEN ! ! THIS IS THE IN-SAMPLE FIRM ! K=0 DO 138, J=1,20 K=K+1 IF((DATA(9,J) .LT. -0.008) .OR. (DATA(9,J) . .GT. -0.001)) THEN IF ((DATA(6,J) .LT. -0.008) .OR. (DATA(6,J) . .GT. -0.001)) THEN IF(DATA(6,J) .NE. 0.0) THEN C WRITE(TRACE,124) CONAME, YEARA(J), C . DATA(9,J), DATA(6,J), DATA(9,J)/DATA(6,J) EVFIFRAC(L,K,NRAT) = DATA(9,J) / DATA(6,J) ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF ELSE EVFIFRAC(L,K,NRAT)= -0.001 ENDIF 138 CONTINUE ENDIF D PRINT *, 'DEBTRAT EXITED' END C--------END: DEBTRAT RATIO ------------------------------------------C C----------------------------------------------------------------------C C THIS IS THE SUBROUTINE THAT WRITES OUT THE RATIOS TO A FILE C SUBROUTINE WRITERAT(RATIOOUT,RATIONAM,FIRMNAME,EVFIFRAC, ! . BEGW,ENDW ,MED,MEAN,VALIDCT,NFIRMS,YEARIN,RATIOS, ! . L,H,LOGFILE) ! C----------------------------------------------------------------------C IMPLICIT NONE INTEGER RATIOOUT,BEGW,ENDW,NFIRMS,YEARIN,RATIOS,LOGFILE INTEGER VALIDCT(YEARIN,RATIOS), L, H REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) REAL MED(YEARIN,RATIOS), MEAN(YEARIN,RATIOS) CHARACTER RATIONAM*30, FIRMNAME*80 INTEGER I D PRINT*, 'WRITRAT ENTERED' C WRITE(LOGFILE,*) 'WRITRAT ENTERED' D PRINT *, 'WRITING RATIO NAME' WRITE(RATIOOUT,*) ! BEGIN BY WRITING OUT THE ! WRITE(RATIOOUT,4992) RATIONAM ! NAMES OF THE RATIOS ! 4992 FORMAT(A30) ! ! D PRINT*, 'WRITING FIRM RATIOS' WRITE(RATIOOUT,5002) FIRMNAME, (EVFIFRAC(L,I,H), . I= BEGW, ENDW) 5000 FORMAT('RATIOS FOR THE IN-SAMPLE FIRM:') 5002 FORMAT(A10,',',20(F12.4,',')) D PRINT*, 'WRITING MEDIANS' WRITE(RATIOOUT,1082) 1082 FORMAT('MEDIANS,',$) WRITE(RATIOOUT,1090) (MED(I,H), . I= BEGW, ENDW) 1090 FORMAT(6(F12.4,',')) D PRINT*, 'WRITING MEANS' C WRITE(RATIOOUT,1092) C1092 FORMAT('MEANS,',$) C WRITE(RATIOOUT,1090) (MEAN(I,H), C . I= BEGW, ENDW) D PRINT*, 'WRITING NUMBER OF FIRMS' WRITE(RATIOOUT,1081) 1081 FORMAT('NUMBER OF FIRMS,',$) WRITE(RATIOOUT,1085) (VALIDCT(I,H), . I=BEGW, ENDW) 1085 FORMAT(7(I5,',')) D PRINT*, 'WRITRAT EXITED' C WRITE(LOGFILE,*) 'WRITRAT EXITED' END !-----------------SUBROUTINE WRITERAT---------------------! C----------------------------------------------------------------------C C DETERMINES WHICH YEARS THE DATA ARE WRITTEN FOR. C SUBROUTINE DETFYR(EVTYR,YEARA,BEGYR,ENDYR,BEGW,ENDW) ! C----------------------------------------------------------------------C IMPLICIT NONE ! ! INTEGER EVTYR, YEARA(20), BEGYR, ENDYR, BEGW, ENDW ! ! INTEGER I ! ! ! ! ! ! D PRINT*, 'DETFYR ENTERED' ! ! ! ! BEGW = EVTYR + BEGYR ! ENDING ARE IN TERMS ! ENDW = EVTYR + ENDYR ! OF YEARS ! ! ! IF (BEGW .LT. YEARA(1)) THEN ! IF THE BEGINNING AND ! BEGW = YEARA(1) ! ENDING ARE OUT OF THE ! ENDIF ! BOUNDS OF THE EXISTING ! ! DATA, THEN SET THEM TO ! IF(ENDW .GT. YEARA(20)) THEN ! THE BOUNDS OF THE ! ENDW = YEARA(20) ! EXISTING DATA ! ENDIF ! ! ! ! DO I=1,20 ! NOW SET BEGW AND ENDW ! IF(BEGW .EQ. YEARA(I)) THEN ! IN TERMS OF THE INDEX ! BEGW = I ! I, I IN [1,20] ! ENDIF ! ! IF(ENDW .EQ. YEARA(I)) THEN ! ! ENDW = I ! ! ENDIF ! ! ENDDO ! ! ! ! ! ! D PRINT*, 'DETFYR EXITED' ! END !--------------------SUBROUTINE DETFYR---------------------! C----------------------------------------------------------------------C C THIS SUBROUTINE PULLS THIS FIRM'S DATA OUT OF THE INDFRAC ARRAY C C AND PUTS IT INTO A TEMPORARY ARRAY, THEN PUSHES THE LAST FIRM'S C C DATA INTO THE HOLE CREATED IN INDFRAC, THEN MOVES THE DATA FROM C C THE TEMPORARY ARRAY INTO EVFIFRAC. C SUBROUTINE PULLPUSH(INDCT,INDFRAC,EVFIFRAC,L,NFIRMS,YEARIN, ! . RATIOS,MAXSIZE,CNUMLAST,CNUMNEW,DNUMLAST, ! . DNUMNEW,CNUMEV,CNUMIND,INFOUND,NFOUND, ! . FIRMFOUND,TRACE) ! C----------------------------------------------------------------------C IMPLICIT NONE ! ! INTEGER L, NFIRMS, YEARIN, RATIOS, MAXSIZE, NFOUND ! INTEGER DNUMLAST, DNUMNEW, TRACE ! INTEGER INDCT(0:RATIOS) ! REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) ! REAL INDFRAC(MAXSIZE,YEARIN,RATIOS) ! CHARACTER*6 CNUMLAST, CNUMNEW ! CHARACTER*6 CNUMIND(MAXSIZE) ! CHARACTER*6 CNUMEV(NFIRMS) ! CHARACTER*1 FIRMFOUND(NFIRMS) ! LOGICAL INFOUND ! ! REAL TEMPFRAC(20,30) ! INTEGER I,J,K ! INTEGER IPULL, IPUSH ! ! ! ! ! ! ! ! D PRINT*, 'PULLPUSH ENTERED' ! ! IF((YEARIN .GT. 20) .OR. (RATIOS .GT. 30)) THEN ! PRINT*, 'SIZE OF TEMPFRAC IN PULLPUSH TOO SMALL' ! PRINT*, 'INCREASE SIZE OF TEMPFRAC IN PULLPUSH' ! STOP ! ENDIF ! ! ! IPULL=0 ! IPUSH=0 ! ! ! D PRINT*, 'PULLPUSH: CNUM OF THIS FIRM ', CNUMNEW ! ! ! C BEGIN BY IDENTIFYING WHAT DATA IN INDFRAC NEEDS TO BE PULLED OUT ! DO I=1, INDCT(0) ! IF(CNUMNEW .EQ. CNUMIND(I)) THEN ! D PRINT*,'PULL: ',CNUMNEW,' ', CNUMIND(I), I ! IPULL=I ! ENDIF ! ENDDO ! C NOW PULL THE DATA OUT FOR THIS FIRM FROM INDFRAC INTO TEMPFRAC ! IF(IPULL .EQ. 0) THEN ! D PRINT*, 'PUSHPULL: THIS FIRM NOT FOUND IN INDFRAC:',CNUMNEW ! INFOUND = .FALSE. ! RETURN ! ELSE ! INFOUND = .TRUE. ! FIRMFOUND(L) = 'Y' NFOUND = NFOUND + 1 ! DO J=1,20 ! DO K=1,MIN(RATIOS,30) ! TEMPFRAC(J,K)=INDFRAC(IPULL,J,K) ! C WRITE(TRACE,12) IPULL, J, K, INDFRAC(IPULL,J,K) ! ENDDO ! ENDDO ! ENDIF ! ! 12 FORMAT('PULL:', 3(I4,1X,),F10.6) ! ! ! ! ! ! ! C NOW IDENTIFY THE DATA IN EVFIFRAC THAT NEEDS TO BE PUSHED IN INDFRAC ! DO I=L, 1, -1 ! IF(CNUMLAST .EQ. CNUMEV(I)) THEN ! D PRINT*,'PUSH: ',CNUMLAST,' ', CNUMEV(I), I ! IPUSH=I ! ENDIF ! ENDDO ! C NOW PUSH THE DATA OUT FOR THIS FIRM FROM INDFRAC INTO TEMPFRAC ! IF(IPUSH .EQ. 0) THEN ! C PRINT*, 'PUSHPULL: THIS FIRM NOT FOUND IN INDFRAC:',CNUMLAST ! RETURN ! ELSE ! DO J=1,20 ! DO K=1,MIN(RATIOS,30) ! INDFRAC(IPULL,J,K)=EVFIFRAC(IPUSH,J,K) ! ENDDO ! ENDDO ! ENDIF ! ! ! ! ! C NOW MOVE THE TEMPFRAC DATA TO EVFIFRAC ! DO J=1,20 ! DO K=1,MIN(RATIOS,30) ! EVFIFRAC(L,J,K) = TEMPFRAC(J,K) ! ENDDO ! ENDDO ! ! ! D PRINT*, 'PULLPUSH EXITED' ! END ! SUBROUTINE PULLPUSH ! C----------------------------------------------------------------------C C DETERMINES WHETHER THE NEW FIRM HAS ANY CHARACTERISTICS IN C C COMMON WITH THE FIRM JUST PROCESSED C SUBROUTINE SETSAME(L,CNUMEV,DNUMIN,EVTYR,SAMECNUM, ! . SAMEDNUM,SAMEEVYR,NFIRMS) ! C----------------------------------------------------------------------C IMPLICIT NONE INTEGER L, NFIRMS INTEGER EVTYR(NFIRMS), DNUMIN(NFIRMS) CHARACTER*6 CNUMEV(NFIRMS) LOGICAL SAMECNUM, SAMEDNUM, SAMEEVYR D PRINT*, 'SETSAME ENTERED' IF(CNUMEV(L) .EQ. CNUMEV(L-1)) THEN SAMECNUM = .TRUE. ELSE SAMECNUM = .FALSE. ENDIF IF(DNUMIN(L) .EQ. DNUMIN(L-1)) THEN SAMEDNUM = .TRUE. ELSE SAMEDNUM = .FALSE. ENDIF IF(EVTYR(L) .EQ. EVTYR(L-1)) THEN SAMEEVYR = .TRUE. ELSE SAMEEVYR = .FALSE. ENDIF D PRINT*, 'SETSAME EXITED' END ! SUBROUTINE SETSAME ! C----------------------------------------------------------------------C C LOOP 1100 CLEANS THE DATA, RETURNS THE VALID COUNTS, THEN SORTS C C THE DATA, CALCULATES THE MEDIANS AND THE MEANS AND WRITES OUT C C THE RATIOS TO A FILE. C SUBROUTINE LOOP1100(RATIOS,YEARIN,MAXSIZE,RATIOOUT,INDCT,VALIDCT,! .IPERM,BEGW,ENDW,INDFRAC,VALID,EVFIFRAC,NULL,MED,MEAN, ! .RATIONAM,FIRMNAME,RA,NFIRMS,TRACE,L) ! C C C C C----------------------------------------------------------------------C IMPLICIT NONE INTEGER RATIOS, YEARIN, MAXSIZE, RATIOOUT, NFIRMS INTEGER INDCT(0:RATIOS), VALIDCT(YEARIN,RATIOS) INTEGER IPERM(MAXSIZE), BEGW, ENDW INTEGER TRACE, L REAL INDFRAC(MAXSIZE,YEARIN,RATIOS), VALID(MAXSIZE,YEARIN,RATIOS) REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS), NULL REAL MED(YEARIN,RATIOS), MEAN(YEARIN,RATIOS) REAL RA(MAXSIZE) CHARACTER*30 RATIONAM(RATIOS) CHARACTER FIRMNAME*80 INTEGER H, I, J1 D PRINT*, 'LOOP1100 ENTERED' DO 1100, H=1,RATIOS IF(INDCT(H) .NE. 0) THEN C PRINT*, 'GOING TO CLEANERS' CALL CLEAN(RATIOS,YEARIN,MAXSIZE,INDFRAC,INDCT,VALID,VALIDCT,H) C PRINT *, 'RETURNED SUCCESSFULLY FROM CLEANING' DO 1080, I=1,YEARIN C PRINT *, '1080 I=', I DO 1050, J1=1, VALIDCT(I,H) C PRINT *, '1050 J1=', J1 RA(J1)=VALID(J1,I,H) 1050 CONTINUE C PRINT*, 'DONE 1050...NOW GOING TO SVRGP, MEAN_S,...' IF(VALIDCT(I,H) .NE. 0) THEN ! THE MEANS AND MEDIANS ! C PRINT*, 'VALIDCT IF STATEMENT EVALUATED' CALL SVRGP(VALIDCT(I,H),RA,RA,IPERM) ! ARE CALCULATED HERE.. ! C PRINT*, 'RETURNED FROM SVRGP' CALL MEDIAN_S(VALIDCT(I,H), RA, MED(I,H)) ! .THIS IS THE HEART OF ! C PRINT*, 'RETURNED FROM MEDIAN_S' CALL MEAN_S(VALIDCT(I,H), RA, MEAN(I,H)) ! THIS PROGRAM. ! C PRINT*, 'RETURNED FROM SVRGP, MEDIAN_S, AND MEAN_S' ELSE MED(I,H)=-0.001 MEAN(I,H)=-0.001 ENDIF C DO JLOOP=1, VALIDCT(I,H) C WRITE(TRACE,1052) RA(JLOOP) C ENDDO 1052 FORMAT(F10.4) C WRITE(TRACE,*) 1080 CONTINUE C----------------------------------------------------------------------C C WRITE OUT THE INFORMATION THAT'S IN THE ARRAYS C C----------------------------------------------------------------------C CALL WRITERAT(RATIOOUT,RATIONAM(H),FIRMNAME,EVFIFRAC, . BEGW,ENDW,MED,MEAN,VALIDCT,NFIRMS,YEARIN,RATIOS, . L,H,TRACE) ELSE C WRITE(21,*) 'MEDIAN' WRITE(RATIOOUT,1090) (NULL,I=BEGW, ENDW) ENDIF 1100 CONTINUE 1090 FORMAT(6(F12.4,',')) D PRINT*, 'LOOP1100 EXITED' END !--------SUBROUTINE LOOP1100---------------------------------! C----------------------------------------------------------------------C C RESET THE COUNT OF FIRMS IN THE INDUSTRY FOR ALL THE RATIOS AS C C WELL AS THE OVERALL COUNT INDCT(0). C SUBROUTINE RESETINDCT(RATIOS,INDCT) ! C----------------------------------------------------------------------C IMPLICIT NONE ! INTEGER RATIOS ! INTEGER INDCT(0:RATIOS) ! INTEGER I ! ! D PRINT*, 'RESETINDCT ENTERED' ! DO 20, I=0,RATIOS ! INDCT(I)=0 ! 20 CONTINUE ! D PRINT*, 'RESETINDCT EXITED ' ! ! END ! SUBROUTINE RESETINDCT ! C----------------------------------------------------! C NAME EVERY RATIO ! SUBROUTINE NAMERATIOS(RATIONAM,RATIOS) ! C----------------------------------------------------! IMPLICIT NONE ! ! INTEGER RATIOS ! CHARACTER*30 RATIONAM(RATIOS) ! ! INTEGER I ! ! ! DO I=1, RATIOS ! RATIONAM(I)='' ! ENDDO ! ! ! RATIONAM(1) = 'OPERATING ROA' ! RATIONAM(2) = 'CURRENT RATIO' ! RATIONAM(3) = 'QUICK RATIO' ! RATIONAM(4) = 'NET PROFIT MARGIN' ! RATIONAM(5) = 'RETURN ON EQUITY' ! RATIONAM(6) = 'TOTAL ASSET TURNOVER' ! RATIONAM(7) = 'INVENTORY TURNOVER' ! RATIONAM(8) = 'TIMES INTEREST EARNED' ! RATIONAM(9) = 'DEBT RATIO' ! ! ! DO I=1, RATIOS ! IF(RATIONAM(I) .EQ.'') THEN ! RATIONAM(I)='USER-DEFINED RATIO' ! ENDIF ! ENDDO ! ! END ! C----------------------------------------------------! C----------------------------------------------------------------------C C SET INDCT, VALIDCT, VALID, ALL TO ZERO C SUBROUTINE RESETVAL(MAXSIZE,YEARIN,RATIOS,VALIDCT,VALID,MEAN,MED) C----------------------------------------------------------------------C IMPLICIT NONE ! ! INTEGER MAXSIZE, YEARIN, RATIOS ! INTEGER VALIDCT(YEARIN,RATIOS) ! REAL VALID(MAXSIZE, YEARIN, RATIOS) ! REAL MEAN(YEARIN, RATIOS) ! REAL MED(YEARIN, RATIOS) ! ! INTEGER I, J, K ! ! ! ! ! D PRINT*, 'RESEVAL ENTERED' ! ! DO 40, I=1,RATIOS ! DO 35, J=1,YEARIN ! VALIDCT(J,I)=0 ! MEAN(J,I)=-0.001 ! MED(J,I)=-0.001 ! DO 33, K=1,MAXSIZE ! VALID(K,J,I)=0.0 ! 33 CONTINUE ! 35 CONTINUE ! 40 CONTINUE ! ! ! D PRINT*, 'RESEVAL EXITED ' ! END ! SUBROUTINE RESETVAL ! C----------------------------------------------------------------------C C WRITES THE NUMBER OF FIRMS THAT WERE FOUND IN THE X-DIGIT C C SIC CODE INDUSTRY C C C SUBROUTINE WRITINDCT(INDCT,INDDIGIT,RATIOOUT) ! C----------------------------------------------------------------------C IMPLICIT NONE ! ! INTEGER INDCT, INDDIGIT, RATIOOUT ! ! CHARACTER DSTRING*10 ! ! ! ! ! ! D PRINT*, 'WRITINDCT ENTERED' ! D PRINT*, 'RATIO OUT UNIT:', RATIOOUT ! ! D PRINT*, 'SELECTING CASE' !----------------------------------! SELECT CASE (INDDIGIT) ! FOR PRINTING PURPOSES SELECT ! CASE (0) ! THE STRING. ! DSTRING='4-DIGIT' !----------------------------------! CASE (1) ! DSTRING='3-DIGIT' ! CASE (2) ! DSTRING='2-DIGIT' ! END SELECT ! ! D PRINT*, 'WRITING INDCT' ! WRITE(RATIOOUT,1043) INDCT, DSTRING ! 1043 FORMAT(I5,1X,' FIRMS FOUND IN THE ',A7,' SIC CODE INDUSTRY') ! ! C WRITE(RATIOOUT,1044) ! 1044 FORMAT('HOWEVER, NUMBER OF FIRMS WILL VARY FOR EACH RATIO AND EACH . YEAR!') ! ! D PRINT*, 'WRITINDCT EXITED' ! ! END !-----------------SUBROUTINE WRITINDCT---------------------! C----------------------------------------------------------------------C C THIS SUBROUTINE IS CALLED ONLY IF THE CURRENT INPUT FIRM IS THE C C SAME AS THE FIRM THAT WAS JUST PROCESSED. IN THAT CASE, COPY C C THE RATIOS THAT RESIDE IN EVFIFRAC L-1 TO EVFIFRAC L C SUBROUTINE COPYEVFI(NFIRMS,YEARIN,RATIOS,EVFIFRAC,L) ! C----------------------------------------------------------------------C IMPLICIT NONE ! ! INTEGER L, NFIRMS, RATIOS, YEARIN ! REAL EVFIFRAC(NFIRMS,YEARIN,RATIOS) ! ! INTEGER I, J ! ! ! ! D PRINT*, 'COPYEVFI ENTERED' ! ! DO I=1,RATIOS ! DO J=1, YEARIN ! EVFIFRAC(L,J,I) = EVFIFRAC(L-1,J,I) ! ENDDO ! ENDDO ! ! D PRINT*, 'COPYEVFI EXITED' ! END ! SUBROUTINE COPYEVFI ! C----------------------------------------------------------------------C C WRITES APPROPRIATE STATS TO THE LOG FILE C SUBROUTINE WRITELOG(LOGFILE,MAXSIZE,MINSIZE,RATIOS,BEGYR,ENDYR, . NFIRMS,NREAD,NFOUND,NINDUS,EVTYR,DNUMIN,CNUMEV,FIRMFOUND, . INDFILLED) C----------------------------------------------------------------------C IMPLICIT NONE ! ! INTEGER LOGFILE, MAXSIZE, MINSIZE, RATIOS, BEGYR, ENDYR, NFIRMS ! INTEGER NREAD, NFOUND, NINDUS, EVTYR(NFIRMS ), DNUMIN(NFIRMS) ! CHARACTER*6 CNUMEV(NFIRMS) ! CHARACTER*1 FIRMFOUND(NFIRMS), INDFILLED(NFIRMS) ! ! ! ! INTEGER I ! ! ! D PRINT*, 'WRITELOGFILE ENTERED' ! ! ! ! WRITE(LOGFILE,*) ! WRITE(LOGFILE,*) ! WRITE(LOGFILE,2) ! 2 FORMAT('------------------------ INDUSTIO LOG ------------------- .---------') ! WRITE(LOGFILE,*) ! WRITE(LOGFILE,*) ! WRITE(LOGFILE,4) ! 4 FORMAT(' **** SUMMARY STATISTICS **** ') WRITE(LOGFILE,*) ! ! WRITE(LOGFILE,12) MAXSIZE ! 12 FORMAT('Maximum number of firms allowed in the industry:',T65,I5)! ! c WRITE(LOGFILE,*) ! WRITE(LOGFILE,22) MINSIZE ! 22 FORMAT('Minimum number of firms required in the industry:',T65,I5) ! c WRITE(LOGFILE,*) ! WRITE(LOGFILE,32) RATIOS ! 32 FORMAT('Number of ratios requested:',T65,I5) ! ! c WRITE(LOGFILE,*) ! WRITE(LOGFILE,42) BEGYR ! 42 FORMAT('First year',"'",'s ratios are written for (relative to eve .nt year):',T65,I5) ! ! c WRITE(LOGFILE,*) ! WRITE(LOGFILE,52) ENDYR ! 52 FORMAT('Last year',"'",'s ratios are written for (relative to even .t year):',T65,I5) ! ! c WRITE(LOGFILE,*) ! WRITE(LOGFILE,62) NFIRMS ! 62 FORMAT('Number of firms expected in fdnumin.txt:',T65,I5) ! ! c WRITE(LOGFILE,*) ! WRITE(LOGFILE,72) NREAD ! 72 FORMAT('Number of firms found in fdnumin.txt:',T65,I5) ! ! c WRITE(LOGFILE,*) ! WRITE(LOGFILE,82) NFOUND ! 82 FORMAT('Number of firms found in COMPUSTAT files:',T65,I5) ! ! c WRITE(LOGFILE,*) ! WRITE(LOGFILE,92) NINDUS ! 92 FORMAT('Number of firms for which industry data was available:', ! . T65,I5) ! ! ! ! WRITE(LOGFILE,*) ! WRITE(LOGFILE,*) ! WRITE(LOGFILE,*) ! WRITE(LOGFILE,94) 94 FORMAT(' **** INDIVIDUAL FIRM STATISTICS **** ') WRITE(LOGFILE,*) ! ! WRITE(LOGFILE,96) ! WRITE(LOGFILE,97) ! WRITE(LOGFILE,98) ! WRITE(LOGFILE,99) ! 96 FORMAT(' IND- ') ! 97 FORMAT(' FIRM USTRY') ! 98 FORMAT('YEAR DNUM CNUM FOUND FILLED') ! 99 FORMAT('---- ---- ------ ----- ------') ! ! DO 100, I=1, NREAD ! WRITE(LOGFILE,102) EVTYR(I), DNUMIN(I), CNUMEV(I), FIRMFOUND(I), . INDFILLED(I) 100 CONTINUE ! 102 FORMAT(I4,1X,I4,1X,A6,3X,A1,6X,A1) ! ! ! D PRINT*, 'WRITELOG EXITED' ! ! END ! SUBROUTINE LOGFILE !