  	PROGRAM BIRITM
	DATA ININ/"40/
	BYTE NPL,NPLM,NPLW,FORMF
	INTEGER*2 NAME,NWK
	DIMENSION NAME(10),NWK(7)
	DATA NDR,NMR,NYR/0,0,-1/
	DATA NDT,NMT,NYT/0,0,-1/
	DATA NPLM/'M'/
	DATA	FORMF	/"14/
	DATA NPLW/'v'/
	DATA NWK/2Hpn,2Hwt,2HsP,2H~t,2Hpt,2Hsb,2Hws/
	CALL	IPOKE("44,IPEEK("44).OR."40000)
10	JA=0
        CALL	ASSIGN(6,'LP:BIO.LST',0,,'CC',2) !
1000	TYPE	777,ININ
	ACCEPT 68,NAME2
68	FORMAT(A2)
	TYPE	900
900	FORMAT	(/'$data rovdeniq (29,5,57)		  ? ')
	ACCEPT	901,NDR,NMR,NYR 	!
901	FORMAT	(3I)			!
	IF(NDR.GT.31 .OR. NDR.LE.0) GO TO 1000
	IF(NDR.GT.29 .AND. NMR.EQ.2) GO TO 1000
	IF(NMR.LE.0 .OR. NMR.GT.12) GO TO 1000
	IF(NYR.LT.0 .OR. NYR.GT.99)GO TO 1000
	IF(NMR.EQ.4 .AND.  NDR.GT.30)GO TO 1000
	IF(NMR.EQ.6 .AND. NDR.GT.30) GO TO 1000
	IF(NMR.EQ.9 .AND. NDR.GT.30) GO TO 1000
	IF(NMR.EQ.11 .AND. NDR.GT.30) GO TO 1000
	NYRA=NYR
	NYRA=(NYRA/4)*4
	IF(NYRA.NE.NYR .AND. NMR.EQ.2 .AND. NDR.GT.28) GO TO 1000
1001	TYPE	902			!
902	FORMAT	('$wa{ pol (m,v)			? ')
	ACCEPT	903,NPL 		!
903	FORMAT	(A1)			!
	IF(NPL .NE. 'm' .AND. NPL .NE. 'v' ) GOTO 1001
1002	TYPE	904			!
904	FORMAT	('$teku}aq data (22,7,79)		? ')
	ACCEPT	901,NDT,NMT,NYT 	!
	IF (NDT .GT. 31 .OR. NDT .LE. 0) GOTO 1002
	IF (NDT .GT. 29 .AND. NMT .EQ. 2) GOTO 1002
	IF (NMT .LE. 0 .OR. NMT .GT. 12) GOTO 1002
	IF (NYT .LT. 0 .OR. NYT .GT. 99) GOTO 1002
	IF (NDT .GT. 30 .AND. NMT .EQ. 4) GOTO 1002
	IF (NDT .GT. 30 .AND. NMT .EQ. 6) GOTO 1002
	IF (NDT .GT. 30 .AND. NMT .EQ. 9) GOTO 1002
	IF (NDT .GT. 30 .AND. NMT .EQ. 11) GOTO 1002
	NYTA=NYT
	NYTA=(NYTA/4)*4
	IF (NYTA .NE. NYT .AND. NMT .EQ. 2 .AND. NDT .GT. 28) GOTO 1002
	IF (NYT .LT. NYR .OR. NYT .EQ. NYR .AND. NMT .LT. NMR .OR.
     *	NYT .EQ. NYR .AND. NMT .EQ. NMR .AND. NDT .LE. NDR) GOTO 1000
	TYPE	905			!
905	FORMAT	('$nomer dnq nedeli (1-pn., 2-wt.,...)	? ')
	ACCEPT	901,NW			!
	TYPE	906			!
