Télécharger oplre1.eso

Retour à la liste

Numérotation des lignes :

  1. C OPLRE1 SOURCE CB215821 19/07/09 21:15:27 10252
  2. SUBROUTINE OPLRE1(IPO1,IOPERA,IARGU,I1,X1,IPO2,IRET)
  3. C=======================================================================
  4. C
  5. C ENTREES
  6. C IPO1 = POINTEUR SUR LE LISTREEL
  7. C IPO2 = POINTEUR SUR LE LISTREEL (Second Argument + - * / ATAN2)
  8. C I1 = ENTIER
  9. C X1 = FLOTTANT
  10. C
  11. C Operations elementaires entre un LISTREEL et un ENTIER ou FLOTTANT
  12. C IOPERA= 1 PUISSANCE
  13. C = 2 PRODUIT
  14. C = 3 ADDITION
  15. C = 4 SOUSTRACTION
  16. C = 5 DIVISION
  17. C
  18. C Fonctions sur un LISTREEL
  19. C IOPERA= 6 COSINUS
  20. C = 7 SINUS
  21. C = 8 TANGENTE
  22. C = 9 ARCOSINUS
  23. C = 10 ARCSINUS
  24. C = 11 ARCTANGENTE (ATAN A UN ARGUMENT)
  25. C = 12 EXPONENTIELLE
  26. C = 13 LOGARITHME
  27. C = 14 VALEUR ABSOLUE
  28. C = 15 COSINUS HYPERBOLIQUE
  29. C = 16 SINUS HYPERBOLIQUE
  30. C = 17 TANGENTE HYPERBOLIQUE
  31. C = 18 ERF FONCTION D''ERRREUR DE GAUSS
  32. C = 19 ERFC FONCTION D''ERRREUR complementaire DE GAUSS (1-ERF(X))
  33. C = 20 ARGCH (FONCTION RECIPROQUE DE COSH)
  34. C = 21 ARGSH (FONCTION RECIPROQUE DE SINH)
  35. C = 22 ARGTH (FONCTION RECIPROQUE DE TANH)
  36. C = 23 SIGN (renvoie -1 ou +1, resultat du meme type)
  37. C
  38. C IARGU = 0 ==> ARGUMENT I1I ET X1I INUTILISES
  39. C IARGU = 1 ==> ARGUMENT I1I UTILISE
  40. C IARGU = 11 ==> ARGUMENT I1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (SOUSTRACTION, DIVISION : POSITIONNEL)
  41. C IARGU = 2 ==> ARGUMENT X1I UTILISE
  42. C IARGU = 21 ==> ARGUMENT X1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (SOUSTRACTION, DIVISION : POSITIONNEL)
  43. C
  44. C SORTIES
  45. C IPO2 = LISTREEL SOLUTION
  46. C IRET = 1 SI L OPERATION EST POSSIBLE
  47. C = 0 SI L OPERATION EST IMPOSSIBLE
  48. C
  49. C HISTORIQUE :
  50. C - CB215821 05/09/2016 --> Creation
  51. C - CB215821 05/06/2018 --> Ajout de la fonction SIGN a un argument
  52. C
  53. C=======================================================================
  54.  
  55. IMPLICIT INTEGER(I-N)
  56. IMPLICIT REAL*8 (A-H,O-Z)
  57.  
  58. -INC SMLREEL
  59. -INC CCASSIS
  60. -INC TMVALUE
  61.  
  62. C Segment quelconque pour la desactivation des segements
  63. SEGMENT ISEG(0)
  64.  
  65. EXTERNAL OPTABi
  66. LOGICAL BTHRD
  67.  
  68. C Pour afficher les lignes gibianes appelees decommenter le CALL
  69. C CALL TRBAC
  70.  
  71. MLREE2 = 0
  72.  
  73. C======================================================================C
  74. C Activation des SEGMENTS pour placer les PROG dans le SVALUE
  75. C======================================================================C
  76. MLREE1=IPO1
  77. JG=MLREE1.PROG(/1)
  78.  
  79. C Ajout lecture second argument
  80. IF (IPO2 .GT. 0) THEN
  81. MLREE2=IPO2
  82. IF (IPO2 .NE. IPO1) THEN
  83. JG2=MLREE2.PROG(/1)
  84. C Les deux objets doivent etre de meme taille
  85. IF (JG .NE. JG2 ) THEN
  86. CALL ERREUR(217)
  87. RETURN
  88. ENDIF
  89. ENDIF
  90. ENDIF
  91.  
  92. SEGINI,MLREEL
  93. IPO2=MLREEL
  94. IF (JG .EQ. 0)THEN
  95. C Cas du LISTREEL vide : Nouveau pointeur, vide...
  96. IRET = 1
  97. RETURN
  98. ENDIF
  99.  
  100. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  101. C par thread
  102. IOPTIM = 12500
  103.  
  104. NBPOIN=1
  105. SEGINI,SVALUE
  106. SVALUE.ITYPOI (1 )= 3
  107. SVALUE.IPOI0 (1,1)= MLREE1
  108. SVALUE.IPOI1 (1,1)= MLREE2
  109. SVALUE.IPOI2 (1,1)= MLREEL
  110. SVALUE.IPOI0 (1,2)= JG
  111. SVALUE.IPOI1 (1,2)= JG
  112. SVALUE.IPOI2 (1,2)= JG
  113. NT1 = JG / IOPTIM
  114. SVALUE.NPUTIL=NBPOIN
  115.  
  116. C======================================================================C
  117. C Partie pour lancer le travail sur les Threads en parallele
  118. C======================================================================C
  119. ITH = 0
  120. IF (NBESC .NE. 0) ith=oothrd
  121. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  122. C DEJA DANS LES ASSISTANTS
  123. IF ((NT1 .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  124. NBTHR = 1
  125. BTHRD = .FALSE.
  126. ELSE
  127. NBTHR = MIN(NT1, NBTHRS)
  128. BTHRD = .TRUE.
  129. CALL THREADII
  130. ENDIF
  131.  
  132. SEGINI,SPARAL
  133. SPARAL.NBTHRD = NBTHR
  134. SPARAL.IVALUE = SVALUE
  135. SPARAL.IOPE = IOPERA
  136. SPARAL.IARG = IARGU
  137. SPARAL.I1I = I1
  138. SPARAL.X1I = X1
  139.  
  140. IF (BTHRD) THEN
  141. C Remplissage du 'COMMON/optabc'
  142. IPARAL=SPARAL
  143. DO ith=2,NBTHR
  144. CALL THREADID(ith,OPTABi)
  145. ENDDO
  146. CALL OPTABi(1)
  147.  
  148. C Attente de la fin de tous les threads en cours de travail
  149. DO ith=2,NBTHR
  150. CALL THREADIF(ith)
  151. ENDDO
  152.  
  153. C On libère les Threads
  154. CALL THREADIS
  155.  
  156. C Verification de l'erreur (Apres liberation des THREADS)
  157. DO ith=1,NBTHR
  158. IRETOU=SPARAL.IERROR(ith)
  159. IF (IRETOU .GT. 0) THEN
  160. CALL ERREUR(IRETOU)
  161. RETURN
  162. ENDIF
  163. ENDDO
  164.  
  165. ELSE
  166. C Appel de la SUBROUTINE qui fait le travail
  167. CALL OPTAB0(1,SPARAL)
  168.  
  169. IRETOU=SPARAL.IERROR(1)
  170. IF (IRETOU .GT. 0) THEN
  171. CALL ERREUR(IRETOU)
  172. RETURN
  173. ENDIF
  174. ENDIF
  175.  
  176. SEGSUP,SVALUE,SPARAL
  177.  
  178. IRET = 1
  179. END
  180.  
  181.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales