FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  RechercherRechercher  Dernières imagesDernières images  S'enregistrerS'enregistrer  MembresMembres  Connexion  
Derniers sujets
» 2D_fill_color
Problème avec les SUBS Emptypar Marc Hier à 14:25

» Consommation gaz électricité
Problème avec les SUBS Emptypar leclode Mer 17 Avr 2024 - 11:07

» trop de fichiers en cours
Problème avec les SUBS Emptypar lepetitmarocain Mer 17 Avr 2024 - 10:19

» on_key_down (résolu)
Problème avec les SUBS Emptypar leclode Mar 16 Avr 2024 - 11:01

» Sous-programme(résolu)
Problème avec les SUBS Emptypar jjn4 Jeu 4 Avr 2024 - 14:42

» Bataille-navale
Problème avec les SUBS Emptypar jjn4 Mer 3 Avr 2024 - 14:08

» Minimiser une fenêtre Panoramic.
Problème avec les SUBS Emptypar Pedro Mar 2 Avr 2024 - 13:50

» Récapitulatif ludothèque panoramic jjn4
Problème avec les SUBS Emptypar jjn4 Lun 1 Avr 2024 - 18:04

» demande explication KGF pour imprimer en mm
Problème avec les SUBS Emptypar JL35 Jeu 28 Mar 2024 - 17:28

» Petit passage furtif
Problème avec les SUBS Emptypar Froggy One Mer 27 Mar 2024 - 14:26

» SPIN et aide langage (résolu)
Problème avec les SUBS Emptypar leclode Sam 23 Mar 2024 - 15:20

» Aide-mémoire des mots-clés Panoramic
Problème avec les SUBS Emptypar papydall Mer 20 Mar 2024 - 21:23

» Je ne comprend pas pourquoi la largeur de la scene 3d change
Problème avec les SUBS Emptypar Marc Mar 12 Mar 2024 - 20:06

» Comment télécharger panoramic?
Problème avec les SUBS Emptypar lepetitmarocain Sam 9 Mar 2024 - 13:31

» @lepetitmarocain <==> KGFGrid
Problème avec les SUBS Emptypar Klaus Dim 3 Mar 2024 - 9:59

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Avril 2024
LunMarMerJeuVenSamDim
1234567
891011121314
15161718192021
22232425262728
2930     
CalendrierCalendrier
Le deal à ne pas rater :
Pokémon EV06 : où acheter le Bundle Lot 6 Boosters Mascarade ...
Voir le deal

 

 Problème avec les SUBS

Aller en bas 
3 participants
AuteurMessage
jean_debord

jean_debord


Nombre de messages : 1246
Age : 69
Localisation : Limoges
Date d'inscription : 21/09/2008

Problème avec les SUBS Empty
MessageSujet: Problème avec les SUBS   Problème avec les SUBS EmptyMer 28 Mai 2014 - 9:51

Afin de faciliter la programmation des images fractales, j'essaye de faire une bibliothèque de procédures pour le calcul des fonctions complexes. Le code suivant passe très bien avec l'interpréteur :

Code:

' *******************************************************************
' Variables globales de la bibliotheque
' *******************************************************************

' Constantes mathematiques

dim MaxNum, MinNum, MaxLog, MinLog, Pi, PiDiv2

MaxLog = 709.78      : ' Argument max. pour EXP
MinLog = -708.39     : ' Argument min. pour EXP
MaxNum = exp(MaxLog) : ' Nb reel max. ~ 2^1024
MinNum = exp(MinLog) : ' Nb reel min. ~ 2^(-1022)
Pi     = 4 * atn(1)
PiDiv2 = Pi / 2

' Resultats des calculs
' Partie reelle, partie imaginaire, module, argument, signe

dim r_x, r_y, r_mod, r_arg, r_sgn

' Code d'erreur
'  0 = pas d'erreur
' -1 = argument hors bornes
' -2 = singularite
' -3 = overflow
' -4 = underflow

dim ErrCode%

' *******************************************************************
' Programme de test : Calcul de sin(z)^2 + cos(z)^2
' *******************************************************************

dim x, y         : ' z
dim sx, sy       : ' sin(z)
dim cx, cy       : ' cos(z)
dim s2x, s2y     : ' sin(z)^2
dim c2x, c2y     : ' cos(z)^2

x = 1 : y = 2

Complex_Sin(x, y) : sx = r_x : sy = r_y

Complex_Cos(x, y) : cx = r_x : cy = r_y

Complex_Square(sx, sy) : s2x = r_x : s2y = r_y

Complex_Square(cx, cy) : c2x = r_x : c2y = r_y

Complex_Add(s2x, s2y, c2x, c2y)

print "z                   = " + str$(x)   + " + " + str$(y)   + " * i"
print "sin(z)              = " + str$(sx)  + " + " + str$(sy)  + " * i"
print "cos(z)              = " + str$(cx)  + " + " + str$(cy)  + " * i"
print "sin(z)^2            = " + str$(s2x) + " + " + str$(s2y) + " * i"
print "cos(z)^2            = " + str$(c2x) + " + " + str$(c2y) + " * i"
print "sin(z)^2 + cos(z)^2 = " + str$(r_x) + " + " + str$(r_y) + " * i"

end

' *******************************************************************
' Procedures de la bibliotheque
' *******************************************************************

sub Complex_Add(a_x, a_y, b_x, b_y)
' Addition : r_x + i r_y = (a_x + i a_y) + (b_x + i b_y)

 ErrCode% = 0

 r_x = a_x + b_x
 r_y = a_y + b_y
end_sub

sub Complex_Sub(a_x, a_y, b_x, b_y)
' Soustraction : r_x + i r_y = (a_x + i a_y) - (b_x + i b_y)

 ErrCode% = 0

 r_x = a_x - b_x
 r_y = a_y - b_y
end_sub

sub Complex_Mul(a_x, a_y, b_x, b_y)
' Multiplication : r_x + i r_y = (a_x + i a_y) * (b_x + i b_y)

 ErrCode% = 0

 r_x = a_x * b_x - a_y * b_y
 r_y = a_x * b_y + a_y * b_x
end_sub

sub Complex_Square(a_x, a_y)
' Carre : r_x + i r_y = (a_x + i a_y)^2

 ErrCode% = 0

 r_x = a_x * a_x - a_y * a_y
 r_y = 2 * a_x * a_y
end_sub

sub Complex_Cube(a_x, a_y)
' Cube : r_x + i r_y = (a_x + i a_y)^3

 dim_local x2, y2, x3, y3

 ErrCode% = 0

 x2 = a_x * a_x : x3 = x2 * a_x
 y2 = a_y * a_y : y3 = y2 * a_y

 r_x = x3 - 3 * a_x * y2
 r_y = 3 * x2 * a_y - y3
end_sub

sub Complex_Div(a_x, a_y, b_x, b_y)
' Division : r_x + i r_y = (a_x + i a_y) / (b_x + i b_y)

 dim_local Temp

 if b_x = 0 and b_y = 0
   ErrCode% = -3
   r_x = MaxNum
   r_y = MaxNum
 else
   ErrCode% = 0
   Temp = b_x * b_x + b_y * b_y
   r_x = (a_x * b_x + a_y * b_y) / Temp
   r_y = (a_y * b_x - a_x * b_y) / Temp
 end_if
end_sub

sub Complex_Inv(a_x, a_y)
' Inverse : r_x + i r_y = 1 / (a_x + i a_y)

 dim_local Temp

 if a_x = 0 and a_y = 0
   ErrCode% = -3
   r_x = MaxNum
   r_y = MaxNum
 else
   ErrCode% = 0
   Temp = a_x * a_x + a_y * a_y
   r_x = a_x / Temp
   r_y = 0 - a_y / Temp
 end_if
end_sub

sub Complex_Sgn(a_x, a_y)
' Signe complexe

 ErrCode% = 0

 if a_x > 0
   r_sgn = 1
 else
   if a_y < 0
     r_sgn = -1
   else
     if a_y > 0
       r_sgn = 1
     else
       if a_y < 0
         r_sgn= -1
       else
         r_sgn = 0
       end_if
     end_if
   end_if
 end_if
end_sub

sub Complex_Abs(a_x, a_y)
' Module : r_mod = |a_x + i a_y|
' Algorithme d'apres "Numerical Recipes"

 ErrCode% = 0

 dim_local AbsX, AbsY, R, C

 AbsX = abs(a_x)
 AbsY = abs(a_y)

 if a_x = 0
   r_mod = abs(a_y)
 else
   if a_y = 0
     r_mod = abs(a_x)
   else
     if AbsX > AbsY
       R = AbsY / AbsX
       C = AbsX
     else
       R = AbsX / AbsY
       C = AbsY
     end_if
     r_mod = C * sqr(1 + R * R)
   end_if
 end_if
end_sub

sub Complex_Arg(a_x, a_y)
' Argument : r_arg = arg(a_x + i a_y)
' Resultat dans [-Pi, Pi)
' Equivaut a atan2(a_y, a_x)

 ErrCode% = 0

 if a_x = 0
   r_arg = sgn(a_y) * PiDiv2
 else
   ' 4e / 1er quadrant : -Pi/2..Pi/2
   r_arg = atn(a_y / a_x)
   if a_x < 0
     if a_y > 0
       ' 2e quadrant : Pi/2..Pi
       r_arg = r_arg + Pi
     else
       ' 3e quadrant : -Pi..-Pi/2
       r_arg = r_arg - Pi
     end_if
   end_if
 end_if
end_sub

