Fix Windows compilation using Visual Express. 99/8199/4
Vincent COUVERT [Thu, 19 Jul 2012 14:55:19 +0000 (16:55 +0200)]
Change-Id: Id905c757d3e31f77507b4f259883a741c444088f

56 files changed:
scilab/Scilab_f2c.sln
scilab/modules/boolean/src/fortran/boolean_f2c.vcxproj
scilab/modules/boolean/src/fortran/boolean_f2c.vcxproj.filters
scilab/modules/core/src/fortran/core_f2c.vcxproj
scilab/modules/core/src/fortran/core_f2c.vcxproj.filters
scilab/modules/data_structures/src/fortran/data_structures_f2c.vcxproj
scilab/modules/data_structures/src/fortran/data_structures_f2c.vcxproj.filters
scilab/modules/differential_equations/sci_gateway/fortran/bbvode.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/bfeval.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/bjac.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/bjacd.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/bresd.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/bsurf.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/bsurfd.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/bydot.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/bydot2.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/int2d.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/int3d.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/intg.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_bvode.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_dasrt.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_dassl.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_feval.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_impl.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_ode.f [deleted file]
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_odedc.f [deleted file]
scilab/modules/differential_equations/src/c/colnewtable.c [deleted file]
scilab/modules/differential_equations/src/c/dassltable.c [deleted file]
scilab/modules/differential_equations/src/c/differential_equations.vcxproj.filters
scilab/modules/differential_equations/src/c/differential_equations_f_Import.def
scilab/modules/differential_equations/src/c/fevaltable.c [deleted file]
scilab/modules/differential_equations/src/c/fydot2table.c [deleted file]
scilab/modules/differential_equations/src/c/fydottable.c [deleted file]
scilab/modules/differential_equations/src/c/impltable.c [deleted file]
scilab/modules/differential_equations/src/c/int2dtable.c [deleted file]
scilab/modules/differential_equations/src/c/int3dtable.c [deleted file]
scilab/modules/differential_equations/src/c/intgtable.c [deleted file]
scilab/modules/differential_equations/src/fortran/differential_equations_Import.def
scilab/modules/differential_equations/src/fortran/differential_equations_f2c.vcxproj
scilab/modules/differential_equations/src/fortran/differential_equations_f2c.vcxproj.filters
scilab/modules/dynamic_link/src/cpp/dynamic_link.cpp
scilab/modules/elementary_functions/sci_gateway/cpp/elem_func_gw/elem_func_gw.vcxproj
scilab/modules/elementary_functions/src/cpp/elem_func/elem_func.vcxproj
scilab/modules/elementary_functions/src/fortran/elementary_functions_f2c.vcxproj
scilab/modules/elementary_functions/src/fortran/elementary_functions_f2c.vcxproj.filters
scilab/modules/fileio/src/c/getshortpathname.c
scilab/modules/functions/src/fortran/functions_f2c.vcxproj
scilab/modules/functions/src/fortran/functions_f2c.vcxproj.filters
scilab/modules/history_manager/sci_gateway/cpp/history_manager_gw.vcxproj
scilab/modules/io/src/fortran/io_f2c.vcxproj
scilab/modules/io/src/fortran/io_f2c.vcxproj.filters
scilab/modules/operations/operations.vcxproj
scilab/modules/output_stream/src/fortran/output_stream_f2c.vcxproj
scilab/modules/output_stream/src/fortran/output_stream_f2c.vcxproj.filters
scilab/modules/signal_processing/src/fortran/signal_processing_f2c.vcxproj
scilab/modules/signal_processing/src/fortran/signal_processing_f2c.vcxproj.filters

index 157134a..9aef6ab 100644 (file)
@@ -51,7 +51,6 @@ Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "core", "modules\core\src\c\
                {C8C13A46-DEB8-44AA-8BF8-C9BBC7FA0B46} = {C8C13A46-DEB8-44AA-8BF8-C9BBC7FA0B46}
                {C2EDD447-BB60-41A1-973B-8213FCA9ECD4} = {C2EDD447-BB60-41A1-973B-8213FCA9ECD4}
                {4FC72D4A-80EE-4B1A-8724-0201C1A35621} = {4FC72D4A-80EE-4B1A-8724-0201C1A35621}
-               {97B3664E-1186-400A-AEC0-AC3F23087689} = {97B3664E-1186-400A-AEC0-AC3F23087689}
                {C4C3EA58-1C27-4EFB-A5BF-0DB24EC5F87A} = {C4C3EA58-1C27-4EFB-A5BF-0DB24EC5F87A}
                {BB8D4E6F-F09E-49FC-8BCB-9F496F639F60} = {BB8D4E6F-F09E-49FC-8BCB-9F496F639F60}
                {0BB16C71-0FCD-4FB9-B7C0-F2601330C980} = {0BB16C71-0FCD-4FB9-B7C0-F2601330C980}
@@ -87,7 +86,6 @@ Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "core", "modules\core\src\c\
                {EAF0949C-28D2-497C-954F-FC13B32FF2F3} = {EAF0949C-28D2-497C-954F-FC13B32FF2F3}
                {B7A168A0-DFC0-4C6D-B0CC-6079912A4A76} = {B7A168A0-DFC0-4C6D-B0CC-6079912A4A76}
                {620D8FA7-3704-438E-BB1E-391C84401A2E} = {620D8FA7-3704-438E-BB1E-391C84401A2E}
-               {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2} = {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}
                {8BA2DDA8-BD04-4D4D-8EE6-6CAA955F7470} = {8BA2DDA8-BD04-4D4D-8EE6-6CAA955F7470}
                {C7865CAA-EC7C-41EB-8324-2B81C384CA20} = {C7865CAA-EC7C-41EB-8324-2B81C384CA20}
                {CCCE1EAD-8E62-4DC0-AB17-972C06EF0C89} = {CCCE1EAD-8E62-4DC0-AB17-972C06EF0C89}
@@ -216,10 +214,6 @@ Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "libmat", "modules\mexlib\sr
                {64E090DA-DCB5-4F4D-93D7-E88DDEC9C2EF} = {64E090DA-DCB5-4F4D-93D7-E88DDEC9C2EF}
        EndProjectSection
 EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "libmx", "modules\mexlib\src\libmx\libmx.vcxproj", "{CEF88C5F-6820-46D4-BCCD-44D5581481C5}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "libmat", "modules\mexlib\src\libmat\libmat.vcxproj", "{8A508625-C2AA-4295-AA76-16E4E456D13D}"
-EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "SetupAtlas", "tools\SetupAtlas\SetupAtlas.vcxproj", "{AAFF2053-3F1E-4B8B-B174-4407A6B98FA5}"
 EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "CheckHelp", "modules\helptools\src\CheckHelp\CheckHelp.vcxproj", "{1697EEE6-935C-4B9D-AD6A-5707DC120A1A}"
@@ -315,13 +309,6 @@ Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "differential_equations_f",
                {3170E4C2-1173-4264-A222-7EE8CCB3DDF7} = {3170E4C2-1173-4264-A222-7EE8CCB3DDF7}
        EndProjectSection
 EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "double", "modules\double\src\c\double.vcxproj", "{E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "double_f", "modules\double\src\fortran\double_f2c.vcxproj", "{97B3664E-1186-400A-AEC0-AC3F23087689}"
-       ProjectSection(ProjectDependencies) = postProject
-               {3170E4C2-1173-4264-A222-7EE8CCB3DDF7} = {3170E4C2-1173-4264-A222-7EE8CCB3DDF7}
-       EndProjectSection
-EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "boolean", "modules\boolean\src\c\boolean.vcxproj", "{8AB8ECEC-8C22-475E-80D0-E14696F5A19B}"
 EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "boolean_f", "modules\boolean\src\fortran\boolean_f2c.vcxproj", "{45ECEB36-A12B-42F5-9D7A-216A0E70601D}"
@@ -367,8 +354,6 @@ Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "dynamiclibrary", "libs\dyna
 EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "nographics", "modules\graphics\src\nographics\nographics.vcxproj", "{0AC1142C-0EFF-4406-9E5D-6111A7A8F614}"
 EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "nographics", "modules\graphics\src\nographics\nographics.vcxproj", "{0AC1142C-0EFF-4406-9E5D-6111A7A8F614}"
-EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "renderer", "modules\renderer\renderer.vcxproj", "{B23B01C1-A545-4BA0-9950-7BCADE201C5B}"
 EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "console", "modules\console\src\c\console.vcxproj", "{445D3B85-C9B1-498B-9C88-0A3C2390B1CC}"
@@ -576,6 +561,8 @@ Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "ui_data", "modules\ui_data\
 EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "scinotes", "modules\scinotes\src\c\scinotes.vcxproj", "{BAE68B54-2C1A-44D0-A0E9-05156A784E79}"
 EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "parallel", "modules\parallel\src\c\parallel.vcxproj", "{56A2E2F3-26CF-45D5-BE7A-534C39CD7003}"
+EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "commons", "modules\commons\src\c\commons.vcxproj", "{ECA09A1E-6D12-4A47-92E1-A671C181DF77}"
 EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "javasci-JAVA-tests", "modules\javasci\tests\java\javasci-JAVA-tests.vcxproj", "{9BE8D73A-7E83-46ED-A9E2-1E3472F52AE5}"
