SUBROUTINE MASKEF(X,Y,XQ,YQ,PHCRD) 2417 c include 'tcommon.for' %include tcommon.for DIMENSION ATENF(5) 2437 DATA ATENF/100.,30.,25.,50.,500./ 2438 C ...OBJECT AT XQ,YQ IS PHASING OBJECT AT X,Y. 2439 C ...PHCRD WILL BE % REDUCTION DUE TO MASKING. 2440 C ...INTERVENING OBJECTS AND THEIR RELATIVE MASKING EFFECTS: 2441 C ... * 100 2442 C ... K,R 30 2443 C ... G 25 2444 C ... HOLE500 2445 PHCRD=0. 2446 LNDX=1 2447 SUMAX=0. 2448 SUMACT=0. 2449 IF(NSTARS.EQ.0)GO TO 100 2450 DO 50 I=1,NSTARS 2451 IF(STARS(I,1).EQ.0)GO TO 50 2452 CALL GETBRG(A1,XQ,STARS(I,1),YQ,STARS(I,2),VPX,VPY) 2453 CALL GETBRG(A2,STARS(I,1),X,STARS(I,2),Y,VPX,VPY) 2454 D1=VPX*VPX+VPY*VPY 2455 D2=0. 2456 IF(A1.NE.0.)D2=360.-A1 2457 A2=A2+D2 2458 IF(A2.GE.360.)A2=A2-360. 2459 IF(A2.GE.45..AND.A2.LE.315.)GO TO 50 2460 SUMAX=SUMAX+ATENF(LNDX) 2461 D2=SIND(A2) 2462 D2=1.-D2*D2 2463 D2=D2/2.+RAD(I)/(D1+D1) 2464 IF(D2.GT.1.)D2=1. 2465 SUMACT=SUMACT+D2*ATENF(LNDX) 2466 50 CONTINUE 2467 100 IF(KLNGNS.EQ.0)GO TO 200 2468 LNDX=2 2469 DO 150 I=1,KLNGNS 2470 IF(XKL(I,1).EQ.0)GO TO 150 2471 IF(XKL(I,1).EQ.X.AND.XKL(I,2).EQ.Y)GO TO 150 2472 IF(XKL(I,1).EQ.XQ.AND.XKL(I,2).EQ.YQ)GO TO 150 2473 CALL GETBRG(A1,XQ,XKL(I,1),YQ,XKL(I,2),VPX,VPY) 2474 CALL GETBRG(A2,XKL(I,1),X,XKL(I,2),Y,VPX,VPY) 2475 D1=VPX*VPX+VPY*VPY 2476 D2=0. 2477 IF(A1.NE.0.)D2=360.-A1 2478 A2=A2+D2 2479 IF(A2.GE.360.)A2=A2-360. 2480 IF(A2.GE.45..AND.A2.LE.315.)GO TO 150 2481 SUMAX=SUMAX+ATENF(LNDX) 2482 D2=SIND(A2) 2483 D2=1.-D2*D2 2484 D2=D2/2.+RADKK/(D1+D1) 2485 IF(D2.GT.1.)D2=1. 2486 SUMACT=SUMACT+D2*ATENF(LNDX) 2487 150 CONTINUE 2488 200 IF(NROM.EQ.0)GO TO 300 2489 LNDX=2 2490 DO 250 I=1,NROM 2491 IF(XROM(I,1).EQ.0)GO TO 250 2492 IF(XROM(I,1).EQ.X.AND.XROM(I,2).EQ.Y)GO TO 250 2493 CALL GETBRG(A1,XQ,XROM(I,1),YQ,XROM(I,2),VPX,VPY) 2494 CALL GETBRG(A2,XROM(I,1),X,XROM(I,2),Y,VPX,VPY) 2495 D1=VPX*VPX+VPY*VPY 2496 D2=0. 2497 IF(A1.NE.0.)D2=360.-A1 2498 A2=A2+D2 2499 IF(A2.GE.360.)A2=A2-360. 2500 IF(A2.GE.45..AND.A2.LE.315.)GO TO 250 2501 SUMAX=SUMAX+ATENF(LNDX) 2502 D2=SIND(A2) 2503 D2=1.-D2*D2 2504 D2=D2/2.+RADKK/(D1+D1) 2505 IF(D2.GT.1.)D2=1. 2506 SUMACT=SUMACT+D2*ATENF(LNDX) 2507 250 CONTINUE 2508 300 IF(IGH.EQ.0)GO TO 400 2509 IF(GHOST(1).EQ.XQ.AND.GHOST(2).EQ.YQ)GO TO 400 2510 LNDX=3 2511 CALL GETBRG(A1,XQ,GHOST(1),YQ,GHOST(2),VPX,VPY) 2512 CALL GETBRG(A2,GHOST(1),X,GHOST(2),Y,VPX,VPY) 2513 D1=VPX*VPX+VPY*VPY 2514 D2=0. 2515 IF(A1.NE.0.)D2=360.-A1 2516 A2=A2+D2 2517 IF(A2.GE.360.)A2=A2-360. 2518 IF(A2.GE.45..AND.A2.LE.315.)GO TO 400 2519 SUMAX=SUMAX+ATENF(LNDX) 2520 D2=SIND(A2) 2521 D2=1.-D2*D2 2522 D2=D2/2.+RADEG/(D1+D1) 2523 IF(D2.GT.1.)D2=1. 2524 SUMACT=SUMACT+D2*ATENF(LNDX) 2525 400 IF (IBASE.EQ.0)GO TO 500 2526 LNDX=4 2527 CALL GETBRG(A1,XQ,BASE(1),YQ,BASE(2),VPX,VPY) 2528 CALL GETBRG(A2,BASE(1),X,BASE(2),Y,VPX,VPY) 2529 D1=VPX*VPX+VPY*VPY 2530 D2=0. 2531 IF(A1.NE.0.)D2=360.-A1 2532 A2=A2+D2 2533 IF(A2.GE.360.)A2=A2-360. 2534 IF(A2.GE.45..AND.A2.LE.315.)GO TO 500 2535 SUMAX=SUMAX+ATENF(LNDX) 2536 D2=SIND(A2) 2537 D2=1.-D2*D2 2538 D2=D2/2.+RADEB/(D1+D1) 2539 IF(D2.GT.1.)D2=1. 2540 SUMACT=SUMACT+D2*ATENF(LNDX) 2541 500 IF(IHOLE.EQ.0)GO TO 999 2542 LNDX=5 2543 XX=IHOLE 2544 YY=JHOLE 2545 CALL GETBRG(A1,XQ,XX,YQ,YY,VPX,VPY) 2546 CALL GETBRG(A2,XX,X,YY,Y,VPX,VPY) 2547 D1=VPX*VPX+VPY*VPY 2548 D2=0. 2549 IF(A1.NE.0.)D2=360.-A1 2550 A2=A2+D2 2551 IF(A2.GE.360.)A2=A2-360. 2552 IF(A2.GE.45..AND.A2.LE.315.)GO TO 999 2553 SUMAX=SUMAX+ATENF(LNDX) 2554 D2=SIND(A2) 2555 D2=1.-D2*D2 2556 D2=D2/2.+HOLRAD/(D1) 2557 IF(D2.GT.1.)D2=1. 2558 SUMACT=SUMACT+D2*ATENF(LNDX) 2559 999 IF(SUMAX.EQ.0.)GO TO 1000 2560 PHCRD=SUMACT/SUMAX 2561 1000 RETURN 2562 END 2563  IF(IX.GT.10)JX=1 39