sub Complex_Sqrt(a_x, a_y)
' Racine carree : r_x + i r_y = sqrt(a_x + i a_y)
' Algorithme d'apres "Numerical Recipes"

 dim_local X, Y, W, R

 ErrCode% = 0

 if a_x = 0 and a_y = 0
   r_x = 0
   r_y = 0
 else
   X = abs(a_x)
   Y = abs(a_y)

   if X >= Y
     R = Y / X
     W = sqr(X) * sqr(0.5 * (1 + sqr(1 + R * R)))
   else
     R = X / Y
     W = sqr(Y) * sqr(0.5 * (R + sqr(1 + R * R)))
   end_if

   if a_x >= 0.0
     r_x = W
     r_y = a_y / (2 * r_x)
   else
     if a_y >= 0
       r_y = W
     else
       r_y = 0 - W
     end_if
     r_x = a_y / (2 * r_y)
   end_if
 end_if
end_sub

sub Complex_Log(a_x, a_y)
' Partie principale du logarithme complexe
' r_x + i r_y = ln(a_x + i a_y)

 if a_x = 0 and a_y = 0
   ErrCode% = -2
   r_x = 0 - MaxNum
   r_y = 0
 else
   ErrCode% = 0
   Complex_Abs(a_x, a_y)
   Complex_Arg(a_x, a_y)
   r_x = log(r_mod)
   r_y = r_arg
 end_if
end_sub

sub Complex_Exp(a_x, a_y)
' Exponentielle complexe : r_x + i r_y = exp(a_x + i a_y)

 dim_local ExpX

 if a_x < MinLog
   ErrCode% = -4
   r_x = 0
   r_y = 0
 else
   if a_x > MaxLog
     ErrCode = -3
     ExpX = MaxNum
   else
     ErrCode% = 0
     ExpX = exp(a_x)
   end_if
   r_x = ExpX * cos(a_y)
   r_y = ExpX * sin(a_y)
 end_if
end_sub

sub Complex_RealPower(a_x, a_y, p)
' Puissance (exposant reel) : (a_x + i a_y)^p
' Resultat dans r_x, r_y
' Resultat aussi dans r_mod, r_arg si a <> 0

 ErrCode% = 0

 if a_x = 0 and a_y = 0
   if r = 0
     ' 0^0 = lim x^x quand x --> 0 = 1
     r_x = 1
     r_y = 0
   else
     if p > 0
       ' 0^p = 0 si p > 0
       r_x = 0
       r_y = 0
     else
       ' 0^p indefini si p < 0
       ErrCode% = -2
       r_x = MaxNum
       r_y = MaxNum
     end_if
   end_if
 else
   Complex_Abs(a_x, a_y)
   Complex_Arg(a_x, a_y)
   r_mod = power(r_mod, p)
   r_arg = r_arg * p
   r_x = r_mod * cos(r_arg)
   r_y = r_mod * sin(r_arg)
 end_if
end_sub

sub Complex_Power(a_x, a_y, b_x, b_y)
' Puissance (exposant complexe) : (a_x + i a_y)^(b_x + i b_y)
' Resultat dans r_x, r_y

 ErrCode% = 0

 if a_x = 0 and a_y = 0
   if b_x = 0 and b_y = 0
     ' 0^0 = lim x^x quand x --> 0 = 1
     r_x = 1
     r_y = 0
   else
     ' 0^p = 0 si p > 0
     r_x = 0
     r_y = 0
   end_if
 else
   ' exp(b ln(a))
   Complex_Abs(a_x, a_y)
   Complex_Arg(a_x, a_y)
   Complex_Mul(b_x, b_y, log(r_mod), r_arg)
   Complex_Exp(r_x, r_y)
 end_if
end_sub

sub Complex_Sin(a_x, a_y)
' Sinus complexe : r_x + i r_y = sin(a_x + i a_y)

 ErrCode% = 0

 r_x = sin(a_x) * hcos(a_y)
 r_y = cos(a_x) * hsin(a_y)
end_sub

sub Complex_Cos(a_x, a_y)
' Cosinus complexe : r_x + i r_y = cos(a_x + i a_y)

 ErrCode% = 0

 r_x = cos(a_x) * hcos(a_y)
 r_y = 0 - sin(a_x) * hsin(a_y)
end_sub

sub Complex_Tan(a_x, a_y)
' Tangente complexe : r_x + i r_y = tan(a_x + i a_y)

 dim_local X2, Y2, Temp

 X2 = 2 * a_x
 Y2 = 2 * a_y

 Temp = cos(X2) + hcos(Y2)

 if Temp <> 0
   ErrCode% = 0
   r_x = sin(X2) / Temp
   r_y = hsin(Y2) / Temp
 else
   ' a = Pi/2 + k*Pi
   ErrCode% = -2
   r_x = MaxNum
   r_y = 0
 end_if
end_sub

sub Complex_ASin(a_x, a_y)
' Arc Sinus complexe : r_x + i r_y = asin(a_x + i a_y)

 dim_local X2, XX, YY, Rp, Rm, S, T

 X2 = 2 * a_x
 XX = a_x * a_x
 YY = a_y * a_y
 S  = XX + YY + 1
 Rp = 0.5 * sqr(S + X2)
 Rm = 0.5 * sqr(S - X2)
 T  = Rp + Rm

 ErrCode% = 0

 Complex_Sgn(a_y, 0 - a_x)

 r_x = asin(Rp - Rm)
 r_y = r_sgn * log(T + sqr(T * T - 1))
end_sub

sub Complex_ACos(a_x, a_y)
' Arc Cosinus complexe :
' r_x + i r_y = acos(a_x + i a_y) = Pi/2 - ASin(a)

 Complex_ASin(a_x, a_y)

 r_x = PiDiv2 - r_x
 r_y = 0 - r_y
end_sub

sub Complex_ATan(a_x, a_y)
' Arc Tangente complexe : r_x + i r_y = atan(a_x + i a_y)

 dim_local XX, YY, Yp1, Ym1, A1, A2

 if a_x = 0 and abs(a_y) = 1
   ' a = +/- i
   ErrCode% = -2
   r_x = 0
   r_y = sgn(a_y) * MaxNum
 else
   ErrCode% = 0

   XX  = a_x * a_x
   YY  = a_y * a_y
   Yp1 = a_y + 1
   Ym1 = a_y - 1

   Complex_Arg(0 - Ym1, a_x) : A1 = r_arg : ' = atan2(a_x, - Ym1)
   Complex_Arg(Yp1, 0 - a_x) : A2 = r_arg : ' = atan2(- Ym1, a_x)

   r_x = 0.5 * (A1 - A2)
   r_y = 0.25 * log((XX + Yp1 * Yp1) / (XX + Ym1 * Ym1))
 end_if
end_sub

sub Complex_Sinh(a_x, a_y)
' Sinus hyperbolique complexe : r_x + i r_y = sinh(a_x + i a_y)

 ErrCode% = 0

 r_x = hsin(a_x) * cos(a_y)
 r_y = hcos(a_x) * sin(a_y)
end_sub

sub Complex_Cosh(a_x, a_y)
' Cosinus hyperbolique complexe : r_x + i r_y = cosh(a_x + i a_y)

 ErrCode% = 0

 r_x = hcos(a_x) * cos(a_y)
 r_y = hsin(a_x) * sin(a_y)
end_sub

sub Complex_Tanh(a_x, a_y)
' Tangente hyperbolique complexe : r_x + i r_y = tanh(a_x + i a_y)

 dim_local X2, Y2, Temp

 X2 = 2.0 * a_x
 Y2 = 2.0 * a_y

 Temp = hcos(X2) + cos(Y2)

 if Temp = 0
   ' a = i * (Pi/2 + k*Pi)
   ErrCode% = -2
   r_x = 0
   r_y = MaxNum
 else
   ErrCode% = 0
   r_x = hsin(X2) / Temp
   r_y = sin(Y2) / Temp
 end_if
end_sub

sub Complex_ASinh(a_x, a_y)
' Argument Sinus hyperbolique complexe :
' r_x + i r_y = asinh(a_x + i a_y) = -i*asin(i*a)
' i * (a_x + i a_y) = -a_y + i a_x

 dim_local t

 Complex_ASin(0 - a_y, a_x)

 t = r_x
 r_x = r_y
 r_y = 0 - t
end_sub

sub Complex_ACosh(a_x, a_y)
' Argument Cosinus hyperbolique complexe :
' r_x + i r_y = acosh(a_x + i a_y) = csgn(a_y + i(1 - a_x)) * i * acos(a)

 dim_local t

 Complex_Sgn(a_y, 1 - a_x)
 Complex_ACos(a_x, a_y)

 t = r_x
 r_x = 0 - r_sgn* r_y
 r_y = r_sgn * t
end_sub

sub Complex_ATanh(a_x, a_y)
' Argument Tangente hyperbolique complexe :
' r_x + i r_y = atanh(a_x + i a_y) = -i*atan(i*a)

 dim_local t

 Complex_ATan(0 - a_y, a_x)

 t = r_x
 r_x = r_y
 r_y = 0 - t
end_sub

En revanche, avec le compilateur, certains segments de code sont systématiquement dupliqués dans le code FreeBASIC généré (voir p. ex. la procédure COMPLEX_SIN) :

Code:

