home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 14.ddi / PRE2.FOR < prev    next >
Encoding:
Text File  |  1987-04-02  |  6.7 KB  |  85 lines
  1.       SUBROUTINE PRE2(I2D,LIMIT,IELM,NSTOR,X,Y,Z,CXY)                   MOD04902
  2.       LOGICAL IGET,RGET                                                 MOD04903
  3.       INTEGER AGET,AGETW                                                MOD04904
  4.       DIMENSION NSTOR(LIMIT),X(LIMIT),Y(LIMIT),Z(LIMIT)                 MOD04905
  5.       DIMENSION XID(20,4),IDUM(20)                                      MOD04906
  6.       COMMON/UNIT/IN,IO,IP,INP                                          MOD04907
  7.       DATA BLANK/1H /                                                   MOD04908
  8.       IDD=I2D                                                           MOD04909
  9.       DO 12 I=1,20                                                      MOD04910
  10.       DO 12 J=1,4                                                       MOD04911
  11.       XID(I,J)=0.0                                                      MOD04912
  12. 12    CONTINUE                                                          MOD04913
  13.       IF(IDD.NE.2)GO TO 200                                             MOD04914
  14.       DO 2 JJ=3,7                                                       MOD04915
  15.       IJS=AGET(JJ)                                                      MOD04916
  16. 2     CONTINUE                                                          MOD04917
  17.       IF(IGET(INCS))CALL PRTERR(0)                                      MOD04918
  18.       IF(IGET(INCT))CALL PRTERR(0)                                      MOD04919
  19.       IF(RGET(PERS))CALL PRTERR(0)                                      MOD04920
  20.       IF(RGET(PERT))CALL PRTERR(0)                                      MOD04921
  21.       IF(IGET(KS1))CALL PRTERR(0)                                       MOD04922
  22.       INCR=1                                                            MOD04923
  23.       PERR=100                                                          MOD04924
  24. 20    M=1                                                               MOD04925
  25. 21    CALL GETNL(GET001)                                                MOD04926
  26.       IF(IGET(K))CALL PRTERR(0)                                         MOD04927
  27.       IF(K.EQ.-1)GO TO 30                                               MOD04928
  28.       XID(M,1)=K                                                        MOD04929
  29.       IF(RGET(XID(M,2)))CALL PRTERR(0)                                  MOD04930
  30.       IF(RGET(XID(M,3)))CALL PRTERR(0)                                  MOD04931
  31.       IF(RGET(XID(M,4)))CALL PRTERR(0)                                  MOD04932
  32.       M=M+1                                                             MOD04933
  33.       GO TO 21                                                          MOD04934
  34. 30    CALL MESHGE(XID,INCS,INCT,INCR,PERS,PERT,PERR,IDD,KS1             MOD04935
  35.      1,LIMIT,NSTOR,X,Y,Z)                                               MOD04936
  36.       RETURN                                                            MOD04937
  37. 200   CONTINUE                                                          MOD04938
  38.       IF(IDD.NE.3)GO TO 300                                             MOD04939
  39.       DO 3 JJ=3,6                                                       MOD04940
  40.       IJK=AGET(JJ)                                                      MOD04941
  41. 3     CONTINUE                                                          MOD04942
  42.       IF(IGET(INCS))CALL PRTERR(0)                                      MOD04943
  43.       IF(IGET(INCT))CALL PRTERR(0)                                      MOD04944
  44.       IF(IGET(INCR))CALL PRTERR(0)                                      MOD04945
  45.       IF(RGET(PERS))CALL PRTERR(0)                                      MOD04946
  46.       IF(RGET(PERT))CALL PRTERR(0)                                      MOD04947
  47.       IF(RGET(PERR))CALL PRTERR(0)                                      MOD04948
  48.       IF(IGET(KS1))CALL PRTERR(0)                                       MOD04949
  49.       GO TO 20                                                          MOD04950
  50. 300   CONTINUE                                                          MOD04951
  51.       IF(IDD.NE.4)GO TO 400                                             MOD04952
  52.       ICO=8                                                             MOD04953
  53.       IDD=2                                                             MOD04954
  54.       IF(IGET(INCS))CALL PRTERR(0)                                      MOD04955
  55.       IF(IGET(INCT))CALL PRTERR(0)                                      MOD04956
  56.       IF(RGET(PERS))CALL PRTERR(0)                                      MOD04957
  57.       IF(RGET(PERT))CALL PRTERR(0)                                      MOD04958
  58.       IF(IGET(KS1))CALL PRTERR(0)                                       MOD04959
  59.       INCR=1                                                            MOD04960
  60.       PERR=100                                                          MOD04961
  61. 310   CALL GETNL(GET001)                                                MOD04962
  62.       DO 221 M=1,ICO                                                    MOD04963
  63.       IF(IGET(IDUM(M)))CALL PRTERR(0)                                   MOD04964
  64. 221   CONTINUE                                                          MOD04965
  65.       DO 22 M=1,ICO                                                     MOD04966
  66.       K=IDUM(M)                                                         MOD04967
  67.       XID(M,1)=K                                                        MOD04968
  68.       XID(M,2)=X(K)                                                     MOD04969
  69.       XID(M,3)=Y(K)                                                     MOD04970
  70.       XID(M,4)=Z(K)                                                     MOD04971
  71. 22    CONTINUE                                                          MOD04972
  72.       GO TO 30                                                          MOD04973
  73. 400   CONTINUE                                                          MOD04974
  74.       IDD=3                                                             MOD04975
  75.       IF(IGET(INCS))CALL PRTERR(0)                                      MOD04976
  76.       IF(IGET(INCT))CALL PRTERR(0)                                      MOD04977
  77.       IF(IGET(INCR))CALL PRTERR(0)                                      MOD04978
  78.       IF(RGET(PERS))CALL PRTERR(0)                                      MOD04979
  79.       IF(RGET(PERT))CALL PRTERR(0)                                      MOD04980
  80.       IF(RGET(PERR))CALL PRTERR(0)                                      MOD04981
  81.       IF(IGET(KS1))CALL PRTERR(0)                                       MOD04982
  82.       ICO=20                                                            MOD04983
  83.       GO TO 310                                                         MOD04984
  84.       END                                                               MOD04985
  85.