Télécharger opchel.eso

Retour à la liste

Numérotation des lignes :

  1. C OPCHEL SOURCE FD218221 15/07/31 21:15:00 8596
  2. SUBROUTINE OPCHEL(MCHEL1,IEPS,MCHEL3)
  3. C=====================================================================
  4. C
  5. C EFFECTUE DIVERSES OPERATIONS SUR DES MCHAML
  6. C ENTREES
  7. C MCHEL1=POINTEUR SUR UN MCHAML
  8. C MCHEL3 (E) POINTEUR SUR UN MCHAML si appel à ATAN2.
  9. C IEPS = 1 COSINUS
  10. C = 2 SINUS
  11. C = 3 TANGENTE
  12. C = 4 ARCOSINUS
  13. C = 5 ARCSINUS
  14. C = 6 ARCTANGENTE
  15. C = 7 EXPONENTIELLE
  16. C = 8 LOGARITHME
  17. C = 9 VALEUR ABSOLUE
  18. C =10 COSINUS HYPERBOLIQUE
  19. C =11 SINUS HYPERBOLIQUE
  20. C =12 TANGENTE HYPERBOLIQUE
  21. C =13 ERF FONCTION D'ERRREUR DE GAUSS
  22. C =14 ERFC FONCTION D'ERRREUR complementaire DE GAUSS (1-erf(x))
  23. C =15 ARGCH (Fonction reciproque de COSH)
  24. C =16 ARGSH (Fonction reciproque de SINH)
  25. C =17 ARGTH (Fonction reciproque de TANH)
  26. C =18 COTANGENTE (inverse de la tangente)
  27. C
  28. C =19 PRODUIT FLOTTANT * FLOTTANT
  29. C =20 DIVISION FLOTTANT / FLOTTANT
  30. C =21 PUISSANCE FLOTTANT ** FLOTTANT
  31. C =22 PUISSANCE FLOTTANT ** ENTIER
  32. C
  33. C
  34. C SORTIES
  35. C MCHEL3=POINTEUR SUR MCHAML RESULTANT
  36. C
  37. C PASSAGE AUX NOUVEAUX CHAMELEMS LE 3 09 90 PAR I.MONNIER
  38. C
  39. C=====================================================================
  40. C
  41. IMPLICIT INTEGER(I-N)
  42. IMPLICIT REAL*8(A-H,O-Z)
  43.  
  44. LOGICAL BATAN2
  45. INTEGER IR
  46. C
  47. -INC SMCHAML
  48. -INC CCOPTIO
  49. -INC CCREEL
  50. C
  51. BATAN2 = .FALSE.
  52.  
  53. XIN1=XZERO
  54. XIN2=XZERO
  55. XOUT=XZERO/XPI
  56.  
  57. N1PTEL=0
  58. N2PTEL=0
  59. N3PTEL=0
  60. N1EL =0
  61. N2EL =0
  62. IR =0
  63.  
  64.  
  65. SEGACT MCHEL1
  66. SEGINI,MCHELM=MCHEL1
  67. N1 = ICHAML(/1)
  68.  
  69. C ajout lecture second argument pour ATAN2 au lieu de ATAN
  70. IF(MCHEL3.NE.0) THEN
  71. SEGACT MCHEL3
  72. IF (N1.NE.MCHEL3.ICHAML(/1)) GOTO 300
  73. DO I=1,N1
  74. IF (IMACHE(I).NE.MCHEL3.IMACHE(I)) GOTO 300
  75. ENDDO
  76. ENDIF
  77.  
  78. DO I = 1,N1
  79. MCHAM1 = ICHAML(I)
  80. SEGINI,MCHAML = MCHAM1
  81. ICHAML(I) = MCHAML
  82. N2 = IELVAL(/1)
  83. C Vérif du meme nombre de composante si second argument
  84. IF(MCHEL3.NE.0) THEN
  85. MCHAM3 = MCHEL3.ICHAML(I)
  86. segact,MCHAM3
  87. IF(MCHAM3.IELVAL(/1).NE.N2) GOTO 302
  88. ENDIF
  89. C Vérification que les composantes sont réelles
  90. DO J = 1,N2
  91. IF (TYPCHE(J).NE.'REAL*8') THEN
  92. C Le type %m1:16 de la composante %m17:20 du champ par
  93. C élement %m21:36 ne correspond pas à celui attendu
  94. MOTERR(1:8) = TYPCHE(J)
  95. MOTERR(17:20) = NOMCHE(J)
  96. MOTERR(21:29) = 'argument'
  97. CALL ERREUR(552)
  98. DO K = 1,I
  99. MCHAML = ICHAML(K)
  100. SEGSUP MCHAML
  101. ENDDO
  102. SEGSUP MCHELM
  103. RETURN
  104. ENDIF
  105. C Vérification qu'on a la meme chose pour le second argument
  106. IF(MCHEL3.NE.0) THEN
  107. IF(MCHAM3.NOMCHE(J).NE.NOMCHE(J)) GOTO 302
  108. ENDIF
  109. ENDDO
  110. C calcul de l'atan
  111. DO J = 1,N2
  112. MELVA1 = IELVAL(J)
  113. SEGINI,MELVAL=MELVA1
  114. IELVAL(J) = MELVAL
  115. NPTEL = VELCHE(/1)
  116. NEL = VELCHE(/2)
  117. IF (MCHEL3.NE.0) THEN
  118. BATAN2 = .TRUE.
  119. MELVA3=MCHAM3.IELVAL(J)
  120. segact,MELVA3
  121. N3PTEL = MELVA3.VELCHE(/1)
  122. N3EL = MELVA3.VELCHE(/2)
  123. IF (NPTEL.EQ.N3PTEL.AND.NEL.EQ.N3EL)THEN
  124. DO K = 1,NEL
  125. DO L = 1,NPTEL
  126. XIN1 = VELCHE(L,K)
  127. XIN2 = MELVA3.VELCHE(L,K)
  128. CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
  129. VELCHE(L,K) = XOUT
  130. ENDDO
  131. ENDDO
  132. ELSE
  133. C il faut faire attention aux champs constants
  134. N1PTEL = max(NPTEL,N3PTEL)
  135. N1EL = max(NEL, N3EL)
  136. segadj,MELVAL
  137. segact,MELVA1
  138. DO K1 = 1,N1EL
  139. K = MIN(K1,NEL)
  140. K3 = MIN(K3,N3EL)
  141. DO L1 = 1,N1PTEL
  142. L = MIN(L1,NPTEL)
  143. L3 = MIN(L1,N3PTEL)
  144.  
  145. XIN1 = MELVA1.VELCHE(L,K)
  146. XIN2 = MELVA3.VELCHE(L3,K3)
  147. CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
  148. VELCHE(L,K) = XOUT
  149. ENDDO
  150. ENDDO
  151. segdes,MELVA1
  152. ENDIF
  153. SEGDES,MELVA3
  154. ELSE
  155. DO K = 1,NEL
  156. DO L = 1,NPTEL
  157. XIN1 = VELCHE(L,K)
  158. CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
  159. VELCHE(L,K) = XOUT
  160. ENDDO
  161. ENDDO
  162. ENDIF
  163. SEGDES,MELVAL
  164. ENDDO
  165. SEGDES,MCHAM1
  166. SEGDES,MCHAML
  167. ENDDO
  168.  
  169. SEGDES MCHELM
  170. MCHEL3 = MCHELM
  171. RETURN
  172.  
  173. C gestion des erreurs
  174. 302 CALL ERREUR(488)
  175.  
  176. DO K = 1,I
  177. MCHAML = ICHAML(K)
  178. SEGSUP MCHAML
  179. MCHAM3 = MCHEL3.ICHAML(K)
  180. segdes,MCHAM3
  181. ENDDO
  182.  
  183. goto 299
  184.  
  185. 300 CALL ERREUR(329)
  186.  
  187. 299 segdes,MCHEL3,MCHEL1
  188. segsup,MCHELM
  189. RETURN
  190.  
  191. END
  192.  
  193.  
  194.  
  195.  
  196.  

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