Télécharger opchp1.eso

Retour à la liste

Numérotation des lignes :

  1. C OPCHP1 SOURCE CB215821 18/02/23 21:15:05 9758
  2.  
  3. SUBROUTINE OPCHP1(IPO1,IOPERA,IARGU,I1,X1,IPO2,IRET)
  4. C=======================================================================
  5. C
  6. C ENTREES
  7. C IPO1 = POINTEUR SUR LE CHPOINT
  8. C I1 = ENTIER
  9. C X1 = FLOTTANT
  10.  
  11.  
  12. C Operations elementaires entre un CHPOINT et un ENTIER ou FLOTTANT
  13. C IOPERA= 1 PUISSANCE
  14. C = 2 PRODUIT
  15. C = 3 ADDITION
  16. C = 4 SOUSTRACTION
  17. C = 5 DIVISION
  18. C
  19. C Fonctions sur un CHPOINT
  20. C IOPERA= 6 COSINUS
  21. C = 7 SINUS
  22. C = 8 TANGENTE
  23. C = 9 ARCOSINUS
  24. C = 10 ARCSINUS
  25. C = 11 ARCTANGENTE (ATAN A UN ARGUMENT)
  26. C = 12 EXPONENTIELLE
  27. C = 13 LOGARITHME
  28. C = 14 VALEUR ABSOLUE
  29. C = 15 COSINUS HYPERBOLIQUE
  30. C = 16 SINUS HYPERBOLIQUE
  31. C = 17 TANGENTE HYPERBOLIQUE
  32. C = 18 ERF FONCTION D''ERRREUR DE GAUSS
  33. C = 19 ERFC FONCTION D''ERRREUR complementaire DE GAUSS (1-ERF(X))
  34. C = 20 ARGCH (FONCTION RECIPROQUE DE COSH)
  35. C = 21 ARGSH (FONCTION RECIPROQUE DE SINH)
  36. C = 22 ARGTH (FONCTION RECIPROQUE DE TANH)
  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.  
  44. C SORTIES
  45. C IPO2 = CHPOINT SOLUTION
  46. C IRET = 1 SI L OPERATION EST POSSIBLE
  47. C = 0 SI L OPERATION EST IMPOSSIBLE
  48. C
  49. C Creation 07/12/2015
  50. C Createur CB215821
  51. C Historique des Corrections apportees :
  52. C - 01/09/2016 : Ajout de l''include TMVALUE
  53. C -
  54. C
  55. C=======================================================================
  56.  
  57. IMPLICIT INTEGER(I-N)
  58. IMPLICIT REAL*8 (A-H,O-Z)
  59. C
  60. -INC SMCHPOI
  61. -INC SMLMOTS
  62. -INC CCASSIS
  63. -INC TMVALUE
  64.  
  65. C Segment quelconque pour la desactivation des segements
  66. SEGMENT ISEG(0)
  67.  
  68. EXTERNAL OPTABi
  69. LOGICAL BTHRD
  70.  
  71. C Pour afficher les lignes gibianes appelees decommenter le CALL
  72. C CALL TRBAC
  73.  
  74. C======================================================================C
  75. C Activation des SEGMENTS pour placer les MPOVAL dans le SVALUE
  76. C======================================================================C
  77. MCHPO1=IPO1
  78.  
  79. C IF ((IOPERA .EQ. 3) .OR. (IOPERA .EQ. 4)) THEN
  80. CC Pour les operations + - on n'accepte que les CHPOINT a 1
  81. CC seule composante.
  82. CC Pour les fonctions, on traite toutes les composantes en présence
  83. C CALL EXTR11(IPO1,MLMOTS)
  84. C SEGACT,MLMOTS
  85. C JGM=MLMOTS.MOTS(/2)
  86. C SEGDES,MLMOTS
  87. C IF(JGM .GT. 1)THEN
  88. C CALL ERREUR(180)
  89. C RETURN
  90. C ENDIF
  91. C ENDIF
  92.  
  93. SEGINI,MCHPOI=MCHPO1
  94. IPO2 =MCHPOI
  95.  
  96. NSOUPO=MCHPOI.IPCHP(/1)
  97.  
  98. IF (NSOUPO .EQ. 0)THEN
  99. C Cas du CHPOINT vide
  100. SEGDES,MCHPOI
  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=NSOUPO
  110. SEGINI,SVALUE
  111.  
  112. DO 40 IA=1,NSOUPO
  113. MSOUP1=MCHPOI.IPCHP(IA)
  114. SEGINI,MSOUPO=MSOUP1
  115. MCHPOI.IPCHP(IA)=MSOUPO
  116. MPOVA1=MSOUPO.IPOVAL
  117. SEGACT,MPOVA1
  118. N = MPOVA1.VPOCHA(/1)
  119. NC = MPOVA1.VPOCHA(/2)
  120. NNC=N*NC
  121. SEGINI,MPOVAL
  122. MSOUPO.IPOVAL=MPOVAL
  123. SVALUE.ITYPOI (IA )= 1
  124. SVALUE.IPOI0 (IA,1)= MPOVA1
  125. SVALUE.IPOI1 (IA,1)= 0
  126. SVALUE.IPOI2 (IA,1)= MPOVAL
  127. SVALUE.IPOI0 (IA,2)= NNC
  128. SVALUE.IPOI1 (IA,2)= 0
  129. SVALUE.IPOI2 (IA,2)= NNC
  130. SEGDES,MSOUPO
  131. IF (IA .EQ. 1) THEN
  132. NT1 = NNC / IOPTIM
  133. ELSE
  134. NT1 = MAX(NT1, NNC/IOPTIM)
  135. ENDIF
  136. 40 CONTINUE
  137. SEGDES,MCHPOI
  138. SVALUE.NPUTIL=NBPOIN
  139.  
  140. C======================================================================C
  141. C Partie pour lancer le travail sur les Threads en parallele
  142. C======================================================================C
  143. ITH = 0
  144. IF (NBESC .NE. 0) CALL OOONTH(ITH)
  145. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  146. C DEJA DANS LES ASSISTANTS
  147. IF ((NT1 .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  148. NBTHR = 1
  149. BTHRD = .FALSE.
  150. ELSE
  151. NBTHR = MIN(NT1, NBTHRS)
  152. BTHRD = .TRUE.
  153. CALL THREADII
  154. ENDIF
  155.  
  156. SEGINI,SPARAL
  157. SPARAL.NBTHRD = NBTHR
  158. SPARAL.IVALUE = SVALUE
  159. SPARAL.IOPE = IOPERA
  160. SPARAL.IARG = IARGU
  161. SPARAL.I1I = I1
  162. SPARAL.X1I = X1
  163.  
  164. IF (BTHRD) THEN
  165. C Remplissage du 'COMMON/optabc'
  166. IPARAL=SPARAL
  167. DO ith=2,NBTHR
  168. CALL THREADID(ith,OPTABi)
  169. ENDDO
  170. CALL OPTABi(1)
  171.  
  172. C Attente de la fin de tous les threads en cours de travail
  173. DO ith=2,NBTHR
  174. CALL THREADIF(ith)
  175. ENDDO
  176.  
  177. C On libère les Threads
  178. CALL THREADIS
  179.  
  180. C Verification de l'erreur (Apres liberation des THREADS)
  181. DO ith=1,NBTHR
  182. IRETOU=SPARAL.IERROR(ith)
  183. IF (IRETOU .GT. 0) THEN
  184. CALL ERREUR(IRETOU)
  185. RETURN
  186. ENDIF
  187. ENDDO
  188.  
  189. C En multithread il peut y avoir n'importe quoi dans OOV(1)
  190. C Indicateur de l'utilisation d'un ELEMENT DE SEGMENT
  191. OOV(1) = 0
  192.  
  193. ELSE
  194. C Appel de la SUBROUTINE qui fait le travail
  195. CALL OPTAB0(1,SPARAL)
  196.  
  197. IRETOU=SPARAL.IERROR(1)
  198. IF (IRETOU .GT. 0) THEN
  199. CALL ERREUR(IRETOU)
  200. RETURN
  201. ENDIF
  202. ENDIF
  203.  
  204. C======================================================================C
  205. C Boucle pour desactiver les SEGMENTS
  206. C======================================================================C
  207. DO 50 IA=1,SVALUE.NPUTIL
  208. ISEG = SVALUE.IPOI0(IA,1)
  209. IF (ISEG.NE.0) SEGDES,ISEG
  210. ISEG = SVALUE.IPOI1(IA,1)
  211. IF (ISEG.NE.0) SEGDES,ISEG
  212. ISEG = SVALUE.IPOI2(IA,1)
  213. IF (ISEG.NE.0) SEGDES,ISEG
  214. 50 CONTINUE
  215. SEGSUP,SVALUE
  216.  
  217. IRET = 1
  218. RETURN
  219. END
  220.  
  221.  
  222.  
  223.  

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