      SUBROUTINE SCAN                                                   4227

c	include 'tcommon.for'
	%include tcommon.for

      character*8 JCOND(4)
      DIMENSION IBAD(100,2)
	character*4 NUMS(9) ,ILET(2),JPQ(10,10)
	data nums/'1','2','3','4','5','6','7','8','9'/
      data ILET/'+','-'/
      data jcond/'GREEN','YELLOW','ORANGE',' RED'/

      DO 100   I=1,10                                                   4265
      DO 100    J=1,10                                                  4266
      JPQ(I,J)=LETR(9)                                                  4267
100   IPQ(I,J)=LETR(8)                                                  4268
      IF(IHERE.EQ.2)GO TO 1001                                          4269
      IF(IDMG(6).GT.0)GO TO 105                                         4270
C     CALL CPAGE                                                        4271
      WRITE(*,1)ICE,JCE                                                 4272
1     FORMAT(' SHORT RANGE SENSOR SCAN FOR QUADRANT ',I2,',',I2 )       4273
C     ...CALCULATE CURRENT RATING AND TIME RATIO.                       4274
      R=LEFTK+LEFTR                                                     4275
      S=NKL+MROM                                                        4276
      IR=(S-R)/S*1000.                                                  4277
      TRATE=XTIME/R                                                     4278
      KP=1                                                              4279
      IPLUSM=(TRATE-RTIME)/RTIME*100.                                   4280
      IF(IPLUSM.LT.0)KP=2                                               4281
      IPLUSM=IABS(IPLUSM)                                               4282
      WRITE(*,21)                                                       4283
105   IF(IHERE.GE.1)GO TO 1000                                          4284
C     ...RESET ARRAYS TO LOSE THINGS LEFT BEHIND.                       4285
9876  ETR(1)=0.                                                         4286
      EFP(1)=0.                                                         4287
      EFT(1,1)=0.                                                       4288
      ITORP=ITORP+ITFIRE                                                4289
      ITFIRE=0                                                          4290
      DO 2017 J=1,18                                                    4291
      ITKL(J)=0                                                         4292
2017  JTKL(J)=0                                                         4293
      ACTPJM=PJAM                                                       4294
      IF(ISTSH.EQ.0)GO TO 9873                                          4295
      ISTSH=0                                                           4296
      ISHD=0                                                            4297
      ISHNUM=ISHNUM-1                                                   4298
9873  DO 9872 J=1,9                                                     4299
9872  IFNDS(J)=0                                                        4300
      DO 9889 J=1,10                                                    4301
9889  ISHSTR(J)=0                                                       4302
      DO 9875 J=2,20                                                    4303
      ICNTL(J)=0                                                        4304
9875  ITRMEN(J)=0                                                       4305
      IF(ISTAT.NE.0)ISTAT=9999                                          4306
      DO 9874 J=1,30                                                    4307
9874  TORPS(J,1)=0.                                                     4308
      IF(ICLOAK.LT.0.AND.ION.EQ.1)GO TO 4646                            4309
      IX=XQE+.5                                                         4310
      IY=YQE+.5                                                         4311
      IPQ(IX,IY)=LETR(2)                                                4312
4646  IF(IDMG(6).EQ.0.OR.IDMG(7).EQ.0) IGAL(ICE,JCE)=JGAL(ICE,JCE)      4313
C     ...GET CONTENTS FROM JGAL                                         4314
      ICNTNT=JGAL(ICE,JCE)                                              4315
      NROM=ICNTNT/1000                                                  4316
      KLNGNS=ICNTNT/100-NROM*10                                         4317
      IBASE=(ICNTNT-ICNTNT/100*100)/10                                  4318
      NSTARS=ICNTNT-ICNTNT/10*10                                        4319
      NTORPS=0                                                          4320
      IGH=0                                                             4321
      IF(RAN(IZZ).LE.PRGH)IGH=1                                         4322
      IF(ICLOAK.EQ.2)ICLOAK=1                                           4323
      NBAD=0                                                            4324
C     ...EVERYTHING STARTS ON INTEGRAL COORDINATES                      4325
C     ...FLAG THOSE POINTS TOO NEAR TO E TO PUT OBJECTS.                4326
      DO 200    I=1,10                                                  4327
      DO 200    J=1,10                                                  4328
      DIST=(I-XQE)**2+(J-YQE)**2                                        4329
      IF(SQRT(DIST).GT.ESDIST)GO TO 200                                 4330
      NBAD=NBAD+1                                                       4331
      IBAD(NBAD,1)=I                                                    4332
      IBAD(NBAD,2)=J                                                    4333
