Télécharger oplre1.eso

Retour à la liste

Numérotation des lignes :

  1. C OPLRE1 SOURCE CB215821 17/06/29 21:15:03 9470
  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 Declaration du COMMON pour le travail en parallele
  64. COMMON/optabc/NBTH1,IERR1,IVALUE,NBPOI1,IOPE,IARG,I1I,X1I
  65.  
  66. C Segment quelconque pour la desactivation des segements
  67. SEGMENT ISEG(0)
  68.  
  69. EXTERNAL OPTABi
  70. LOGICAL BTHRD
  71.  
  72. C Pour afficher les lignes gibianes appelees decommenter le CALL
  73. C CALL TRBAC
  74.  
  75. MLREE2 = 0
  76.  
  77. C======================================================================C
  78. C Activation des SEGMENTS pour placer les PROG dans le SVALUE
  79. C======================================================================C
  80. MLREE1=IPO1
  81. SEGACT,MLREE1
  82. JG=MLREE1.PROG(/1)
  83.  
  84. C Ajout lecture second argument
  85. IF (IPO2 .GT. 0) THEN
  86. MLREE2=IPO2
  87. IF (IPO2 .NE. IPO1) THEN
  88. SEGACT,MLREE2
  89. JG2=MLREE2.PROG(/1)
  90. C Les deux objets doivent etre de meme taille
  91. IF (JG .NE. JG2 ) THEN
  92. SEGDES,MLREE2,MLREE1
  93. CALL ERREUR(217)
  94. RETURN
  95. ENDIF
  96. ENDIF
  97. ENDIF
  98.  
  99. SEGINI,MLREEL
  100. IPO2=MLREEL
  101. IF (JG .EQ. 0)THEN
  102. C Cas du LISTREEL vide : Nouveau pointeur, vide...
  103. SEGDES,MLREE1,MLREEL
  104. IRET = 1
  105. RETURN
  106. ENDIF
  107.  
  108. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  109. C par thread
  110. IOPTIM = 12500
  111.  
  112. NBPOIN=1
  113. SEGINI,SVALUE
  114. SVALUE.ITYPOI (1 )= 3
  115. SVALUE.IPOI0 (1,1)= MLREE1
  116. SVALUE.IPOI1 (1,1)= MLREE2
  117. SVALUE.IPOI2 (1,1)= MLREEL
  118. SVALUE.IPOI0 (1,2)= JG
  119. SVALUE.IPOI1 (1,2)= JG
  120. SVALUE.IPOI2 (1,2)= JG
  121. NT1 = JG / IOPTIM
  122.  
  123. C======================================================================C
  124. C Partie pour lancer le travail sur les Threads en parallele
  125. C======================================================================C
  126. ITH = 0
  127. IF (NBESC .NE. 0) CALL OOONTH(ITH)
  128. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  129. C DEJA DANS LES ASSISTANTS
  130. IF ((NT1 .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  131. NBTHR = 1
  132. ITH = 1
  133. BTHRD = .FALSE.
  134. ELSE
  135. BTHRD = .TRUE.
  136. NBTHR = MIN(NT1, NBTHRS)
  137. ENDIF
  138.  
  139. C INITIALISATION DU SEGMENT D''ERREUR
  140. SEGINI,SERROR
  141.  
  142. IF (BTHRD) THEN
  143. CALL THREADII
  144. C Remplissage du 'COMMON/optabc' apres THREADII : pthread_mutex_lock
  145. C sinon soucis de cohabitation entre les ASSISTANTS qui ecrivent tous dans le meme COMMON...
  146. NBTH1 = NBTHR
  147. IERR1 = SERROR
  148. IVALUE = SVALUE
  149. NBPOI1 = NBPOIN
  150. IOPE = IOPERA
  151. IARG = IARGU
  152. I1I = I1
  153. X1I = X1
  154.  
  155. DO ith=2,NBTHR
  156. CALL THREADID(ith,OPTABi)
  157. CALL THREADIF(ith)
  158. IRET=SERROR.IERROR(ith)
  159. IF (IRET .GT. 0) THEN
  160. CALL ERREUR(IRET)
  161. RETURN
  162. ENDIF
  163. ENDDO
  164. CALL OPTABi(1)
  165. IRET=SERROR.IERROR(1)
  166. IF (IRET .GT. 0) THEN
  167. CALL ERREUR(IRET)
  168. RETURN
  169. ENDIF
  170.  
  171. C En multithread il peut y avoir n''importe quoi dans OOV(1)
  172. C Indicateur de l'utilisation d'un élément de segment
  173. OOV(1) = 0
  174.  
  175. ELSE
  176. C Appel de la SUBROUTINE qui fait le travail
  177. DO 99 IA=1,NBPOIN
  178. NTABEN = 1
  179. ITAIL1=SVALUE.IPOI0 (IA,2)
  180. ITAIL2=SVALUE.IPOI1 (IA,2)
  181. ITAIL3=SVALUE.IPOI2 (IA,2)
  182.  
  183. MLREE1=SVALUE.IPOI0 (IA,1)
  184. MLREE2=SVALUE.IPOI1 (IA,1)
  185. MLREEL=SVALUE.IPOI2 (IA,1)
  186.  
  187. IF (MLREE2 .GT. 0) THEN
  188. NTABEN = 2
  189. CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  190. & MLREE1.PROG,MLREE2.PROG,MLREEL.PROG,
  191. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  192. ELSE
  193. CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  194. & MLREE1.PROG,MLREE1.PROG,MLREEL.PROG,
  195. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  196. ENDIF
  197. 99 CONTINUE
  198. IRET=SERROR.IERROR(1)
  199. IF (IRET .GT. 0) THEN
  200. CALL ERREUR(IRET)
  201. RETURN
  202. ENDIF
  203. ENDIF
  204.  
  205. IF (BTHRD) CALL THREADIS
  206.  
  207. C======================================================================C
  208. C Desactiver les SEGMENTS
  209. C======================================================================C
  210. DO 50 IA=1,NBPOIN
  211. ISEG = SVALUE.IPOI0(IA,1)
  212. IF (ISEG.NE.0) SEGDES,ISEG
  213. ISEG = SVALUE.IPOI1(IA,1)
  214. IF (ISEG.NE.0) SEGDES,ISEG
  215. ISEG = SVALUE.IPOI2(IA,1)
  216. IF (ISEG.NE.0) SEGDES,ISEG
  217. 50 CONTINUE
  218. SEGDES,MLREE1
  219. IF (MLREE2 .GT. 0) SEGDES,MLREE2
  220.  
  221. SEGSUP,SERROR,SVALUE
  222.  
  223. IRET = 1
  224. RETURN
  225. END
  226.  
  227.  

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