SUBROUTINE TROOPM
C
C THIS SUBROUTINE HANDLES ENEMY TROOP TRANSPORT MOVES
C 
	INCLUDE 'EMPIRE.INC/NOLIST'
	INTEGER TTTC(-1:20,0:50)
	BYTE I100
C
	MONKEY=0
	NUMBER(5)=0
C	IF (CODER.EQ.5) TYPE 999
C999	FORMAT(' TROOP TRANSPORT CODES')
C 
	DO 2300 Y=1,LIMIT(13)
	CALL MAP(4)
	Z6=RLMAP(ITT2+Y)
	IF (Z6.EQ.0) GOTO 2300
	MONKEY=Y
	DIR=MOD(Y,2)*2-1		!SET DIR TO 1 OR -1 CONSISTENTLY
	CALL MAP(2)
	AB=RMAP(Z6)
	CALL MAP(8)
	H1=J1TS(ITT2H+Y)
	IF (AB.EQ.'X') H1=H1+1
	IF (H1.GT.3)    H1=3
C 
C NOW COMPUTE THE NUMBER OF ARMIES ABOARD THE TROOP TRANSPORT
C
	NUMARM=0
	CALL MAP(4)
	DO 100 I=1,LIMIT(9)
100	IF (Z6.EQ.RLMAP(IAR2+I)) NUMARM=NUMARM+1
	IF (NUMARM.GT.6) NUMARM=6		!MAX # ARMIES = 6
C 
	ORIG=Z6
	DO 2200 ITURN=1,2
	P=0
	Z7=Z6
	CALL MAP(2)
	AB=RMAP(Z6)
	IF ((ITURN.EQ.2).AND.(H1.LE.1)) GOTO 2300
C
C MOVE SELECTION
C
	CALL MAP(6)
	IFO=CODEFU(Y+ITT2-1500)
	ILA=CODELA(Y+ITT2-1500)
C 
C 300 IS THE STATEMENT NUMBER WHERE THE IFO AND ILA ARE
C PROCESSED TO COME UP WITH A MOVE, WHICH IS THEN FED THRU MOVCOR
C TO COME UP WITH A FINAL MOVE.
C 
C TAKE CARE OF DAMAGED SHIPS OR JUST REPAIRED SHIPS.
C (DAMAGED SHIPS WILL HAVE AN IFO OF 8)
C 
	IF (H1.LT.3) GOTO 200
	IF (IFO.EQ.8) IFO=0
	GOTO 300
200	IFO=8
	IF (ILA.EQ.0) GOTO 250
	CALL MAP(2)
	IF (RMAP(ILA).EQ.'X') GOTO 1300
250	ILA=IPORT(Z6)
	GOTO 1300
C 
C IFO=10: MOVE TOWARD UNEXPLORED TERRITORY, LOCATION SPECIFIED BY ILA
C IFO=7: MOVE IN A CONSTANT DIRECTION SPECIFIED BY ILA
C IFO=9: MOVE TOWARD AN UNOWNED CITY SPECIFIED BY ILA
C IFO=0-6: ILA SPECIFIES LOCATION OF WHERE TO MOVE, EITHER
C	AN ARMY PRODUCING CITY OR AN ARMY LOOKING FOR A 't'.
C	IT COULD ALSO BE A DIRECTION. IFO IS THE NUMBER OF ARMIES ON
C	BOARD THE TROOP TRANSPORT.
C 
300	IF (IFO.LT.7) IFO=NUMARM
	IF (NUMARM.EQ.0) IFO=0
	CALL MAP(1)
	IF ((IFO.EQ.10).AND.(EMAP(ILA).NE.' ')) GOTO 1000
	IF (IFO.EQ.10) GOTO 1300
	IF (IFO.EQ.7) GOTO 1350
	IF (IFO.NE.9) GOTO 500
C 
C IFO=9
C
	DO 400 I=1,70
	IF (TARGET(I).NE.ILA) GOTO 400
	MOVE=0
	IF ((ITURN.EQ.2).AND.(IDIST(Z6,ILA).EQ.1)) GOTO 1600
	GOTO 1300
400	CONTINUE
	IF ((IDIST(Z6,ILA).LT.10).AND.(EDGER(ILA).LT.8).AND.(RND(100).GT.10))
	1 GOTO 1300
C
C	IT SEEMS THAT IT'S TARGET IS NO LONGER ON THE HIT LIST,
C	MEANING IT WAS CAPTURED.
C 
500	IF (IFO.LE.2) GOTO 600
	IF (IFO.EQ.3) THEN
	 IF (RND(100).LT.96) GOTO 600
	ENDIF
	IF (IFO.EQ.4) THEN
	 IF (RND(100).LT.90) GOTO 600
	ENDIF
	GOTO 800			!SELECT A TARGET
C
C SELECT AN ARMY PRODUCING CITY AND MOVE TOWARDS IT.
C PICK THE CLOSEST ONE.
C
600	IF (ILA.EQ.0.OR.ILA.GT.500) GOTO 650
	CALL MAP(6)
	IF (CODEFU(ILA).NE.3) GOTO 650
	CALL MAP(4)
	IF (RLMAP(IAR2+ILA).NE.0) GOTO 1200