906	FORMAT	('$wa{e imq w roditelxnom padeve',
     *//7X,' (iwanowoj i.i.)     ? ')
	ACCEPT	907,NAME		!
907	FORMAT	(20A2)			!
92	TYPE *,' ~islo dnej ,na kotorye nuven grafik'
	ACCEPT *,IINUM
	IF(IINUM.LE.0.OR.IINUM.GT.32767) GO TO 92
	IF(NW-7) 81,81,80
81	IF(NPL.EQ.'m') GOTO 11
	IF(NPL.EQ.'v') GOTO 12
80	CONTINUE
	GOTO 10
11	PL=1095.75
	JPL=1096
	GOTO 13
12	PL=-730.5
	JPL=731
13	N=NW
131	CALL NDAY(NMR,NDR,NYR,NMT,NDT,NYT,N,K)
	NYT=NYT+1900
	NYR=1900+NYR
	PRINT 200,(NAME(I),I=1,10),NDR,NMR,NYR,NWK(N),NDT,NMT,NYT,K
        PRINT 201
200	FORMAT(25X,'bioritmy TOw. ',10A2//1X,'dlq kontrolq: wa{ denx ',
     *'rovdeniq - ',I2,', mesqc - ',I2,', god - ',I4,'.'/1X,'wy ',
     *'rodilisx w - ',A2,'.',1X,'na ',I2,'/',I2,'/',I4,'g. wy provili',I6,
     *' dn.')
201   FORMAT(1X,
     *//,1X,90('=')/1X,'ritmy |moc., fizi~., intel. i fizi~. aktiwn.',
     *T60,'denx mesqc   luna'/1X,
     *90('='))
      KLUN=(NYT-1969)*11+10
      KLUN=KLUN-(KLUN/30)*30
      NDX=14
      NMX=2
      N1=N
	IF(NMT .GT. 7) NYT=NYT+1
      CALL NDY(NMX,NDX,NMT,NDT,NYT,N1,K1)
      DO 77 II=1,IINUM
      SEZ=(K1-(K1/365)*365)
      CEM=(K-(K/28)*28)
      CIN=(K-(K/33)*33)
      CPH=(K-(K/23)*23)
      CWN=(K-(K/JPL)*JPL)
      PI=6.28218
      PEM=SIN((PI/28)*CEM)
      PIN=SIN((PI/33)*CIN)
      PPH=SIN((PI/23)*CPH)
      PWM=SIN((PI/PL)*CWN)
      PSEZ=SIN((PI/364.0)*SEZ)
	SUM=PSEZ+PWM+(PPH+PEM+PIN)/2.0
      IF (JA.EQ.1) GOTO 14
      JA=1
      LUN=NMT+NDT+KLUN
	IF (LUN .GE. 0) GOTO 14
	LUN=0-LUN
14	LUN=LUN-(LUN/30)*30+1
	CALL PLOT(PEM,PIN,SUM,PPH,PWM,PSAZ,NDT,NMT,NW,LUN)
	GOTO(31,32,31,34,31,34,31,31,34,31,34,30),NMT !
30	IF(NDT-31) 53,50,50
31	IF(NDT-31) 53,51,51
32	KY1=NYT
	KY1=(KY1/4)*4
	IF(KY1.EQ.NYT) GOTO 54
	IF(NDT-28) 53,51,51
54	IF(NDT-29) 53,51,51
34	IF(NDT-30) 53,51,51
50	NMT=0
51	NMT=NMT+1
52	NDT=0
53	NDT=NDT+1
	K1=K1+1
	K=K+1
	IF(NW.NE.7) GOTO 4
	NW=0
4	NW=NW+1
77	CONTINUE
	PRINT	202			!
	PRINT	701			!
	PRINT	702			!
	PRINT   705                     !
	PRINT	703			!
202	FORMAT(1X,
     *24('-'),'I',24('+')/1X,
     *90('=')/5X,
     *'ispolxzowany sledu`}ie uslownye obozna~eniq:'
     *//5X,'(|) - |MOciOnAlxnyj cikl, |=28 dn.;'
     */5X,'(i) - inTEllEKTuAlxnyj cikl, i=33 dn.;'
     */5X,'(f) - fizi~eskij cikl f=23 dn.;'
     */5X,'(+) - fizi~eskij cikl (rawen 3 godam'
     */' dlq Muv~in i 2 godam dlq ven}in);')
701    FORMAT(5X,'(*) - summarnyj grafik fizi~eskoj aktiwnosti.'
     *//5X,'w polovitelxnye periody |MOciOnalxnogo cikla (14 dn.)'
     */' l`di sklonny K horo{emu nastroeni`, optimisti~ny i kontaktny.'
     *//5X,'naprotiw, w OTricATElxnye periody oni bolee podwervEny'
     */' plohomu nastroeni` i pEssimizmu.')
702	FORMAT(//5X,'w polovitelxnye periody intellEKTuAlxnogo ciKlA',
     *' (16,5 dn.)',
     */' leg~e da`tsq u~ebA, matemaTiKA, prOgrAMMirOwAnie...'
     *//5X,'ritm fizi~eskoj aktiwnosti zdesx predsTAwlqET sObOj sisTEMu'
     */' ciklow: |mocionalxnogo, fizi~eskogo, intellektualxnogo,'
     */' a takve 3-h godi~nogo dlq muv~in i 2-h godi~nogo dlq ven}in.')
705   FORMAT(//5X,'BO BCEh tPeh ciklah (|,i,f) denx perehoda ot'
     */' polovitelxnoj polowiny perioda k otricatelxnoj'
     */' ili obratno nazywaetsq kriti~eskim dnem.'
     *//5X,'6 raz w god bywa`t dwojnye kriti~eskie dni'
     */' (sowpadenie perehodow dwuh raznyh ciklow)',
     *' i 1 raz w god - trojnye.')
703   FORMAT(//5X,'ven}iny podwerveny takvE "lunnomu ritmu".')
203   FORMAT(' pered polnoluniem (primerno za 7 dn., A inogda',
     *' i wo wremq ego)',
     *','/' u mnogih ven}in rastet razdravitelxnostx, snivaetsq',
     *' wynosliwostx,',
     */' Oni bystree usta`t, bolx{e nerwni~a`t, ispytywa`t tqgostnye',
     */' nastroeniq, A TO i wpAdA`T w depresCi`.')
	PRINT	203			!
	PRINT	777,	FORMF		!
777	FORMAT	(X,A1)			!
	CALL	CLOSE	(6)		!
	GOTO 10
	END
	SUBROUTINE NDAY(NM,ND,NY,NMT,NDT,NYT,N,K)
	KM=NMT
	KD=NDT
	KY=NYT
	K=1
41	IF(KD.EQ.1) GOTO 10
	KD=KD-1
	GOTO 31
10	GOTO(11,12,13,14,15,14,15,14,14,15,14,15),KM !
11	KM=13
	KD=31
	KY=KY-1
	GOTO 30
12	KD=31
	GOTO 30
13	KY1=KY
	KY1=(KY1/4)*4
	IF(KY1.EQ.KY) GOTO 23
	KD=28
	GOTO 24
23	KD=29
24	GOTO 30
14	KD=31
	GOTO 30
15	KD=30
30	KM=KM-1
31	IF(N.NE.1) GOTO 43
	N=8
43	N=N-1
	K=K+1
	GOTO 42
42	IF(KD.EQ.ND) GOTO 32
	GOTO 41
32	IF(KM.EQ.NM) GOTO 33
	GOTO 41
33	IF(KY.EQ.NY) GOTO 34
	GOTO 41
34	CONTINUE
	RETURN
	END
	SUBROUTINE NDY(NM,ND,NMT,NDT,NYT,N,K)
	KM=NMT
	KD=NDT
	KY=NYT
	K=1
41	IF(KD.EQ.1) GOTO 10
	KD=KD-1
	GOTO 31
10	GOTO(11,12,13,14,15,14,15,14,14,15,14,15),KM !
11	KM=13
	KD=31
	KY=KY-1
	GOTO 30
12	KD=31
	GOTO 30
13	KY1=KY
	KY1=(KY1/4)*4
	IF(KY1.EQ.KY) GOTO23
	KD=28
	GOTO 24
23	KD=29
24	GOTO 30
14	KD=31
	GOTO 30
15	KD=30
30	KM=KM-1
31	IF(N.NE.1) GOTO 43
	N=8
43	N=N-1
	K=K+1
	GOTO 42
42	IF(KD.EQ.ND) GOTO 32
	GOTO 41
32	IF(KM.EQ.NM) GOTO 33
	GOTO 41
33	CONTINUE
	GOTO 34
34	CONTINUE
	RETURN
	END
	SUBROUTINE PLOT(EM,EN,SUM,PH,WM,SZ,ND,NM,NDN,LUN)
	INTEGER*2 L1,L2,NDN0KS,KV,IN,IN1,IN2,IN3
     *,NDL,LL1,LL2
     *,KLN1,KLN2
     *,KSV,MN
	DIMENSION KLN1(2),KLN2(2)
	DIMENSION KPOLN1(2),KPOLN2(2)
	DIMENSION L1(49),L2(49),MN(2,12),NDL(7)
	DATA L1/49*2H  /,L2/49*2H  /
	DATA LL1/2H  /,LL2/2H  /
	DATA MN/2Hqn,2Hw ,2Hfe,2Hwr,2Hma,2Hrt,2Hap,2Hr ,2Hma,
     *2Hj ,2Hi`,2Hnx,2Hi`,2Hlx,2Haw,2Hg ,2Hse,2Hnt,2HOK,2Ht ,2Hno,
     *2Hqb,2Hde,2HK /
	DATA NDL/2HpH,2HBT,2Hsr,2H~t,2Hpt,2Hsb,2Hws/
	DATA KPOLN1/2Hpo,2HlH/
	DATA KPOLN2/2HOl,2Hun/
     *,IN5/2H++/,IN6/2H##/
	DATA KS/2H */,KV/2H**/,IN/2HII/,IN1/2Hii/,IN2/2H||/,IN3/2Hff/,
     *IN4/2H$$/
	DO 41 J=1,49
	L1(J)=LL1
41	L2(J)=LL2
	KLN1(1)=KPOLN1(1)
	KLN1(2)=KPOLN1(2)
	KLN2(1)=KPOLN2(1)
	KLN2(2)=KPOLN2(2)
	IF(LUN-8) 8,9,7
9	KLN1(1)=IN4
	KLN1(2)=IN4
	KLN2(1)=L1(1)
	KLN2(2)=L1(1)
	GOTO 11
7	IF(LUN-15) 9,11,8
8	KLN1(1)=L1(1)
	KLN2(2)=L1(1)
	KLN1(2)=L1(1)
	KLN2(1)=L2(2)
11	IF(NDN.EQ.6) GOTO 12
	IF(NDN.EQ.7) GOTO 13
	KSV=L1(1)
	GOTO 14
12	KSV=KS
	GOTO 14
13	KSV=KV
14	MI=(EN+1.0)*24.0+1.5
	ME=(EM+1.0)*24.0+1.5
	MS=(SUM+3.5)*7.0+0.5
	MH=(PH+1.0)*24.0+1.5
	MM=(WM+1.0)*24.0+1.5
	MZ=(SZ+1.0)*24.0+1.5
	L1(25)=IN
	L2(25)=IN
	L1(ME)=IN2
	L1(MI)=IN1
	L1(MH)=IN3
	L2(MM)=IN5
	L2(MZ)=IN6
	L2(MS)=KV
	DO 66 IM=1,49
	IF(L1(IM).NE.' ') GO TO 66
	L1(IM)=L2(IM)
66	CONTINUE
	PRINT 100,(L1(I),I=1,49),ND,
     *MN(1,NM),MN(2,NM),KSV,NDL(NDN),LUN,KLN1(1),KLN1(2),KLN2(1),
     *KLN2(2)
100	FORMAT(1X,49A1,12X,I2,4A2,1X,I2,4A2)
	RETURN
	END

