Télécharger cmaxro.eso

Retour à la liste

Numérotation des lignes :

cmaxro
  1. C CMAXRO SOURCE CB215821 26/08/24 21:15:36 12622
  2. SUBROUTINE CMAXRO(WRK52,WRK53,WRK54,IB,IGAU,NBGMAT,NELMAT)
  3. C MAXROT SOURCE PV 99/08/14 12:48:16 3659
  4. * SUBROUTINE MAXROT(WTRAV,MFR,IB,IGAU,NBGMAT,NELMAT,NPINT)
  5. C
  6. C ROTATION DES TENSEURS POUR MAXWEL
  7. C SI MATE UNIDIRECTIONNEL
  8. C INSPIRE DE HOOKUN
  9. C
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. PARAMETER(UN=1.D0,DEUX=2.D0,UNDEMI=.5D0)
  13. C
  14. -INC CCHAMP
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC DECHE
  19.  
  20.  
  21.  
  22. C
  23. C INITIALISATION
  24. C
  25. CALL ZERO(XGLOB,IDIM,IDIM)
  26.  
  27. ***********************
  28. * CAS MASSIF
  29. ***********************
  30. *
  31. IF (MFR.EQ.1.OR.MFR.EQ.33) THEN
  32.  
  33. IF(IGAU.LE.NBGMAT) THEN
  34.  
  35. IF(IDIM.EQ.2)THEN
  36. C
  37. C DEFINITION DES AXES ORTHO./AXES LOCAUX
  38. C
  39.  
  40. XLOC(1,1)=VALMAT(2)
  41. XLOC(2,1)=VALMAT(3)
  42. XLOC(1,2)=-XLOC(2,1)
  43. XLOC(2,2)=XLOC(1,1)
  44.  
  45. ELSEIF(IDIM.EQ.3)THEN
  46. XLOC(1,1)=VALMAT(2)
  47. XLOC(2,1)=VALMAT(3)
  48. XLOC(3,1)=VALMAT(4)
  49. XLOC(1,2)=VALMAT(5)
  50. XLOC(2,2)=VALMAT(6)
  51. XLOC(3,2)=VALMAT(7)
  52. C
  53. CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
  54. IF(IRR.EQ.0) THEN
  55. CALL ERREUR(277)
  56. RETURN
  57. ENDIF
  58. ENDIF
  59.  
  60.  
  61.  
  62. C
  63. C DEFINITION DES AXES ORTHO./AXES GLOBAUX
  64. C
  65. DO 2037 K=1,IDIM
  66. DO 2036 J=1,IDIM
  67. DO 1045 I=1,IDIM
  68. XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J)
  69. 1045 CONTINUE
  70. 2036 CONTINUE
  71. 2037 CONTINUE
  72.  
  73. ENDIF
  74. C
  75. C
  76. ELSEIF (IGAU.LE.NBGMAT.AND.
  77. + (IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  78. C
  79. C MLR 12/8/99
  80. C POUR LE MOMENT ON BLOQUE LE RESTE
  81. C A BRANCHER PLUS TARD ...!
  82. C
  83. IZOB=0
  84. IF(IZOB.EQ.0) THEN
  85. CALL ERREUR (251)
  86. RETURN
  87. ENDIF
  88.  
  89.  
  90.  
  91.  
  92. C
  93. C Coques minces
  94. C
  95. IF(MFR.EQ.3) THEN
  96. C
  97. C CAS DKT INTEGRE
  98. C
  99. IF (NPINT.NE.0) THEN
  100. * CAS NON ENCORE IMPLEMENTE
  101. CALL ERREUR (251)
  102. RETURN
  103. ELSE
  104. C
  105. C CAS TRIDIMENSIONNEL ET FOURIER
  106. C
  107. IF(IFOUR.EQ.2.OR.IFOUR.EQ.1) THEN
  108. *PV D3HOO1 n'existe pas !!!
  109. * CALL ZERO(D3HOO1,3,3)
  110. COSA=VALMAT(2)
  111. SINA=VALMAT(3)
  112. C
  113. COS2 = COSA**2
  114. SIN2 = SINA**2
  115. SINCOS = SINA * COSA
  116. C
  117. C
  118. C
  119. C CAS AXISYMETRIQUE ET DEFORMATIONS PLANES
  120. C
  121. ELSE IF(IFOUR.EQ.0.OR.IFOUR.EQ.-1.OR.
  122. & IFOUR.EQ.-3) THEN
  123. COSA=VALMAT(2)
  124. SINA=VALMAT(3)
  125. COS2 = COSA**2
  126. SIN2 = SINA**2
  127. C
  128. C
  129. C CAS CONTRAINTES PLANES
  130. C
  131. ELSE IF(IFOUR.EQ.-2) THEN
  132. ******** DDHOOK(1,1)=YG1
  133. ******** DDHOOK(3,3)=YG1
  134. C
  135. ELSE
  136. IRET=0
  137. ENDIF
  138. ENDIF
  139. C
  140. C Coques epaisses
  141. C
  142. ELSE IF(MFR.EQ.5) THEN
  143. C
  144. C CAS TRIDIMENSIONNEL
  145. C
  146. IF(IFOUR.EQ.2) THEN
  147. COSA=VALMAT(2)
  148. SINA=VALMAT(3)
  149. C
  150. COS2 = COSA**2
  151. SIN2 = SINA**2
  152. SINCOS = SINA * COSA
  153. C
  154. C
  155. ELSE
  156. IRET=0
  157. ENDIF
  158. C
  159. C Coques minces avec cisaillement transverse
  160. C
  161. ELSE IF(MFR.EQ.9) THEN
  162. C
  163. IF(IFOUR.EQ.2) THEN
  164. COSA=VALMAT(2)
  165. SINA=VALMAT(3)
  166. C
  167. COS2 = COSA**2
  168. SIN2 = SINA**2
  169. SINCOS = SINA * COSA
  170. C
  171. C
  172. ELSE
  173. IRET=0
  174. ENDIF
  175. C
  176. C Cas des barres
  177. C
  178. ELSE IF(MFR.EQ.27) THEN
  179. C
  180. C RIEN A FAIRE
  181. C
  182. ELSE
  183. IRET=0
  184. GOTO 2035
  185. ENDIF
  186. ENDIF
  187. C
  188. 2035 RETURN
  189.  
  190. END
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  

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