diff options
Diffstat (limited to 'PALICE.FOR')
| -rw-r--r-- | PALICE.FOR | 80 |
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 + + |