C lcross.f vers 3.0 Level crossing count prog. a redo of 1977 prog. fac97 C C Usage: lcross Vmax Vmin outfile C If Vmax & Vmin are missing, lcross will stop. C The "infile" must have a header & ^END or BEGIN DATA line C C Linux Compile: gfortran -g lcross.f -o lcross C Copyright (C) 2002 University of Waterloo and F.A. Conle C This data file is free software; you can redistribute it and/or modify C it under the terms of the GNU General Public License as published by C the Free Software Foundation; either version 2 of the license, or (at C your option) any later version. C This data file is distributed in the hope that it will be useful, but C WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTA- C BILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public C License for more details. C You should have received a copy of the GNU General PUblic License along C with this program; if not, write to the Free Software Foundation, Inc., C 59 Temple Place -Suite 330, Boston, MA 02111-1307, USA. Try also their C web site: http://www.gnu.org/copyleft/gpl.html C vers 3.0 remove time column in input data. Apr. 2017 C---------------- Input file format expected----------------------------- C comment line C These lines contain descriptions etc. can be anything except C the words "BEGIN" or "^END " in the first column. These symbols C delimit the comments and the data section of the file C C comment line C comment line C comment line, up to 1000 comment lines allowed C comment: data is c time (integer) and signal(real) pairs, as below C Time is not paid much attention to in the program C C BEGIN DATA C 5.1 C 6.2 c 8.1 C . C . C . c voltage_n C---------------- End of input file format ------------------------------ C CHARACTER*1 INP1(80) CHARACTER*5 INP5(16) CHARACTER*20 XELEM CHARACTER*80 INP80,argv EQUIVALENCE (INP80,INP5(1),INP1(1)) C C INTEGER MAT(40) LOGICAL BUG integer highwater,lowwater, ithresup, ithresdown REAL thresup, thresdown BUG=.false. C Additions to force noprint output format in some fortran compilers that C always place a space at begining of line. C Open standard output and standard error with c no carriage control interp of leading char. c open(6,FORM="NOPRINT") C open(0,FORM="NOPRINT") WRITE(0,102) WRITE(6,102) 102 FORMAT("#LCROSS version 3.0 STARTS...") C C get the max and min histogram delimiters C NOTE NOTE NOTE on HPs the arg numbers are different !!!! if(iargc().NE.2)then write(0,*)'#LCROSS no max min args, ... ' write(0,*)"# Usage: lcross vmax vmin outfile" stop endif c Assume 2 args call getarg(1,argv) read(argv,*)VMAX call getarg(2,argv) read(argv,*)VMIN 105 continue c decide which is bigger if(VMAX.lt.VMIN)then xtemp=VMAX VMAX=VMIN VMIN=xtemp endif C INITILIZE THE VARIABLES NA=40 C ASSUME VMIN AT CENTER OF BIN 1, VMAX AT C OF BIN 40 DA=(VMAX-VMIN)/(NA-1) ALOW=(VMIN-DA*0.5) C ALOW, is THE LOWER BOUNDS OF THE MATRIX C Zero the level counters DO 69 KA=1,NA MAT(KA)=0 69 CONTINUE Vmid=(VMAX+VMIN)/2.0 write(0,68)VMAX,VMIN,Vmid write(6,68)VMAX,VMIN,Vmid 68 format("#LCROSS, Max= ",G10.3," Min= ",G10.3," Middle=",G10.3) C THRESHOLDS SET HERE C THRESHOLDS SET HERE C THRESHOLDS SET HERE thresup=Vmid+ 0.05*(VMAX-VMIN) thresdown=Vmid - 0.05*(VMAX-VMIN) ithresup= IFIX((thresup-ALOW)/DA)+1 ithresdown= IFIX((thresdown-ALOW)/DA)+1 write(6,75)vmax,vmin, & thresup,thresdown,ithresup,ithresdown 75 format("#LCROSS Vmax= ",G10.3," Vmin= ",G10.3, & " 5% Thres Up= ",G10.3," Down= ",G10.3," bins: ",2(1x,I3) ) C C C READ IN HEADER STUFF C Note this program is older and does not like finding a # outside C of column 1 to denote a comment line. It also needs a "#BEGIN" C in the line above the data lines. NL=0 1000 CONTINUE READ(5,1010,END=1050)INP80 NL=NL+1 1010 FORMAT(A80) IF(INP5(1).EQ. '^END '.or. INP5(1).eq. "BEGIN" .or. & INP5(1).EQ. '#BEGI' .or. INP5(1).EQ. '#Begi')THEN 1022 WRITE(0,1020) 1020 FORMAT("# Found end of comments line. Reading data...") GO TO 2000 ENDIF C No?, then it was just a comment line. Go get another, goto 1000 C E.O.F. DURING HEADER READ 1050 WRITE(0,1052)F1,NL 1052 FORMAT('#***LCROSS: ERROR NO DATA IN FILE =',A80/' LINES=',I10) IER=1050 GO TO 9000 C C 2000 CONTINUE C C get the first point. It does not creat a count. It does establish C the range of the next point set. CONVERT ALL TO BINS. Run the whole C thing in bins. N=1 70 continue Ctiem voltage file READ(5,*,END=9020)iTIME,V1 READ(5,*,END=9020)V1 ! only voltage file IF(V1.GT.VMAX .OR.V1.LT.VMIN)THEN WRITE(0,12)V1,N 12 FORMAT('#LCROSS: ERROR , OUT OF RG: V=',F12.5,', N=',I10) write(0,*)" Suggest you run the HILO routine on the", & " history first." write(0,*)" Stopping here, now." STOP ENDIF C change to bin ibinnew=IFIX((V1-ALOW)/DA)+1 C If its in the threshold region, abandon this as a first "point" if(ibinnew.le.ithresup .and. ibinnew.ge.ithresdown)go to 70 C ok the first pt is in. Arbitrarily set ibinold to highwater if(ibinnew.gt.ithresup)then ibinold=ithresup +1 MAT(ibinold)=MAT(ibinold)+1 highwater=ibinold lowwater=ithresdown endif if(ibinnew.lt.ithresdown)then ibinold=ithresdown-1 MAT(ibinold)=MAT(ibinold)+1 if(BUG)write(0,*)" counting ",ibinold lowwater=ibinold highwater=ithresup endif C we must now count to the new pt go to 10020 C C RUN------------------------------------------------------- 10010 CONTINUE N=N+1 Ctime voltage file READ(5,*,END=999,ERR=30)iTIME,V READ(5,*,END=999,ERR=30)V if(bug)write (0,*)iTime,v IF(V.GT.VMAX .OR.V.LT.VMIN)THEN WRITE(0,12)V,N write(0,*)" Suggest you run the HILO routine on the", & " history first." write(0,*)" Stopping here, now." STOP ENDIF C change volts to bin nos ibinnew=IFIX((V-ALOW)/DA)+1 C see if we are in the reset band if(ibinnew.le.ithresup .and. ibinnew.ge.ithresdown) then highwater=ithresup lowwater=ithresdown if(BUG)write(0,*)" reset waters: ",highwater,lowwater go to 10010 endif 10020 continue if(BUG)write(0,*)ibinold,ibinnew," waters:",highwater,lowwater C Is this diff from old? if(ibinnew .eq. ibinold) go to 10010 C The counting process is a matter of "state" C IF we are in the +ve side or field, we are looking for upwards half cycles C and if in the -ve side, downwards half cycles. C IF we are +ve and the new is less than the old, we either ignore it, C or see if we have reset the highwater mark, or if we have gone to the -ve side. C IF we are +ve and the new is bigger than the old, we must check to see if the C highwater mark has been exceeded, and then count all crossings greater than C the highwater, and also reset the highwater to the new value. C If we are +ve and the new value goes below the +ve 5% threshold, we need to reset C the highwater mark to the threshold. C C Analogous logic applies to the -ve state C +ve +ve +ve+ve +ve +ve+ve +ve +ve+ve +ve +ve+ve +ve +ve+ve +ve +ve+ve +ve +ve 3000 continue if(ibinold.gt.ithresup)then C we are in the positive field if(ibinnew.gt.highwater)then C we are also bigger than the old highwater, count all between ka=highwater 5000 ka=ka+1 MAT(ka)=MAT(ka)+1 if(bug)write(0,*)" counting ",ka if(ka.lt.ibinnew)go to 5000 highwater=ibinnew ibinold=ibinnew endif if(ibinnew.eq.highwater)then c since highwater has already been counted dont count here ibinold=ibinnew go to 10010 endif if(ibinnew.lt.ibinold)then c A negative 1/2 cycle in the +ve field counts nothing c See if it is also at or below the reset level, actually it must be C below, because we checked for "at threshold" somewhere above if(ibinnew.lt.ithresup)then c Yes, we have dropped below the threshold highwater=ithresup ibinold=ithresdown-1 lowwater=ibinold MAT(ibinold)=MAT(ibinold)+1 if(BUG)write(0,*)" counting ",ibinold c go to the negative section of the code, and let it handle the rest c of the counting on this 1/2 cycle go to 4000 endif C It must be between ibinold & threshold bands, ignore it go to 10010 endif if(ibinnew.lt.highwater)then c It must be between ibinold and highwater, thus no counts but reset old ibinold=ibinnew endif endif ! from if at statement no. 3000 C -ve-ve -ve -ve -ve-ve -ve -ve -ve-ve -ve -ve -ve-ve -ve -ve -ve-ve -ve -ve -ve 4000 continue if(ibinold.lt.ithresdown)then C we are in the negative field if(ibinnew.lt.lowwater)then C we are also lower than the old lowwater, count all between ka=lowwater 4500 ka=ka-1 MAT(ka)=MAT(ka)+1 if(BUG)write(0,*)" counting ",ka if(ka.gt.ibinnew)go to 4500 lowwater=ibinnew ibinold=ibinnew endif if(ibinnew.eq.lowwater)then c since highwater has already been counted dont count here ibinold=ibinnew go to 10010 endif if(ibinnew.gt.ibinold)then c A positive 1/2 cycle in the -ve field counts nothing c See if it is also at or above the reset level, actually it must be C above, because we checked for "at threshold" somewhere above if(ibinnew.gt.ithresup)then c Yes, we have raised above the threshold lowwater=ithresdown ibinold=ithresup+1 highwater=ibinold MAT(ibinold)=MAT(ibinold)+1 if(BUG)write(0,*)" counting ",ibinold c go to the positive section of the code, and let it handle the rest c of the counting on this 1/2 cycle go to 3000 endif C It must be between ibinold & threshold bands, ignore it go to 10010 endif if(ibinnew.gt.lowwater)then c It must be between ibinold and lowwater, thus no counts but reset old ibinold=ibinnew go to 10010 endif endif !from statement no. 4000 c If the execution ends up here, i have bad logic write(0,*)" *** Logic error, Conle has screwed up, call x32649" write(0,*)" Problem in +ve field logic, stopping." stop C C COUNTING DONE, OUTPUT DATA 999 continue C C Invert the order of printout C ASSUME CENTER OF INTERVAL AS REPRESENTATIVE. xlevel=VMAX DO 9150 I=NA,1,-1 JVT=MAT(I) write(6,*)xlevel,JVT if(I .eq.NA/2)then c A value of 0 0 is the signal of end of highs & also for end of lows write(6,*) " 0. 0 " write(6,*) endif xlevel=xlevel-DA 9150 CONTINUE write(6,*) " 0. 0 " C OTHER ERROR, EXIT GO TO 9000 C END OF DATA C C READ ERROR 9020 CONTINUE 30 CONTINUE C IGNORE ERROR , MAY BE TEXT COMMENT INSERT WRITE(0,*) '#LCROSS: DATA READ ERROR, N=',N,' Stopping...' STOP C 40 WRITE(0,45) 45 FORMAT('#LCROSS: ERROR, NO DATA ?') GO TO 9000 C C C 9000 CONTINUE stop END C C Note: when creating the input file remove "C " from each line of input file below C----------------------------- cut here, sample input file ------------------------------ C test C BEGIN C 0 C 10000 C 9000 C 14000 C 100 C 15000 C -5000 C -4000 C -10000 C 0 C -14000 C 0 C C----------------------------- cut here, sample output file--------------------------- Ctest C.LCROSS 0.150E+05-0.150E+05 5% Thres 0.150E+04-0.150E+04 bins: 22 19 CBEGIN C 15000.0 1 C 14230.8 2 C 13461.5 2 C 12692.3 2 C 11923.1 2 C 11153.8 2 C 10384.62 2 C 9615.39 2 C 8846.16 2 C 8076.93 2 C 7307.69 2 C 6538.46 2 C 5769.23 2 C 5000.00 2 C 4230.77 2 C 3461.54 2 C 2692.31 2 C 1923.08 2 C 1153.85 0 C 384.617 0 C 0 0 C -384.614 0 C -1153.84 0 C -1923.08 2 C -2692.31 2 C -3461.54 2 C -4230.77 2 C -5000.00 2 C -5769.23 2 C -6538.46 2 C -7307.69 2 C -8076.92 2 C -8846.15 2 C -9615.38 2 C -10384.61 1 C -11153.8 1 C -11923.1 1 C -12692.3 1 C -13461.5 1 C -14230.8 1 C -15000.0 0 C 0 0 C---------------------------------cut here, end of sample output ---------------