%%HP: T(3)A(D)F(.);
DIR

;*************************************************************************
  
  DEQ                                
    
    \<< RCLF \-> flags
     \<<  -56 CF 
          DEQINPUT 
          CLLCD "  I'm searching ..." 3 DISP 
          
          initvalues DUP DUP 'xyvalues' STO DEQXYSTO 
                     OBJ\-> 1 GET 1 + 1 \->LIST         ;add also value of
                     functions degree GET \->NUM        ;highest derivative 
                     SWAP \->ARRY CL\GS \GS+            ;of y(x) to äDAT
          
          IFERR DO    1 DEQRUNGE
                UNTIL xyvalues 1 GET xmax \>=
                END
          
                initvalues DUP 'xyvalues' STO DEQXYSTO
          
                DO    -1 DEQRUNGE
                UNTIL xyvalues 1 GET xmin \<=
                END 
          THEN  ERRM "program killed" \->TAG
          END

          'X' 'Y0'                                      ;     
          degree 1 >                                    ;clear
          \<< 1 degree 1 -                              ;memory
              FOR n "'Y" n + "'" + STR\->               ;of    
              NEXT                                      ;global 
          \>> IFT                                       ;vari- 
          degree 1 + \->LIST                            ;ables
          'xyvalues' + 'kmatrix' + PURGE                ;       
          
          1 XCOL 2 YCOL 1000 .01 BEEP                   ;plot
          SCATRPLOT DRAX GRAPH FUNCTION                 ;result  

          flags STOF
      \>>
    \>>

  
;**********************************************************************  
  
  DEQINPUT                                              ;enter values
                                                        ;needed for DEQ
    \<< ": degree of diff.eq  :" "" INPUT 
        DUP IF "" SAME 
            THEN DROP
            ELSE OBJ\-> 'degree' STO
            END 
        
        
        { X Y0 Y1 Y2 Y3 Y4 } TMENU 
        "" 
        ":enter Y" degree + 
        "(X;Y0;Y1;..) 
        No discontin.! Edit
        rest for deq-sys.  :
        :\.dX(Y" + degree 1 - + ")=Y" + degree + ": ''" + 
        degree 1 >
        \<< 2 degree FOR n
                     "        
                      :\.dX(Y" + degree n - + 
                     ")   : 'Y" + degree n - 1 + + 
                     "'" +
                     NEXT
        \>> IFT 
        { 4 14 } ALG 3 \->LIST INPUT
        0 MENU 
        IFERR DUP "\.d" POS 1 - 2 PICK SIZE SUB 
              OBJ\-> 1 \->LIST
              degree 1 >
              \<< 2 degree START SWAP +
                           NEXT
              \>> IFT
              'functions' STO
        THEN  DROP
        END 
        
        
        ""
        ": enter init. val.  :
         :   xo :              
         :Y0(xo):"
        degree 1 >
        \<< 1 degree 1 - FOR n
                         "              
                         :Y" + n + "(xo):" +
                         NEXT
        \>> IFT { 2 9 } 2 \->LIST INPUT
        IFERR OBJ\-> 
              1 degree 1 + 
              START \->NUM degree 1 + ROLLD
              NEXT 
              degree 1 + \->ARRY 'initvalues' STO
        THEN  DROP
        END

        
        ":      x-range       :
          (should include xo)"
        { ":xmin=:
           :xmax=:" 8 } INPUT
        IFERR OBJ\-> 
              DUP2 MAX \->NUM 'xmax' STO 
                   MIN \->NUM 'xmin' STO
        THEN  DROP
        END

        
        ":      stepsize      :"
        "" INPUT
        IF   DUP "" SAME
        THEN DROP
        ELSE OBJ\-> ABS \->NUM 'h' STO
        END
    \>>
  


;**************************************************************************
  
  DEQXYSTO
    
    \<< \-> vector
      \<< vector 1 GETI 'X' STO GET 'Y0' STO 
          degree 1 >
          \<< 1 degree 1 -
              FOR n vector n 2 + GET "'Y" n + "'" + STR\-> STO
              NEXT
          \>> IFT
       \>>
    \>>
  
  
;**************************************************************************  
  
  DEQRUNGE                                            

    \<< \-> direction
      \<< 4 degree 2 \->LIST 0 CON 'kmatrix' STO    ;generate array for
                                                    ;temporary needed k's
                                                    ;       y0 y1 y2 ..
                                                    ; k1 [[          .. ]
                                                    ; k2  [          .. ]
                                                    ; k3  [          .. ]
                                                    ; k4  [          .. ]]
          1 4
          FOR k 
              1 degree
              FOR n functions n GET EVAL h * direction *     ;fill    
                  kmatrix SWAP k n 2 \->LIST SWAP PUT        ;row of    
                  'kmatrix' STO                              ;present k
              NEXT                                           ;in 'kmatrix'
              
              k 3 \<=                                        ;calcul-  
              \<< h direction * { 2 2 1 } k GET /            ;ate     
                  1 degree                                   ;x-      
                  FOR column kmatrix k column 2 \->LIST GET  ;y-    
                      { 2 2 1 } k GET /                      ;values
                  NEXT                                       ;for 
                  degree 1 + \->ARRY xyvalues + DEQXYSTO     ;next
              \>> IFT                                        ;k
          NEXT 
          
          h direction *                                      ;dx-value
          
          1 degree                                           ;calcul- 
          FOR n                                              ;ate         
              1 4                                            ;dy-   
              FOR k                                          ;values 
                  kmatrix k n 2 \->LIST GET                  ;(result   
                  { 6 3 3 6 } k GET /                        ;of  
              NEXT                                           ;Runge-
              + + +                                          ;Kutta-
          NEXT                                               ;approx-
          degree 1 + \->ARRY                                 ;imation )   
          
          xyvalues +
          DUP DUP 'xyvalues' STO DEQXYSTO          ;store new x-y-values
                  OBJ\-> 1 GET 1 + 1 \->LIST       ;in 'xyvalues' and in     
                  functions degree GET EVAL        ;äDAT also highest    
                  SWAP \->ARRY \GS+                ;derivative of y(x) 
                  
          CLLCD
          "|\175\175\175\175\175\175\175\175\175\175\175\175\175\175\175\175\175\175\175\175|
          "
          "| x=                 |
          " 5 xyvalues 1 GET \->STR REPL +
          "| y=                 |
          " 5 xyvalues 2 GET \->STR REPL +
          "|____________________|

              is part of Y0(X)" + 2 DISP
      \>>
    \>>


END