Arcane  v3.14.10.0
Documentation développeur
Chargement...
Recherche...
Aucune correspondance
mathlink.cc
1// -*- tab-width: 2; indent-tabs-mode: nil; coding: utf-8-with-signature -*-
2//-----------------------------------------------------------------------------
3// Copyright 2000-2022 CEA (www.cea.fr) IFPEN (www.ifpenergiesnouvelles.com)
4// See the top-level COPYRIGHT file for details.
5// SPDX-License-Identifier: Apache-2.0
6//-----------------------------------------------------------------------------
7/*---------------------------------------------------------------------------*/
8/* mathlink.cc (C) 2013 */
9/* */
10/*---------------------------------------------------------------------------*/
11#include "arcane/IApplication.h"
12#include "arcane/IParallelMng.h"
13
14#include "arcane/AbstractService.h"
15#include "arcane/FactoryService.h"
16
17#include "arcane/IVariableMng.h"
18#include "arcane/SharedVariable.h"
19#include "arcane/CommonVariables.h"
20
21#include "arcane/IMesh.h"
22#include "arcane/IItemFamily.h"
23
24#include <arcane/MathUtils.h>
25#include <arcane/Timer.h>
26#include <arcane/IParallelMng.h>
27#include <arcane/ITimeLoopMng.h>
28
29#include <mathlink.h>
30#include <arcane/mathlink/mathlink.h>
31
32/*---------------------------------------------------------------------------*/
33/*---------------------------------------------------------------------------*/
34
35ARCANE_BEGIN_NAMESPACE
36
37// ****************************************************************************
38// * mathlink
39// ****************************************************************************
40mathlink::mathlink(const ServiceBuildInfo & sbi):
41 AbstractService(sbi),
42 m_sub_domain(sbi.subDomain()),
43 mathenv(NULL),
44 mathlnk(NULL),
45 mathtmr(new Timer(m_sub_domain,"mathlink",Timer::TimerReal)){}
46
47
48// ****************************************************************************
49// * ~mathlink
50// ****************************************************************************
51mathlink::~mathlink(){}
52
53
54// ****************************************************************************
55// * link
56// ****************************************************************************
57void mathlink::link(){
58 int error;
59
60 // Il n'y a que le master en 0 qui se link à Mathematica
61 if (m_sub_domain->parallelMng()->commRank()!=0) return;
62
63
64 debug()<<"[mathlink::link]"<<" linking?"
65 <<" (commSize=" << m_sub_domain->parallelMng()->commSize()
66 <<", commRank=" << m_sub_domain->parallelMng()->commRank()<<")";
67
68 { // Initializes the MathLink environment object and passes parameters in p
69 mathenv = MLInitialize((char *)NULL);
70 if(mathenv == (MLENV)NULL)
71 throw Arcane::FatalErrorException(A_FUNCINFO, "Unable to initialize the MathLink environment");
72 debug()<<"[mathlink::link] initialized!";
73 }
74
75 { // Opens a MathLink connection taking parameters from a character string
76 // -linkhost localhost /cea/produits1/mathematica-8.0.0/Executables/math
77 // pkill -9 MathKernel
78 // SharedMemory
79 char master_string[]="-linkname /cea/produits1/mathematica-8.0.0/Executables/math -mathlink -linkmode launch -linkprotocol SharedMemory";
80 char slave_string[] ="-linkname /cea/produits1/mathematica-8.0.0/Executables/math -mathlink -linkmode connect -linkprotocol tcpip";
81 if (m_sub_domain->parallelMng()->commRank()==0){
82 mathlnk = MLOpenString(mathenv, master_string, &error);
83 }else{
84 mathlnk = MLOpenString(mathenv, slave_string, &error);
85 }
86 if ((mathlnk==(MLINK)NULL)||(error!=MLEOK))
87 throw Arcane::FatalErrorException(A_FUNCINFO, "Unable to create the link");
88 }
89
90 { // Activates a MathLink connection, waiting for the program at the other end to respond.
91 if (!MLActivate(mathlnk))
92 throw Arcane::FatalErrorException(A_FUNCINFO, "Unable to establish communication");
93 info()<<"Mathematica launched on rank #"<<m_sub_domain->parallelMng()->commRank();
94 }
95}
96
97
98// ****************************************************************************
99// * unlink
100// ****************************************************************************
101void mathlink::unlink(){
102 info()<<__FUNCTION__<<" MLClose";
103 if (!mathlnk) return;
104 MLPutFunction(mathlnk, "Exit", 0);
105 // Closes a MathLink connection
106 MLClose(mathlnk);
107 info()<<__FUNCTION__<<" MLDeinitialize";
108 if (!mathenv) return;
109 // Destructs the MathLink environment object
110 MLDeinitialize(mathenv);
111}
112
113// ****************************************************************************
114// * statics to read outputs
115// ****************************************************************************
116static int read_and_print_expression( MLINK lp);
117static int read_and_print_atom( MLINK lp, int tag){
118 const char *s;
119 if( tag == MLTKSTR) putchar( '"');
120 if( MLGetString( lp, &s)){
121 printf( "%s", s);
122 //MLDisownString( lp, s);
123 ARCANE_FATAL("MLDisownString is unknown");
124 }
125 if( tag == MLTKSTR) putchar( '"');
126 putchar( ' ');
127 return MLError( lp) == MLEOK;
128}
129static int read_and_print_function( MLINK lp){
130 int len, i;
131 static int indent;
132 if( ! MLGetArgCount( lp, &len)) return 0;
133 indent += 3;
134 printf( "\n%*.*s", indent, indent, "");
135 if( read_and_print_expression( lp) == 0) return 0;
136 printf( "[");
137 for( i = 1; i <= len; ++i) {
138 if( read_and_print_expression( lp) == 0) return 0;
139 if( i < len) printf( ", ");
140 }
141 printf( "]");
142 indent -= 3;
143 return 1;
144}
145static int read_and_print_expression( MLINK lp){
146 int tag;
147 switch (tag = MLGetNext( lp)) {
148 case MLTKSYM:
149 case MLTKSTR:
150 case MLTKINT:
151 case MLTKREAL:
152 return read_and_print_atom(lp, tag);
153 case MLTKFUNC:
154 return read_and_print_function(lp);
155 case MLTKERROR:{
156 printf("MLTKERROR!\n");
157 break;
158 }
159 default: printf("\nread_and_print_expression default!");
160 }
161 return 0;
162}
163
164
165// ****************************************************************************
166// * skip any packets before the first ReturnPacket
167// ****************************************************************************
168void mathlink::skipAnyPacketsBeforeTheFirstReturnPacket(){
169 int pkt;
170 while( (pkt = MLNextPacket(mathlnk), pkt) && pkt != RETURNPKT) {
171 MLNewPacket(mathlnk);
172 if (MLError(mathlnk)) mathlink::error();
173 }
174}
175
176
177// ****************************************************************************
178// * Prime
179// * gives the nth prime number
180// ****************************************************************************
181Integer mathlink::Prime(Integer n){
182 mlint64 prime;
183 if (n==0) return 1;
184 debug()<<"[mathlink::Prime] n=" << n;
185 MLPutFunction(mathlnk, "EvaluatePacket", 1L);
186 MLPutFunction(mathlnk, "Prime", 1L);
187 MLPutInteger64(mathlnk, n);
188 MLEndPacket(mathlnk);
189 skipAnyPacketsBeforeTheFirstReturnPacket();
190 if (MLGetNext(mathlnk)!=MLTKINT) mathlink::error();
191 MLGetInteger64(mathlnk, &prime);
192 debug()<<"[mathlink::Prime] returning " << prime;
193 return prime;
194}
195
196
197// ****************************************************************************
198// * tests
199// ****************************************************************************
200void mathlink::tests(){
201 testFactorInteger(7420738134810L);
202 UniqueArray<Integer> coefs;
203 coefs.add(3);
204 coefs.add(4);
205 coefs.add(7);
206 testLinearProgramming(coefs.view());
207}
208
209
210// ****************************************************************************
211// * testFactorInteger
212// ****************************************************************************
213void mathlink::testFactorInteger(Int64 n){
214 info()<<__FUNCTION__<<" is now factoring "<<n;
215 {
216 int pkt, expt;
217 mlint64 prime;
218 long len, lenp, k;
219 Timer::Sentry ts(mathtmr);
220
221 MLPutFunction(mathlnk, "EvaluatePacket", 1L);
222 MLPutFunction(mathlnk, "FactorInteger", 1L);
223 MLPutInteger64(mathlnk, n);
224 MLEndPacket(mathlnk);
225 while( (pkt = MLNextPacket(mathlnk), pkt) && pkt != RETURNPKT) {
226 MLNewPacket(mathlnk);
227 if (MLError(mathlnk)) mathlink::error();
228 }
229 if (!MLCheckFunction(mathlnk, "List", &len)) mathlink::error();
230 for (k = 1; k <= len; k++) {
231 if (MLCheckFunction(mathlnk, "List", &lenp)
232 && lenp == 2
233 && MLGetInteger64(mathlnk, &prime)
234 && MLGetInteger(mathlnk, &expt)
235 ){
236 info()<<prime<<"^"<< expt;
237 }else mathlink::error();
238 }
239 }
240 info()<<__FUNCTION__<<" "<<mathtmr->lastActivationTime()<<"s";
241}
242
243
244
245// ****************************************************************************
246// * testLinearProgramming
247// ****************************************************************************
248void mathlink::testLinearProgramming(ArrayView<Integer> coefs){
249 {
250 int pkt,sol;
251 long len,k;
252 Timer::Sentry ts(mathtmr);
253 MLPutFunction(mathlnk, "EvaluatePacket", 1);
254 MLPutFunction(mathlnk, "LinearProgramming", 5);
255 int c[]={1,1,1,1,1,1};
256 int m[5][6]={{7, 4, 3, 0, 0, 0},
257 {0, 0, 0, 7, 4, 3},
258 {1, 0, 0, 1, 0, 0},
259 {0, 1, 0, 0, 1, 0},
260 {0, 0, 1, 0, 0, 1}};
261 int b[5][2]={{9, -1}, {9, -1}, {1, 0}, {1, 0}, {1, 0}};
262 int l[6][2]={{0, 1}, {0, 1}, {0, 1}, {0, 1}, {0, 1}, {0, 1}};
263 MLPutIntegerList(mathlnk, c, 6);
264 MLPutFunction(mathlnk, "List", 5);
265 MLPutIntegerList(mathlnk, m[0], 6);
266 MLPutIntegerList(mathlnk, m[1], 6);
267 MLPutIntegerList(mathlnk, m[2], 6);
268 MLPutIntegerList(mathlnk, m[3], 6);
269 MLPutIntegerList(mathlnk, m[4], 6);
270 MLPutFunction(mathlnk, "List", 5);
271 MLPutIntegerList(mathlnk, b[0], 2);
272 MLPutIntegerList(mathlnk, b[1], 2);
273 MLPutIntegerList(mathlnk, b[2], 2);
274 MLPutIntegerList(mathlnk, b[3], 2);
275 MLPutIntegerList(mathlnk, b[4], 2);
276 MLPutFunction(mathlnk, "List", 6);
277 MLPutIntegerList(mathlnk, l[0], 2);
278 MLPutIntegerList(mathlnk, l[1], 2);
279 MLPutIntegerList(mathlnk, l[2], 2);
280 MLPutIntegerList(mathlnk, l[3], 2);
281 MLPutIntegerList(mathlnk, l[4], 2);
282 MLPutIntegerList(mathlnk, l[5], 2);
283 MLPutFunction(mathlnk, "List", 6);
284 MLPutSymbol(mathlnk, "Integers");
285 MLPutSymbol(mathlnk, "Integers");
286 MLPutSymbol(mathlnk, "Integers");
287 MLPutSymbol(mathlnk, "Integers");
288 MLPutSymbol(mathlnk, "Integers");
289 MLPutSymbol(mathlnk, "Integers");
290 MLEndPacket(mathlnk);
291 while( (pkt = MLNextPacket(mathlnk), pkt) && pkt != RETURNPKT) {
292 MLNewPacket(mathlnk);
293 if (MLError(mathlnk)) mathlink::error();
294 }
295 if (!MLCheckFunction(mathlnk, "List", &len)) mathlink::error();
296 for (k = 1; k <= len; k++) {
297 if (MLGetInteger(mathlnk, &sol)){
298 info()<<sol;
299 }else mathlink::error();
300 }
301 }
302 info()<<__FUNCTION__<<" "<<mathtmr->lastActivationTime()<<"s";
303}
304
305
306// ****************************************************************************
307// * error
308// ****************************************************************************
309void mathlink::error(){
310 if (MLError(mathlnk))
311 throw Arcane::FatalErrorException(A_FUNCINFO, MLErrorMessage(mathlnk));
312 else
313 throw Arcane::FatalErrorException(A_FUNCINFO,"Error detected by mathlink.\n");
314}
315
316
317ARCANE_REGISTER_SUB_DOMAIN_FACTORY(mathlink, mathlink, mathlink);
318
319/*---------------------------------------------------------------------------*/
320/*---------------------------------------------------------------------------*/
321
322ARCANE_END_NAMESPACE
323
324/*---------------------------------------------------------------------------*/
325/*---------------------------------------------------------------------------*/
ARCANE_FATAL
#define ARCANE_FATAL(...)
Macro envoyant une exception FatalErrorException.
Definition ArcaneGlobal.h:809
ARCANE_REGISTER_SUB_DOMAIN_FACTORY
#define ARCANE_REGISTER_SUB_DOMAIN_FACTORY(aclass, ainterface, aname)
Enregistre un service de fabrique pour la classe aclass.
Definition ServiceFactory.h:586
Arccore::FatalErrorException
Exception lorsqu'une erreur fatale est survenue.
Definition arccore/src/base/arccore/base/FatalErrorException.h:32
Arcane::CStringUtils::len
Integer len(const char *s)
Retourne la longueur de la chaîne s.
Definition arcane/src/arcane/utils/CStringUtils.cc:90
Arccore::Integer
Int32 Integer
Type représentant un entier.
Definition ArccoreGlobal.h:240