200   CONTINUE                                                          4334
      IHOLE=0                                                           4335
      IF(IBL(ICE,JCE).EQ.0)GO TO 9877                                   4336
      CALL PUTIN(IHOLE,JHOLE,NBAD,IBAD,LETR(9))                         4337
9877  ISTORM=0                                                          4338
      IF(LEVEL.NE.3)GO TO 9879                                          4339
      PSTORM=(NSTARS**3)/1000.                                          4340
      IF(RAN(IZZ).GT.PSTORM)GO TO 9879                                  4341
      CALL PUTIN(ISTORM,JSTORM,NBAD,IBAD,LETR(8))                       4342
6534  FORMAT(' WARNING - NUCLEONIC DISTURBANCES SIGHTED IN QUADRANT.')  4343
C     ...PUT THINGS IN. NO TWO OBJECTS IN SAME PLACE.                   4344
9879  IF(KLNGNS.EQ.0)GO TO 300                                          4345
      DO 110    I=1,KLNGNS                                              4346
      CALL PUTIN(IX,IY,NBAD,IBAD,LETR(3))                               4347
      JPQ(IX,IY)=NUMS(I)                                                4348
      XKL(I,1)=IX                                                       4349
      XKL(I,2)=IY                                                       4350
      XKL(I,3)=0.                                                       4351
      XKL(I,4)=0.                                                       4352
      XKL(I,5)=0.                                                       4353
      XKL(I,6)=0.                                                       4354
      IX=RAN(IZZ)*XKFPST+NTSTPS+1                                       4355
      XKL(I,8)=IX                                                       4356
      XKL(I,7)=0.                                                       4357
C     ...RANDOM K CREW STRENGTH AROUND MEAN.                            4358
      IX=CREWK   +SIGN(RAN(IZZ)*25.,.5-RAN(IZZ))                        4359
      XKL(I,9)=IX                                                       4360
110   CONTINUE                                                          4361
300   IF(NROM.EQ.0)GO TO 150                                            4362
      JUMP=1                                                            4363
      IF(ICLOAK.EQ.1.AND.RAN(IZZ).LE.PRCLDN)JUMP=2                      4364
      DO 310    I=1,NROM                                                4365
      CALL PUTIN(IX,IY,NBAD,IBAD,LETR(4))                               4366
      IF(I.NE.1)GO TO 33305                                             4367
      IF(JUMP.EQ.2)GO TO 33307                                          4368
33305 SCR=SCREWR                                                        4369
      JPQ(IX,IY)=NUMS(I)                                                4370
      GO TO 33308                                                       4371
33307 SCR=SCREWR*1.33                                                   4372
      IPQ(IX,IY)=LETR(8)                                                4373
      ICLOAK=2                                                          4374
33308 XROM(I,1)=IX                                                      4375
      XROM(I,2)=IY                                                      4376
      XROM(I,3)=0.                                                      4377
C     ...RANDOM R CREW STRENGTH AROUND MEAN.                            4378
      IX=SCR+SIGN(RAN(IZZ)*35.,.5-RAN(IZZ))                             4379
      CREWR(I)=IX                                                       4380
      IX=RAN(IZZ)*XRFTS+NTSTPS                                          4381
      XROM(I,4)=IX                                                      4382
310   CONTINUE                                                          4383
150   IF(NSTARS.EQ.0)GO TO 170                                          4384
      DO 160 I=1,NSTARS                                                 4385
      CALL PUTIN(IX,IY,NBAD,IBAD,LETR(1))                               4386
      JPQ(IX,IY)=NUMS(I)                                                4387
      STARS(I,1)=IX                                                     4388
      STARS(I,2)=IY                                                     4389
      RAD(I)=RAN(IZZ)*.75+.25                                           4390
160   CONTINUE                                                          4391
170   IF(IGH.EQ.0)GO TO 180                                             4392
      CALL PUTIN(IX,IY,NBAD,IBAD,LETR(5))                               4393
      GHOST(1)=IX                                                       4394
      GHOST(2)=IY                                                       4395
      GHOST(3)=0.                                                       4396
      GHOST(4)=RAN(IZZ)*GHVMX                                           4397
      GHOST(6)=GHOST(4)                                                 4398
      GHOST(5)=RAN(IZZ)*360.                                            4399
      GHOST(7)=GHOST(5)                                                 4400
      GHOST(8)=0.                                                       4401
      GHOST(9)=0.                                                       4402
      GHOST(10)=0.                                                      4403
      GHOST(11)=RAN(IZZ)*GHEMX                                          4404
      IX=RAN(IZZ)*GHTMX+1.                                              4405
      GHOST(12)=IX                                                      4406
      GHOST(13)=0.                                                      4407
      IGHPH=1                                                           4408
      IF(RAN(IZZ).LE.PPHASD)IGHPH=0                                     4409
      IGHTR=1                                                           4410
      IF(RAN(IZZ).LE.PTORPD)IGHTR=0                                     4411
      IGHDR=1                                                           4412
      IF(RAN(IZZ).LE.PDRVD)IGHDR=0                                      4413
      IGHDE=1                                                           4414
      IF(RAN(IZZ).LE.PDEFD)IGHDE=0                                      4415
