home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 14.ddi / MODLOAD.FOR < prev    next >
Encoding:
Text File  |  1987-04-03  |  25.3 KB  |  317 lines
  1.       SUBROUTINE LOAD1(LIMIT,NUMEL)                                     MOD03850
  2.       INTEGER AGET,AGETW                                                MOD03851
  3.       LOGICAL IGET,RGET                                                 MOD03852
  4.       COMMON  A(1)                                                      MOD03853
  5.       COMMON/ELARRY/NELAR(4,20)                                         MOD03854
  6.       COMMON/TLOAD1/LTOT1,LCASE,LKEY,NCUR,FAC1,MTOT1                    MOD03855
  7.       COMMON/ETITLE/TITLE(20)                                           MOD03856
  8.       COMMON/UNIT/IN,IO,IP,INP,INPF,ITER,IS6,I30,I57                    MOD03857
  9.       COMMON/TOTAL/MAXELM,MAXNOD,MAXNDM,MAXGRO                          MOD03858
  10.       COMMON/SAP6/ISAP6                                                 MOD03859
  11.       DIMENSION ICOM(60),ICC(20)                                        MOD03860
  12.       DATA ICOM(1)/1HL/,ICOM(2)/1HN/                                    MOD03861
  13.       DATA ICOM(3)/1HL/,ICOM(4)/1HW/                                    MOD03862
  14.       DATA ICOM(5)/1HL/,ICOM(6)/1HS/                                    MOD03863
  15.       DATA ICOM(7)/1HL/,ICOM(8)/1HV/                                    MOD03864
  16.       DATA ICOM(9)/1HL/,ICOM(10)/1HF/                                   MOD03865
  17.       DATA ICOM(11)/1HC/,ICOM(12)/1HC/                                  MOD03866
  18.       DATA BLANK/1H /,LLL/1HL/,HELP/4HHELP/                             MOD03867
  19.       MTOTAL=25000                                                      MOD03868
  20.       N1=1                                                              MOD03869
  21.       N2=N1+LIMIT                                                       MOD03870
  22.       N3=N2+LIMIT                                                       MOD03871
  23.       N4=N3+LIMIT                                                       MOD03872
  24.       N5=N4+LIMIT                                                       MOD03873
  25.       N6=N5+LIMIT                                                       MOD03874
  26.       N7=N6+LIMIT                                                       MOD03875
  27.       N8=N7+LIMIT                                                       MOD03876
  28.       IF(N8.GT.MTOTAL)CALL PRTERR(8)                                    MOD03877
  29.       IF(IGET(LKEY))CALL PRTERR(0)                                      MOD03878
  30.       IF(IGET(LCASE))CALL PRTERR(0)                                     MOD03879
  31.       IF(LKEY.LT.0.OR.LKEY.GT.6)LKEY=0                                  MOD03880
  32.       IF(LCASE.LE.0)LCASE=1                                             MOD03881
  33.       IF(ISAP6.EQ.1)GO TO 100                                           MOD03882
  34.       IF(IGET(NCUR))GO TO 100                                           MOD03883
  35.       IF(RGET(FAC1))GO TO 100                                           MOD03884
  36. 100   CALL GETNL(GET001)                                                MOD03885
  37.       I=AGETW(AG001)                                                    MOD03886
  38.       K=AGET(2)                                                         MOD03887
  39.       KEY=1                                                             MOD03888
  40.       DO 110 J=1,39,2                                                   MOD03889
  41.       L=J+1                                                             MOD03890
  42.       IF(ICOM(J).EQ.I.AND.ICOM(L).EQ.K)GO TO 120                        MOD03891
  43.       KEY=KEY+1                                                         MOD03892
  44. 110   CONTINUE                                                          MOD03893
  45.       WRITE(IO,111)I,K                                                  MOD03894
  46. 111   FORMAT('   ++ F ++ CONTROL KEY = ',A1,A1,'  IS ILLEGAL')          MOD03895
  47.       STOP                                                              MOD03896
  48. 120   GO TO (1,2,3,4,5,6),KEY                                           MOD03897
  49. 1     X=AGET(3)                                                         MOD03898
  50.       X=AGET(4)                                                         MOD03899
  51.       CALL LNODE1(LIMIT,A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7))      MOD03900
  52.       GO TO 100                                                         MOD03901
  53. 2     CALL LWRIT1(LIMIT,A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7))      MOD03902
  54.       RETURN                                                            MOD03903
  55. 3     ID2=2                                                             MOD03904
  56.       CALL LPRE2(ID2,LIMIT,A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7))   MOD03905
  57.       GO TO 100                                                         MOD03906
  58. 4     ID2=3                                                             MOD03907
  59.       CALL LPRE2(ID2,LIMIT,A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7))   MOD03908
  60.       GO TO 100                                                         MOD03909
  61. 5     CALL LFILL1(LIMIT,A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7))      MOD03910
  62. 6     GO TO 100                                                         MOD03911
  63.       END                                                               MOD03912
  64.       SUBROUTINE LNODE1(LIMIT,NSTOR,FX,FY,FZ,XM,YM,ZM)                  MOD03825
  65.       INTEGER AGET,AGETW                                                MOD03826
  66.       LOGICAL IGET,RGET                                                 MOD03827
  67.       DIMENSION NSTOR(LIMIT),FX(LIMIT),FY(LIMIT),FZ(LIMIT)              MOD03828
  68.      1,XM(LIMIT),YM(LIMIT),ZM(LIMIT),DUMMY(6)                           MOD03829
  69.       IF(IGET(N1))CALL PRTERR(0)                                        MOD03830
  70.       DO 10 I=1,6                                                       MOD03831
  71.       IF(RGET(DUMMY(I)))CALL PRTERR(0)                                  MOD03832
  72. 10    CONTINUE                                                          MOD03833
  73.       IF(IGET(N2))CALL PRTERR(0)                                        MOD03834
  74.       IF(IGET(INC))CALL PRTERR(0)                                       MOD03835
  75.       IF(N2.LE.0)N2=N1                                                  MOD03836
  76.       IF(INC.LE.0)INC=1                                                 MOD03837
  77.       DO 20 K=N1,N2,INC                                                 MOD03838
  78.       IF(K.GT.LIMIT)CALL PRTERR(7)                                      MOD03839
  79.       NSTOR(K)=K                                                        MOD03840
  80.       FX(K)=DUMMY(1)                                                    MOD03841
  81.       FY(K)=DUMMY(2)                                                    MOD03842
  82.       FZ(K)=DUMMY(3)                                                    MOD03843
  83.       XM(K)=DUMMY(4)                                                    MOD03844
  84.       YM(K)=DUMMY(5)                                                    MOD03845
  85.       ZM(K)=DUMMY(6)                                                    MOD03846
  86. 20    CONTINUE                                                          MOD03847
  87.       RETURN                                                            MOD03848
  88.       END                                                               MOD03849
  89.       SUBROUTINE LWRIT1(LIMIT,NSTOR,X,Y,Z,XM,YM,ZM)                     MOD03996
  90.       COMMON/UNIT/IN,IO,IPL,INP,INPF,ITER,IS6,I30,I57                   MOD03997
  91.       COMMON/SAP6/ISAP6                                                 MOD03998
  92.       COMMON/TLOAD1/LTOT1,LCASE,LKEY,NCUR,FAC1,MTOT1                    MOD03999
  93.       COMMON/FORCE/NLC1                                                 MOD04000
  94.       DIMENSION NSTOR(LIMIT),X(LIMIT),Y(LIMIT),Z(LIMIT)                 MOD04001
  95.      1,XM(LIMIT),YM(LIMIT),ZM(LIMIT)                                    MOD04002
  96.       IZERO=0                                                           MOD04003
  97.       LTOT1=0                                                           MOD04004
  98.       DO 3 I=1,LIMIT                                                    MOD04005
  99.       IF(NSTOR(I).LE.0)GO TO 3                                          MOD04006
  100.       LTOT1=LTOT1+1                                                     MOD04007
  101. 3     CONTINUE                                                          MOD04008
  102.       IF(ISAP6.EQ.1)WRITE(I57,10)LTOT1,LCASE,LKEY                       MOD04009
  103.       IF(ISAP6.NE.1)WRITE(I57,11)LTOT1,LCASE,LKEY,NCUR,FAC1             MOD04010
  104. 11    FORMAT(4I5,E14.7)                                                 MOD04011
  105. 10    FORMAT(3I5)                                                       MOD04012
  106.       I=0                                                               MOD04013
  107.       ICO=0                                                             MOD04014
  108. 20    I=I+1                                                             MOD04015
  109.       IF(I.GT.LIMIT)GO TO 100                                           MOD04016
  110.       IF(NSTOR(I).LE.0)GO TO 20                                         MOD04017
  111.       ICO=ICO+1                                                         MOD04018
  112.       J=NSTOR(I)                                                        MOD04019
  113.       IF(ISAP6.NE.1)GO TO 70                                            MOD04020
  114.       WRITE(I57,30)J,X(J),Y(J),Z(J),XM(J),YM(J),ZM(J)                   MOD04021
  115. 30    FORMAT(I5,6F15.5)                                                 MOD04022
  116. 31    NSTOR(I)=0                                                        MOD04023
  117.       X(J)=0                                                            MOD04024
  118.       Y(J)=0                                                            MOD04025
  119.       Z(J)=0                                                            MOD04026
  120.       XM(J)=0                                                           MOD04027
  121.       YM(J)=0                                                           MOD04028
  122.       ZM(J)=0                                                           MOD04029
  123.       GO TO 20                                                          MOD04030
  124. 70    IDIR=0                                                            MOD04031
  125.       JDIR=0                                                            MOD04032
  126.       XOUT=0.                                                           MOD04033
  127.       IF(X(J).EQ.0.)GO TO 71                                            MOD04034
  128.       IDIR=1                                                            MOD04035
  129.       JDIR=JDIR+1                                                       MOD04036
  130.       XOUT=X(J)                                                         MOD04037
  131. 71    IF(Y(J).EQ.0.)GO TO 72                                            MOD04038
  132.       IDIR=2                                                            MOD04039
  133.       JDIR=JDIR+2                                                       MOD04040
  134.       XOUT=Y(J)                                                         MOD04041
  135. 72    IF(Z(J).EQ.0.)GO TO 73                                            MOD04042
  136.       IDIR=3                                                            MOD04043
  137.       JDIR=JDIR+3                                                       MOD04044
  138.       XOUT=Z(J)                                                         MOD04045
  139. 73    IF(XM(J).EQ.0.)GO TO 74                                           MOD04046
  140.       IDIR=4                                                            MOD04047
  141.       JDIR=JDIR+4                                                       MOD04048
  142.       XOUT=XM(J)                                                        MOD04049
  143. 74    IF(YM(J).EQ.0.)GO TO 75                                           MOD04050
  144.       IDIR=5                                                            MOD04051
  145.       JDIR=JDIR+5                                                       MOD04052
  146.       XOUT=YM(J)                                                        MOD04053
  147. 75    IF(ZM(J).EQ.0.)GO TO 76                                           MOD04054
  148.       IDIR=6                                                            MOD04055
  149.       JDIR=JDIR+6                                                       MOD04056
  150.       XOUT=ZM(J)                                                        MOD04057
  151. 76    IF(IDIR.EQ.0)WRITE(IO,91)J                                        MOD04058
  152. 91    FORMAT(' ++ W ++  NODE =',I5,'  HAS ZERO COMPONENTS')             MOD04059
  153.       IF(IDIR.EQ.JDIR)GO TO 80                                          MOD04060
  154.       WRITE(IO,92)J                                                     MOD04061
  155. 92    FORMAT(' ++ F ++  MORE THAN ONE COMPONENT WAS GENERATED FOR '     MOD04062
  156.      1,'NODE NUMBE =',I5)                                               MOD04063
  157.       STOP                                                              MOD04064
  158. 80    WRITE(I57,82)J,X(J),Y(J),Z(J),XM(J),YM(J),ZM(J),IDIR              MOD04065
  159. 82    FORMAT(I5,6F15.5,I5)                                              MOD04066
  160.       GO TO 31                                                          MOD04067
  161. 100   WRITE(IO,200)LKEY,LCASE,ICO                                       MOD04068
  162. 200   FORMAT(10X,'FOR KEY=',I2,' LOAD CASE =',I3                        MOD04069
  163.      1,' TOTAL GENERATED =',I5)                                         MOD04070
  164.       WRITE(I57,210)IZERO                                               MOD04071
  165. 210   FORMAT(I5)                                                        MOD04072
  166.       MTOT1=MTOT1+ICO                                                   MOD04073
  167.       NLC1=1                                                            MOD04074
  168.       RETURN                                                            MOD04075
  169.       END                                                               MOD04076
  170.       SUBROUTINE LFILL1(LIMIT,NSTOR,X,Y,Z,XM,YM,ZM)                     MOD03706
  171.       LOGICAL IGET,RGET                                                 MOD03707
  172.       INTEGER AGET,AGETW                                                MOD03708
  173.       DIMENSION NSTOR(LIMIT),X(LIMIT),Y(LIMIT),Z(LIMIT)                 MOD03709
  174.      1,XM(LIMIT),YM(LIMIT),ZM(LIMIT)                                    MOD03710
  175.       DATA IBLANK/1H /                                                  MOD03711
  176.       IDOUM=AGET(4)                                                     MOD03712
  177.       IDOUM=AGET(5)                                                     MOD03713
  178.       IF(IGET(NTIM))CALL PRTERR(0)                                      MOD03714
  179.       IF(IGET(N1))CALL PRTERR(0)                                        MOD03715
  180.       IF(IGET(N2))CALL PRTERR(0)                                        MOD03716
  181.       IF(IGET(NFILL))CALL PRTERR(0)                                     MOD03717
  182.       IF(IGET(NSTRT))CALL PRTERR(0)                                     MOD03718
  183.       IF(IGET(INC))CALL PRTERR(0)                                       MOD03719
  184.       IF(IGET(IADD))CALL PRTERR(0)                                      MOD03720
  185.       IF(IGET(IADD2))CALL PRTERR(0)                                     MOD03721
  186.       IF(NTIM.LE.0)NTIM=1                                               MOD03722
  187.       IF(N1.LE.0)N1=1                                                   MOD03723
  188.       IF(N2.NE.0)GO TO 12                                               MOD03724
  189.       DO 14 I=1,LIMIT                                                   MOD03725
  190.       IF(NSTOR(I).EQ.0)GO TO 14                                         MOD03726
  191.       IF(NSTOR(I).GT.N2)N2=NSTOR(I)                                     MOD03727
  192. 14    CONTINUE                                                          MOD03728
  193. 12    IF(N2.GT.N1)GO TO 15                                              MOD03729
  194.       LAB=N1                                                            MOD03730
  195.       N1=N2                                                             MOD03731
  196.       N2=LAB                                                            MOD03732
  197. 15    IF(NFILL.EQ.0)NFILL=N2-N1-1                                       MOD03733
  198.       IF(INC.EQ.0)INC=(N2-N1)/(NFILL+1)                                 MOD03734
  199.       IF(NSTRT.EQ.0)NSTRT=N1+INC                                        MOD03735
  200.       IF(IADD.EQ.0)IADD=1                                               MOD03736
  201.       DO 100 I=1,NTIM                                                   MOD03737
  202.       SUM=NFILL+1                                                       MOD03738
  203.       XS=(X(N2)-X(N1))/SUM                                              MOD03739
  204.       YS=(Y(N2)-Y(N1))/SUM                                              MOD03740
  205.       ZS=(Z(N2)-Z(N1))/SUM                                              MOD03741
  206.       XMS=(XM(N2)-XM(N1))/SUM                                           MOD03742
  207.       YMS=(YM(N2)-YM(N1))/SUM                                           MOD03743
  208.       ZMS=(ZM(N2)-ZM(N1))/SUM                                           MOD03744
  209.       N=NSTRT                                                           MOD03745
  210.       NSTOR(N)=N                                                        MOD03746
  211.       X(N)=X(N1)+XS                                                     MOD03747
  212.       Y(N)=Y(N1)+YS                                                     MOD03748
  213.       Z(N)=Z(N1)+ZS                                                     MOD03749
  214.       XM(N)=XM(N1)+XMS                                                  MOD03750
  215.       YM(N)=YM(N1)+YMS                                                  MOD03751
  216.       ZM(N)=ZM(N1)+ZMS                                                  MOD03752
  217.       IF(NFILL.EQ.1)GO TO 90                                            MOD03753
  218.       DO 50 J=2,NFILL                                                   MOD03754
  219.       N=N+INC                                                           MOD03755
  220.       NSTOR(N)=N                                                        MOD03756
  221.       X(N)=X(N1)+XS*J                                                   MOD03757
  222.       Y(N)=Y(N1)+YS*J                                                   MOD03758
  223.       Z(N)=Z(N1)+ZS*J                                                   MOD03759
  224.       XM(N)=XM(N1)+XMS*J                                                MOD03760
  225.       YM(N)=YM(N1)+YMS*J                                                MOD03761
  226.       ZM(N)=ZM(N1)+ZMS*J                                                MOD03762
  227. 50    CONTINUE                                                          MOD03763
  228. 90    N1=N1+IADD                                                        MOD03764
  229.       N2=N2+IADD                                                        MOD03765
  230.       NSTRT=NSTRT+IADD+IADD2                                            MOD03766
  231. 100   CONTINUE                                                          MOD03767
  232.       RETURN                                                            MOD03768
  233.       END                                                               MOD03769
  234.       SUBROUTINE LPRE2(I2D,LIMIT,NSTOR,X,Y,Z,XM,YM,ZM)                  MOD03913
  235.       LOGICAL IGET,RGET                                                 MOD03914
  236.       INTEGER AGET,AGETW                                                MOD03915
  237.       DIMENSION NSTOR(LIMIT),X(LIMIT),Y(LIMIT),Z(LIMIT)                 MOD03916
  238.      1,XM(LIMIT),YM(LIMIT),ZM(LIMIT)                                    MOD03917
  239.       DIMENSION XID(20,4),IDUM(20)                                      MOD03918
  240.       DATA BLANK/1H /                                                   MOD03919
  241.       ICO=8                                                             MOD03920
  242.       DO 12 I=1,20                                                      MOD03921
  243.       DO 12 J=1,4                                                       MOD03922
  244.       XID(I,J)=0.0                                                      MOD03923
  245. 12    CONTINUE                                                          MOD03924
  246.       IF(I2D.NE.2)GO TO 200                                             MOD03925
  247.       DO 2 JJ=3,8                                                       MOD03926
  248.       IJS=AGET(JJ)                                                      MOD03927
  249. 2     CONTINUE                                                          MOD03928
  250.       IF(IGET(INCS))CALL PRTERR(0)                                      MOD03929
  251.       IF(IGET(INCT))CALL PRTERR(0)                                      MOD03930
  252.       IF(RGET(PERS))CALL PRTERR(0)                                      MOD03931
  253.       IF(RGET(PERT))CALL PRTERR(0)                                      MOD03932
  254.       IF(IGET(KS1))CALL PRTERR(0)                                       MOD03933
  255.       INCR=1                                                            MOD03934
  256.       INCR1=INCR                                                        MOD03935
  257.       INCS1=INCS                                                        MOD03936
  258.       INCT1=INCT                                                        MOD03937
  259.       PERS1=PERS                                                        MOD03938
  260.       PERT1=PERT                                                        MOD03939
  261.       PERR=100                                                          MOD03940
  262.       PERR1=PERR                                                        MOD03941
  263. 20    CONTINUE                                                          MOD03942
  264.       CALL GETNL(GET001)                                                MOD03943
  265.       DO 21 M=1,ICO                                                     MOD03944
  266.       IF(IGET(IDUM(M)))CALL PRTERR(0)                                   MOD03945
  267. 21    CONTINUE                                                          MOD03946
  268.       DO 22 M=1,ICO                                                     MOD03947
  269.       K=IDUM(M)                                                         MOD03948
  270.       XID(M,1)=K                                                        MOD03949
  271.       XID(M,2)=X(K)                                                     MOD03950
  272.       XID(M,3)=Y(K)                                                     MOD03951
  273.       XID(M,4)=Z(K)                                                     MOD03952
  274. 22    CONTINUE                                                          MOD03953
  275. 30    CALL MESHGE(XID,INCS,INCT,INCR,PERS,PERT,PERR,I2D,KS1             MOD03954
  276.      1,LIMIT,NSTOR,X,Y,Z)                                               MOD03955
  277.       INCS=INCS1                                                        MOD03956
  278.       INCT=INCT1                                                        MOD03957
  279.       INCT=INCT1                                                        MOD03958
  280.       PERS=PERS1                                                        MOD03959
  281.       PERT=PERT1                                                        MOD03960
  282.       PERR=PERR1                                                        MOD03961
  283.       DO 50 M1M=1,20                                                    MOD03962
  284.       DO 50 M2M=1,4                                                     MOD03963
  285.       XID(M1M,M2M)=0.0                                                  MOD03964
  286. 50    CONTINUE                                                          MOD03965
  287.       DO 24 M=1,ICO                                                     MOD03966
  288.       K=IDUM(M)                                                         MOD03967
  289.       XID(M,1)=K                                                        MOD03968
  290.       XID(M,2)=XM(K)                                                    MOD03969
  291.       XID(M,3)=YM(K)                                                    MOD03970
  292.       XID(M,4)=ZM(K)                                                    MOD03971
  293. 24    CONTINUE                                                          MOD03972
  294.       CALL MESHGE(XID,INCS,INCT,INCR,PERS,PERT,PERR,I2D,KS1             MOD03973
  295.      1,LIMIT,NSTOR,XM,YM,ZM)                                            MOD03974
  296.       RETURN                                                            MOD03975
  297. 200   CONTINUE                                                          MOD03976
  298.       DO 3 JJ=3,7                                                       MOD03977
  299.       IJK=AGET(JJ)                                                      MOD03978
  300. 3     CONTINUE                                                          MOD03979
  301.       IF(IGET(INCS))CALL PRTERR(0)                                      MOD03980
  302.       IF(IGET(INCT))CALL PRTERR(0)                                      MOD03981
  303.       IF(IGET(INCR))CALL PRTERR(0)                                      MOD03982
  304.       IF(RGET(PERS))CALL PRTERR(0)                                      MOD03983
  305.       IF(RGET(PERT))CALL PRTERR(0)                                      MOD03984
  306.       IF(RGET(PERR))CALL PRTERR(0)                                      MOD03985
  307.       IF(IGET(KS1))CALL PRTERR(0)                                       MOD03986
  308.       INCS1=INCS                                                        MOD03987
  309.       INCT1=INCT                                                        MOD03988
  310.       INCR1=INCR                                                        MOD03989
  311.       PERS1=PERS                                                        MOD03990
  312.       PERT1=PERT                                                        MOD03991
  313.       PERR1=PERR                                                        MOD03992
  314.       ICO=20                                                            MOD03993
  315.       GO TO 20                                                          MOD03994
  316.       END                                                               MOD03995
  317.