Directory of image this file is from
This file as a plain text file

C	PROGRAM MCFOVC
	COMMON ARRAY(411),DUMI(90),MANU,BLNO
	COMMON/PA/V(501),Q(501),P(501),LURE1,LURE2
	DIMENSION DQ(501),PERVC(501),NAME(2)
     1	,IFEV(4),ENK(21),INK(21),DUM(501)
	EQUIVALENCE (ARRAY(1),DQ(1)),(DUM(1),PERVC(1))
	REAL LURE1,LURE2,LOTE,LUTE,NAME,INGAS
	INTEGER ENDA,ENK,ARRAY,BLNO
	WRITE(4,3)
  3	FORMAT(1H ,'ENTER MANEUVER ID,NO OF BLOCKS,SAMPLING RATE,
     1	 LUNG RECOIL COEFFICIENTS,'/' VITAL CAPACITY, SCALE
     2	 FACTORS FOR V,Q, AND P.'/'
     3	(I2,I2,I3,3F4.2,3F7.4)')
	READ (4,2) MANU,NBL,ISR,LURE1,LURE2,VICAP,SFV,SFQ,SFP
C	SFP IS +, BUT SFQ AND SFV ARE -!!!
  2	FORMAT(I2,I2,I3,3F4.2,3F7.4)
  6	FORMAT(2I6,2A6,F6.0,A6)
  7	FORMAT(30X,'EXPERIMENT DATE',5X,I6/30X,'DATE ANALYZED'
     1	,7X,I6/30X,'SUBJECT',13X,2A6/30X,'DEPTH',15X,F6.0/30X,
     2	'INERT GAS',11X,A6/30X,'MANEUVER',12X,I4////)
	WRITE(4,407)
 407	FORMAT(1H ,'ENTER EXPERIMENT DATE, DATE ANALYZED
     1	,SUBJECT NAME,'/' DEPTH AND THE INERT GAS.'/
     2	' (2I6,2A6,F6.0,A6)')
 	READ (4,6) IDEA,IDER,NAME(1),NAME(2),DEPTH,INGAS
 	WRITE(3,7) IDEA,IDER,NAME(1),NAME(2),DEPTH,INGAS,MANU
	MAXNO=1365
	NMAX=500
	SR=ISR
	ENDA=255
	IV=0
	DO 95 IBA=1,NBL
	BLNO=IBA
	CALL TRANS
	IF(IBA.NE.NBL) GO TO 110
	DO 121 IT=1,255
	IF(ARRAY(IT).NE.0) GO TO 121
	IA=IT+1
	IZ=IT+9
	IF(IZ.GT.255) IZ=255
	DO 122 ITT=IA,IZ
	IF(ARRAY(ITT).NE.0) GO TO 121
  122	CONTINUE
	ENDA=IT-1
	GO TO 110
  121	CONTINUE
 110	DO 95 MA=1,ENDA,3
    	IV=IV+1
	IF(IV.GT.MAXNO) GO TO 98
  95	V(IV)=-ARRAY(MA)
C	THE NEGATIVE SIGN HERE IS TO INVERT WHILE WE SEARCH
C	PATTERN RECOGNITION DETAILS. THE SPIROMETER PUTS OUT +
C	VOLTAGE DURING EXPIRATION.
	VMIN=V(1)
	MERD=1
	DO 35 KV=2,IV
	IF (V(KV).GT.VMIN) GO TO 35
	MERD=KV
	VMIN=V(KV)
  35	CONTINUE
	WRITE(4,234) MERD
	VMAX=V(1)
	MORD=1
	DO 31 JV=2,MERD-1
	IF(V(JV).LT.VMAX) GO TO 31
	MORD=JV
	VMAX=V(JV)
  31	CONTINUE
	WRITE(4,231) MORD
	VMAZ=V(MERD)
	MORZ=MERD
	DO 32 JVZ=MERD+1,IV
	IF(V(JVZ).LE.VMAZ) GO TO 32
	MORZ=JVZ
	VMAZ=V(JVZ)
  32	CONTINUE
	WRITE(4,232) MORZ
	VHI=VMAX
	IF(VMAX.LT.VMAZ) VHI=VMAZ
  20	ICASE=1
	INB=MORD*3-2
	DO 176 IC=1,16
	INC=IC
	IF(INB.LE.255) GO TO 177
 176	INB=INB-255
 177	NBA=INC
	ISTART=INB
	IEND=MERD-MORD+1
  25	IF(IEND.GT.500) IEND=500
	IAM=1
	WRITE (4,221) NBA,ISTART,IEND
  221	FORMAT(1H ,'NBA ',I2,3X,'ISTART ',I4,3X,'IEND ',I4)
  231	FORMAT(1H ,' MORD=',I4)
 232	FORMAT(1H ,' MORZ=',I4)
 234	FORMAT(1H ,' MERD=',I4)
	IV=0
	IQ=0
	IP=0
	DO 90 IBL=NBA,NBL
	BLNO=IBL
	IF(IBL.NE.NBA) ISTART=1
	CALL TRANS
    	DO 90 M=ISTART,255
	GO TO (11,12,13),IAM
  11	IV=IV+1
	IF(IV.GT.IEND) GO TO 50
	IF(IV.GT.NMAX) GO TO 98
	V(IV)=ARRAY(M)
	IAM=2
	GO TO 90
  12	IQ=IQ+1
	Q(IQ)=ARRAY(M)
	IAM=3
	GO TO 90
  13	IP=IP+1
	P(IP)=ARRAY(M)
	IAM=1
  90	CONTINUE
  50	DO 33 JM=1,IEND
	V(JM)=VICAP+SFV*(VHI+V(JM))
	Q(JM)=Q(JM)*SFQ
  33	P(JM)=P(JM)*SFP
	IF(ICASE.EQ.2) GO TO 21
C	MEANS OF DETERMINING 0 TIME FOR Q FOR THE FEV S
C	GOES HERE.   TEMPORARILY:
	IFEV(1)=1
	DO 19 IFA=2,4
    	IFEV(IFA)=IFEV(IFA-1)+ISR
	MFZ=IFA
	IF(IFEV(IFA).LE.IEND) GO TO 19
	MFZ=IFA-1
	GO TO 119
  19	CONTINUE
 119	HQ=1./SR
  21	CALL DET5(HQ,Q,DUM,DQ,IEND,IER)
	IF(IER.EQ.0) GO TO 16
	WRITE(4,17) IER
  17	FORMAT(1H1,'HELP, IER= ',I4//)
	GO TO 99
  16	VEXP=V(1)-V(IEND)
	IF(ICASE.EQ.2) VEXP=-VEXP
    	DO 36 MA=1,IEND
  36	PERVC(MA)=(V(MA)*100.)/VICAP
	PMAXE=P(1)
	QMAXE=Q(1)
	DQMAXE=DQ(1)
	NPE=1
	NQE=1
	NDQE=1
	DO 34 NU=2,IEND
	IF(ICASE.EQ.2) GO TO 134
	IF(P(NU).LE.PMAXE) GO TO 4
	PMAXE=P(NU)
	NPE=NU
  4	IF(Q(NU).GE.QMAXE) GO TO 5
	QMAXE=Q(NU)
	NQE=NU
  5	IF(DQ(NU).GE.DQMAXE) GO TO 34
	DQMAXE=DQ(NU)
	NDQE=NU
	GO TO 34
 134	IF(P(NU).GE.PMAXE) GO TO 104
	PMAXE=P(NU)
	NPE=NU
 104	IF(Q(NU).LE.QMAXE) GO TO 105
	QMAXE=Q(NU)
	NQE=NU
 105	IF(DQ(NU).LE.DQMAXE) GO TO 34
	DQMAXE=DQ(NU)
	NDQE=NU
  34	CONTINUE
	IF(ICASE.EQ.2) GO TO 22
	DO 24 MFA=1,MFZ
	IFV=IFEV(MFA)
	MFM=MFA-1
	VFV=VICAP-V(IFV)
	PRFV=100.-PERVC(IFV)
  24	WRITE(3,26) MFM,VFV,PRFV
  26	FORMAT(1H ,'FEV(',I2,') ',10X,'V= ',F6.2,5X,
     1	'PER CENT VC= ',F6.2)
	WRITE(3,27) VEXP
  27	FORMAT(///30X,'FORCED EXPIRATION',F10.3,2X,'L'///
     1	14X,'VOLUME',6X,'% V C',7X,'FLOW',6X,'PRES',6X,'RESIST'
     2	,7X,'ACCEL'/17X,'L',21X,'L/S',5X,'CM H2O',4X,'CMH2O/L/S'
     3	,5X,'L/S/S')
	GO TO 124
  22	WRITE(3,38) VEXP
  38	FORMAT(///30X,'FORCED INSPIRATION',F10.3,2X,'L'///
     1	14X,'VOLUME',6X,'% V C',7X,'FLOW',6X,'PRES',6X,'RESIST'
     2	,7X,'ACCEL'/17X,'L',21X,'L/S',5X,'CM H20',4X,'CMH2O/L/S'
     3	,5X,'L/S/S')

 124  	CALL PAVO(PERVC(NQE),PAV,NQE)
	WRITE(3,18) V(NQE),PERVC(NQE),QMAXE,P(NQE),PAV,DQ(NQE)
  8	FORMAT(1H ,13X,3(F6.2,5X),2(F6.1,5X),F7.2)
  18	FORMAT(1H ,'PEAK FLOW',4X,3(F6.2,5X),2(F6.1,5X),F7.2)
  28	FORMAT(1H ,'PEAK PRES',4X,3(F6.2,5X),2(F6.1,5X),F7.2)
	CALL PAVO(PERVC(NPE),PAV,NPE)
	WRITE(3,28) V(NPE),PERVC(NPE),Q(NPE),PMAXE,PAV,DQ(NPE)
  29	FORMAT(1H ,'PEAK ACCL',4X,3(F6.2,5X),2(F6.1,5X),F7.2)
	CALL PAVO(PERVC(NDQE),PAV,NDQE)
	WRITE(3,29) V(NDQE),PERVC(NDQE),Q(NDQE),P(NDQE),PAV,
     1	DQMAXE
	WRITE(3,40)
  40	FORMAT(//)
	IF(ICASE.EQ.2) GO TO 71
	NKE=1
	LOT=95
	DO 39 NOT=1,IEND
	LOTE=LOT
	IPER=PERVC(NOT)
	IF(IPER.GT.(LOT-1)) GO TO 39
	XCES=PERVC(NOT-1)-LOTE
	XTRA=LOTE-PERVC(NOT)
	IF(XCES.LE.XTRA) GO TO 41
	ENK(NKE)=NOT
	GO TO 42
  41	ENK(NKE)=NOT-1
  42	NKE=NKE+1
	LOT=LOT-5
	IF(LOT.EQ.0) GO TO 307
  39	CONTINUE
 307	NPR=NKE-1
	IF(LOT.EQ.0) LOT=5
	DO 43 NP=1,NPR
	JE=ENK(NP)
    	CALL PAVO(PERVC(JE),PAV,JE)
  43	WRITE(3,8) V(JE),PERVC(JE),Q(JE),P(JE),PAV,DQ(JE)
  301	ICASE=2
	INP=MERD*3-2
	DO 178 IW=1,16
	INW=IW
	IF(INP.LE.255) GO TO 179
 178	INP=INP-255
 179	NBA=INW
	ISTART=INP
	IEND=MORZ-MERD+1
	GO TO 25
  71	NKI=1
	LUT=LOT
	DO 44 NUT=1,IEND
	LUTE=LUT
	IPER=PERVC(NUT)
	IF(IPER.LT.LUT) GO TO 44
	XCES=PERVC(NUT)-LUTE
	XTRA=LUTE-PERVC(NUT-1)
	IF(XTRA.LE.XCES) GO TO 45
	INK(NKI)=NUT
	GO TO 46
  45	INK(NKI)=NUT-1
  46	NKI=NKI+1
	LUT=LUT+5
	IF(LUT.EQ.100) GO TO 308
  44	CONTINUE
 308	NPR=NKI-1
	DO 47 NP=1,NPR
	JI=INK(NP)
    	CALL PAVO(PERVC(JI),PAV,JI)
  47	WRITE(3,8) V(JI),PERVC(JI),Q(JI),P(JI),PAV,DQ(JI)
	GO TO 99
  98	WRITE(4,97) IV
  97	FORMAT(1H1,'HELP, OVERFLEW DIMENSIONS.',5X,I4)
  99	STOP
	END