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