@@ -629,17 +616,25 @@ Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "ant-all", "Visual-Studio-se
                {DD8A0506-8D31-4CF8-856A-C10ECE9C13A4} = {DD8A0506-8D31-4CF8-856A-C10ECE9C13A4}
        EndProjectSection
 EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "differential_equations_gw", "modules\differential_equations\sci_gateway\differential_equations_gw.vcxproj", "{99D6BDD6-2226-43A1-B0FA-9D412BBCA6DD}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "preferences", "modules\preferences\src\c\preferences.vcxproj", "{7B893E9F-D032-44DE-9B71-197A29C4989B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "swig-all", "Visual-Studio-settings\swig-all\swig-all.vcxproj", "{85303A11-CF6B-432F-B3FD-24DEFFB51025}"
+EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "graphic_objects", "modules\graphic_objects\src\c\graphic_objects.vcxproj", "{30F9EE41-587B-4618-8DE7-698D3FBA4985}"
        ProjectSection(ProjectDependencies) = postProject
                {DD8A0506-8D31-4CF8-856A-C10ECE9C13A4} = {DD8A0506-8D31-4CF8-856A-C10ECE9C13A4}
        EndProjectSection
 EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "preferences", "modules\preferences\src\c\preferences.vcxproj", "{7B893E9F-D032-44DE-9B71-197A29C4989B}"
-EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "test-level", "Visual-Studio-settings\test-level\test-level.vcxproj", "{07F766A8-A2C1-4D9D-86DE-FD9C19952C7A}"
 EndProject
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "nographic_objects", "modules\graphic_objects\src\nographic_objects\nographic_objects.vcxproj", "{A910BD0C-8FAF-4382-B06A-F767E4752733}"
 EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "gui_gw", "modules\gui\sci_gateway\cpp\gui_gw.vcxproj", "{83C04253-B152-4EF6-BB36-35A7B0FDFB98}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "graphics_gw", "modules\graphics\sci_gateway\cpp\graphics_gw.vcxproj", "{61B23D9B-3F73-4204-98F7-6F41218F4564}"
+EndProject
 Global
        GlobalSection(SolutionConfigurationPlatforms) = preSolution
                Debug|Win32 = Debug|Win32
@@ -1132,22 +1127,6 @@ Global
                {28E4E9CA-3EEC-43EE-9F15-56259C6677B8}.Release|Win32.Build.0 = Release|Win32
                {28E4E9CA-3EEC-43EE-9F15-56259C6677B8}.Release|x64.ActiveCfg = Release|x64
                {28E4E9CA-3EEC-43EE-9F15-56259C6677B8}.Release|x64.Build.0 = Release|x64
-               {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}.Debug|Win32.ActiveCfg = Debug|Win32
-               {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}.Debug|Win32.Build.0 = Debug|Win32
-               {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}.Debug|x64.ActiveCfg = Debug|x64
-               {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}.Debug|x64.Build.0 = Debug|x64
-               {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}.Release|Win32.ActiveCfg = Release|Win32
-               {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}.Release|Win32.Build.0 = Release|Win32
-               {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}.Release|x64.ActiveCfg = Release|x64
-               {E61FEBA7-C98E-4C42-96CA-FC03F0DB26B2}.Release|x64.Build.0 = Release|x64
-               {97B3664E-1186-400A-AEC0-AC3F23087689}.Debug|Win32.ActiveCfg = Debug|Win32
-               {97B3664E-1186-400A-AEC0-AC3F23087689}.Debug|Win32.Build.0 = Debug|Win32
-               {97B3664E-1186-400A-AEC0-AC3F23087689}.Debug|x64.ActiveCfg = Debug|x64
-               {97B3664E-1186-400A-AEC0-AC3F23087689}.Debug|x64.Build.0 = Debug|x64
-               {97B3664E-1186-400A-AEC0-AC3F23087689}.Release|Win32.ActiveCfg = Release|Win32
-               {97B3664E-1186-400A-AEC0-AC3F23087689}.Release|Win32.Build.0 = Release|Win32
-               {97B3664E-1186-400A-AEC0-AC3F23087689}.Release|x64.ActiveCfg = Release|x64
-               {97B3664E-1186-400A-AEC0-AC3F23087689}.Release|x64.Build.0 = Release|x64
                {8AB8ECEC-8C22-475E-80D0-E14696F5A19B}.Debug|Win32.ActiveCfg = Debug|Win32
                {8AB8ECEC-8C22-475E-80D0-E14696F5A19B}.Debug|Win32.Build.0 = Debug|Win32
                {8AB8ECEC-8C22-475E-80D0-E14696F5A19B}.Debug|x64.ActiveCfg = Debug|x64
@@ -1760,6 +1739,10 @@ Global
                {BAE68B54-2C1A-44D0-A0E9-05156A784E79}.Release|Win32.Build.0 = Release|Win32
                {BAE68B54-2C1A-44D0-A0E9-05156A784E79}.Release|x64.ActiveCfg = Release|x64
                {BAE68B54-2C1A-44D0-A0E9-05156A784E79}.Release|x64.Build.0 = Release|x64
+               {56A2E2F3-26CF-45D5-BE7A-534C39CD7003}.Debug|Win32.ActiveCfg = Debug|Win32
+               {56A2E2F3-26CF-45D5-BE7A-534C39CD7003}.Debug|x64.ActiveCfg = Debug|x64
+               {56A2E2F3-26CF-45D5-BE7A-534C39CD7003}.Release|Win32.ActiveCfg = Release|Win32
+               {56A2E2F3-26CF-45D5-BE7A-534C39CD7003}.Release|x64.ActiveCfg = Release|x64
                {ECA09A1E-6D12-4A47-92E1-A671C181DF77}.Debug|Win32.ActiveCfg = Debug|Win32
                {ECA09A1E-6D12-4A47-92E1-A671C181DF77}.Debug|Win32.Build.0 = Debug|Win32
                {ECA09A1E-6D12-4A47-92E1-A671C181DF77}.Debug|x64.ActiveCfg = Debug|x64
@@ -1908,22 +1891,14 @@ Global
                {A9A2020D-5541-44F2-B080-DF3C9426C409}.Release|Win32.Build.0 = Release|Win32
                {A9A2020D-5541-44F2-B080-DF3C9426C409}.Release|x64.ActiveCfg = Release|x64
                {A9A2020D-5541-44F2-B080-DF3C9426C409}.Release|x64.Build.0 = Release|x64
-               {626B9142-13A1-4765-A072-FB08952E7BB8}.Debug|Win32.ActiveCfg = Debug|Win32
-               {626B9142-13A1-4765-A072-FB08952E7BB8}.Debug|Win32.Build.0 = Debug|Win32
-               {626B9142-13A1-4765-A072-FB08952E7BB8}.Debug|x64.ActiveCfg = Debug|x64
-               {626B9142-13A1-4765-A072-FB08952E7BB8}.Debug|x64.Build.0 = Debug|x64
-               {626B9142-13A1-4765-A072-FB08952E7BB8}.Release|Win32.ActiveCfg = Release|Win32
-               {626B9142-13A1-4765-A072-FB08952E7BB8}.Release|Win32.Build.0 = Release|Win32
-               {626B9142-13A1-4765-A072-FB08952E7BB8}.Release|x64.ActiveCfg = Release|x64
-               {626B9142-13A1-4765-A072-FB08952E7BB8}.Release|x64.Build.0 = Release|x64
-               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Debug|Win32.ActiveCfg = Debug|Win32
-               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Debug|Win32.Build.0 = Debug|Win32
-               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Debug|x64.ActiveCfg = Debug|x64
-               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Debug|x64.Build.0 = Debug|x64
-               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Release|Win32.ActiveCfg = Release|Win32
-               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Release|Win32.Build.0 = Release|Win32
-               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Release|x64.ActiveCfg = Release|x64
-               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Release|x64.Build.0 = Release|x64
+               {99D6BDD6-2226-43A1-B0FA-9D412BBCA6DD}.Debug|Win32.ActiveCfg = Debug|Win32
+               {99D6BDD6-2226-43A1-B0FA-9D412BBCA6DD}.Debug|Win32.Build.0 = Debug|Win32
+               {99D6BDD6-2226-43A1-B0FA-9D412BBCA6DD}.Debug|x64.ActiveCfg = Debug|x64
+               {99D6BDD6-2226-43A1-B0FA-9D412BBCA6DD}.Debug|x64.Build.0 = Debug|x64
+               {99D6BDD6-2226-43A1-B0FA-9D412BBCA6DD}.Release|Win32.ActiveCfg = Release|Win32
+               {99D6BDD6-2226-43A1-B0FA-9D412BBCA6DD}.Release|Win32.Build.0 = Release|Win32
+               {99D6BDD6-2226-43A1-B0FA-9D412BBCA6DD}.Release|x64.ActiveCfg = Release|x64
+               {99D6BDD6-2226-43A1-B0FA-9D412BBCA6DD}.Release|x64.Build.0 = Release|x64
                {7B893E9F-D032-44DE-9B71-197A29C4989B}.Debug|Win32.ActiveCfg = Debug|Win32
                {7B893E9F-D032-44DE-9B71-197A29C4989B}.Debug|Win32.Build.0 = Debug|Win32
                {7B893E9F-D032-44DE-9B71-197A29C4989B}.Debug|x64.ActiveCfg = Debug|x64
@@ -1932,6 +1907,18 @@ Global
                {7B893E9F-D032-44DE-9B71-197A29C4989B}.Release|Win32.Build.0 = Release|Win32
                {7B893E9F-D032-44DE-9B71-197A29C4989B}.Release|x64.ActiveCfg = Release|x64
                {7B893E9F-D032-44DE-9B71-197A29C4989B}.Release|x64.Build.0 = Release|x64
+               {85303A11-CF6B-432F-B3FD-24DEFFB51025}.Debug|Win32.ActiveCfg = Debug|Win32
+               {85303A11-CF6B-432F-B3FD-24DEFFB51025}.Debug|x64.ActiveCfg = Debug|x64
+               {85303A11-CF6B-432F-B3FD-24DEFFB51025}.Release|Win32.ActiveCfg = Release|Win32
+               {85303A11-CF6B-432F-B3FD-24DEFFB51025}.Release|x64.ActiveCfg = Release|x64
+               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Debug|Win32.ActiveCfg = Debug|Win32
+               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Debug|Win32.Build.0 = Debug|Win32
+               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Debug|x64.ActiveCfg = Debug|x64
+               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Debug|x64.Build.0 = Debug|x64
+               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Release|Win32.ActiveCfg = Release|Win32
+               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Release|Win32.Build.0 = Release|Win32
+               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Release|x64.ActiveCfg = Release|x64
+               {30F9EE41-587B-4618-8DE7-698D3FBA4985}.Release|x64.Build.0 = Release|x64
                {07F766A8-A2C1-4D9D-86DE-FD9C19952C7A}.Debug|Win32.ActiveCfg = Debug|Win32
                {07F766A8-A2C1-4D9D-86DE-FD9C19952C7A}.Debug|x64.ActiveCfg = Debug|x64
                {07F766A8-A2C1-4D9D-86DE-FD9C19952C7A}.Release|Win32.ActiveCfg = Release|Win32
@@ -1944,6 +1931,22 @@ Global
                {A910BD0C-8FAF-4382-B06A-F767E4752733}.Release|Win32.Build.0 = Release|Win32
                {A910BD0C-8FAF-4382-B06A-F767E4752733}.Release|x64.ActiveCfg = Release|x64
                {A910BD0C-8FAF-4382-B06A-F767E4752733}.Release|x64.Build.0 = Release|x64
+               {83C04253-B152-4EF6-BB36-35A7B0FDFB98}.Debug|Win32.ActiveCfg = Debug|Win32
+               {83C04253-B152-4EF6-BB36-35A7B0FDFB98}.Debug|Win32.Build.0 = Debug|Win32
+               {83C04253-B152-4EF6-BB36-35A7B0FDFB98}.Debug|x64.ActiveCfg = Debug|x64
+               {83C04253-B152-4EF6-BB36-35A7B0FDFB98}.Debug|x64.Build.0 = Debug|x64
+               {83C04253-B152-4EF6-BB36-35A7B0FDFB98}.Release|Win32.ActiveCfg = Release|Win32
+               {83C04253-B152-4EF6-BB36-35A7B0FDFB98}.Release|Win32.Build.0 = Release|Win32
+               {83C04253-B152-4EF6-BB36-35A7B0FDFB98}.Release|x64.ActiveCfg = Release|x64
+               {83C04253-B152-4EF6-BB36-35A7B0FDFB98}.Release|x64.Build.0 = Release|x64
+               {61B23D9B-3F73-4204-98F7-6F41218F4564}.Debug|Win32.ActiveCfg = Debug|Win32
+               {61B23D9B-3F73-4204-98F7-6F41218F4564}.Debug|Win32.Build.0 = Debug|Win32
+               {61B23D9B-3F73-4204-98F7-6F41218F4564}.Debug|x64.ActiveCfg = Debug|x64
+               {61B23D9B-3F73-4204-98F7-6F41218F4564}.Debug|x64.Build.0 = Debug|x64
+               {61B23D9B-3F73-4204-98F7-6F41218F4564}.Release|Win32.ActiveCfg = Release|Win32
+               {61B23D9B-3F73-4204-98F7-6F41218F4564}.Release|Win32.Build.0 = Release|Win32
+               {61B23D9B-3F73-4204-98F7-6F41218F4564}.Release|x64.ActiveCfg = Release|x64
+               {61B23D9B-3F73-4204-98F7-6F41218F4564}.Release|x64.Build.0 = Release|x64
        EndGlobalSection
        GlobalSection(SolutionProperties) = preSolution
                HideSolutionNode = FALSE
index 09ad6d0..ae9476e 100644 (file)
@@ -252,14 +252,10 @@ cd ..
     </Link>
   </ItemDefinitionGroup>
   <ItemGroup>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_bool2s.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_find.c" />
     <ClCompile Include="find.c" />
     <ClCompile Include="logic.c" />
   </ItemGroup>
   <ItemGroup>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_bool2s.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_find.f" />
     <f2c_rule Include="find.f" />
     <f2c_rule Include="logic.f" />
   </ItemGroup>
index aa67043..0495127 100644 (file)
     <ClCompile Include="logic.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_bool2s.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_find.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
   </ItemGroup>
   <ItemGroup>
     <f2c_rule Include="find.f">
     <f2c_rule Include="logic.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_bool2s.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_find.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
   </ItemGroup>
   <ItemGroup>
     <None Include="Elementary_functions_Import.def">
index 01725c5..33c5e8d 100644 (file)
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
   <ItemGroup Label="ProjectConfigurations">
     <ProjectConfiguration Include="Debug|Win32">
@@ -321,34 +321,26 @@ cd ..
   </ItemDefinitionGroup>
   <ItemGroup>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_argn.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_clear.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_clearglobal.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_comp.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_delbpt.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_dispbpt.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_errcatch.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_exists.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_global.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_ieee.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_intppty.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_iserror.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_isglobal.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_macrovar.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_mtlb_mode.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_resume.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_setbpt.c" />
     <ClCompile Include="..\c\withf2c.c" />
-    <ClCompile Include="allops.c" />
     <ClCompile Include="allowptr.c" />
     <ClCompile Include="basnms.c" />
     <ClCompile Include="bexec.c" />
     <ClCompile Include="btof.c" />
     <ClCompile Include="btofm.c" />
-    <ClCompile Include="clause.c" />
     <ClCompile Include="clunit.c" />
     <ClCompile Include="cmdstr.c" />
     <ClCompile Include="cmplxt.c" />
-    <ClCompile Include="command.c" />
     <ClCompile Include="compcl.c" />
     <ClCompile Include="compil.c" />
     <ClCompile Include="copyvar.c" />
@@ -362,13 +354,11 @@ cd ..
     <ClCompile Include="error.c" />
     <ClCompile Include="expsum.c" />
     <ClCompile Include="extlarg.c" />
-    <ClCompile Include="fact.c" />
     <ClCompile Include="find.c" />
     <ClCompile Include="findequal.c" />
     <ClCompile Include="folhp.c" />
     <ClCompile Include="ftob.c" />
     <ClCompile Include="funnam.c" />
-    <ClCompile Include="funs.c" />
     <ClCompile Include="getch.c" />
     <ClCompile Include="getfun.c" />
     <ClCompile Include="getfunction.c" />
@@ -389,15 +379,11 @@ cd ..
     <ClCompile Include="istrue.c" />
     <ClCompile Include="itosci.c" />
     <ClCompile Include="lst2vars.c" />
-    <ClCompile Include="macro.c" />
-    <ClCompile Include="misops.c" />
     <ClCompile Include="mkindx.c" />
     <ClCompile Include="mklist.c" />
-    <ClCompile Include="mname.c" />
     <ClCompile Include="mrknmd.c" />
     <ClCompile Include="nextj.c" />
     <ClCompile Include="prompt.c" />
-    <ClCompile Include="ptover.c" />
     <ClCompile Include="ptrback.c" />
     <ClCompile Include="putid.c" />
     <ClCompile Include="ref2val.c" />
@@ -414,7 +400,6 @@ cd ..
     <ClCompile Include="stackg.c" />
     <ClCompile Include="stackgl.c" />
     <ClCompile Include="stacki2d.c" />
-    <ClCompile Include="stackp.c" />
     <ClCompile Include="stackr2d.c" />
     <ClCompile Include="storeglobal.c" />
     <ClCompile Include="termf.c" />
@@ -431,33 +416,25 @@ cd ..
   </ItemGroup>
   <ItemGroup>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_argn.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_clear.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_clearglobal.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_comp.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_delbpt.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_dispbpt.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_errcatch.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_exists.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_global.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_ieee.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_intppty.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_iserror.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_isglobal.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_macrovar.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_mtlb_mode.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_resume.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_setbpt.f" />
-    <f2c_rule Include="allops.f" />
     <f2c_rule Include="allowptr.f" />
     <f2c_rule Include="basnms.f" />
     <f2c_rule Include="bexec.f" />
     <f2c_rule Include="btof.f" />
     <f2c_rule Include="btofm.f" />
-    <f2c_rule Include="clause.f" />
     <f2c_rule Include="clunit.f" />
     <f2c_rule Include="cmdstr.f" />
     <f2c_rule Include="cmplxt.f" />
-    <f2c_rule Include="command.f" />
     <f2c_rule Include="compcl.f" />
     <f2c_rule Include="compil.f" />
     <f2c_rule Include="copyvar.f" />
@@ -471,13 +448,11 @@ cd ..
     <f2c_rule Include="error.f" />
     <f2c_rule Include="expsum.f" />
     <f2c_rule Include="extlarg.f" />
-    <f2c_rule Include="fact.f" />
     <f2c_rule Include="find.f" />
     <f2c_rule Include="findequal.f" />
     <f2c_rule Include="folhp.f" />
     <f2c_rule Include="ftob.f" />
     <f2c_rule Include="funnam.f" />
-    <f2c_rule Include="funs.f" />
     <f2c_rule Include="getch.f" />
     <f2c_rule Include="getfun.f" />
     <f2c_rule Include="getfunction.f" />
@@ -498,15 +473,11 @@ cd ..
     <f2c_rule Include="istrue.f" />
     <f2c_rule Include="itosci.f" />
     <f2c_rule Include="lst2vars.f" />
-    <f2c_rule Include="macro.f" />
-    <f2c_rule Include="misops.f" />
     <f2c_rule Include="mkindx.f" />
     <f2c_rule Include="mklist.f" />
-    <f2c_rule Include="mname.f" />
     <f2c_rule Include="mrknmd.f" />
     <f2c_rule Include="nextj.f" />
     <f2c_rule Include="prompt.f" />
-    <f2c_rule Include="ptover.f" />
     <f2c_rule Include="ptrback.f" />
     <f2c_rule Include="putid.f" />
     <f2c_rule Include="ref2val.f" />
@@ -523,7 +494,6 @@ cd ..
     <f2c_rule Include="stackg.f" />
     <f2c_rule Include="stackgl.f" />
     <f2c_rule Include="stacki2d.f" />
-    <f2c_rule Include="stackp.f" />
     <f2c_rule Include="stackr2d.f" />
     <f2c_rule Include="storeglobal.f" />
     <f2c_rule Include="termf.f" />
index 5ff9dcd..1b07e1f 100644 (file)
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
   <ItemGroup>
     <Filter Include="Source Files">
@@ -21,9 +21,6 @@
     </Filter>
   </ItemGroup>
   <ItemGroup>
-    <ClCompile Include="allops.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="allowptr.c">
       <Filter>Source Files</Filter>
     </ClCompile>
@@ -39,9 +36,6 @@
     <ClCompile Include="btofm.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="clause.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="clunit.c">
       <Filter>Source Files</Filter>
     </ClCompile>
@@ -51,9 +45,6 @@
     <ClCompile Include="cmplxt.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="command.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="compcl.c">
       <Filter>Source Files</Filter>
     </ClCompile>
@@ -93,9 +84,6 @@
     <ClCompile Include="extlarg.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="fact.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="find.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="funnam.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="funs.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="getch.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="lst2vars.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="macro.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="misops.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="mkindx.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="mklist.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="mname.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="mrknmd.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="prompt.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="ptover.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="ptrback.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="stacki2d.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="stackp.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="stackr2d.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_argn.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_clear.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_clearglobal.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_comp.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_delbpt.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_errcatch.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_exists.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_global.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_ieee.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_mtlb_mode.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_resume.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_setbpt.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     </ClInclude>
   </ItemGroup>
   <ItemGroup>
-    <f2c_rule Include="allops.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="allowptr.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="btofm.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="clause.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="clunit.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="cmplxt.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="command.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="compcl.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="extlarg.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="fact.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="find.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="funnam.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="funs.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="getch.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="lst2vars.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="macro.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="misops.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="mkindx.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="mklist.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="mname.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="mrknmd.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="prompt.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="ptover.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="ptrback.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="stacki2d.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="stackp.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="stackr2d.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_argn.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_clear.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_clearglobal.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_comp.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_delbpt.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_errcatch.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_exists.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_global.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_ieee.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_mtlb_mode.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_resume.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_setbpt.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
index 5ae97c4..6a4980a 100644 (file)
@@ -265,40 +265,28 @@ cd ..
   </ItemDefinitionGroup>
   <ItemGroup>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_definedfields.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_getfield.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_list.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_lstcat.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_lstsize.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_setfield.c" />
     <ClCompile Include="extractfields.c" />
-    <ClCompile Include="followpath.c" />
     <ClCompile Include="forcerhs.c" />
     <ClCompile Include="gratyp.c" />
     <ClCompile Include="insertfield.c" />
-    <ClCompile Include="intl_e.c" />
-    <ClCompile Include="intl_i.c" />
     <ClCompile Include="lsstyp.c" />
-    <ClCompile Include="lstops.c" />
     <ClCompile Include="mlist.c" />
     <ClCompile Include="rattyp.c" />
     <ClCompile Include="udptr.c" />
   </ItemGroup>
   <ItemGroup>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_definedfields.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_getfield.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_list.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_lstcat.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_lstsize.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_setfield.f" />
     <f2c_rule Include="extractfields.f" />
-    <f2c_rule Include="followpath.f" />
     <f2c_rule Include="forcerhs.f" />
     <f2c_rule Include="gratyp.f" />
     <f2c_rule Include="insertfield.f" />
-    <f2c_rule Include="intl_e.f" />
-    <f2c_rule Include="intl_i.f" />
     <f2c_rule Include="lsstyp.f" />
-    <f2c_rule Include="lstops.f" />
     <f2c_rule Include="mlist.f" />
     <f2c_rule Include="rattyp.f" />
     <f2c_rule Include="udptr.f" />
index 3d3279f..abe1c36 100644 (file)
@@ -24,9 +24,6 @@
     <ClCompile Include="extractfields.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="followpath.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="forcerhs.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="insertfield.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="intl_e.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="intl_i.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="lsstyp.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="lstops.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="mlist.c">
       <Filter>Source Files</Filter>
     </ClCompile>
@@ -60,9 +48,6 @@
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_definedfields.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_getfield.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_list.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_lstsize.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_setfield.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
   </ItemGroup>
   <ItemGroup>
     <f2c_rule Include="extractfields.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="followpath.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="forcerhs.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="insertfield.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="intl_e.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="intl_i.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="lsstyp.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="lstops.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="mlist.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_definedfields.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_getfield.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_list.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_lstsize.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_setfield.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
   </ItemGroup>
   <ItemGroup>
     <None Include="data_structures_Import.def">
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/bbvode.f b/scilab/modules/differential_equations/sci_gateway/fortran/bbvode.f
deleted file mode 100644 (file)
index ed0b0d2..0000000
+++ /dev/null
@@ -1,505 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine dgsub(ii,z,dg)
-c ======================================================================
-c     Soft and Fortrans coded externals for colnew 
-c ======================================================================
-c
-      INCLUDE 'stack.h'
-c      
-      character tmpbuf * (bsiz)      
-      integer iadr,sadr
-      common/iercol/iero
-      double precision z(*), dg(*)
-      common / icolnew/  ncomp,mstar
-      common / coladr / kfsub,kdfsub,kgsub,kdgsub,kguess,kx,ki,kz
-      common / coltyp / itfsub,itdfsub,itgsub,itdgsub,itguess
-      integer ii
-      logical allowptr
-      data mlhs/1/,mrhs/2/
-
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' dgsub  top:'//tmpbuf(1:4))
-      endif
-
-      if(itdgsub.eq.10) then
-c       Fortran case 
-        call fcoldg(ii,z,dg)
-        return
-      endif
-c     external is a Scilab function
-c+ 
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-c     Putting Fortran arguments on Scilab stack 
-
-      call ftob(dble(ii),1,ki)
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(z,mstar,kz)
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-      if(itdgsub.ne.15) then
-         fin=lstk(kdgsub)
-      else
-         ils=iadr(lstk(kdgsub))
-         nelt=istk(ils+1)
-         l=sadr(ils+3+nelt)
-         ils=ils+2
-c     external adress 
-         fin=l
-c     Extra arguments in calling list that westore on the Scilab stack
-         call extlarg(l,ils,nelt,mrhs)
-         if(err.gt.0.or.err1.gt.0) return
-      endif
-c     Macro execution 
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-C     Scilab to Fortran convertion 
-      call btof(dg,mstar)
-      if(err.gt.0.or.err1.gt.0) return
-c     normal return iero set to 0
-      iero=0
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
-
-
-      subroutine gsub(ii,z,g)
-c ======================================================================
-C     Soft and Fortrans coded externals for colnew 
-c ======================================================================
-      INCLUDE 'stack.h'
-c      
-      character tmpbuf * (bsiz) 
-      integer iadr,sadr
-      common/iercol/iero
-      double precision z(*), g(*)
-      common / icolnew/  ncomp,mstar
-      common / coladr / kfsub,kdfsub,kgsub,kdgsub,kguess,kx,ki,kz
-      common / coltyp / itfsub,itdfsub,itgsub,itdgsub,itguess
-      logical allowptr
-      integer ii
-
-      data mlhs/1/,mrhs/2/
-
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' gsub  top:'//tmpbuf(1:4))
-      endif
-
-      if(itgsub.eq.10) then
-c       Fortran case 
-        call fcolg(ii,z,g)
-        return
-      endif
-
-
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-
-c     Putting Fortran arguments on Scilab stack 
-c+    
-      call ftob(dble(ii),1,ki)
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(z,mstar,kz)
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-      if(itgsub.ne.15) then
-         fin=lstk(kgsub)
-      else
-         ils=iadr(lstk(kgsub))
-         nelt=istk(ils+1)
-         l=sadr(ils+3+nelt)
-         ils=ils+2
-c     external adress 
-         fin=l
-c     Extra arguments in calling list that westore on the Scilab stack
-         call extlarg(l,ils,nelt,mrhs)
-         if(err.gt.0.or.err1.gt.0) return
-      endif
-c     Macro execution 
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-C     Scilab to Fortran convertion 
-      call btof(g,1)
-      if(err.gt.0.or.err1.gt.0) return
-c     normal return iero set to 0
-      iero=0
-c+    
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
-
-      subroutine dfsub(x,z,df)
-c ======================================================================
-C     Soft and Fortrans coded externals for colnew 
-c ======================================================================
-      INCLUDE 'stack.h'
-c
-      character tmpbuf * (bsiz)       
-      integer iadr,sadr
-      common/iercol/iero
-      double precision z(*), df(*),x
-      common / icolnew/  ncomp,mstar
-      common / coladr / kfsub,kdfsub,kgsub,kdgsub,kguess,kx,ki,kz
-      common / coltyp / itfsub,itdfsub,itgsub,itdgsub,itguess
-      logical allowptr
-
-      data mlhs/1/,mrhs/2/
-
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' dfsub  top:'//tmpbuf(1:4))
-      endif
-
-      if(itdfsub.eq.10) then
-c       Fortran case 
-        call fcoldf(x,z,df)
-        return
-      endif
-
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-
-c     Putting Fortran arguments on Scilab stack 
-c+    
-      call ftob(x,1,kx)
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(z,mstar,kz)
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-      if(itdfsub.ne.15) then
-         fin=lstk(kdfsub)
-      else
-         ils=iadr(lstk(kdfsub))
-         nelt=istk(ils+1)
-         l=sadr(ils+3+nelt)
-         ils=ils+2
-c     external adress 
-         fin=l
-c     Extra arguments in calling list that westore on the Scilab stack
-         call extlarg(l,ils,nelt,mrhs)
-         if(err.gt.0.or.err1.gt.0) return
-      endif
-c     Macro execution 
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-C     Scilab to Fortran convertion 
-      call btof(df,mstar*ncomp)
-      if(err.gt.0.or.err1.gt.0) return
-c     normal return iero set to 0
-      iero=0
-c+    
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
-
-
-      subroutine fsub(x,z,f)
-c ======================================================================
-C     Soft and Fortrans coded externals for colnew 
-c ======================================================================
-      INCLUDE 'stack.h'
-c
-      character tmpbuf * (bsiz)        
-      integer iadr,sadr
-      common/iercol/iero
-      double precision z(*), f(*),x
-      common / icolnew/  ncomp,mstar
-      common / coladr / kfsub,kdfsub,kgsub,kdgsub,kguess,kx,ki,kz
-      common / coltyp / itfsub,itdfsub,itgsub,itdgsub,itguess
-      logical allowptr
-
-      data mlhs/1/,mrhs/2/
-
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' fsub  top:'//tmpbuf(1:4))
-      endif
-
-      if(itfsub.eq.10) then
-c       Fortran case 
-        call fcolf(x,z,f)
-        return
-      endif
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-
-c     Putting Fortran arguments on Scilab stack 
-c+    
-      call ftob(x,1,kx)
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(z,mstar,kz)
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-      if(itfsub.ne.15) then
-         fin=lstk(kfsub)
-      else
-         ils=iadr(lstk(kfsub))
-         nelt=istk(ils+1)
-         l=sadr(ils+3+nelt)
-         ils=ils+2
-c     external adress 
-         fin=l
-c     Extra arguments in calling list that westore on the Scilab stack
-         call extlarg(l,ils,nelt,mrhs)
-         if(err.gt.0.or.err1.gt.0) return
-      endif
-c     Macro execution 
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-C     Scilab to Fortran convertion 
-      call btof(f,ncomp)
-      if(err.gt.0.or.err1.gt.0) return
-c     normal return iero set to 0
-      iero=0
-c+    
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
-
-      subroutine dguess(x,z,dmval)
-c ======================================================================
-C     Soft and Fortrans coded externals for colnew 
-c ======================================================================
-      INCLUDE 'stack.h'
-c
-      character tmpbuf * (bsiz)       
-      integer iadr,sadr
-      common/iercol/iero
-      double precision z(*), dmval(*),x
-      common / icolnew/  ncomp,mstar
-      common / coladr / kfsub,kdfsub,kgsub,kdgsub,kguess,kx,ki,kz
-      common / coltyp / itfsub,itdfsub,itgsub,itdgsub,itguess
-      logical allowptr
-
-      data mlhs/2/,mrhs/1/
-
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' guess  top:'//tmpbuf(1:4))
-      endif
-
-      if(itguess.eq.10) then
-c       Fortran case 
-        call fcolgu(x,z,dmval)
-        return
-      endif
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-
-c     Putting Fortran arguments on Scilab stack 
-c+    
-      call ftob(x,1,kx)
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-      if(itguess.ne.15) then
-         fin=lstk(kguess)
-      else
-         ils=iadr(lstk(kguess))
-         nelt=istk(ils+1)
-         l=sadr(ils+3+nelt)
-         ils=ils+2
-c     external adress 
-         fin=l
-c     Extra arguments in calling list that westore on the Scilab stack
-         call extlarg(l,ils,nelt,mrhs)
-         if(err.gt.0.or.err1.gt.0) return
-      endif
-c     Macro execution 
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-C     Scilab to Fortran convertion 
-      call btof(dmval,ncomp)
-      if(err.gt.0.or.err1.gt.0) return
-      call btof(z,mstar)
-      if(err.gt.0.or.err1.gt.0) return
-c     normal return iero set to 0
-      iero=0
-c+    
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/bfeval.f b/scilab/modules/differential_equations/sci_gateway/fortran/bfeval.f
deleted file mode 100644 (file)
index d912d33..0000000
+++ /dev/null
@@ -1,117 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine bfeval(nn,x1,x2,xres,itype,ename)
-c     ==========================================================
-c     soft external for feval 
-c     the result is real or complex according to itype value 
-c     ==========================================================
-c
-      include 'stack.h'
-c
-      character tmpbuf * (bsiz) 
-      integer sadr,iadr
-      character*6 ename
-      double precision x1,x2,xres(2)
-      common / fevaladr / kfeval,kx1top,kx2top
-      common / fevaltyp / itfeval
-      logical allowptr
-
-      data mlhs/1/
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' bydot  top:'//tmpbuf(1:4))
-      endif
-c
-      mrhs=nn
-      if(itfeval.eq.10) then
-         call ffeval(nn,x1,x2,xres,itype,ename)
-         return
-      endif
-c     Putting Fortran arguments on Scilab stack 
-c+    
-      call ftob(x1,1,kx1top)
-      if(err.gt.0.or.err1.gt.0) return
-      if (nn.eq.2) then
-         call ftob(x2,1,kx2top)
-         if(err.gt.0.or.err1.gt.0) return
-      endif
-c+    
-      if(itfeval.ne.15) then
-         fin=lstk(kfeval)
-      else
-         ils=iadr(lstk(kfeval))
-         nelt=istk(ils+1)
-         l=sadr(ils+3+nelt)
-         ils=ils+2
-c     external adress 
-         fin=l
-c     Extra arguments in calling list that westore on the Scilab stack
-         call extlarg(l,ils,nelt,mrhs)
-         if(err.gt.0.or.err1.gt.0) return
-      endif
-
-c     Macro execution 
-c     
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
-cxxx
-c     
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-c     transfert des variables (scilab) de sortie vers fortran
-c     avec test du cas complexe
-      il=iadr(lstk(top))
-      if(istk(il).ne.1) then 
-         call error(98)
-         return
-      endif
-      itype=istk(il+3)
-      call btof(xres,itype+1)
-      if(err.gt.0.or.err1.gt.0) return
-c     normal return
-      return
-
-c     the external produces an error
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-c     .  the error has been catched
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/bjac.f b/scilab/modules/differential_equations/sci_gateway/fortran/bjac.f
deleted file mode 100644 (file)
index 4633a38..0000000
+++ /dev/null
@@ -1,141 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine bjac(ny,t,y,ml,mu,jac,nrowj)
-c
-      INCLUDE 'stack.h'
-      integer iadr,sadr
-c     
-      double precision y(ny),jac(nrowj,ny),t(*)
-      common/ierode/iero
-c     
-      logical allowptr
-      integer vol,tops,nordre
-      data nordre/2/,mlhs/1/
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c     
-      iero=0
-      mrhs=2
-c     
-      ilp=iadr(lstk(top))
-      il=istk(ilp+nordre)
-c      
-      tops=istk(il)
-      ils=iadr(lstk(tops))
-c
-      if(istk(ils).eq.10) then
-c     cas d'un simulateur en fortran
-         call fjac(ny,t,y,ml,mu,jac,nrowj)
-         return
-      endif
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-c     Putting Fortran arguments on Scilab stack 
-c+    
-      call ftob(t,1,istk(il+1))
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(y,ny,istk(il+2))
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-c     
-      
-c     
-c     recuperation de l'adresse du simulateur
-      fin=lstk(tops)
-c     
-      if(istk(ils).eq.15) then
-c     cas ou le simulateur est decrit par une liste
-      nelt=istk(ils+1)
-      l=sadr(ils+3+nelt)
-      ils=ils+2
-c     
-c     recuperation de l'adresse du simulateur
-      fin=l
-c     
-c     gestion des parametres supplementaires du simulateur
-c     proviennent du contexte  (elements de la liste
-c     decrivant le simulateur
-c     
-      nelt=nelt-1
-      if(nelt.eq.0) goto 40
-      l=l+istk(ils+1)-istk(ils)
-      vol=istk(ils+nelt+1)-istk(ils+1)
-      if(top+1+nelt.ge.bot) then
-         call error(18)
-         return
-      endif
-      err=lstk(top+1)+vol-lstk(bot)
-      if(err.gt.0) then
-         call error(17)
-         return
-      endif
-      call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1)
-      do 11 i=1,nelt
-         top=top+1
-         lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
- 11   continue
-      mrhs=mrhs+nelt
-      endif
- 40   continue
-c     
-c     execution de la macro definissant le simulateur
-c     
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call error(26)
-         goto 9999
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
-c     
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-c     transfert des variables  de sortie vers fortran
-      if(ml.gt.0.or.mu.gt.0) then
-         mm=ml+mu+1
-         call btofm(jac,nrowj,mm,ny)
-         else
-         nnn=ny*ny
-         call btof(jac,nnn)
-      endif
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-c     normal return iero set to 0
-      iero=0 
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/bjacd.f b/scilab/modules/differential_equations/sci_gateway/fortran/bjacd.f
deleted file mode 100644 (file)
index d4a15c8..0000000
+++ /dev/null
@@ -1,162 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine bjacd(t,y,ydot,res,cj,rpar,ipar)
-c
-c ======================================================================
-c     gestion external "soft" relatif a dassl calcul du jacobien
-c ======================================================================
-c
-      INCLUDE 'stack.h'
-      integer iadr,sadr
-c     
-      common/ierode/iero
-c     
-      character tmpbuf * (bsiz) 
-      logical allowptr
-      double precision t, y(*),ydot(*),res(*),rpar(*),cj
-      integer ipar(*)
-      integer vol,tops,nordre
-      data nordre/2/,mlhs/1/
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' bjacd  top:'//tmpbuf(1:4))
-      endif
-c     
-c     nordre est le numero d'ordre de cet external dans la structure
-c     de donnee,
-c     mlhs (mrhs) est le nombre de parametres de sortie (entree)
-c     du simulateur 
-c     
-      iero=0
-      mrhs=4
-c     
-      ilp=iadr(lstk(top))
-      il=istk(ilp+nordre)
-c
-      tops=istk(il)
-      ils=iadr(lstk(tops))
-c
-      if(istk(ils).eq.10) then
-c     cas d'un simulateur en fortran
-         call fjacd(t,y,ydot,res,cj,rpar,ipar)
-         return
-      endif
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-c     Putting Fortran arguments on Scilab stack 
-c+    
-      neq=istk(il+1)
-      call ftob(t,1,istk(il+2))
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(y,neq,istk(il+3))
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(ydot,neq,istk(il+3))
-      if(err.gt.0.or.err1.gt.0) return
-      top=top+1
-      ilc=iadr(lstk(top))
-      istk(ilc)=1
-      istk(ilc+1)=1
-      istk(ilc+2)=1
-      istk(ilc+3)=0
-      lc=sadr(ilc+4)
-      stk(lc)=cj
-      lstk(top+1)=lc+1
-c+    
-c     
-      if(istk(ils).eq.15) goto 10
-c     
-c     recuperation de l'adresse du simulateur
-      fin=lstk(tops)
-c     
-      goto 40
-c     cas ou le simulateur est decrit par une liste
- 10   nelt=istk(ils+1)
-      l=sadr(ils+3+nelt)
-      ils=ils+2
-c     
-c     recuperation de l'adresse du simulateur
-      fin=l
-c     
-c     gestion des parametres supplementaires du simulateur
-c     proviennent du contexte  (elements de la liste
-c     decrivant le simulateur
-c     
-      nelt=nelt-1
-      if(nelt.ne.0) then
-         l=l+istk(ils+1)-istk(ils)
-         vol=istk(ils+nelt+1)-istk(ils+1)
-         if(top+1+nelt.ge.bot) then
-            call error(18)
-            return
-         endif
-         err=lstk(top+1)+vol-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1)
-         do 11 i=1,nelt
-            top=top+1
-            lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
- 11      continue
-         mrhs=mrhs+nelt
-      endif
- 40   continue
-c     
-c     execution de la macro definissant le simulateur
-c     
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
-c     
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-c     transfert des variables  de sortie vers fortran
-      call btof(res,neq*neq)
-      if(err.gt.0.or.err1.gt.0) return
-c     normal return iero set to 0
-      iero=0 
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/bresd.f b/scilab/modules/differential_equations/sci_gateway/fortran/bresd.f
deleted file mode 100644 (file)
index a909095..0000000
+++ /dev/null
@@ -1,162 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine bresd(t,y,ydot,res,ires,rpar,ipar)
-c     
-c ======================================================================
-c     gestion external "soft" relatif a dassl calcul du residu
-c ======================================================================
-c
-      INCLUDE 'stack.h'
-      integer iadr,sadr
-c     
-      common/ierode/iero
-      logical allowptr
-c      
-      character tmpbuf * (bsiz) 
-      double precision t, y(*),ydot(*),res(*),rpar(*)
-      integer ires,ipar(*)
-      integer vol,tops,nordre
-      data nordre/1/,mlhs/2/
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c     
-c
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' bresd  top:'//tmpbuf(1:4))
-      endif
-c     nordre est le numero d'ordre de cet external dans la structure
-c     de donnee,
-c     mlhs (mrhs) est le nombre de parametres de sortie (entree)
-c     du simulateur 
-c     
-      mrhs=3
-      iero=0
-c     
-      ilp=iadr(lstk(top))
-      il=istk(ilp+nordre)
-c
-      tops=istk(il)
-      ils=iadr(lstk(tops))
-c
-      if(istk(ils).eq.10) then
-c     cas d'un simulateur en fortran
-         call fresd(t,y,ydot,res,ires,rpar,ipar)
-         return
-      endif
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-c     Putting Fortran arguments on Scilab stack 
-c     
-c     transfert des arguments d'entree minimaux du simulateur
-c     la valeur de ces arguments vient du contexte fortran (liste d'appel)
-c     la structure vient du contexte 
-c+    
-      neq=istk(il+1)
-      call ftob(t,1,istk(il+2))
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(y,neq,istk(il+3))
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(ydot,neq,istk(il+3))
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-c     
-      if(istk(ils).eq.15) goto 10
-c     
-c     recuperation de l'adresse du simulateur
-      fin=lstk(tops)
-c     
-      goto 40
-c     cas ou le simulateur est decrit par une liste
- 10   nelt=istk(ils+1)
-      l=sadr(ils+3+nelt)
-      ils=ils+2
-c     
-c     recuperation de l'adresse du simulateur
-      fin=l
-c     
-c     gestion des parametres supplementaires du simulateur
-c     proviennent du contexte  (elements de la liste
-c     decrivant le simulateur
-c     
-      nelt=nelt-1
-      if(nelt.ne.0) then
-         l=l+istk(ils+1)-istk(ils)
-         vol=istk(ils+nelt+1)-istk(ils+1)
-         if(top+1+nelt.ge.bot) then
-            call error(18)
-            return
-         endif
-         err=lstk(top+1)+vol-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1)
-         do 11 i=1,nelt
-            top=top+1
-            lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
- 11      continue
-         mrhs=mrhs+nelt
-      endif
- 40   continue
-c     
-c     execution de la macro definissant le simulateur
-c     
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
-c     
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-c     transfert des variables  de sortie vers fortran
-      call btof(res,1)
-      if(err.gt.0.or.err1.gt.0) return
-      ires=res(1)
-      call btof(res,neq)
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-c     normal return iero set to 0
-      iero=0 
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/bsurf.f b/scilab/modules/differential_equations/sci_gateway/fortran/bsurf.f
deleted file mode 100644 (file)
index aec33b9..0000000
+++ /dev/null
@@ -1,150 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine bsurf (ny, t, y, ng, gout)
-c
-c ======================================================================
-c     gestion des macros external pour la primitive ODE 
-c     (traversee de surface)
-c ======================================================================
-c
-      INCLUDE 'stack.h'
-      integer iadr,sadr
-c     
-      logical allowptr
-      double precision y(ny),gout(ng),t(*)
-      common/ierode/iero
-c     
-      character tmpbuf * (bsiz) 
-      integer vol,tops,nordre
-      data nordre/3/,mlhs/1/
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c     
-c     nordre est le numero d'ordre de cet external dans la structure
-c     de donnee,
-c     mlhs (mrhs) est le nombre de parametres de sortie (entree)
-c     du simulateur 
-c     
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' bsurf   top:'//tmpbuf(1:4))
-      endif
-c
-      iero=0
-      mrhs=2
-c     
-      ilp=iadr(lstk(top))
-      il=istk(ilp+nordre)
-c      
-      tops=istk(il)
-      ils=iadr(lstk(tops))
-c
-      if(istk(ils).eq.10) then
-c     cas d'un simulateur en fortran
-         call fsurf (ny, t, y, ng, gout)
-         return
-      endif
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-c     Putting Fortran arguments on Scilab stack 
-c+    
-      call ftob(t,1,istk(il+1))
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(y,ny,istk(il+2))
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-c     
-      if(istk(ils).eq.15) goto 10
-c     
-c     recuperation de l'adresse du simulateur
-      fin=lstk(tops)
-c     
-      goto 40
-c     cas ou le simulateur est decrit par une liste
- 10   nelt=istk(ils+1)
-      l=sadr(ils+3+nelt)
-      ils=ils+2
-c     
-c     recuperation de l'adresse du simulateur
-      fin=l
-c     
-c     gestion des parametres supplementaires du simulateur
-c     proviennent du contexte  (elements de la liste
-c     decrivant le simulateur
-c     
-      nelt=nelt-1
-      if(nelt.eq.0) goto 40
-      l=l+istk(ils+1)-istk(ils)
-      vol=istk(ils+nelt+1)-istk(ils+1)
-      if(top+1+nelt.ge.bot) then
-         call error(18)
-         return
-      endif
-      err=lstk(top+1)+vol-lstk(bot)
-      if(err.gt.0) then
-         call error(17)
-         return
-      endif
-      call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1)
-      do 11 i=1,nelt
-         top=top+1
-         lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
- 11   continue
-      mrhs=mrhs+nelt
- 40   continue
-c     
-c     execution de la macro definissant le simulateur
-c     
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call error(26)
-         goto 9999
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
-c     
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-c     transfert des variables  de sortie vers fortran
-      call btof(gout,ng)
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-c     normal return iero set to 0
-      iero=0 
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/bsurfd.f b/scilab/modules/differential_equations/sci_gateway/fortran/bsurfd.f
deleted file mode 100644 (file)
index 85517de..0000000
+++ /dev/null
@@ -1,153 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine bsurfd(ny, t, y, ng, gout,RPAR,IPAR)
-c
-c     ====================================
-c     soft external for dasrt (surface crossing)
-c     ====================================
-c
-      INCLUDE 'stack.h'
-      integer iadr,sadr
-c     
-      common/ierode/iero
-c     
-      character tmpbuf * (bsiz) 
-      logical allowptr
-      double precision y(ny),gout(ng),t(*)
-      double precision rpar(*)
-      integer ipar(*)
-      integer vol,tops,nordre
-      data nordre/3/,mlhs/1/
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:12),'(3i4)') top,r,sym
-         call basout(io,wte,' bsurfd  top:'//tmpbuf(1:4))
-      endif
-c     
-c     nordre est le numero d'ordre de cet external dans la structure
-c     de donnee,
-c     mlhs (mrhs) est le nombre de parametres de sortie (entree)
-c     du simulateur 
-c     
-      iero=0
-      mrhs=2
-c     
-      ilp=iadr(lstk(top))
-      il=istk(ilp+nordre)
-c
-      tops=istk(il)
-      ils=iadr(lstk(tops))
-c
-      if(istk(ils).eq.10) then
-c     cas d'un simulateur en fortran
-         call fsurfd(ny, t, y, ng, gout,RPAR,IPAR)
-         return
-      endif
-c     
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-c     Putting Fortran arguments on Scilab stack 
-c+    
-      call ftob(t,1,istk(il+1))
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(y,ny,istk(il+2))
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-c     
-      if(istk(ils).eq.15) goto 10
-c     
-c     recuperation de l'adresse du simulateur
-      fin=lstk(tops)
-c     
-      goto 40
-c     cas ou le simulateur est decrit par une liste
- 10   nelt=istk(ils+1)
-      l=sadr(ils+3+nelt)
-      ils=ils+2
-c     
-c     recuperation de l'adresse du simulateur
-      fin=l
-c     
-c     gestion des parametres supplementaires du simulateur
-c     proviennent du contexte  (elements de la liste
-c     decrivant le simulateur
-c     
-      nelt=nelt-1
-      if(nelt.eq.0) goto 40
-      l=l+istk(ils+1)-istk(ils)
-      vol=istk(ils+nelt+1)-istk(ils+1)
-      if(top+1+nelt.ge.bot) then
-         call error(18)
-         return
-      endif
-      err=lstk(top+1)+vol-lstk(bot)
-      if(err.gt.0) then
-         call error(17)
-         return
-      endif
-      call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1)
-      do 11 i=1,nelt
-         top=top+1
-         lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
- 11   continue
-      mrhs=mrhs+nelt
- 40   continue
-c     
-c     execution de la macro definissant le simulateur
-c     
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
-c     
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-c     transfert des variables  de sortie vers fortran
-      call btof(gout,ng)
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-c     normal return iero set to 0
-      iero=0 
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/bydot.f b/scilab/modules/differential_equations/sci_gateway/fortran/bydot.f
deleted file mode 100644 (file)
index be0c2ed..0000000
+++ /dev/null
@@ -1,139 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine bydot(n,t,y,ydot)
-c     
-      INCLUDE 'stack.h'
-      integer iadr,sadr
-c     
-      common/ierode/iero
-c     
-      logical allowptr
-      double precision t(*), y(*),ydot(*)
-      integer vol,tops,nordre
-      data nordre/1/,mlhs/1/
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c
-c     
-c     nordre=external number
-c     mlhs (mrhs) = number ot output (input) parameters of the 
-c     external 
-c     
-      iero=0
-      mrhs=2
-c     
-      ilp=iadr(lstk(top))
-      il=istk(ilp+nordre)
-c
-      tops=istk(il)
-      ils=iadr(lstk(tops))
-c
-      if(istk(ils).eq.10) then
-c     fortran external
-         call fydot(n,t,y,ydot)
-         return
-      endif
-
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-c     
-c     transfer of input parameters
-c+    
-      call ftob(t,1,istk(il+1))
-      if(err.gt.0.or.err1.gt.0) return
-      call ftob(y,n,istk(il+2))
-      if(err.gt.0.or.err1.gt.0) return
-
-c+    
-c     adress of external
-      fin=lstk(tops)
-c     
-c     external in a list
-      if(istk(ils).eq.15) then
-      nelt=istk(ils+1)
-      l=sadr(ils+3+nelt)
-      ils=ils+2
-c     
-c     adress of external
-      fin=l
-c     
-c     additional parameters
-c     
-      nelt=nelt-1
-      if(nelt.ne.0) then
-         l=l+istk(ils+1)-istk(ils)
-         vol=istk(ils+nelt+1)-istk(ils+1)
-         if(top+1+nelt.ge.bot) then
-            call error(18)
-            return
-         endif
-         err=lstk(top+1)+vol-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1)
-         do 11 i=1,nelt
-            top=top+1
-            lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
- 11      continue
-         mrhs=mrhs+nelt
-      endif
-      endif
-c     
-c     execute scilab external
-c     
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
-c     
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-c     transfer of output parameters of external to fortran
-      call btof(ydot,n)
-      if(err.gt.0.or.err1.gt.0) return
-c     normal return iero set to 0
-      iero=0
-c+    
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/bydot2.f b/scilab/modules/differential_equations/sci_gateway/fortran/bydot2.f
deleted file mode 100644 (file)
index c78e85c..0000000
+++ /dev/null
@@ -1,175 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine bydot2(n,t,y,ydot)
-c     
-      INCLUDE 'stack.h'
-      integer iadr,sadr
-c     
-      common/ierode/iero
-      common/odecd/nd,iflag
-c     
-      logical allowptr
-      double precision t(*), y(*),ydot(*)
-      integer vol,tops,nordre
-      data nordre/1/,mlhs/1/
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c
-c     
-c     nordre=external number
-c     mlhs (mrhs) = number ot output (input) parameters of the 
-c     external 
-c  
-      iero=0
-      mrhs=4
-c     
-      ilp=iadr(lstk(top))
-      il=istk(ilp+nordre)
-      il1=il
-c
-      tops=istk(il)
-      ils=iadr(lstk(tops))
-c
-      if(istk(ils).eq.10) then
-c     fortran external
-         call fydot2(n,t,y,ydot)
-         return
-      endif
-c     
-c     external is a Scilab function
-
-c     on return iero=1 is used to notify to the ode solver that
-c     scilab was not able to evaluate the external
-      iero=1
-
-c     transfer of input parameters
-c+    
-      call ftob(t,1,istk(il+1))
-      if(err.gt.0.or.err1.gt.0) return
-
-      top=top+1
-      il=iadr(lstk(top))
-      istk(il)=1
-      istk(il+1)=n
-      istk(il+2)=1
-      istk(il+3)=0
-      l=sadr(il+4)
-      err=lstk(top)+sadr(4)+n-lstk(bot)
-      if(err.gt.0) then
-         call error(17)
-         return
-      endif
-      call unsfdcopy(n,y,1,stk(l),1)
-      lstk(top+1)=l+n
-
-      top=top+1
-      il=iadr(lstk(top))
-      istk(il)=1
-      istk(il+1)=nd
-      istk(il+2)=1
-      istk(il+3)=0
-      l=sadr(il+4)
-      err=lstk(top)+sadr(4)+nd-lstk(bot)
-      if(err.gt.0) then
-         call error(17)
-         return
-      endif
-      call unsfdcopy(nd,y(n+1),1,stk(l),1)
-      lstk(top+1)=l+nd
-
-      call ftob(dble(iflag),1,istk(il1+1))
-      if(err.gt.0.or.err1.gt.0) return
-c  *****************************************
-c+    
-c     
-c     adress of external
-      fin=lstk(tops)
-c     
-c     external in a list
-      if(istk(ils).eq.15) then
-      nelt=istk(ils+1)
-      l=sadr(ils+3+nelt)
-      ils=ils+2
-c     
-c     adress of external
-      fin=l
-c     
-c     additional parameters
-c     
-      nelt=nelt-1
-      if(nelt.ne.0) then
-         l=l+istk(ils+1)-istk(ils)
-         vol=istk(ils+nelt+1)-istk(ils+1)
-         if(top+1+nelt.ge.bot) then
-            call error(18)
-            return
-         endif
-         err=lstk(top+1)+vol-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1)
-         do 11 i=1,nelt
-            top=top+1
-            lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
- 11      continue
-         mrhs=mrhs+nelt
-      endif
-      endif
-c     
-c     execute scilab external
-c     
-      pt=pt+1
-      if(pt.gt.psiz) then
-         call  error(26)
-         return
-      endif
-      ids(1,pt)=lhs
-      ids(2,pt)=rhs
-      rstk(pt)=1001
-      lhs=mlhs
-      rhs=mrhs
-      niv=niv+1
-      fun=0
-c     
-      icall=5
-
-      include 'callinter.h'
-c     
- 200  lhs=ids(1,pt)
-      rhs=ids(2,pt)
-      pt=pt-1
-      niv=niv-1
-c+    
-c     transfer of output parameters of external to fortran
-      if(iflag.eq.0) then
-         call btof(ydot,n)
-      else
-         call btof(ydot,nd)
-      endif
-      if(err.gt.0.or.err1.gt.0) return
-c+    
-c     normal return iero set to 0
-      iero=0 
-      return
-c     
- 9999 continue
-      niv=niv-1
-      if(err1.gt.0) then
-         lhs=ids(1,pt)
-         rhs=ids(2,pt)
-         pt=pt-1
-         fun=0
-      endif
-      return
-      end
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/int2d.f b/scilab/modules/differential_equations/sci_gateway/fortran/int2d.f
deleted file mode 100644 (file)
index f29de0e..0000000
+++ /dev/null
@@ -1,150 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine int2d
-c     --------------------------------------------
-c     Scilab intg 
-c      implicit undefined (a-z)
-      include 'stack.h'
-      character*(5) fname
-      character*(nlgh+1) namef
-      integer iero 
-      common/ierajf/iero
-      external bint2d,fint2d
-      double precision tol,result,erro
-      logical getexternal,getrmat,type ,cremat,checkval
-      integer topk,lr,top2,lc
-c
-      integer iadr,sadr
-      external setfint2d
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-      fname='int2d'
-      if(rhs.lt.3) then
-         call error(39)
-         return
-      endif
-      type=.false.
-      top2=top
-      topk=top
-      if(rhs.eq.4) then
-         if (.not.getrmat(fname,topk,top,m1,n1,lr))  return
-         if(.not.checkval(fname,m1*n1,5)) return
-         tol=max(stk(lr),0.0d0)
-         iclose=stk(lr+1)
-         maxtri=max(int(stk(lr+2)),1)
-         mevals=max(int(stk(lr+3)),1)
-         iflag=stk(lr+4)
-         if((iclose.ne.0.and.iclose.ne.1) .or. 
-     $        (iflag.ne.0.and.iflag.ne.1)) then
-            err=4
-            call error(36)
-         endif
-         top=top-1
-      else
-         tol=1.d-10
-         iclose=1
-         maxtri=50
-         mevals=4000
-         iflag=1
-      endif
-c     
-      if (.not.getexternal(fname,topk,top,namef,type,setfint2d)) return
-      kext=top
-      top=top-1
-      
-      if (.not.getrmat(fname,topk,top,my,ny,ly))  return
-      if(.not.checkval(fname,my,3)) return
-
-      top=top-1
-      kxtop=top
-
-      if (.not.getrmat(fname,topk,top,mx,nx,lx))  return
-      if(.not.checkval(fname,mx,3)) return
-
-
-      if(.not.checkval(fname,nx,ny)) return
-
-c     definition des variables pour l'external
-      top=top2+1
-      kxx=top
-      if (.not.cremat(fname,top,0,1,1,lxx,lc)) return
-
-      top=top+1
-      kyy=top
-      if (.not.cremat(fname,top,0,1,1,lyy,lc)) return
-
-c     tableaux de travail 
-      lw=9*maxtri
-      top=top+1
-      if (.not.cremat(fname,top,0,1,lw,ldata,lc)) return
-
-c     tableau de travail entier necessaire 
-      liw=2*maxtri
-      top=top+1
-      if (.not.cremat(fname,top,0,1,iadr(liw)+1,liwork,lc)) return
-
-c
-c     external scilab
-c
-      top=top+1
-      ipal=iadr(lstk(top))
-      istk(ipal)=1
-      istk(ipal+1)=ipal+2
-      istk(ipal+2)=kext
-      istk(ipal+3)=kxx
-      istk(ipal+4)=kyy
-      lstk(top+1)=sadr(ipal+5)
-
-      nu=0
-      nd=0
-      if(type) then 
-         call TWODQ(fint2d,nx,stk(lx),stk(ly),tol,iclose,maxtri,mevals
-     $        ,result,erro,nu,nd,nevals,iflag,stk(ldata),stk(liwork))
-
-      else
-         call TWODQ(bint2d,nx,stk(lx),stk(ly),tol,iclose,maxtri,mevals
-     $        ,result,erro,nu,nd,nevals,iflag,stk(ldata),stk(liwork))
-
-      endif
-
-      if(err.gt.0.or.err1.gt.0)return
-      if(iflag.gt.0) then
-         if(iflag.eq.1) then
-c     termination for lack of space to divide triangle
-            call msgs(81,0)
-         elseif(iflag.eq.2) then
-c     termination because of roundoff noise
-            call msgs(82,0)
-         elseif(iflag.eq.3) then
-c     termination for relative error <5.0*%eps
-            call msgs(83,0)
-         elseif(iflag.eq.4) then
-c     termination: number of function evaluations > MEVALS
-            call msgs(84,0)
-         endif
-      endif
-      top=top2-rhs+1
-      if (.not.cremat(fname,top,0,1,1,lr1,lc)) return
-      stk(lr1)=result
-      if(lhs.ge.2) then
-         top=top+1
-         if (.not.cremat(fname,top,0,1,1,lr2,lc)) return
-         stk(lr2)=erro
-      endif
-      if(lhs.eq.3) then
-         top=top+1
-         if (.not.cremat(fname,top,0,1,1,lr2,lc)) return
-         stk(lr2)=nevals
-      endif
-      return
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/int3d.f b/scilab/modules/differential_equations/sci_gateway/fortran/int3d.f
deleted file mode 100644 (file)
index 7313db4..0000000
+++ /dev/null
@@ -1,167 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine int3d
-c     --------------------------------------------
-c     Scilab int3d 
-c      implicit undefined (a-z)
-      include 'stack.h'
-      character*(5) fname
-      character*(nlgh+1) namef
-      integer iero 
-      common/ierajf/iero
-      external bint3d,fint3d
-      double precision epsabs,epsrel
-      logical getexternal,getrmat,type ,cremat,checkval,getscalar
-      integer topk,lr,top2,lc,gettype,top0
-c
-      integer iadr,sadr
-      external setfint3d
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-      fname='int3d'
-      if(rhs.lt.4) then
-         call error(39)
-         return
-      endif
-      type=.false.
-      top0=top-rhs+1
-      topk=top
-      if(rhs.eq.6) then
-c      [minpts,maxpts,epsabs,epsrel]
-         if (.not.getrmat(fname,topk,top,m1,n1,lr))  return
-         if(.not.checkval(fname,m1*n1,4)) return
-         minpts=max(int(stk(lr)),0)
-         maxpts=max(int(stk(lr+1)),0)
-         epsabs=max(stk(lr+2),0.0d0)
-         epsrel=max(stk(lr+3),0.0d0)
-         if(maxpts.lt.minpts) then
-            err= 5
-            call error(36)
-         endif
-         top=top-1
-      else
-         minpts=0
-         maxpts=1000
-         epsabs=0.0d0
-         epsrel=1.D-5
-      endif
-c
-      if(gettype(top).eq.1) then
-         if(.not.getscalar(fname,topk,top,lnum)) return
-         numfun=stk(lnum)
-         top=top-1
-      else
-         numfun=1
-      endif
-      top2=top
-      if (.not.getexternal(fname,topk,top,namef,type,setfint3d)) return
-      kext=top
-      top=top-1
-      
-      if (.not.getrmat(fname,topk,top,mz,nz,lz))  return
-      if(.not.checkval(fname,mz,4)) return
-
-      top=top-1
-      if (.not.getrmat(fname,topk,top,my,ny,ly))  return
-      if(.not.checkval(fname,my,4)) return
-      top=top-1
-      if (.not.getrmat(fname,topk,top,mx,nx,lx))  return
-      if(.not.checkval(fname,mx,4)) return
-
-      if(.not.checkval(fname,nx,ny)) return
-      if(.not.checkval(fname,nx,nz)) return
-      numtet=nx
-
-      maxpts=max(maxpts,43*numtet)
-
-      top=top2
-c     form matrix ver
-      maxsub = 7*(maxpts-43*numtet)/(8*43) + numtet
-      lenver=maxsub
-      top=top+1
-      if (.not.cremat(fname,top,0,3,4*lenver,lver,lc)) return
-      call unsfdcopy(4*numtet,stk(lx),1,stk(lver),3)
-      call unsfdcopy(4*numtet,stk(ly),1,stk(lver+1),3)
-      call unsfdcopy(4*numtet,stk(lz),1,stk(lver+2),3)
-
-c     allocate matrix for result and abserr
-      top=top+1
-      if (.not.cremat(fname,top,0,numfun,2,lres,lc)) return
-
-c     form arg shape for external
-      top=top+1
-      kxyz=top
-      if (.not.cremat(fname,top,0,3,1,lxyz,lc)) return
-
-c     tableaux de travail 
-      mdiv=1
-      nw=maxsub*(2*numfun+1) + 7*max(8*mdiv,numtet)*numfun + 1
-      top=top+1
-      if (.not.cremat(fname,top,0,1,nw,lwork,lc)) return
-
-c     tableau de travail entier necessaire 
-      niw=lenver + mdiv
-      top=top+1
-      if (.not.cremat(fname,top,0,1,iadr(niw)+1,liwork,lc)) return
-
-c
-c     external scilab
-c
-      top=top+1
-      ipal=iadr(lstk(top))
-      istk(ipal)=1
-      istk(ipal+1)=ipal+2
-      istk(ipal+2)=kext
-      istk(ipal+3)=kxyz
-      lstk(top+1)=sadr(ipal+4)
-
-      irestar=0
-      if(type) then
-         call dcutet(fint3d,numfun,stk(lver),numtet,minpts,maxpts,epsabs
-     $        ,epsrel,lenver,nw,irestar,stk(lres),stk(lres+numfun),neval
-     $        ,ifail,stk(lwork),stk(liwork))
-      else
-         call dcutet(bint3d,numfun,stk(lver),numtet,minpts,maxpts,epsabs
-     $        ,epsrel,lenver,nw,irestar,stk(lres),stk(lres+numfun),neval
-     $        ,ifail,stk(lwork),stk(liwork))
-      endif
-      if(err.gt.0.or.err1.gt.0)return
-      if(ifail.gt.0) then
-         if(ifail.eq.1) then
-c     MAXPTS was too small to obtain the required accuracy
-            call msgs(85,0)
-         elseif(ifail.eq.3) then
-c     volume of one of the  given tetrahedrons is zero
-            buf='volume of one of the  given tetrahedrons is zero'
-            call error(999)
-         else
-            buf='inexpected error: please report'
-            call error(999)
-         endif
-      endif
-      top=top0
-      if (.not.cremat(fname,top,0,numfun,1,lr1,lc)) return
-      call unsfdcopy(numfun,stk(lres),1,stk(lr1),1)
-
-      if(lhs.ge.2) then
-         top=top+1
-         if (.not.cremat(fname,top,0,numfun,1,lr2,lc)) return
-         call unsfdcopy(numfun,stk(lres+numfun),1,stk(lr2),1)
-      endif
-      if(lhs.eq.3) then
-         top=top+1
-         if (.not.cremat(fname,top,0,1,1,lr2,lc)) return
-         stk(lr2)=neval
-      endif
-      return
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/intg.f b/scilab/modules/differential_equations/sci_gateway/fortran/intg.f
deleted file mode 100644 (file)
index a7bea46..0000000
+++ /dev/null
@@ -1,103 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine intg
-c     --------------------------------------------
-c     Scilab intg 
-c      implicit undefined (a-z)
-      character*(4) fname
-      character*6   namef
-      include 'stack.h'
-      integer iero 
-      common/ierajf/iero
-      common/cintg/namef
-      external bintg,fintg
-      double precision epsa,epsr,a,b,val,abserr
-      logical getexternal, getscalar,type ,cremat
-      integer topk,lr,katop,kydot,top2,lra,lrb,lc
-      integer iipal,lpal,lw,liw,lpali,ifail
-      integer iadr,sadr
-      external setfintg
-c
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-      fname='intg'
-      if(rhs.lt.3) then
-         call error(39)
-         return
-      endif
-      type=.false.
-      top2=top
-      topk=top
-      if(rhs.eq.5) then
-         if (.not.getscalar(fname,topk,top,lr)) return
-         epsr=stk(lr)
-         top=top-1
-      else
-         epsr=1.0d-8
-      endif
-      if (rhs.ge.4) then 
-         if (.not.getscalar(fname,topk,top,lr)) return
-         epsa=stk(lr)
-         top=top-1
-      else
-         epsa=1.0d-14
-      endif
-c     cas standard
-      if (.not.getexternal(fname,topk,top,namef,type,
-     $     setfintg)) return
-      kydot=top
-      top=top-1
-      if (.not.getscalar(fname,topk,top,lrb)) return
-      b=stk(lrb)
-      top=top-1
-      katop=top
-      if (.not.getscalar(fname,topk,top,lra)) return
-      a=stk(lra)
-c     tableaux de travail 
-      top=top2+1
-      lw=3000
-      if (.not.cremat(fname,top,0,1,lw,lpal,lc)) return
-      top=top+1
-c     tableau de travail entier necessaire 
-      liw=3000/8+2
-      if (.not.cremat(fname,top,0,1,iadr(liw)+1,lpali,lc)) return
-      top=top+1
-c
-c     external scilab
-c
-      iipal=iadr(lstk(top))
-      istk(iipal)=1
-      istk(iipal+1)=iipal+2
-      istk(iipal+2)=kydot
-      istk(iipal+3)=katop
-      lstk(top+1)=sadr(iipal+4)
-      if(type) then 
-         call dqag0(fintg,a,b,epsa,epsr,val,abserr,
-     +        stk(lpal),lw,stk(lpali),liw,ifail)
-      else
-         call dqag0(bintg,a,b,epsa,epsr,val,abserr,
-     +        stk(lpal),lw,stk(lpali),liw,ifail)
-      endif
-      if(err.gt.0.or.err1.gt.0)return
-      if(ifail.gt.0) then
-         call error(24)
-         return
-      endif
-      top=top2-rhs+1
-      stk(lra)=val
-      if(lhs.eq.2) then
-         top=top+1
-         stk(lrb)=abserr
-         return
-      endif
-      return
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_bvode.f b/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_bvode.f
deleted file mode 100644 (file)
index ad11ab4..0000000
+++ /dev/null
@@ -1,202 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) ENPC - Jean-Philippe Chancelier
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine scibvode(fname)
-c
-c      implicit undefined (a-z)
-c     -----------------------------------------------------
-      include 'stack.h'
-      character*(*) fname
-      character tmpbuf * (bsiz)      
-      character*(nlgh+1)   efsub,edfsub,egsub,edgsub,eguess
-      integer    kfsub,kdfsub,kgsub,kdgsub,kguess,topk
-      external   fsub,dfsub,gsub,dgsub,dguess
-      external setfcolgu,setfcoldg,setfcolg,setfcoldf
-      external setfcolf
-      integer    mstar,ncomp,io
-      double precision aleft,aright
-      integer iadr,lr,iflag,mf,nf,lfixpnt,mtol,ntol,ltol,l
-      integer mltol,nltol,lltol,iero,mipar,nipar,lipar,mzeta,nzeta,lzeta
-      integer mm,mn,lrm,i,lispace,lspace,lc,ki,kz,kx,lr1,lc1
-      integer mres,nres,lres
-      integer itfsub,itdfsub,itgsub,itdgsub,itguess,gettype
-      logical type,getexternal,getrmat,cremat,getscalar
-      common/iercol/iero
-C     External names 
-      common / colname / efsub,edfsub,egsub,edgsub,eguess
-C     External Position in stack and arguments model position in stack
-      common / coladr / kfsub,kdfsub,kgsub,kdgsub,kguess,kx,ki,kz
-C     Type of externals 
-      common / coltyp / itfsub,itdfsub,itgsub,itdgsub,itguess
-      common / icolnew/  ncomp,mstar
-c
-      iadr(l)=l+l-1
-
-c
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:4),'(i4)') fin
-         call basout(io,wte,' bva '//tmpbuf(1:4))
-      endif
-c
-c     fin  1
-c         bvode
-c
-c     z=bvode(res,ncomp,m,aleft,aright,zeta,ipar,ltol,tol,fixpnt,...
-c      fsub1,dfsub1,gsub1,dgsub1,guess1)
-c
-c     Interface for the colnew program for boundary values problem.
-      type=.false.
-      topk=top
-      kguess=top
-c     guess1 external
-      itguess= gettype(top)
-      if (.not.getexternal(fname,topk,top,eguess,type,
-     $     setfcolgu)) return
-      top=top-1
-c     dgsub1 external
-      itdgsub=gettype(top)
-      kdgsub=top
-      if (.not.getexternal(fname,topk,top,edgsub,type,
-     $     setfcoldg)) return
-      top=top-1
-c     gsub1 external
-      itgsub=gettype(top)
-      kgsub=top
-      if (.not.getexternal(fname,topk,top,egsub,type,
-     $     setfcolg)) return
-      top=top-1
-c     dfsub1 external
-      itdfsub=gettype(top)
-      kdfsub=top
-      if (.not.getexternal(fname,topk,top,edfsub,type,
-     $     setfcoldf)) return
-      top=top-1
-c     fsub1 external
-      itfsub=gettype(top)
-      kfsub=top
-      if (.not.getexternal(fname,topk,top,efsub,type,
-     $     setfcolf)) return
-c      write(06,*) 'args',itfsub,itdfsub,itgsub,itdgsub,itguess
-      top=top-1
-c     fixpnt
-      if (.not.getrmat(fname,topk,top,mf,nf,lfixpnt))  return
-      top=top-1
-c     tol
-      if (.not.getrmat(fname,topk,top,mtol,ntol,ltol))  return
-      top=top-1
-c     ltol
-      if (.not.getrmat(fname,topk,top,mltol,nltol,lltol))  return
-      call entier(mltol*nltol,stk(lltol),istk(iadr(lltol)))
-      top=top-1
-c     ipar  
-      if (.not.getrmat(fname,topk,top,mipar,nipar,lipar))  return
-      if(mipar*nipar.lt.11) then 
-c     .  bvode: ipar dimensioned at least 11
-         call error(251) 
-      endif
-      ilipar=iadr(lipar)
-      call entier(mipar*nipar,stk(lipar),istk(ilipar))
-c
-      if(istk(ilipar+3).ne.mltol*nltol) then 
-C     .  bvode: ltol must be of size ipar(4)
-         call error(252) 
-      endif
-      if(istk(ilipar+10).ne.mf*nf.and.istk(ilipar+10).ne.0) then 
-c     .  bvode: fixpnt must be of size ipar(11)
-         call error(253) 
-      endif
-      top=top-1
-c     zeta 
-      if (.not.getrmat(fname,topk,top,mzeta,nzeta,lzeta))  return
-      top=top-1
-c     aright  
-      if (.not.getscalar(fname,topk,top,lr))  return
-      aright=stk(lr)
-      top=top-1
-c     aleft
-      if (.not.getscalar(fname,topk,top,lr))  return
-      aleft=stk(lr)
-      top=top-1
-c     m
-      if (.not. getrmat(fname,topk,top,mm,mn,lrm)) return 
-      call entier(mm*mn,stk(lrm),istk(iadr(lrm)))
-      mstar=0
-      do 10 i=1,mm*mn
-         mstar=mstar+ istk(iadr(lrm)+i-1)
- 10   continue
-      top=top-1
-c     ncomp
-      if (.not.getscalar(fname,topk,top,lr))  return
-      ncomp=int(stk(lr))
-      if(ncomp.gt.20) then 
-c     .  bvode: ncomp < 20 requested 
-         call error(254) 
-      endif
-      if(mm*mn.ne.ncomp) then 
-c     .  bvode: m must be of size ncomp
-         call error(255) 
-      endif
-      if(mstar.gt.40) then 
-c     .  bvode: sum(m must be less than 40
-         call error(256) 
-      endif
-
-      top=top-1
-c     res
-      if (.not.getrmat(fname,topk,top,mres,nres,lres))  return
-c
-c     create working arrays
-      top=topk+1
-      if (.not.cremat(fname,top,0,1,istk(iadr(lipar)+6-1),lispace,lc)) 
-     $     return
-      top=top+1
-      if (.not.cremat(fname,top,0,1,istk(iadr(lipar)+5-1),lspace,lc)) 
-     $     return
-C     Modele des arguments des external x scalaire z vecteur 
-      top=top+1
-      ki=top
-      kx=top
-      if (.not.cremat(fname,top,0,1,1,lr,lc)) return
-      top=top+1
-      kz=top
-      if (.not.cremat(fname,top,0,mstar,1,lr,lc)) return
-      iero=0
-      call colnew (ncomp,istk(iadr(lrm)),aleft,aright,stk(lzeta),
-     $     istk(iadr(lipar)),istk(iadr(lltol)), stk(ltol),stk(lfixpnt),
-     $     istk(iadr(lispace)), stk(lspace), iflag, fsub, 
-     $             dfsub, gsub, dgsub, dguess) 
-      if(err.gt.0.or.err1.gt.0) return
-      if(iero.gt.0) then
-         call error(24)
-         Return
-      endif
-      if ( iflag.ne.1) then 
-         goto (101,102,103,104) iflag+4
- 101     call error(258)
-         return 
- 102     call error(24)
-         return
- 103     call error(259)
-         return
- 104     call error(260)
-         return
-      endif
-      top=top+1
-      if (.not.cremat(fname,top,0,mstar,mres*nres,lr,lc)) return
-         do 20 i=1,mres*nres
-            call appsln(stk(lres+i-1),stk(lr+(i-1)*mstar),stk(lspace),
-     $           istk(iadr(lispace)))
- 20      continue
-      top=topk-rhs+1
-      if (.not.cremat(fname,top,0,mstar,mres*nres,lr1,lc1)) return
-      call unsfdcopy(mstar*mres*nres,stk(lr),1,stk(lr1),1)
-      return
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_dasrt.f b/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_dasrt.f
deleted file mode 100644 (file)
index 51e5d8e..0000000
+++ /dev/null
@@ -1,569 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA/ENPC
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine dasrti(fname)
-c ====================================================================
-C     dasrt 
-c ====================================================================
-c
-      INCLUDE 'stack.h'
-c
-      character*(*) fname
-      character*(nlgh+1) namjac
-      common/cjac/namjac
-      integer iadr,sadr,gettype
-c
-      double precision atol,rtol,t0
-      integer info(15),topk,topw
-      logical hotstart,type,getexternal,getrvect
-      logical checkrhs,checklhs,getrmat,cremat,getscalar
-      double precision tout,tstop,maxstep,stepin
-      character*(nlgh+1) namer,namej,names
-      common /dassln/ namer,namej,names
-      external bresd,bjacd,bsurfd
-      external setfresd,setfjacd,setfsurfd
-      common/ierode/iero
-c     
-      data atol/1.d-7/,rtol/1.d-9/
-c     
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-
-c     SCILAB function : dasrt
-c     --------------------------
-c     [y0,nvs,[,hotdata]]=dasrt(y0,t0,t1[,atol,rtol],res[,jac],nh,h,info
-c     [,hotdata])
-      iero=0
-      maxord=5
-      lbuf = 1
-      topk=top
-      topw=top+1
-      lw = lstk(topw)
-      l0 = lstk(top+1-rhs)
-      if (.not.checkrhs(fname,6,11)) return
-      if (.not.checklhs(fname,2,3)) return
-c     checking variable y0 (number 1)
-c     -------------------------------
-      ky=top-rhs+1
-      if(.not.getrmat(fname,topk,ky,n1,m1,l1))return
-      neq=n1
-      lydot=l1+n1
-      info(11)=0
-      if (m1 .eq.1) then
-         if (.not.cremat(fname,topw,0,n1,1,lydot,lc)) return
-         topw=topw+1
-         info(11)=1
-         call dset(n1,0.0d0,stk(lydot),1)
-      elseif(m1.ne.2) then
-         err = 1
-         call error(89)
-         return
-      else 
-         il1 = iadr(lstk(top-rhs+1))
-         istk(il1+2)=1
-      endif
-c     checking variable t0 (number 2)
-c     ----------------------------
-      kt0=top-rhs+2
-      if(.not.getscalar(fname,topk,kt0,lr2))return
-      t0=stk(lr2)
-c     checking variable t1 (number 3)
-c     -------------------------------
-      if(.not.getrmat(fname,topk,top-rhs+3,m3,n3,l3))return
-      nt=m3*n3
-c     
-c     checking variable atol (number 4)
-c     --------------------------------
-      iskip=0
-      itype = gettype(top-rhs+4)
-      if ( itype .ne. 1) then
-         if (.not.cremat(fname,topw,0,1,1,latol,lc)) return
-         topw=topw+1
-         if (.not.cremat(fname,topw,0,1,1,lrtol,lc)) return
-         topw=topw+1
-         stk(latol)=atol
-         stk(lrtol)=rtol
-         info(2)=0
-         iskip=iskip+2
-         goto 1105
-      endif
-      if(.not.getrvect(fname,topk,top-rhs+4,m4,n4,latol))return
-      m4 = m4*n4
-c     checking variable rtol (number 5)
-c     --------------------------------
-      itype = gettype(top-rhs+5)
-      if (itype .ne. 1) then
-         if (.not.cremat(fname,topw,0,1,1,lrtol,lc)) return
-         topw=topw+1
-         stk(lrtol)=lrtol
-         info(2)=0
-         iskip=iskip+1
-         goto 1105
-      endif
-      if(.not.getrvect(fname,topk,top-rhs+5,m5,n5,lrtol))return
-      m5 = m5*n5
-      if(m5.ne.m4) then
-         call error(60)
-         return
-      endif
-      if(m5.eq.1) then
-         info(2)=0
-      else
-         info(2)=1
-      endif
-      
-c     checking variable res (number 6)
-c     --------------------------------
- 1105 kres=top-rhs+6-iskip
-      if (.not.getexternal(fname,topk,kres,namer,type,
-     $     setfresd)) return
-
-c     checking variable number 7
-c     -----------------------------
-      kjac=top-rhs+7-iskip
-      if(kjac.gt.top) then
-         iskip=iskip+1
-         info(5)=0
-      else
-         is7 = gettype(kjac)
-         if(is7.eq.15) then
-c     .     info or jac ? get list list first element type to decide
-            il7=iadr(lstk(kjac))
-            if (istk(il7).lt.0)  il7=istk(il7+1)
-            nelt=istk(il7+1)
-            l71=sadr(il7+3+nelt)
-            if (abs(istk(iadr(l71))).eq.11.or.
-     $           abs(istk(iadr(l71))).eq.13) then
-c     .        jac
-               is7=istk(iadr(l71))
-            endif
-         endif
-         if((is7.ne.10).and.(is7.ne.11).and.(is7.ne.13)) then
-            iskip=iskip+1
-            info(5)=0
-         else
-            info(5)=1
-            if (.not.getexternal(fname,topk,kjac,namej,type,
-     $           setfjacd)) return
-         endif
-      endif
-c     DASRT nh,h
-c     checking variable number 8
-c     -----------------------------
-      if(.not.getscalar(fname,topk,top-rhs+8-iskip,lr8))return
-      nh=int(stk(lr8))
-c     checking variable number 9
-      ksurf=top-rhs+9-iskip
-      if (.not.getexternal(fname,topk,ksurf,names,type,
-     $        setfsurfd)) return
-c     
-c     checking variable info (number 10)
-c     ------------------------------------
-      kinfo = top-rhs+10-iskip
-      if (kinfo.gt.top) then
-         info(4)=0
-         info(3)=0
-         info(6)=0
-         info(7)=0
-         info(8)=0
-         info(10)=0
-         info(11)=0
-         iskip=iskip+1
-         goto 10
-      endif
-      il10 = iadr(lstk(top-rhs+10-iskip))
-      if (istk(il10) .ne. 15) then
-c     default info values
-         info(4)=0
-         info(3)=0
-         info(6)=0
-         info(7)=0
-         info(8)=0
-         info(10)=0
-         info(11)=0
-         iskip=iskip+1
-         goto 10
-      endif
-      n10=istk(il10+1)
-      l10=sadr(il10+n10+3)
-c     
-c     --   subvariable tstop(info) --
-      il10e1=iadr(l10+istk(il10+1+1)-1)
-      l10e1 = sadr(il10e1+4)
-      m10e1 = istk(il10e1+1)*istk(il10e1+2)
-      if(m10e1.eq.0) then
-         info(4)=0
-      else
-         info(4)=1
-         tstop=stk(l10e1)
-      endif
-      
-c     
-c     --   subvariable imode(info) --
-      il10e2=iadr(l10+istk(il10+1+2)-1)
-      l10e2 = sadr(il10e2+4)
-      info(3)=stk(l10e2)
-      
-c     
-c     --   subvariable band(info) --
-      il10e3=iadr(l10+istk(il10+1+3)-1)
-      m10e3 =istk(il10e3+2)*istk(il10e3+2)
-      l10e3 = sadr(il10e3+4)
-      if(m10e3.eq.0) then
-         info(6)=0
-      elseif(m10e3.eq.2) then
-         info(6)=1
-         ml=stk(l10e3)
-         mu=stk(l10e3+1)
-      else
-         err=10-iskip
-         call error(89)
-         return
-      endif
-c     
-c     --   subvariable maxstep(info) --
-      il10e4=iadr(l10+istk(il10+1+4)-1)
-      m10e4 =istk(il10e4+2)*istk(il10e4+2)
-      l10e4 = sadr(il10e4+4)
-      if(m10e4.eq.0) then
-         info(7)=0
-      else
-         info(7)=1
-         maxstep=stk(l10e4)
-      endif
-      
-c     
-c     --   subvariable stepin(info) --
-      il10e5=iadr(l10+istk(il10+1+5)-1)
-      m10e5 =istk(il10e5+2)*istk(il10e5+2)
-      l10e5 = sadr(il10e5+4)
-      if(m10e5.eq.0) then
-         info(8)=0
-      else
-         info(8)=1
-         stepin=stk(l10e5)
-      endif
-      
-c     
-c     --   subvariable nonneg(info) --
-      il10e6=iadr(l10+istk(il10+1+6)-1)
-      l10e6 = sadr(il10e6+4)
-      info(10)=stk(l10e6)
-c     
-c     --   subvariable isest(info) --
-      il10e7=iadr(l10+istk(il10+1+7)-1)
-      l10e7 = sadr(il10e7+4)
-      isest=stk(l10e7)
-      if(isest.eq.1) info(11)=1
-      
-      
- 10   hotstart=.false.
-      if(rhs.eq.11-iskip) then
-         hotstart=.true.
-c     
-c     checking variable hotdata (number 11)
-c     --------------------------------------
-         
-         il11 = iadr(lstk(top-rhs+11-iskip))
-         if (istk(il11) .ne. 1) then
-            err = 11-iskip
-            call error(53)
-            return
-         endif
-         n11 = istk(il11+1)*istk(il11+2)
-         lhot = sadr(il11+4)
-      elseif(rhs.ne.10-iskip) then
-         call error(39)
-         return
-      endif
-c     --------------------Work Tables 
-      if (.not.cremat(fname,topw,0,1,1,lw15,lc)) return
-      topw=topw+1      
-      if (.not.cremat(fname,topw,0,1,1,lw17,lc)) return
-      topw=topw+1      
-      il17=iadr(lw17)
-c     dasrt needs more
-      if (.not.cremat(fname,topw,0,1,nh,lgr,lc)) return
-      topw=topw+1      
-      lgroot=iadr(lgr)
-c     
-      if(info(6).eq.0) then
-C     for the full (dense) JACOBIAN case 
-         lrw = 50+(maxord+4)*neq+neq**2+3*nh
-      elseif(info(5).eq.1) then
-C     for the banded user-defined JACOBIAN case
-         lrw=50+(maxord+4)*neq+(2*ml+mu+1)*neq+3*nh
-      elseif(info(5).eq.0) then
-C     for the banded finite-difference-generated JACOBIAN case
-         lrw = 50+(maxord+4)*neq+(2*ml+mu+1)*neq+2*(neq/(ml+mu+1)+1)+
-     $        3*nh
-      endif
-      liw=20+neq
-      if(.not.hotstart) then
-         if (.not.cremat(fname,topw,0,1,lrw,lrwork,lc)) return
-         topw=topw+1
-         if (.not.cremat(fname,topw,0,1,sadr(liw)+1,liwork,lc)) return
-         topw=topw+1
-      else
-         if(lrw+liw.gt.n11) then
-            err=11-iskip
-            call error(89)
-            return
-         endif
-         lrwork=lhot
-         liwork=lhot+lrw
-         call entier(liw,stk(liwork),istk(iadr(liwork)))
-      endif
-c     
-      if(info(4).eq.1) then
-         stk(lrwork)=tstop
-      endif
-      if(info(7).eq.1) then
-         stk(lrwork+1)=maxstep
-      endif
-      if(info(8).eq.1) then
-         stk(lrwork+2)=stepin
-      endif
-      if(info(6).eq.1) then
-         istk(iadr(liwork))=ml
-         istk(iadr(liwork+1))=mu
-      endif
-c     structure d'info pour les externals
-      top=topw
-      lw=lstk(top)
-      ilext=iadr(lw)
-      istk(ilext)=3
-      istk(ilext+1)=ilext+5
-      istk(ilext+2)=ilext+9
-      istk(ilext+3)=ilext+13
-      istk(ilext+4)=ilext+16
-      istk(ilext+5)=kres
-      istk(ilext+6)=neq
-      istk(ilext+7)=kt0
-      istk(ilext+8)=ky
-      istk(ilext+9)=kjac
-      istk(ilext+10)=neq
-      istk(ilext+11)=kt0
-      istk(ilext+12)=ky
-      istk(ilext+13)=ksurf
-      istk(ilext+14)=kt0
-      istk(ilext+15)=ky
-c     istk(ilext+16)=ky
-      lw=sadr(ilext)+16
-      
-      lw0=lw
-      ilyr=iadr(lw)
-      istk(ilyr)=1
-      istk(ilyr+1)=2*n1+1
-      istk(ilyr+3)=0
-      lyr=sadr(ilyr+4)
-      lyri=lyr-(2*n1+1)
-      k=0
-      info(1)=0
-      if(hotstart) info(1)=1
-      info(9)=0
-      do 1120 i=0,nt-1
-         tout=stk(l3+i)
-c     
- 1115    k=k+1
-         lyri=lyri+(2*n1+1)
-         lw=lyri+(2*n1+1)
-         lstk(top+1)=lw
-         margin=(k-1)*(2*n1+1)+4
-         lw1=lw+margin
-         if(lhs.eq.3) lw1=lw1+4+lrw+liw
-         if(lw1-lstk(bot).gt.0) then
-c     not enough memory
-            call msgstxt('Not enough memory to go further')
-            k=k-1
-            goto 1125
-         endif
-         if (tout .eq. t0) then
-            stk(lyri)=tout
-            call unsfdcopy(n1,stk(l1),1,stk(lyri+1),1)
-            call unsfdcopy(n1,stk(lydot),1,stk(lyri+n1+1),1)
-            l1=lyri+1
-            lydot=lyri+n1+1
-            t0=tout
-            goto 1120            
-         else
-            stk(lyri)=tout
-            call unsfdcopy(n1,stk(l1),1,stk(lyri+1),1)
-            call unsfdcopy(n1,stk(lydot),1,stk(lyri+n1+1),1)
-            l1=lyri+1
-            lydot=lyri+n1+1
-            call ddasrt(bresd,n1,t0,stk(l1),stk(lydot),
-     &           stk(lyri),info,stk(lrtol),stk(latol),idid,
-     &           stk(lrwork),lrw,istk(iadr(liwork)),liw,stk(lw15),
-     &           istk(il17),bjacd,bsurfd,nh,istk(lgroot))
-C     SUBROUTINE DDASRT (RES,NEQ,T,Y,YPRIME,TOUT,
-C     *  INFO,RTOL,ATOL,IDID,RWORK,LRW,IWORK,LIW,RPAR,IPAR,JAC,
-C     *  G,NG,JROOT)
-         endif
-         if(err.gt.0.or.err1.gt.0)  return
-         if(idid.eq.1) then
-C     A step was successfully taken in the intermediate-output mode. 
-C     The code has not yet reached TOUT.
-            stk(lyri)=t0
-            info(1)=1
-            goto 1115
-            
-         elseif(idid.eq.2) then
-C     The integration to TSTOP was successfully completed (T=TSTOP)
-            goto 1125
-            
-         elseif(idid.eq.3) then
-C     The integration to TOUT was successfully completed (T=TOUT) by 
-C     stepping past TOUT. Y,ydot are obtained by interpolation.
-            t0=tout
-            info(1)=1
-            goto 1120
-         elseif(idid.eq.4) then
-C     one or more root found
-            stk(lyri)=t0
-C     stk(lrw+41)
-            goto 1125 
-         elseif(idid.eq.-1) then
-C     A large amount of work has been expended (About 500 steps)
-            call msgstxt('to many steps necessary to reached next '//
-     &           'required time discretization point')
-            call msgstxt('Change discretisation of time vector t '//
-     &           'or decrease accuracy')
-            stk(lyri)=t0
-            goto 1125
-         elseif(idid.eq.-2) then
-C     The error tolerances are too stringent.
-            t0=tout
-            info(1)=1
-            goto 1115
-c     buf='The error tolerances are too stringent'
-c     call error(9982)
-c     return
-         elseif(idid.eq.-3) then
-C     The local error test cannot be satisfied because you specified 
-C     a zero component in ATOL and the corresponding computed solution
-C     component is zero. Thus, a pure relative error test is impossible 
-C     for this component.
-            buf='atol and computed test value are zero'
-            call error(9983)
-            return
-         elseif(idid.eq.-6) then
-C     repeated error test failures on the last attempted step.
-            call msgstxt('A singularity in the solution '//
-     &           'may be present')
-            goto 1125
-         elseif(idid.eq.-7) then
-C     The corrector could not converge.
-            call msgstxt('May be inaccurate or ill-conditioned '//
-     &           'JACOBIAN')
-            goto 1125
-         elseif(idid.eq.-8) then
-C     The matrix of partial derivatives is singular.
-            buf='The matrix of partial derivatives is singular'//
-     &           'Some of your equations may be redundant'
-            call error(9986)
-            return
-         elseif(idid.eq.-9) then
-C     The corrector could not converge. there were repeated error 
-c     test failures in this step.
-            call msgstxt('Either ill-posed problem or '//
-     &           'discontinuity or singularity encountered')
-            goto 1125
-         elseif(idid.eq.-10) then
-            call msgstxt('external ''res'' return many times'//
-     &           'with ires=-1')
-            goto 1125
-         elseif(idid.eq.-11) then
-C     IRES equal to -2 was encountered  and control is being returned to the
-C     calling program.
-            buf='error in external ''res'' '
-            call error(9989)
-            return
-         elseif(idid.eq.-12) then
-C     DDASSL failed to compute the initial YPRIME.
-            buf='dassrt failed to compute the initial Ydot.'
-            call error(9990)
-            return
-         elseif(idid.eq.-33) then
-C     The code has encountered trouble from which
-C     it cannot recover. A message is printed
-C     explaining the trouble and control is returned
-C     to the calling program. For example, this occurs
-C     when invalid input is detected.
-            call msgstxt('dassrt encountered trouble')
-            goto 1125
-         endif
-         t0=tout
-         info(1)=1
- 1120 continue
-c     
- 1125 top=topk-rhs
-      mv=lw0-l0
-c     
-c     Variable de sortie: y0
-c     
-      top=top+1
-      if(k.eq.0) istk(ilyr+1)=0
-      istk(ilyr+2)=k
-      lw=lyr+(2*n1+1)*k
-      lstk(top+1)=lw-mv
-c     
-c     Variable de sortie: roots
-c     
-      top=top+1
-      ilw=iadr(lw)
-      err=lw+4+nh+1-lstk(bot)
-      if (err .gt. 0) then
-         call error(17)
-         return
-      endif
-      istk(ilw)=1
-      istk(ilw+1)=1
-      istk(ilw+2)=1
-      istk(ilw+3)=0
-      l=sadr(ilw+4)
-      stk(l)=t0
-      kkk=1
-      do 1153 i=0,nh-1
-         if(istk(lgroot+i).ne.0) then
-            l=l+1
-            kkk=kkk+1
-            istk(ilw+2)=istk(ilw+2)+1
-            stk(l)=i+1
-         endif
- 1153 continue
-      lw=l+1
-      lstk(top+1)=lw-mv
-      if(lhs.eq.2) goto 1150
-c     
-c     Variable de sortie: rwork
-c     
-      top=top+1
-      ilw=iadr(lw)
-      err=lw+4+lrw+liw-lstk(bot)
-      if (err .gt. 0) then
-         call error(17)
-         return
-      endif
-      istk(ilw)=1
-      istk(ilw+1)=lrw+liw
-      istk(ilw+2)=1
-      istk(ilw+3)=0
-      lw=sadr(ilw+4)
-      call unsfdcopy(lrw,stk(lrwork),1,stk(lw),1)
-      call int2db(liw,istk(iadr(liwork)),1,stk(lw+lrw),1)
-      lw=lw+lrw+liw
-      lstk(top+1)=lw-mv
-c     
-c     Remise en place de la pile
- 1150 call unsfdcopy(lw-lw0,stk(lw0),1,stk(l0),1)      
-      return
-      end      
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_dassl.f b/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_dassl.f
deleted file mode 100644 (file)
index 64d2ef0..0000000
+++ /dev/null
@@ -1,511 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine dassli(fname)
-      character*(*) fname
-c     ============================================
-      INCLUDE 'stack.h'
-c
-      integer iadr,sadr
-      integer topk,topw, info(15),gettype
-      logical hotstart,getexternal,getrvect,type
-      logical checkrhs,checklhs,getrmat,cremat,getscalar
-      double precision tout,tstop,maxstep,stepin
-      double precision atol,rtol,t0
-      character*(nlgh+1) namer,namej,names
-      character*(nlgh+1) namjac
-      external bresd,bjacd
-      external setfresd,setfjacd
-
-      common /dassln/ namer,namej,names
-      common/ierode/iero
-      common/cjac/namjac
-c     
-      data atol/1.d-7/,rtol/1.d-9/
-c     
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c     
-c     SCILAB function : dassl
-c     --------------------------
-c     [y0 [,hotdata]]=dassl(y0,t0,t1 [,atol,rtol],res [,jac],info..
-c     [,hotdata])
-      iero=0
-      maxord=5
-      lbuf = 1
-      topk=top
-      topw=top+1
-      lw = lstk(topw)
-      l0 = lstk(top+1-rhs)
-      if (.not.checkrhs(fname,4,9)) return
-      if (.not.checklhs(fname,1,2)) return
-c     checking variable y0 (number 1)
-c     -------------------------------
-      ky=top-rhs+1
-      if(.not.getrmat(fname,topk,ky,n1,m1,l1))return
-      neq=n1
-      lydot=l1+n1
-      info(11)=0
-      if (m1 .eq.1) then
-         if (.not.cremat(fname,topw,0,n1,1,lydot,lc)) return
-         topw=topw+1
-         info(11)=1
-         call dset(n1,0.0d0,stk(lydot),1)
-      elseif(m1.ne.2) then
-         err = 1
-         call error(89)
-         return
-      else 
-         il1 = iadr(lstk(top-rhs+1))
-         istk(il1+2)=1
-      endif
-c     checking variable t0 (number 2)
-c     -------------------------------
-      kt0=top-rhs+2
-      if(.not.getscalar(fname,topk,kt0,lr2))return
-      t0=stk(lr2)
-c     checking variable t1 (number 3)
-c     -------------------------------
-      if(.not.getrmat(fname,topk,top-rhs+3,m3,n3,l3))return
-      nt=m3*n3
-c     
-c     checking variable atol (number 4)
-c     -------------------------------
-      iskip=0
-      itype = gettype(top-rhs+4)
-      if ( itype .ne. 1) then
-         if (.not.cremat(fname,topw,0,1,1,latol,lc)) return
-         topw=topw+1
-         if (.not.cremat(fname,topw,0,1,1,lrtol,lc)) return
-         topw=topw+1
-         stk(latol)=atol
-         stk(lrtol)=rtol
-         info(2)=0
-         iskip=iskip+2
-         goto 105
-      endif
-      if(.not.getrvect(fname,topk,top-rhs+4,m4,n4,latol))return
-      m4 = m4*n4
-c     checking variable rtol (number 5)
-c     --------------------------------
-      itype = gettype(top-rhs+5)
-      if (itype .ne. 1) then
-         if (.not.cremat(fname,topw,0,1,1,lrtol,lc)) return
-         topw=topw+1
-         stk(lrtol)=lrtol
-         info(2)=0
-         iskip=iskip+1
-         goto 105
-      endif
-      if(.not.getrvect(fname,topk,top-rhs+5,m5,n5,lrtol))return
-      m5 = m5*n5
-      if(m5.ne.m4) then
-         call error(60)
-         return
-      endif
-      if(m5.eq.1) then
-         info(2)=0
-      else
-         info(2)=1
-      endif
-c     checking variable res (number 6)
-c     
- 105  kres=top-rhs+6-iskip
-      if (.not.getexternal(fname,topk,kres,namer,type,
-     $     setfresd)) return
-c     checking variable jac (number 7)
-c     
-      kjac=top-rhs+7-iskip
-      if(kjac.gt.top) then
-         iskip=iskip+1
-         info(5)=0
-      else
-         isres=gettype(kjac)
-         if(isres.eq.15) then
-c     .     info or jac ? get list first element type to decide
-            il6=iadr(lstk(kjac))
-            if (istk(il6).lt.0)  il6=istk(il6+1)
-            nelt=istk(il6+1)
-            l61=sadr(il6+3+nelt)
-            if (abs(istk(iadr(l61))).eq.11.or.
-     $           abs(istk(iadr(l61))).eq.13) then
-c     .        jac
-               isres=istk(iadr(l61))
-            endif
-         endif
-            
-         if((isres.ne.10).and.(isres.ne.11).and.(isres.ne.13)) then
-            iskip=iskip+1
-            info(5)=0
-         else
-            info(5)=1
-            if (.not.getexternal(fname,topk,kjac,namej,type,
-     $           setfjacd)) return
-         endif
-      endif
-c     
-c     checking variable info (number 8)
-c     ---------------------------------
-      kinfo=top-rhs+8-iskip
-      if (kinfo.gt.top) then
-         info(4)=0
-         info(3)=0
-         info(6)=0
-         info(7)=0
-         info(8)=0
-         info(10)=0
-         info(11)=0
-         iskip=iskip+1
-         goto 10
-      endif
-      il8 = iadr(lstk(top-rhs+8-iskip))
-      if (istk(il8) .ne. 15) then
-c     default info values
-         info(4)=0
-         info(3)=0
-         info(6)=0
-         info(7)=0
-         info(8)=0
-         info(10)=0
-         info(11)=0
-         iskip=iskip+1
-         goto 10
-      endif
-      n8=istk(il8+1)
-      l8=sadr(il8+n8+3)
-c     
-c     --   subvariable tstop(info) --
-      il8e1=iadr(l8+istk(il8+1+1)-1)
-      l8e1 = sadr(il8e1+4)
-      m8e1 = istk(il8e1+1)*istk(il8e1+2)
-      if(m8e1.eq.0) then
-         info(4)=0
-      else
-         info(4)=1
-         tstop=stk(l8e1)
-      endif
-      
-c     
-c     --   subvariable imode(info) --
-      il8e2=iadr(l8+istk(il8+1+2)-1)
-      l8e2 = sadr(il8e2+4)
-      info(3)=stk(l8e2)
-      
-c     
-c     --   subvariable band(info) --
-      il8e3=iadr(l8+istk(il8+1+3)-1)
-      m8e3 =istk(il8e3+1)*istk(il8e3+2)
-      l8e3 = sadr(il8e3+4)
-      if(m8e3.eq.0) then
-         info(6)=0
-      elseif(m8e3.eq.2) then
-         info(6)=1
-         ml=stk(l8e3)
-         mu=stk(l8e3+1)
-      else
-         err=8-iskip
-         call error(89)
-         return
-      endif
-c     
-c     --   subvariable maxstep(info) --
-      il8e4=iadr(l8+istk(il8+1+4)-1)
-      m8e4 =istk(il8e4+1)*istk(il8e4+2)
-      l8e4 = sadr(il8e4+4)
-      if(m8e4.eq.0) then
-         info(7)=0
-      else
-         info(7)=1
-         maxstep=stk(l8e4)
-      endif
-      
-c     
-c     --   subvariable stepin(info) --
-      il8e5=iadr(l8+istk(il8+1+5)-1)
-      m8e5 =istk(il8e5+1)*istk(il8e5+2)
-      l8e5 = sadr(il8e5+4)
-      if(m8e5.eq.0) then
-         info(8)=0
-      else
-         info(8)=1
-         stepin=stk(l8e5)
-      endif
-      
-c     
-c     --   subvariable nonneg(info) --
-      il8e6=iadr(l8+istk(il8+1+6)-1)
-      l8e6 = sadr(il8e6+4)
-      info(10)=stk(l8e6)
-c     
-c     --   subvariable isest(info) --
-      il8e7=iadr(l8+istk(il8+1+7)-1)
-      l8e7 = sadr(il8e7+4)
-      isest=stk(l8e7)
-      if(isest.eq.1) info(11)=1
-      
-      
- 10   hotstart=.false.
-      if(rhs.eq.9-iskip) then
-         hotstart=.true.
-c     
-c     checking variable hotdata (number 9)
-c     
-         il9 = iadr(lstk(top-rhs+9-iskip))
-         if (istk(il9) .ne. 1) then
-            err = 9-iskip
-            call error(53)
-            return
-         endif
-         n9 = istk(il9+1)*istk(il9+2)
-         lhot = sadr(il9+4)
-      elseif(rhs.ne.8-iskip) then
-         call error(39)
-         return
-      endif
-c     
-c     --------------------Work Tables 
-      if (.not.cremat(fname,topw,0,1,1,lw15,lc)) return
-      topw=topw+1      
-      if (.not.cremat(fname,topw,0,1,1,lw17,lc)) return
-      topw=topw+1      
-      il17=iadr(lw17)
-      if(info(6).eq.0) then
-C     for the full (dense) JACOBIAN case 
-         lrw = 40+(maxord+4)*neq+neq**2
-      elseif(info(5).eq.1) then
-C     for the banded user-defined JACOBIAN case
-         lrw=40+(maxord+4)*neq+(2*ml+mu+1)*neq
-      elseif(info(5).eq.0) then
-C     for the banded finite-difference-generated JACOBIAN case
-         lrw = 40+(maxord+4)*neq+(2*ml+mu+1)*neq+2*(neq/(ml+mu+1)+1)
-      endif
-      liw=20+neq
-      if(.not.hotstart) then
-         if (.not.cremat(fname,topw,0,1,lrw,lrwork,lc)) return
-         topw=topw+1
-         if (.not.cremat(fname,topw,0,1,sadr(liw)+1,liwork,lc)) return
-         topw=topw+1
-      else
-         if(lrw+liw.gt.n9) then
-            err=9-iskip
-            call error(89)
-            return
-         endif
-         lrwork=lhot
-         liwork=lhot+lrw
-         call entier(liw,stk(liwork),istk(iadr(liwork)))
-      endif
-c     
-      if(info(4).eq.1) then
-         stk(lrwork)=tstop
-      endif
-      if(info(7).eq.1) then
-         stk(lrwork+1)=maxstep
-      endif
-      if(info(8).eq.1) then
-         stk(lrwork+2)=stepin
-      endif
-      if(info(6).eq.1) then
-         istk(iadr(liwork))=ml
-         istk(iadr(liwork)+1)=mu
-      endif
-c     structure d'info pour les externals
-      top=topw
-      lw=lstk(top)
-      ilext=iadr(lw)
-      istk(ilext)=2
-      istk(ilext+1)=ilext+4
-      istk(ilext+2)=ilext+8
-      istk(ilext+3)=ilext+12
-      istk(ilext+4)=kres
-      istk(ilext+5)=neq
-      istk(ilext+6)=kt0
-      istk(ilext+7)=ky
-      istk(ilext+8)=kjac
-      istk(ilext+9)=neq
-      istk(ilext+10)=kt0
-      istk(ilext+11)=ky
-      lw=sadr(ilext)+12
-      lw0=lw
-      ilyr=iadr(lw)
-      istk(ilyr)=1
-      istk(ilyr+1)=2*n1+1
-      istk(ilyr+3)=0
-      lyr=sadr(ilyr+4)
-      lyri=lyr-(2*n1+1)
-      k=0
-      info(1)=0
-      if(hotstart) info(1)=1
-      info(9)=0
-      do 120 i=0,nt-1
-         tout=stk(l3+i)
-c     
- 115     k=k+1
-         lyri=lyri+(2*n1+1)
-         lw=lyri+(2*n1+1)
-         lstk(top+1)=lw
-         margin=(k-1)*(2*n1+1)+4
-         lw1=lw+margin
-         if(lhs.eq.2) lw1=lw1+4+lrw+liw
-         if(lw1-lstk(bot).gt.0) then
-c     not enough memory
-            call msgstxt('Not enough memory to go further')
-            k=k-1
-            goto 125
-         endif
-         if (tout .eq. t0) then
-            stk(lyri)=tout
-            call unsfdcopy(n1,stk(l1),1,stk(lyri+1),1)
-            call unsfdcopy(n1,stk(lydot),1,stk(lyri+n1+1),1)
-            l1=lyri+1
-            lydot=lyri+n1+1
-            t0=tout
-            goto 120            
-         else
-            stk(lyri)=tout
-            call unsfdcopy(n1,stk(l1),1,stk(lyri+1),1)
-            call unsfdcopy(n1,stk(lydot),1,stk(lyri+n1+1),1)
-            l1=lyri+1
-            lydot=lyri+n1+1
-            call dassl(bresd,n1,t0,stk(l1),stk(lydot),
-     &           stk(lyri),info,stk(lrtol),stk(latol),idid,
-     &           stk(lrwork),lrw,istk(iadr(liwork)),liw,stk(lw15),
-     &           istk(il17),bjacd)
-         endif
-         if(err.gt.0.or.err1.gt.0)  return
-         if(idid.eq.1) then
-C     A step was successfully taken in the intermediate-output mode. 
-C     The code has not yet reached TOUT.
-            stk(lyri)=t0
-            info(1)=1
-            goto 115
-            
-         elseif(idid.eq.2) then
-C     The integration to TSTOP was successfully completed (T=TSTOP)
-            goto 125
-            
-         elseif(idid.eq.3) then
-C     The integration to TOUT was successfully completed (T=TOUT) by 
-C     stepping past TOUT. Y,ydot are obtained by interpolation.
-            t0=tout
-            info(1)=1
-            goto 120
-            
-         elseif(idid.eq.-1) then
-C     A large amount of work has been expended (About 500 steps)
-            call msgstxt('to many steps necessary to reached next '//
-     &           'required time discretization point')
-            call msgstxt('Change discretisation of time vector t '//
-     &           'or decrease accuracy')
-            stk(lyri)=t0
-            goto 125
-         elseif(idid.eq.-2) then
-C     The error tolerances are too stringent.
-            t0=tout
-            info(1)=1
-            goto 115
-c     buf='The error tolerances are too stringent'
-c     call error(9982)
-c     return
-         elseif(idid.eq.-3) then
-C     The local error test cannot be satisfied because you specified 
-C     a zero component in ATOL and the corresponding computed solution
-C     component is zero. Thus, a pure relative error test is impossible 
-C     for this component.
-            buf='atol and computed test value are zero'
-            call error(9983)
-            return
-         elseif(idid.eq.-6) then
-C     repeated error test failures on the last attempted step.
-            call msgstxt('A singularity in the solution '//
-     &           'may be present')
-            goto 125
-         elseif(idid.eq.-7) then
-C     The corrector could not converge.
-            call msgstxt('May be inaccurate or ill-conditioned '//
-     &           'JACOBIAN')
-            goto 125
-         elseif(idid.eq.-8) then
-C     The matrix of partial derivatives is singular.
-            buf='Singular partial derivatives matrix'//
-     &           ' (may be redundant equations)'
-            call error(9986)
-            return
-         elseif(idid.eq.-9) then
-C     The corrector could not converge. there were repeated error 
-c     test failures in this step.
-            call msgstxt('Either ill-posed problem or '//
-     &           'discontinuity or singularity encountered')
-            goto 125
-         elseif(idid.eq.-10) then
-            call msgstxt('external ''res'' return many times'//
-     &           ' with ires=-1')
-            goto 125
-         elseif(idid.eq.-11) then
-C     IRES equal to -2 was encountered  and control is being returned to the
-C     calling program.
-            buf='error in external ''res'' '
-            call error(9989)
-            return
-         elseif(idid.eq.-12) then
-C     DDASSL failed to compute the initial YPRIME.
-            buf='dassl failed to compute the initial Ydot.'
-            call error(9990)
-            return
-         elseif(idid.eq.-33) then
-C     The code has encountered trouble from which
-C     it cannot recover. A message is printed
-C     explaining the trouble and control is returned
-C     to the calling program. For example, this occurs
-C     when invalid input is detected.
-            call msgstxt('dassl encountered trouble')
-            goto 125
-         endif
-         t0=tout
-         info(1)=1
- 120  continue
-c     
- 125  top=topk-rhs
-      mv=lw0-l0
-c     
-c     Variable de sortie: y0
-c     
-      top=top+1
-      if(k.eq.0) istk(ilyr+1)=0
-      istk(ilyr+2)=k
-      lw=lyr+(2*n1+1)*k
-      lstk(top+1)=lw-mv
-      if(lhs.eq.1) goto 150
-      
-c     
-c     Variable de sortie: rwork
-c     
-      top=top+1
-      ilw=iadr(lw)
-      err=lw+4+lrw+liw-lstk(bot)
-      if (err .gt. 0) then
-         call error(17)
-         return
-      endif
-      istk(ilw)=1
-      istk(ilw+1)=lrw+liw
-      istk(ilw+2)=1
-      istk(ilw+3)=0
-      lw=sadr(ilw+4)
-      call unsfdcopy(lrw,stk(lrwork),1,stk(lw),1)
-      call int2db(liw,istk(iadr(liwork)),1,stk(lw+lrw),1)
-      lw=lw+lrw+liw
-      lstk(top+1)=lw-mv
-c     
-c     Remise en place de la pile
- 150  call unsfdcopy(lw-lw0,stk(lw0),1,stk(l0),1)
-      return
-      end
-c     ============================================
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_feval.f b/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_feval.f
deleted file mode 100644 (file)
index cd05346..0000000
+++ /dev/null
@@ -1,118 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) ENPC - Jean-Philippe Chancelier
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine feval
-C     --------------------------------------------
-C     feval(x1,x2,external) -> external(x1(i),x2(j))
-C     feval(x1,external)    -> external(x1(i))
-c      implicit undefined (a-z)
-      include 'stack.h'
-      character*(5) fname
-      character*(nlgh+1)   ename
-      integer m1,n1,lb,m2,n2,la,i,j,nn,lr,lc,lb1,lbc1,lrr,lcr
-      integer topk,itype,kx1top,kx2top,lr1,kfeval,gettype
-      double precision x1,x2,fval(2)
-      external setfeval 
-      logical type,getexternal,getrmat,cremat
-C     External names (colname), Position in stack (coladr), type (coltyp)
-      common / fevalname / ename
-      common / fevaladr / kfeval,kx1top,kx2top
-      common / fevaltyp / itfeval
-      fname='feval'
-      if(rhs.lt.2) then
-         call error(39)
-         return
-      endif
-      itype=0
-      type=.false.
-      kfeval=top
-      topk=top
-      if (.not.getexternal(fname,topk,top,ename,type,
-     $     setfeval)) return
-      itfeval=gettype(top)
-      top=top-1
-      if (.not.getrmat(fname,topk,top,m1,n1,lb))  return
-      x2=stk(lb)
-      nn=1
-      if (rhs.eq.3) then 
-         nn=2
-         top=top-1
-         if (.not.getrmat(fname,topk,top,m2,n2,la))  return
-         x1=stk(la)
-      endif
-C     place pour le resultat si on a deux arguments 
-      top=topk+1
-      if (nn.eq.2) then 
-         if (.not.cremat(fname,top,1,m1*n1,m2*n2,lr,lc)) return
-      else
-         if (.not.cremat(fname,top,0,m1,n1,lb1,lbc1)) return
-      endif
-c     external scilab
-C     une variable de taille 1 qui permet de gerer le type d'argument
-      top=top+1
-      kx1top=top
-      if (.not.cremat(fname,top,0,1,1,lrr,lcr)) return
-      if (nn.eq.2) then 
-         top=top+1
-         kx2top=top
-         if (.not.cremat(fname,top,0,1,1,lrr,lcr)) return
-      endif
-      if(type) then 
-         if (nn.eq.2) then 
-            do 182 i=1,m2*n2
-               do 192 j=1,m1*n1
-                  call ffeval(nn,stk(la+i-1),stk(lb+j-1),
-     $                 fval,itype,ename)
-                  if(err.gt.0) return
-                  stk(lr+i-1+m2*n2*(j-1))=fval(1)
-                  if (itype.eq.1) stk(lc+i-1+m2*n2*(j-1))=fval(2)
- 192           continue
- 182        continue
-         else
-            do 183 i=1,m1*n1
-               call ffeval(nn,stk(lb+i-1),1.0d0,fval,itype,ename)
-               if(err.gt.0) return
-               stk(lb+i-1)=fval(1)
-               if (itype.eq.1) stk(lb1+i-1)=fval(2)
- 183        continue
-         endif
-      else
-         if (nn.eq.2) then 
-            do 172 i=1,m2*n2
-               do 174 j=1,m1*n1
-                  call bfeval(nn,stk(la+i-1),stk(lb+j-1),
-     $                 fval,itype,ename)
-                  if(err.gt.0.or.err1.gt.0) return
-                  stk(lr+i-1+m2*n2*(j-1))=fval(1)
-                  if (itype.eq.1) stk(lc+i-1+m2*n2*(j-1))=fval(2)
- 174           continue
- 172        continue
-         else
-            do 173 i=1,m1*n1
-               call bfeval(nn,stk(lb+i-1),1.0D0,fval,itype,ename)
-               if(err.gt.0.or.err1.gt.0) return
-               stk(lb+i-1)=fval(1)
-               if (itype.eq.1) stk(lb1+i-1)=fval(2)
- 173        continue
-         endif
-      endif
- 162  continue
-      top=topk-rhs+1
-      if (nn.eq.2) then 
-         if (.not.cremat(fname,top,itype,m2*n2,m1*n1,lr1,lc)) return
-         call unsfdcopy(m1*n1*m2*n2*(itype+1),stk(lr),1,stk(lr1),1)
-      else
-         if (itype.eq.1)then 
-            if (.not.cremat(fname,top,itype,m1,n1,lr,lc)) return
-            call unsfdcopy(m1*n1,stk(lb1),1,stk(lc),1)
-         endif
-      endif
-      return
-      end
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_impl.f b/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_impl.f
deleted file mode 100644 (file)
index 7024c1d..0000000
+++ /dev/null
@@ -1,324 +0,0 @@
-c 
-c  Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c  Copyright (C) INRIA
-c  
-c  This file must be used under the terms of the CeCILL.
-c  This source file is licensed as described in the file COPYING, which
-c  you should have received as part of this distribution.  The terms
-c  are also available at    
-c  http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c 
-c 
-               subroutine sciimpl(fname)
-c     ==================================================
-      INCLUDE 'stack.h'
-c
-      character*(*) fname
-      integer iadr,sadr
-c
-      double precision atol,rtol,t0,t1
-      integer topk,topw
-      logical jaco,achaud
-      external bresid,badd,bj2
-      external fres,fadda,fj2
-      integer gettype
-      logical getexternal,getrvect,vcopyobj
-      logical checkrhs,checklhs,getrmat,cremat,getscalar
-      logical typej,typea,typer,getsmat,vectsize
-      character*(nlgh+1) namres,namadd,namjac
-      character*1 strf
-      common/cjac/namjac
-      external setfres,setfadda,setfj2
-      common/ierode/iero
-c     
-      data atol/1.d-7/,rtol/1.d-9/
-c     
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-      if (.not.checkrhs(fname,6,10)) return
-C     XXXXXX : pour l'instant 
-      if (.not.checklhs(fname,1,3)) return
-c     ---------------------------------
-      iero=0
-      topk=top
-      topw=top+1
-      iskip=1
-      mf=20
-c     first argument (check for string )
-c     ----------------------------
-      if(gettype(topk-rhs+1).eq.10) then
-         iskip=0
-         if(.not.getsmat(fname,topk,topk-rhs+1,
-     $        m1,n1,1,1,lr1,nlr1))return
-         call cvstr(1,istk(lr1),strf,1)
-         if ( strf.eq.'a') mf = 10
-         if ( strf.eq.'s') mf = 20
-         if(strf.ne.'a'.and.strf.ne.'s') then
-            call error(42)
-            return
-         endif
-      endif
-c     Initial condition : y0 arg 2 - iskip
-c     -------------------
-      kynew=topk-rhs+2-iskip
-      if(.not.getrvect(fname,topk,kynew,ny,my,ly))return
-      neq=ny*my
-c     
-c     Initial derivative condition : y0dot arg 3 - iskip
-c     -------------------
-      kydtop=topk-rhs+3-iskip
-      if(.not.getrvect(fname,topk,kydtop,nyd,myd,lyd))return
-      if(.not.vectsize(fname,topk,kydtop,ny*my)) return
-c     t0 arg 4 - iskip
-c     ----------------------------
-      kttop=topk-rhs+4-iskip 
-      if(.not.getscalar(fname,topk,kttop,lr4))return
-      t0=stk(lr4)
-c     t1 arg 5 - iskip
-c     ---------------------------
-      kt1=topk-rhs+5-iskip 
-      if(.not.getrmat(fname,topk,kt1,m5,n5,lt5))return
-      nn=m5*n5
-c     checking variable rtol (number 6 - iskip)
-c     -----------------------------------
-      itype = gettype(topk-rhs+6-iskip)
-      if ( itype .ne. 1) then
-         if (.not.cremat(fname,topw,0,1,1,latol,lc)) return
-         topw=topw+1
-         if (.not.cremat(fname,topw,0,1,1,lrtol,lc)) return
-         topw=topw+1
-         stk(latol)=atol
-         stk(lrtol)=rtol
-         na=1
-         nr=1
-         iskip = iskip+2
-         goto 11105
-      endif
-      kr=top-rhs+6-iskip
-      if(.not.getrvect(fname,topk,kr,m6,n6,lrtol))return
-      nr = m6*n6
-      if(nr.ne.1.and.nr.ne.neq) then
-         err= 6-iskip 
-         call error(89)
-         return
-      endif
-
-c     checking variable rtol (number 7 - iskip )
-c     --------------------------------
-      itype = gettype(topk-rhs+7-iskip)
-      if (itype .ne. 1) then
-         if (.not.cremat(fname,topw,0,1,1,lrtol,lc)) return
-         topw=topw+1
-         stk(lrtol)=rtol
-         nr=1
-         iskip = iskip +1
-         goto 11105
-      endif
-      kr= top-rhs+7-iskip
-      if(.not.getrvect(fname,topk,kr,m7,n7,latol))return
-      na = m7*n7
-      if(na.ne.1.and.na.ne.neq) then
-         err= 7-iskip 
-         call error(89)
-         return
-      endif
-c     ----------------------------------
-11105 if(nr.eq.1.and.na.eq.1) itol=1
-      if(nr.eq.1.and.na.gt.1) itol=2
-      if(nr.gt.1.and.na.eq.1) itol=3
-      if(nr.gt.1.and.na.gt.1) itol=4
-c     les externaux : res,adda et jac 
-c     -----------------------------------
-c     checking variable res (number 8 - iskip )
-      kres=topk-rhs+8-iskip
-      typer=.false.
-      if (.not.getexternal(fname,topk,kres,namres,typer,
-     $     setfres)) return
-
-c     checking variable number 9 - iskip
-c     -----------------------------
-      kadd=topk-rhs+9-iskip
-      if (.not.getexternal(fname,topk,kadd,namadd,typea,
-     $     setfadda)) return
-      if ( typea.neqv.typer) then 
-         buf = fname // ': res and adda must have same type '
-         call error(999)
-      endif
-c     checking variable number 10 - iskip
-c     -----------------------------
-      achaud=gettype(topk).eq.1
-      kjac=topk-rhs+10-iskip
-      if ( kjac.eq.topk.or.(achaud.and.kjac.eq.topk-2)) then 
-         if (.not.getexternal(fname,topk,kjac,namjac,typej,
-     $        setfj2)) return
-         mf = mf+1
-         jaco=.true.
-      else
-         jaco=.false.
-         typej=.false.
-         mf = mf + 2
-      endif
-
-c     other parameters 
-c     -----------------
-      itask=1
-      istate=1
-      iopt=0
-c     hot restart case 
-c     hot restart is detected when last argument is a matrix
-c     ---------------------
-C     space for result 
-      if(.not.cremat(fname,topw,0,neq,nn,lres,lc)) return
-      kresu=topw
-      topw=topw+1
-      nsizd=219
-      nsizi=41
-      if(achaud) then
-c        iwork 
-         if (.not.vcopyobj(fname,topk,topw)) return
-         topw=topw+1
-         if(.not.getrmat(fname,topk,topw-1,ml,nl,lci))return
-         liwp= ml*nl
-         ilc=iadr(lci)
-         do 400 k= liwp -nsizi+1 , liwp
-            write(06,*) k,'avant sauv iw',stk(lci+k-1)
- 400     continue
-c        rwork 
-         if (.not.vcopyobj(fname,topk-1,topw)) return
-         topw=topw+1
-         if(.not.getrmat(fname,topk,topw-1,ml,nl,lrwp))return
-         ilrw = ml*nl
-         istate=2
-c        restauration des commons
-         lsavs=lrwp+ilrw- nsizd
-         lsavi=lci+liwp- nsizi
-         liwp1=liwp- nsizi
-         call rscom1(stk(lsavs),stk(lsavi))
-c        restauration du tableau entier
-c        the end was used to restore the common 
-         do 40 k=1,liwp
-            istk(ilc+k-1)=int(stk(lci+k-1))
- 40      continue
-         
-      else
-c         ----create Work space 
-         ilrw=0
-         if(mf.gt.10) ilrw=22+16*neq+neq*neq
-         if(mf.gt.20) ilrw=22+9*neq+neq*neq
-         liwp=20+neq
-         if(lhs.gt.1) then
-            ilrw=ilrw+nsizd
-            liwp=liwp+nsizi
-         endif
-         if(.not.cremat(fname,topw,0,1,liwp,li,lc)) return
-         topw=topw+1
-         ilc=iadr(li)
-         do 1 k=1,liwp
-            istk(ilc+k-1) =0
- 1       continue
-         if(.not.cremat(fname,topw,0,1,ilrw,lrwp,lc)) return
-         do 11 k=1,liwp
-            stk(lrwp+k-1) =0
- 11      continue
-         topw=topw+1
-      endif
-      if(jaco) then
-         top=topw
-         lw=lstk(top)
-         ilw1=iadr(lw)
-         istk(ilw1)=3
-         istk(ilw1+1)=ilw1+4
-         istk(ilw1+2)=ilw1+8
-         istk(ilw1+3)=ilw1+12
-         istk(ilw1+4)=kres
-         istk(ilw1+5)=kttop
-         istk(ilw1+6)=kynew
-         istk(ilw1+7)=kydtop
-         istk(ilw1+8)=kadd
-         istk(ilw1+9)=kttop
-         istk(ilw1+10)=kynew
-         istk(ilw1+11)=kydtop
-         istk(ilw1+12)=kjac
-         istk(ilw1+13)=kttop
-         istk(ilw1+14)=kynew
-         istk(ilw1+15)=kydtop
-         lstk(top+1)=sadr(ilw1+17)
-      else
-         top=topw
-         lw=lstk(top)
-         ilw1=iadr(lw)
-         istk(ilw1)=2
-         istk(ilw1+1)=ilw1+3
-         istk(ilw1+2)=ilw1+7
-         istk(ilw1+3)=kres
-         istk(ilw1+4)=kttop
-         istk(ilw1+5)=kynew
-         istk(ilw1+6)=kydtop
-         istk(ilw1+7)=kadd
-         istk(ilw1+8)=kttop
-         istk(ilw1+9)=kynew
-         istk(ilw1+10)=kydtop
-         lstk(top+1)=sadr(ilw1+11)
-      endif
-c     
-      call xsetf(1)
-      call xsetun(wte)
-c     
-c     appel de l'integrateur
-      do 50 k=1,nn
-         t1=stk(lt5 +k-1)
-c        test sur le type des fonctions fournies
-         if(typea) then
-            if(typej) then
-c     f fortran j fortran
-               call lsodi(fres,fadda,fj2,neq,stk(ly),stk(lyd),t0,t1,
-     1              itol,stk(lrtol),stk(latol),itask,istate,iopt,
-     2              stk(lrwp),ilrw,istk(ilc),liwp,mf)
-            else
-c     f fortran j macro 
-               call lsodi(fres,fadda,bj2,neq,stk(ly),stk(lyd),t0,t1,
-     1              itol,stk(lrtol),stk(latol),itask,istate,iopt,
-     2              stk(lrwp),ilrw,istk(ilc),liwp,mf)
-            endif
-         else
-            if(typej) then
-c     f macro j fortran
-               call lsodi(bresid,badd,fj2,neq,stk(ly),stk(lyd),t0,t1,
-     1              itol,stk(lrtol),stk(latol),itask,istate,iopt,
-     2              stk(lrwp),ilrw,istk(ilc),liwp,mf)
-            else
-c     f macro j macro
-               call lsodi(bresid,badd,bj2,neq,stk(ly),stk(lyd),t0,t1,
-     1              itol,stk(lrtol),stk(latol),itask,istate,iopt,
-     2              stk(lrwp),ilrw,istk(ilc),liwp,mf)
-            endif
-         endif
-         if(err.gt.0.or.err1.gt.0) return
-         if(istate.lt.0) then
-            call error(24)
-            return
-         endif
-         call unsfdcopy(neq,stk(ly),1,stk(lres+(k-1)*neq),1)
- 50   continue
-      top= topk-rhs+1
-      call copyobj(fname,kresu,topk-rhs+1)
-      if(lhs.eq.1) return
-c     w
-      if (lhs.ne.3) then 
-         buf = fname // ' lhs can only be 1 or 2 '
-         call error(999)
-      endif
-      top=top+1
-      if (.not.cremat(fname,top,0,1,ilrw,lr,lc)) return
-      call unsfdcopy(ilrw-nsizd,stk(lrwp),1,stk(lr),1)
-      lsvs=lr+ilrw-nsizd
-c     iw
-      top=top+1
-      if (.not.cremat(fname,top,0,1,liwp,lr,lc)) return
-      do 60 k=1,liwp-nsizi
-         stk(lr+k-1)=dble(istk(ilc+k-1))
- 60   continue
-      lsvi=lr+liwp-nsizi
-      call svcom1(stk(lsvs),stk(lsvi))
-      return
-      end
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_ode.f b/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_ode.f
deleted file mode 100644 (file)
index 7ffe3f2..0000000
+++ /dev/null
@@ -1,1056 +0,0 @@
-c     Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c     Copyright (C) INRIA
-c     ...
-c     
-c     This file must be used under the terms of the CeCILL.
-c     This source file is licensed as described in the file COPYING,
-c     which
-c     you should have received as part of this distribution.  The terms
-c     are also available at
-c     http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c     
-      subroutine sciode
-c     
-c     ode
-c     
-      include 'stack.h'
-      integer iadr,sadr
-c      
-      character buftmp*(bsiz)
-c     
-c     common de lsode,lsoda,lsodar
-      double precision xxxx,yyyy,rlsr
-      integer ilsr
-      common/ls0001/xxxx(219),iiii(39)
-      common/lsa001/yyyy(22),jjjj(9)
-      common/lsr001/ rlsr(5),ilsr(9)
-      common/eh0001/kkkk(2)
-      save /ls0001/,/lsa001/,/lsr001/,/eh0001/
-c     
-c     commons avec bydot,bjac,....
-c     
-      character*(nlgh+1) namef,namej,names
-      common/cydot/namef
-      common/cjac/namej
-      common/csurf/names
-      integer       iero
-      common/ierajf/iero
-c     
-      double precision atol,rtol,t0,tout,dir
-      double precision h0,hmax,hmin,tcrit,tmax
-      integer top1,top2,tope,hsize
-c     meth is simulator number, and jactyp the jacobian type used
-      integer meth,jactyp
-      logical jaco,achaud,withw,single
-      external bydot,bjac,bsurf
-      integer raide(2),root(2),adams,discre,rkf(3),rk(2),fix(2)
-      integer params(nsiz)
-      data raide/28,29/,adams/10/,root/27,24/
-      data discre/13/,rkf/27,20,15/,rk/27,20/,fix/15,18/
-      data params/-235739080,-303896856,669247720,3*673720360/
-c     
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-
-      iflagcr=0
-c     
-c     get %ODEOPTIONS variable
-      ifin=fin
-      fin=-1
-      istate=1
-      call stackg(params)
-      if(fin.eq.0) then
-c     call msgs(72,0)
-         iopt=0
-         itask=1
-         jactyp=2
-         ml=-1
-         mu=-1
-      else
-         iopt=1
-         il=iadr(lstk(fin))
-         l=sadr(il+4)
-c     %ODEOPTIONS=[itask,tcrit,h0,hmax,hmin,jactyp,mxstep,..
-c     mxordn,mxords,ixpr, ml,mu]
-         itask=int(stk(l))
-         if(itask.lt.1.or.itask.gt.5) then
-            buf=' invalid option (first entry)'
-            call error(9999)
-            return
-         endif
-         tcrit=stk(l+1)
-         h0=stk(l+2)
-         hmax=stk(l+3)
-         hmin=stk(l+4)
-         if(hmin.gt.hmax) then
-            buf=' what? hmin greater than hmax?'
-            call error(9999)
-            return
-         endif
-         jactyp=int(stk(l+5))
-         if(jactyp.lt.0.or.jactyp.gt.5) then
-            buf=' invalid option (entry no 4)'
-            call error(9999)
-            return
-         endif
-         mxstep=int(stk(l+6))
-         mxordn=int(stk(l+7))
-         mxords=int(stk(l+8))
-         ixpr=int(stk(l+9))
-         ml=int(stk(l+10))
-         mu=int(stk(l+11))
-      endif
-c     .....
-c     
-      fin=ifin
-      withw=.false.
-
-      tope=top
-      itype=0
-
-      if(rhs.lt.4) then
-         call error(39)
-         return
-      endif
-c     
-c     lw=premiere adresse libre dans la pile
-      lw=lstk(top+1)
-c     
-c     test demarrage a chaud
-      ifin=iadr(lstk(top))
-      achaud=istk(ifin).eq.1
-      if(achaud) then
-c     ilc=adresse of lsod* integer work space
-         top=top-2
-         il=iadr(lstk(top+2))
-         if(istk(il).ne.1) then
-            err=rhs
-            call error(53)
-            return
-         endif
-         liwp=istk(il+2)*istk(il+1)
-         lci=sadr(il+4)
-         ilc=iadr(lci)
-c     lc=adresse of lsod* real work space
-         il=iadr(lstk(top+1))
-         if(istk(il).ne.1) then
-            err=rhs-1
-            call error(53)
-            return
-         endif
-         lc=sadr(il+4)
-         lrwp=istk(il+1)*istk(il+2)
-      endif
-c     
-      top2=top-rhs+1
-      if(achaud) top2=top2+2
-      ile=iadr(lstk(top2))
-c     
-      if(istk(ile).eq.10) then
-         top2=top2+1
-         if(abs(istk(ile+6)).eq.adams) then
-c     lsode (adams)
-            meth=1
-         elseif(abs(istk(ile+6)).eq.raide(1) .and.
-     $           abs(istk(ile+7)).eq.raide(2)) then
-c     lsode (gear)
-            meth=2
-         elseif(abs(istk(ile+6)).eq.root(1) .and.
-     $           abs(istk(ile+7)).eq.root(2)) then
-c     lsodar
-            meth=3
-         elseif(abs(istk(ile+6)).eq.discre) then
-c     ldisc
-            meth=4
-         elseif(abs(istk(ile+6)).eq.rkf(1) .and.
-     $           abs(istk(ile+7)).eq.rkf(2) .and.
-     $           abs(istk(ile+8)).eq.rkf(3)) then
-c     rkf45
-            meth=6
-         elseif(abs(istk(ile+6)).eq.rk(1) .and.
-     $           abs(istk(ile+7)).eq.rk(2)) then
-c     rk4
-            meth=5
-         elseif(abs(istk(ile+6)).eq.fix(1) .and.
-     $           abs(istk(ile+7)).eq.fix(2)) then
-c     rksimp
-            meth=7
-         else
-            call error(42)
-            return
-         endif
-      else
-c     lsoda
-         meth=0
-      endif
-c     
-      if(meth.lt.3) then
-         if(lhs.ne.3.and.lhs.ne.1) then
-            call error(41)
-            return
-         endif
-      elseif(meth.eq.3) then
-         if(lhs.eq.3.or.lhs.gt.4) then
-            call error(41)
-            return
-         endif
-      elseif(meth.ge.4) then
-         if(lhs.ne.1) then
-            call error(41)
-            return
-         endif
-      endif
-c     
-      top1=top
-c     
-      if(meth.eq.3) then
-c     on recupere le simulateur des equations des surfaces
-         ilsurf=iadr(lstk(top1))
-         if(istk(ilsurf).ne.10.and.istk(ilsurf).ne.15.and.
-     $        istk(ilsurf).ne.11.and.istk(ilsurf).ne.13) then
-            err=rhs-(tope-top1)
-            call error(80)
-            return
-         endif
-         if(istk(ilsurf).eq.10) then
-            names=' '
-            call cvstr(istk(ilsurf+5)-1,istk(ilsurf+6),names,1)
-            names(istk(ilsurf+5):istk(ilsurf+5))=char(0)
-            call setfsurf(names,irep)
-            if ( irep.eq.1) then
-               buf = names
-               call error(50)
-               return
-            endif
-         elseif(istk(ilsurf).eq.15) then
-            le1=sadr(ilsurf+istk(ilsurf+1)+3)
-            if(istk(iadr(le1)).ne.11.and.istk(iadr(le1)).ne.13) then
-               err=rhs-(tope-top1)
-               call error(80)
-               return
-            endif
-         endif
-         ksurf=top1
-         top1=top1-1
-c     ... et le nombre d'equations
-         il=iadr(lstk(top1))
-         if(istk(il).ne.1) then
-            err=rhs-(tope-top1)
-            call error(53)
-            return
-         endif
-         if(istk(il+1)*istk(il+2).ne.1) then
-            err=rhs-(tope-top1)
-            call error(89)
-            return
-         endif
-         l=sadr(il+4)
-         nsurf=stk(l)
-         top1=top1-1
-      else
-         ksurf=0
-      endif
-
-      il=iadr(lstk(top1-1))
-      if(istk(il).eq.10.or.istk(il).eq.15.or.
-     $     istk(il).eq.11.or.istk(il).eq.13) then
-c     JACOBIAN IS GIVEN (variable top1)
-         ilj=iadr(lstk(top1))
-         islj=istk(ilj)
-         if(islj.lt.10.or.islj.gt.15.or.islj.eq.12) then
-            err=rhs-(tope-top1)
-            call error(80)
-            return
-         endif
-         if(islj.eq.10) then
-            namej=' '
-            call cvstr(istk(ilj+5)-1,istk(ilj+6),namej,1)
-            namej(istk(ilj+5):istk(ilj+5))=char(0)
-            call setfjac(namej,irep)
-            if ( irep.eq.1) then
-               buf = namej
-               call error(50)
-               return
-            endif
-         elseif(islj.eq.15) then
-            le1=sadr(ilj+istk(ilj+1)+3)
-            if(istk(iadr(le1)).ne.11.and.istk(iadr(le1)).ne.13) then
-               err=rhs-(tope-top1)
-               call error(80)
-               return
-            endif
-         endif
-         if (meth.ge.4) then
-            call msgs(75,0)
-         endif
-         if(jactyp.eq.0.and.(meth.eq.2.or.meth.eq.1)) then
-            call msgs(75,0)
-         endif
-         jaco=.true.
-         if(iopt.eq.0) then
-c     set jactyp (jacobian is supposed full)
-            jactyp=1
-         else
-c     check jactyp
-            if(jactyp.eq.2.or.jactyp.eq.5) then
-               call msgs(75,0)
-            endif
-         endif
-         kjac=top1
-         top1=top1-1
-      else
-c     JACOBIAN NOT GIVEN
-         if(iopt.eq.0) then
-c     set jactyp (estimated jacobian is supposed full)
-            jactyp=2
-         else
-c     check jactyp
-            if(jactyp.eq.1.or.jactyp.eq.4) then
-c     %ODEOPTIONS requires the jacobian
-               call msgs(76,0)
-               jactyp=jactyp+1
-            endif
-         endif
-         jaco=.false.
-         kjac=0
-      endif
-
-      kytop=top1
-
-c     
-c     rhs
-      ilf=iadr(lstk(top1))
-      islf=istk(ilf)
-      if(islf.ne.10.and.islf.ne.15.and.islf.ne.11.and.islf.ne.13) then
-         err=rhs-(tope-top1)
-         call error(80)
-         return
-      endif
-      kydot=top1
-      if(islf.eq.10) then
-         namef=' '
-         call cvstr(istk(ilf+5)-1,istk(ilf+6),namef,1)
-         namef(istk(ilf+5):istk(ilf+5))=char(0)
-         call setfydot(namef,irep)
-         if ( irep.eq.1) then
-            buf = namef
-            call error(50)
-            return
-         endif
-c     test list('fex', ...) or list(fun,...)
-      elseif(islf.eq.15) then
-         le1=sadr(ilf+istk(ilf+1)+3)
-         if(istk(iadr(le1)).eq.10) then
-            withw=.true.
-c     .     next line just to tell to bydot that external is in fortran
-            istk(ilf)=10
-            if(istk(ilf+1).ne.2) then
-               buf='wrong list passed: needs two elts in list'
-               call error(9999)
-               return
-            endif
-            long1=istk(ilf+3)
-            lf=lstk(top1)
-            illl=iadr(lf+istk(ilf+3))
-            nblett=istk(illl-1)-1
-            namef=' '
-            call cvstr(istk(ilf+11)-1,istk(ilf+12),namef,1)
-            namef(istk(ilf+11):istk(ilf+11))=char(0)
-            call setfydot(namef,irep)
-            if ( irep.eq.1) then
-               buf = namef
-               call error(50)
-               return
-            endif
-            ll1=sadr(ilf+5)
-            ll2=ll1+long1-1
-            il2=iadr(ll2)
-            nbw=istk(il2+1)*istk(il2+2)
-            if(istk(il2+3).ne.0) then
-               buf='working array must be real'
-               call error(9999)
-               return
-            endif
-            lww=sadr(il2+4)
-c     .     lww = adr w , nbw = size (w)
-         elseif(istk(iadr(le1)).ne.11.and.istk(iadr(le1)).ne.13) then
-            err=rhs-(tope-top1)
-            call error(80)
-            return
-         endif
-      endif
-c     
-c     jaco,type and meth initialized ...
-c     top2 point on y0
-c     
-c     y0
-      kynew=top2
-      il=iadr(lstk(top2))
-      it=istk(il+3)
-c     
-      if(istk(il).eq.1) then
-         hsize=4
-         ny=istk(il+1)*istk(il+2)*(istk(il+3)+1)
-      elseif(istk(il).eq.2) then
-         mn=istk(il+1)*istk(il+2)
-         hsize=9+mn
-         ny=(istk(il+8+mn)-1)*(istk(il+3)+1)
-      else
-         err=rhs-(tope-top2)
-         call error(44)
-         return
-      endif
-      if(it.eq.1) nys2=ny/2
-      ly=sadr(il+hsize)
-
-c     list('fex',w)
-      if(withw) then
-         if(top+1.ge.bot) then
-            call error(18)
-            return
-         endif
-         top=top+1
-c     .  kynew=top
-         ily=iadr(lstk(top))
-         err=sadr(ily+4)+ny+nbw-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         istk(ily+1)=1
-         istk(ily+2)=ny+nbw
-         istk(ily+3)=1
-         istk(ily+4)=0
-         ly1=sadr(ily+4)
-         call unsfdcopy(ny,stk(ly),1,stk(ly1),1)
-         call unsfdcopy(nbw,stk(lww),1,stk(ly1+ny),1)
-         lstk(top+1)=ly1+ny+nbw
-         ly=ly1
-         lw=lstk(top+1)
-      endif
-      lw1=lw
-      lw=sadr(iadr(lw1)+13)
-c     
-c     t0
-      top2=top2+1
-      kttop=top2
-      il=iadr(lstk(top2))
-      if(istk(il).ne.1) then
-         err=rhs-(tope-top2)
-         call error(53)
-         return
-      endif
-      l=sadr(il+4)
-      t0=stk(l)
-c     t1
-      top2=top2+1
-      il=iadr(lstk(top2))
-      if(istk(il).ne.1) then
-         err=rhs-(tope-top2)
-         call error(53)
-         return
-      endif
-
-c     number of output points
-      nn=istk(il+1)*istk(il+2)
-c     pointer on  output time vector
-      lt1=sadr(il+4)
-c     
-c     optionnal parameters rtol et atol
-      top2=top2+1
-c     default values
-      if(meth.eq.6.or.meth.eq.7) then
-         rtol=1.d-3
-         atol=1.d-4
-      else
-         rtol=1.0d-7
-         atol=1.0d-9
-      endif
-      nr=1
-      na=1
-      jobtol=kytop-top2+1
-c     jobtol=(nothing ,rtol only,rtol and atol)
-c     
-      if(jobtol.eq.1) then
-c     default tolerances
-         lr=lw
-         la=lr+1
-         stk(la)=atol
-         stk(lr)=rtol
-      else
-c     rtol given
-         lr=lw
-c     rtol
-         il=iadr(lstk(top2))
-         if(istk(il).ne.1) then
-            err=rhs-(tope-top2)
-            call error(53)
-            return
-         endif
-         nr=istk(il+1)*istk(il+2)
-         if(nr.ne.1.and.nr.ne.ny) then
-            err=rhs-(tope-top2)
-            call error(89)
-            return
-         endif
-         lrt=sadr(il+4)
-         call unsfdcopy(nr,stk(lrt),1,stk(lr),1)
-         la=lr+nr
-c     .  atol
-         if(jobtol.eq.2) then
-c     .     default
-            stk(la)=atol
-         else
-c     .     atol given
-            top2=top2+1
-            il=iadr(lstk(top2))
-            if(istk(il).ne.1) then
-               err=rhs-(tope-top2)
-               call error(53)
-               return
-            endif
-            na=istk(il+1)*istk(il+2)
-            if(na.ne.1.and.na.ne.ny) then
-               err=rhs-(tope-top2)
-               call error(89)
-               return
-            endif
-            lat=sadr(il+4)
-            call unsfdcopy(na,stk(lat),1,stk(la),1)
-         endif
-      endif
-      lw=la+na
-
-c     set input top value
-      if(achaud) top=top+2
-c     
-      if(nr.eq.1.and.na.eq.1) itol=1
-      if(nr.eq.1.and.na.gt.1) itol=2
-      if(nr.gt.1.and.na.eq.1) itol=3
-      if(nr.gt.1.and.na.gt.1) itol=4
-c     
-c     compute integrator workspace  sizes
-      if(meth.eq.0) then
-c     lsoda
-         lrw=22+ny*max(16,ny+9)
-         liw=20+ny
-         nsizd=241
-         nsizi=50
-         if(jactyp.eq.4.or.jactyp.eq.5) then
-            lrn=20+16*ny
-            lrs=22+10*ny+(2*ml+mu)*ny
-            lrw=max(lrn,lrs)
-         endif
-      elseif(meth.eq.1) then
-c     lsode - adams
-         if(jactyp.eq.1.or.jactyp.eq.2) then
-            lrw=22+16*ny+ny*ny
-         elseif(jactyp.eq.4.or.jactyp.eq.5) then
-            lrw=22+16*ny+(2*ml+mu+1)*ny
-         else
-            lrw=20+16*ny
-         endif
-         liw=20+ny
-         nsizd=219
-         nsizi=41
-      elseif(meth.eq.2) then
-c     lsode gear
-         if(jactyp.eq.1.or.jactyp.eq.2) then
-            lrw=22+9*ny+ny*ny
-         elseif(jactyp.eq.4.or.jactyp.eq.5) then
-            lrw=22+9*ny+(2*ml+mu+1)*ny
-         else
-            lrw=20+9*ny
-         endif
-         liw=20+ny
-         nsizd=219
-         nsizi=41
-      elseif(meth.eq.3) then
-c     lsodar
-         ilroot=iadr(lw)
-         lw=sadr(ilroot+nsurf)
-         lrw= 22 + ny * max(16, ny + 9) + 3*nsurf
-         liw=20+ny
-         nsizd=246
-         nsizi=59
-      elseif(meth.eq.4) then
-c     lsdisc
-         lrw=ny
-         liw=1
-      elseif(meth.eq.5) then
-c     lsrgk
-         lrw=9*ny
-         liw=1
-      elseif(meth.eq.6) then
-c     rkf45
-         lrw=3+8*ny
-         liw=5
-      elseif(meth.eq.7) then
-c     rksimp
-         lrw=3+8*ny
-         liw=1
-      endif
-c     
-c     hot start
-c     
-      if(achaud) then
-         if(meth.le.3) then
-c     check for input hot start table consistency
-            if(lrwp.ne.lrw+nsizd) then
-               buf=' Real hot start table has incorrect size'
-               call error(9999)
-               return
-            endif
-            if(liwp.ne.liw+nsizi) then
-               buf=' Input hot start table has incorrect size'
-               call error(9999)
-               return
-            endif
-         endif
-         istate=2
-c     commons retrieval from hot start tables
-         if(meth.eq.0) then
-c     lsoda
-            lsavs=lc+lrwp-nsizd
-            lsavi=lci+liwp-nsizi
-            call rscma1(stk(lsavs),stk(lsavi))
-         elseif(meth.eq.1.or.meth.eq.2) then
-c     lsode
-            lsavs=lc+lrwp-nsizd
-            lsavi=lci+liwp-nsizi
-            call rscom1(stk(lsavs),stk(lsavi))
-         elseif(meth.eq.3) then
-c     lsodar
-            lsavs=lc+lrwp-nsizd
-            lsavi=lci+liwp-nsizi
-            call rscar1(stk(lsavs),stk(lsavi))
-         endif
-c     integer workspace retrieval
-         do 40 k=1,liw
-            istk(ilc+k-1)=int(stk(lci+k-1))
- 40      continue
-      endif
-c     
-c     
-c     compute pointer on ode real and integer work spaces
-      lc0=lw
-      li=lc0+lrw
-c     
-      ili=iadr(li)
-      lw=sadr(ili+liw)
-c     
-c     get memory to store results
-      lyp=lw
-      if(itask.eq.2.or.itask.eq.3.or.itask.eq.5) then
-c     unknown number of output points.  space for  points
-c     will be allocated later
-         single=.true.
-         lw=lyp
-         if(nn.ne.1) then
-            call msgs(77,0)
-            stk(lt1)=stk(lt1+nn-1)
-            nn=1
-         endif
-         if(it.ne.0) then
-            buf='itask=2,3 or 5: y0 must be a real vector'
-            call error(9999)
-            return
-         endif
-      else
-c     number of output points is equal to number of t points all
-c     space allocated here
-         single=.false.
-         lw=lw+nn*ny
-      endif
-
-c     top points on external workspace
-      top=top+1
-      lstk(top+1)=lw
-      err=lstk(top+1)-lstk(bot)
-      if(err.gt.0) then
-         call error(17)
-         return
-      endif
-c     
-      call xsetf(1)
-      call xsetun(wte)
-c     
-      if(.not.achaud) then
-         lc=lc0
-         ilc=ili
-      endif
-c     
-c     data structure passed to externals, it contains pointer
-c     to externals parameters
-c     
-      ilw1=iadr(lw1)
-      istk(ilw1)=3
-      istk(ilw1+1)=ilw1+4
-      istk(ilw1+2)=ilw1+7
-      istk(ilw1+3)=ilw1+10
-      istk(ilw1+4)=kydot
-      istk(ilw1+5)=kttop
-      istk(ilw1+6)=kynew
-      istk(ilw1+7)=kjac
-      istk(ilw1+8)=kttop
-      istk(ilw1+9)=kynew
-      istk(ilw1+10)=ksurf
-      istk(ilw1+11)=kttop
-      istk(ilw1+12)=kynew
-c     
-      if(iopt.eq.1) then
-c     copy integration options in lsod* workspace
-         if(itask.ge.4) then
-            stk(lc)=tcrit
-         endif
-         stk(lc+4)=h0
-         stk(lc+5)=hmax
-         stk(lc+6)=hmin
-         if(meth.eq.0.or.meth.eq.3) then
-c     lsoda/lsodar
-            if(jactyp.eq.4.or.jactyp.eq.5) then
-               istk(ilc)=ml
-               istk(ilc+1)=mu
-            endif
-            istk(ilc+4)=ixpr
-            istk(ilc+5)=mxstep
-            istk(ilc+6)=0
-            istk(ilc+7)=mxordn
-            istk(ilc+8)=mxords
-         elseif(meth.lt.3) then
-c     lsode
-            if(jactyp.eq.4.or.jactyp.eq.5) then
-               istk(ilc)=ml
-               istk(ilc+1)=mu
-            endif
-            if(meth.lt.2) then
-               istk(ilc+4)=mxordn
-            else
-               istk(ilc+4)=mxords
-            endif
-            istk(ilc+5)=mxstep
-            istk(ilc+6)=0
-         endif
-      endif
-      tmax=stk(lt1+nn-1)
-      niter=nn
-      if(ixpr.eq.1.and.iopt.eq.1) then
-         call writebufodea(buf,itask,meth,jactyp,ml,mu,iopt)
-         call basout(io,wte,buf(1:80))
-         call writebufodeb(buf,tcrit,stk(lc+4),stk(lc+5),stk(lc+6))
-         call basout(io,wte,buf(1:80))
-      endif
-      if(single) then
-c     loop til t=tout
-c     --------------
-         dir=sign(1.0D0,tmax-t0)
-         tout=tmax
-         k=0
-         nn=0
- 50      k=k+1
-         nn=nn+1
-         if(meth.eq.0) then
-            call lsoda(bydot,ny,stk(ly),t0,tout,itol,stk(lr),
-     1           stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2           liw,bjac,jactyp)
-         elseif(meth.eq.1.or.meth.eq.2) then
-            call lsode(bydot,ny,stk(ly),t0,tout,itol,stk(lr),
-     1           stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2           liw,bjac,10*meth+jactyp)
-         elseif(meth.eq.3) then
-            call lsodar(bydot,ny,stk(ly),t0,tout,itol,stk(lr),
-     1           stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2           liw,bjac,jactyp,bsurf,nsurf,istk(ilroot))
-         elseif(meth.eq.4) then
-            call lsdisc(bydot,ny,stk(ly),t0,tout, stk(lc),lrw,
-     1           istate)
-         elseif(meth.eq.5) then
-            call lsrgk(bydot,ny,stk(ly),t0,tout,itol,stk(lr),
-     1           stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2           liw,bjac,meth)
-            if(iero.eq.-1) then
-               write(buftmp,'(e10.3)') tout
-               buf = buftmp
-               call msgs(70,0)
-            endif
-         elseif(meth.eq.6) then
-            call rkf45(bydot,ny,stk(ly),t0,tout,itol,rtol,
-     1           atol,itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2           liw,bjac,meth)
-         elseif(meth.eq.7) then
-            call rksimp(bydot,ny,stk(ly),t0,tout,itol,rtol,
-     1           atol,itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2           liw,bjac,meth)
-         endif
-         if(err.gt.0.or.err1.gt.0) return
-         if(istate.lt.0) then
-            if(meth.le.3) then
-               if(istate.eq.-3) then
-                  buf='illegal input'
-                  call error(9999)
-                  return
-               endif
-            elseif(meth.eq.5) then
-               call msgs(71,0)
-            elseif(meth.eq.4) then
-               if(istate.eq.-3) then
-                  buf ='ode discrete : a requested k is smaller '
-     $                 // ' than initial one'
-                  call error(999)
-                  return
-               else
-                  return
-               endif
-            endif
-            call msgs(4,ierr)
-            nn=k-1
-            goto 500
-         endif
-         if((meth.eq.6.or.meth.eq.7).and.istate.ne.2) then
-            nn=k-1
-            call msgs(74,0)
-            goto 500
-         endif
-c     store intermediate result
-         lys=lyp+(k-1)*(ny+1)
-         lstk(top+1)=lys+(ny+1)
-         err=lstk(top+1)-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         stk(lys)=t0
-         call unsfdcopy(ny,stk(ly),1,stk(lys+1),1)
-         if((t0-tout)*dir.ge.0.0d0)  then
-c     tout reached
-            nn=k
-            goto 500
-         endif
-         if(meth.eq.3.and.istate.eq.3) then
-c     lsodar: a root found
-            nn=k
-            goto 500
-         endif
-         if(itask.eq.4.and.iflagcr.eq.1) then
-c     tcrit reached
-            nn=k
-
-            call msgs(73,0)
-            goto 500
-         endif
-         goto 50
-c     
-      else
-c     
-c     loop on t points
-c--------------------
-         do 60 k=1,niter
-            tout=stk(lt1+k-1)
-            if(itask.ge.4.and.tout.gt.tcrit) then
-               tout=tcrit
-               iflagcr=1
-            endif
-            if(meth.eq.0) then
-               call lsoda(bydot,ny,stk(ly),t0,tout,itol,stk(lr),
-     1              stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2              liw,bjac,jactyp)
-            elseif(meth.eq.1.or.meth.eq.2) then
-               call lsode(bydot,ny,stk(ly),t0,tout,itol,stk(lr),
-     1              stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2              liw,bjac,10*meth+jactyp)
-            elseif(meth.eq.3) then
-               call lsodar(bydot,ny,stk(ly),t0,tout,itol,stk(lr),
-     1              stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2              liw,bjac,jactyp,bsurf,nsurf,istk(ilroot))
-            elseif(meth.eq.4) then
-               call lsdisc(bydot,ny,stk(ly),t0,tout, stk(lc),lrw,
-     1              istate)
-            elseif(meth.eq.5) then
-               call lsrgk(bydot,ny,stk(ly),t0,tout,itol,stk(lr),
-     1              stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2              liw,bjac,meth)
-               if(iero.eq.-1) then
-                  write(buftmp,'(e10.3)') tout
-                  buf = buftmp
-                  call msgs(70,0)
-               endif
-            elseif(meth.eq.6) then
-               call rkf45(bydot,ny,stk(ly),t0,tout,itol,rtol,
-     1              atol,itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2              liw,bjac,meth)
-               istk(ilc)=0
-               istk(ilc+1)=0
-            elseif(meth.eq.7) then
-               call rksimp(bydot,ny,stk(ly),t0,tout,itol,rtol,
-     1              atol,itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2              liw,bjac,meth)
-            endif
-            if(err.gt.0.or.err1.gt.0) return
-
-            if(istate.lt.0) then
-               if(meth.le.3) then
-                  if(istate.eq.-3) then
-                     buf='illegal input'
-                     call error(9999)
-                     return
-                  endif
-               endif
-               if(meth.eq.5) call msgs(71,0)
-               call msgs(4,ierr)
-               nn=k-1
-               goto 500
-            endif
-            if((meth.eq.6.or.meth.eq.7).and.istate.ne.2) then
-               nn=k-1
-               call msgs(74,0)
-               goto 500
-            endif
-c     store intermediate result
-            if(it.eq.0) then
-               lys=lyp+(k-1)*ny
-               call unsfdcopy(ny,stk(ly),1,stk(lys),1)
-            else
-               lys=lyp+(k-1)*nys2
-               call unsfdcopy(nys2,stk(ly),1,stk(lys),1)
-               call unsfdcopy(nys2,stk(ly+nys2),1,stk(lys+nn*nys2),1)
-            endif
-            if(meth.eq.3.and.istate.eq.3) then
-c     lsodar: a root found
-               nn=k
-               goto 500
-            endif
-            if(itask.eq.4.and.iflagcr.eq.1) then
-c     tcrit reached
-               nn=k
-               call msgs(73,0)
-               goto 500
-            endif
- 60      continue
-      endif
-c     
-c     form results for output
- 500  continue
-c      if(lhs.ge.3) then
-c     preserve lsod* working spaces
-c         lw=lyp+nn*(ny+1)
-c         ilw=iadr(lw+lrw)
-c         err=sadr(ilw+liw)-lstk(bot)
-c         if(err.gt.0) then
-c            call error(17)
-c            return
-c         endif
-c        call unsfdcopy(lrw,stk(lc),1,stk(lw),1)
-c        call icopy(liw,istk(ilc),1,istk(ilw),1)
-c     endif
-c     form state output
-      ils=iadr(lstk(kynew))
-      top=tope-rhs+1
-      call icopy(hsize,istk(ils),1,istk(ile),1)
-      ly=sadr(ile+hsize)
-      nel=istk(ile+1)*istk(ile+2)
-      if(nn.eq.0) then
-         istk(ile)=1
-         istk(ile+1)=0
-         istk(ile+2)=0
-         istk(ile+3)=0
-         lstk(top+1)=sadr(ile+4)
-      elseif(single) then
-         istk(ile+1)=istk(ile+1)+1
-         istk(ile+2)=nn*istk(ile+2)
-         inc=1
-         if(ly.gt.lyp) inc=-1
-         call unsfdcopy((ny+1)*nn,stk(lyp),inc,stk(ly),inc)
-         lstk(top+1)=ly+(ny+1)*nn
-      else
-         istk(ile+2)=nn*istk(ile+2)
-         if(istk(ile).eq.2) ly=sadr(ile+9+nel*nn)
-         inc=1
-         if(ly.gt.lyp) inc=-1
-
-         if(meth.eq.3.and.iadr(ly+ny*nn).gt.ilroot) then
-c     preserve jroot table
-            ilr1=iadr(lyp+ny*nn)
-            err=sadr(ilr1)-lstk(bot)
-            if(err.gt.0) then
-               call error(17)
-               return
-            endif
-            call icopy(nsurf,istk(ilroot),1,istk(ilr1),1)
-            ilroot=ilr1
-         endif
-
-         call unsfdcopy(ny*nn,stk(lyp),inc,stk(ly),inc)
-         lstk(top+1)=ly+ny*nn
-         if(istk(ile).eq.2) then
-c     on defini la table des pointeurs
-            il=ile+7
-            do 502 i=2,nn
-               do 501 j=1,nel
-                  istk(il+nel+j+1)=istk(ile+8+j)-1+istk(il+nel+1)
- 501           continue
-               il=il+nel
- 502        continue
-         endif
-      endif
-
-      if(meth.eq.3) then
-         if(lhs.lt.2) return
-c     lsodar: form roots output
-         top=top+1
-         il=iadr(lstk(top))
-         istk(il)=1
-         istk(il+3)=0
-         l=sadr(il+4)
-         if(istate.eq.3) then
-            istk(il+1)=1
-            istk(il+2)=1
-            stk(l)=t0
-            do 503 i=0,nsurf-1
-               if(istk(ilroot+i).ne.0) then
-                  l=l+1
-                  istk(il+2)=istk(il+2)+1
-                  stk(l)=i+1
-               endif
- 503        continue
-         else
-            istk(il+1)=0
-            istk(il+2)=0
-         endif
-         lstk(top+1)=l+1
-      endif
-c     form w and iw output
-      if(lhs.lt.3) return
-c     w
-      top=top+1
-      il=iadr(lstk(top))
-      istk(il)=1
-      istk(il+1)=1
-      istk(il+2)=lrw+nsizd
-      istk(il+3)=0
-      l=sadr(il+4)
-      lstk(top+1)=l+lrw+nsizd
-      call unsfdcopy(lrw,stk(lc),1,stk(l),1)
-      lsvs=l+lrw
-c     iw
-      top=top+1
-      il=iadr(lstk(top))
-      istk(il)=1
-      istk(il+1)=1
-      istk(il+2)=liw+nsizi
-      istk(il+3)=0
-      l=sadr(il+4)
-      lstk(top+1)=l+liw+nsizi
-      do 506 k=1,liw
-         stk(l+k-1)=dble(istk(ilc+k-1))
- 506  continue
-      lsvi=l+liw
-      if(meth.eq.0) then
-         call svcma1(stk(lsvs),stk(lsvi))
-      elseif(meth.lt.3) then
-         call svcom1(stk(lsvs),stk(lsvi))
-      else
-         call svcar1(stk(lsvs),stk(lsvi))
-      endif
-      return
-      end
-
diff --git a/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_odedc.f b/scilab/modules/differential_equations/sci_gateway/fortran/sci_f_odedc.f
deleted file mode 100644 (file)
index d0cf2bb..0000000
+++ /dev/null
@@ -1,1150 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c ...
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-c
-      subroutine  sciodc
-c ====================================================================
-c     simulation non lineaire hybride
-c ====================================================================
-c
-      include 'stack.h'
-      integer iadr,sadr
-c
-c     common de lsode,lsoda,lsodar
-      double precision xxxx,yyyy,rlsr
-      integer ilsr
-      common/ls0001/xxxx(219),iiii(39)
-      common/lsa001/yyyy(22),jjjj(9)
-      common/lsr001/ rlsr(5),ilsr(9)
-      common/eh0001/kkkk(2)
-      save /ls0001/,/lsa001/,/lsr001/,/eh0001/
-c
-c     commons avec bydot,bjac,....
-c
-      character*(nlgh+1) namef,namej,names
-      common/cydot/namef
-      common/cjac/namej
-      common/csurf/names
-      common/ierajf/iero
-      common/odecd/nd,iflag
-c
-c
-      character tmpbuf * (bsiz)  
-      double precision atol,rtol,t0,tleft,tright,tf,hf
-      double precision h0,hmax,hmin,tcrit,tmax,hstep,delta
-      integer meth,jactyp
-      integer top1,top2,tope,hsize
-      logical jaco,achaud,withw,single,update
-      external bydot2,bjac,bsurf
-      integer raide(2),root(2),adams,discre,rgk(2),rk(2),fix(2)
-      integer params(nsiz)
-      data raide/28,29/,adams/10/,root/27,24/
-      data discre/13/,rgk/27,16/,rk/27,20/,fix/15,18/
-      data params/-235739080,-303896856,669247720,3*673720360/
-c     
-      iadr(l)=l+l-1
-      sadr(l)=(l/2)+1
-c     
-c
-      if (ddt .eq. 4) then
-         write(tmpbuf(1:4),'(i4)') fin
-         call basout(io,wte,' matodc '//tmpbuf(1:4))
-      endif
-
-c
-      top2=top+1-rhs
-c
-c     get %ODEOPTIONS variable
-      ifin=fin
-      fin=-1
-      istate=1
-      call stackg(params)
-      if(fin.eq.0) then
-c         call msgs(72,0)
-         iopt=0
-         itask=4
-         jactyp=2
-         ml=-1
-         mu=-1
-      else
-         iopt=1
-         il=iadr(lstk(fin))
-         l=sadr(il+4)
-c     %ODEOPTIONS=[itask,tcrit,h0,hmax,hmin,jactyp,mxstep,..
-c                                  mxordn,mxords,ixpr, ml,mu]
-         itask=int(stk(l))
-         if(itask.ne.4.and.itask.ne.5) then
-            call msgs(78,0)
-            if(itask.eq.1) then
-               itask=4
-            else
-               itask=5
-            endif
-         endif
-         tcrit=stk(l+1)
-         h0=stk(l+2)
-         hmax=stk(l+3)
-         hmin=stk(l+4)
-         if(hmin.gt.hmax) then
-            buf=' what? hmin greater than hmax?'
-            call error(9999)
-            return
-         endif
-         jactyp=int(stk(l+5))
-         if(jactyp.lt.0.or.jactyp.gt.5) then
-            buf=' invalid option (entry no 4)'
-            call error(9999)
-            return
-         endif
-         mxstep=int(stk(l+6))
-         mxordn=int(stk(l+7))
-         mxords=int(stk(l+8))
-         ixpr=int(stk(l+9))
-         ml=int(stk(l+10))
-         mu=int(stk(l+11))
-      endif
-c      .....
-c
-      fin=ifin
-      withw=.false.
-
-      tope=top
-      itype=0
-
-      nd=0
-      iflag=0      
-c
-c     odedc
-c
-      if(rhs.lt.4) then
-         call error(39)
-         return
-      endif
-c
-c     lw=premiere adresse libre dans la pile
-      lw=lstk(top+1)
-c
-c     test demarrage a chaud
-      ifin=iadr(lstk(top))
-      achaud=istk(ifin).eq.1
-      if(achaud) then
-c     ilc=adresse of lsod* integer work space  
-         il=iadr(lstk(top))
-         if(istk(il).ne.1) then
-            err=rhs
-            call error(53)
-            return
-         endif
-         liwp=istk(il+2)*istk(il+1)
-         lci=sadr(il+4)
-         ilc=iadr(lci)
-c     lc=adresse of lsod* real work space  
-         il=iadr(lstk(top-1))
-         if(istk(il).ne.1) then
-            err=rhs-1
-            call error(53)
-            return
-         endif
-         lc=sadr(il+4)
-         lrwp=istk(il+1)*istk(il+2)
-c         if(meth.le.3) then
-c     check for input hot start table consistency
-c            if(lrwp.ne.lrw+nsizd) then
-c               buf=' Real hot start table has incorrect size'
-c               call error(9999)
-c               return
-c            endif
-c            if(liwp.ne.liw+nsizi) then
-c               buf=' Input hot start table has incorrect size'
-c               call error(9999)
-c               return
-c            endif
-c         endif
-      endif
-c
-      ile=iadr(lstk(top2))
-c
-      if(istk(ile).eq.10) then
-         top2=top2+1
-         if(abs(istk(ile+6)).eq.adams) then
-c     lsode (adams)
-            meth=1
-         elseif(abs(istk(ile+6)).eq.raide(1) .and.
-     $           abs(istk(ile+7)).eq.raide(2)) then
-c     lsode (gear)
-            meth=2
-         elseif(abs(istk(ile+6)).eq.root(1) .and.
-     $           abs(istk(ile+7)).eq.root(2)) then
-c     lsodar
-            meth=3
-         elseif(abs(istk(ile+6)).eq.discre) then
-c     ldisc
-            meth=4
-         elseif(abs(istk(ile+6)).eq.rgk(1) .and.
-     $           abs(istk(ile+7)).eq.rgk(2)) then
-c     runge-kutta
-            meth=5
-         elseif(abs(istk(ile+6)).eq.rk(1) .and.
-     $           abs(istk(ile+7)).eq.rk(2)) then
-c     rkf45
-            meth=6
-         elseif(abs(istk(ile+6)).eq.fix(1) .and.
-     $           abs(istk(ile+7)).eq.fix(2)) then
-c     rksimp
-            meth=7
-         else
-            call error(42)
-            return
-         endif
-      else
-c     lsoda
-         meth=0
-      endif
-c
-      if(meth.lt.3) then
-         if(lhs.ne.3.and.lhs.ne.1) then
-            call error(41)
-            return
-         endif
-      elseif(meth.eq.3) then
-         if(lhs.ne.2.and.lhs.ne.4) then
-            call error(41)
-            return
-         endif
-      elseif(meth.ge.4) then
-         if(lhs.ne.1) then
-            call error(41)
-            return
-         endif
-      endif
-c
-      top1=top
-      if(achaud) top1=top-2
-c     top1 points to last external
-c
-      if(meth.eq.3) then
-c     on recupere le simulateur des equations des surfaces
-         ilsurf=iadr(lstk(top1))
-         if(istk(ilsurf).ne.10.and.istk(ilsurf).ne.15.and.
-     $        istk(ilsurf).ne.11.and.istk(ilsurf).ne.13) then
-            err=rhs-(tope-top1)
-            call error(80)
-            return
-         endif
-         if(istk(ilsurf).eq.10) then
-            names=' '
-            call cvstr(istk(ilsurf+5)-1,istk(ilsurf+6),names,1)
-            names(istk(ilsurf+5):istk(ilsurf+5))=char(0)
-            call setfsurf(names,irep)
-            if ( irep.eq.1) then 
-               buf = names
-               call error(50)
-               return
-            endif
-         endif
-         ksurf=top1
-         top1=top1-1
-c     ... et le nombre d'equations
-         il=iadr(lstk(top1))
-         if(istk(il).ne.1) then
-            err=rhs-(tope-top1)
-            call error(53)
-            return
-         endif
-         if(istk(il+1)*istk(il+2).ne.1) then
-            err=rhs-(tope-top1)
-            call error(89)
-            return
-         endif
-         l=sadr(il+4)
-         nsurf=stk(l)
-         top1=top1-1
-      else
-         ksurf=0
-      endif
-      
-      il=iadr(lstk(top1-1))
-      if(istk(il).eq.10.or.istk(il).eq.15.or.
-     $     istk(il).eq.11.or.istk(il).eq.13) then
-c     JACOBIAN IS GIVEN (variable top1)
-         ilj=iadr(lstk(top1))
-         islj=istk(ilj)
-         if(islj.lt.10.or.islj.gt.15.or.islj.eq.12) then
-            err=rhs-(tope-top1)
-            call error(80)
-            return
-         endif
-         if(islj.eq.10) then
-            namej=' '
-            call cvstr(istk(ilj+5)-1,istk(ilj+6),namej,1)
-            namej(istk(ilj+5):istk(ilj+5))=char(0)
-            call setfjac(namej,irep)
-            if ( irep.eq.1) then 
-               buf = namej
-               call error(50)
-               return
-            endif
-         endif
-         if (meth.ge.4) then
-            call msgs(75,0)
-         endif
-         if(jactyp.eq.0.and.(meth.eq.2.or.meth.eq.1)) then
-            call msgs(75,0)
-         endif
-         jaco=.true.
-         if(iopt.eq.0) then
-c     set jactyp (jacobian is supposed full)
-            jactyp=1
-         else 
-c     check jactyp
-            if(jactyp.eq.2.or.jactyp.eq.5) then
-               call msgs(75,0)
-            endif
-         endif
-         kjac=top1
-         top1=top1-1
-      else
-c     JACOBIAN NOT GIVEN
-         if(iopt.eq.0) then
-c     set jactyp (estimated jacobian is supposed full)
-            jactyp=2
-         else
-c     check jactyp
-            if(jactyp.eq.1.or.jactyp.eq.4) then
-c     %ODEOPTIONS requires the jacobian
-               call msgs(76,0)
-               jactyp=jactyp+1
-            endif
-         endif
-         jaco=.false.         
-         kjac=0
-      endif
-
-      kytop=top1
-
-c
-c     rhs
-      ilf=iadr(lstk(top1))
-      islf=istk(ilf)
-      if(islf.ne.10.and.islf.ne.15.and.islf.ne.11.and.islf.ne.13) then
-         err=rhs-(tope-top1)
-         call error(80)
-         return
-      endif
-      kydot=top1
-      if(islf.eq.10) then
-         namef=' '
-         call cvstr(istk(ilf+5)-1,istk(ilf+6),namef,1)
-         namef(istk(ilf+5):istk(ilf+5))=char(0)
-         call setfydot2(namef,irep)
-         if ( irep.eq.1) then 
-            buf = namef
-            call error(50)
-            return
-         endif
-c    test list('fex',w)
-      elseif(islf.eq.15) then
-        le1=sadr(ilf+istk(ilf+1)+3)
-        if(istk(iadr(le1)).eq.10) then
-        withw=.true.
-c     next line just to tell to bydot that external is in fortran
-        istk(ilf)=10 
-        if(istk(ilf+1).ne.2) then
-           buf='wrong list passed: needs two elts in list'
-           call error(9999)
-           return
-        endif
-        long1=istk(ilf+3)
-        lf=lstk(top1)
-        illl=iadr(lf+istk(ilf+3))
-        nblett=istk(illl-1)-1
-        namef=' '
-        call cvstr(istk(ilf+11)-1,istk(ilf+12),namef,1)
-        namef(istk(ilf+11):istk(ilf+11))=char(0)
-        call setfydot2(namef,irep)
-        if ( irep.eq.1) then 
-           buf = namef
-           call error(50)
-           return
-        endif
-        ll1=sadr(ilf+5)
-        ll2=ll1+long1-1
-        il2=iadr(ll2)
-        nbw=istk(il2+1)*istk(il2+2)
-        if(istk(il2+3).ne.0) then
-           buf='working array must be real'
-           call error(9999)
-           return
-        endif
-        lww=sadr(il2+4)
-c     lww = adr w , nbw = size (w) 
-      endif
-      endif
-c
-c     jaco,type and meth initialized ...
-c     top2 point on y0
-c
-c     y0
-      kynew=top2
-      il=iadr(lstk(top2))
-      ilws=il
-      it=istk(il+3)
-      if(it.ne.0) then
-         buf='odedc: y0 must be real!'
-         call error(9999)
-         return
-      endif
-c
-      if(istk(il).eq.1) then
-         hsize=4
-         ny1=istk(il+1)
-         ny2=istk(il+2)
-         ny=ny1*ny2
-         else
-            buf='odedc: invalid y0'
-            call error(9999)
-      endif
-      ly=sadr(il+hsize)
-
-c     list('fex',w)
-      if(withw) then
-         if(top+1.ge.bot) then
-            call error(18)
-            return
-         endif
-         top=top+1
-c         kynew=top
-         ily=iadr(lstk(top))
-         err=sadr(ily+4)+ny+nbw-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         istk(ily+1)=1
-         istk(ily+2)=ny+nbw
-         istk(ily+3)=1
-         istk(ily+4)=0
-         ly1=sadr(ily+4)
-         call unsfdcopy(ny,stk(ly),1,stk(ly1),1)
-         call unsfdcopy(nbw,stk(lww),1,stk(ly1+ny),1)
-         lstk(top+1)=ly1+ny+nbw
-         ly=ly1
-         lw=lstk(top+1)
-      endif
-      lw1=lw
-      lw=sadr(iadr(lw1)+13)
-c 
-c **************************************
-c      nd discrete part size
-      top2=top2+1
-      il=iadr(lstk(top2))
-      if(istk(il).ne.1) then
-         err=rhs-(tope-top2)
-         call error(53)
-         return
-      endif
-      l=sadr(il+4)
-      if((istk(il+1)*istk(il+2)).ne.1) then
-         buf='odedc: argument nc must be 1x1 and integer!'
-         call error(9999)
-         return
-      endif
-      nd=int(stk(l))
-      ny=ny-nd
-      if(ny.lt.0) then
-         buf='odedc: value of nd exceeds dimension of y0'
-         call error(9999)
-         return
-      endif
-c 
-c      hstep or [hstep delta]
-      top2=top2+1
-      il=iadr(lstk(top2))
-      if(istk(il).ne.1) then
-         err=rhs-(tope-top2)
-         call error(53)
-         return
-      endif
-      l=sadr(il+4)
-      nsi=istk(il+1)*istk(il+2)
-      if(.not.(nsi.eq.1.or.nsi.eq.2)) then
-         buf='odedc: argument hstep must be 1 or 2'
-         call error(9999)
-         return
-      endif
-      hstep=stk(l)
-      delta=0.0d0
-      if(nsi.eq.2) delta=stk(l+1)
-c ************************
-c     t0
-      top2=top2+1
-      kttop=top2
-      il=iadr(lstk(top2))
-      if(istk(il).ne.1) then
-         err=rhs-(tope-top2)
-         call error(53)
-         return
-      endif
-      l=sadr(il+4)
-      t0=stk(l)
-c     t1
-      top2=top2+1
-      il=iadr(lstk(top2))
-      if(istk(il).ne.1) then
-         err=rhs-(tope-top2)
-         call error(53)
-         return
-      endif
-
-c     number of output points
-      nn=istk(il+1)*istk(il+2)
-c     pointer on  output time vector
-      lt1=sadr(il+4)
-c
-c     optionnal parameters rtol et atol
-      top2=top2+1
-c     default values
-      if(meth.eq.6.or.meth.eq.7) then
-         rtol=1.d-3
-         atol=1.d-4
-      else
-         rtol=1.0d-7
-         atol=1.0d-9
-      endif
-      nr=1
-      na=1
-      jobtol=kytop-top2+1
-c     jobtol=(nothing ,rtol only,rtol and atol)
-c
-      if(jobtol.eq.1) then
-c     default tolerances
-         lr=lw
-         la=lr+1
-         stk(la)=atol
-         stk(lr)=rtol
-      else
-c     rtol given
-         lr=lw
-c     rtol
-         il=iadr(lstk(top2))
-         if(istk(il).ne.1) then
-            err=rhs-(tope-top2)
-            call error(53)
-            return
-         endif
-         nr=istk(il+1)*istk(il+2)
-         if(nr.ne.1.and.nr.ne.ny) then
-            err=rhs-(tope-top2)
-            call error(89)
-            return
-         endif
-         lrt=sadr(il+4)
-         call unsfdcopy(nr,stk(lrt),1,stk(lr),1)
-         la=lr+nr
-c     atol
-         if(jobtol.eq.2) then
-c        .  default
-            stk(la)=atol
-         else
-c        .  atol given
-            top2=top2+1
-            il=iadr(lstk(top2))
-            if(istk(il).ne.1) then
-               err=rhs-(tope-top2)
-               call error(53)
-               return
-            endif
-            na=istk(il+1)*istk(il+2)
-            if(na.ne.1.and.na.ne.ny) then
-               err=rhs-(tope-top2)
-               call error(89)
-               return
-            endif
-            lat=sadr(il+4)
-            call unsfdcopy(na,stk(lat),1,stk(la),1)
-         endif
-      endif
-      lw=la+na
-
-c     set input top value
-      if(achaud) top=top+2
-c
-      if(nr.eq.1.and.na.eq.1) itol=1
-      if(nr.eq.1.and.na.gt.1) itol=2
-      if(nr.gt.1.and.na.eq.1) itol=3
-      if(nr.gt.1.and.na.gt.1) itol=4
-
-c     compute integrator workspace  sizes
-      if(meth.eq.0) then
-c     lsoda
-         lrw=22+ny*max(16,ny+9)
-         liw=20+ny
-         nsizd=241
-         nsizi=50
-         if(jactyp.eq.4.or.jactyp.eq.5) then
-            lrn=20+16*ny
-            lrs=22+10*ny+(2*ml+mu)*ny
-            lrw=max(lrn,lrs)
-         endif
-      elseif(meth.eq.1) then
-c     lsode - adams
-         if(jactyp.eq.1.or.jactyp.eq.2) then
-            lrw=22+16*ny+ny*ny
-         elseif(jactyp.eq.4.or.jactyp.eq.5) then
-            lrw=22+16*ny+(2*ml+mu+1)*ny
-         else
-            lrw=20+16*ny
-         endif
-         liw=20+ny
-         nsizd=219
-         nsizi=41
-      elseif(meth.eq.2) then
-c     lsode gear
-         if(jactyp.eq.1.or.jactyp.eq.2) then
-            lrw=22+9*ny+ny*ny
-         elseif(jactyp.eq.4.or.jactyp.eq.5) then
-            lrw=22+9*ny+(2*ml+mu+1)*ny
-         else
-            lrw=20+9*ny
-         endif
-         liw=20+ny
-         nsizd=219
-         nsizi=41
-      elseif(meth.eq.3) then
-c     lsodar
-         ilroot=iadr(lw)
-         lw=sadr(ilroot+nsurf)
-         lrw= 22 + ny * max(16, ny + 9) + 3*nsurf
-         liw=20+ny
-         nsizd=246
-         nsizi=59
-      elseif(meth.eq.4) then
-c     lsdisc
-         lrw=ny
-         liw=1
-      elseif(meth.eq.5) then
-c     lsrgk
-         lrw=3*ny
-         liw=1
-      elseif(meth.eq.6) then
-c     rkf45
-         lrw=3+8*ny
-         liw=5
-      elseif(meth.eq.7) then
-c     rksimp
-         lrw=3+8*ny
-         liw=1
-      endif
-c
-c     hot start
-c
-      if(achaud) then
-         istate=2
-c     commons retrieval from hot start tables
-         if(meth.eq.0) then
-c     lsoda
-            lsavs=lc+lrwp-nsizd
-            lsavi=lci+liwp-nsizi
-            call rscma1(stk(lsavs),stk(lsavi))
-         elseif(meth.eq.1.or.meth.eq.2) then
-c     lsode
-            lsavs=lc+lrwp-nsizd
-            lsavi=lci+liwp-nsizi
-            call rscom1(stk(lsavs),stk(lsavi))
-         elseif(meth.eq.3) then
-c     lsodar
-            lsavs=lc+lrwp-nsizd
-            lsavi=lci+liwp-nsizi
-            call rscar1(stk(lsavs),stk(lsavi))
-         endif
-c     integer workspace retrieval
-         do 40 k=1,liw
-            istk(ilc+k-1)=int(stk(lci+k-1))
- 40      continue
-      endif
-c
-c
-c     compute pointer on ode real and integer work spaces
-      lc0=lw
-      li=lc0+lrw
-c
-      ili=iadr(li)
-      lw=sadr(ili+liw)
-c
-c     get memory to store results
-      lyp=lw
-      if(itask.eq.5) then
-c     unknown number of output points.  space for  points 
-c     will be allocated later
-         single=.true.
-         lw=lyp
-         if(nn.ne.1) then
-            call msgs(77,0)
-            stk(lt1)=stk(lt1+nn-1)
-            nn=1
-         endif
-         if(it.ne.0) then
-            buf='itask=5: y0 must be a real vector'
-            call error(9999)
-            return
-         endif
-      else
-c     number of output points is equal to number of t points all 
-c     space allocated here
-         single=.false.
-         lw=lw+nn*(ny+nd)
-      endif
-c     top points on external workspace
-      top=top+1
-      lstk(top+1)=lw
-      err=lstk(top+1)-lstk(bot)
-      if(err.gt.0) then
-         call error(17)
-         return
-      endif
-c
-      call xsetf(1)
-      call xsetun(wte)
-c
-      if(.not.achaud) then
-         lc=lc0
-         ilc=ili
-      endif
-c
-c     data structure passed to externals, it contains pointer
-c     to externals parameters
-c
-      ilw1=iadr(lw1)
-      istk(ilw1)=3
-      istk(ilw1+1)=ilw1+4
-      istk(ilw1+2)=ilw1+7
-      istk(ilw1+3)=ilw1+10
-      istk(ilw1+4)=kydot
-      istk(ilw1+5)=kttop
-      istk(ilw1+6)=kynew
-      istk(ilw1+7)=kjac
-      istk(ilw1+8)=kttop
-      istk(ilw1+9)=kynew
-      istk(ilw1+10)=ksurf
-      istk(ilw1+11)=kttop
-      istk(ilw1+12)=kynew
-c 
-      if(iopt.eq.1) then
-c     copy integration options in lsod* workspace
-         if(itask.ge.4) then
-            stk(lc)=tcrit
-         endif
-         stk(lc+4)=h0
-         stk(lc+5)=hmax
-         stk(lc+6)=hmin
-         if(meth.eq.0.or.meth.eq.3) then
-c   lsoda/lsodar
-            if(jactyp.eq.4.or.jactyp.eq.5) then
-               istk(ilc)=ml
-               istk(ilc+1)=mu
-            endif
-            istk(ilc+4)=ixpr
-            istk(ilc+5)=mxstep
-            istk(ilc+6)=0
-            istk(ilc+7)=mxordn
-            istk(ilc+8)=mxords
-         elseif(meth.lt.3) then
-c   lsode 
-            if(jactyp.eq.4.or.jactyp.eq.5) then
-               istk(ilc)=ml
-               istk(ilc+1)=mu
-            endif
-            if(meth.lt.2) then
-               istk(ilc+4)=mxordn
-            else
-               istk(ilc+4)=mxords
-            endif
-            istk(ilc+5)=mxstep
-            istk(ilc+6)=0
-         endif
-      endif
-      tmax=stk(lt1+nn-1)
-      niter=nn
-c     
-      if(ixpr.eq.1.and.iopt.eq.1) then
-      write(tmpbuf, '(''itask = '',i3,'' meth = '',i3,'' jactyp = '','//
-     $        'i3,'' ml = '',i3,'' mu = '',i3)') itask,meth,jactyp,ml
-     $        ,mu
-         call basout(io,wte,tmpbuf(1:80))
-      write(tmpbuf, '(''tcrit= '',e11.4,'' h0= '',e11.4, '' hmax= '','//
-     $       'e11.4,'' hmin = '',e11.4)')
-     $    tcrit,stk(lc+4),stk(lc+5),stk(lc+6)
-         call basout(io,wte,tmpbuf(1:80)) 
-      endif
-
-      tleft=t0
-      iflag=0
-      ntpass=0
-      nhpass=0
-      if(single) then
-c     loop til t=tout
-c     --------------
-         nn=0
-         k=0
-         tf=tmax
- 50      continue
-         hf=min(t0+nhpass*hstep+delta*hstep,tmax)
-c     set continuuous integration time
- 51      continue
-         if(abs(tleft-hf).le.1.d-12) goto 52
-         istore=1
-         if(ixpr.eq.1.and.iopt.eq.1) then
-            write(tmpbuf
-     $           ,'(''integ. from tleft='',e10.3,'' to tf= '','//
-     $           'e10.3)') tleft,tright 
-            buf = tmpbuf
-            call basout(io,wte,tmpbuf(1:50))
-         endif
-         tright=hf
-         tcrit=hf
-         stk(lc)=tcrit
-c     integrate continuous part
-         if(meth.eq.0) then
-            call lsoda(bydot2,ny,stk(ly),tleft,tright,itol
-     $           ,stk(lr),stk(la),itask,istate,iopt,stk(lc),lrw
-     $           ,istk(ilc),liw,bjac,10*meth+jactyp)
-         elseif(meth.eq.1.or.meth.eq.2) then
-            call lsode(bydot2,ny,stk(ly),tleft,tright,itol
-     $           ,stk(lr),stk(la),itask,istate,iopt,stk(lc),lrw
-     $           ,istk(ilc),liw,bjac,10*meth+jactyp)
-         elseif(meth.eq.3) then
-            call lsodar(bydot2,ny,stk(ly),tleft,tright,itol,stk(lr)
-     $           ,stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc)
-     $           ,liw,bjac,jactyp,bsurf,nsurf,istk(ilroot)) 
-
-         elseif(meth.eq.4) then
-            call lsdisc(bydot2,ny,stk(ly),tleft,tright, stk(lc)
-     $           ,lrw,istate)
-         elseif(meth.eq.5) then
-            call lsrgk(bydot2,ny,stk(ly),tleft,tright,itol
-     $           ,stk(lr),stk(la),itask,istate,iopt,stk(lc),lrw
-     $           ,istk(ilc),liw,bjac,meth)
-            if(iero.eq.-1) then
-               write(tmpbuf,'(e10.3)') tright
-               buf = tmpbuf
-               call msgs(70,0)
-            endif
-         elseif(meth.eq.6) then
-            call rkf45(bydot2,ny,stk(ly),tleft,tright,itol,rtol,
-     1           atol,itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2           liw,bjac,meth)
-         elseif(meth.eq.7) then
-            call rksimp(bydot2,ny,stk(ly),tleft,tright,itol,rtol
-     $           ,atol,itask,istate,iopt,stk(lc),lrw,istk(ilc)
-     $           ,liw,bjac,meth)
-         endif         
-         if(err.gt.0.or.err1.gt.0) return
-         if(istate.lt.0) then
-            if(meth.le.3) then
-               if(istate.eq.-3) then
-                  buf='illegal input'
-                  call error(9999)
-                  return
-                endif
-            endif
-            if(meth.eq.5) call msgs(71,0)
-            call msgs(4,ierr)
-            nn=k
-            goto 500
-         endif
-         if((meth.eq.6.or.meth.eq.7).and.istate.ne.2) then
-            nn=k
-            call msgs(74,0)
-            goto 500
-         endif  
-c     store intermediate result
-         k=k+1
-         lys=lyp+(k-1)*(ny+nd+1)
-         lstk(top+1)=lys+(ny+nd+1)
-         err=lstk(top+1)-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         stk(lys)=tleft
-         call unsfdcopy(ny+nd,stk(ly),1,stk(lys+1),1)
-         if(meth.eq.3.and.istate.eq.3) then
-c     lsodar: a root found
-            nn=k
-            goto 500
-         endif
-         goto 51
-c     update discrete part if necessary
- 52      continue
-         iflag=1
-         if(ixpr.eq.1.and.iopt.eq.1) then
-            write(tmpbuf,'(''update at t = '',e10.3)') tright
-            buf = tmpbuf
-            call basout(io,wte,tmpbuf(1:20))
-         endif
-         call bydot2(ny,tright,stk(ly),stk(ly+ny))
-         if(err.gt.0.or.err1.gt.0) return
-         iflag=0
-         nhpass=nhpass+1
-c     store intermediate result
-         k=k+1
-         lys=lyp+(k-1)*(ny+nd+1)
-         lstk(top+1)=lys+(ny+nd+1)
-         err=lstk(top+1)-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         stk(lys)=tleft
-         call unsfdcopy(ny+nd,stk(ly),1,stk(lys+1),1)
-         if (abs(tleft-tmax).gt.1.d-12) goto 50
-         nn=k
-      else
-         do 60 k=1,niter
- 59         tf=stk(lt1+k-1)
-            hf=t0+nhpass*hstep+delta*hstep
-            if(ixpr.eq.1.and.iopt.eq.1) then
-               write(tmpbuf,'(''tf-hf = '',e10.3)') tf-hf
-               buf = tmpbuf
-               call basout(io,wte,tmpbuf(1:20))
-            endif
-c     set continuous integration time
-            if(abs(tf-hf).le.1.d-12) then
-               tright=hf
-               nhpass=nhpass+1
-               istore=1
-               if(ixpr.eq.1.and.iopt.eq.1) then
-                  write(tmpbuf,'(''integ. from tleft='',e10.3,'//
-     $                 ''' to hf=tf= '',e10.3)') tleft,tright 
-                  call basout(io,wte,tmpbuf(1:50))
-               endif
-               update=.true.
-            elseif(tf.lt.hf) then
-               tright=tf
-               istore=1
-               if(ixpr.eq.1.and.iopt.eq.1) then
-                  write(tmpbuf
-     $                 ,'(''integ. from tleft='',e10.3,'' to tf= '','//
-     $                 'e10.3)') tleft,tright 
-                  buf = tmpbuf
-                  call basout(io,wte,tmpbuf(1:50))
-               endif
-               update=.false.
-            elseif(tf.gt.hf) then
-               tright=hf
-               nhpass=nhpass+1
-               istore=0
-               if(ixpr.eq.1.and.iopt.eq.1) then
-                  write(tmpbuf
-     $                 ,'(''integ. from tleft='',e10.3,'' to hf= '','//
-     $                 'e10.3)') tleft,tright 
-                  buf = tmpbuf
-                  call basout(io,wte,tmpbuf(1:50))
-               endif
-               update=.true.
-            endif
-            tcrit=hf
-            stk(lc)=tcrit
-c     integrate continuuous part
-            if(meth.eq.0) then
-               call lsoda(bydot2,ny,stk(ly),tleft,tright,itol
-     $              ,stk(lr),stk(la),itask,istate,iopt,stk(lc),lrw
-     $              ,istk(ilc),liw,bjac,10*meth+jactyp)
-            elseif(meth.eq.1.or.meth.eq.2) then
-               call lsode(bydot2,ny,stk(ly),tleft,tright,itol
-     $              ,stk(lr),stk(la),itask,istate,iopt,stk(lc),lrw
-     $              ,istk(ilc),liw,bjac,10*meth+jactyp)
-            elseif(meth.eq.3) then
-               call lsodar(bydot2,ny,stk(ly),tleft,tright,itol,stk(lr)
-     $              ,stk(la),itask,istate,iopt,stk(lc),lrw,istk(ilc)
-     $              ,liw,bjac,jactyp,bsurf,nsurf,istk(ilroot)) 
-
-            elseif(meth.eq.4) then
-               call lsdisc(bydot2,ny,stk(ly),tleft,tright, stk(lc)
-     $              ,lrw,istate)
-            elseif(meth.eq.5) then
-               call lsrgk(bydot2,ny,stk(ly),tleft,tright,itol
-     $              ,stk(lr),stk(la),itask,istate,iopt,stk(lc),lrw
-     $              ,istk(ilc),liw,bjac,meth)
-               if(iero.eq.-1) then
-                  write(tmpbuf,'(e10.3)') tright
-                  buf = tmpbuf
-                  call msgs(70,0)
-               endif
-            elseif(meth.eq.6) then
-               call rkf45(bydot2,ny,stk(ly),tleft,tright,itol,rtol,
-     1              atol,itask,istate,iopt,stk(lc),lrw,istk(ilc),
-     2              liw,bjac,meth)
-            elseif(meth.eq.7) then
-               call rksimp(bydot2,ny,stk(ly),tleft,tright,itol,rtol
-     $              ,atol,itask,istate,iopt,stk(lc),lrw,istk(ilc)
-     $              ,liw,bjac,meth)
-            endif         
-            if(err.gt.0.or.err1.gt.0) return
-            if(istate.lt.0) then
-            if(meth.le.3) then
-               if(istate.eq.-3) then
-                  buf='illegal input'
-                  call error(9999)
-                  return
-                endif
-            endif
-               if(meth.eq.5) call msgs(71,0)
-               call msgs(4,ierr)
-               nn=k-1
-               goto 500
-            endif
-            if((meth.eq.6.or.meth.eq.7).and.istate.ne.2) then
-               nn=k-1
-               call msgs(74,0)
-               goto 500
-            endif     
-c     update discrete part if necessary
-            if(update) then
-               iflag=1
-               if(ixpr.eq.1.and.iopt.eq.1) then
-                  write(tmpbuf,'(''update at t = '',e10.3)') tright
-                  buf = tmpbuf
-                  call basout(io,wte,tmpbuf(1:20))
-               endif
-               call bydot2(ny,tright,stk(ly),stk(ly+ny))
-               if(err.gt.0.or.err1.gt.0) return
-               iflag=0
-            endif
-c     store intermediate result
-            if(meth.eq.3.and.istate.eq.3) then
-c     lsodar: a root found
-               nn=k
-               goto 500
-            endif
-            if(istore.eq.1) then
-               if(it.eq.0) then
-                  lys=lyp+(k-1)*(ny+nd)
-                  call unsfdcopy(ny+nd,stk(ly),1,stk(lys),1)
-               else
-                  lys=lyp+(k-1)*nys2
-                  call unsfdcopy(nys2,stk(ly),1,stk(lys),1)
-                  call unsfdcopy(nys2,stk(ly+nys2),1,stk(lys+nn*nys2),1)
-               endif
-            else
-               goto 59
-            endif
- 60      continue
-      endif
- 500  continue
-      if(lhs.ge.3) then
-c     preserve lsod* working spaces
-         lw=lyp+nn*(ny+nd+1)
-         ilw=iadr(lw+lrw)
-         err=sadr(ilw+liw)-lstk(bot)
-         if(err.gt.0) then
-            call error(17)
-            return
-         endif
-         call unsfdcopy(lrw,stk(lc),1,stk(lw),1)
-         call icopy(liw,istk(ilc),1,istk(ilw),1)
-      endif
-c form state output
-      ils=iadr(lstk(kynew))
-      top=tope-rhs+1
-c      
-      call icopy(hsize,istk(ils),1,istk(ile),1)
-      ly=sadr(ile+hsize)
-      nel=istk(ile+1)*istk(ile+2)
-      if(single) then
-         istk(ile+1)=istk(ile+1)+1
-         istk(ile+2)=nn*istk(ile+2)
-         inc=1
-         if(ly.gt.lyp) inc=-1
-         call unsfdcopy((ny+nd+1)*nn,stk(lyp),inc,stk(ly),inc)
-         lstk(top+1)=ly+(ny+nd+1)*nn
-      else
-         istk(ile+2)=nn*istk(ile+2)
-         inc=1
-         if(ly.gt.lyp) inc=-1
-c
-         call unsfdcopy((ny+nd)*nn,stk(lyp),inc,stk(ly),inc)
-         lstk(top+1)=ly+(ny+nd)*nn
-      endif
-
-      if(meth.eq.3) then
-c     lsodar: form roots output
-         top=top+1
-         il=iadr(lstk(top))
-         istk(il)=1
-         istk(il+3)=0
-         l=sadr(il+4)
-         if(istate.eq.3) then
-            istk(il+1)=1
-            istk(il+2)=1
-            stk(l)=t0
-            do 503 i=0,nsurf-1
-               if(istk(ilroot+i).ne.0) then
-                  l=l+1
-                  istk(il+2)=istk(il+2)+1
-                  stk(l)=i+1
-               endif
- 503        continue
-         else
-            istk(il+1)=0
-            istk(il+2)=0
-         endif
-         lstk(top+1)=l+1
-      endif
-c form w and iw output
-      if(lhs.lt.3) return
-c     w
-      top=top+1
-      il=iadr(lstk(top))
-      istk(il)=1
-      istk(il+1)=1
-      istk(il+2)=lrw+nsizd
-      istk(il+3)=0
-      l=sadr(il+4)
-      lstk(top+1)=l+lrw+nsizd
-      call unsfdcopy(lrw,stk(lw),1,stk(l),1)
-      lsvs=l+lrw
-c     iw
-      top=top+1
-      il=iadr(lstk(top))
-      istk(il)=1
-      istk(il+1)=1
-      istk(il+2)=liw+nsizi
-      istk(il+3)=0
-      l=sadr(il+4)
-      lstk(top+1)=l+liw+nsizi
-      do 506 k=1,liw
-         stk(l+k-1)=dble(istk(ilw+k-1))
- 506  continue
-      lsvi=l+liw
-      if(meth.eq.0) then
-         call svcma1(stk(lsvs),stk(lsvi))
-      elseif(meth.lt.3) then
-         call svcom1(stk(lsvs),stk(lsvi))
-      else
-         call svcar1(stk(lsvs),stk(lsvi))
-      endif
-
-      return
-c     fin de odedc.....
-      end
-c      subroutine pristk(il,n)
-c      include 'stack.h'
-c      write(6,*) (istk(il+i),i=0,n-1)
-c      end
-
-
-C     For C function who need to read odedc common
-      subroutine getcodc(nd1,iflag1)
-      integer nd1,iflag1
-      common/odecd/nd,iflag
-      nd1=nd
-      iflag1=iflag
-      return
-      end
diff --git a/scilab/modules/differential_equations/src/c/colnewtable.c b/scilab/modules/differential_equations/src/c/colnewtable.c
deleted file mode 100644 (file)
index 39cde22..0000000
+++ /dev/null
@@ -1,177 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) INRIA
- * ...
- * 
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at    
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include "GetFunctionByName.h"
-#include "machine.h"
-#include "dynlib_differential_equations.h"
-/***********************************
-* Search Table for colnew 
-*   corr uses : fcoldg , fcolg, fcoldf,fcolf,fcolgu
-***********************************/
-
-#define ARGS_fcoldg int*,double *,double*
-typedef void (*fcoldgf)(ARGS_fcoldg);
-
-#define ARGS_fcolg int*,double *,double*
-typedef void (*fcolgf)(ARGS_fcolg);
-
-#define ARGS_fcoldf double *,double *,double*
-typedef void (*fcoldff)(ARGS_fcoldf);
-
-#define ARGS_fcolf double *,double *,double*
-typedef void (*fcolff)(ARGS_fcolf);
-
-#define ARGS_fcolgu double *,double *,double*
-typedef void (*fcolguf)(ARGS_fcolgu);
-
-/**************** fcoldg ***************/
-extern void C2F(cndg)(ARGS_fcoldg);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fcoldg)(ARGS_fcoldg);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfcoldg)(char *name, int *rep);
-
-FTAB FTab_fcoldg[] ={
-{"cndg", (voidf)  C2F(cndg)},
-{(char *) 0, (voidf) 0}};
-/**************** fcolg ***************/
-extern void C2F(cng)(ARGS_fcolg);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fcolg)(ARGS_fcolg);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfcolg)(char *name, int *rep);
-FTAB FTab_fcolg[] ={
-{"cng", (voidf)  C2F(cng)},
-{(char *) 0, (voidf) 0}};
-/**************** fcolf ***************/
-extern void C2F(cnf)(ARGS_fcolf);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fcolf)(ARGS_fcolf);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfcolf)(char *name, int *rep);
-
-FTAB FTab_fcolf[] ={
-{"cnf", (voidf)  C2F(cnf)},
-{(char *) 0, (voidf) 0}};
-/**************** fcoldf ***************/
-extern void C2F(cndf)(ARGS_fcoldf);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fcoldf)(ARGS_fcoldf);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfcoldf)(char *name, int *rep);
-FTAB FTab_fcoldf[] ={
-{"cndf", (voidf)  C2F(cndf)},
-{(char *) 0, (voidf) 0}};
-/**************** fcolgu ***************/
-extern void C2F(cngu)(ARGS_fcolgu);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fcolgu)(ARGS_fcolgu);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfcolgu)(char *name, int *rep);
-
-FTAB FTab_fcolgu[] ={
-{"cngu", (voidf)  C2F(cngu)},
-{(char *) 0, (voidf) 0}};
-
-
-/***********************************
-* Search Table for colnew 
-*   corr uses : fcoldg , fcolg, fcoldf,fcolf,fcolgu
-***********************************/
-
-/** the current function fixed by setfcoldg **/
-
-static fcoldgf fcoldgfonc ;
-
-/** function call **/
-
-void C2F(fcoldg)(int *i, double *z, double *dg)
-{
-       (*fcoldgfonc)(i,z,dg);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfcoldg)(char *name, int *rep)
-{
-       fcoldgfonc = (fcoldgf) GetFunctionByName(name,rep,FTab_fcoldg);
-}
-
-
-/** the current function fixed by setfcolg **/
-
-static fcolgf fcolgfonc ;
-
-/** function call **/
-
-void C2F(fcolg)(int *i, double *z, double *g)
-{
-       (*fcolgfonc)(i,z,g);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfcolg)(char *name, int *rep)
-{
-       fcolgfonc = (fcolgf) GetFunctionByName(name,rep,FTab_fcolg);
-}
-
-
-
-/** the current function fixed by setfcoldf **/
-
-static fcoldff fcoldffonc ;
-
-/** function call **/
-
-void C2F(fcoldf)(double *x, double *z, double *df)
-{
-       (*fcoldffonc)(x,z,df);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfcoldf)(char *name, int *rep)
-{
-       fcoldffonc = (fcoldff) GetFunctionByName(name,rep,FTab_fcoldf);
-}
-
-
-/** the current function fixed by setfcolf **/
-
-static fcolff fcolffonc ;
-
-/** function call **/
-
-void C2F(fcolf)(double *x, double *z, double *df)
-{
-       (*fcolffonc)(x,z,df);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfcolf)(char *name, int *rep)
-{
-       fcolffonc = (fcolff) GetFunctionByName(name,rep,FTab_fcolf);
-}
-
-/** the current function fixed by setfcolgu **/
-
-static fcolguf fcolgufonc ;
-
-/** function call **/
-
-void C2F(fcolgu)(double *x, double *z, double *dmval)
-{
-       (*fcolgufonc)(x,z,dmval);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfcolgu)(char *name, int *rep)
-{
-       fcolgufonc = (fcolguf) GetFunctionByName(name,rep,FTab_fcolgu);
-}
diff --git a/scilab/modules/differential_equations/src/c/dassltable.c b/scilab/modules/differential_equations/src/c/dassltable.c
deleted file mode 100644 (file)
index d01b8d9..0000000
+++ /dev/null
@@ -1,171 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) INRIA
- * ...
- * 
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at    
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include "GetFunctionByName.h"
-#include "machine.h"
-#include "dynlib_differential_equations.h"
-/***********************************
-* Search Table for dassl 
-***********************************/
-
-#define ARGS_fresd double *,double*,double*,double*,int*,double*,int*
-typedef int * (*fresdf)(ARGS_fresd);
-
-#define ARGS_fjacd double *,double*,double*,double*,double*,double*,int*
-typedef int * (*fjacdf)(ARGS_fjacd);
-
-/***********************************
-* Search Table for dasrt 
-***********************************/
-
-#define ARGS_fsurfd int*,double *,double*,int*,double*,double*,int*
-typedef int * (*fsurfdf)(ARGS_fsurfd);
-
-
-#define ARGS_fsurf int*,double *,double*,int*,double*
-typedef int * (*fsurff)(ARGS_fsurf);
-
-/**************** fresd ***************/
-extern void C2F(dres1)(ARGS_fresd);
-extern void C2F(dres2)(ARGS_fresd);
-extern void C2F(res1)(ARGS_fresd);
-extern void C2F(res2)(ARGS_fresd);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fresd)(ARGS_fresd);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfresd)(char *name, int *rep);
-
-FTAB FTab_fresd[] =
-{
-       {"dres1", (voidf)  C2F(dres1)},
-       {"dres2", (voidf)  C2F(dres2)},
-       {"res1", (voidf)  C2F(res1)},
-       {"res2", (voidf)  C2F(res2)},
-       {(char *) 0, (voidf) 0}
-};
-
-/**************** fjacd ***************/
-extern void C2F(djac1)(ARGS_fjacd);
-extern void C2F(djac2)(ARGS_fjacd);
-extern void C2F(jac2)(ARGS_fjacd);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fjacd)(ARGS_fjacd);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfjacd)(char *name, int *rep);
-
-FTAB FTab_fjacd[] =
-{
-       {"djac1", (voidf)  C2F(djac1)},
-       {"djac2", (voidf)  C2F(djac2)},
-       {"jac2", (voidf)  C2F(jac2)},
-       {(char *) 0, (voidf) 0}
-};
-
-
-/**************** fsurf ***************/
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fsurf)(ARGS_fsurf);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfsurf)(char *name, int *rep);
-
-FTAB FTab_fsurf[] ={
-{(char *) 0, (voidf) 0}};
-/**************** fsurfd ***************/
-extern void C2F(gr1)(ARGS_fsurfd);
-extern void C2F(gr2)(ARGS_fsurfd);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fsurfd)(ARGS_fsurfd);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfsurfd)(char *name, int *rep);
-
-FTAB FTab_fsurfd[] ={
-{"gr1", (voidf)  C2F(gr1)},
-{"gr2", (voidf)  C2F(gr2)},
-{(char *) 0, (voidf) 0}};
-
-/***********************************
-* Search Table for dassl or dassrt 
-***********************************/
-
-/** the current function fixed by setfresd **/
-
-static fresdf fresdfonc ;
-
-/** function call **/
-
-void C2F(fresd)(double *t, double *y, double *ydot, double *res, int *ires, double *rpar, int *ipar)
-{
-       (*fresdfonc)(t,y,ydot,res,ires,rpar,ipar);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfresd)(char *name, int *rep)
-{
-       fresdfonc = (fresdf) GetFunctionByName(name,rep,FTab_fresd);
-}
-
-
-/** the current function fixed by setfjacd **/
-
-static fjacdf fjacdfonc ;
-
-/** function call **/
-
-void C2F(fjacd)(double *t, double *y, double *ydot, double *pd, double *cj, double *rpar, int *ipar)
-{
-       (*fjacdfonc)(t,y,ydot,pd,cj,rpar,ipar);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfjacd)(char *name, int *rep)
-{
-       fjacdfonc = (fjacdf) GetFunctionByName(name,rep,FTab_fjacd);
-}
-
-
-/** the current function fixed by setfsurfd **/
-
-static fsurfdf fsurfdfonc ;
-
-/** function call **/
-
-
-void C2F(fsurfd)(int *neq, double *t, double *y, int *ng, double *gout, double *rpar, int *ipar)
-{
-       (*fsurfdfonc)(neq,t,y,ng,gout,rpar,ipar);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfsurfd)(char *name, int *rep)
-{
-       fsurfdfonc = (fsurfdf) GetFunctionByName(name,rep,FTab_fsurfd);
-}
-
-/***********************************
-* Search Table for dasrt ??? 
-**********************************/
-
-/** the current function fixed by setfsurf **/
-
-static fsurff fsurffonc ;
-
-/** function call **/
-
-void C2F(fsurf)(int *ny, double *t, double *y, int *ng, double *gout)
-{
-       (*fsurffonc)(ny, t, y, ng, gout) ;
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfsurf)(char *name, int *rep)
-{
-       fsurffonc = (fsurff) GetFunctionByName(name,rep,FTab_fsurf);
-}
index 82b29d6..1efb896 100644 (file)
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
   <ItemGroup>
     <Filter Include="Source Files">
diff --git a/scilab/modules/differential_equations/src/c/fevaltable.c b/scilab/modules/differential_equations/src/c/fevaltable.c
deleted file mode 100644 (file)
index 4066f59..0000000
+++ /dev/null
@@ -1,54 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) INRIA
- * ...
- * 
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at    
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include "GetFunctionByName.h"
-#include "feval.h"
-#include "dynlib_differential_equations.h"
-/***********************************
-* feval (ffeval)
-***********************************/
-
-#define ARGS_ffeval int*,double *,double *,double *,int*,char *
-typedef void (*ffevalf)(ARGS_ffeval);
-
-/**************** ffeval ***************/
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(ffeval)(ARGS_ffeval);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfeval)(char *name, int *rep);
-
-FTAB FTab_ffeval[] ={
-       {"parab", (voidf)  C2F(parab)},
-       {"parabc", (voidf)  C2F(parabc)},
-       {(char *) 0, (voidf) 0}};
-
-
-/***********************************
-* Search Table for feval 
-***********************************/
-
-/** the current function fixed by setfeval **/
-
-static ffevalf fevalfonc ;
-
-/** function call **/
-
-void C2F(ffeval)(int *nn, double *x1, double *x2, double *xres, int *itype, char *name)
-{
-       (*fevalfonc)(nn,x1,x2,xres,itype,name);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfeval)(char *name, int *rep)
-{
-       fevalfonc = (ffevalf) GetFunctionByName(name,rep,FTab_ffeval);
-}
-
diff --git a/scilab/modules/differential_equations/src/c/fydot2table.c b/scilab/modules/differential_equations/src/c/fydot2table.c
deleted file mode 100644 (file)
index bf3dcea..0000000
+++ /dev/null
@@ -1,70 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) INRIA
- * ...
- * 
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at    
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include "GetFunctionByName.h"
-#include "machine.h"
-#include "dynlib_differential_equations.h"
-
-extern int C2F(getcodc)(int *nd1, int *iflag1);
-
-/***********************************
-* Search Table for odedc
-***********************************/
-
-#define ARGS_fydot2 int*, int*,int*,double *,double*,double* 
-#define ARGS_fydot2f int *, double *, double *, double *
-typedef int * (*fydot2f)(ARGS_fydot2);
-
-
-/**************** fydot2 ***************/
-extern void C2F(fexcd)(ARGS_fydot2);
-extern void C2F(fcd)(ARGS_fydot2);
-extern void C2F(fcd1)(ARGS_fydot2);
-extern void C2F(phis)(ARGS_fydot2);
-extern void C2F(phit)(ARGS_fydot2);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fydot2)(ARGS_fydot2f);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfydot2)(char *name, int *rep);
-
-FTAB FTab_fydot2[] =
-{
-       {"fcd", (voidf)  C2F(fcd)},
-       {"fcd1", (voidf)  C2F(fcd1)},
-       {"fexcd", (voidf)  C2F(fexcd)},
-       {"phis", (voidf)  C2F(phis)},
-       {"phit", (voidf)  C2F(phit)},
-       {(char *) 0, (voidf) 0}
-};
-
-/***********************************
-* Search Table for fydot2
-***********************************/
-
-/** the current function fixed by setfydot2 **/
-
-static fydot2f fydot2fonc ;
-
-/** function call **/
-
-void C2F(fydot2)(int *n, double *t, double *y, double *ydot)
-{
-       int nd1,iflag1;
-       C2F(getcodc)(&nd1,&iflag1);
-       (*fydot2fonc)(&iflag1,n,&nd1,t,y,ydot);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfydot2)(char *name, int *rep)
-{
-       fydot2fonc = (fydot2f) GetFunctionByName(name,rep,FTab_fydot2);
-}
diff --git a/scilab/modules/differential_equations/src/c/fydottable.c b/scilab/modules/differential_equations/src/c/fydottable.c
deleted file mode 100644 (file)
index 5a6d8f4..0000000
+++ /dev/null
@@ -1,104 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) INRIA
- * ...
- * 
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at    
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include "GetFunctionByName.h"
-#include "dynlib_differential_equations.h"
-#include "arnol.h"
-       /***********************************
-       * ode   (fydot and fjac )
-       ***********************************/
-
-/**
- ** @TODO : Wow !! Lot of things to kick out..
- **/
-
-
-typedef void (*fydotf)(int*,double *,double *,double *);
-
-#define ARGS_fjac int*,double *,double *,int*,int*,double*,int*
-typedef void (*fjacf)(ARGS_fjac);
-
-/**************** fydot ***************/
-extern void C2F(fex)(int*,double *,double *,double *);
-extern void C2F(fex2)(int*,double *,double *,double *);
-extern void C2F(fex3)(int*,double *,double *,double *);
-extern void C2F(fexab)(int*,double *,double *,double *);
-extern void C2F(loren)(int*,double *,double *,double *);
-extern void C2F(bcomp)(int*,double *,double *,double *);
-extern void C2F(lcomp)(int*,double *,double *,double *);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fydot)(int*,double *,double *,double *);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfydot)(char *name, int *rep);
-
-FTAB FTab_fydot[] ={
-       {"arnol", (voidf)  C2F(arnol)},
-       {"bcomp", (voidf)  C2F(bcomp)},
-       {"fex", (voidf)  C2F(fex)},
-       {"fex2", (voidf)  C2F(fex2)},
-       {"fex3", (voidf)  C2F(fex3)},
-       {"fexab", (voidf)  C2F(fexab)},
-       {"lcomp", (voidf)  C2F(lcomp)},
-       {"loren", (voidf)  C2F(loren)},
-       {(char *) 0, (voidf) 0}};
-
-/**************** fjac ***************/
-extern void C2F(jex)(ARGS_fjac);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fjac)(ARGS_fjac);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfjac)(char *name, int *rep);
-
-FTAB FTab_fjac[] =
-{
-       {"jex", (voidf)  C2F(jex)},
-       {(char *) 0, (voidf) 0}
-};
-
-/***********************************
-* Search Table for fydot
-***********************************/
-
-/** the current function fixed by setfydot **/
-
-static fydotf fydotfonc ;
-
-/** function call **/
-
-void C2F(fydot)(int *n, double *t, double *y, double *ydot)
-{
-       (*fydotfonc)(n,t,y,ydot);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfydot)(char *name, int *rep)
-{
-       fydotfonc = (fydotf) GetFunctionByName(name,rep,FTab_fydot);
-}
-
-
-/** the current function fixed by setfjac **/
-
-static fjacf fjacfonc ;
-
-/** function call **/
-
-void C2F(fjac)(int *neq, double *t, double *y, int *ml, int *mu, double *pd, int *nrpd)
-{
-       (*fjacfonc)(neq, t, y, ml, mu, pd, nrpd);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfjac)(char *name, int *rep)
-{
-       fjacfonc = (fjacf) GetFunctionByName(name,rep,FTab_fjac);
-}
diff --git a/scilab/modules/differential_equations/src/c/impltable.c b/scilab/modules/differential_equations/src/c/impltable.c
deleted file mode 100644 (file)
index 0ab1c0a..0000000
+++ /dev/null
@@ -1,115 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) INRIA
- * ...
- * 
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at    
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include "GetFunctionByName.h"
-#include "machine.h"
-#include "dynlib_differential_equations.h"
-/***********************************
-* impl   (  fres, fadda, fj2 )
-***********************************/
-
-#define ARGS_fres int*,double *,double *,double *,double*,int*
-typedef void (*fresf)(ARGS_fres);
-
-
-#define ARGS_fadda int*,double *,double *,int*,int*,double*,int*
-typedef void (*faddaf)(ARGS_fadda);
-
-#define ARGS_fj2 int *,double *,double *,double *,int *,int *,double*,int *
-typedef void (*fj2f)(ARGS_fj2);
-
-/**************** fres ***************/
-extern void C2F(resid)(ARGS_fres);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fres)(ARGS_fres);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfres)(char *name, int *rep);
-
-FTAB FTab_fres[] ={
-       {"resid", (voidf)  C2F(resid)},
-       {(char *) 0, (voidf) 0}};
-/**************** fadda ***************/
-extern void C2F(aplusp)(ARGS_fadda);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fadda)(ARGS_fadda);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfadda)(char *name, int *rep);
-
-FTAB FTab_fadda[] ={
-{"aplusp", (voidf)  C2F(aplusp)},
-{(char *) 0, (voidf) 0}};
-
-/**************** fj2 ***************/
-extern void C2F(dgbydy)(ARGS_fj2);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fj2)(ARGS_fj2);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfj2)(char *name, int *rep);
-
-FTAB FTab_fj2[] ={
-       {"dgbydy", (voidf)  C2F(dgbydy)},
-       {(char *) 0, (voidf) 0}};
-
-/***********************************
-* Search Table for impl 
-***********************************/
-
-/** the current function fixed by setfres **/
-
-static fresf fresfonc ;
-
-/** function call **/
-
-void C2F(fres)(int *ny, double *t, double *y, double *s, double *r, int *ires)
-{
-       (*fresfonc)(ny,t,y,s,r,ires);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfres)(char *name, int *rep)
-{
-       fresfonc = (fresf) GetFunctionByName(name,rep,FTab_fres);
-}
-
-
-/** the current function fixed by setfadda **/
-
-static faddaf faddafonc ;
-
-void C2F(fadda)(int *ny, double *t, double *y, int *ml, int *mu, double *p, int *nrowp)
-{
-       (*faddafonc)(ny,t,y,ml,mu,p,nrowp);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfadda)(char *name, int *rep)
-{
-       faddafonc = (faddaf) GetFunctionByName(name,rep,FTab_fadda);
-}
-
-
-/** the current function fixed by setfj2 **/
-
-static fj2f fj2fonc ;
-
-/** function call **/
-
-void C2F(fj2)(int *ny, double *t, double *y, double *s, int *ml, int *mu, double *p, int *nrowp)
-{
-       (*fj2fonc)(ny,t,y,s,ml,mu,p,nrowp);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfj2)(char *name, int *rep)
-{
-       fj2fonc = (fj2f) GetFunctionByName(name,rep,FTab_fj2);
-}
diff --git a/scilab/modules/differential_equations/src/c/int2dtable.c b/scilab/modules/differential_equations/src/c/int2dtable.c
deleted file mode 100644 (file)
index bd17aee..0000000
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) INRIA
- * ...
- * 
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at    
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include "GetFunctionByName.h"
-#include "machine.h"
-#include "dynlib_differential_equations.h"
-/***********************************
-* Search Table for int2d
-***********************************/
-
-#define ARGS_fint2d double *,double *
-typedef double * (*fint2df)(ARGS_fint2d);
-
-/**************** fint2d ***************/
-extern void C2F(int2dex)(ARGS_fint2d);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP double *C2F(fint2d)(ARGS_fint2d);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfint2d)(char *name, int *rep);
-
-FTAB FTab_fint2d[] =
-{
-       {"int2dex", (voidf)  C2F(int2dex)},
-       {(char *) 0, (voidf) 0}
-};
-
-/***********************************
-* Search Table for int2d
-*    uses : fint2d
-***********************************/
-
-/** the current function fixed by setfint2d **/
-
-static fint2df fint2dfonc ;
-
-/** function call : WARNING fintg returns a double  **/
-
-double *C2F(fint2d)(double *x, double *y)
-{
-       return((*fint2dfonc)(x,y));
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfint2d)(char *name, int *rep)
-{
-       fint2dfonc = (fint2df) GetFunctionByName(name,rep,FTab_fint2d);
-}
diff --git a/scilab/modules/differential_equations/src/c/int3dtable.c b/scilab/modules/differential_equations/src/c/int3dtable.c
deleted file mode 100644 (file)
index c700fb1..0000000
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) INRIA
- * ...
- * 
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at    
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include "GetFunctionByName.h"
-#include "machine.h"
-#include "dynlib_differential_equations.h"
-/***********************************
-* Search Table for int3d
-***********************************/
-
-#define ARGS_fint3d double *,int*,double *
-typedef void (*fint3df)(ARGS_fint3d);
-
-/**************** fint3d ***************/
-extern void C2F(int3dex)(ARGS_fint3d);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(fint3d)(ARGS_fint3d);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfint3d)(char *name, int *rep);
-
-FTAB FTab_fint3d[] =
-{
-       {"int3dex", (voidf)  C2F(int3dex)},
-       {(char *) 0, (voidf) 0}
-};
-
-
-/***********************************
-* Search Table for int3d
-*    uses : fint3d
-***********************************/
-
-/** the current function fixed by setfint3d **/
-
-static fint3df fint3dfonc ;
-
-/** function call : WARNING fintg returns a double  **/
-
-void C2F(fint3d)(double *xyz, int *numfun, double *v)
-{
-       (*fint3dfonc)(xyz,numfun,v);
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfint3d)(char *name, int *rep)
-{
-       fint3dfonc = (fint3df) GetFunctionByName(name,rep,FTab_fint3d);
-}
diff --git a/scilab/modules/differential_equations/src/c/intgtable.c b/scilab/modules/differential_equations/src/c/intgtable.c
deleted file mode 100644 (file)
index 7127c5e..0000000
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) INRIA
- * ...
- * 
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at    
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include "GetFunctionByName.h"
-#include "machine.h"
-#include "dynlib_differential_equations.h"
-#define ARGS_fintg double *
-
-/**************** fintg ***************/
-extern void C2F(intgex)(ARGS_fintg);
-
-DIFFERENTIAL_EQUATIONS_IMPEXP double *C2F(fintg)(ARGS_fintg);
-DIFFERENTIAL_EQUATIONS_IMPEXP void C2F(setfintg)(char *name, int *rep);
-
-FTAB FTab_fintg[] ={
-       {"intgex", (voidf)  C2F(intgex)},
-       {(char *) 0, (voidf) 0}};
-
-/***********************************
-* Search Table for intg 
-***********************************/
-
-typedef double * (*fintgf)(ARGS_fintg);
-
-/***********************************
-* Search Table for intg 
-*    uses : fintg 
-***********************************/
-
-/** the current function fixed by setfintg **/
-
-static fintgf fintgfonc ;
-
-/** function call : WARNING fintg returns a double  **/
-
-double *C2F(fintg)(double *x)
-{
-       return((*fintgfonc)(x));
-}
-
-/** fixes the function associated to name **/
-
-void C2F(setfintg)(char *name, int *rep)
-{
-       fintgfonc = (fintgf) GetFunctionByName(name,rep,FTab_fintg);
-}
index 5cf2b27..3d164af 100644 (file)
@@ -13,19 +13,14 @@ rk4_
 fcolg_
 fcolf_
 fcoldf_
-fcolgu_
-ffeval_
 setfres_
 setfadda_
 fcoldg_
 setfint2d_
-fint3d_
-setfj2_
 fj2_
 fadda_
 fevalname_
 bcompc_
-setfeval_
 setfresd_
 dassln_
 fres_
@@ -33,21 +28,12 @@ dassl_
 setfjacd_
 setfsurfd_
 setfcolgu_
-fjac_
-fjacd_
-fresd_
 setfcoldg_
 setfcolg_
 setfcoldf_
 setfcolf_
 setfintg_
-fintg_
 setfint3d_
-fint2d_
-fydot2_
-fydot_
-fsurfd_
-fsurf_
 colmsh_
 colsid_
 colest_
index 9e80a05..dbc8c29 100644 (file)
@@ -272,31 +272,15 @@ cd ..
     </Link>
   </ItemDefinitionGroup>
   <ItemGroup>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_bvode.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_dasrt.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_dassl.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_feval.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_impl.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_ode.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_odedc.c" />
     <ClCompile Include="ainvg.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\badd.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\bbvode.c" />
     <ClCompile Include="bcomp.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\bfeval.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\bint2d.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\bint3d.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\bintg.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\bj2.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\bjac.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\bjacd.c" />
     <ClCompile Include="bnorm.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\bresd.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\bresid.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\bsurf.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\bsurfd.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\bydot.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\bydot2.c" />
     <ClCompile Include="cfode.c" />
     <ClCompile Include="colnew.c" />
     <ClCompile Include="..\c\commons_f2c.c" />
@@ -321,10 +305,7 @@ cd ..
     <ClCompile Include="greatr.c" />
     <ClCompile Include="hpdel.c" />
     <ClCompile Include="hpins.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\int2d.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\int3d.c" />
     <ClCompile Include="intdy.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\intg.c" />
     <ClCompile Include="lcomp.c" />
     <ClCompile Include="loren.c" />
     <ClCompile Include="lsdisc.c" />
@@ -365,31 +346,15 @@ cd ..
     <ClCompile Include="xsetun.c" />
   </ItemGroup>
   <ItemGroup>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_bvode.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_dasrt.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_dassl.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_feval.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_impl.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_ode.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_odedc.f" />
     <f2c_rule Include="ainvg.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\badd.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\bbvode.f" />
     <f2c_rule Include="bcomp.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\bfeval.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\bint2d.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\bint3d.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\bintg.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\bj2.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\bjac.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\bjacd.f" />
     <f2c_rule Include="bnorm.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\bresd.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\bresid.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\bsurf.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\bsurfd.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\bydot.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\bydot2.f" />
     <f2c_rule Include="cfode.f" />
     <f2c_rule Include="colnew.f" />
     <f2c_rule Include="dcutet.f" />
@@ -413,10 +378,7 @@ cd ..
     <f2c_rule Include="greatr.f" />
     <f2c_rule Include="hpdel.f" />
     <f2c_rule Include="hpins.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\int2d.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\int3d.f" />
     <f2c_rule Include="intdy.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\intg.f" />
     <f2c_rule Include="lcomp.f" />
     <f2c_rule Include="loren.f" />
     <f2c_rule Include="lsdisc.f" />
index 5ae7a5a..e7a4666 100644 (file)
     <ClCompile Include="..\..\sci_gateway\fortran\badd.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\bbvode.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="bcomp.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\bfeval.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\bint2d.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\bj2.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\bjac.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\bjacd.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="bnorm.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\bresd.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\bresid.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\bsurf.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\bsurfd.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\bydot.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\bydot2.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="cfode.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="hpins.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\int2d.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\int3d.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="intdy.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\intg.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="lcomp.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="xsetun.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_bvode.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_dasrt.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_dassl.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_feval.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_impl.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_ode.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_odedc.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
   </ItemGroup>
   <ItemGroup>
     <f2c_rule Include="ainvg.f">
     <f2c_rule Include="..\..\sci_gateway\fortran\badd.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\bbvode.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="bcomp.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\bfeval.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\bint2d.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\bj2.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\bjac.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\bjacd.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="bnorm.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\bresd.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\bresid.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\bsurf.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\bsurfd.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\bydot.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\bydot2.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="cfode.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="hpins.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\int2d.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\int3d.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="intdy.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\intg.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="lcomp.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="xsetun.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_bvode.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_dasrt.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_dassl.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_feval.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_impl.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_ode.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_odedc.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
   </ItemGroup>
   <ItemGroup>
     <None Include="differential_equations_Import.def">
index e3c822e..4c0b397 100644 (file)
@@ -2,11 +2,11 @@
 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
 * Copyright (C) INRIA/ENPC
 * Copyright (C) DIGITEO - 2011 - Allan CORNET
-* 
+*
 * This file must be used under the terms of the CeCILL.
 * This source file is licensed as described in the file COPYING, which
 * you should have received as part of this distribution.  The terms
-* are also available at    
+* are also available at
 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
 *
 */
@@ -17,7 +17,7 @@
 
 extern "C"
 {
-#include <string.h> 
+#include <string.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include "dynamic_link.h"
@@ -35,6 +35,23 @@ extern "C"
 #ifdef _MSC_VER
 #include "getenvc.h"
 #include "dllinfo.h"
+
+/* struct used by fortran (F2C) */
+/* required to be defined in C */
+
+typedef struct {
+    char name[nlgh+1];
+} CINTER_struct;
+
+__declspec (dllexport) CINTER_struct C2F(cinter);
+
+/* struct used by fortran (F2C) */
+/* required to be defined in C */
+typedef struct {
+    int ibuf[lsiz];
+} IBFU_struct;
+__declspec (dllexport) CINTER_struct C2F(ibfu);
+
 #endif
 #include "getshortpathname.h"
 #include "BOOL.h"
index e802963..4e72115 100644 (file)
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
   <ItemGroup Label="ProjectConfigurations">
     <ProjectConfiguration Include="Debug|Win32">
@@ -95,7 +95,7 @@ lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform
 </Command>
     </PreLinkEvent>
     <Link>
-      <AdditionalDependencies>core_f.lib;cacsd_f.lib;eispack_f.lib;linpack_f.lib;elementary_functions_f.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\ifconsol.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libifcoremdd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libmmdd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>core_f.lib;cacsd_f.lib;eispack_f.lib;linpack_f.lib;elementary_functions_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <GenerateDebugInformation>true</GenerateDebugInformation>
       <SubSystem>Windows</SubSystem>
@@ -129,7 +129,7 @@ lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform
 </Command>
     </PreLinkEvent>
     <Link>
-      <AdditionalDependencies>core_f.lib;cacsd_f.lib;eispack_f.lib;linpack_f.lib;elementary_functions_f.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\ifconsol.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libifcoremdd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libmmdd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>core_f.lib;cacsd_f.lib;eispack_f.lib;linpack_f.lib;elementary_functions_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <GenerateDebugInformation>true</GenerateDebugInformation>
       <SubSystem>Windows</SubSystem>
@@ -161,7 +161,7 @@ lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform
 </Command>
     </PreLinkEvent>
     <Link>
-      <AdditionalDependencies>core_f.lib;cacsd_f.lib;eispack_f.lib;linpack_f.lib;elementary_functions_f.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\ifconsol.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libifcoremd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libmmd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>core_f.lib;cacsd_f.lib;eispack_f.lib;linpack_f.lib;elementary_functions_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <GenerateDebugInformation>true</GenerateDebugInformation>
       <SubSystem>Windows</SubSystem>
@@ -198,7 +198,7 @@ lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform
 </Command>
     </PreLinkEvent>
     <Link>
-      <AdditionalDependencies>core_f.lib;cacsd_f.lib;eispack_f.lib;linpack_f.lib;elementary_functions_f.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\ifconsol.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libifcoremd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libmmd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>core_f.lib;cacsd_f.lib;eispack_f.lib;linpack_f.lib;elementary_functions_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <GenerateDebugInformation>true</GenerateDebugInformation>
       <SubSystem>Windows</SubSystem>
index b570549..45de153 100644 (file)
@@ -84,7 +84,7 @@
       <CallingConvention>Cdecl</CallingConvention>
     </ClCompile>
     <Link>
-      <AdditionalDependencies>$(IFORT_COMPILER12)\compiler\lib\ia32\ifconsol.lib;elementary_functions_f.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libifcoremdd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libmmdd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>elementary_functions_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <IgnoreSpecificDefaultLibraries>%(IgnoreSpecificDefaultLibraries)</IgnoreSpecificDefaultLibraries>
       <GenerateDebugInformation>true</GenerateDebugInformation>
       <CallingConvention>Cdecl</CallingConvention>
     </ClCompile>
     <Link>
-      <AdditionalDependencies>$(IFORT_COMPILER12)\compiler\lib\intel64\ifconsol.lib;elementary_functions_f.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libifcoremdd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libmmdd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>elementary_functions_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <IgnoreSpecificDefaultLibraries>%(IgnoreSpecificDefaultLibraries)</IgnoreSpecificDefaultLibraries>
       <GenerateDebugInformation>true</GenerateDebugInformation>
       <MultiProcessorCompilation>true</MultiProcessorCompilation>
     </ClCompile>
     <Link>
-      <AdditionalDependencies>$(IFORT_COMPILER12)\compiler\lib\ia32\ifconsol.lib;elementary_functions_f.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libifcoremd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libmmd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\svml_disp.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libiomp5md.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>elementary_functions_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <IgnoreSpecificDefaultLibraries>%(IgnoreSpecificDefaultLibraries)</IgnoreSpecificDefaultLibraries>
       <RandomizedBaseAddress>false</RandomizedBaseAddress>
       <MultiProcessorCompilation>true</MultiProcessorCompilation>
     </ClCompile>
     <Link>
-      <AdditionalDependencies>$(IFORT_COMPILER12)\compiler\lib\intel64\ifconsol.lib;elementary_functions_f.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libifcoremd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libmmd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\svml_disp.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libiomp5md.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>elementary_functions_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <IgnoreSpecificDefaultLibraries>%(IgnoreSpecificDefaultLibraries)</IgnoreSpecificDefaultLibraries>
       <TargetMachine>MachineX64</TargetMachine>
index 3303238..ef25560 100644 (file)
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
   <ItemGroup Label="ProjectConfigurations">
     <ProjectConfiguration Include="Debug|Win32">
@@ -89,7 +89,9 @@ lib /DEF:"$(ProjectDir)linpack_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platf
 lib /DEF:"$(ProjectDir)slatec_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)slatec_f.lib" 1&gt;NUL 2&gt;NUL
 lib /DEF:"$(ProjectDir)polynomials_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)polynomials_f.lib" 1&gt;NUL 2&gt;NUL
 lib /DEF:"$(ProjectDir)eispack_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)eispack_f.lib" 1&gt;NUL 2&gt;NUL
-lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)core_f.lib" 1&gt;NUL 2&gt;NUL</Command>
+lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)core_f.lib" 1&gt;NUL 2&gt;NUL
+lib /DEF:"$(ProjectDir)elementary_functions_gw_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)elementary_functions_gw.lib" 1&gt;NUL 2&gt;NUL
+</Command>
     </PreBuildEvent>
     <ClCompile>
       <Optimization>Disabled</Optimization>
@@ -112,7 +114,7 @@ cd ..
     </PreLinkEvent>
     <Link>
       <AdditionalOptions>/ignore:4049 %(AdditionalOptions)</AdditionalOptions>
-      <AdditionalDependencies>core.lib;elementary_functions.lib;string.lib;integer.lib;output_stream.lib;cacsd_f.lib;polynomials_f.lib;sparse_f.lib;eispack_f.lib;linpack_f.lib;slatec_f.lib;core_f.lib;../../../../bin/blasplus.lib;../../../../bin/lapack.lib;../../../../bin/libf2c.lib</AdditionalDependencies>
+      <AdditionalDependencies>core.lib;elementary_functions_gw.lib;elementary_functions.lib;string.lib;integer.lib;output_stream.lib;cacsd_f.lib;polynomials_f.lib;sparse_f.lib;eispack_f.lib;linpack_f.lib;slatec_f.lib;core_f.lib;../../../../bin/blasplus.lib;../../../../bin/lapack.lib;../../../../bin/libf2c.lib</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <ModuleDefinitionFile>elementary_functions_f.def</ModuleDefinitionFile>
       <GenerateDebugInformation>true</GenerateDebugInformation>
@@ -139,6 +141,7 @@ lib /DEF:"$(ProjectDir)slatec_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platfo
 lib /DEF:"$(ProjectDir)polynomials_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)polynomials_f.lib" 1&gt;NUL 2&gt;NUL
 lib /DEF:"$(ProjectDir)eispack_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)eispack_f.lib" 1&gt;NUL 2&gt;NUL
 lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)core_f.lib" 1&gt;NUL 2&gt;NUL</Command>
+lib /DEF:"$(ProjectDir)elementary_functions_gw_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)elementary_functions_gw.lib" 1&gt;NUL 2&gt;NUL
     </PreBuildEvent>
     <Midl>
       <TargetEnvironment>X64</TargetEnvironment>
@@ -164,7 +167,7 @@ cd ..
     </PreLinkEvent>
     <Link>
       <AdditionalOptions>/ignore:4049 %(AdditionalOptions)</AdditionalOptions>
-      <AdditionalDependencies>core.lib;elementary_functions.lib;string.lib;integer.lib;output_stream.lib;cacsd_f.lib;polynomials_f.lib;sparse_f.lib;eispack_f.lib;linpack_f.lib;slatec_f.lib;core_f.lib;../../../../bin/blasplus.lib;../../../../bin/lapack.lib;../../../../bin/libf2c.lib</AdditionalDependencies>
+      <AdditionalDependencies>core.lib;elementary_functions_gw.lib;elementary_functions.lib;string.lib;integer.lib;output_stream.lib;cacsd_f.lib;polynomials_f.lib;sparse_f.lib;eispack_f.lib;linpack_f.lib;slatec_f.lib;core_f.lib;../../../../bin/blasplus.lib;../../../../bin/lapack.lib;../../../../bin/libf2c.lib</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <ModuleDefinitionFile>elementary_functions_f.def</ModuleDefinitionFile>
       <GenerateDebugInformation>true</GenerateDebugInformation>
@@ -190,7 +193,9 @@ lib /DEF:"$(ProjectDir)linpack_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platf
 lib /DEF:"$(ProjectDir)slatec_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)slatec_f.lib" 1&gt;NUL 2&gt;NUL
 lib /DEF:"$(ProjectDir)polynomials_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)polynomials_f.lib" 1&gt;NUL 2&gt;NUL
 lib /DEF:"$(ProjectDir)eispack_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)eispack_f.lib" 1&gt;NUL 2&gt;NUL
-lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)core_f.lib" 1&gt;NUL 2&gt;NUL</Command>
+lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)core_f.lib" 1&gt;NUL 2&gt;NUL
+lib /DEF:"$(ProjectDir)elementary_functions_gw_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)elementary_functions_gw.lib" 1&gt;NUL 2&gt;NUL
+</Command>
     </PreBuildEvent>
     <ClCompile>
       <WholeProgramOptimization>false</WholeProgramOptimization>
@@ -214,7 +219,7 @@ cd ..
     </PreLinkEvent>
     <Link>
       <AdditionalOptions>/ignore:4049 %(AdditionalOptions)</AdditionalOptions>
-      <AdditionalDependencies>core.lib;elementary_functions.lib;string.lib;integer.lib;output_stream.lib;cacsd_f.lib;polynomials_f.lib;sparse_f.lib;eispack_f.lib;linpack_f.lib;slatec_f.lib;core_f.lib;../../../../bin/blasplus.lib;../../../../bin/lapack.lib;../../../../bin/libf2c.lib</AdditionalDependencies>
+      <AdditionalDependencies>core.lib;elementary_functions_gw.lib;elementary_functions.lib;string.lib;integer.lib;output_stream.lib;cacsd_f.lib;polynomials_f.lib;sparse_f.lib;eispack_f.lib;linpack_f.lib;slatec_f.lib;core_f.lib;../../../../bin/blasplus.lib;../../../../bin/lapack.lib;../../../../bin/libf2c.lib</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <ModuleDefinitionFile>elementary_functions_f.def</ModuleDefinitionFile>
       <GenerateDebugInformation>true</GenerateDebugInformation>
@@ -243,6 +248,7 @@ lib /DEF:"$(ProjectDir)slatec_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platfo
 lib /DEF:"$(ProjectDir)polynomials_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)polynomials_f.lib" 1&gt;NUL 2&gt;NUL
 lib /DEF:"$(ProjectDir)eispack_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)eispack_f.lib" 1&gt;NUL 2&gt;NUL
 lib /DEF:"$(ProjectDir)core_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)core_f.lib" 1&gt;NUL 2&gt;NUL</Command>
+lib /DEF:"$(ProjectDir)elementary_functions_gw_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(Platform) /OUT:"$(ProjectDir)elementary_functions_gw.lib" 1&gt;NUL 2&gt;NUL
     </PreBuildEvent>
     <Midl>
       <TargetEnvironment>X64</TargetEnvironment>
@@ -269,7 +275,7 @@ cd ..
     </PreLinkEvent>
     <Link>
       <AdditionalOptions>/ignore:4049 %(AdditionalOptions)</AdditionalOptions>
-      <AdditionalDependencies>core.lib;elementary_functions.lib;string.lib;integer.lib;output_stream.lib;cacsd_f.lib;polynomials_f.lib;sparse_f.lib;eispack_f.lib;linpack_f.lib;slatec_f.lib;core_f.lib;../../../../bin/blasplus.lib;../../../../bin/lapack.lib;../../../../bin/libf2c.lib</AdditionalDependencies>
+      <AdditionalDependencies>core.lib;elementary_functions_gw.lib;elementary_functions.lib;string.lib;integer.lib;output_stream.lib;cacsd_f.lib;polynomials_f.lib;sparse_f.lib;eispack_f.lib;linpack_f.lib;slatec_f.lib;core_f.lib;../../../../bin/blasplus.lib;../../../../bin/lapack.lib;../../../../bin/libf2c.lib</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <ModuleDefinitionFile>elementary_functions_f.def</ModuleDefinitionFile>
       <GenerateDebugInformation>true</GenerateDebugInformation>
@@ -294,8 +300,6 @@ cd ..
     <ClCompile Include="corth.c" />
     <ClCompile Include="cortr.c" />
     <ClCompile Include="coshin.c" />
-    <ClCompile Include="cupro.c" />
-    <ClCompile Include="cuproi.c" />
     <ClCompile Include="cusum.c" />
     <ClCompile Include="d1mach.c" />
     <ClCompile Include="dad.c" />
@@ -315,9 +319,7 @@ cd ..
     <ClCompile Include="dmmul.c" />
     <ClCompile Include="dmmul1.c" />
     <ClCompile Include="dmprod.c" />
-    <ClCompile Include="dmsum.c" />
     <ClCompile Include="drdiv.c" />
-    <ClCompile Include="dsearch.c" />
     <ClCompile Include="dset.c" />
     <ClCompile Include="dsort.c" />
     <ClCompile Include="dsum.c" />
@@ -352,10 +354,10 @@ cd ..
     <ClCompile Include="magic.c" />
     <ClCompile Include="mtran.c" />
     <ClCompile Include="nearfloat.c" />
+    <ClCompile Include="old_pythag.c" />
     <ClCompile Include="orthes.c" />
     <ClCompile Include="ortran.c" />
     <ClCompile Include="psi.c" />
-    <ClCompile Include="pythag.c" />
     <ClCompile Include="rat.c" />
     <ClCompile Include="rcopy.c" />
     <ClCompile Include="rcsort.c" />
@@ -369,10 +371,8 @@ cd ..
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_clean.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_conj.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_cos.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_cumprod.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_cumsum.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_diag.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_dsearch.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_exp.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_expm.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_eye.c" />
@@ -381,7 +381,6 @@ cd ..
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_imag.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_imult.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_int.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_isequal.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_isreal.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_kron.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_log.c" />
@@ -401,7 +400,6 @@ cd ..
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_size.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_spones.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_sqrt.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_sum.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_tan.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_testmatrix.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_tril.c" />
@@ -461,8 +459,6 @@ cd ..
     <f2c_rule Include="corth.f" />
     <f2c_rule Include="cortr.f" />
     <f2c_rule Include="coshin.f" />
-    <f2c_rule Include="cupro.f" />
-    <f2c_rule Include="cuproi.f" />
     <f2c_rule Include="cusum.f" />
     <f2c_rule Include="d1mach.f" />
     <f2c_rule Include="dad.f" />
@@ -482,9 +478,7 @@ cd ..
     <f2c_rule Include="dmmul.f" />
     <f2c_rule Include="dmmul1.f" />
     <f2c_rule Include="dmprod.f" />
-    <f2c_rule Include="dmsum.f" />
     <f2c_rule Include="drdiv.f" />
-    <f2c_rule Include="dsearch.f" />
     <f2c_rule Include="dset.f" />
     <f2c_rule Include="dsort.f" />
     <f2c_rule Include="dsum.f" />
@@ -519,10 +513,10 @@ cd ..
     <f2c_rule Include="magic.f" />
     <f2c_rule Include="mtran.f" />
     <f2c_rule Include="nearfloat.f" />
+    <f2c_rule Include="old_pythag.f" />
     <f2c_rule Include="orthes.f" />
     <f2c_rule Include="ortran.f" />
     <f2c_rule Include="psi.f" />
-    <f2c_rule Include="pythag.f" />
     <f2c_rule Include="rat.f" />
     <f2c_rule Include="rcopy.f" />
     <f2c_rule Include="rcsort.f" />
@@ -536,10 +530,8 @@ cd ..
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_clean.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_conj.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_cos.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_cumprod.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_cumsum.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_diag.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_dsearch.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_exp.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_expm.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_eye.f" />
@@ -548,7 +540,6 @@ cd ..
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_imag.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_imult.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_int.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_isequal.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_isreal.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_kron.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_log.f" />
@@ -568,7 +559,6 @@ cd ..
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_size.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_spones.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_sqrt.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_sum.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_tan.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_testmatrix.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_tril.f" />
@@ -621,6 +611,7 @@ cd ..
     <None Include="cacsd_f_Import.def" />
     <None Include="Core_f_Import.def" />
     <None Include="eispack_f_Import.def" />
+    <None Include="elementary_functions_gw_Import.def" />
     <None Include="elementary_functions_Import.def" />
     <None Include="Integer_Import.def" />
     <None Include="core_import.def" />
index 11cf52f..b768621 100644 (file)
     <ClCompile Include="coshin.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="cupro.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
-    <ClCompile Include="cuproi.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="cusum.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="dmprod.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="dmsum.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="drdiv.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="dsearch.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="dset.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="psi.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="pythag.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="rat.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_cos.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_cumprod.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_cumsum.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_diag.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_dsearch.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_exp.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_int.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_isequal.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_isreal.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_sqrt.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_sum.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_tan.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <ClCompile Include="wwrdiv.c">
       <Filter>Source Files</Filter>
     </ClCompile>
+    <ClCompile Include="old_pythag.c">
+      <Filter>Source Files</Filter>
+    </ClCompile>
   </ItemGroup>
   <ItemGroup>
     <f2c_rule Include="arcosh.f">
     <f2c_rule Include="coshin.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="cupro.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
-    <f2c_rule Include="cuproi.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="cusum.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="dmprod.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="dmsum.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="drdiv.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="dsearch.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="dset.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="psi.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="pythag.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="rat.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_cos.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_cumprod.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_cumsum.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_diag.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_dsearch.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_exp.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_int.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_isequal.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_isreal.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_sqrt.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_sum.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_tan.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
     <f2c_rule Include="wwrdiv.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
+    <f2c_rule Include="old_pythag.f">
+      <Filter>Fortran files</Filter>
+    </f2c_rule>
   </ItemGroup>
   <ItemGroup>
     <None Include="elementary_functions_Import.def">
     <None Include="Core_f_Import.def">
       <Filter>Libraries Dependencies</Filter>
     </None>
+    <None Include="elementary_functions_gw_Import.def">
+      <Filter>Libraries Dependencies</Filter>
+    </None>
   </ItemGroup>
 </Project>
\ No newline at end of file
index f9bd0bb..7411eb9 100644 (file)
@@ -19,6 +19,7 @@
 #include "os_wcsdup.h"
 /*--------------------------------------------------------------------------*/
 #ifdef _MSC_VER
+       #include <Windows.h> /* GetShortPathNameW */
        #ifndef MAX_PATH_SHORT
                #define MAX_PATH_SHORT 260
        #endif
index d61376f..6782361 100644 (file)
@@ -268,14 +268,12 @@ cd ..
     </Link>
   </ItemDefinitionGroup>
   <ItemGroup>
-    <ClCompile Include="..\..\sci_gateway\fortran\intdeff.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\intexec.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\intexecstr.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\intlib.c" />
     <ClCompile Include="whereis.c" />
   </ItemGroup>
   <ItemGroup>
-    <f2c_rule Include="..\..\sci_gateway\fortran\intdeff.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\intexec.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\intexecstr.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\intlib.f" />
index ba83073..5e3bca2 100644 (file)
@@ -21,9 +21,6 @@
     </Filter>
   </ItemGroup>
   <ItemGroup>
-    <ClCompile Include="..\..\sci_gateway\fortran\intdeff.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\intexec.c">
       <Filter>Source Files</Filter>
     </ClCompile>
@@ -38,9 +35,6 @@
     </ClCompile>
   </ItemGroup>
   <ItemGroup>
-    <f2c_rule Include="..\..\sci_gateway\fortran\intdeff.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\intexec.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
index b43b5dc..13eae65 100644 (file)
@@ -72,7 +72,7 @@
     <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">$(SolutionDir)bin\</OutDir>
     <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">$(ProjectDir)$(Configuration)\</IntDir>
     <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
-    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">(ProjectName)</TargetName>
+    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">$(ProjectName)</TargetName>
     <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">$(ProjectName)</TargetName>
     <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">$(ProjectName)</TargetName>
     <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|x64'">$(ProjectName)</TargetName>
index 41e63c1..c10fd4f 100644 (file)
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
   <ItemGroup Label="ProjectConfigurations">
     <ProjectConfiguration Include="Debug|Win32">
@@ -281,7 +281,6 @@ cd ..
       <CompileAs Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">CompileAsC</CompileAs>
     </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\intwrite4b.c" />
-    <ClCompile Include="newsave.c" />
     <ClCompile Include="v2cunit.c" />
     <ClCompile Include="v2unit.c" />
   </ItemGroup>
@@ -292,7 +291,6 @@ cd ..
     <f2c_rule Include="..\..\sci_gateway\fortran\intwritb.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\intwrite.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\intwrite4b.f" />
-    <f2c_rule Include="newsave.f" />
     <f2c_rule Include="v2cunit.f" />
     <f2c_rule Include="v2unit.f" />
   </ItemGroup>
index 841564b..49e5f55 100644 (file)
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
   <ItemGroup>
     <Filter Include="Source Files">
@@ -39,9 +39,6 @@
     <ClCompile Include="..\..\sci_gateway\fortran\intwrite4b.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="newsave.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="v2cunit.c">
       <Filter>Source Files</Filter>
     </ClCompile>
@@ -68,9 +65,6 @@
     <f2c_rule Include="..\..\sci_gateway\fortran\intwrite4b.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
-    <f2c_rule Include="newsave.f">
-      <Filter>Fortran files</Filter>
-    </f2c_rule>
     <f2c_rule Include="v2cunit.f">
       <Filter>Fortran files</Filter>
     </f2c_rule>
index b037541..ce80b1d 100644 (file)
@@ -94,7 +94,7 @@ lib /DEF:"$(ProjectDir)polynomials_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(P
 </Command>
     </PreLinkEvent>
     <Link>
-      <AdditionalDependencies>scilocalization.lib;linear_algebra_f.lib;elementary_functions_f.lib;polynomials_f.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\ifconsol.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libifcoremdd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libmmdd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>scilocalization.lib;linear_algebra_f.lib;elementary_functions_f.lib;polynomials_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <IgnoreSpecificDefaultLibraries>%(IgnoreSpecificDefaultLibraries)</IgnoreSpecificDefaultLibraries>
       <GenerateDebugInformation>true</GenerateDebugInformation>
@@ -128,7 +128,7 @@ lib /DEF:"$(ProjectDir)polynomials_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(P
 </Command>
     </PreLinkEvent>
     <Link>
-      <AdditionalDependencies>scilocalization.lib;linear_algebra_f.lib;elementary_functions_f.lib;polynomials_f.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\ifconsol.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libifcoremdd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libmmdd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>scilocalization.lib;linear_algebra_f.lib;elementary_functions_f.lib;polynomials_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <IgnoreSpecificDefaultLibraries>%(IgnoreSpecificDefaultLibraries)</IgnoreSpecificDefaultLibraries>
       <GenerateDebugInformation>true</GenerateDebugInformation>
@@ -160,7 +160,7 @@ lib /DEF:"$(ProjectDir)polynomials_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(P
 </Command>
     </PreLinkEvent>
     <Link>
-      <AdditionalDependencies>scilocalization.lib;linear_algebra_f.lib;elementary_functions_f.lib;polynomials_f.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\ifconsol.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libifcoremd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libmmd.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\ia32\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>scilocalization.lib;linear_algebra_f.lib;elementary_functions_f.lib;polynomials_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <IgnoreSpecificDefaultLibraries>%(IgnoreSpecificDefaultLibraries)</IgnoreSpecificDefaultLibraries>
       <GenerateDebugInformation>true</GenerateDebugInformation>
@@ -197,7 +197,7 @@ lib /DEF:"$(ProjectDir)polynomials_f_Import.def" /SUBSYSTEM:WINDOWS /MACHINE:$(P
 </Command>
     </PreLinkEvent>
     <Link>
-      <AdditionalDependencies>scilocalization.lib;linear_algebra_f.lib;elementary_functions_f.lib;polynomials_f.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\ifconsol.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libifcoremd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libmmd.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\libirc.lib;$(IFORT_COMPILER12)\compiler\lib\intel64\svml_disp.lib;%(AdditionalDependencies)</AdditionalDependencies>
+      <AdditionalDependencies>scilocalization.lib;linear_algebra_f.lib;elementary_functions_f.lib;polynomials_f.lib;%(AdditionalDependencies)</AdditionalDependencies>
       <OutputFile>$(SolutionDir)bin\$(ProjectName).dll</OutputFile>
       <IgnoreSpecificDefaultLibraries>%(IgnoreSpecificDefaultLibraries)</IgnoreSpecificDefaultLibraries>
       <GenerateDebugInformation>true</GenerateDebugInformation>
index 369f95e..7567127 100644 (file)
@@ -279,10 +279,7 @@ cd ..
     <ClCompile Include="fmt.c" />
     <ClCompile Include="fmttyp.c" />
     <ClCompile Include="formatnumber.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\intdisp.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\intprint.c" />
     <ClCompile Include="lspdsp.c" />
-    <ClCompile Include="print.c" />
     <ClCompile Include="prntid.c" />
     <ClCompile Include="strdsp.c" />
     <ClCompile Include="wmdsp.c" />
@@ -299,10 +296,7 @@ cd ..
     <f2c_rule Include="fmt.f" />
     <f2c_rule Include="fmttyp.f" />
     <f2c_rule Include="formatnumber.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\intdisp.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\intprint.f" />
     <f2c_rule Include="lspdsp.f" />
-    <f2c_rule Include="print.f" />
     <f2c_rule Include="prntid.f" />
     <f2c_rule Include="strdsp.f" />
     <f2c_rule Include="wmdsp.f" />