C	IF ((CODEFU(ILA).EQ.3).AND.(RLMAP(IAR2+ILA).NE.0)) GOTO 1200
650	AFLAG=0
	ID=35
670	DO 700 I=1,70
	IF ((X(I).EQ.0).OR.(OWNER(I).NE.2)) GOTO 700
	IF (EDGER(X(I)).EQ.0) GOTO 700
	IF ((AFLAG.EQ.0).AND.(PHASE(I).NE.1)) GOTO 700
	IF (IDIST(Z6,X(I)).GE.ID) GOTO 700
	DO 680 J=1,LIMIT(13)
	IF (J.EQ.Y) GOTO 680
	CALL MAP(6)
	IF (CODELA(J+ITT2-1500).NE.X(I)) GOTO 680
	CALL MAP(4)
	IF (IDIST(RLMAP(J+ITT2),X(I)).LE.2) GOTO 700
680	CONTINUE
	ID=IDIST(Z6,X(I))
	ILA=X(I)
700	CONTINUE
	IF (ID.NE.35) GOTO 1300
	IF (AFLAG.EQ.1) GOTO 1000
	AFLAG=1
	GOTO 670
C 
C PERFORM TROOP TRANSPORT TO TARGET CITY ASSIGNMENT
C
800	IF (NUMBER(10).EQ.0) GOTO 1000
	TM=0
	DO 820 I=1,LIMIT(13)
	CALL MAP(4)
	IF (RLMAP(ITT2+I).EQ.0) GOTO 820
	CALL MAP(6)
	IF (I.EQ.Y) GOTO 810
	IF (CODEFU(ITT2-1500+I).EQ.8) GOTO 820
	IF (CODEFU(ITT2-1500+I).LE.3) GOTO 820
810	TM=TM+1
	IF (CODEFU(ITT2-1500+I).EQ.9) CODEFU(ITT2-1500+I)=0
	TTTC(TM,0)=I
820	CONTINUE
	CM=0
	DO 840 I=1,NUMBER(10)
	IF (TARGET(I).EQ.0) GOTO 840
	ILA=TARGET(I)
	IF (EDGER(ILA).EQ.0) GOTO 840
	CM=CM+1
	TTTC(0,CM)=ILA
	TTTC(-1,CM)=-1
	CALL MAP(2)
	IF (RMAP(ILA).EQ.'O') TTTC(-1,CM)=1
840	CONTINUE
	IF (CM .EQ. 0) GOTO 1000
	CALL MAP(4)
	DO 850 I=1,TM
	DO 850 J=1,CM
	TTTC(I,J)=IDIST(RLMAP(ITT2+TTTC(I,0)),TTTC(0,J))
850	CONTINUE

	AC='*'
860	MIN=1000
	DO 880 I=1,TM
	IF (TTTC(I,0).EQ.0) GOTO 880
	DO 880 J=1,CM
	CALL MAP(1)
	IF (EMAP(TTTC(0,J)).NE.AC) GOTO 880
	IF (TTTC(I,J).GE.MIN) GOTO 880
	IF (TTTC(-1,J).EQ.0) THEN
	  DO 870 K=1,CM
	  IF (TTTC(-1,K).EQ.-1) GOTO 880
870	  CONTINUE
	ENDIF
	CALL MAP(4)
	MOVE=PATH(RLMAP(ITT2+TTTC(I,0)),TTTC(0,J),1,OKC,FLAG)
	IF (FLAG.EQ.0) THEN
	  TTTC(I,J)=1000
	  GOTO 880
	ENDIF
	MIN=TTTC(I,J)
	IR=I
	IC=J
880	CONTINUE
	IF (MIN.NE.1000) THEN  !DON'T CHANGE FUNCTION IF DEST IS <3 FROM OLD?
	  CALL MAP(6)
	  CODEFU(ITT2-1500+TTTC(IR,0))=9
	  CODELA(ITT2-1500+TTTC(IR,0))=TTTC(0,IC)
	  CALL MAP(4)
	  I20=RLMAP(ITT2+TTTC(IR,0))
	  CALL DIST(I20,TTTC(0,IC))
	  TTTC(IR,0)=0
	  TTTC(IR,IC)=1001
	  TTTC(-1,IC)=0
	  GOTO 860
	ENDIF
	CALL MAP(6)
	IFO=CODEFU(ITT2-1500+Y)
	ILA=CODELA(ITT2-1500+Y)
	IF (NUMBER(9)+NUMBER(10).LE.38) THEN
	  IF (IFO.EQ.9) GOTO 1500
	  GOTO 1000
	ENDIF
	IF (AC.EQ.'*') THEN
	  AC='O'
	  GOTO 860
	ENDIF
	IF (IFO.EQ.9) GOTO 1500
C 
C MOVE TOWARDS UNKNOWN TERRITORY
C
1000	IFO=10
	ILA=EXPL()
	IF (ILA.EQ.0) GOTO 1100
	CALL DIST(Z6,ILA)
	GOTO 1300
