home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / BHOLE.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  5.8 KB  |  81 lines
  1.  
  2.       SUBROUTINE BHOLE                                                  0222
  3. C     ...GRAVITATIONAL EFFECTS OF BLACK HOLES. HGRAV                    0223
  4. C     ...IS GRAVITATIONAL CONSTANT. ONLY E,K,G,T ARE EFFECTED.          0224
  5.  
  6. c    include 'tcommon.for'
  7.     %include tcommon.for
  8.  
  9.       DATA HGRAV/.6/                                                    0244
  10.       X=IHOLE                                                           0245
  11.       Y=JHOLE                                                           0246
  12.       IF(IDOCK.EQ.2)GO TO 50                                            0247
  13.       CALL GETBRG(DELTA,XQE,X,YQE,Y,VPX,VPY)                            0248
  14.       D=VPX*VPX+VPY*VPY                                                 0249
  15.       DX=COSD(DELTA)*HGRAV/D                                            0250
  16.       DY=SIND(DELTA)*HGRAV/D                                            0251
  17.       XQE=XQE+DX                                                        0252
  18.       YQE=YQE+DY                                                        0253
  19.       DX=DX+COSD(PDEG)*PSP                                              0254
  20.       DY=DY+SIND(PDEG)*PSP                                              0255
  21.       PRSPD=PSP                                                         0256
  22.       PRDEG=PDEG                                                        0257
  23.       PSP=SQRT(DX*DX+DY*DY)                                             0258
  24.       CALL GETBRG(PDEG,0.,DX,0.,DY,VPX,VPY)                             0259
  25.       IF(DSP.EQ.PRSPD)DSP=PSP                                           0260
  26.       IF(DDEG.EQ.PRDEG)DDEG=PDEG                                        0261
  27. 50    IF(IGH.EQ.0)GO TO 100                                             0262
  28.       CALL GETBRG(DELTA,GHOST(1),X,GHOST(2),Y,VPX,VPY)                  0263
  29.       D=VPX*VPX+VPY*VPY                                                 0264
  30.       DX=COSD(DELTA)*HGRAV/D                                            0265
  31.       DY=SIND(DELTA)*HGRAV/D                                            0266
  32.       GHOST(1)=GHOST(1)+DX                                              0267
  33.       GHOST(2)=GHOST(2)+DY                                              0268
  34.       DX=DX+COSD(GHOST(5))*GHOST(4)                                     0269
  35.       DY=DY+SIND(GHOST(5))*GHOST(4)                                     0270
  36.       PRSPD=GHOST(4)                                                    0271
  37.       PRDEG=GHOST(5)                                                    0272
  38.       GHOST(4)=SQRT(DX*DX+DY*DY)                                        0273
  39.       CALL GETBRG(GHOST(5),0.,DX,0.,DY,VPX,VPY)                         0274
  40.       IF(GHOST(6).EQ.PRSPD)GHOST(6)=GHOST(4)                            0275
  41.       IF(GHOST(7).EQ.PRDEG)GHOST(7)=GHOST(5)                            0276
  42. 100   IF(KLNGNS.EQ.0)GO TO 200                                          0277
  43.       DO 150 J=1,KLNGNS                                                 0278
  44.       IF(XKL(J,1).EQ.0.)GO TO 150                                       0279
  45.       CALL GETBRG(DELTA,XKL(J,1),X,XKL(J,2),Y,VPX,VPY)                  0280
  46.       D=VPX*VPX+VPY*VPY                                                 0281
  47.       DX=COSD(DELTA)*HGRAV/D                                            0282
  48.       DY=SIND(DELTA)*HGRAV/D                                            0283
  49.       XKL(J,1)=XKL(J,1)+DX                                              0284
  50.       XKL(J,2)=XKL(J,2)+DY                                              0285
  51.       DX=DX+COSD(XKL(J,4))*XKL(J,3)                                     0286
  52.       DY=DY+SIND(XKL(J,4))*XKL(J,3)                                     0287
  53.       PRSPD=XKL(J,3)                                                    0288
  54.       PRDEG=XKL(J,4)                                                    0289
  55.       XKL(J,3)=SQRT(DX*DX+DY*DY)                                        0290
  56.       CALL GETBRG(XKL(J,4),0.,DX,0.,DY,VPX,VPY)                         0291
  57.       IF(XKL(J,5).EQ.PRSPD)XKL(J,5)=XKL(J,3)                            0292
  58.       IF(XKL(J,6).EQ.PRDEG)XKL(J,6)=XKL(J,4)                            0293
  59. 150   CONTINUE                                                          0294
  60. 200   IF(NTORPS.EQ.0)GO TO 999                                          0295
  61.       DO 250 J=1,NTORPS                                                 0296
  62.       IF(TORPS(J,1).EQ.0.)GO TO 250                                     0297
  63.       ZPLUS=0.                                                          0298
  64.       IF(TORPS(J,4).LT.0.)ZPLUS=-360.                                   0299
  65.       IF(TORPS(J,4).GE.360.)ZPLUS=360.                                  0300
  66.       CALL GETBRG(DELTA,TORPS(J,1),X,TORPS(J,2),Y,VPX,VPY)              0301
  67.       D=VPX*VPX+VPY*VPY                                                 0302
  68.       DX=COSD(DELTA)*HGRAV/D                                            0303
  69.       DY=SIND(DELTA)*HGRAV/D                                            0304
  70.       TORPS(J,1)=TORPS(J,1)+DX                                          0305
  71.       TORPS(J,2)=TORPS(J,2)+DY                                          0306
  72.       DX=DX+COSD(TORPS(J,4))*TORPS(J,3)                                 0307
  73.       DY=DY+SIND(TORPS(J,4))*TORPS(J,3)                                 0308
  74.       TORPS(J,3)=SQRT(DX*DX+DY*DY)                                      0309
  75.       CALL GETBRG(TORPS(J,4),0.,DX,0.,DY,VPX,VPY)                       0310
  76.       IF(TORPS(J,4).LT.ZPLUS)TORPS(J,4)=TORPS(J,4)+360.                 0311
  77.       IF(TORPS(J,4).GE.ZPLUS+360.)TORPS(J,4)=TORPS(J,4)-360.            0312
  78. 250   CONTINUE                                                          0313
  79. 999   RETURN                                                            0314
  80.       END                                                               0315
  81.