Télécharger opchp1.eso

Retour à la liste

Numérotation des lignes :

  1. C OPCHP1 SOURCE CB215821 17/10/04 21:15:06 9586
  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.  
  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) CALL OOONTH(ITH)
  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. ITH=1
  148. NBTHR = 1
  149. BTHRD = .FALSE.
  150. ELSE
  151. ITH = 1
  152. NBTHR = MIN(NT1, NBTHRS)
  153. BTHRD = .TRUE.
  154. CALL THREADII
  155. ENDIF
  156.  
  157. SEGINI,SPARAL
  158. SPARAL.NBTHRD = NBTHR
  159. SPARAL.IVALUE = SVALUE
  160. SPARAL.IOPE = IOPERA
  161. SPARAL.IARG = IARGU
  162. SPARAL.I1I = I1
  163. SPARAL.X1I = X1
  164.  
  165. C Remplissage du 'COMMON/optabc'
  166. IPARAL=SPARAL
  167.  
  168. IF (BTHRD) THEN
  169. DO ith=2,NBTHR
  170. CALL THREADID(ith,OPTABi)
  171. ENDDO
  172. CALL OPTABi(1)
  173.  
  174. C Attente de la fin de tous les threads en cours de travail
  175. DO ith=2,NBTHR
  176. CALL THREADIF(ith)
  177. IRETOU=SPARAL.IERROR(ith)
  178. IF (IRETOU .GT. 0) THEN
  179. CALL ERREUR(IRETOU)
  180. RETURN
  181. ENDIF
  182. ENDDO
  183. IRETOU=SPARAL.IERROR(1)
  184. IF (IRETOU .GT. 0) THEN
  185. CALL ERREUR(IRETOU)
  186. RETURN
  187. ENDIF
  188.  
  189. C On libère les Threads
  190. CALL THREADIS
  191.  
  192. C En multithread il peut y avoir n'importe quoi dans OOV(1)
  193. C Indicateur de l'utilisation d'un ELEMENT DE SEGMENT
  194. OOV(1) = 0
  195.  
  196. ELSE
  197. DO 99 IA=1,NBPOIN
  198. NTABEN = 1
  199. ITYP = SVALUE.ITYPOI (IA )
  200. ITAIL1=SVALUE.IPOI0 (IA,2)
  201. ITAIL2=SVALUE.IPOI1 (IA,2)
  202. ITAIL3=SVALUE.IPOI2 (IA,2)
  203.  
  204. C Traitement direct du bon type d''OBJET de Cast3M
  205. MPOVA1=SVALUE.IPOI0 (IA,1)
  206. MPOVA2=SVALUE.IPOI1 (IA,1)
  207. MPOVAL=SVALUE.IPOI2 (IA,1)
  208.  
  209. IF (MPOVA2 .GT. 0) THEN
  210. NTABEN = 2
  211. CALL OPTABj(NBTHR ,ITH,IOPERA,NTABEN,
  212. & MPOVA1.VPOCHA,MPOVA2.VPOCHA,MPOVAL.VPOCHA,
  213. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 ,IRETOU )
  214. ELSE
  215. CALL OPTABj(NBTHR ,ITH,IOPERA,NTABEN,
  216. & MPOVA1.VPOCHA,MPOVA1.VPOCHA,MPOVAL.VPOCHA,
  217. & ITAIL1,ITAIL2,ITAIL3,IARGU ,I1 ,X1 ,IRETOU )
  218. ENDIF
  219. 99 CONTINUE
  220.  
  221. IF (IRETOU .GT. 0) THEN
  222. CALL ERREUR(IRETOU)
  223. RETURN
  224. ENDIF
  225. ENDIF
  226.  
  227. C======================================================================C
  228. C Boucle pour desactiver les SEGMENTS
  229. C======================================================================C
  230. DO 50 IA=1,NBPOIN
  231. ISEG = SVALUE.IPOI0(IA,1)
  232. IF (ISEG.NE.0) SEGDES,ISEG
  233. ISEG = SVALUE.IPOI1(IA,1)
  234. IF (ISEG.NE.0) SEGDES,ISEG
  235. ISEG = SVALUE.IPOI2(IA,1)
  236. IF (ISEG.NE.0) SEGDES,ISEG
  237. 50 CONTINUE
  238. SEGSUP,SVALUE
  239.  
  240. IRET = 1
  241. RETURN
  242. END
  243.  
  244.  
  245.  

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