C 
C MOVE IN SPECIFIED DIRECTION (ILA SPECIFIES WHICH)
C
1100	IFO=7
	ILA=RND(8)+1				!**
	GOTO 1400
C 
C NOW PICK A MOVE ACCORDING TO IFO AND ILA
C
1200	MOVE=0
	CALL MAP(4)
	IF (IDIST(Z6,RLMAP(IAR2+ILA)).EQ.1) GOTO 1600
	MOVE=MOV(Z6,RLMAP(IAR2+ILA))
	GOTO 1500
1300	MOVE=PATH(Z6,ILA,DIR,OKC,FLAG)
	IF (FLAG.EQ.0) GOTO 1100
	GOTO 1500
1350	IF (NUMBER(10).EQ.0) GOTO 1400
	IF (RND(100).LT.40) GOTO 800
1400	MOVE=ILA
1500	AGGR=-NUMARM
	IF ((NUMBER(5).GT.10).AND.(NUMARM.EQ.0)) AGGR=AGGR+2
	EXPLOR=0
	IF (IFO.GT.6) EXPLOR=1
	MOVE=MOVE*DIR
	DEST=-1
	IF ((IFO.EQ.9).OR.(IFO.EQ.10)) DEST=ILA
	MOVE=MOVCOR(IFO,ITURN,Z6,MOVE,H1,1,AGGR,'t',EXPLOR,DIR,DEST,ORIG,3)
	MOVE=IABS(MOVE)
	IF (IFO.EQ.7) ILA=MOVE
1600	CALL MAP(6)
	CODEFU(ITT2-1500+Y)=IFO
	CODELA(ITT2-1500+Y)=ILA
	Z6=Z6+IARROW(MOVE+1)			!**
C	IF (CODER.EQ.5) TYPE 997, IFO,ILA
C997	FORMAT(1X,I)
C 
	CALL MAP(3)
	I100=OMAP(Z7)
	CALL MAP(2)
	IF (I100.NE.'*') RMAP(Z7)=I100
	IF (RMAP(Z6).EQ.'.') GOTO 1700
	IF (RMAP(Z6).EQ.'X') GOTO 1800
	CALL MAP(3)
	I100=OMAP(Z6)
	CALL MAP(2)
	IF ((RMAP(Z6).EQ.'+').OR.(I100.EQ.'*')) GOTO 1900
	AB=RMAP(Z6)
C	IF (CODER.EQ.5) TYPE 996,AB		!FIX THIS CONDITIONAL, KLUDGED
C996	FORMAT(' ATTACKING ',A1)
	IF (AB.EQ.'.') GOTO 1700
	P=1
	H2=30
	OWN1='t'
	OWN2=RMAP(Z6)
	CALL FIND(OWN2,Z6,Z8,H2)
	CALL FGHT(Z6,H1,H2,OWN1,OWN2)
	CALL FIND(OWN2,Z6,Z8,H2)
	IF (H1.LE.0) GOTO 1900
	CALL MAP(3)
	IF (OMAP(Z6).EQ.'+') GOTO 1900
	CALL MAP(8)
	J1TS(ITT2H+Y)=H1
1700	CALL MAP(2)
	RMAP(Z6)='t'
1800	CALL MAP(4)
	RLMAP(ITT2+Y)=Z6
	CALL MAP(8)
	J1TS(ITT2H+Y)=H1
	IF (ITURN.EQ.1) NUMBER(5)=NUMBER(5)+1
	GOTO 2000
1900	CALL MAP(4)
	RLMAP(ITT2+Y)=0
	CALL MAP(8)
	J1TS(ITT2H+Y)=0
2000	N=0
	IF (P.EQ.1) CALL SENSOR(Z6)
	CALL MAP(2)
	I100=RMAP(Z7)
	CALL MAP(4)
	DO 2100 U=IAR2+1,IAR2+LIMIT(9)
	IF (RLMAP(U).NE.Z7) GOTO 2100
	IF (N+1.GT.H1*2) THEN
	 IF (I100.NE.'X') RLMAP(U)=0
	 GOTO 2100
	ENDIF
	N=N+1
	RLMAP(U)=Z6
2100	CONTINUE
	IF (NUMARM.GT.2*H1) NUMARM=2*H1
	CALL SONAR(Z6)
2200	CONTINUE
2300	CONTINUE
	LIMIT(13)=MONKEY
	RETURN
	END
	SUBROUTINE DIST(Z6,ILA)
C
C THIS SUBROUTINE SETS AR2S SO THAT THE ARMY WON'T GET
C OFF THE TROOP TRANSPORT PREMATURELY
C 
	INCLUDE 'EMPIRE.INC/NOLIST'
C
	ID=2*IDIST(Z6,ILA)+1
	DO 100 L=1+IAR2,LIMIT(9)+IAR2
	CALL MAP(4)
	IF (RLMAP(L).NE.Z6) GOTO 100
	  CALL MAP(8)
	  AR2S(L-IAR2)=ID
100	CONTINUE
	RETURN
	END