Télécharger fsur.eso

Retour à la liste

Numérotation des lignes :

  1. C FSUR SOURCE CB215821 19/07/30 21:16:35 10273
  2. *
  3. SUBROUTINE FSUR
  4. *
  5. *-----------------------------------------------------------------------
  6. *
  7. * OPERATEUR FSUR
  8. *
  9. *-----------------------------------------------------------------------
  10. *
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8 (A-H,O-Z)
  13. *
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. *
  18. -INC SMCHPOI
  19. *
  20. PARAMETER (NTYPE = 3, NTYPR = 1)
  21. CHARACTER*4 MTYPE(NTYPE),MTYPR(NTYPR)
  22. *
  23. DATA MTYPE / 'MASS','COQU','POUT' /
  24. DATA MTYPR / 'PROJ' /
  25. *
  26. IMLU = 0
  27. IPMODL = 0
  28. IPCHPS = 0
  29. IPVECT = 0
  30. IPMAIL = 0
  31. IPCARA = 0
  32. IPCHPF = 0
  33. *
  34. *-----------------------------------------------------------------------
  35. * LECTURE DES ARGUMENTS
  36. *-----------------------------------------------------------------------
  37. *
  38. * ON LIT UN MOT-CLE OBLIGATOIRE
  39. *
  40. CALL LIRMOT(MTYPE,NTYPE,IMLU,1)
  41. IF (IERR.NE.0) RETURN
  42. *
  43. * ON LIT UN MMODEL OBLIGATOIRE
  44. *
  45. CALL LIROBJ('MMODEL ',IPMODL,1,iret)
  46. CALL ACTOBJ('MMODEL ',IPMODL,1)
  47. IF (IERR.NE.0) RETURN
  48. *
  49. * ON LIT SOIT UN CHAMP POINT, SOIT UN VECTEUR
  50. *
  51. CALL LIROBJ('CHPOINT ',IPCHPS,0,iretch)
  52. IF(iretch .EQ. 1) CALL ACTOBJ('CHPOINT ',IPCHPS,1)
  53. IF (IERR.NE.0) RETURN
  54. *
  55. * IF (IPCHPS .EQ. 0) THEN
  56. IF (iretch .EQ. 0) THEN
  57. CALL LIROBJ('POINT ',IPVECT,1,iret)
  58. IF (IERR.NE.0) RETURN
  59. ENDIF
  60. *
  61. *-----------------------------------------------------------------------
  62. * ON A LU LE MOT MASSIF
  63. *-----------------------------------------------------------------------
  64. IF (IMLU.EQ.1) THEN
  65. *
  66. * SI ON A LU UN VECTEUR, IL FAUT LIRE UN MAILLAGE OBLIGATOIREMENT
  67. *
  68. IF (IPVECT .NE. 0) THEN
  69. CALL ACTOBJ('MAILLAGE',IPMAIL,1)
  70. CALL LIROBJ('MAILLAGE',IPMAIL,1,iret)
  71. IF (IERR.NE.0) RETURN
  72. ENDIF
  73. *
  74. * LECTURE D'UN MCHAML DE CARACTERISTIQUES FACULTATIVE
  75. *
  76. CALL LIROBJ('MCHAML ',IPCARA,0,iret)
  77. IF(iret .EQ. 1) CALL ACTOBJ('MCHAML ',IPCARA,1)
  78. IF (IERR.NE.0) RETURN
  79. *
  80. * CALCUL DU CHAMP POINT DE FORCES NODALES EQUIVALENTES
  81. *
  82. CALL FSURMA(IPMODL,IPCHPS,IPVECT,IPMAIL,IPCARA, IPCHPF)
  83. *
  84. *-----------------------------------------------------------------------
  85. * ON A LU LE MOT COQUE
  86. *-----------------------------------------------------------------------
  87. ELSE IF (IMLU.EQ.2) THEN
  88. *
  89. * LECTURE D'UN MCHAML DE CARACTERISTIQUES FACULTATIVE
  90. *
  91. CALL LIROBJ('MCHAML',IPCARA,0,iret)
  92. IF(iret .EQ. 1) CALL ACTOBJ('MCHAML ',IPCARA,1)
  93. IF (IERR.NE.0) RETURN
  94. *
  95. * CALCUL DU CHAMP POINT DE FORCES NODALES EQUIVALENTES
  96. *
  97. CALL FSURCO(IPMODL,IPCHPS,IPVECT,IPCARA, IPCHPF)
  98. *
  99. *-----------------------------------------------------------------------
  100. * ON A LU LE MOT POUT
  101. *-----------------------------------------------------------------------
  102. ELSE IF (IMLU.EQ.3) THEN
  103. *
  104. IVPROJ = 0
  105. *
  106. * LECTURE DU MOT-CLE FACULTATIF 'PROJ'
  107. *
  108. CALL LIRMOT(MTYPR,NTYPR,IPROJ,0)
  109. IF (IERR.NE.0) THEN
  110. CALL ERREUR(7)
  111. RETURN
  112. ENDIF
  113. *
  114. * LECTURE DU VECTEUR SI MOT-CLE 'PROJ' A ETE LU
  115. *
  116. IF (IPROJ.EQ.1) THEN
  117. CALL LIROBJ('POINT ',IVPROJ,1,iret)
  118. IF (IERR.NE.0) RETURN
  119. ENDIF
  120. *
  121. * CALCUL DU CHAMP POINT DE FORCES NODALES EQUIVALENTES
  122. *
  123. CALL FSURPO(IPMODL,IPCHPS,IPVECT,IVPROJ, IPCHPF)
  124. *
  125. ENDIF
  126. *
  127. *-----------------------------------------------------------------------
  128. * FIN DU TRAITEMENT
  129. *-----------------------------------------------------------------------
  130. *
  131. * --> SORTIE PREMATUREE EN CAS D'ERREUR LORS DU CALCUL DES FORCES
  132. *
  133. IF (IERR.NE.0 .OR. IPCHPF.EQ.0) RETURN
  134. *
  135. * --> LE CHAMP DE FORCES NODALES EQUIVALENTES EST DE NATURE DISCRETE
  136. * LE NUMERO DE L HARMONIQUE EST PRIS EGAL A NIFOUR
  137. * POUR TOUTES LES COMPOSANTES DU CHPOINT
  138. *
  139. MCHPOI = IPCHPF
  140. SEGACT,MCHPOI*MOD
  141. NAT = MAX(JATTRI(/1),1)
  142. NSOUPO = IPCHP(/1)
  143. SEGADJ,MCHPOI
  144. JATTRI(1) = 2
  145. DO 10 i = 1, NSOUPO
  146. MSOUPO = IPCHP(i)
  147. SEGACT,MSOUPO*MOD
  148. DO 11 j = 1, NOHARM(/1)
  149. NOHARM(j) = NIFOUR
  150. 11 CONTINUE
  151. 10 CONTINUE
  152. *
  153. * --> ECRITURE DU CHPOINT RESULTAT
  154. *
  155. CALL ACTOBJ('CHPOINT ',IPCHPF,1)
  156. CALL ECROBJ('CHPOINT ',IPCHPF)
  157.  
  158. END
  159.  
  160.  
  161.  

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