mathlib-slatec-depac.c
1 //! @file mathlib-slatec-depac.c
2 //
3 //! @section copyright
4 //
5 // This file is part of VIF - vintage fortran compiler.
6 // Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
7 //
8 //! @section license
9 //
10 // This program is free software; you can redistribute it and/or modify it
11 // under the terms of the gnu general public license as published by the
12 // free software foundation; either version 3 of the license, or
13 // (at your option) any later version.
14 //
15 // This program is distributed in the hope that it will be useful, but
16 // without any warranty; without even the implied warranty of merchantability
17 // or fitness for a particular purpose. See the GNU general public license for
18 // more details. you should have received a copy of the GNU general public
19 // license along with this program. If not, see <http://www.gnu.org/licenses/>.
20 //
21 //! @Synopsis
22 //
23 //! Subprograms from SLATEC-DEPAC
24
25 // Compiled from Fortran source code by VIF.
26
27 // The license for SLATEC Fortran source code is:
28 //
29 // The SLATEC Common Mathematical Library was developed at
30 // US government research laboratories and is in the public domain.
31 //
32 // Repository: http://www.netlib.org/slatec/
33 //
34 // The SLATEC common mathematical library is issued by the following
35 //
36 // Air Force Weapons Laboratory, Albuquerque
37 // Lawrence Livermore National Laboratory, Livermore
38 // Los Alamos National Laboratory, Los Alamos
39 // National Institute of Standards and Technology, Washington
40 // National Energy Research Supercomputer Center, Livermore
41 // Oak Ridge National Laboratory, Oak Ridge
42 // Sandia National Laboratories, Albuquerque
43 // Sandia National Laboratories, Livermore
44 //
45 // All questions concerning the distribution of the library should be
46 // directed to the NATIONAL ENERGY SOFTWARE CENTER, 9700 Cass Ave.,
47 // Argonne, Illinois 60439, and not to the authors of the subprograms.
48 //
49 // * * * * * Notice * * * * *
50 //
51 // This material was prepared as an account of work sponsored by the
52 // United States Government. Neither the United States, nor the
53 // Department of Energy, nor the Department of Defense, nor any of
54 // their employees, nor any of their contractors, subcontractors, or
55 // their employees, makes any warranty, expressed or implied, or
56 // assumes any legal liability or responsibility for the accuracy,
57 // completeness, or usefulness of any information, apparatus, product,
58 // or process disclosed, or represents that its use would not infringe
59 // upon privately owned rights.
60
61 // VIF THU 20 NOV 2025 22:19:16 ** MARCEL ** SLATEC DEPAC PAGE 00001
62
63
64
65 // M M A RRRRRR CCCCC EEEEEEE L
66 // MM MM A A R R C C E L
67 // M M M M A A R R C E L
68 // M M M A A RRRRRR C EEEEE L
69 // M M AAAAAAA R R C E L
70 // M M A A R R C C E L
71 // M M A A R R CCCCC EEEEEEE LLLLLLL
72
73 // SSSSS L A TTTTTTT EEEEEEE CCCCC DDDDDD EEEEEEE PPPPPP A CCCCC
74 // S S L A A T E C C D D E P P A A C C
75 // S L A A T E C D D E P P A A C
76 // SSSSS L A A T EEEEE C ***** D D EEEEE PPPPPP A A C
77 // S L AAAAAAA T E C D D E P AAAAAAA C
78 // S S L A A T E C C D D E P A A C C
79 // SSSSS LLLLLLL A A T EEEEEEE CCCCC DDDDDD EEEEEEE P A A CCCCC
80
81
82
83
84 // VIF THU 20 NOV 2025 22:19:16 ** GLOBAL SCOPE ** DIAGNOSTICS PAGE 00002
85
86 // ** linker ** object size 145008 bytes
87 // ** statistics ** 8 subprograms, no errors, no warnings
88
89
90 // VIF THU 20 NOV 2025 22:19:16 ** GLOBAL SCOPE ** JOB CONTROL PAGE 00003
91
92
93 // Line JCL *...*....1....|....2....|....3....|....4....|....5....|....6....|....7..*.|....8
94
95
96
97 // VIF THU 20 NOV 2025 22:19:16 ** GLOBAL SCOPE ** DEFINITIONS PAGE 00004
98
99 /*
100 Generated by VIF - experimental VIntage Fortran compiler.
101 VIF release 1.4.1
102 */
103
104 #if defined (__GNUC__)
105 #pragma GCC diagnostic ignored "-Wimplicit-function-declaration"
106 #pragma GCC diagnostic ignored "-Wincompatible-pointer-types"
107 #if (__GNUC__ >= 14)
108 #pragma GCC diagnostic ignored "-Wdeclaration-missing-parameter-type"
109 #pragma GCC diagnostic ignored "-Wimplicit-int"
110 #pragma GCC diagnostic ignored "-Wint-conversion"
111 #pragma GCC diagnostic ignored "-Wreturn-mismatch"
112 #endif
113 #else
114 #error VIF requires GCC
115 #endif
116
117 #include <vif.h>
118
119 static int_4 _km1 = -1, _k0 = 0, _k1 = 1;
120
121
122 #define _dc_0 "slatec"
123 #define _dc_1 "ddeabm"
124 #define _dc_2 "an apparent infinite loop has been detected.$$"
125 #define _dc_3 "you have made repeated calls at t = "
126 #define _dc_4 " and the integration has not advanced. check the "
127 #define _dc_5 "way you have set parameters for the call to the "
128 #define _dc_6 "code, particularly info(1)."
129 #define _dc_7 "the length of the rwork "
130 #define _dc_8 "array must be at least 130 + 21*neq.$$"
131 #define _dc_9 "you have called the code with lrw = "
132 #define _dc_10 "the length of the iwork "
133 #define _dc_11 "array must be at least 51.$$you have called the code "
134 #define _dc_12 "with liw = "
135 #define _dc_13 "dderkf"
136 #define _dc_14 "you have made repeated calls at t = "
137 #define _dc_15 "length of rwork array "
138 #define _dc_16 "must be at least 30 + 7*neq. you have called the "
139 #define _dc_17 "code with lrw = "
140 #define _dc_18 "length of iwork array "
141 #define _dc_19 "must be at least 34. you have called the code with "
142 #define _dc_20 "liw = "
143 #define _dc_21 "deabm"
144 #define _dc_22 "derkf"
145 #define _dc_23 "must be at least 30 + 7*neq. you have called the "
146 #define _dc_24 "code with lrw = "
147 #define _dc_25 "must be at least 34. you have called the code with "
148
149
150
151 // VIF THU 20 NOV 2025 22:19:16 ** GLOBAL SCOPE ** TYPEDEFS PAGE 00005
152
153 static FORMAT *__fmt_a = NULL;
154 typedef char char_7[8];
155 typedef char char_15[16];
156 typedef char char_31[32];
157 typedef char char_63[64];
158 typedef char char_127[128];
159 typedef char char_255[256];
160 typedef char char_511[512];
161 typedef char char_1023[1024];
162 typedef char char_2047[2048];
163
164
165 // VIF THU 20 NOV 2025 22:19:16 ** GLOBAL SCOPE ** FREQUENCY TABLE PAGE 00006
166
167 #define __ncalls 9
168 static CALLS __calls[__ncalls] = {
169 { // ** body not listed **"ddeabm", 0}, // subroutine
171 { // ** body not listed **"deabm", 0}, // subroutine
173 { // ** body not listed **"dintp", 0}, // subroutine
175 { // ** body not listed **"sintrp", 0}, // subroutine
177 { // ** body not listed **NULL, 0}
178 };
259 { // ** body not listed **
482 }
483
484 // VIF THU 20 NOV 2025 22:19:16 ** DDERKF ** DDERKF PAGE 00016
485
486 // SSSSS U U BBBBBB RRRRRR OOOOO U U TTTTTTT III N N EEEEEEE
487 // S S U U B B R R O O U U T I NN N E
488 // S U U B B R R O O U U T I N N N E
489 // SSSSS U U BBBBBB RRRRRR O O U U T I N N N EEEEE
490 // S U U B B R R O O U U T I N N N E
491 // S S U U B B R R O O U U T I N NN E
492 // SSSSS UUUUU BBBBBB R R OOOOO UUUUU T III N N EEEEEEE
493
494 // DDDDDD DDDDDD EEEEEEE RRRRRR K K FFFFFFF
495 // D D D D E R R K K F
496 // D D D D E R R K K F
497 // D D D D EEEEE RRRRRR KKK FFFFF
498 // D D D D E R R K K F
499 // D D D D E R R K K F
500 // DDDDDD DDDDDD EEEEEEE R R K K F
501
502
503 // VIF THU 20 NOV 2025 22:19:16 ** DDERKF ** DIAGNOSTICS PAGE 00017
504
505
506 // VIF THU 20 NOV 2025 22:19:16 ** DDERKF ** GENERATED CODE PAGE 00018
507
508 int_4 _dderkf (real_4 (*_df)(), int_4 _p_ neq_, real_8 _p_ t_, real_8 _p_ y_, real_8 _p_ tout_, int_4 _p_ info_, real_8
509 _p_ rtol_, real_8 _p_ atol_, int_4 _p_ idid_, real_8 _p_ rwork_, int_4 _p_ lrw_, int_4 _p_ iwork_, int_4 _p_ liw_,
510 real_8 _p_ rpar_, int_4 _p_ ipar_)
511 { // ** body not listed **
704 }
705
706 // VIF THU 20 NOV 2025 22:19:16 ** DEABM ** DEABM PAGE 00022
707
708 // SSSSS U U BBBBBB RRRRRR OOOOO U U TTTTTTT III N N EEEEEEE
709 // S S U U B B R R O O U U T I NN N E
710 // S U U B B R R O O U U T I N N N E
711 // SSSSS U U BBBBBB RRRRRR O O U U T I N N N EEEEE
712 // S U U B B R R O O U U T I N N N E
713 // S S U U B B R R O O U U T I N NN E
714 // SSSSS UUUUU BBBBBB R R OOOOO UUUUU T III N N EEEEEEE
715
716 // DDDDDD EEEEEEE A BBBBBB M M
717 // D D E A A B B MM MM
718 // D D E A A B B M M M M
719 // D D EEEEE A A BBBBBB M M M
720 // D D E AAAAAAA B B M M
721 // D D E A A B B M M
722 // DDDDDD EEEEEEE A A BBBBBB M M
723
724
725 // VIF THU 20 NOV 2025 22:19:16 ** DEABM ** DIAGNOSTICS PAGE 00023
726
727
728 // VIF THU 20 NOV 2025 22:19:16 ** DEABM ** GENERATED CODE PAGE 00024
729
730 int_4 _deabm (real_4 (*_f)(), int_4 _p_ neq_, real_4 _p_ t_, real_4 _p_ y_, real_4 _p_ tout_, int_4 _p_ info_, real_4
731 _p_ rtol_, real_4 _p_ atol_, int_4 _p_ idid_, real_4 _p_ rwork_, int_4 _p_ lrw_, int_4 _p_ iwork_, int_4 _p_ liw_,
732 real_4 _p_ rpar_, int_4 _p_ ipar_)
733 { // ** body not listed **
956 }
957
958 // VIF THU 20 NOV 2025 22:19:16 ** DERKF ** DERKF PAGE 00029
959
960 // SSSSS U U BBBBBB RRRRRR OOOOO U U TTTTTTT III N N EEEEEEE
961 // S S U U B B R R O O U U T I NN N E
962 // S U U B B R R O O U U T I N N N E
963 // SSSSS U U BBBBBB RRRRRR O O U U T I N N N EEEEE
964 // S U U B B R R O O U U T I N N N E
965 // S S U U B B R R O O U U T I N NN E
966 // SSSSS UUUUU BBBBBB R R OOOOO UUUUU T III N N EEEEEEE
967
968 // DDDDDD EEEEEEE RRRRRR K K FFFFFFF
969 // D D E R R K K F
970 // D D E R R K K F
971 // D D EEEEE RRRRRR KKK FFFFF
972 // D D E R R K K F
973 // D D E R R K K F
974 // DDDDDD EEEEEEE R R K K F
975
976
977 // VIF THU 20 NOV 2025 22:19:16 ** DERKF ** DIAGNOSTICS PAGE 00030
978
979
980 // VIF THU 20 NOV 2025 22:19:16 ** DERKF ** GENERATED CODE PAGE 00031
981
982 int_4 _derkf (real_4 (*_f)(), int_4 _p_ neq_, real_4 _p_ t_, real_4 _p_ y_, real_4 _p_ tout_, int_4 _p_ info_, real_4
983 _p_ rtol_, real_4 _p_ atol_, int_4 _p_ idid_, real_4 _p_ rwork_, int_4 _p_ lrw_, int_4 _p_ iwork_, int_4 _p_ liw_,
984 real_4 _p_ rpar_, int_4 _p_ ipar_)
985 { // ** body not listed **
1178 }
1179
1180 // VIF THU 20 NOV 2025 22:19:16 ** DINTP ** DINTP PAGE 00035
1181
1182 // SSSSS U U BBBBBB RRRRRR OOOOO U U TTTTTTT III N N EEEEEEE
1183 // S S U U B B R R O O U U T I NN N E
1184 // S U U B B R R O O U U T I N N N E
1185 // SSSSS U U BBBBBB RRRRRR O O U U T I N N N EEEEE
1186 // S U U B B R R O O U U T I N N N E
1187 // S S U U B B R R O O U U T I N NN E
1188 // SSSSS UUUUU BBBBBB R R OOOOO UUUUU T III N N EEEEEEE
1189
1190 // DDDDDD III N N TTTTTTT PPPPPP
1191 // D D I NN N T P P
1192 // D D I N N N T P P
1193 // D D I N N N T PPPPPP
1194 // D D I N N N T P
1195 // D D I N NN T P
1196 // DDDDDD III N N T P
1197
1198
1199 // VIF THU 20 NOV 2025 22:19:16 ** DINTP ** DIAGNOSTICS PAGE 00036
1200
1201
1202 // VIF THU 20 NOV 2025 22:19:16 ** DINTP ** GENERATED CODE PAGE 00037
1203
1204 int_4 _dintp (real_8 _p_ x_, real_8 _p_ y_, real_8 _p_ xout_, real_8 _p_ yout_, real_8 _p_ ypout_, int_4 _p_ neqn_,
1205 int_4 _p_ kold_, real_8 _p_ phi_, int_4 _p_ ivc_, int_4 _p_ iv_, int_4 _p_ kgi_, real_8 _p_ gi_, real_8 _p_ alpha_,
1206 real_8 _p_ og_, real_8 _p_ ow_, real_8 _p_ ox_, real_8 _p_ oy_)
1207 { // ** body not listed **
1292 }
1293
1294 // VIF THU 20 NOV 2025 22:19:16 ** DSTEPS ** DSTEPS PAGE 00039
1295
1296 // SSSSS U U BBBBBB RRRRRR OOOOO U U TTTTTTT III N N EEEEEEE
1297 // S S U U B B R R O O U U T I NN N E
1298 // S U U B B R R O O U U T I N N N E
1299 // SSSSS U U BBBBBB RRRRRR O O U U T I N N N EEEEE
1300 // S U U B B R R O O U U T I N N N E
1301 // S S U U B B R R O O U U T I N NN E
1302 // SSSSS UUUUU BBBBBB R R OOOOO UUUUU T III N N EEEEEEE
1303
1304 // DDDDDD SSSSS TTTTTTT EEEEEEE PPPPPP SSSSS
1305 // D D S S T E P P S S
1306 // D D S T E P P S
1307 // D D SSSSS T EEEEE PPPPPP SSSSS
1308 // D D S T E P S
1309 // D D S S T E P S S
1310 // DDDDDD SSSSS T EEEEEEE P SSSSS
1311
1312
1313 // VIF THU 20 NOV 2025 22:19:16 ** DSTEPS ** DIAGNOSTICS PAGE 00040
1314
1315
1316 // VIF THU 20 NOV 2025 22:19:16 ** DSTEPS ** GENERATED CODE PAGE 00041
1317
1318 int_4 _dsteps (int_4 (*_df)(), int_4 _p_ neqn_, real_8 _p_ y_, real_8 _p_ x_, real_8 _p_ h_, real_8 _p_ eps_, real_8
1319 _p_ wt_, logical_4 _p_ start_, real_8 _p_ hold_, int_4 _p_ k_, int_4 _p_ kold_, logical_4 _p_ crash_, real_8 _p_ phi_,
1320 real_8 _p_ p_, real_8 _p_ yp_, real_8 _p_ psi_, real_8 _p_ alpha_, real_8 _p_ beta_, real_8 _p_ sig_, real_8 _p_ v_,
1321 real_8 _p_ w_, real_8 _p_ g_, logical_4 _p_ phase1_, int_4 _p_ ns_, logical_4 _p_ nornd_, int_4 _p_ ksteps_, real_8 _p_
1322 twou_, real_8 _p_ fouru_, real_8 _p_ xold_, int_4 _p_ kprev_, int_4 _p_ ivc_, int_4 _p_ iv_, int_4 _p_ kgi_, real_8 _p_
1323 gi_, real_8 _p_ rpar_, int_4 _p_ ipar_)
1324 { // ** body not listed **
1936 }
1937
1938 // VIF THU 20 NOV 2025 22:19:16 ** SINTRP ** SINTRP PAGE 00053
1939
1940 // SSSSS U U BBBBBB RRRRRR OOOOO U U TTTTTTT III N N EEEEEEE
1941 // S S U U B B R R O O U U T I NN N E
1942 // S U U B B R R O O U U T I N N N E
1943 // SSSSS U U BBBBBB RRRRRR O O U U T I N N N EEEEE
1944 // S U U B B R R O O U U T I N N N E
1945 // S S U U B B R R O O U U T I N NN E
1946 // SSSSS UUUUU BBBBBB R R OOOOO UUUUU T III N N EEEEEEE
1947
1948 // SSSSS III N N TTTTTTT RRRRRR PPPPPP
1949 // S S I NN N T R R P P
1950 // S I N N N T R R P P
1951 // SSSSS I N N N T RRRRRR PPPPPP
1952 // S I N N N T R R P
1953 // S S I N NN T R R P
1954 // SSSSS III N N T R R P
1955
1956
1957 // VIF THU 20 NOV 2025 22:19:16 ** SINTRP ** DIAGNOSTICS PAGE 00054
1958
1959
1960 // VIF THU 20 NOV 2025 22:19:16 ** SINTRP ** GENERATED CODE PAGE 00055
1961
1962 int_4 _sintrp (real_4 _p_ x_, real_4 _p_ y_, real_4 _p_ xout_, real_4 _p_ yout_, real_4 _p_ ypout_, int_4 _p_ neqn_,
1963 int_4 _p_ kold_, real_4 _p_ phi_, int_4 _p_ ivc_, int_4 _p_ iv_, int_4 _p_ kgi_, real_4 _p_ gi_, real_4 _p_ alpha_,
1964 real_4 _p_ og_, real_4 _p_ ow_, real_4 _p_ ox_, real_4 _p_ oy_)
1965 { // ** body not listed **
2050 }
2051
2052 // VIF THU 20 NOV 2025 22:19:16 ** STEPS ** STEPS PAGE 00057
2053
2054 // SSSSS U U BBBBBB RRRRRR OOOOO U U TTTTTTT III N N EEEEEEE
2055 // S S U U B B R R O O U U T I NN N E
2056 // S U U B B R R O O U U T I N N N E
2057 // SSSSS U U BBBBBB RRRRRR O O U U T I N N N EEEEE
2058 // S U U B B R R O O U U T I N N N E
2059 // S S U U B B R R O O U U T I N NN E
2060 // SSSSS UUUUU BBBBBB R R OOOOO UUUUU T III N N EEEEEEE
2061
2062 // SSSSS TTTTTTT EEEEEEE PPPPPP SSSSS
2063 // S S T E P P S S
2064 // S T E P P S
2065 // SSSSS T EEEEE PPPPPP SSSSS
2066 // S T E P S
2067 // S S T E P S S
2068 // SSSSS T EEEEEEE P SSSSS
2069
2070
2071 // VIF THU 20 NOV 2025 22:19:16 ** STEPS ** DIAGNOSTICS PAGE 00058
2072
2073
2074 // VIF THU 20 NOV 2025 22:19:16 ** STEPS ** GENERATED CODE PAGE 00059
2075
2076 int_4 _steps (int_4 (*_f)(), int_4 _p_ neqn_, real_4 _p_ y_, real_4 _p_ x_, real_4 _p_ h_, real_4 _p_ eps_, real_4 _p_
2077 wt_, logical_4 _p_ start_, real_4 _p_ hold_, int_4 _p_ k_, int_4 _p_ kold_, logical_4 _p_ crash_, real_4 _p_ phi_,
2078 real_4 _p_ p_, real_4 _p_ yp_, real_4 _p_ psi_, real_4 _p_ alpha_, real_4 _p_ beta_, real_4 _p_ sig_, real_4 _p_ v_,
2079 real_4 _p_ w_, real_4 _p_ g_, logical_4 _p_ phase1_, int_4 _p_ ns_, logical_4 _p_ nornd_, int_4 _p_ ksteps_, real_4 _p_
2080 twou_, real_4 _p_ fouru_, real_4 _p_ xold_, int_4 _p_ kprev_, int_4 _p_ ivc_, int_4 _p_ iv_, int_4 _p_ kgi_, real_4 _p_
2081 gi_, real_4 _p_ rpar_, int_4 _p_ ipar_)
2082 { // ** body not listed **
2694 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
