Télécharger opevo1.eso

Retour à la liste

Numérotation des lignes :

  1. C OPEVO1 SOURCE PV 20/04/28 21:15:21 10593
  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. C
  10. C
  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 = 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 = EVOLUTIO 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 07/12/2015 --> Creation
  51. C - CB215821 01/09/2016 --> Ajout de l''include TMVALUE
  52. C - CB215821 05/06/2018 --> Ajout de la fonction SIGN a un argument
  53. C
  54. C=======================================================================
  55.  
  56. IMPLICIT INTEGER(I-N)
  57. IMPLICIT REAL*8 (A-H,O-Z)
  58.  
  59. -INC PPARAM
  60. -INC CCOPTIO
  61. -INC SMEVOLL
  62. -INC SMLREEL
  63. -INC SMLENTI
  64. -INC SMLMOTS
  65. -INC CCASSIS
  66. -INC TMVALUE
  67.  
  68. C Segment quelconque pour la desactivation des segements
  69. SEGMENT ISEG(0)
  70.  
  71. EXTERNAL OPTABi
  72. LOGICAL BTHRD
  73.  
  74. C Pour afficher les lignes gibianes appelees decommenter le CALL
  75. C CALL TRBAC
  76.  
  77. C======================================================================C
  78. C Activation des SEGMENTS pour placer les LISTREEL dans le SVALUE
  79. C======================================================================C
  80. MEVOL1=IPO1
  81.  
  82. SEGINI,MEVOLL=MEVOL1
  83. IPO2 = MEVOLL
  84.  
  85. N=MEVOLL.IEVOLL(/1)
  86. IF (N .EQ. 0)THEN
  87. C Cas de l'EVOLUTION vide
  88. IRET = 1
  89. RETURN
  90. ENDIF
  91.  
  92. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  93. C par thread
  94. IOPTIM = 100
  95.  
  96. IPOS1 = 0
  97. NBPOIN=N
  98. SEGINI,SVALUE
  99.  
  100. DO 40 IA=1,N
  101. KEVOL1=MEVOLL.IEVOLL(IA)
  102. SEGINI,KEVOLL=KEVOL1
  103. MEVOLL.IEVOLL(IA)=KEVOLL
  104.  
  105. IF (KEVOLL.TYPY .EQ. 'LISTMOTS') THEN
  106. C Cas des ordonnees de type LISTMOTS
  107. C Cela sert pour DESS pour mettre les petits triangles au niveau
  108. C des points nommes sur l''abscisse curviligne
  109. GOTO 40
  110.  
  111. ELSEIF (KEVOLL.TYPY .EQ. 'LISTREEL') THEN
  112. C Cas des ordonnees de type LISTREEL
  113. MLREE1=KEVOLL.IPROGY
  114. JG =MLREE1.PROG(/1)
  115. SEGINI,MLREEL
  116. KEVOLL.IPROGY=MLREEL
  117. IPOS1 = IPOS1 + 1
  118. SVALUE.ITYPOI (IPOS1 )= 3
  119. SVALUE.IPOI0 (IPOS1,1)= MLREE1
  120. SVALUE.IPOI1 (IPOS1,1)= 0
  121. SVALUE.IPOI2 (IPOS1,1)= MLREEL
  122. SVALUE.IPOI0 (IPOS1,2)= JG
  123. SVALUE.IPOI1 (IPOS1,2)= 0
  124. SVALUE.IPOI2 (IPOS1,2)= JG
  125.  
  126. ELSEIF(KEVOLL.TYPY .EQ. 'LISTENTI') THEN
  127. C Cas des ordonnees de type LISTENTI
  128. MLENT1=KEVOLL.IPROGY
  129. JG =MLENT1.LECT(/1)
  130. SEGINI,MLENTI
  131. KEVOLL.IPROGY=MLENTI
  132. IPOS1 = IPOS1 + 1
  133. SVALUE.ITYPOI (IPOS1 )= 4
  134. SVALUE.IPOI0 (IPOS1,1)= MLENT1
  135. SVALUE.IPOI1 (IPOS1,1)= 0
  136. SVALUE.IPOI2 (IPOS1,1)= MLENTI
  137. SVALUE.IPOI0 (IPOS1,2)= JG
  138. SVALUE.IPOI1 (IPOS1,2)= 0
  139. SVALUE.IPOI2 (IPOS1,2)= JG
  140.  
  141. ELSE
  142. C Cas des ordonnees de type Different
  143. MOTERR(1:8) =KEVOLL.TYPY
  144. IF (IARGU .EQ. 1 .OR. IARGU .EQ. 11) THEN
  145. MOTERR(9:16)='ENTIER '
  146. CALL ERREUR(532)
  147. ELSEIF (IARGU .EQ. 2 .OR. IARGU .EQ. 21) THEN
  148. MOTERR(9:16)='FLOTTANT'
  149. CALL ERREUR(532)
  150. ELSE
  151. MOTERR(9:16)='???? '
  152. CALL ERREUR(532)
  153. ENDIF
  154. RETURN
  155. ENDIF
  156.  
  157. IF (IA .EQ. 1) THEN
  158. NT1 = JG / IOPTIM
  159. ELSE
  160. NT1 = MAX(NT1, JG/IOPTIM)
  161. ENDIF
  162. 40 CONTINUE
  163. SVALUE.NPUTIL=IPOS1
  164.  
  165. C======================================================================C
  166. C Partie pour lancer le travail sur les Threads en parallele
  167. C======================================================================C
  168. ITH = 0
  169. IF (NBESC .NE. 0) ith=oothrd
  170. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  171. C DEJA DANS LES ASSISTANTS
  172. IF ((NT1 .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  173. NBTHR = 1
  174. BTHRD = .FALSE.
  175. ELSE
  176. NBTHR = MIN(NT1, NBTHRS)
  177. BTHRD = .TRUE.
  178. CALL THREADII
  179. ENDIF
  180.  
  181. SEGINI,SPARAL
  182. SPARAL.NBTHRD = NBTHR
  183. SPARAL.IVALUE = SVALUE
  184. SPARAL.IOPE = IOPERA
  185. SPARAL.IARG = IARGU
  186. SPARAL.I1I = I1
  187. SPARAL.X1I = X1
  188.  
  189. IF (BTHRD) THEN
  190. C Remplissage du 'COMMON/optabc'
  191. IPARAL=SPARAL
  192. DO ith=2,NBTHR
  193. CALL THREADID(ith,OPTABi)
  194. ENDDO
  195. CALL OPTABi(1)
  196.  
  197. C Attente de la fin de tous les threads en cours de travail
  198. DO ith=2,NBTHR
  199. CALL THREADIF(ith)
  200. ENDDO
  201.  
  202. C On libère les Threads
  203. CALL THREADIS
  204.  
  205. C Verification de l'erreur (Apres liberation des THREADS)
  206. DO ith=1,NBTHR
  207. IRETOU=SPARAL.IERROR(ith)
  208. IF (IRETOU .GT. 0) THEN
  209. CALL ERREUR(IRETOU)
  210. RETURN
  211. ENDIF
  212. ENDDO
  213.  
  214. ELSE
  215. C Appel de la SUBROUTINE qui fait le travail
  216. CALL OPTAB0(1,SPARAL)
  217.  
  218. IRETOU=SPARAL.IERROR(1)
  219. IF (IRETOU .GT. 0) THEN
  220. CALL ERREUR(IRETOU)
  221. RETURN
  222. ENDIF
  223. ENDIF
  224.  
  225. SEGSUP,SVALUE,SPARAL
  226.  
  227. IRET = 1
  228. END
  229.  
  230.  
  231.  
  232.  
  233.  

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