Télécharger oplre1.eso

Retour à la liste

Numérotation des lignes :

  1. C OPLRE1 SOURCE CB215821 18/02/23 21:15:07 9758
  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.  
  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
  37. C IARGU = 0 ==> ARGUMENT I1I ET X1I INUTILISES
  38. C IARGU = 1 ==> ARGUMENT I1I UTILISE
  39. C IARGU = 11 ==> ARGUMENT I1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (SOUSTRACTION, DIVISION : POSITIONNEL)
  40. C IARGU = 2 ==> ARGUMENT X1I UTILISE
  41. C IARGU = 21 ==> ARGUMENT X1I UTILISE MAIS COMMUTE AVEC LE TABLEAU (SOUSTRACTION, DIVISION : POSITIONNEL)
  42.  
  43. C SORTIES
  44. C IPO2 = LISTREEL SOLUTION
  45. C IRET = 1 SI L OPERATION EST POSSIBLE
  46. C = 0 SI L OPERATION EST IMPOSSIBLE
  47. C
  48. C Creation 05/09/2016
  49. C Createur CB215821
  50. C Historique des Corrections apportees :
  51. C -
  52. C -
  53. C
  54. C=======================================================================
  55.  
  56. IMPLICIT INTEGER(I-N)
  57. IMPLICIT REAL*8 (A-H,O-Z)
  58. C
  59. -INC SMLREEL
  60. -INC CCASSIS
  61. -INC TMVALUE
  62.  
  63. C Segment quelconque pour la desactivation des segements
  64. SEGMENT ISEG(0)
  65.  
  66. EXTERNAL OPTABi
  67. LOGICAL BTHRD
  68.  
  69. C Pour afficher les lignes gibianes appelees decommenter le CALL
  70. C CALL TRBAC
  71.  
  72. MLREE2 = 0
  73.  
  74. C======================================================================C
  75. C Activation des SEGMENTS pour placer les PROG dans le SVALUE
  76. C======================================================================C
  77. MLREE1=IPO1
  78. SEGACT,MLREE1
  79. JG=MLREE1.PROG(/1)
  80.  
  81. C Ajout lecture second argument
  82. IF (IPO2 .GT. 0) THEN
  83. MLREE2=IPO2
  84. IF (IPO2 .NE. IPO1) THEN
  85. SEGACT,MLREE2
  86. JG2=MLREE2.PROG(/1)
  87. C Les deux objets doivent etre de meme taille
  88. IF (JG .NE. JG2 ) THEN
  89. SEGDES,MLREE2,MLREE1
  90. CALL ERREUR(217)
  91. RETURN
  92. ENDIF
  93. ENDIF
  94. ENDIF
  95.  
  96. SEGINI,MLREEL
  97. IPO2=MLREEL
  98. IF (JG .EQ. 0)THEN
  99. C Cas du LISTREEL vide : Nouveau pointeur, vide...
  100. SEGDES,MLREE1,MLREEL
  101. IRET = 1
  102. RETURN
  103. ENDIF
  104.  
  105. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  106. C par thread
  107. IOPTIM = 12500
  108.  
  109. NBPOIN=1
  110. SEGINI,SVALUE
  111. SVALUE.ITYPOI (1 )= 3
  112. SVALUE.IPOI0 (1,1)= MLREE1
  113. SVALUE.IPOI1 (1,1)= MLREE2
  114. SVALUE.IPOI2 (1,1)= MLREEL
  115. SVALUE.IPOI0 (1,2)= JG
  116. SVALUE.IPOI1 (1,2)= JG
  117. SVALUE.IPOI2 (1,2)= JG
  118. NT1 = JG / IOPTIM
  119. SVALUE.NPUTIL=NBPOIN
  120.  
  121. C======================================================================C
  122. C Partie pour lancer le travail sur les Threads en parallele
  123. C======================================================================C
  124. ITH = 0
  125. IF (NBESC .NE. 0) CALL OOONTH(ITH)
  126. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  127. C DEJA DANS LES ASSISTANTS
  128. IF ((NT1 .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  129. NBTHR = 1
  130. BTHRD = .FALSE.
  131. ELSE
  132. NBTHR = MIN(NT1, NBTHRS)
  133. BTHRD = .TRUE.
  134. CALL THREADII
  135. ENDIF
  136.  
  137. SEGINI,SPARAL
  138. SPARAL.NBTHRD = NBTHR
  139. SPARAL.IVALUE = SVALUE
  140. SPARAL.IOPE = IOPERA
  141. SPARAL.IARG = IARGU
  142. SPARAL.I1I = I1
  143. SPARAL.X1I = X1
  144.  
  145. IF (BTHRD) THEN
  146. C Remplissage du 'COMMON/optabc'
  147. IPARAL=SPARAL
  148. DO ith=2,NBTHR
  149. CALL THREADID(ith,OPTABi)
  150. ENDDO
  151. CALL OPTABi(1)
  152.  
  153. C Attente de la fin de tous les threads en cours de travail
  154. DO ith=2,NBTHR
  155. CALL THREADIF(ith)
  156. ENDDO
  157.  
  158. C On libère les Threads
  159. CALL THREADIS
  160.  
  161. C Verification de l'erreur (Apres liberation des THREADS)
  162. DO ith=1,NBTHR
  163. IRETOU=SPARAL.IERROR(ith)
  164. IF (IRETOU .GT. 0) THEN
  165. CALL ERREUR(IRETOU)
  166. RETURN
  167. ENDIF
  168. ENDDO
  169.  
  170. C En multithread il peut y avoir n'importe quoi dans OOV(1)
  171. C Indicateur de l'utilisation d'un ELEMENT DE SEGMENT
  172. OOV(1) = 0
  173.  
  174. ELSE
  175. C Appel de la SUBROUTINE qui fait le travail
  176. CALL OPTAB0(1,SPARAL)
  177.  
  178. IRETOU=SPARAL.IERROR(1)
  179. IF (IRETOU .GT. 0) THEN
  180. CALL ERREUR(IRETOU)
  181. RETURN
  182. ENDIF
  183. ENDIF
  184.  
  185. C======================================================================C
  186. C Boucle pour desactiver les SEGMENTS
  187. C======================================================================C
  188. DO 50 IA=1,SVALUE.NPUTIL
  189. ISEG = SVALUE.IPOI0(IA,1)
  190. IF (ISEG.NE.0) SEGDES,ISEG
  191. ISEG = SVALUE.IPOI1(IA,1)
  192. IF (ISEG.NE.0) SEGDES,ISEG
  193. ISEG = SVALUE.IPOI2(IA,1)
  194. IF (ISEG.NE.0) SEGDES,ISEG
  195. 50 CONTINUE
  196. SEGSUP,SVALUE
  197.  
  198. IRET = 1
  199. RETURN
  200. END
  201.  
  202.  
  203.  
  204.  

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