File MCTIV2.FT (FORTRAN source file)

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

C	PROGRAM MCTIVO2 
C	THIS IS THE SECOND HALF OF TIDAL VOLUME.
	COMMON ARRAY(411),DUMI(90),MANU,BLNO
	 DIMENSION NAME(2),NONEUP(20),NONEDO(20)
	REAL NAME,INGAS
	INTEGER ENDA,ARRAY,BLNO
	WRITE(4,3)
  3	FORMAT(1H ,'ENTER MANEUVER ID,NO OF BLOCKS,SAMPLING RATE'/
     1	 ' SCALE FACTORS FOR V,Q, AND P.'/'
     2	(I2,I2,I4,3F6.2)')
	READ (4,2) MANU,NBL,ISR,SFV,SFQ,SFP
C	SFP IS +, BUT SFQ AND SFV ARE -!!!
  2	FORMAT(I2,I2,I4,3F6.2)
  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
	SR=ISR
	HV=1./SR
	ENDA=255
	IEND=NMAX
	IQ=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=2,ENDA,3
    	IQ=IQ+1
   	IF(IQ.LE.MAXNO) GO TO 95
	WRITE(4,97) IQ
	GO TO 99
  95	Q(IQ)=-ARRAY(MA)
C	DO 901 JQ=1,IQ
C 901	WRITE(3,902) JQ,Q(JQ)
C 902	FORMAT(1H ,'Q',2X,I4,5X,I6)
	WRITE(4,903) IQ
 903	FORMAT(1H ,'IQ=',I4)
	IIN=0
	IDO=0
	NOM=0
	IST=1
  30	IF(Q(IST+1).GT.Q(IST)) GO TO 31
	IF(Q(IST+1).LT.Q(IST)) GO TO 32
	WRITE(4,409)
 409	FORMAT(1H ,'THE 2 Q S  ARE EQUAL.')
	IST=IST+1
	GO TO 30
  31	DO 34 KQ=IST,IQ
	IMP=KQ
	IF(Q(KQ+1).EQ.Q(KQ)) GO TO 34
	IF(Q(KQ+1).LT.Q(KQ)) GO TO 37
	IF((Q(KQ).LE.0.).AND.(Q(KQ+1).GT.0.)) GO TO 36
	GO TO 34
  36	IIN=IIN+1
	NONEUP(IIN)=KQ
	WRITE(3,236) KQ,IIN,Q(KQ)
 236	FORMAT(1H ,I5,5X,'ZERO CROSS UP',3X,I4,5X,I6)
  34	CONTINUE
	IF(IMP.GE.IQ) GO TO 40
  37	IST=IMP+1
  32	DO 35 LQ=IST,IQ
	IMQ=LQ
	IF(Q(LQ+1).EQ.Q(LQ)) GO TO 35
	IF(Q(LQ+1).GT.Q(LQ)) GO TO 38
	IF((Q(LQ).GE.0.).AND.(Q(LQ+1).LT.0.)) GO TO 336
	GO TO 35
 336	IDO=IDO+1
	WRITE (3,237) LQ,IDO,Q(LQ)
 237	FORMAT(1H ,I5,5X,'ZERO CROSS DOWN',3X,I4,5X,I6)
	NONEDO(IDO)=LQ
  35	CONTINUE
	IF(IMQ.GE.IQ) GO TO 40
  38	IST=IMQ+1
	GO TO 31
 904	FORMAT(1H ,'NUMBER OF DOWN ZERO CROSSINGS=',I6/1H ,
     1	'NUMBER OF UP ZERO CROSSINGS=',I6)
  40	IF(NONEDO(1).GT.NONEUP(1)) GO TO 42
	DO 41 MQ=1,IDO-1
  41	NONEDO(MQ)=NONEDO(MQ+1)
	IDO=IDO-1
	GO TO 40
  42	IF(NONEDO(IDO).LT.NONEUP(IIN)) GO TO 20
	IDO=IDO-1
	GO TO 42
  20	WRITE(4,904) IDO,IIN
C	DO 929 JPM=1,IDO
C	WRITE(3,928) JPM,NONEUP(JPM)
C 929	WRITE(3,927) JPM,NONEDO(JPM)
  927	FORMAT(1H ,'NONEDO(',I3,')=',I5)
  928	FORMAT(1H ,'NONEUP(',I3,')=',I5)
C	WRITE(3,928) IIN,NONEUP(IIN)
	ICASE=1
	INB=NONEUP(1)*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
	DO 601 JY=2,IIN
	NPON=NONEUP(JY)-NONEUP(1)+1
	IF(NPON.LE.NMAX) GO TO 601
	UPTO=NONEUP(JY-1)
	IEND=UPTO-NONEUP(1)+1
	INBB=UPTO*3-2
	IENDB=IEND
	LULL=JY-1
	NOSET=LULL-1
C	WRITE(4,945) NOSET,ICASE,LULL
 945	FORMAT(1H ,'NOSET=',I4,10X,'ICASE=',I4,10X,'LULL=',I4)
	GO TO 602
 601	CONTINUE
 602	DO 614 IM=2,IDO
	NONEDO(IM)=NONEDO(IM)-NONEUP(1)+1
 614	NONEUP(IM)=NONEUP(IM)-NONEUP(1)+1
	NONEUP(IIN)=NONEUP(IIN)-NONEUP(1)+1
	NONEDO(1)=NONEDO(1)-NONEUP(1)+1
	NONEUP(1)=1
  25	IAM=1
C	DO 829 JPP=1,IDO
C	WRITE(3,928) JPP,NONEUP(JPP)
C 829	WRITE(3,927) JPP,NONEDO(JPP)
C	WRITE(3,928) IIN,NONEUP(IIN)
	WRITE (4,221) NBA,ISTART,IEND
  221	FORMAT(1H ,'NBA ',I2,3X,'ISTART ',I4,3X,'IEND ',I4)
C	WRITE(4,904) IDO,IIN
	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.LE.NMAX) GO TO 911
	WRITE(4,97) IV
	GO TO 99
 911	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)=V(JM)*SFV
	Q(JM)=Q(JM)*SFQ

P(JM)=P(JM)*SFP C WRITE(3,218) JM,V(JM),Q(JM),P(JM) 218 FORMAT(1H ,I4,3X,'V ',F7.3,2X,'Q ',F7.2,2X, 1 'P ',F7.2) 33 CONTINUE C ROSE'S PROGRAM GOES HERE. 99 STOP END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search