Télécharger opchp1.eso

Retour à la liste

Numérotation des lignes :

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

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