180   IF(IBASE.EQ.0)GO TO 1900                                          4416
      CALL PUTIN(IX,IY,NBAD,IBAD,LETR(6))                               4417
      BASE(1)=IX                                                        4418
      BASE(2)=IY                                                        4419
      MAXRQ=0                                                           4420
      IBMENR=RAN(IZZ)*SBMNR                                             4421
      GO TO 1900                                                        4422
1000  IF(IDMG(6).GT.0)RETURN                                            4423
C     ...ALREADY HERE. PUT THINGS IN THEIR PLACE ACCORDING TO PROPER    4424
C     ...HIERARCHY.                                                     4425
1001  IF(ISTSH.NE.99)GO TO 1010                                         4426
      IX=SHX+.5                                                         4427
      IY=SHY+.5                                                         4428
      IPQ(IX,IY)=LETR(12)                                               4429
C     ...TO SET UP IPQ FOR PRINTING QUAD IF ALREADY GENERATED.          4430
1010  IF(NTORPS.EQ.0)GO TO 1100                                         4431
      DO 1050      I=1,NTORPS                                           4432
      IF(TORPS(I,1).EQ.0.)GO TO 1050                                    4433
      IX=TORPS(I,1)+.5                                                  4434
      IY=TORPS(I,2)+.5                                                  4435
      IPQ(IX,IY)=LETR(7)                                                4436
1050  CONTINUE                                                          4437
      GO TO 1100                                                        4438
1300  IF(IBASE.EQ.0)GOTO 1200                                           4439
      IX=BASE(1)                                                        4440
      IY=BASE(2)                                                        4441
      IPQ(IX,IY)=LETR(6)                                                4442
1200  IF(IGH.EQ.0)GO TO 1550                                            4443
      IX=GHOST(1)   +.5                                                 4444
      IY=GHOST(2)   +.5                                                 4445
      IPQ(IX,IY)=LETR(5)                                                4446
      GO TO 1550                                                        4447
1500  IF(NROM.EQ.0)GOTO 1400                                            4448
      DO 1350    I=1,NROM                                               4449
      IF(XROM(I,1).EQ.0.)GO TO 1350                                     4450
      IF(ICLOAK.EQ.2.AND.IHERE.NE.2.AND.I.EQ.1)GO TO 1350               4451
      IX=XROM(I,1)                                                      4452
      IY=XROM(I,2)                                                      4453
      IPQ(IX,IY)=LETR(4)                                                4454
      JPQ(IX,IY)=NUMS(I)                                                4455
1350  CONTINUE                                                          4456
1400  IF(KLNGNS.EQ.0)GO TO 1900                                         4457
      DO 1450  I=1,KLNGNS                                               4458
      IF(XKL(I,1).EQ.0.)GO TO 1450                                      4459
      IX=XKL(I,1)+.5                                                    4460
      IY=XKL(I,2)+.5                                                    4461
      IPQ(IX,IY)=LETR(3)                                                4462
      JPQ(IX,IY)=NUMS(I)                                                4463
1450  CONTINUE                                                          4464
      GO TO 1900                                                        4465
1100  IX=XQE+.5                                                         4466
      IY=YQE+.5                                                         4467
      IF(ICLOAK.LT.0.AND.ION.EQ.1)GO TO 1300                            4468
      IPQ(IX,IY)=LETR(2)                                                4469
      GO TO 1300                                                        4470
1550  IF(NSTARS.EQ.0)GO TO 1500                                         4471
      DO 1600 I=1,NSTARS                                                4472
      IF(STARS(I,1).EQ.0.)GO TO 1600                                    4473
      IX=STARS(I,1)                                                     4474
      IY=STARS(I,2)                                                     4475
      IPQ(IX,IY)=LETR(1)                                                4476
      JPQ(IX,IY)=NUMS(I)                                                4477
1600  CONTINUE                                                          4478
      GO TO 1500                                                        4479
