Télécharger opevo1.eso

Retour à la liste

Numérotation des lignes :

  1. C OPEVO1 SOURCE CB215821 17/02/06 21:15:04 9301
  2. SUBROUTINE OPEVO1(IPO1,IOPERA,IARGU,I1,X1,IPO2,IRET)
  3. C=======================================================================
  4. C
  5. C ENTREES
  6. C IPO1 = POINTEUR SUR LE EVOLUTIO
  7. C I1 = ENTIER
  8. C X1 = FLOTTANT
  9.  
  10.  
  11. C Operations elementaires entre un EVOLUTIO 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 EVOLUTIO
  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 = EVOLUTIO SOLUTION
  45. C IRET = 1 SI L OPERATION EST POSSIBLE
  46. C = 0 SI L OPERATION EST IMPOSSIBLE
  47. C
  48. C Creation 07/12/2015
  49. C Createur CB215821
  50. C Historique des Corrections apportees :
  51. C - 01/09/2016 : Ajout de l''include TMVALUE
  52. C -
  53. C
  54. C=======================================================================
  55.  
  56. IMPLICIT INTEGER(I-N)
  57. IMPLICIT REAL*8 (A-H,O-Z)
  58. C
  59. -INC SMEVOLL
  60. -INC SMLREEL
  61. -INC SMLENTI
  62. -INC SMLMOTS
  63. -INC CCASSIS
  64. -INC TMVALUE
  65. -INC CCOPTIO
  66.  
  67. C Declaration du COMMON pour le travail en parallele
  68. COMMON/optabc/NBTH1,IERR1,IVALUE,NBPOI1,IOPE,IARG,I1I,X1I
  69.  
  70. C Segment quelconque pour la desactivation des segements
  71. SEGMENT ISEG(0)
  72.  
  73. EXTERNAL OPTABi
  74. LOGICAL BTHRD
  75.  
  76. C Pour afficher les lignes gibianes appelees decommenter le CALL
  77. C CALL TRBAC
  78.  
  79. C======================================================================C
  80. C Activation des SEGMENTS pour placer les LISTREEL dans le SVALUE
  81. C======================================================================C
  82. MEVOL1=IPO1
  83. SEGINI,MEVOLL=MEVOL1
  84.  
  85. N=MEVOLL.IEVOLL(/1)
  86. IF (N .EQ. 0)THEN
  87. C Cas de l'EVOLUTION vide : On renvoie l'IDENTITE
  88. IPO2 = MEVOLL
  89. SEGDES,MEVOLL
  90. IRET = 1
  91. RETURN
  92. ENDIF
  93.  
  94. IPO2 = MEVOLL
  95.  
  96. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  97. C par thread
  98. IOPTIM = 12500
  99.  
  100. IPOS1 = 0
  101. NBPOIN=N
  102. SEGINI,SVALUE
  103.  
  104. DO 40 IA=1,N
  105. KEVOL1=MEVOLL.IEVOLL(IA)
  106. SEGINI,KEVOLL=KEVOL1
  107. MEVOLL.IEVOLL(IA)=KEVOLL
  108.  
  109. IF (KEVOLL.TYPY .EQ. 'LISTMOTS') THEN
  110. C Cas des ordonnees de type LISTMOTS
  111. C Cela sert pour DESS pour mettre les petits triangles au niveau
  112. C des points nommes sur l''abscisse curviligne
  113. SEGDES,KEVOLL
  114. GOTO 40
  115.  
  116. ELSEIF (KEVOLL.TYPY .EQ. 'LISTREEL') THEN
  117. C Cas des ordonnees de type LISTREEL
  118. MLREE1=KEVOLL.IPROGY
  119. SEGACT,MLREE1
  120. JG =MLREE1.PROG(/1)
  121. SEGINI,MLREEL
  122. KEVOLL.IPROGY=MLREEL
  123. IPOS1 = IPOS1 + 1
  124. SVALUE.ITYPOI (IPOS1 )= 3
  125. SVALUE.IPOI0 (IPOS1,1)= MLREE1
  126. SVALUE.IPOI1 (IPOS1,1)= 0
  127. SVALUE.IPOI2 (IPOS1,1)= MLREEL
  128. SVALUE.IPOI0 (IPOS1,2)= JG
  129. SVALUE.IPOI1 (IPOS1,2)= 0
  130. SVALUE.IPOI2 (IPOS1,2)= JG
  131.  
  132. ELSEIF(KEVOLL.TYPY .EQ. 'LISTENTI') THEN
  133. C Cas des ordonnees de type LISTENTI
  134. MLENT1=KEVOLL.IPROGY
  135. SEGACT,MLENT1
  136. JG =MLENT1.LECT(/1)
  137. SEGINI,MLENTI
  138. KEVOLL.IPROGY=MLENTI
  139. IPOS1 = IPOS1 + 1
  140. SVALUE.ITYPOI (IPOS1 )= 4
  141. SVALUE.IPOI0 (IPOS1,1)= MLENT1
  142. SVALUE.IPOI1 (IPOS1,1)= 0
  143. SVALUE.IPOI2 (IPOS1,1)= MLENTI
  144. SVALUE.IPOI0 (IPOS1,2)= JG
  145. SVALUE.IPOI1 (IPOS1,2)= 0
  146. SVALUE.IPOI2 (IPOS1,2)= JG
  147.  
  148. ELSE
  149. C Cas des ordonnees de type Different
  150. MOTERR(1:8) =KEVOLL.TYPY
  151. IF (IARGU .EQ. 1 .OR. IARGU .EQ. 11) THEN
  152. MOTERR(9:16)='ENTIER '
  153. CALL ERREUR(532)
  154. ELSEIF (IARGU .EQ. 2 .OR. IARGU .EQ. 21) THEN
  155. MOTERR(9:16)='FLOTTANT'
  156. CALL ERREUR(532)
  157. ELSE
  158. MOTERR(9:16)='???? '
  159. CALL ERREUR(532)
  160. ENDIF
  161. RETURN
  162. ENDIF
  163.  
  164. SEGDES,KEVOLL
  165. IF (IA .EQ. 1) THEN
  166. NT1 = JG / IOPTIM
  167. ELSE
  168. NT1 = MAX(NT1, JG/IOPTIM)
  169. ENDIF
  170. 40 CONTINUE
  171. SEGDES,MEVOLL
  172.  
  173. C======================================================================C
  174. C Partie pour lancer le travail sur les Threads en parallele
  175. C======================================================================C
  176. ITH = 0
  177. IF (NBESC .NE. 0) CALL OOONTH(ITH)
  178. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  179. C DEJA DANS LES ASSISTANTS
  180. IF ((NT1 .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  181. NBTHR = 1
  182. ITH = 1
  183. BTHRD = .FALSE.
  184. ELSE
  185. BTHRD = .TRUE.
  186. NBTHR = MIN(NT1, NBTHRS)
  187. ENDIF
  188.  
  189. C INITIALISATION DU SEGMENT D''ERREUR
  190. SEGINI,SERROR
  191.  
  192. IF (BTHRD) THEN
  193. CALL THREADII
  194. C Remplissage du 'COMMON/optabc' apres THREADII : pthread_mutex_lock
  195. C sinon soucis de cohabitation entre les ASSISTANTS qui ecrivent tous dans le meme COMMON...
  196. NBTH1 = NBTHR
  197. IERR1 = SERROR
  198. IVALUE = SVALUE
  199. NBPOI1 = IPOS1
  200. IOPE = IOPERA
  201. IARG = IARGU
  202. I1I = I1
  203. X1I = X1
  204.  
  205. DO ith=2,NBTHR
  206. CALL THREADID(ith,OPTABi)
  207. CALL THREADIF(ith)
  208. IRET=SERROR.IERROR(ith)
  209. IF (IRET .GT. 0) THEN
  210. CALL ERREUR(IRET)
  211. RETURN
  212. ENDIF
  213. ENDDO
  214. CALL OPTABi(1)
  215. IRET=SERROR.IERROR(1)
  216. IF (IRET .GT. 0) THEN
  217. CALL ERREUR(IRET)
  218. RETURN
  219. ENDIF
  220.  
  221. C En multithread il peut y avoir n''importe quoi dans OOV(1)
  222. C Indicateur de l'utilisation d'un élément de segment
  223. OOV(1) = 0
  224.  
  225. ELSE
  226. C Appel de la SUBROUTINE qui fait le travail
  227. DO 99 IA=1,IPOS1
  228. NTABEN = 1
  229. ITAIL1=SVALUE.IPOI0 (IA,2)
  230. ITAIL2=SVALUE.IPOI1 (IA,2)
  231. ITAIL3=SVALUE.IPOI2 (IA,2)
  232.  
  233. MLREE1=SVALUE.IPOI0 (IA,1)
  234. MLREE2=SVALUE.IPOI1 (IA,1)
  235. MLREEL=SVALUE.IPOI2 (IA,1)
  236.  
  237. IF (MLREE2 .GT. 0) THEN
  238. NTABEN = 2
  239. CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  240. & MLREE1.PROG,MLREE2.PROG,MLREEL.PROG,
  241. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  242. ELSE
  243. CALL OPTABj(NBTHR ,ITH ,SERROR.IERROR,IOPERA,NTABEN,
  244. & MLREE1.PROG,MLREE1.PROG,MLREEL.PROG,
  245. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 )
  246. ENDIF
  247. 99 CONTINUE
  248. IRET=SERROR.IERROR(1)
  249. IF (IRET .GT. 0) THEN
  250. CALL ERREUR(IRET)
  251. RETURN
  252. ENDIF
  253. ENDIF
  254.  
  255. IF (BTHRD) CALL THREADIS
  256.  
  257. C======================================================================C
  258. C Boucle pour desactiver les SEGMENTS
  259. C======================================================================C
  260. DO 50 IA=1,IPOS1
  261. ISEG = SVALUE.IPOI0(IA,1)
  262. IF (ISEG.NE.0) SEGDES,ISEG
  263. ISEG = SVALUE.IPOI1(IA,1)
  264. IF (ISEG.NE.0) SEGDES,ISEG
  265. ISEG = SVALUE.IPOI2(IA,1)
  266. IF (ISEG.NE.0) SEGDES,ISEG
  267. 50 CONTINUE
  268. SEGSUP,SERROR,SVALUE
  269.  
  270. IRET = 1
  271. RETURN
  272. END
  273.  
  274.  
  275.  

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