summaryrefslogtreecommitdiffstats
path: root/PALICE.FOR
diff options
context:
space:
mode:
authorAnton Šijanec <sijanecantonluka@gmail.com>2020-03-30 15:24:15 +0200
committerAnton Šijanec <sijanecantonluka@gmail.com>2020-03-30 15:24:15 +0200
commit37fc0b25d852dba0ce7a329678c5c30a028be00f (patch)
tree80e58fb4000efc4fcf3f7afccbda0f4a6a48f93b /PALICE.FOR
downloadZVEZDE-37fc0b25d852dba0ce7a329678c5c30a028be00f.tar
ZVEZDE-37fc0b25d852dba0ce7a329678c5c30a028be00f.tar.gz
ZVEZDE-37fc0b25d852dba0ce7a329678c5c30a028be00f.tar.bz2
ZVEZDE-37fc0b25d852dba0ce7a329678c5c30a028be00f.tar.lz
ZVEZDE-37fc0b25d852dba0ce7a329678c5c30a028be00f.tar.xz
ZVEZDE-37fc0b25d852dba0ce7a329678c5c30a028be00f.tar.zst
ZVEZDE-37fc0b25d852dba0ce7a329678c5c30a028be00f.zip
Diffstat (limited to 'PALICE.FOR')
-rw-r--r--PALICE.FOR80
1 files changed, 80 insertions, 0 deletions
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
+
+