C     ...PRINTOUT AREA.                                                 4480
1900  ICOND=1                                                           4481
      IF(IDMG(6).GT.0)RETURN                                            4482
      IF(IHERE.EQ.2)RETURN                                              4483
      IGAL(ICE,JCE)=JGAL(ICE,JCE)                                       4484
      IF(ENERGY.LE.500.)ICOND=2                                         4485
      IF(NROM+KLNGNS.EQ.0)GO TO 1950                                    4486
      IF(KLNGNS.EQ.0)GO TO 1920                                         4487
      DO 1910 J=1,KLNGNS                                                4488
      IF(XKL(J,1).EQ.0..OR.ICNTL(J+1).EQ.1)GO TO 1910                   4489
      ICOND=3                                                           4490
      GO TO 1950                                                        4491
1910  CONTINUE                                                          4492
1920  IF(NROM.EQ.0)GO TO 1950                                           4493
      DO 1930 J=1,NROM                                                  4494
      IF(XROM(J,1).EQ.0..OR.ICNTL(J+10).EQ.1)GO TO 1930                 4495
      ICOND=3                                                           4496
      GO TO 1950                                                        4497
1930  CONTINUE                                                          4498
1950  IF(IHOLE.EQ.0)GO TO 1975                                          4499
      IPQ(IHOLE,JHOLE)=LETR(9)                                          4500
1975  IF(ICOND.EQ.3.AND.DEFL.EQ.0.)ICOND=4                              4501
      WRITE(*,11)(IPQ(I,10),JPQ(I,10),I=1,10),SDATE,XTIME               4502
      WRITE(*,12)(IPQ(I,9),JPQ(I,9),I=1,10),JCOND(ICOND)                4503
      WRITE(*,13)(IPQ(I,8),JPQ(I,8),I=1,10),XQE,YQE                     4504
      WRITE(*,14)(IPQ(I,7),JPQ(I,7),I=1,10),ENERGY                      4505
      WRITE(*,15)(IPQ(I,6),JPQ(I,6),I=1,10) ,ITORP                      4506
      WRITE(*,16)(IPQ(I,5),JPQ(I,5),I=1,10),LEFTK   ,LEFTR              4507
      WRITE(*,17)(IPQ(I,4),JPQ(I,4),I=1,10),MEN,ITRMEN(1)               4508
      WRITE(*,18)(IPQ(I,3),JPQ(I,3),I=1,10),DEFL                        4509
      WRITE(*,19)(IPQ(I,2),JPQ(I,2),I=1,10),PDEG,PSP                    4510
      WRITE(*,20)(IPQ(I,1),JPQ(I,1),I=1,10),IR,TRATE,ILET(KP),IPLUSM    4511
11    FORMAT(1X,20A1,5X,'STARDATE: ',F7.2,'  LEFT: ',F6.2)              4512
12    FORMAT(1X,20A1,5X,'CONDITION: ',A10)                              4513
13    FORMAT(1X,20A1,5X,'SHIP POSITION: ',F4.1,',',F4.1)                4514
14    FORMAT(1X,20A1,5X,'ENERGY: ',F8.2)                                4515
15    FORMAT(1X,20A1,5X,'TORPEDOS: ',I2)                                4516
16    FORMAT(1X,20A1,5X,'ENEMY LEFT(K,R): ',I3,',',I3)                  4517
17    FORMAT(1X,20A1,5X,'CREW: ',I4,' TROOPS: ',I4)                     4518
18    FORMAT(1X,20A1,5X,'DEFLECTOR POWER: ',F8.2)                       4519
19    FORMAT(1X,20A1,5X,'BEARING: ',F4.0,' SPEED: ',F5.3)               4520
20    FORMAT(1X,20A1,5X,'RATING: ',I3,' TIME RATIO: ',F4.2,'(',A1,I3,'%)4521
     1')                                                                4522
      WRITE(*,21)                                                       4523
21    FORMAT(' ------------------------------')                         4524
      IF(KLNGNS+NROM.LT.9.OR.IHERE.NE.0)GO TO 99998                     4525
      WRITE(*,65310)                                                    4526
65310 FORMAT(' WELCOME TO THE CONVENTION! HEH, HEH, HEH...')            4527
99998 IF(ISTORM.EQ.0.OR.IHERE.NE.0)GO TO 99999                          4528
      WRITE(*,6534)                                                     4529
99999 IF(IHERE.EQ.0)IHERE=1                                             4530
      RETURN                                                            4531
      END                                                               4532
5385
      read(*,*,err=8835,end=4321)iguess,jguess                          5386
      if(iguess.eq.xhelp)go t