Télécharger opchp1.eso

Retour à la liste

Numérotation des lignes :

  1. C OPCHP1 SOURCE CB215821 18/12/04 21:15:55 10020
  2. SUBROUTINE OPCHP1(IPO1,IOPERA,IARGU,I1,X1,IPO2,IRET)
  3. C=======================================================================
  4. C
  5. C ENTREES
  6. C IPO1 = POINTEUR SUR LE CHPOINT
  7. C I1 = ENTIER
  8. C X1 = FLOTTANT
  9. C
  10. C
  11. C Operations elementaires entre un CHPOINT 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 CHPOINT
  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 = CHPOINT 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 SMCHPOI
  60. -INC SMLMOTS
  61. -INC CCASSIS
  62. -INC TMVALUE
  63.  
  64. C Segment quelconque pour la desactivation des segements
  65. SEGMENT ISEG(0)
  66.  
  67. EXTERNAL OPTABi
  68. LOGICAL BTHRD
  69.  
  70. C Pour afficher les lignes gibianes appelees decommenter le CALL
  71. C CALL TRBAC
  72.  
  73. C======================================================================C
  74. C Activation des SEGMENTS pour placer les MPOVAL dans le SVALUE
  75. C======================================================================C
  76. MCHPO1=IPO1
  77.  
  78. C IF ((IOPERA .EQ. 3) .OR. (IOPERA .EQ. 4)) THEN
  79. CC Pour les operations + - on n'accepte que les CHPOINT a 1
  80. CC seule composante.
  81. CC Pour les fonctions, on traite toutes les composantes en présence
  82. C CALL EXTR11(IPO1,MLMOTS)
  83. C SEGACT,MLMOTS
  84. C JGM=MLMOTS.MOTS(/2)
  85. C SEGDES,MLMOTS
  86. C IF(JGM .GT. 1)THEN
  87. C CALL ERREUR(180)
  88. C RETURN
  89. C ENDIF
  90. C ENDIF
  91.  
  92. SEGINI,MCHPOI=MCHPO1
  93. IPO2 =MCHPOI
  94.  
  95. NSOUPO=MCHPOI.IPCHP(/1)
  96.  
  97. IF (NSOUPO .EQ. 0)THEN
  98. C Cas du CHPOINT vide
  99. SEGACT,MCHPOI*NOMOD
  100. IRET = 1
  101. RETURN
  102. ENDIF
  103.  
  104. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  105. C par thread
  106. IOPTIM = 12500
  107.  
  108. NBPOIN=NSOUPO
  109. SEGINI,SVALUE
  110.  
  111. DO 40 IA=1,NSOUPO
  112. MSOUP1=MCHPOI.IPCHP(IA)
  113. SEGINI,MSOUPO=MSOUP1
  114. MCHPOI.IPCHP(IA)=MSOUPO
  115. MPOVA1=MSOUPO.IPOVAL
  116. SEGACT,MPOVA1
  117. N = MPOVA1.VPOCHA(/1)
  118. NC = MPOVA1.VPOCHA(/2)
  119. NNC=N*NC
  120. SEGINI,MPOVAL
  121. MSOUPO.IPOVAL=MPOVAL
  122. SVALUE.ITYPOI (IA )= 1
  123. SVALUE.IPOI0 (IA,1)= MPOVA1
  124. SVALUE.IPOI1 (IA,1)= 0
  125. SVALUE.IPOI2 (IA,1)= MPOVAL
  126. SVALUE.IPOI0 (IA,2)= NNC
  127. SVALUE.IPOI1 (IA,2)= 0
  128. SVALUE.IPOI2 (IA,2)= NNC
  129. SEGACT,MSOUPO*NOMOD
  130. IF (IA .EQ. 1) THEN
  131. NT1 = NNC / IOPTIM
  132. ELSE
  133. NT1 = MAX(NT1, NNC/IOPTIM)
  134. ENDIF
  135. 40 CONTINUE
  136. SEGACT,MCHPOI*NOMOD
  137. SVALUE.NPUTIL=NBPOIN
  138.  
  139. C======================================================================C
  140. C Partie pour lancer le travail sur les Threads en parallele
  141. C======================================================================C
  142. ITH = 0
  143. IF (NBESC .NE. 0) ith=oothrd
  144. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  145. C DEJA DANS LES ASSISTANTS
  146. IF ((NT1 .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  147. NBTHR = 1
  148. BTHRD = .FALSE.
  149. ELSE
  150. NBTHR = MIN(NT1, NBTHRS)
  151. BTHRD = .TRUE.
  152. CALL THREADII
  153. ENDIF
  154.  
  155. SEGINI,SPARAL
  156. SPARAL.NBTHRD = NBTHR
  157. SPARAL.IVALUE = SVALUE
  158. SPARAL.IOPE = IOPERA
  159. SPARAL.IARG = IARGU
  160. SPARAL.I1I = I1
  161. SPARAL.X1I = X1
  162.  
  163. IF (BTHRD) THEN
  164. C Remplissage du 'COMMON/optabc'
  165. IPARAL=SPARAL
  166. DO ith=2,NBTHR
  167. CALL THREADID(ith,OPTABi)
  168. ENDDO
  169. CALL OPTABi(1)
  170.  
  171. C Attente de la fin de tous les threads en cours de travail
  172. DO ith=2,NBTHR
  173. CALL THREADIF(ith)
  174. ENDDO
  175.  
  176. C On libère les Threads
  177. CALL THREADIS
  178.  
  179. C Verification de l'erreur (Apres liberation des THREADS)
  180. DO ith=1,NBTHR
  181. IRETOU=SPARAL.IERROR(ith)
  182. IF (IRETOU .GT. 0) THEN
  183. CALL ERREUR(IRETOU)
  184. RETURN
  185. ENDIF
  186. ENDDO
  187.  
  188. ELSE
  189. C Appel de la SUBROUTINE qui fait le travail
  190. CALL OPTAB0(1,SPARAL)
  191.  
  192. IRETOU=SPARAL.IERROR(1)
  193. IF (IRETOU .GT. 0) THEN
  194. CALL ERREUR(IRETOU)
  195. RETURN
  196. ENDIF
  197. ENDIF
  198.  
  199. C======================================================================C
  200. C Boucle pour restituer les SEGMENTS crees en *NOMOD
  201. C======================================================================C
  202. DO 50 IA=1,SVALUE.NPUTIL
  203. ISEG = SVALUE.IPOI2(IA,1)
  204. IF (ISEG.NE.0) SEGACT,ISEG*NOMOD
  205. 50 CONTINUE
  206. SEGSUP,SVALUE
  207.  
  208. IRET = 1
  209. END
  210.  
  211.  

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