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.  
  49. -INC PPARAM
  50. -INC CCOPTIO
  51. -INC CCREEL
  52. C
  53. BATAN2 = .FALSE.
  54.  
  55. XIN1=XZERO
  56. XIN2=XZERO
  57. XOUT=XZERO/XPI
  58.  
  59. N1PTEL=0
  60. N2PTEL=0
  61. N3PTEL=0
  62. N1EL =0
  63. N2EL =0
  64. IR =0
  65.  
  66.  
  67. SEGACT MCHEL1
  68. SEGINI,MCHELM=MCHEL1
  69. N1 = ICHAML(/1)
  70.  
  71. C ajout lecture second argument pour ATAN2 au lieu de ATAN
  72. IF(MCHEL3.NE.0) THEN
  73. SEGACT MCHEL3
  74. IF (N1.NE.MCHEL3.ICHAML(/1)) GOTO 300
  75. DO I=1,N1
  76. IF (IMACHE(I).NE.MCHEL3.IMACHE(I)) GOTO 300
  77. ENDDO
  78. ENDIF
  79.  
  80. DO I = 1,N1
  81. MCHAM1 = ICHAML(I)
  82. SEGINI,MCHAML = MCHAM1
  83. ICHAML(I) = MCHAML
  84. N2 = IELVAL(/1)
  85. C Vérif du meme nombre de composante si second argument
  86. IF(MCHEL3.NE.0) THEN
  87. MCHAM3 = MCHEL3.ICHAML(I)
  88. segact,MCHAM3
  89. IF(MCHAM3.IELVAL(/1).NE.N2) GOTO 302
  90. ENDIF
  91. C Vérification que les composantes sont réelles
  92. DO J = 1,N2
  93. IF (TYPCHE(J).NE.'REAL*8') THEN
  94. C Le type %m1:16 de la composante %m17:20 du champ par
  95. C élement %m21:36 ne correspond pas à celui attendu
  96. MOTERR(1:8) = TYPCHE(J)
  97. MOTERR(17:20) = NOMCHE(J)
  98. MOTERR(21:29) = 'argument'
  99. CALL ERREUR(552)
  100. DO K = 1,I
  101. MCHAML = ICHAML(K)
  102. SEGSUP MCHAML
  103. ENDDO
  104. SEGSUP MCHELM
  105. RETURN
  106. ENDIF
  107. C Vérification qu'on a la meme chose pour le second argument
  108. IF(MCHEL3.NE.0) THEN
  109. IF(MCHAM3.NOMCHE(J).NE.NOMCHE(J)) GOTO 302
  110. ENDIF
  111. ENDDO
  112. C calcul de l'atan
  113. DO J = 1,N2
  114. MELVA1 = IELVAL(J)
  115. SEGINI,MELVAL=MELVA1
  116. IELVAL(J) = MELVAL
  117. NPTEL = VELCHE(/1)
  118. NEL = VELCHE(/2)
  119. IF (MCHEL3.NE.0) THEN
  120. BATAN2 = .TRUE.
  121. MELVA3=MCHAM3.IELVAL(J)
  122. segact,MELVA3
  123. N3PTEL = MELVA3.VELCHE(/1)
  124. N3EL = MELVA3.VELCHE(/2)
  125. IF (NPTEL.EQ.N3PTEL.AND.NEL.EQ.N3EL)THEN
  126. DO K = 1,NEL
  127. DO L = 1,NPTEL
  128. XIN1 = VELCHE(L,K)
  129. XIN2 = MELVA3.VELCHE(L,K)
  130. CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
  131. VELCHE(L,K) = XOUT
  132. ENDDO
  133. ENDDO
  134. ELSE
  135. C il faut faire attention aux champs constants
  136. N1PTEL = max(NPTEL,N3PTEL)
  137. N1EL = max(NEL, N3EL)
  138. segadj,MELVAL
  139. segact,MELVA1
  140. DO K1 = 1,N1EL
  141. K = MIN(K1,NEL)
  142. K3 = MIN(K3,N3EL)
  143. DO L1 = 1,N1PTEL
  144. L = MIN(L1,NPTEL)
  145. L3 = MIN(L1,N3PTEL)
  146.  
  147. XIN1 = MELVA1.VELCHE(L,K)
  148. XIN2 = MELVA3.VELCHE(L3,K3)
  149. CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
  150. VELCHE(L,K) = XOUT
  151. ENDDO
  152. ENDDO
  153. segdes,MELVA1
  154. ENDIF
  155. SEGDES,MELVA3
  156. ELSE
  157. DO K = 1,NEL
  158. DO L = 1,NPTEL
  159. XIN1 = VELCHE(L,K)
  160. CALL OPFLOT(XIN1,XIN2,IR,BATAN2,IEPS,XOUT)
  161. VELCHE(L,K) = XOUT
  162. ENDDO
  163. ENDDO
  164. ENDIF
  165. SEGDES,MELVAL
  166. ENDDO
  167. SEGDES,MCHAM1
  168. SEGDES,MCHAML
  169. ENDDO
  170.  
  171. SEGDES MCHELM
  172. MCHEL3 = MCHELM
  173. RETURN
  174.  
  175. C gestion des erreurs
  176. 302 CALL ERREUR(488)
  177.  
  178. DO K = 1,I
  179. MCHAML = ICHAML(K)
  180. SEGSUP MCHAML
  181. MCHAM3 = MCHEL3.ICHAML(K)
  182. segdes,MCHAM3
  183. ENDDO
  184.  
  185. goto 299
  186.  
  187. 300 CALL ERREUR(329)
  188.  
  189. 299 segdes,MCHEL3,MCHEL1
  190. segsup,MCHELM
  191. RETURN
  192.  
  193. END
  194.  
  195.  
  196.  
  197.  
  198.  

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