DataMuseum.dk

top - metrics - download

    Length: 2256 (0x8d0)
    Types: TextFile
    Names: »sonar.f«

└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
    └─⟦this⟧ »EUUGD18/General/Empire/sonar.f« 

TextFile

	SUBROUTINE SONAR(Z6)
C
C UPDATES COMPUTER'S MAP AROUND LOCATION Z6
C
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C
C 
	DO 1300 I=1,8
	LOCUS=Z6+IARROW(I+1)
comment	**
	AB=RMAP(LOCUS)
	IF (AB.NE.EMAP(LOCUS)) EMAP(LOCUS)=AB
	IF ((AB.NE.'*').AND.(AB.NE.'O')) GOTO 400
	DO 100 I1=1,70
100	IF (TARGET(I1).EQ.LOCUS) GOTO 1300
	DO 200 I1=1,70
200	IF (TARGET(I1).EQ.0) GOTO 300
300	TARGET(I1)=LOCUS
400	IF ((AB.LT.'A').OR.(AB.GT.'T')) GOTO 1300
	IF (AB.NE.'A'.AND.AB.NE.'O') GOTO 1100
C 
C WE MUST NOW FIGURE OUT IF THE ARMY IS A THREAT TO ANY OF THE COMPUTER'S
C CITIES, I.E. IF IT IS ON THE CONTINENT WITH ANY OF THEM. IF SO, PUT
C THE ARMY IN THE LOCI ARRAY. THE FIRST INDEX IS THE CONTINENT, THE
C SECOND IS THE NTH ARMY DISCOVERED ON THAT CONTINENT - 1. THE (N,1)
C ARGUMENT IS THE DATE OF THE LAST ARMY DISCOVERED ON THE
C NTH CONTINENT. THUS WE HAVE A MEANS OF DETERMINING THE AGE OF THE DATA
C 
	ARMDEF=0
	DO 480 Y=1,LIMIT(9)
	IF (RLMAP(IAR2+Y).EQ.0) GOTO 480
	IF (IDIST(LOCUS,RLMAP(IAR2+Y)).GT.14) GOTO 480
	MOVE=PATH(RLMAP(IAR2+Y),LOCUS,1,OKA,FLAG)
	IF (FLAG.NE.0) ARMDEF=ARMDEF+1
480	CONTINUE
	IF (ARMDEF.GE.7) GOTO 520

	DO 500 K=1,70
	IF ((OWNER(K).NE.2).OR.(PHASE(K).EQ.1)) GOTO 500
	IF (FOUND(K)-MDATE-5.LE.0) GOTO 500
	IF (IDIST(X(K),LOCUS).GT.18) GOTO 500
	MOVE=PATH(X(K),LOCUS,1,OKA,FLAG)
	IF (FLAG.NE.0) PHASE(K)=-1
500	CONTINUE
C 
520	IF (AB.EQ.'O') GOTO 1300
	DO 600 K=1,10
	IF (LOCI(K,2).EQ.0) GOTO 600
	DO 550 J=2,11
	IF (LOCI(K,J).EQ.LOCUS) GOTO 800
550	CONTINUE
	MOVE=PATH(LOCUS,LOCI(K,2),1,OKA,FLAG)
	J=11
	IF (FLAG.NE.0) GOTO 800
600	CONTINUE

	DO 700 K=1,10
700	IF (LOCI(K,2).EQ.0) GOTO 760

	OLDEST=10000
	DO 750 J=1,10
	IF (LOCI(J,1).LT.OLDEST) THEN
	  OLDEST=LOCI(J,1)
	  K=J
	ENDIF
750	CONTINUE
760	DO 770 J=2,11
770	LOCI(K,J)=0
	GOTO 1000

800	DO 900 J=J,3,-1
900	LOCI(K,J)=LOCI(K,J-1)
comment	SHIFT EVERYTHING UP THE ARRAY
1000	LOCI(K,1)=MDATE
	LOCI(K,2)=LOCUS
	GOTO 1300
C 
1100	ISHIPT=0
	IF (AB.EQ.'D') ISHIPT=1
	IF (AB.EQ.'S') ISHIPT=2
	IF (AB.EQ.'T') ISHIPT=3
	IF (AB.EQ.'R') ISHIPT=4
	IF (AB.EQ.'C') ISHIPT=5
	IF (AB.EQ.'B') ISHIPT=6
	IF (ISHIPT.EQ.0) GOTO 1300
	DO 1200 IB=1,4
1200	TROOPT(ISHIPT,IB)=TROOPT(ISHIPT,IB+1)
	TROOPT(ISHIPT,5)=LOCUS
1300	CONTINUE
	EMAP(Z6)=RMAP(Z6)
	IF (CODER.EQ.10) CALL SENSOR(Z6)
	RETURN
	END