From 37fc0b25d852dba0ce7a329678c5c30a028be00f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Anton=20=C5=A0ijanec?= <sijanecantonluka@gmail.com>
Date: Mon, 30 Mar 2020 15:24:15 +0200
Subject: initial commit

---
 PALICE.FOR | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)
 create mode 100644 PALICE.FOR

(limited to 'PALICE.FOR')

diff --git a/PALICE.FOR b/PALICE.FOR
new file mode 100644
index 0000000..61e19ee
--- /dev/null
+++ b/PALICE.FOR
@@ -0,0 +1,80 @@
+	SUBROUTINE PALICE(IZV,N,IVRSTA,IPALIC,IZMA,KON)
+	DIMENSION IZV(1),IPA(100)
+	IZMA=0
+	IMAK=0
+	KON=0
+	ISOTIC=0
+	DO 10 I=1,N
+	IF(IZV(I).GE.IMAK) THEN
+	IVMAK=I
+	IMAK=IZV(I)
+	ENDIF
+	ISOTIC=ISOTIC+IZV(I)
+10	IPA(I)=IZV(I)
+	IF(IMAK.EQ.0) THEN
+	IZMA=1
+	KON=1
+	RETURN
+	ENDIF
+	IF(ISOTIC.EQ.0) KON=1
+	J=0
+	KODA=0
+	DO 20 I=1,N
+20	IF(IZV(I).GE.2) J=J+1
+	IF(J.EQ.1) KODA=1
+	IF(J.EQ.0) KODA=2
+	LL=0
+	DO 21 L=1,N
+	IF(IPA(L).GT.0) LL=LL+1
+21	CONTINUE
+	ICC=MOD(LL,2)
+	IF((KODA.EQ.1).AND.(IMAK.GT.1)) THEN
+	IF(ICC.EQ.0) THEN
+	IVRSTA=IVMAK
+	IPALIC=IMAK
+	IZMA=1
+	RETURN
+	ELSE
+	IVRSTA=IVMAK
+	IPALIC=IMAK-1
+	IZMA=1
+	RETURN
+	ENDIF
+	ENDIF
+	DO 30 I=1,N
+	IF(IPA(I).EQ.0) GO TO 30
+	DO 25 J=1,IMAK
+	IPA(I)=IPA(I)-J
+	IF(IPA(I).EQ.-1) THEN
+	IPA(I)=IPA(I)+J
+	GO TO 30
+	ENDIF
+	CALL SRC(IPA,N,IND)
+	IF((KODA.EQ.0).AND.(IND.EQ.0)) THEN
+	IVRSTA=I
+	IPALIC=J
+	IZMA=1
+	RETURN
+	ENDIF
+25	IPA(I)=IPA(I)+J
+30	CONTINUE
+	IF((KODA.EQ.2).AND.(ICC.EQ.0)) IZMA=1
+C	IVRSTA=IVMAK
+C	IPALIC=1
+	CALL GETTIM(LU,LM,LS,L)
+	IZN=1
+	J=MOD(L,N)+1
+40	IF(IPA(J).EQ.0) J=J+IZN
+	IF(J.GT.N) THEN
+	IZN=-1
+	J=J-1
+	GO TO 40
+	ENDIF
+	IF(IPA(J).NE.0) GO TO 50
+	GO TO 40
+50	IVRSTA=J
+	IPALIC=1
+	RETURN
+	END
+
+
-- 
cgit v1.2.3