Télécharger dfour2.eso

Retour à la liste

Numérotation des lignes :

dfour2
  1. C DFOUR2 SOURCE CB215821 20/11/04 21:16:11 10766
  2. SUBROUTINE DFOUR2(IPCHE1,ANGL,IPCHE2)
  3.  
  4. C====================================================================
  5. C
  6. C ENTREES
  7. C IPCHE1 = CHAMELEM DE TYPE CONTRAINTES OU DEFORMATIONS
  8. C ANGL = ANGLE
  9. C SORTIES
  10. C IPCHE2 = SI SUCCES , POINTEUR SUR UN MCHAML
  11. C 0 SINON
  12. C
  13. C J BROCHARD MARS 87
  14. C NOUVEAUX CHAMELEMS P DOWLATYARI SEP 91
  15. C=====================================================================
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8(A-H,O-Z)
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMCHAML
  22. -INC CCREEL
  23. CHARACTER*(LOCOMP) NOMCOM
  24.  
  25. C
  26. ANGL=(ANGL*XPI)/180.D0
  27. C
  28. C-------ON VERIFIE QUE IFOCHE EST BIEN EGAL A 1
  29. C
  30. MCHEL1=IPCHE1
  31. SEGACT MCHEL1
  32. IF(MCHEL1.IFOCHE.NE.1)THEN
  33. MOTERR(1:8)='DFOURIER'
  34. CALL ERREUR(333)
  35. SEGDES MCHEL1
  36. RETURN
  37. ENDIF
  38. C
  39. C ON VERIFIE QUE LE CHAMP/ELEMENT EST BIEN DE TYPE CONTRAINTE OU
  40. C DEFORMATION
  41. C
  42. IF(MCHEL1.TITCHE.EQ.'CONTRAINTES')THEN
  43. ITYPE=1
  44. L1=11
  45. ELSEIF(MCHEL1.TITCHE.EQ.'DEFORMATIONS')THEN
  46. ITYPE=2
  47. L1=12
  48. ELSE
  49. MOTERR(1:8)='DFOURIER'
  50. CALL ERREUR(334)
  51. SEGDES MCHEL1
  52. RETURN
  53. ENDIF
  54. C
  55. N1=MCHEL1.INFCHE(/1)
  56. N3=MCHEL1.INFCHE(/2)
  57. SEGINI MCHELM
  58. IPCHE2=MCHELM
  59. TITCHE=MCHEL1.TITCHE
  60. IFOCHE=1
  61. NSOUS=N1
  62. C
  63. C BOUCLE SUR LES SOUS-ZONES
  64. C
  65. DO 500 ISOUS=1,NSOUS
  66. C
  67. CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS)
  68. IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS)
  69. DO 10 IN=1,N3
  70. INFCHE(ISOUS,IN)=MCHEL1.INFCHE(ISOUS,IN)
  71. 10 CONTINUE
  72. C
  73. C ON MET NUMERO DE l'HARMONIQUE A ZERO POUR ADDITIONS FUTURS
  74. C
  75. NHRM=INFCHE(ISOUS,3)
  76. INFCHE(ISOUS,3)=0
  77. C
  78. COSNT=COS(NHRM*ANGL)
  79. SINNT=SIN(NHRM*ANGL)
  80. IF(NHRM.LT.0) THEN
  81. CNT=SINNT
  82. SINNT=COSNT
  83. COSNT=CNT
  84. ENDIF
  85. C
  86. C CREATION DU MCHAML DE LA SOUS-ZONE
  87. C
  88. MCHAM1=MCHEL1.ICHAML(ISOUS)
  89. SEGACT MCHAM1
  90. N2=MCHAM1.IELVAL(/1)
  91. SEGINI MCHAML
  92. ICHAML(ISOUS)=MCHAML
  93. DO 100 ICOMP=1,N2
  94. C
  95. MELVA1=MCHAM1.IELVAL(ICOMP)
  96. SEGACT MELVA1
  97. NBPTEL=MELVA1.VELCHE(/1)
  98. NEL=MELVA1.VELCHE(/2)
  99. NOMCOM=MCHAM1.NOMCHE(ICOMP)
  100. C
  101. IF(NOMCOM.EQ.'SMRR'.OR.NOMCOM.EQ.'SMZZ'.OR.
  102. 1 NOMCOM.EQ.'SMTT'.OR.NOMCOM.EQ.'SMRZ'.OR.
  103. 2 NOMCOM.EQ. 'N11'.OR.NOMCOM.EQ. 'N22'.OR.
  104. 3 NOMCOM.EQ. 'M11'.OR.NOMCOM.EQ. 'M22'.OR.
  105. 4 NOMCOM.EQ.'EPRR'.OR.NOMCOM.EQ.'EPZZ'.OR.
  106. 5 NOMCOM.EQ.'EPTT'.OR.NOMCOM.EQ.'GARZ'.OR.
  107. 6 NOMCOM.EQ.'EPSS'.OR.NOMCOM.EQ.'RTSS'.OR.
  108. 7 NOMCOM.EQ.'RTTT')THEN
  109. C
  110. NOMCHE(ICOMP)=NOMCOM
  111. TYPCHE(ICOMP)='REAL*8'
  112. N1PTEL=NBPTEL
  113. N1EL=NEL
  114. N2PTEL=0
  115. N2EL=0
  116. SEGINI MELVAL
  117. IELVAL(ICOMP)=MELVAL
  118. DO 110 IB=1,NEL
  119. DO 110 IGAU=1,NBPTEL
  120. VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)*COSNT
  121. 110 CONTINUE
  122. SEGDES MELVAL,MELVA1
  123. C
  124. ELSEIF(NOMCOM.EQ.'SMRT'.OR.NOMCOM.EQ.'SMZT'.OR.
  125. 1 NOMCOM.EQ. 'N12'.OR.NOMCOM.EQ. 'M12'.OR.
  126. 2 NOMCOM.EQ.'GART'.OR.NOMCOM.EQ.'GAZT'.OR.
  127. 3 NOMCOM.EQ.'GAST'.OR.NOMCOM.EQ.'RTST')THEN
  128. C
  129. NOMCHE(ICOMP)=NOMCOM
  130. TYPCHE(ICOMP)='REAL*8'
  131. N1PTEL=NBPTEL
  132. N1EL=NEL
  133. N2PTEL=0
  134. N2EL=0
  135. SEGINI MELVAL
  136. IELVAL(ICOMP)=MELVAL
  137. DO 120 IB=1,NEL
  138. DO 120 IGAU=1,NBPTEL
  139. VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)*SINNT
  140. 120 CONTINUE
  141. SEGDES MELVAL,MELVA1
  142. C
  143. ELSE
  144. MOTERR(1:4)='DFOU'
  145. MOTERR(5:8)=NOMCOM
  146. CALL ERREUR(335)
  147. SEGSUP MCHAML,MCHELM
  148. SEGDES MELVA1
  149. SEGDES MCHAM1,MCHEL1
  150. RETURN
  151. ENDIF
  152. C
  153. 100 CONTINUE
  154. SEGDES MCHAML,MCHAM1
  155. C
  156. 500 CONTINUE
  157. SEGDES MCHEL1,MCHELM
  158. RETURN
  159. END
  160.  
  161.  

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