#include"MemoryModule.bi"
#include"incfile.bi"
IncFile(DLLdata,"panoramic.dll")
#lang "fblite"
option gosub
#include once"windows.bi"
dim shared _handl as HWND
dim shared _library as HMEMORYMODULE
_library = MemoryLoadLibrary(DLLdata)
dim shared pc_init as sub stdcall _
(byval operand1 as handle)
pc_init=MemoryGetProcAddress(_library,"pc_init")
dim shared pc_close as sub
pc_close=MemoryGetProcAddress(_library,"pc_close")
DIM SHARED V_NUMBER_3D_OBJECTS AS DOUBLE
DIM SHARED V_NUMBER_3D_TARGET AS DOUBLE
DIM SHARED V_MAXNUM AS DOUBLE
DIM SHARED V_MINNUM AS DOUBLE
DIM SHARED V_MAXLOG AS DOUBLE
DIM SHARED V_MINLOG AS DOUBLE
DIM SHARED V_PI AS DOUBLE
DIM SHARED V_PIDIV2 AS DOUBLE
DIM SHARED V_R_X AS DOUBLE
DIM SHARED V_R_Y AS DOUBLE
DIM SHARED V_R_MOD AS DOUBLE
DIM SHARED V_R_ARG AS DOUBLE
DIM SHARED V_R_SGN AS DOUBLE
DIM SHARED V_ERRCODE AS INTEGER
DIM SHARED V_X AS DOUBLE
DIM SHARED V_Y AS DOUBLE
DIM SHARED V_SX AS DOUBLE
DIM SHARED V_SY AS DOUBLE
DIM SHARED V_CX AS DOUBLE
DIM SHARED V_CY AS DOUBLE
DIM SHARED V_S2X AS DOUBLE
DIM SHARED V_S2Y AS DOUBLE
DIM SHARED V_C2X AS DOUBLE
DIM SHARED V_C2Y AS DOUBLE
dim shared pf_abs as function stdcall _
(byval P1 as double)as double
pf_abs=MemoryGetProcAddress(_library,"pf_abs")
dim shared pf_asin as function stdcall _
(byval P1 as double)as double
pf_asin=MemoryGetProcAddress(_library,"pf_asin")
dim shared pf_atn as function stdcall _
(byval P1 as double)as double
pf_atn=MemoryGetProcAddress(_library,"pf_atn")
dim shared pf_cos as function stdcall _
(byval P1 as double)as double
pf_cos=MemoryGetProcAddress(_library,"pf_cos")
dim shared pf_exp as function stdcall _
(byval P1 as double)as double
pf_exp=MemoryGetProcAddress(_library,"pf_exp")
dim shared pf_hcos as function stdcall _
(byval P1 as double)as double
pf_hcos=MemoryGetProcAddress(_library,"pf_hcos")
dim shared pf_hsin as function stdcall _
(byval P1 as double)as double
pf_hsin=MemoryGetProcAddress(_library,"pf_hsin")
dim shared pf_log as function stdcall _
(byval P1 as double)as double
pf_log=MemoryGetProcAddress(_library,"pf_log")
dim shared pf_power as function stdcall _
(byval P1 as double,_
byval P2 as double)as double
pf_power=MemoryGetProcAddress(_library,"pf_power")
dim shared pf_sgn as function stdcall _
(byval P1 as double)as integer
pf_sgn=MemoryGetProcAddress(_library,"pf_sgn")
dim shared pf_sin as function stdcall _
(byval P1 as double)as double
pf_sin=MemoryGetProcAddress(_library,"pf_sin")
dim shared pf_sqr as function stdcall _
(byval P1 as double)as double
pf_sqr=MemoryGetProcAddress(_library,"pf_sqr")
dim shared pc_print_string as sub stdcall _
(byval P1 as string)
pc_print_string=MemoryGetProcAddress(_library,"pc_print_string")
Declare Sub COMPLEX_ADD(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
Declare Sub COMPLEX_SUB(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
Declare Sub COMPLEX_MUL(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
Declare Sub COMPLEX_SQUARE(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_CUBE(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_DIV(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
Declare Sub COMPLEX_INV(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_SGN(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_ABS(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_ARG(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_SQRT(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_LOG(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_EXP(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_REALPOWER(V_A_X as double,V_A_Y as double,V_P as double)
Declare Sub COMPLEX_POWER(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
Declare Sub COMPLEX_SIN(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_SIN(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_COS(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_COS(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_TAN(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_TAN(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_ASIN(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_ASIN(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_ACOS(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_ACOS(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_ATAN(V_A_X as double,V_A_Y as double)
Declare Sub COMPLEX_ATANH(V_A_X as double,V_A_Y as double)
Sub COMPLEX_ADD(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
V_ERRCODE=0
V_R_X=V_A_X+V_B_X
V_R_Y=V_A_Y+V_B_Y
End Sub
Sub COMPLEX_SUB(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
V_ERRCODE=0
V_R_X=V_A_X-V_B_X
V_R_Y=V_A_Y-V_B_Y
End Sub
Sub COMPLEX_MUL(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
V_ERRCODE=0
V_R_X=V_A_X*V_B_X-V_A_Y*V_B_Y
V_R_Y=V_A_X*V_B_Y+V_A_Y*V_B_X
End Sub
Sub COMPLEX_SQUARE(V_A_X as double,V_A_Y as double)
V_ERRCODE=0
V_R_X=V_A_X*V_A_X-V_A_Y*V_A_Y
V_R_Y=2*V_A_X*V_A_Y
End Sub
Sub COMPLEX_CUBE(V_A_X as double,V_A_Y as double)
DIM V_X2 AS DOUBLE
DIM V_Y2 AS DOUBLE
DIM V_X3 AS DOUBLE
DIM V_Y3 AS DOUBLE
V_ERRCODE=0
V_X2=V_A_X*V_A_X
V_X3=V_X2*V_A_X
V_Y2=V_A_Y*V_A_Y
V_Y3=V_Y2*V_A_Y
V_R_X=V_X3-3*V_A_X*V_Y2
V_R_Y=3*V_X2*V_A_Y-V_Y3
End Sub
Sub COMPLEX_DIV(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
DIM V_TEMP AS DOUBLE
IF V_B_X=0 AND V_B_Y=0 THEN
V_ERRCODE=-3
V_R_X=V_MAXNUM
V_R_Y=V_MAXNUM
ELSE
V_ERRCODE=0
V_TEMP=V_B_X*V_B_X+V_B_Y*V_B_Y
V_R_X=(V_A_X*V_B_X+V_A_Y*V_B_Y)/V_TEMP
V_R_Y=(V_A_Y*V_B_X-V_A_X*V_B_Y)/V_TEMP
END IF
End Sub
Sub COMPLEX_INV(V_A_X as double,V_A_Y as double)
DIM V_TEMP AS DOUBLE
IF V_A_X=0 AND V_A_Y=0 THEN
V_ERRCODE=-3
V_R_X=V_MAXNUM
V_R_Y=V_MAXNUM
ELSE
V_ERRCODE=0
V_TEMP=V_A_X*V_A_X+V_A_Y*V_A_Y
V_R_X=V_A_X/V_TEMP
V_R_Y=0-V_A_Y/V_TEMP
END IF
End Sub
Sub COMPLEX_SGN(V_A_X as double,V_A_Y as double)
V_ERRCODE=0
IF V_A_X>0 THEN
V_R_SGN=1
ELSE
IF V_A_Y<0 THEN
V_R_SGN=-1
ELSE
IF V_A_Y>0 THEN
V_R_SGN=1
ELSE
IF V_A_Y<0 THEN
V_R_SGN=-1
ELSE
V_R_SGN=0
END IF
END IF
END IF
END IF
End Sub
Sub COMPLEX_ABS(V_A_X as double,V_A_Y as double)
V_ERRCODE=0
DIM V_ABSX AS DOUBLE
DIM V_ABSY AS DOUBLE
DIM V_R AS DOUBLE
DIM V_C AS DOUBLE
V_ABSX=pf_ABS(V_A_X)
V_ABSY=pf_ABS(V_A_Y)
IF V_A_X=0 THEN
V_R_MOD=pf_ABS(V_A_Y)
ELSE
IF V_A_Y=0 THEN
V_R_MOD=pf_ABS(V_A_X)
ELSE
IF V_ABSX>V_ABSY THEN
V_R=V_ABSY/V_ABSX
V_C=V_ABSX
ELSE
V_R=V_ABSX/V_ABSY
V_C=V_ABSY
END IF
V_R_MOD=V_C*pf_SQR(1+V_R*V_R)
END IF
END IF
End Sub
Sub COMPLEX_ARG(V_A_X as double,V_A_Y as double)
V_ERRCODE=0
IF V_A_X=0 THEN
V_R_ARG=pf_SGN(V_A_Y)*V_PIDIV2
ELSE
V_R_ARG=pf_ATN(V_A_Y/V_A_X)
IF V_A_X<0 THEN
IF V_A_Y>0 THEN
V_R_ARG=V_R_ARG+V_PI
ELSE
V_R_ARG=V_R_ARG-V_PI
END IF
END IF
END IF
End Sub
Sub COMPLEX_SQRT(V_A_X as double,V_A_Y as double)
DIM V_X AS DOUBLE
DIM V_Y AS DOUBLE
DIM V_W AS DOUBLE
DIM V_R AS DOUBLE
V_ERRCODE=0
IF V_A_X=0 AND V_A_Y=0 THEN
V_R_X=0
V_R_Y=0
ELSE
V_X=pf_ABS(V_A_X)
V_Y=pf_ABS(V_A_Y)
IF V_X>=V_Y THEN
V_R=V_Y/V_X
V_W=pf_SQR(V_X)*pf_SQR(0.5*(1+pf_SQR(1+V_R*V_R)))
ELSE
V_R=V_X/V_Y
V_W=pf_SQR(V_Y)*pf_SQR(0.5*(V_R+pf_SQR(1+V_R*V_R)))
END IF
IF V_A_X>=0.0 THEN
V_R_X=V_W
V_R_Y=V_A_Y/(2*V_R_X)
ELSE
IF V_A_Y>=0 THEN
V_R_Y=V_W
ELSE
V_R_Y=0-V_W
END IF
V_R_X=V_A_Y/(2*V_R_Y)
END IF
END IF
End Sub
Sub COMPLEX_LOG(V_A_X as double,V_A_Y as double)
IF V_A_X=0 AND V_A_Y=0 THEN
V_ERRCODE=-2
V_R_X=0-V_MAXNUM
V_R_Y=0
ELSE
V_ERRCODE=0
COMPLEX_ABS(V_A_X,V_A_Y)
COMPLEX_ARG(V_A_X,V_A_Y)
V_R_X=pf_LOG(V_R_MOD)
V_R_Y=V_R_ARG
END IF
End Sub
Sub COMPLEX_EXP(V_A_X as double,V_A_Y as double)
DIM V_EXPX AS DOUBLE
IF V_A_X<V_MINLOG THEN
V_ERRCODE=-4
V_R_X=0
V_R_Y=0
ELSE
IF V_A_X>V_MAXLOG THEN
V_ERRCODE=-3
V_EXPX=V_MAXNUM
ELSE
V_ERRCODE=0
V_EXPX=pf_EXP(V_A_X)
END IF
V_R_X=V_EXPX*pf_COS(V_A_Y)
V_R_Y=V_EXPX*pf_SIN(V_A_Y)
END IF
End Sub
Sub COMPLEX_REALPOWER(V_A_X as double,V_A_Y as double,V_P as double)
V_ERRCODE=0
IF V_A_X=0 AND V_A_Y=0 THEN
IF V_R=0 THEN
V_R_X=1
V_R_Y=0
ELSE
IF V_P>0 THEN
V_R_X=0
V_R_Y=0
ELSE
V_ERRCODE=-2
V_R_X=V_MAXNUM
V_R_Y=V_MAXNUM
END IF
END IF
ELSE
COMPLEX_ABS(V_A_X,V_A_Y)
COMPLEX_ARG(V_A_X,V_A_Y)
V_R_MOD=pf_POWER(V_R_MOD,V_P)
V_R_ARG=V_R_ARG*V_P
V_R_X=V_R_MOD*pf_COS(V_R_ARG)
V_R_Y=V_R_MOD*pf_SIN(V_R_ARG)
END IF
End Sub
Sub COMPLEX_POWER(V_A_X as double,V_A_Y as double,V_B_X as double,V_B_Y as double)
V_ERRCODE=0
IF V_A_X=0 AND V_A_Y=0 THEN
IF V_B_X=0 AND V_B_Y=0 THEN
V_R_X=1
V_R_Y=0
ELSE
V_R_X=0
V_R_Y=0
END IF
ELSE
COMPLEX_ABS(V_A_X,V_A_Y)
COMPLEX_ARG(V_A_X,V_A_Y)
COMPLEX_MUL(V_B_X,V_B_Y,pf_LOG(V_R_MOD),V_R_ARG)
COMPLEX_EXP(V_R_X,V_R_Y)
END IF
End Sub
Sub COMPLEX_SIN(V_A_X as double,V_A_Y as double)
V_ERRCODE=0
V_R_X=pf_SIN(V_A_X)*pf_HCOS(V_A_Y)
V_R_Y=pf_COS(V_A_X)*pf_HSIN(V_A_Y)
End Sub
Sub COMPLEX_SIN(V_A_X as double,V_A_Y as double)
V_ERRCODE=0
V_R_X=pf_HSIN(V_A_X)*pf_COS(V_A_Y)
V_R_Y=pf_HCOS(V_A_X)*pf_SIN(V_A_Y)
End Sub
Sub COMPLEX_COS(V_A_X as double,V_A_Y as double)
V_ERRCODE=0
V_R_X=pf_COS(V_A_X)*pf_HCOS(V_A_Y)
V_R_Y=0-pf_SIN(V_A_X)*pf_HSIN(V_A_Y)
End Sub
Sub COMPLEX_COS(V_A_X as double,V_A_Y as double)
V_ERRCODE=0
V_R_X=pf_HCOS(V_A_X)*pf_COS(V_A_Y)
V_R_Y=pf_HSIN(V_A_X)*pf_SIN(V_A_Y)
End Sub
Sub COMPLEX_TAN(V_A_X as double,V_A_Y as double)
DIM V_X2 AS DOUBLE
DIM V_Y2 AS DOUBLE
DIM V_TEMP AS DOUBLE
V_X2=2*V_A_X
V_Y2=2*V_A_Y
V_TEMP=pf_COS(V_X2)+pf_HCOS(V_Y2)
IF V_TEMP<>0 THEN
V_ERRCODE=0
V_R_X=pf_SIN(V_X2)/V_TEMP
V_R_Y=pf_HSIN(V_Y2)/V_TEMP
ELSE
V_ERRCODE=-2
V_R_X=V_MAXNUM
V_R_Y=0
END IF
End Sub
Sub COMPLEX_TAN(V_A_X as double,V_A_Y as double)
DIM V_X2 AS DOUBLE
DIM V_Y2 AS DOUBLE
DIM V_TEMP AS DOUBLE
V_X2=2.0*V_A_X
V_Y2=2.0*V_A_Y
V_TEMP=pf_HCOS(V_X2)+pf_COS(V_Y2)
IF V_TEMP=0 THEN
V_ERRCODE=-2
V_R_X=0
V_R_Y=V_MAXNUM
ELSE
V_ERRCODE=0
V_R_X=pf_HSIN(V_X2)/V_TEMP
V_R_Y=pf_SIN(V_Y2)/V_TEMP
END IF
End Sub
Sub COMPLEX_ASIN(V_A_X as double,V_A_Y as double)
DIM V_X2 AS DOUBLE
DIM V_XX AS DOUBLE
DIM V_YY AS DOUBLE
DIM V_RP AS DOUBLE
DIM V_RM AS DOUBLE
DIM V_S AS DOUBLE
DIM V_T AS DOUBLE
V_X2=2*V_A_X
V_XX=V_A_X*V_A_X
V_YY=V_A_Y*V_A_Y
V_S=V_XX+V_YY+1
V_RP=0.5*pf_SQR(V_S+V_X2)
V_RM=0.5*pf_SQR(V_S-V_X2)
V_T=V_RP+V_RM
V_ERRCODE=0
COMPLEX_SGN(V_A_Y,0-V_A_X)
V_R_X=pf_ASIN(V_RP-V_RM)
V_R_Y=V_R_SGN*pf_LOG(V_T+pf_SQR(V_T*V_T-1))
End Sub
Sub COMPLEX_ASIN(V_A_X as double,V_A_Y as double)
DIM V_T AS DOUBLE
COMPLEX_ASIN(0-V_A_Y,V_A_X)
V_T=V_R_X
V_R_X=V_R_Y
V_R_Y=0-V_T
End Sub
Sub COMPLEX_ACOS(V_A_X as double,V_A_Y as double)
COMPLEX_ASIN(V_A_X,V_A_Y)
V_R_X=V_PIDIV2-V_R_X
V_R_Y=0-V_R_Y
End Sub
Sub COMPLEX_ACOS(V_A_X as double,V_A_Y as double)
DIM V_T AS DOUBLE
COMPLEX_SGN(V_A_Y,1-V_A_X)
COMPLEX_ACOS(V_A_X,V_A_Y)
V_T=V_R_X
V_R_X=0-V_R_SGN*V_R_Y
V_R_Y=V_R_SGN*V_T
End Sub
Sub COMPLEX_ATAN(V_A_X as double,V_A_Y as double)
DIM V_XX AS DOUBLE
DIM V_YY AS DOUBLE
DIM V_YP1 AS DOUBLE
DIM V_YM1 AS DOUBLE
DIM V_A1 AS DOUBLE
DIM V_A2 AS DOUBLE
IF V_A_X=0 AND pf_ABS(V_A_Y)=1 THEN
V_ERRCODE=-2
V_R_X=0
V_R_Y=pf_SGN(V_A_Y)*V_MAXNUM
ELSE
V_ERRCODE=0
V_XX=V_A_X*V_A_X
V_YY=V_A_Y*V_A_Y
V_YP1=V_A_Y+1
V_YM1=V_A_Y-1
COMPLEX_ARG(0-V_YM1,V_A_X)
V_A1=V_R_ARG
COMPLEX_ARG(V_YP1,0-V_A_X)
V_A2=V_R_ARG
V_R_X=0.5*(V_A1-V_A2)
V_R_Y=0.25*pf_LOG((V_XX+V_YP1*V_YP1)/(V_XX+V_YM1*V_YM1))
END IF
End Sub
Sub COMPLEX_ATANH(V_A_X as double,V_A_Y as double)
DIM V_T AS DOUBLE
COMPLEX_ATAN(0-V_A_Y,V_A_X)
V_T=V_R_X
V_R_X=V_R_Y
V_R_Y=0-V_T
End Sub
declare function WinMain _
(byval _hInstance as HINSTANCE,_
byval _hPrevInstance as HINSTANCE,_
byval _szCmdLine as string,_
byval _iCmdShow as integer)as integer
end WinMain(GetModuleHandle(null),null,Command(),SW_NORMAL)
function WndProc _
(byval _hWnd as HWND,_
byval _wMsg as UINT,_
byval _wParam as WPARAM,_
byval _lParam as LPARAM)as LRESULT
function=0
select case(_wMsg)
case WM_CREATE
exit function
case WM_DESTROY
pc_close()
sleep 200
MemoryFreeLibrary(_library)
PostQuitMessage(0)
exit function
end select
function=DefWindowProc(_hWnd,_wMsg,_wParam,_lParam)
end function
function WinMain (byval _hInstance as HINSTANCE,_
byval _hPrevInstance as HINSTANCE,_
byval _szCmdLine as string,_
byval _iCmdShow as integer)as integer
dim _wMsg as MSG
dim _wcls as WNDCLASS
dim _hWnd as HWND
function=0
with _wcls
.style=CS_HREDRAW or CS_VREDRAW
.lpfnWndProc=@WndProc
.cbClsExtra=0
.cbWndExtra=0
.hInstance=_hInstance
.hIcon=LoadIcon(NULL,IDI_APPLICATION)
.hCursor=LoadCursor(NULL,IDC_ARROW)
.hbrBackground=GetStockObject(WHITE_BRUSH)
.lpszMenuName=NULL
.lpszClassName=@"HelloWin"
end with
if(RegisterClass(@_wcls)=FALSE)then
MessageBox(null,"Failed to register _wcls","Error",MB_ICONERROR)
exit function
end if
_hWnd = CreateWindowEx(0,_
@"HelloWin",_
"PANORAMIC",_
WS_OVERLAPPEDWINDOW,_
10,_
10,_
200,_
100,_
NULL,_
NULL,_
_hInstance,_
NULL)
_handl=_hWnd
UpdateWindow(_hWnd)
pc_init(_hWnd)
sleep 100
V_MAXLOG=709.78
V_MINLOG=-708.39
V_MAXNUM=pf_EXP(V_MAXLOG)
V_MINNUM=pf_EXP(V_MINLOG)
V_PI=4*pf_ATN(1)
V_PIDIV2=V_PI/2
V_X=1
V_Y=2
COMPLEX_SIN(V_X,V_Y)
V_SX=V_R_X
V_SY=V_R_Y
COMPLEX_COS(V_X,V_Y)
V_CX=V_R_X
V_CY=V_R_Y
COMPLEX_SQUARE(V_SX,V_SY)
V_S2X=V_R_X
V_S2Y=V_R_Y
COMPLEX_SQUARE(V_CX,V_CY)
V_C2X=V_R_X
V_C2Y=V_R_Y
COMPLEX_ADD(V_S2X,V_S2Y,V_C2X,V_C2Y)
pc_print_string("z                   = "+str(V_X)+" + "+str(V_Y)+" * i")
pc_print_string("sin(z)              = "+str(V_SX)+" + "+str(V_SY)+" * i")
pc_print_string("cos(z)              = "+str(V_CX)+" + "+str(V_CY)+" * i")
pc_print_string("sin(z)^2            = "+str(V_S2X)+" + "+str(V_S2Y)+" * i")
pc_print_string("cos(z)^2            = "+str(V_C2X)+" + "+str(V_C2Y)+" * i")
pc_print_string("sin(z)^2 + cos(z)^2 = "+str(V_R_X)+" + "+str(V_R_Y)+" * i")
goto _end
_end:
while(GetMessage(@_wMsg,NULL,0,0)<>FALSE)
TranslateMessage(@_wMsg)
DispatchMessage(@_wMsg)
wend
function=_wMsg.wParam
end function

Serait-il possible de corriger ce bug ?
Revenir en haut Aller en bas
http://www.unilim.fr/pages_perso/jean.debord/index.htm
papydall

papydall


Nombre de messages : 6989
Age : 73
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

Problème avec les SUBS Empty
MessageSujet: Re: Problème avec les SUBS   Problème avec les SUBS EmptyMer 28 Mai 2014 - 19:58

Salut Jean_Debord.

J’ai corrigé  ce qui ne va pas : maintenant ça marche, mais je n’arrive toujours pas à savoir pourquoi ça ne marchait pas avant !
Je m’explique :

J’ai testé et compilé une à une toutes les SUB, jusqu’à ce que l’erreur de duplication s’est manifestée.
L’erreur est au niveau des SUB suivantes :
Complex_Sinh
Complex_Cosh
Complex_Tanh
Complex_Atanh
Complex_Asinh
Complex_AcosH

J’ai essayé plein de trucs pour finalement comprendre que, pour les SUB sus-indiquées, le compilateur n’aime pas leur identificateur !
Il semble que le mot Complex n’est pas estimé par le compilateur !
Bref, changez Complex par ce que vous voulez et ça marchera !
Pour ma part, j’ai changé leur nom par Complexe_... et tout fonctionne.

Le compilateur préfère le Complexe français au  Complex anglais !  Laughing  Laughing 

Voici le code que j’ai adapté

Code:

' *******************************************************************
' Variables globales de la bibliotheque
' *******************************************************************

' Constantes mathematiques

dim MaxNum, MinNum, MaxLog, MinLog, Pi, PiDiv2

MaxLog = 709.78      : ' Argument max. pour EXP
MinLog = -708.39     : ' Argument min. pour EXP
MaxNum = exp(MaxLog) : ' Nb reel max. ~ 2^1024
MinNum = exp(MinLog) : ' Nb reel min. ~ 2^(-1022)
Pi     = 4 * atn(1)
PiDiv2 = Pi / 2

' Resultats des calculs
' Partie reelle, partie imaginaire, module, argument, signe

dim r_x, r_y, r_mod, r_arg, r_sgn

' Code d'erreur
'  0 = pas d'erreur
' -1 = argument hors bornes
' -2 = singularite
' -3 = overflow
' -4 = underflow

dim ErrCode%

' *******************************************************************
' Programme de test : Calcul de sin(z)^2 + cos(z)^2
' *******************************************************************
dim x1, y1       : ' z1
dim x2, y2       : ' z2
dim sx, sy       : ' sin(z)
dim cx, cy       : ' cos(z)
dim s2x, s2y     : ' sin(z)^2
dim c2x, c2y     : ' cos(z)^2
dim p            : ' puissance
rem ============================================================================
height 0, screen_y-100
' Tests
x1 = 1 : y1 = 2
x2 = 2 : y2 = 3

print " z1 --> x1 = " + str$(x1) + " , y1 = " + str$(y1)
print " z2 --> x2 = " + str$(x2) + " , y2 = " + str$(y2)

Complex_Add(x1,y1,x2,y2) : print " Addition             : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Sub(x1,y1,x2,y2) : print " Soustraction         : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Mul(x1,y1,x2,y2) : print " Multiplication       : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Div(x1,y1,x2,y2) : print " Division             : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Square(x1,y1)    : print " Carré de z1          : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Cube(x1,y1)      : print " Cube de z1           : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Inv(x1,y1)       : print " Inverse de z1        : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Sgn(x1,y1)       : print " Signe de z1          : " + str$(r_sgn)
Complex_Abs(x1,y1)       : print " Val Abs de z1        : " + str$(r_mod)
Complex_Arg(x1,y1)       : print " Arg de z1            : " + str$(r_arg)
Complex_Sqrt(x1,y1)      : print " Racine Carrée de z1  : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Log(x1,y1)       : print " Logarithme de z1     : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Exp(x1,y1)       : print " Exponentielle de z1  : " + str$(r_x) + " + " + str$(r_y) + " * i"
p = 3 : Complex_RealPower(x1,y1,p) : print " z1 Puissance p=("+str$(p)+")   : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Power(x1,y1,x2,y2) : print " z1 Puissance z2      : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Sin(x1,y1)      : print " Sinus de z1          : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Cos(x1,y1)      : print " Cosinus de z1        : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_Tan(x1,y1)      : print " Tangente de z1       : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_ASin(x1,y1)     : print " ArcSin de z1         : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_ACos(x1,y1)     : print " ArcCos de z1         : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_ATan(x1,y1)     : print " ArcTan de z1         : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complexe_Sinh(x1,y1)    : print " Sinh de z1           : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complexe_Cosh(x1,y1)    : print " Cosh de z1           : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complexe_Tanh(x1,y1)    : print " Tanh de z1           : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complex_ATanh(x1,y1)    : print " ATanh de z1          : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complexe_ASinh(x1,y1)   : print " ASinh de z1          : " + str$(r_x) + " + " + str$(r_y) + " * i"
Complexe_ACosh(x1,y1)   : print " ACosh de z1          : " + str$(r_x) + " + " + str$(r_y) + " * i"

' ==============================================================================
Complex_Sin(x1, y1) : sx = r_x : sy = r_y

Complex_Cos(x1, y1) : cx = r_x : cy = r_y

Complex_Square(sx, sy) : s2x = r_x : s2y = r_y

Complex_Square(cx, cy) : c2x = r_x : c2y = r_y

Complex_Add(s2x, s2y, c2x, c2y)
print "======================================================================="
print "z                   = " + str$(x1)   + " + " + str$(y1)   + " * i"
print "sin(z)              = " + str$(sx)  + " + " + str$(sy)  + " * i"
print "cos(z)              = " + str$(cx)  + " + " + str$(cy)  + " * i"
print "sin(z)^2            = " + str$(s2x) + " + " + str$(s2y) + " * i"
print "cos(z)^2            = " + str$(c2x) + " + " + str$(c2y) + " * i"
print "sin(z)^2 + cos(z)^2 = " + str$(r_x) + " + " + str$(r_y) + " * i"

end
rem ============================================================================
' *******************************************************************
' Procedures de la bibliotheque
' *******************************************************************

sub Complex_Add(a_x, a_y, b_x, b_y)
' Addition : r_x + i r_y = (a_x + i a_y) + (b_x + i b_y)

 ErrCode% = 0

 r_x = a_x + b_x
 r_y = a_y + b_y
end_sub
rem ============================================================================
sub Complex_Sub(a_x, a_y, b_x, b_y)
' Soustraction : r_x + i r_y = (a_x + i a_y) - (b_x + i b_y)

 ErrCode% = 0

 r_x = a_x - b_x
 r_y = a_y - b_y
end_sub
rem ============================================================================
sub Complex_Mul(a_x, a_y, b_x, b_y)
' Multiplication : r_x + i r_y = (a_x + i a_y) * (b_x + i b_y)

 ErrCode% = 0

 r_x = a_x * b_x - a_y * b_y
 r_y = a_x * b_y + a_y * b_x
end_sub
rem ============================================================================
sub Complex_Square(a_x, a_y)
' Carre : r_x + i r_y = (a_x + i a_y)^2

 ErrCode% = 0

 r_x = a_x * a_x - a_y * a_y
 r_y = 2 * a_x * a_y
end_sub
rem ============================================================================
sub Complex_Cube(a_x, a_y)
' Cube : r_x + i r_y = (a_x + i a_y)^3

 dim_local x2, y2, x3, y3

 ErrCode% = 0

 x2 = a_x * a_x : x3 = x2 * a_x
 y2 = a_y * a_y : y3 = y2 * a_y

 r_x = x3 - 3 * a_x * y2
 r_y = 3 * x2 * a_y - y3
end_sub
rem ============================================================================
sub Complex_Div(a_x, a_y, b_x, b_y)
' Division : r_x + i r_y = (a_x + i a_y) / (b_x + i b_y)

 dim_local Temp

 if b_x = 0 and b_y = 0
   ErrCode% = -3
   r_x = MaxNum
   r_y = MaxNum
 else
   ErrCode% = 0
   Temp = b_x * b_x + b_y * b_y
   r_x = (a_x * b_x + a_y * b_y) / Temp
   r_y = (a_y * b_x - a_x * b_y) / Temp
 end_if
end_sub
rem ============================================================================
sub Complex_Inv(a_x, a_y)
' Inverse : r_x + i r_y = 1 / (a_x + i a_y)

 dim_local Temp

 if a_x = 0 and a_y = 0
   ErrCode% = -3
   r_x = MaxNum
   r_y = MaxNum
 else
   ErrCode% = 0
   Temp = a_x * a_x + a_y * a_y
   r_x = a_x / Temp
   r_y = 0 - a_y / Temp
 end_if
end_sub
rem ============================================================================
sub Complex_Sgn(a_x, a_y)
' Signe complexe

 ErrCode% = 0

 if a_x > 0
   r_sgn = 1
 else
   if a_y < 0
     r_sgn = -1
   else
     if a_y > 0
       r_sgn = 1
     else
       if a_y < 0
         r_sgn= -1
       else
         r_sgn = 0
       end_if
     end_if
   end_if
 end_if
end_sub
rem ============================================================================
sub Complex_Abs(a_x, a_y)
' Module : r_mod = |a_x + i a_y|
' Algorithme d'apres "Numerical Recipes"

 ErrCode% = 0

 dim_local AbsX, AbsY, R, C

 AbsX = abs(a_x)
 AbsY = abs(a_y)

 if a_x = 0
   r_mod = abs(a_y)
 else
   if a_y = 0
     r_mod = abs(a_x)
   else
     if AbsX > AbsY
       R = AbsY / AbsX
       C = AbsX
     else
       R = AbsX / AbsY
       C = AbsY
     end_if
     r_mod = C * sqr(1 + R * R)
   end_if
 end_if
end_sub
rem ============================================================================
sub Complex_Arg(a_x, a_y)
' Argument : r_arg = arg(a_x + i a_y)
' Resultat dans [-Pi, Pi)
' Equivaut a atan2(a_y, a_x)

 ErrCode% = 0

 if a_x = 0
   r_arg = sgn(a_y) * PiDiv2
 else
   ' 4e / 1er quadrant : -Pi/2..Pi/2
   r_arg = atn(a_y / a_x)
   if a_x < 0
     if a_y > 0
       ' 2e quadrant : Pi/2..Pi
       r_arg = r_arg + Pi
     else
       ' 3e quadrant : -Pi..-Pi/2
       r_arg = r_arg - Pi
     end_if
   end_if
 end_if
end_sub
rem ============================================================================
sub Complex_Sqrt(a_x, a_y)
' Racine carree : r_x + i r_y = sqrt(a_x + i a_y)
' Algorithme d'apres "Numerical Recipes"

 dim_local X, Y, W, R

 ErrCode% = 0

 if a_x = 0 and a_y = 0
   r_x = 0
   r_y = 0
 else
   X = abs(a_x)
   Y = abs(a_y)

   if X >= Y
     R = Y / X
     W = sqr(X) * sqr(0.5 * (1 + sqr(1 + R * R)))
   else
     R = X / Y
     W = sqr(Y) * sqr(0.5 * (R + sqr(1 + R * R)))
   end_if

   if a_x >= 0.0
     r_x = W
     r_y = a_y / (2 * r_x)
   else
     if a_y >= 0
       r_y = W
     else
       r_y = 0 - W
     end_if
     r_x = a_y / (2 * r_y)
   end_if
 end_if
end_sub
rem ============================================================================
sub Complex_Log(a_x, a_y)
' Partie principale du logarithme complexe
' r_x + i r_y = ln(a_x + i a_y)

 if a_x = 0 and a_y = 0
   ErrCode% = -2
   r_x = 0 - MaxNum
   r_y = 0
 else
   ErrCode% = 0
   Complex_Abs(a_x, a_y)
   Complex_Arg(a_x, a_y)
   r_x = log(r_mod)
   r_y = r_arg
 end_if
end_sub
rem ============================================================================
sub Complex_Exp(a_x, a_y)
' Exponentielle complexe : r_x + i r_y = exp(a_x + i a_y)

 dim_local ExpX

 if a_x < MinLog
   ErrCode% = -4
   r_x = 0
   r_y = 0
 else
   if a_x > MaxLog
     ErrCode = -3
     ExpX = MaxNum
   else
     ErrCode% = 0
     ExpX = exp(a_x)
   end_if
   r_x = ExpX * cos(a_y)
   r_y = ExpX * sin(a_y)
 end_if
end_sub
rem ============================================================================
sub Complex_RealPower(a_x, a_y, p)
' Puissance (exposant reel) : (a_x + i a_y)^p
' Resultat dans r_x, r_y
' Resultat aussi dans r_mod, r_arg si a <> 0

 ErrCode% = 0

 if a_x = 0 and a_y = 0
   if r = 0
     ' 0^0 = lim x^x quand x --> 0 = 1
     r_x = 1
     r_y = 0
   else
     if p > 0
       ' 0^p = 0 si p > 0
       r_x = 0
       r_y = 0
     else
       ' 0^p indefini si p < 0
       ErrCode% = -2
       r_x = MaxNum
       r_y = MaxNum
     end_if
   end_if
 else
   Complex_Abs(a_x, a_y)
   Complex_Arg(a_x, a_y)
   r_mod = power(r_mod, p)
   r_arg = r_arg * p
   r_x = r_mod * cos(r_arg)
   r_y = r_mod * sin(r_arg)
 end_if
end_sub
rem ============================================================================
sub Complex_Power(a_x, a_y, b_x, b_y)
' Puissance (exposant complexe) : (a_x + i a_y)^(b_x + i b_y)
' Resultat dans r_x, r_y

 ErrCode% = 0

 if a_x = 0 and a_y = 0
   if b_x = 0 and b_y = 0
     ' 0^0 = lim x^x quand x --> 0 = 1
     r_x = 1
     r_y = 0
   else
     ' 0^p = 0 si p > 0
     r_x = 0
     r_y = 0
   end_if
 else
   ' exp(b ln(a))
   Complex_Abs(a_x, a_y)
   Complex_Arg(a_x, a_y)
   Complex_Mul(b_x, b_y, log(r_mod), r_arg)
   Complex_Exp(r_x, r_y)
 end_if
end_sub
rem ============================================================================
sub Complex_Sin(a_x, a_y)
' Sinus complexe : r_x + i r_y = sin(a_x + i a_y)

 ErrCode% = 0

 r_x = sin(a_x) * hcos(a_y)
 r_y = cos(a_x) * hsin(a_y)
end_sub
rem ============================================================================
sub Complex_Cos(a_x, a_y)
' Cosinus complexe : r_x + i r_y = cos(a_x + i a_y)

 ErrCode% = 0

 r_x = cos(a_x) * hcos(a_y)
 r_y = 0 - sin(a_x) * hsin(a_y)
end_sub
rem ============================================================================
sub Complex_Tan(a_x, a_y)
' Tangente complexe : r_x + i r_y = tan(a_x + i a_y)

 dim_local X2, Y2, Temp

 X2 = 2 * a_x
 Y2 = 2 * a_y

 Temp = cos(X2) + hcos(Y2)

 if Temp <> 0
   ErrCode% = 0
   r_x = sin(X2) / Temp
   r_y = hsin(Y2) / Temp
 else
   ' a = Pi/2 + k*Pi
   ErrCode% = -2
   r_x = MaxNum
   r_y = 0
 end_if
end_sub
rem ============================================================================
sub Complex_ASin(a_x, a_y)
' Arc Sinus complexe : r_x + i r_y = asin(a_x + i a_y)

 dim_local X2, XX, YY, Rp, Rm, S, T

 X2 = 2 * a_x
 XX = a_x * a_x
 YY = a_y * a_y
 S  = XX + YY + 1
 Rp = 0.5 * sqr(S + X2)
 Rm = 0.5 * sqr(S - X2)
 T  = Rp + Rm

 ErrCode% = 0

 Complex_Sgn(a_y, 0 - a_x)

 r_x = asin(Rp - Rm)
 r_y = r_sgn * log(T + sqr(T * T - 1))
end_sub
rem ============================================================================
sub Complex_ACos(a_x, a_y)
' Arc Cosinus complexe :
' r_x + i r_y = acos(a_x + i a_y) = Pi/2 - ASin(a)

 Complex_ASin(a_x, a_y)

 r_x = PiDiv2 - r_x
 r_y = 0 - r_y
end_sub
rem ============================================================================
sub Complex_ATan(a_x, a_y)
' Arc Tangente complexe : r_x + i r_y = atan(a_x + i a_y)

 dim_local XX, YY, Yp1, Ym1, A1, A2

 if a_x = 0 and abs(a_y) = 1
   ' a = +/- i
   ErrCode% = -2
   r_x = 0
   r_y = sgn(a_y) * MaxNum
 else
   ErrCode% = 0

   XX  = a_x * a_x
   YY  = a_y * a_y
   Yp1 = a_y + 1
   Ym1 = a_y - 1

   Complex_Arg(0 - Ym1, a_x) : A1 = r_arg : ' = atan2(a_x, - Ym1)
   Complex_Arg(Yp1, 0 - a_x) : A2 = r_arg : ' = atan2(- Ym1, a_x)

   r_x = 0.5 * (A1 - A2)
   r_y = 0.25 * log((XX + Yp1 * Yp1) / (XX + Ym1 * Ym1))
 end_if
end_sub
rem ============================================================================
 sub Complex_ATanh(a_x, a_y)
' Argument Tangente hyperbolique complexe :
' r_x + i r_y = atanh(a_x + i a_y) = -i*atan(i*a)

 dim_local t

 Complex_ATan(0 - a_y, a_x)

 t = r_x
 r_x = r_y
 r_y = 0 - t
end_sub
rem ============================================================================
sub Complexe_Sinh(a_x, a_y)
' Sinus hyperbolique complexe : r_x + i r_y = sinh(a_x + i a_y)

 ErrCode% = 0

 r_x = hsin(a_x) * cos(a_y)
 r_y = hcos(a_x) * sin(a_y)
end_sub
rem ============================================================================
sub Complexe_Cosh(a_x, a_y)
' Cosinus hyperbolique complexe : r_x + i r_y = cosh(a_x + i a_y)

 ErrCode% = 0

 r_x = hcos(a_x) * cos(a_y)
 r_y = hsin(a_x) * sin(a_y)
end_sub
rem ============================================================================
sub Complexe_Tanh(a_x, a_y)
' Tangente hyperbolique complexe : r_x + i r_y = tanh(a_x + i a_y)

 dim_local X2, Y2, Temp

 X2 = 2.0 * a_x
 Y2 = 2.0 * a_y

 Temp = hcos(X2) + cos(Y2)

 if Temp = 0
   ' a = i * (Pi/2 + k*Pi)
   ErrCode% = -2
   r_x = 0
   r_y = MaxNum
 else
   ErrCode% = 0
   r_x = hsin(X2) / Temp
   r_y = sin(Y2) / Temp
 end_if
end_sub
rem ============================================================================
sub Complexe_ASinh(a_x, a_y)
' Argument Sinus hyperbolique complexe :
' r_x + i r_y = asinh(a_x + i a_y) = -i*asin(i*a)
' i * (a_x + i a_y) = -a_y + i a_x

 dim_local t

 Complex_ASin(0 - a_y, a_x)

 t = r_x
 r_x = r_y
 r_y = 0 - t
end_sub
rem ============================================================================
sub Complexe_ACosh(a_x, a_y)
' Argument Cosinus hyperbolique complexe :
' r_x + i r_y = acosh(a_x + i a_y) = csgn(a_y + i(1 - a_x)) * i * acos(a)

 dim_local t

 Complex_Sgn(a_y, 1 - a_x)
 Complex_ACos(a_x, a_y)

 t = r_x
 r_x = 0 - r_sgn* r_y
 r_y = r_sgn * t
end_sub
rem ============================================================================

Revenir en haut Aller en bas
http://papydall-panoramic.forumarabia.com/
jean_debord

jean_debord


Nombre de messages : 1246
Age : 69
Localisation : Limoges
Date d'inscription : 21/09/2008

Problème avec les SUBS Empty
MessageSujet: Re: Problème avec les SUBS   Problème avec les SUBS EmptyJeu 29 Mai 2014 - 10:55

Merci Papydall Smile

J'avais essayé différents préfixes mais j'utilisais le même préfixe pour toutes les procédures et apparemment c'est cela qui provoquait la duplication !

J'espère que Jack va pouvoir corriger ce bug car c'est un obstacle à l'utilisation des bibliothèques de procédures !
Revenir en haut Aller en bas
http://www.unilim.fr/pages_perso/jean.debord/index.htm
Jicehel

Jicehel


Nombre de messages : 5947
Age : 51
Localisation : 77500
Date d'inscription : 18/04/2011

Problème avec les SUBS Empty
MessageSujet: Re: Problème avec les SUBS   Problème avec les SUBS EmptyJeu 29 Mai 2014 - 11:10

En tout cas, c'est un beau debuggage directement exploitable par Jack Bravo à vous deux et merci de la part de tout les utilisateurs du compilateur.
Revenir en haut Aller en bas
jean_debord

jean_debord


Nombre de messages : 1246
Age : 69
Localisation : Limoges
Date d'inscription : 21/09/2008

Problème avec les SUBS Empty
MessageSujet: Re: Problème avec les SUBS   Problème avec les SUBS EmptyMar 24 Juin 2014 - 9:22

Voici une version améliorée de la bibliothèque. Pour l'utiliser avec le compilateur, il ne faut inclure que les procédures dont on a besoin dans le programme. Le bug se produit lorsqu'il y a beaucoup de procédures.

Variables globales (à inclure en début de programme) :

Code:

' Constantes mathematiques

dim MaxNum, MinNum, MaxLog, MinLog, Pi, PiDiv2

MaxLog =  709.78     : ' Argument max. pour EXP
MinLog = -708.39     : ' Argument min. pour EXP
MaxNum = exp(MaxLog) : ' Nb reel max. ~ 2^1024
MinNum = exp(MinLog) : ' Nb reel min. ~ 2^(-1022)
Pi     = 4 * atn(1)
PiDiv2 = Pi / 2

' Resultats des calculs
' Partie reelle, partie imaginaire, module, argument, signe

dim r_x, r_y, r_mod, r_arg, r_sgn

' Code d'erreur
'  0 = pas d'erreur
' -1 = argument hors bornes
' -2 = singularite
' -3 = overflow
' -4 = underflow

dim ErrCode%

Liste des procédures (à inclure en fin de programme, après le END final) :

Code:

sub CMul(a_x, a_y, b_x, b_y)
' Multiplication : r_x + i r_y = (a_x + i a_y) * (b_x + i b_y)

 ErrCode% = 0

 r_x = a_x * b_x - a_y * b_y
 r_y = a_x * b_y + a_y * b_x
end_sub

sub CSquare(a_x, a_y)
' Carre : r_x + i r_y = (a_x + i a_y)^2

 ErrCode% = 0

 r_x = a_x * a_x - a_y * a_y
 r_y = 2 * a_x * a_y
end_sub

sub CCube(a_x, a_y)
' Cube : r_x + i r_y = (a_x + i a_y)^3

 dim_local x2, y2, x3, y3

 ErrCode% = 0

 x2 = a_x * a_x : x3 = x2 * a_x
 y2 = a_y * a_y : y3 = y2 * a_y

 r_x = x3 - 3 * a_x * y2
 r_y = 3 * x2 * a_y - y3
end_sub

sub CIntPower(a_x, a_y, n%)
' Puissance entiere : r_x + i r_y = (a_x + i a_y)^n

 dim_local m%, b_x, b_y, res_x, res_y
 
 ErrCode% = 0
 
 if a_x = 0 and a_y = 0
   if n% = 0
     ' 0^0 = lim x^x quand x --> 0 = 1
     r_x = 1
     r_y = 0
   else
     if n% > 0
       ' 0^n = 0 si n > 0
       r_x = 0
       r_y = 0
     else
       ' 0^n indefini si n < 0
       ErrCode% = -2
       r_x = MaxNum
       r_y = MaxNum
     end_if
   end_if
 else
   if n% < 0
     m% = abs(n%)
     CInv(a_x, a_y)
     b_x = r_x
     b_y = r_y
   else
     m% = n%
     b_x = a_x
     b_y = a_y
   end_if

   res_x = 1 : res_y = 0

   while m% > 0
     if odd(m%) = 1
       CMul(b_x, b_y, res_x, res_y)
       res_x = r_x
       res_y = r_y
     end_if
     CSquare(b_x, b_y)
     b_x = r_x
     b_y = r_y
     m% = int(m% / 2)
   end_while
 
   r_x = res_x
   r_y = res_y
 end_if  
end_sub

sub CDiv(a_x, a_y, b_x, b_y)
' Division : r_x + i r_y = (a_x + i a_y) / (b_x + i b_y)
' Algorithme d'apres "Numerical Recipes"

 dim_local q, t

 if b_x = 0 and b_y = 0
   ErrCode% = -3
   r_x = MaxNum
   r_y = MaxNum
 else
   ErrCode% = 0
   if abs(b_x) >= abs(b_y)
     q = b_y / b_x
     t = b_x + b_y * q
     r_x = (a_x + a_y * q) / t
     r_y = (a_y - a_x * q) / t
   else
     q = b_x / b_y
     t = b_x * q + b_y
     r_x = (a_x * q + a_y) / t
     r_y = (a_y * q - a_x) / t  
   end_if    
 end_if
end_sub

sub CInv(a_x, a_y)
' Inverse : r_x + i r_y = 1 / (a_x + i a_y)

 dim_local Temp

 if a_x = 0 and a_y = 0
   ErrCode% = -3
   r_x = MaxNum
   r_y = MaxNum
 else
   ErrCode% = 0
   Temp = a_x * a_x + a_y * a_y
   r_x = a_x / Temp
   r_y = 0 - a_y / Temp
 end_if
end_sub

sub CSgn(a_x, a_y)
' Signe complexe

 ErrCode% = 0

 if a_x > 0
   r_sgn = 1
 else
   if a_y < 0
     r_sgn = -1
   else
     if a_y > 0
       r_sgn = 1
     else
       if a_y < 0
         r_sgn= -1
       else
         r_sgn = 0
       end_if
     end_if
   end_if
 end_if
end_sub

sub CAbs(a_x, a_y)
' Module : r_mod = |a_x + i a_y|
' Algorithme d'apres "Numerical Recipes"

 ErrCode% = 0

 dim_local AbsX, AbsY, R, C

 AbsX = abs(a_x)
 AbsY = abs(a_y)

 if a_x = 0
   r_mod = abs(a_y)
 else
   if a_y = 0
     r_mod = abs(a_x)
   else
     if AbsX > AbsY
       R = AbsY / AbsX
       C = AbsX
     else
       R = AbsX / AbsY
       C = AbsY
     end_if
     r_mod = C * sqr(1 + R * R)
   end_if
 end_if
end_sub

sub CArg(a_x, a_y)
' Argument : r_arg = arg(a_x + i a_y)
' Resultat dans [-Pi, Pi)
' Equivaut a atan2(a_y, a_x)

 ErrCode% = 0

 if a_x = 0
   r_arg = sgn(a_y) * PiDiv2
 else
   ' 4e / 1er quadrant : -Pi/2..Pi/2
   r_arg = atn(a_y / a_x)
   if a_x < 0
     if a_y > 0
       ' 2e quadrant : Pi/2..Pi
       r_arg = r_arg + Pi
     else
       ' 3e quadrant : -Pi..-Pi/2
       r_arg = r_arg - Pi
     end_if
   end_if
 end_if
end_sub

sub ATan2(y, x)
' atn(y/x) --> Resultat dans [-Pi, Pi)

 CArg(x, y)
end_sub

sub CSqrt(a_x, a_y)
' Racine carree : r_x + i r_y = sqrt(a_x + i a_y)
' Algorithme d'apres "Numerical Recipes"

 dim_local X, Y, W, R

 ErrCode% = 0

 if a_x = 0 and a_y = 0
   r_x = 0
   r_y = 0
 else
   X = abs(a_x)
   Y = abs(a_y)

   if X >= Y
     R = Y / X
     W = sqr(X) * sqr(0.5 * (1 + sqr(1 + R * R)))
   else
     R = X / Y
     W = sqr(Y) * sqr(0.5 * (R + sqr(1 + R * R)))
   end_if

   if a_x >= 0.0
     r_x = W
     r_y = a_y / (2 * r_x)
   else
     if a_y >= 0
       r_y = W
     else
       r_y = 0 - W
     end_if
     r_x = a_y / (2 * r_y)
   end_if
 end_if
end_sub

sub CLog(a_x, a_y)
' Partie principale du logarithme complexe
' r_x + i r_y = ln(a_x + i a_y)

 if a_x = 0 and a_y = 0
   ErrCode% = -2
   r_x = 0 - MaxNum
   r_y = 0
 else
   ErrCode% = 0
   CAbs(a_x, a_y)
   CArg(a_x, a_y)
   r_x = log(r_mod)
   r_y = r_arg
 end_if
end_sub

sub CExp(a_x, a_y)
' Exponentielle complexe : r_x + i r_y = exp(a_x + i a_y)

 dim_local ExpX

 if a_x < MinLog
   ErrCode% = -4
   r_x = 0
   r_y = 0
 else
   if a_x > MaxLog
     ErrCode = -3
     ExpX = MaxNum
   else
     ErrCode% = 0
     ExpX = exp(a_x)
   end_if
   r_x = ExpX * cos(a_y)
   r_y = ExpX * sin(a_y)
 end_if
end_sub

sub CRealPower(a_x, a_y, p)
' Puissance (exposant reel) : (a_x + i a_y)^p
' Resultat dans r_x, r_y
' Resultat aussi dans r_mod, r_arg si a <> 0

 ErrCode% = 0

 if a_x = 0 and a_y = 0
   if p = 0
     ' 0^0 = lim x^x quand x --> 0 = 1
     r_x = 1
     r_y = 0
   else
     if p > 0
       ' 0^p = 0 si p > 0
       r_x = 0
       r_y = 0
     else
       ' 0^p indefini si p < 0
       ErrCode% = -2
       r_x = MaxNum
       r_y = MaxNum
     end_if
   end_if
 else
   CAbs(a_x, a_y)
   CArg(a_x, a_y)
   r_mod = power(r_mod, p)
   r_arg = r_arg * p
   r_x = r_mod * cos(r_arg)
   r_y = r_mod * sin(r_arg)
 end_if
end_sub

sub CPower(a_x, a_y, b_x, b_y)
' Puissance (exposant complexe) : (a_x + i a_y)^(b_x + i b_y)
' Resultat dans r_x, r_y

 ErrCode% = 0

 if a_x = 0 and a_y = 0
   if b_x = 0 and b_y = 0
     ' 0^0 = lim x^x quand x --> 0 = 1
     r_x = 1
     r_y = 0
   else
     ' 0^p = 0 si p > 0
     r_x = 0
     r_y = 0
   end_if
 else
   ' exp(b ln(a))
   CAbs(a_x, a_y)
   CArg(a_x, a_y)
   CMul(b_x, b_y, log(r_mod), r_arg)
   CExp(r_x, r_y)
 end_if
end_sub

sub CSin(a_x, a_y)
' Sinus complexe : r_x + i r_y = sin(a_x + i a_y)

 ErrCode% = 0

 r_x = sin(a_x) * hcos(a_y)
 r_y = cos(a_x) * hsin(a_y)
end_sub

sub CCos(a_x, a_y)
' Cosinus complexe : r_x + i r_y = cos(a_x + i a_y)

 ErrCode% = 0

 r_x = cos(a_x) * hcos(a_y)
 r_y = 0 - sin(a_x) * hsin(a_y)
end_sub

sub CSinh(a_x, a_y)
' Sinus hyperbolique complexe : r_x + i r_y = sinh(a_x + i a_y)

 ErrCode% = 0

 r_x = hsin(a_x) * cos(a_y)
 r_y = hcos(a_x) * sin(a_y)
end_sub

sub CCosh(a_x, a_y)
' Cosinus hyperbolique complexe : r_x + i r_y = cosh(a_x + i a_y)

 ErrCode% = 0

 r_x = hcos(a_x) * cos(a_y)
 r_y = hsin(a_x) * sin(a_y)
end_sub

sub CTan(a_x, a_y)
' Tangente complexe : r_x + i r_y = tan(a_x + i a_y)

 dim_local X2, Y2, Temp

 X2 = 2 * a_x
 Y2 = 2 * a_y

 Temp = cos(X2) + hcos(Y2)

 if Temp <> 0
   ErrCode% = 0
   r_x = sin(X2) / Temp
   r_y = hsin(Y2) / Temp
 else
   ' a = Pi/2 + k*Pi
   ErrCode% = -2
   r_x = MaxNum
   r_y = 0
 end_if
end_sub

sub CTanh(a_x, a_y)
' Tangente hyperbolique complexe : r_x + i r_y = tanh(a_x + i a_y)

 dim_local X2, Y2, Temp

 X2 = 2.0 * a_x
 Y2 = 2.0 * a_y

 Temp = hcos(X2) + cos(Y2)

 if Temp = 0
   ' a = i * (Pi/2 + k*Pi)
   ErrCode% = -2
   r_x = 0
   r_y = MaxNum
 else
   ErrCode% = 0
   r_x = hsin(X2) / Temp
   r_y = sin(Y2) / Temp
 end_if
end_sub

sub CASin(a_x, a_y)
' Arc Sinus complexe : r_x + i r_y = asin(a_x + i a_y)

 dim_local X2, XX, YY, Rp, Rm, S, T

 X2 = 2 * a_x
 XX = a_x * a_x
 YY = a_y * a_y
 S  = XX + YY + 1
 Rp = 0.5 * sqr(S + X2)
 Rm = 0.5 * sqr(S - X2)
 T  = Rp + Rm

 ErrCode% = 0

 CSgn(a_y, 0 - a_x)

 r_x = asin(Rp - Rm)
 r_y = r_sgn * log(T + sqr(T * T - 1))
end_sub

sub CACos(a_x, a_y)
' Arc Cosinus complexe :
' r_x + i r_y = acos(a_x + i a_y) = Pi/2 - ASin(a)

 CASin(a_x, a_y)

 r_x = PiDiv2 - r_x
 r_y = 0 - r_y
end_sub

sub CATan(a_x, a_y)
' Arc Tangente complexe : r_x + i r_y = atan(a_x + i a_y)

 dim_local XX, YY, Yp1, Ym1, A1, A2

 if a_x = 0 and abs(a_y) = 1
   ' a = +/- i
   ErrCode% = -2
   r_x = 0
   r_y = sgn(a_y) * MaxNum
 else
   ErrCode% = 0

   XX  = a_x * a_x
   YY  = a_y * a_y
   Yp1 = a_y + 1
   Ym1 = a_y - 1

   CArg(0 - Ym1, a_x) : A1 = r_arg : ' = atan2(a_x, - Ym1)
   CArg(Yp1, 0 - a_x) : A2 = r_arg : ' = atan2(- Ym1, a_x)

   r_x = 0.5 * (A1 - A2)
   r_y = 0.25 * log((XX + Yp1 * Yp1) / (XX + Ym1 * Ym1))
 end_if
end_sub

sub CASinh(a_x, a_y)
' Argument Sinus hyperbolique complexe :
' r_x + i r_y = asinh(a_x + i a_y) = -i*asin(i*a)
' i * (a_x + i a_y) = -a_y + i a_x

 dim_local t

 CASin(0 - a_y, a_x)

 t = r_x
 r_x = r_y
 r_y = 0 - t
end_sub

sub CACosh(a_x, a_y)
' Argument Cosinus hyperbolique complexe :
' r_x + i r_y = acosh(a_x + i a_y) = csgn(a_y + i(1 - a_x)) * i * acos(a)

 dim_local t

 CSgn(a_y, 1 - a_x)
 CACos(a_x, a_y)

 t = r_x
 r_x = 0 - r_sgn* r_y
 r_y = r_sgn * t
end_sub

sub CATanh(a_x, a_y)
' Argument Tangente hyperbolique complexe :
' r_x + i r_y = atanh(a_x + i a_y) = -i*atan(i*a)

 dim_local t

 CATan(0 - a_y, a_x)

 t = r_x
 r_x = r_y
 r_y = 0 - t
end_sub
Revenir en haut Aller en bas
http://www.unilim.fr/pages_perso/jean.debord/index.htm
Contenu sponsorisé





Problème avec les SUBS Empty
MessageSujet: Re: Problème avec les SUBS   Problème avec les SUBS Empty

Revenir en haut Aller en bas
 
Problème avec les SUBS
Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Petites subs avec les dates
» Un petit calendrier avec quelques Subs
» Problème avec select case Probleme réglé merci
» problème avec edit ou bien avec combo?
» Problème avec SearchStringList.

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC Le compilateur :: Le Compilateur-
Sauter vers: