source: trunk/ADOL-C/src/interfacesf.c @ 42

Last change on this file since 42 was 42, checked in by awalther, 10 years ago

set svn keywords property

  • Property svn:keywords set to Author Date Id Revision
File size: 7.2 KB
Line 
1/*----------------------------------------------------------------------------
2 ADOL-C -- Automatic Differentiation by Overloading in C++
3 File:     interfacesf.c
4 Revision: $Id: interfacesf.c 42 2009-07-15 18:37:17Z awalther $
5 Contents: Genuine Fortran callable C Interfaces to ADOL-C forward
6           & reverse calls.
7 
8 Copyright (c) Andrea Walther, Andreas Griewank, Andreas Kowarz,
9               Hristo Mitev, Sebastian Schlenkrich, Jean Utke, Olaf Vogel
10 
11 This file is part of ADOL-C. This software is provided as open source.
12 Any use, reproduction, or distribution of the software constitutes
13 recipient's acceptance of the terms of the accompanying license file.
14 
15----------------------------------------------------------------------------*/
16
17#include <interfaces.h>
18#include <adalloc.h>
19#include <fortutils.h>
20
21BEGIN_C_DECLS
22
23/*--------------------------------------------------------------------------*/
24fint hos_forward_(fint* ftag,
25                  fint* fm,
26                  fint* fn,
27                  fint* fd,
28                  fint* fk,
29                  fdouble* fbase,
30                  fdouble* fx,
31                  fdouble* fvalue,
32                  fdouble* fy) {
33    int rc= -1;
34    int tag=*ftag, m=*fm, n=*fn, d=*fd, k=*fk;
35    double* base = myalloc1(n);
36    double* value = myalloc1(m);
37    double** X = myalloc2(n,d);
38    double** Y = myalloc2(m,d);
39    spread1(n,fbase,base);
40    spread2(n,d,fx,X);
41    rc= hos_forward(tag,m,n,d,k,base,X,value,Y);
42    pack2(m,d,Y,fy);
43    pack1(m,value,fvalue);
44    free((char*)*X);
45    free((char*)X);
46    free((char*)*Y);
47    free((char*)Y);
48    free((char*)base);
49    free((char*)value);
50    return rc;
51}
52
53/*--------------------------------------------------------------------------*/
54fint zos_forward_(fint* ftag,
55                  fint* fm,
56                  fint* fn,
57                  fint* fk,
58                  fdouble* fbase,
59                  fdouble* fvalue) {
60    int rc=-1;
61    int tag=*ftag, m=*fm, n=*fn, k=*fk;
62    double* base=myalloc1(n);
63    double* value = myalloc1(m);
64    spread1(n,fbase,base);
65    rc=zos_forward(tag,m,n,k,base,value);
66    pack1(m,value,fvalue);
67    free((char*)base);
68    free((char*)value);
69    return rc;
70}
71
72/*--------------------------------------------------------------------------*/
73fint hov_forward_(fint* ftag,
74                  fint* fm,
75                  fint* fn,
76                  fint* fd,
77                  fint* fp,
78                  fdouble* fbase,
79                  fdouble* fx,
80                  fdouble* fvalue,
81                  fdouble* fy) {
82    int rc= -1;
83    int tag=*ftag, m=*fm, n=*fn, d=*fd, p=*fp;
84    double* base = myalloc1(n);
85    double* value = myalloc1(m);
86    double*** X = myalloc3(n,p,d);
87    double*** Y = myalloc3(m,p,d);
88    spread1(n,fbase,base);
89    spread3(n,p,d,fx,X);
90    rc= hov_forward(tag,m,n,d,p,base,X,value,Y);
91    pack3(m,p,d,Y,fy);
92    pack1(m,value,fvalue);
93    free((char*)**X);
94    free((char*)*X);
95    free((char*)X);
96    free((char*)**Y);
97    free((char*)*Y);
98    free((char*)Y);
99    free((char*)base);
100    free((char*)value);
101    return rc;
102}
103
104/*--------------------------------------------------------------------------*/
105fint fov_forward_(fint* ftag,
106                  fint* fm,
107                  fint* fn,
108                  fint* fp,
109                  fdouble* fbase,
110                  fdouble* fx,
111                  fdouble* fvalue,
112                  fdouble* fy) {
113    int rc= -1;
114    int tag=*ftag, m=*fm, n=*fn, p=*fp;
115    double* base = myalloc1(n);
116    double* value = myalloc1(m);
117    double** X = myalloc2(n,p);
118    double** Y = myalloc2(m,p);
119    spread1(n,fbase,base);
120    spread2(n,p,fx,X);
121    rc= fov_forward(tag,m,n,p,base,X,value,Y);
122    pack2(m,p,Y,fy);
123    pack1(m,value,fvalue);
124    free((char*)*X);
125    free((char*)X);
126    free((char*)*Y);
127    free((char*)Y);
128    free((char*)base);
129    free((char*)value);
130    return rc;
131}
132
133
134/*--------------------------------------------------------------------------*/
135fint hos_reverse_(fint* ftag,
136                  fint* fm,
137                  fint* fn,
138                  fint* fd,
139                  fdouble* fu,
140                  fdouble* fz) {
141    int rc=-1;
142    int tag=*ftag, m=*fm, n=*fn, d=*fd;
143    double** Z = myalloc2(n,d+1);
144    double* u = myalloc1(m);
145    spread1(m,fu,u);
146    rc=hos_reverse(tag,m,n,d,u,Z);
147    pack2(n,d+1,Z,fz);
148    free((char*)*Z);
149    free((char*)Z);
150    free((char*)u);
151    return rc;
152}
153
154/*--------------------------------------------------------------------------*/
155fint hos_ti_reverse_(
156    fint* ftag,
157    fint* fm,
158    fint* fn,
159    fint* fd,
160    fdouble* fu,
161    fdouble* fz) {
162    int rc=-1;
163    int tag=*ftag, m=*fm, n=*fn, d=*fd;
164    double** Z = myalloc2(n,d+1);
165    double** U = myalloc2(m,d+1);
166    spread2(m,d+1,fu,U);
167    rc=hos_ti_reverse(tag,m,n,d,U,Z);
168    pack2(n,d+1,Z,fz);
169    free((char*)*Z);
170    free((char*)Z);
171    free((char*)*U);
172    free((char*)U);
173    return rc;
174}
175
176/*--------------------------------------------------------------------------*/
177fint fos_reverse_(fint* ftag,
178                  fint* fm,
179                  fint* fn,
180                  fdouble* fu,
181                  fdouble* fz) {
182    int rc=-1;
183    int tag=*ftag, m=*fm, n=*fn;
184    double* u = myalloc1(m);
185    double* Z = myalloc1(n);
186    spread1(m,fu,u);
187    rc=fos_reverse(tag,m,n,u,Z);
188    pack1(n,Z,fz);
189    free((char*)Z);
190    free((char*)u);
191    return rc;
192}
193
194/*--------------------------------------------------------------------------*/
195fint hov_reverse_(fint* ftag,
196                  fint* fm,
197                  fint* fn,
198                  fint* fd,
199                  fint* fq,
200                  fdouble* fu,
201                  fdouble* fz) {
202    int rc=-1;
203    int tag=*ftag, m=*fm, n=*fn, d=*fd, q=*fq;
204    double** U = myalloc2(q,m);
205    double*** Z = myalloc3(q,n,d+1);
206    short ** nop = 0;
207    spread2(q,m,fu,U);
208    rc=hov_reverse(tag,m,n,d,q,U,Z,nop);
209    pack3(q,n,d+1,Z,fz);
210    free((char*)**Z);
211    free((char*)*Z);
212    free((char*)Z);
213    free((char*)*U);
214    free((char*)U);
215    return rc;
216}
217
218/*--------------------------------------------------------------------------*/
219fint hov_ti_reverse_(
220    fint* ftag,
221    fint* fm,
222    fint* fn,
223    fint* fd,
224    fint* fq,
225    fdouble* fu,
226    fdouble* fz) {
227    int rc=-1;
228    int tag=*ftag, m=*fm, n=*fn, d=*fd, q=*fq;
229    double*** U = myalloc3(q,m,d+1);
230    double*** Z = myalloc3(q,n,d+1);
231    short ** nop = 0;
232    spread3(q,m,d+1,fu,U);
233    rc=hov_ti_reverse(tag,m,n,d,q,U,Z,nop);
234    pack3(q,n,d+1,Z,fz);
235    free((char*)**Z);
236    free((char*)*Z);
237    free((char*)Z);
238    free((char*)**U);
239    free((char*)*U);
240    free((char*)U);
241    return rc;
242}
243
244/*--------------------------------------------------------------------------*/
245fint fov_reverse_(fint* ftag,
246                  fint* fm,
247                  fint* fn,
248                  fint* fq,
249                  fdouble* fu,
250                  fdouble* fz) {
251    int rc=-1;
252    int tag=*ftag, m=*fm, n=*fn, q=*fq;
253    double** U = myalloc2(q,m);
254    double** Z = myalloc2(q,n);
255    spread2(q,m,fu,U);
256    rc=fov_reverse(tag,m,n,q,U,Z);
257    pack2(q,n,Z,fz);
258    free((char*)*Z);
259    free((char*)Z);
260    free((char*)*U);
261    free((char*)U);
262    return rc;
263}
264
265
266/****************************************************************************/
267/*                                                               THAT'S ALL */
268
269END_C_DECLS
Note: See TracBrowser for help on using the repository browser.