      SUBROUTINE FCOPY(ID,IF)                                           00086440
      RETURN                                                            00086450
      END                                                               00086460
      SUBROUTINE  AUTBND(IES,NUMNP,NMP,NML,NUMEL,NUMEL2)                00019870
      IMPLICIT REAL*8(A-H,O-Z)                                          00019880
      REAL*8  NPAR                                                      00019890
      COMMON A(1)                                                       00019900
      COMMON /ELPAR/ NPAR(14),NUMN ,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00019910
     & ,RRELPA(24)                                                      R0019911
      DIMENSION C(3),ST(3)                                              00019920
      COMMON/TRASH/ ND(100), COSN(100,3),RRTRAS(140)                    R0019930
      COMMON/JUNK/NSN,I,D,J,K,L,II,NSN1,NC,NDOF,N6,DF,N,LX,JL,J1,L1,IL, 00019940
     & RRJUNK(217)                                                      R0019941
      DATA C/2HNM,2HND,2HNR/                                            00019950
      REWIND 1                                                          00019960
      NSN1=0                                                            00019970
      II=1                                                              00019980
      NZ=NUMNP                                                          00019990
      NMP=NUMNP+1                                                       00020000
      CALL CNSTR2 (0,NMP,A(1),NZ,NC,NUMEL2,JL,ND, COSN,NS,ST)           00020010
      NML=NUMEL                                                         00020020
  100 READ(5,110)NSN,D,ST                                               00020030
      IF(NSN.EQ.0) RETURN                                               00020040
  110 FORMAT( I5,A2,3X,3F10.0)                                          00020050
                                                                        00020060
      NC=0                                                              00020070
      NS=0                                                              00020080
      DO 120 I=1,3                                                      00020090
      IF(ST(I).NE.0.0) NS=1                                             00020100
      IF(D.EQ.C(I)) NC=I                                                00020110
  120 CONTINUE                                                          00020120
      IF(NC.EQ.0) WRITE(6,130)NSN                                       00020130
      IF(NC.EQ.1) WRITE(6,140)NSN                                       00020140
      IF(NC.EQ.2) WRITE(6,150)NSN                                       00020150
      IF(NC.EQ.3) WRITE(6,160)NSN                                       00020160
  130 FORMAT (1H0,20X,33H NO CONSTRAINTS SPEC. FOR SURFACE,I5)          00020170
  140 FORMAT (1H0,20X,31H  CONSTRAINTS SPEC. FOR SURFACE,I5,7H ------,  00020180
     $15HNO MOTION------)                                               00020190
  150 FORMAT (1H0,20X,31H  CONSTRAINTS SPEC. FOR SURFACE,I5,7H ------,  00020200
     $18HNO DISPLACEMENT---)                                            00020210
  160 FORMAT (1H0,20X,31H  CONSTRAINTS SPEC. FOR SURFACE,I5,7H ------,  00020220
     $15HNO ROTATION----)                                               00020230
      IF(NC.EQ.0) GO TO 100                                             00020240
      IF(NSN.LE.NSN1) REWIND 1                                          00020250
      IF(NSN.LE.NSN1) II=1                                              00020260
      NSN1=NSN                                                          00020270
      DO  180 I=II,IES                                                  00020280
      IL=I                                                              00020290
      READ (1) J1,L1                                                    00020300
      LX=L1/100+1                                                       00020310
      IF(NSN.EQ.J1)  GO TO 190                                          00020320
      DO  170 J=1,LX                                                    00020330
      JL=100                                                            00020340
      IF(J.EQ.LX)  JL=L1-(LX-1)*100                                     00020350
      READ (1) (ND(K),( COSN(K,M),M=1,3),K=1,JL)                        00020360
  170 CONTINUE                                                          00020370
  180 CONTINUE                                                          00020380
  190 II=IL                                                             00020390
      IF(NSN.EQ.J1) GO TO 210                                           00020400
      WRITE(6,200)NSN                                                   00020410
  200 FORMAT (1X ,20X,44H NO DIRECTION COSINES COULD BE FOUND FOR SUR,  00020420
     $4HFACE,I5)                                                        00020430
      GO TO 100                                                         00020440
  210 DO 250 I=1,LX                                                     00020450
      JL=100                                                            00020460
      IF(I.EQ.LX)  JL=L1-(LX-1)*100                                     00020470
      READ (1) (ND(K),( COSN(K,M),M=1,3),K=1,JL)                        00020480
      DO  240 J=1,JL                                                    00020490
      NDOF=0                                                            00020500
      DO 220 K=1,3                                                      00020510
      DF=  DABS( COSN(J,K) )                                            00020520
      IF(DF.GT.0.999)NDOF=K                                             00020530
  220 CONTINUE                                                          00020540
      IF(NS.EQ.1) NDOF=0                                                00020550
      IF(NDOF.EQ.0) NMP=NMP+1                                           00020560
      N6=NMP*3+ 1                                                       00020570
      IF(N6.LT.MTOT) GO TO  240                                         00020580
      WRITE(6,230)NSN                                                   00020590
  230 FORMAT (1X ,20X,43HTHERE ARE TOO MANY NODES REQUIRING BOUNDARY,/, 00020600
     $20X,48HELEMENTS. MANUAL GENERATION OF BOUNDARY ELEMENTS/,20X      00020610
     $,45HMAY BE REQUIRED. EXECUTION STOPPED ON SURFACE,I5)             00020620
      CALL CLOSE                                                        00020630
      CALL EXIT                                                         00020640
  240 CONTINUE                                                          00020650
      CALL CNSTR2 (1,NMP,A(1),NZ,NC,NUMEL2,JL,ND, COSN,NS,ST)           00020660
  250 CONTINUE                                                          00020670
      GO TO 100                                                         00020680
      END                                                               00020690
      SUBROUTINE CNSTR2(KK,NMZ,ID,N,NC,NUMEL2,JL,ND, COSN,NS,ST)        00045020
      IMPLICIT REAL*8(A-H,O-Z)                                          00045030
      REAL*8  ID                                                        00045040
      DIMENSION  ID(NMZ,3)                                              00045050
      DIMENSION X(3) ,ND(100), COSN(100,3)                              00045060
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7)                       R0045070
      COMMON/JUNK/ DUM(100),          NM,I,Z(5),J,NRJUNK(241)           R0045080
      DIMENSION Y(3),ST(3)                                              00045090
      REWIND 8                                                          00045100
      READ (8)  ((ID(I,J),J=1,3),I=1,N)                                 00045110
      IF(KK.GT.0) GO TO 110                                             00045120
      NM=NMZ                                                            00045130
      XAD1I=1.0+XAD+I1                                                  00045140
      DO 100 I=1,3                                                      00045150
  100 ID(NM,I)=XAD1I                                                    00045160
      GO TO 170                                                         00045170
  110 NMP=N                                                             00045180
      DO 160 J=1,JL                                                     00045190
      NDOF=0                                                            00045200
      DO 120 K=1,3                                                      00045210
      Y(K)=ST(K)                                                        00045220
      DF=  DABS( COSN(J,K) )                                            00045230
      IF(DF.GT.0.999)NDOF=K                                             00045240
  120 X(K)= COSN(J,K)                                                   00045250
      N=ND(J)                                                           00045260
      IF(NS.EQ.1) NDOF=0                                                00045270
  130 IF(NDOF.GT.0) GO TO 150                                           00045280
      NMP=NMP+1                                                         00045290
      SC=01.                                                            00045300
      IF(NC.EQ.1) SC=11.                                                00045310
      IF(NC.EQ.2) SC=10.                                                00045320
      DO 140 I=1,3                                                      00045330
  140 ID(NMP,I)= X(I)/XMX+XAD+1.0+I1                                    00045340
      NUMEL2=NUMEL2+1                                                   00045350
      Z(1)=N                                                            00045360
      Z(2)=NM                                                           00045370
      Z(3)=NMP                                                          00045380
      Z(4)=0                                                            00045390
      Z(5)=0                                                            00045400
      WRITE (9) Z,SC,Y                                                  00045410
      GO TO 160                                                         00045420
  150 NN=ID(N,NDOF)                                                     00045430
      I=I1                                                              00045440
      IF(NC.EQ.1) I=I+1                                                 00045450
      IF(NC.EQ.2) I=1                                                   00045460
      IF(NN.EQ.1.AND.I.EQ.I1) I=I1+1                                    00045470
      IF( I.EQ.1.AND.NN.EQ.I1)I=I1+1                                    00045480
      IF(NN.GT.I1) I=NN                                                 00045490
      ID(N,NDOF) =(ID(N,NDOF)-NN)+I                                     00045500
  160 CONTINUE                                                          00045510
  170 CONTINUE                                                          00045520
      REWIND 8                                                          00045530
      NMP=NMZ                                                           00045540
      N=NMP                                                             00045550
      WRITE (8) ((ID(I,J),J=1,3),I=1,NMP)                               00045560
      RETURN                                                            00045570
      END                                                               00045580
      SUBROUTINE AUTPR(NUMEL,ID2,IES,ID4,NADEL,NADND)                   00020700
      IMPLICIT REAL*8(A-H,O-Z)                                          00020710
      REAL*8  ID2                                                       00020720
      REAL*8  ID4                                                       00020730
      DIMENSION ID4(NADEL,NADND)                                        00020740
      DIMENSION ID2(NUMEL,5)                                            00020750
      COMMON/JUNK/I,J,K,N,J1,J2,J3,J4,NPT,NSN,NSN1,II,IL,LX,KM,NNN,NN1, R0020760
     & NRJUNK(437)                                                      R0020761
      COMMON/TRASH/ IA( 20),RRTRAS(480)                                 R0020770
      REWIND 2                                                          00020780
      II=1                                                              00020790
      NSN1=0                                                            00020800
      REWIND 4                                                          00020810
      READ (4) ((ID2(I,J),J=1,5),I=1,NUMEL)                             00020820
      IF(NADEL.GT.1) READ(4) ((ID4(I,J),J=1,NADND),I=1,NUMEL)           00020830
  100 READ(5,110)NSN,NPT                                                00020840
      IF(NSN.EQ.0)  GO TO 220                                           00020850
  110 FORMAT (2I5)                                                      00020860
      IF(NSN.LT.NSN1) REWIND 2                                          00020870
      IF(NSN.LT.NSN1) II=1                                              00020880
      NSN1=NSN                                                          00020890
      DO 130 I=II,IES                                                   00020900
      IL=I                                                              00020910
      READ (2) J1,J2,J3,J4                                              00020920
      LX=(J4-16)/20+1                                                   00020930
      IF(NSN.EQ.J1) GO TO 140                                           00020940
      JL=16                                                             00020950
      IF(J4.LE.16) JL=J4                                                00020960
      READ (2)  (IA(K),K=1,JL)                                          00020970
      IF(J4.LE.16) GO TO 130                                            00020980
      DO 120 J=1,LX                                                     00020990
      JL=20                                                             00021000
      IF(J.EQ.LX) JL=J4-(LX-1)*20 -16                                   00021010
      IF(JL.EQ.0)  GO TO 130                                            00021020
      READ (2)  (IA(K),K=1,JL)                                          00021030
  120 CONTINUE                                                          00021040
  130 CONTINUE                                                          00021050
  140 II=IL                                                             00021060
      IF(NSN.EQ.J1) GO TO 160                                           00021070
      WRITE(6,150)NSN                                                   00021080
  150 FORMAT (1H0,20X, 38H NO DATA FOUND TO ALLOW PRESSURE TO BE/20X,   00021090
     $   18HAPPLIED TO SURFACE,I5)                                      00021100
      GO TO 100                                                         00021110
  160 CONTINUE                                                          00021120
      WRITE(6,170)NPT,NSN                                               00021130
  170 FORMAT(1H0,20X, 13HPRESSURE TYPE,I5, 28H IS BEING APPLIED TO SURFA00021140
     $CE, I5//)                                                         00021150
      JL=16                                                             00021160
      IF(J4.LE.16) JL=J4                                                00021170
      READ (2)  (IA(K),K=1,JL)                                          00021180
      KM=10000                                                          00021190
      NPTKM=NPT*KM                                                      00021200
      I=0                                                               00021210
      GO TO 190                                                         00021220
  180 I=I+1                                                             00021230
      IF(J4.LE.16) GO TO 210                                            00021240
      JL=20                                                             00021250
      IF(I.EQ.LX) JL=J4-(LX-1)*20 -16                                   00021260
      IF(JL.EQ.0) GO TO 210                                             00021270
      READ (2) (IA(K),K=1,JL)                                           00021280
  190 DO 200 J=1,JL                                                     00021290
      N=IA(J)                                                           00021300
      ZNN=ID2(N,5)                                                      00021310
      NN1=ZNN/KM                                                        00021320
      NN1= MOD(NN1,100)*KM                                              00021330
      ZNN=ZNN-NN1+NPTKM                                                 00021340
      ID2( N,5)=ZNN                                                     00021350
  200 CONTINUE                                                          00021360
  210 IF(I.LT.LX) GO TO 180                                             00021370
      GO TO 100                                                         00021380
  220 REWIND 4                                                          00021390
      WRITE (4) ((ID2(I,J),J=1,5),I=1,NUMEL)                            00021400
      IF(NADEL.GT.1)WRITE(4) ((ID4(I,J),J=1,NADND),I=1,NUMEL)           00021410
      RETURN                                                            00021420
      END                                                               00021430
      SUBROUTINE NODINP (NC,NUMNP,NP,ID,NZZ)                            00155700
      IMPLICIT REAL*8(A-H,O-Z)                                          00155710
      REAL*8  ID                                                        00155720
      DIMENSION ID(NZZ,3)                                               00155730
      COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD                  00155740
     $              ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC                   00155750
      DIMENSION C(3)                                                    00155760
      DIMENSION C1(4)                                                   00155770
      COMMON/QTSARG/ X(3,50),Y(3,50),Z(3,50),TI(3,3,50),XC(3),XI(3)     00155780
     $,XX(3),DX(3)                                                      00155790
     $,CORD(20,3),PERR,PERS,PERT,H(20),CZ(3),RRQTSA(2)                  R0155800
      DIMENSION NOD(8),N3D(20)                                          00155810
      DATA  C/ 4HRECT,4HSPHR,4HCYLD/                                    00155820
      DATA C1/1H ,1HR,1HS,1HC/                                          00155830
        CALL FILES(26)                                                  00155840
      XM=XMX/2.                                                         00155850
      IF(PRTCOD.EQ.PRTOFF) GO TO 195                                    00155860
      IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 195                   00155870
      WRITE(6,100)                                                      00155880
  100 FORMAT (1X ,20X,32HNODAL POINT COORDINATES AS INPUT)              00155890
      WRITE(6,110)                                                      00155900
      WRITE(6,130)                                                      00155910
      WRITE(6,140)                                                      00155920
      WRITE(6,170)                                                      00155930
      WRITE(6,150)                                                      00155940
      WRITE(6,120)                                                      00155950
      WRITE(6,130)                                                      00155960
      WRITE(6,140)                                                      00155970
      WRITE(6,170)                                                      00155980
      WRITE(6,160)                                                      00155990
      WRITE(6,180)                                                      00156000
  110 FORMAT (1H0,20X,27HFOR CYLINDRICAL COORDINATES/)                  00156010
  120 FORMAT (1H0,20X,25HFOR SPHERICAL COORDINATES/)                    00156020
  130 FORMAT (1H0,20X,5HX = R)                                          00156030
  140 FORMAT (1H0,20X,5HY = O)                                          00156040
  150 FORMAT (1H0,20X,5HZ = Z)                                          00156050
  160 FORMAT (1H0,20X,5HZ = O)                                          00156060
  170 FORMAT (1H+,20X,5H    -)                                          00156070
  180 FORMAT (1H+,20X,5H    / //)                                       00156080
      WRITE(6,190)                                                      00156090
  190 FORMAT (1H0,10X,4HNODE,11X,23HNODAL POINT COORDINATES,20X,        00156100
     $6HCOORD.,10X,6HCOORD./11X,3HNO.,10X,1HX,15X,1HY,15X,1HZ,12X,      00156110
     $6HSYSTEM,10X,5H TYPE      ,7H   INC.,5X,10HREF. FACT.///)         00156120
  195 CONTINUE                                                          00156130
      IF (NP.GT.1) REWIND 8                                             00156140
      IF (NP.GT.1) READ (8) ((ID(I,J),J=1,3),I=1,NP)                    00156150
      IF(NP.GT.1) NP=NP+1                                               00156160
      IF(NP.GE.NUMNP) GO TO 210                                         00156170
      XAD1I=XAD+1.0+I1                                                  00156180
      DO 200 I=NP,NUMNP                                                 00156190
      DO 200 J=1,3                                                      00156200
  200 ID(I,J)=XAD1I                                                     00156210
  210 KO=1                                                              00156220
  220 READ (5,230) N,XX,KS,C2,KN,PER                                    00156230
      IF(N.EQ.0)                   GO TO 380                            00156240
      IF(N.EQ.-2) GO TO 410                                             00156250
      IF(N.EQ.-3) GO TO 600                                             00156260
      KT=1                                                              00156270
      IF(C2.EQ.C1(3)) KT=2                                              00156280
      IF(C2.EQ.C1(4)) KT=3                                              00156290
      IF(KT.GT.3) GO TO 390                                             00156300
      IF(PRTCOD.EQ.PRTOFF) GO TO 225                                    00156310
      IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 225                   00156320
      WRITE(6,240)N,XX,KS,C(KT),KN,PER                                  00156330
  225 CONTINUE                                                          00156340
      IF(N.GT.NUMNP) GO TO 390                                          00156350
      IF(KS.GT.NC)   GO TO 390                                          00156360
  230 FORMAT(I10,3F10.0,I5,4X,A1,I5,F10.0)                              00156370
  240 FORMAT (9X,I5,3(5X,F10.4),I16,11X,A4,I6,F15.5)                    00156380
      IF(KO.EQ.1) GO TO 340                                             00156390
      IF(KN.EQ.0)       GO TO 340                                       00156400
      IF((N-NI).LT.KN)GO TO 390                                         00156410
      KDT=N-NI                                                          00156420
      KDT=MOD(KDT,KN)                                                   00156430
      IF(KDT.NE.0) GO TO 390                                            00156440
  250 NUMINT=(N-NI)/KN                                                  00156450
      SUM=NUMINT                                                        00156460
      IF(PER.EQ.0.0) GO TO 270                                          00156470
      PER=PER/100.0                                                     00156480
      LLL=NUMINT-1                                                      00156490
      SUM=1.0                                                           00156500
      DO 260 I=1,LLL                                                    00156510
  260 SUM=SUM+PER**I                                                    00156520
  270 CONTINUE                                                          00156530
      IF( PER.EQ.0.) PER=1.00                                           00156540
      DO 280 I=1,3                                                      00156550
  280 DX(I)=(XX(I)-XI(I))/SUM                                           00156560
      FACT=1.0/PER                                                      00156570
      LLL=NUMINT                                                        00156580
      DO 330 J=1,LLL                                                    00156590
      FACT=FACT*PER                                                     00156600
      NN=NI+J*KN                                                        00156610
      DO 290 JJ=1,3                                                     00156620
  290 XI(JJ)=XI(JJ)+DX(JJ) *FACT                                        00156630
      CALL CONVER (KS,KT)                                               00156640
      DO 320 JJ=1,3                                                     00156650
      IF(DABS(XC(JJ)).LT.XM) GO TO 310                                  00156660
      WRITE(6,300)NN                                                    00156670
      KSKIP=1                                                           00156680
  300 FORMAT (1X ,20HA COORDINATE OF NODE,I5,23H IS LARGER THAN THE MAX,00156690
     $22H. SPECIFIED COORDINATE)                                        00156700
  310 CONTINUE                                                          00156710
  320 ID(NN,JJ)=XC(JJ)/XMX+XAD                                          00156720
  330 CONTINUE                                                          00156730
  340 KO=0                                                              00156740
      NI=N                                                              00156750
      DO 350 J=1,3                                                      00156760
  350 XI(J)=XX(J)                                                       00156770
      IF(KN.GT.0)            GO TO 220                                  00156780
      CALL CONVER (KS,KT)                                               00156790
      DO 370 I=1,3                                                      00156800
      IF(XC(I ).LT.XM) GO TO 360                                        00156810
      WRITE(6,300)N                                                     00156820
      CALL CLOSE                                                        00156830
      CALL EXIT                                                         00156840
  360 CONTINUE                                                          00156850
  370 ID(N,I)=XC(I)/XMX+XAD                                             00156860
      GO TO 220                                                         00156870
  380 REWIND 8                                                          00156880
      WRITE (8) ((ID(I,J),J=1,3),I= 1,NUMNP)                            00156890
      RETURN                                                            00156900
  390 WRITE(6,400)N                                                     00156910
  400 FORMAT (//20X,13HERROR ON NODE,I10//)                             00156920
      KSKIP=1                                                           00156930
      GO TO 220                                                         00156940
  410 READ (5,420) NOD,INCS,INCT,PERS,PERT                              00156950
  420 FORMAT(10I5,2F10.0)                                               00156960
      IF(PERS.LE.0.0) PERS=100.                                         00156970
      IF(PERT.LE.0.0) PERT=100.                                         00156980
      IF(INCS.EQ.0) INCS=1                                              00156990
      IF(INCT.EQ.0) INCT=NOD(2)-NOD(1)+1                                00157000
      WRITE(6,430)NOD,INCS,INCT,PERS,PERT                               00157010
  430 FORMAT(//20X,29HSURFACE COORDINATE GENERATION                     00157020
     $        /20X,27HNODE NOS. FOR CORNERS 1-8 =,1X,8I5                00157030
     $        /20X,35HNODE INCREMENT IN THE S DIRECTION =,1X,I5         00157040
     $        /20X,35HNODE INCREMENT IN THE T DIRECTION =,1X,I5         00157050
     $        /20X,38HREFINEMENT FACTOR IN THE S DIRECTION =,1X,F15.5   00157060
     $        /20X,38HREFINEMENT FACTOR IN THE T DIRECTION =,1X,F15.5//)00157070
        DO 480 I=1,8                                                    00157080
      J=NOD(I)                                                          00157090
      IF(J.GE.0.AND.J.LE.NUMNP) GO TO 450                               00157100
      WRITE(6,440)NOD(I)                                                00157110
  440 FORMAT(/20X,5HNODE ,I5,16H IS OUT OF RANGE//)                     00157120
      KSKIP=1                                                           00157130
      GO TO 220                                                         00157140
  450 DO 460 K=1,3                                                      00157150
  460 CORD(I,K)=0.0                                                     00157160
      IF(J.EQ.0) GO TO 480                                              00157170
      DO 470 K=1,3                                                      00157180
      NNN=ID(J,K)                                                       00157190
      IF(NNN.LT.0) NNN=NNN-1                                            00157200
  470 CORD(I,K)=(ID(J,K)-NNN-XAD)*XMX                                   00157210
  480 CONTINUE                                                          00157220
      NI=4                                                              00157230
      DO 490 I=5,8                                                      00157240
      IF(NOD(I).GT.0) NI=8                                              00157250
      H(I)=0.0                                                          00157260
  490 CONTINUE                                                          00157270
      DO 500 I=1,4                                                      00157280
      IF(NOD(I).EQ.0) WRITE(6,510)I                                     00157290
      IF(NOD(I).EQ.0) GO TO 220                                         00157300
  500 CONTINUE                                                          00157310
  510 FORMAT (/20X,7HCORNER ,I1,19H SHOULD NOT BE ZERO//)               00157320
      NODE=NOD(1)                                                       00157330
      NUMDS=(NOD(2)-NOD(1))/INCS+1                                      00157340
      NUMDT=(NOD(3)-NOD(2))/INCT+1                                      00157350
      NX=NOD(1)-INCS+(NUMDS*NUMDT*INCS)+(INCT-NUMDS*INCS)*(NUMDT-1)     00157360
      IF(NX.EQ.NOD(3)) GO TO 515                                        00157370
      WRITE(6,512)                                                      00157380
  512 FORMAT(//20X,45HSURFACE GENERATION WILL BE TERMINATED BECAUSE,    00157390
     $        /20X,44HEITHER SOME OF THE SUPPLIED CORNER NODE NOS.      00157400
     $        /20X,38HARE WRONG OR THE INCREMENTS ARE WRONG.//)         00157410
      KSKIP=1                                                           00157420
      GO TO 220                                                         00157430
  515 CONTINUE                                                          00157440
      T=-1.                                                             00157450
      PERS=PERS/100.0                                                   00157460
      PERT=PERT/100.0                                                   00157470
      LLL=NUMDS-2                                                       00157480
      SUMS=1.0                                                          00157490
      DO 520 I=1,LLL                                                    00157500
  520 SUMS=SUMS+PERS**I                                                 00157510
      LLL=NUMDT-2                                                       00157520
      SUMT=1.0                                                          00157530
      DO 530 I=1,LLL                                                    00157540
  530 SUMT=SUMT+PERT**I                                                 00157550
      FACTT=1.0/PERT                                                    00157560
      IF(PERS.EQ.1.0)SUMS=NUMDS-1                                       00157570
      IF(PERT.EQ.1.0)SUMT=NUMDT-1                                       00157580
      DS=2.0/SUMS                                                       00157590
      DT=2.0/SUMT                                                       00157600
      DO 590 I=1,NUMDT                                                  00157610
      S=-1.                                                             00157620
      FACTS=1.0/PERS                                                    00157630
      DO 580 J=1,NUMDS                                                  00157640
      IF(NI.NE.8) GO TO 540                                             00157650
      IF(NOD(5).GT.0)                                                   00157660
     $H(5)=(1.-S**2)*(1.-T)*0.5                                         00157670
      IF(NOD(6).GT.0)                                                   00157680
     $H(6)=(1.-T**2)*(1.+S)*0.5                                         00157690
      IF(NOD(7).GT.0)                                                   00157700
     $H(7)=(1.-S**2)*(1.+T)*0.5                                         00157710
      IF(NOD(8).GT.0)                                                   00157720
     $H(8)=(1.-T**2)*(1.-S)*0.5                                         00157730
  540 H(1)=(1.-S)*(1.-T)*   0.25-(H(5)+H(8)) *0.5                       00157740
      H(2)=(1.+S)*(1.-T)*   0.25-(H(5)+H(6)) *0.5                       00157750
      H(3)=(1.+S)*(1.+T)*   0.25-(H(6)+H(7)) *0.5                       00157760
      H(4)=(1.-S)*(1.+T)*   0.25-(H(7)+H(8)) *0.5                       00157770
      DO 550 JJ=1,3                                                     00157780
  550 CZ(JJ)=0.0                                                        00157790
      DO 560 II=1,NI                                                    00157800
      DO 560 JJ=1,3                                                     00157810
  560 CZ(JJ)=CZ(JJ)+H(II)*CORD(II,JJ)                                   00157820
      DO 570 JJ=1,3                                                     00157830
  570 ID(NODE,JJ)=CZ(JJ)/XMX+XAD                                        00157840
      NODE=NODE+INCS                                                    00157850
      FACTS=FACTS*PERS                                                  00157860
  580 S=S+DS*FACTS                                                      00157870
      NODE=NODE-(NUMDS)*INCS+INCT                                       00157880
      FACTT=FACTT*PERT                                                  00157890
  590 T=T+DT*FACTT                                                      00157900
        IF(KS.NE.0) CALL SRFC(NOD,INCS,INCT,NUMDS,NUMDT,                00157910
     $XAD,XMX,NZZ,ID,KS,CORD)                                           00157920
      GO TO 220                                                         00157930
  600 READ (5,610) (N3D(I),I=1,8),PERR,PERS,PERT                        00157940
      READ (5,620) (N3D(I),I=9,20),INCR,INCS,INCT                       00157950
  610 FORMAT(8I5,3F10.0)                                                00157960
  620 FORMAT(16I5)                                                      00157970
      IF(INCR.LE.0) INCR=1                                              00157980
      NUMDR=(N3D(4)-N3D(1))/INCR+1                                      00157990
      IF(INCS.LE.0)                                                     00158000
     $INCS=N3D(4)-N3D(1)+1                                              00158010
      NUMDS=(N3D(3)-N3D(4))/INCS+1                                      00158020
      IF(INCT.LE.0)                                                     00158030
     $INCT=N3D(3)-N3D(1)+1                                              00158040
      NUMDT=(N3D(7)-N3D(3))/INCT+1                                      00158050
      IF(PERR.LE.0.0)PERR=100.0                                         00158060
      IF(PERS.LE.0.0)PERS=100.0                                         00158070
      IF(PERT.LE.0.0)PERT=100.0                                         00158080
      WRITE(6,630)(N3D(I),I=1,8),(N3D(I),I=9,20),INCR,INCS,INCT,PERR    00158090
     $,PERS,PERT                                                        00158100
  630 FORMAT(//20X,28HVOLUME COORDINATE GENERATION                      00158110
     $        /20X,27HNODE NOS. FOR CORNERS 1-8 =,1X,8I5                00158120
     $        /20X,28HNODE NOS. FOR CORNERS 9-20 =,1X,12I5              00158130
     $        /20X,35HNODE INCREMENT IN THE R DIRECTION =,1X,I5         00158140
     $        /20X,35HNODE INCREMENT IN THE S DIRECTION =,1X,I5         00158150
     $        /20X,35HNODE INCREMENT IN THE T DIRECTION =,1X,I5         00158160
     $        /20X,38HREFINEMENT FACTOR IN THE R DIRECTION =,1X,F15.5   00158170
     $        /20X,38HREFINEMENT FACTOR IN THE S DIRECTION =,1X,F15.5   00158180
     $        /20X,38HREFINEMENT FACTOR IN THE T DIRECTION =,1X,F15.5//)00158190
      DO 680 I=1,20                                                     00158200
      J=N3D(I)                                                          00158210
      IF(J.GE.0.AND.J.LE.NUMNP) GO TO 650                               00158220
      WRITE(6,440)N3D(I)                                                00158230
      KSKIP=1                                                           00158240
      GO TO 220                                                         00158250
  650 DO 660 K=1,3                                                      00158260
  660 CORD(I,K)=0.0                                                     00158270
      IF(J.EQ.0) GO TO 680                                              00158280
      DO 670 K=1,3                                                      00158290
      NNN=ID(J,K)                                                       00158300
      IF(NNN.LT.0) NNN=NNN-1                                            00158310
  670 CORD(I,K)=(ID(J,K)-NNN-XAD)*XMX                                   00158320
  680 CONTINUE                                                          00158330
      NI=8                                                              00158340
      DO 690 I=9,20                                                     00158350
      IF(N3D(I).GT.0) NI=20                                             00158360
  690 H(I)=0.0                                                          00158370
      DO 700 I=1,8                                                      00158380
      IF(N3D(I).EQ.0) WRITE(6,510)I                                     00158390
      IF(N3D(I).EQ.0) GO TO 220                                         00158400
  700 CONTINUE                                                          00158410
      NNN=NUMDR*INCR*NUMDS+(INCS-NUMDR*INCR)*(NUMDS-1)                  00158420
      NNN=N3D(1)+NNN*NUMDT+(INCT-NNN)*(NUMDT-1)-INCR                    00158430
      IF(NNN.NE.N3D(7)) WRITE(6,720)                                    00158440
      IF(NNN.NE.N3D(7))GO TO 220                                        00158450
  720 FORMAT(//20X,37HVOLUME GENERATION IS BEING TERMINATED,            00158460
     $        /20X,40HCHECK NODE NOS. ON CORNERS 1,3,4, AND 7.//)       00158470
      PERR=PERR/100.0                                                   00158480
      PERS=PERS/100.0                                                   00158490
      PERT=PERT/100.0                                                   00158500
      T=-1.                                                             00158510
      LLL=NUMDR-2                                                       00158520
      SUMR=1.0                                                          00158530
      DO 730 I=1,LLL                                                    00158540
  730 SUMR=SUMR+PERR**I                                                 00158550
      LLL=NUMDS-2                                                       00158560
      SUMS=1.0                                                          00158570
      DO 740 I=1,LLL                                                    00158580
  740 SUMS=SUMS+PERS**I                                                 00158590
      LLL=NUMDT-2                                                       00158600
      SUMT=1.0                                                          00158610
      DO 750 I=1,LLL                                                    00158620
  750 SUMT=SUMT+PERT**I                                                 00158630
      IF(PERR.EQ.1.0) SUMR=NUMDR-1                                      00158640
      IF(PERS.EQ.1.0) SUMS=NUMDS-1                                      00158650
      IF(PERT.EQ.1.0) SUMT=NUMDT-1                                      00158660
      FACTT=1.0/PERT                                                    00158670
      NODE=N3D(1)                                                       00158680
      DR=2.0/SUMR                                                       00158690
      DS=2.0/SUMS                                                       00158700
      DT=2.0/SUMT                                                       00158710
      DO 820 MMM=1,NUMDT                                                00158720
      NODEI=NODE                                                        00158730
      S=-1.                                                             00158740
      FACTS=1.0/PERS                                                    00158750
      DO 810 I=1,NUMDS                                                  00158760
      R=-1.                                                             00158770
      FACTR=1.0/PERR                                                    00158780
      DO 800 J=1,NUMDR                                                  00158790
      RP=1.+R                                                           00158800
      SP=1.+S                                                           00158810
      TP=1.+T                                                           00158820
      RM=1.-R                                                           00158830
      SM=1.-S                                                           00158840
      TM=1.-T                                                           00158850
      IF(NI.NE.20) GO TO 760                                            00158860
      RR=1.-R*R                                                         00158870
      SS=1.-S*S                                                         00158880
      TT=1.-T*T                                                         00158890
      IF(N3D(9).GT.0)                                                   00158900
     $H(9)=RM*SS*TM*0.25                                                00158910
      IF(N3D(10).GT.0)                                                  00158920
     $H(10)=RR*SP*TM*0.25                                               00158930
      IF(N3D(11).GT.0)                                                  00158940
     $H(11)=RP*SS*TM*0.25                                               00158950
      IF(N3D(12).GT.0)                                                  00158960
     $H(12)=RR*SM*TM *0.25                                              00158970
      IF(N3D(13).GT.0)                                                  00158980
     $H(13)=RM*SS*TP*0.25                                               00158990
      IF(N3D(14).GT.0)                                                  00159000
     $H(14)=RR*SP*TP*0.25                                               00159010
      IF(N3D(15).GT.0)                                                  00159020
     $H(15)=RP*SS*TP*0.25                                               00159030
      IF(N3D(16).GT.0)                                                  00159040
     $H(16)=RR*SM*TP*0.25                                               00159050
      IF(N3D(17).GT.0)                                                  00159060
     $H(17)=RM*SM*TT*0.25                                               00159070
      IF(N3D(18).GT.0)                                                  00159080
     $H(18)=RM*SP*TT *0.25                                              00159090
      IF(N3D(19).GT.0)                                                  00159100
     $H(19)=RP*SP*TT*0.25                                               00159110
      IF(N3D(20).GT.0)                                                  00159120
     $H(20)=RP*SM*TT*0.25                                               00159130
  760 TM=0.125*TM                                                       00159140
      TP=0.125*TP                                                       00159150
      H(1)=RM*SM*TM     -0.5*(H( 9)+H(17)+H(12))                        00159160
      H(2)=RM*SP*TM     -0.5*(H( 9)+H(18)+H(10))                        00159170
      H(3)=RP*SP*TM     -0.5*(H(10)+H(19)+H(11))                        00159180
      H(4)=RP*SM*TM     -0.5*(H(11)+H(20)+H(12))                        00159190
      H(5)=RM*SM*TP     -0.5*(H(13)+H(17)+H(16))                        00159200
      H(6)=RM*SP*TP     -0.5*(H(13)+H(18)+H(14))                        00159210
      H(7)=RP*SP*TP     -0.5*(H(14)+H(19)+H(15))                        00159220
      H(8)=RP*SM*TP     -0.5*(H(15)+H(20)+H(16))                        00159230
      DO 770 JJ=1,3                                                     00159240
  770 CZ(JJ)=0.0                                                        00159250
      DO 780 II=1,NI                                                    00159260
      DO 780 JJ=1,3                                                     00159270
  780 CZ(JJ)=CZ(JJ)+H(II)*CORD(II,JJ)                                   00159280
      DO 790 JJ=1,3                                                     00159290
  790 ID(NODE,JJ)=CZ(JJ)/XMX+XAD                                        00159300
      NODE=NODE+INCR                                                    00159310
      FACTR=FACTR*PERR                                                  00159320
  800 R=R+DR*FACTR                                                      00159330
      NODE=NODE-NUMDR*INCR+INCS                                         00159340
      FACTS=FACTS*PERS                                                  00159350
  810 S=S+DS*FACTS                                                      00159360
      NODE=NODEI+INCT                                                   00159370
      FACTT=FACTT*PERT                                                  00159380
  820 T=T+DT*FACTT                                                      00159390
        IF(KS.NE.0) CALL VOLM(N3D,INCR,INCS,INCT,NUMDR,NUMDS,           00159400
     $NUMDT,XAD,XMX,NZZ,ID,KS,CORD)                                     00159410
      GO TO 220                                                         00159420
      END                                                               00159430
      SUBROUTINE CONVER (KS,KT)                                         00051120
      IMPLICIT REAL*8(A-H,O-Z)                                          00051130
      COMMON/QTSARG/ X(3,50),Y(3,50),Z(3,50),TI(3,3,50),XC(3),XI(3)     00051140
     & ,RRQTSA(94)                                                      R0051141
      DIMENSION XX(3)                                                   00051150
      RDN=0.01745329251                                                 00051160
      GO TO (100,120,130),KT                                            00051170
  100 DO 110 I=1,3                                                      00051180
  110 XC(I)=XI(I)                                                       00051190
      GO TO 140                                                         00051200
  120 THETA=XI(2)*RDN                                                   00051210
      PHI=XI(3)*RDN                                                     00051220
      R=XI(1)                                                           00051230
      XC(1)=R* DSIN(PHI)* DCOS(THETA)                                   00051240
      XC(2)=R* DSIN(PHI)* DSIN(THETA)                                   00051250
      XC(3)=R* DCOS(PHI)                                                00051260
      GO TO 140                                                         00051270
  130 THETA=XI(2)*RDN                                                   00051280
      XC(1)=XI(1)* DCOS(THETA)                                          00051290
      XC(2)=XI(1)* DSIN(THETA)                                          00051300
      XC(3)=XI(3)                                                       00051310
  140 IF(KS.EQ.0) RETURN                                                00051320
      DO 150 I=1,3                                                      00051330
      XX(I)=0.0                                                         00051340
      DO 150 J=1,3                                                      00051350
  150 XX(I)=XX(I)+TI(J,I,KS)*XC(J)                                      00051360
      XC(1)=XX(1)+X(1,KS)                                               00051370
      XC(2)=XX(2)+Y(1,KS)                                               00051380
      XC(3)=XX(3)+Z(1,KS)                                               00051390
      RETURN                                                            00051400
      END                                                               00051410
      SUBROUTINE SRFC (NOD,INCS,INCT,NUMDS,NUMDT,XAD,XMX,NZZ,ID,KS,CORD)00254700
        IMPLICIT REAL*8 (A-H,O-Z)                                       00254710
      REAL*8 ID(NZZ,3)                                                  00254720
      DIMENSION NOD(8),NN(4),CORD(20,3),NIB(4)                          00254730
      DIMENSION P1(3),P2(3),P3(3),P4(3),P5(3),P6(3),P7(3),P8(3)         00254740
      DATA NIB/1,2,4,1/                                                 00254750
      IF (KS.GT.3 .OR. KS.LT.-4)   GO TO 500                            00254760
      IF (KS.LT.0)   GO TO 300                                          00254770
      READ (5,10) NN                                                    00254780
   10 FORMAT (4I5)                                                      00254790
      DO 20 I=1,4                                                       00254800
      J=NN(I)                                                           00254810
      IF (J.LE.0)   GO TO 20                                            00254820
      DO 15 K=1,3                                                       00254830
      NNN=ID(J,K)                                                       00254840
      IF (NNN.LT.0)  NNN=NNN-1                                          00254850
   15 CORD(I,K)=(ID(J,K)-NNN-XAD)*XMX                                   00254860
   20 CONTINUE                                                          00254870
      GO TO (22,100,200), KS                                            00254880
   22 CONTINUE                                                          00254890
      RAD=CORD(2,1)                                                     00254900
      DO 25 K=1,3                                                       00254910
   25 P1(K)=CORD(1,K)                                                   00254920
      NODE=NOD(1)                                                       00254930
      DO 50 I=1,NUMDT                                                   00254940
      DO 40 J=1,NUMDS                                                   00254950
      DO 30 K=1,3                                                       00254960
      NNN=ID(NODE,K)                                                    00254970
      IF (NNN.LT.0)   NNN=NNN-1                                         00254980
   30 P2(K)=(ID(NODE,K)-NNN-XAD)*XMX                                    00254990
      CALL PTS1 (P1,P2,RAD,P3)                                          00255000
      DO 35 K=1,3                                                       00255010
   35 ID(NODE,K)=P3(K)/XMX+XAD                                          00255020
      NODE=NODE+INCS                                                    00255030
   40 CONTINUE                                                          00255040
      NODE=NODE-NUMDS*INCS+INCT                                         00255050
   50 CONTINUE                                                          00255060
      GO TO 500                                                         00255070
  100 CONTINUE                                                          00255080
      RAD=CORD(3,1)                                                     00255090
      DO 125 K=1,3                                                      00255100
      P1(K)=CORD(1,K)                                                   00255110
  125 P2(K)=CORD(2,K)                                                   00255120
      NODE=NOD(1)                                                       00255130
      DO 150 I=1,NUMDT                                                  00255140
      DO 140 J=1,NUMDS                                                  00255150
      DO 130 K=1,3                                                      00255160
      NNN=ID(NODE,K)                                                    00255170
      IF (NNN.LT.0)   NNN=NNN-1                                         00255180
  130 P3(K)=(ID(NODE,K)-NNN-XAD)*XMX                                    00255190
      CALL PTS2 (P1,P2,P3,A,B,C,D)                                      00255200
      CALL PTS3 (P1,P2,A,B,C,D,P4)                                      00255210
      CALL PTS1 (P4,P3,RAD,P5)                                          00255220
      DO 135 K=1,3                                                      00255230
  135 ID(NODE,K)=P5(K)/XMX+XAD                                          00255240
      NODE=NODE+INCS                                                    00255250
  140 CONTINUE                                                          00255260
      NODE=NODE-NUMDS*INCS+INCT                                         00255270
  150 CONTINUE                                                          00255280
      GO TO 500                                                         00255290
  200 CONTINUE                                                          00255300
      DO 225 K=1,3                                                      00255310
      P1(K)=CORD(1,K)                                                   00255320
      P2(K)=CORD(2,K)                                                   00255330
      P3(K)=CORD(3,K)                                                   00255340
  225 P4(K)=CORD(4,K)                                                   00255350
      NODE=NOD(1)                                                       00255360
      DO 250 I=1,NUMDT                                                  00255370
      DO 240 J=1,NUMDS                                                  00255380
      DO 230 K=1,3                                                      00255390
      NNN=ID(NODE,K)                                                    00255400
      IF (NNN.LT.0)   NNN=NNN-1                                         00255410
  230 P5(K)=(ID(NODE,K)-NNN-XAD)*XMX                                    00255420
      CALL PTS2 (P1,P2,P5,A,B,C,D)                                      00255430
      CALL PTS3 (P1,P2,A,B,C,D,P6)                                      00255440
      CALL PTS3 (P3,P4,A,B,C,D,P7)                                      00255450
      RAD=DSQRT((P7(1)-P6(1))**2+(P7(2)-P6(2))**2+(P7(3)-P6(3))**2)     00255460
      CALL PTS1 (P6,P5,RAD,P8)                                          00255470
      DO 235 K=1,3                                                      00255480
  235 ID(NODE,K)=P8(K)/XMX+XAD                                          00255490
      NODE=NODE+INCS                                                    00255500
  240 CONTINUE                                                          00255510
      NODE=NODE-NUMDS*INCS+INCT                                         00255520
  250 CONTINUE                                                          00255530
      GO TO 500                                                         00255540
  300 CONTINUE                                                          00255550
      KS=IABS(KS)                                                       00255560
      DO 400 N=1,KS                                                     00255570
      READ (5,10) NS, (NN(I),I=1,3)                                     00255580
      IF (NS.LT.1 .OR. NS.GT.4)   GO TO 400                             00255590
      DO 320 I=1,3                                                      00255600
      J=NN(I)                                                           00255610
      DO 320 K=1,3                                                      00255620
      NNN=ID(J,K)                                                       00255630
      IF (NNN.LT.0)   NNN=NNN-1                                         00255640
  320 CORD(I,K)=(ID(J,K)-NNN-XAD)*XMX                                   00255650
      RAD=CORD(3,1)                                                     00255660
      DO 325 K=1,3                                                      00255670
      P1(K)=CORD(1,K)                                                   00255680
  325 P2(K)=CORD(2,K)                                                   00255690
      M=NIB(NS)                                                         00255700
      NODE=NOD(M)                                                       00255710
      INC=INCS                                                          00255720
      IF (NS.EQ.2 .OR. NS.EQ.4)   INC=INCT                              00255730
      NUMD=NUMDS                                                        00255740
      IF (NS.EQ.2 .OR. NS.EQ.4)   NUMD=NUMDT                            00255750
      DO 380 M=1,NUMD                                                   00255760
      DO 335 K=1,3                                                      00255770
      NNN=ID(NODE,K)                                                    00255780
      IF (NNN.LT.0)   NNN=NNN-1                                         00255790
  335 P3(K)=(ID(NODE,K)-NNN-XAD)*XMX                                    00255800
      CALL PTS2 (P1,P2,P3,A,B,C,D)                                      00255810
      CALL PTS3 (P1,P2,A,B,C,D,P4)                                      00255820
      CALL PTS1 (P4,P3,RAD,P5)                                          00255830
      DO 340 K=1,3                                                      00255840
  340 ID(NODE,K)=P5(K)/XMX+XAD                                          00255850
      NODE=NODE+INC                                                     00255860
  380 CONTINUE                                                          00255870
  400 CONTINUE                                                          00255880
  500 RETURN                                                            00255890
      END                                                               00255900
      SUBROUTINE VOLM (N3D,INCR,INCS,INCT,NUMDR,NUMDS,NUMDT,XAD,XMX,    00320250
     $                 NZZ,ID,KS,CORD)                                  00320260
        IMPLICIT REAL*8 (A-H,O-Z)                                       00320270
      REAL*8 ID(NZZ,3)                                                  00320280
      DIMENSION N3D(20),NN(4),CORD(20,3),NIB(6)                         00320290
      DIMENSION P1(3),P2(3),P3(3),P4(3),P5(3),P6(3),P7(3),P8(3)         00320300
      DATA NIB/1,4,2,1,5,1/                                             00320310
      IF (KS.LT.0 .OR. KS.GT.6)  GO TO 600                              00320320
      DO 500 N=1,KS                                                     00320330
      READ (5,2)  NS,NTYP,NN                                            00320340
    2 FORMAT (6I5)                                                      00320350
      IF (NS.LT.1 .OR. NS.GT.6)   GO TO 500                             00320360
      IF (NTYP.LT.1 .OR. NTYP.GT.3)   GO TO 500                         00320370
      M=NIB(NS)                                                         00320380
      NODE=N3D(M)                                                       00320390
      GO TO (10,10,20,20,30,30), NS                                     00320400
   10 NUMD1=NUMDT                                                       00320410
      NUMD2=NUMDS                                                       00320420
      INC1=INCS                                                         00320430
      INC2=INCT                                                         00320440
      GO TO 70                                                          00320450
   20 NUMD1=NUMDT                                                       00320460
      NUMD2=NUMDR                                                       00320470
      INC1=INCR                                                         00320480
      INC2=INCT                                                         00320490
      GO TO 70                                                          00320500
   30 NUMD1=NUMDS                                                       00320510
      NUMD2=NUMDR                                                       00320520
      INC1=INCR                                                         00320530
      INC2=INCS                                                         00320540
   70 CONTINUE                                                          00320550
      DO 90 I=1,4                                                       00320560
      J=NN(I)                                                           00320570
      IF (J.LE.0)  GO TO 90                                             00320580
      DO 80 K=1,3                                                       00320590
      NNN=ID(J,K)                                                       00320600
      IF (NNN.LT.0)   NNN=NNN-1                                         00320610
   80 CORD(I,K)=(ID(J,K)-NNN-XAD)*XMX                                   00320620
   90 CONTINUE                                                          00320630
      GO TO (100,200,300), NTYP                                         00320640
  100 CONTINUE                                                          00320650
      RAD=CORD(2,1)                                                     00320660
      DO 125 K=1,3                                                      00320670
  125 P1(K)=CORD(1,K)                                                   00320680
      DO 150 I=1,NUMD1                                                  00320690
      DO 140 J=1,NUMD2                                                  00320700
      DO 130 K=1,3                                                      00320710
      NNN=ID(NODE,K)                                                    00320720
      IF (NNN.LT.0)   NNN=NNN-1                                         00320730
  130 P2(K)=(ID(NODE,K)-NNN-XAD)*XMX                                    00320740
      CALL PTS1 (P1,P2,RAD,P3)                                          00320750
      DO 135 K=1,3                                                      00320760
  135 ID(NODE,K)=P3(K)/XMX+XAD                                          00320770
      NODE=NODE+INC1                                                    00320780
  140 CONTINUE                                                          00320790
      NODE=NODE-NUMD2*INC1+INC2                                         00320800
  150 CONTINUE                                                          00320810
      GO TO 500                                                         00320820
  200 CONTINUE                                                          00320830
      RAD=CORD(3,1)                                                     00320840
      DO 225 K=1,3                                                      00320850
      P1(K)=CORD(1,K)                                                   00320860
  225 P2(K)=CORD(2,K)                                                   00320870
      DO 250 I=1,NUMD1                                                  00320880
      DO 240 J=1,NUMD2                                                  00320890
      DO 230 K=1,3                                                      00320900
      NNN=ID(NODE,K)                                                    00320910
      IF (NNN.LT.0)   NNN=NNN-1                                         00320920
  230 P3(K)=(ID(NODE,K)-NNN-XAD)*XMX                                    00320930
      CALL PTS2 (P1,P2,P3,A,B,C,D)                                      00320940
      CALL PTS3 (P1,P2,A,B,C,D,P4)                                      00320950
      CALL PTS1 (P4,P3,RAD,P5)                                          00320960
      DO 235 K=1,3                                                      00320970
  235 ID(NODE,K)=P5(K)/XMX+XAD                                          00320980
      NODE=NODE+INC1                                                    00320990
  240 CONTINUE                                                          00321000
      NODE=NODE-NUMD2*INC1+INC2                                         00321010
  250 CONTINUE                                                          00321020
      GO TO 500                                                         00321030
  300 CONTINUE                                                          00321040
      DO 325 K=1,3                                                      00321050
      P1(K)=CORD(1,K)                                                   00321060
      P2(K)=CORD(2,K)                                                   00321070
      P3(K)=CORD(3,K)                                                   00321080
  325 P4(K)=CORD(4,K)                                                   00321090
      DO 350 I=1,NUMD1                                                  00321100
      DO 340 J=1,NUMD2                                                  00321110
      DO 330 K=1,3                                                      00321120
      NNN=ID(NODE,K)                                                    00321130
      IF (NNN.LT.0)   NNN=NNN-1                                         00321140
  330 P5(K)=(ID(NODE,K)-NNN-XAD)*XMX                                    00321150
      CALL PTS2 (P1,P2,P5,A,B,C,D)                                      00321160
      CALL PTS3 (P1,P2,A,B,C,D,P6)                                      00321170
      CALL PTS3 (P3,P4,A,B,C,D,P7)                                      00321180
      RAD=DSQRT((P7(1)-P6(1))**2+(P7(2)-P6(2))**2+(P7(3)-P6(3))**2)     00321190
      CALL PTS1 (P6,P5,RAD,P8)                                          00321200
      DO 335 K=1,3                                                      00321210
  335 ID(NODE,K)=P8(K)/XMX+XAD                                          00321220
      NODE=NODE+INC1                                                    00321230
  340 CONTINUE                                                          00321240
      NODE=NODE-NUMD2*INC1+INC2                                         00321250
  350 CONTINUE                                                          00321260
  500 CONTINUE                                                          00321270
  600 CONTINUE                                                          00321280
      RETURN                                                            00321290
      END                                                               00321300
      SUBROUTINE PTS1 (P1,P2,R,P3)                                              
        IMPLICIT REAL*8 (A-H,O-Z)                                       00183050
      DIMENSION P1(3),P2(3),P3(3)                                       00183060
      DX=P2(1)-P1(1)                                                    00183070
      DY=P2(2)-P1(2)                                                    00183080
      DZ=P2(3)-P1(3)                                                    00183090
      DEN=DSQRT(DX*DX+DY*DY+DZ*DZ)                                      00183100
      COSA=DX/DEN                                                       00183110
      COSB=DY/DEN                                                       00183120
      COSC=DZ/DEN                                                       00183130
      P3(1)=R*COSA+P1(1)                                                00183140
      P3(2)=R*COSB+P1(2)                                                00183150
      P3(3)=R*COSC+P1(3)                                                00183160
      RETURN                                                            00183170
      END                                                               00183180
