Télécharger nnor.eso

Retour à la liste

Numérotation des lignes :

  1. C NNOR SOURCE CB215821 19/07/09 21:15:15 10252
  2. SUBROUTINE NNOR
  3. ************************************************************************
  4. * NOM : NNOR
  5. * DESCRIPTION : La directive NNOR rend un objet unitaire au sens de la
  6. * norme infinie (par defaut) ou de la norme Euclidienne.
  7. ************************************************************************
  8. * APPELE PAR : pilot.eso
  9. ************************************************************************
  10. * SOUS-PROGRAMMES : norma3 => norme sup d'un objet CHPOINT
  11. * norma5 => norme sup d'un objet TABLE
  12. * normb3 => norme 2 d'un objet CHPOINT
  13. * normb5 => norme 2 d'un objet TABLE
  14. ************************************************************************
  15. * SYNTAXE (GIBIANE) :
  16. *
  17. * 1) NORME INFINIE
  18. *
  19. * NNOR ('INFI') OBJET1 ( | ('AVEC') | LMOTS1 ) ...
  20. * | 'SANS' |
  21. *
  22. * ... ('RORF' VAL1 'CREF' VAL2 'LCAR' VAL3) ;
  23. *
  24. *
  25. * 2) NORME EUCLIDIENNE
  26. *
  27. * NNOR 'EUCL' OBJET1 (RIGID1) ;
  28. *
  29. ************************************************************************
  30. *
  31. IMPLICIT INTEGER(I-N)
  32. IMPLICIT REAL*8(A-H,O-Z)
  33. -INC CCOPTIO
  34. -INC SMTABLE
  35. -INC SMCHPOI
  36. *
  37. c REAL*8 VNOR,PGRAND,FLUI(3),COEFP,COEFPI,RET
  38. REAL*8 FLUI(3)
  39. *
  40. PARAMETER (NBTYPE = 2)
  41. PARAMETER (LCLEF = 5)
  42. PARAMETER (LNORM = 2)
  43. *
  44. CHARACTER*8 LISTYP(NBTYPE),MONTYP,CHA8
  45. CHARACTER*4 MOCLEF(LCLEF),MONORM(LNORM),MOTCLE
  46. *
  47. DATA LISTYP/'CHPOINT ','TABLE '/
  48. DATA MOCLEF/'RORF','CREF','LCAR','AVEC','SANS'/
  49. DATA MONORM/'INFI','EUCL'/
  50.  
  51. IFLUI=0
  52. INORM=1
  53. MOTCLE = ' '
  54. *
  55. * LECTURE DU TYPE DE NORME
  56. * ========================
  57. ICODE = 0
  58. CALL LIRMOT(MONORM,LNORM,IVAL,ICODE)
  59. IF (IVAL .GT. 1) INORM=IVAL
  60. *
  61. *
  62. IF (INORM.EQ.1) THEN
  63. *
  64. * LECTURE DES MOTS-CLES
  65. * =====================
  66. 1 ICODE = 0
  67. CALL LIRMOT(MOCLEF,LCLEF,IVAL,ICODE)
  68. IF(IVAL.EQ.1 .OR. IVAL.EQ.2 .OR. IVAL.EQ.3) THEN
  69. CALL LIRREE(RET,1,IRETOU)
  70. IF(IERR.NE.0) RETURN
  71. FLUI(IVAL)=RET
  72. IFLUI=IFLUI + 2**IVAL
  73. ELSEIF (IVAL.EQ.4 .OR. IVAL.EQ.5) THEN
  74. MOTCLE=MOCLEF(IVAL)
  75. ELSE
  76. GOTO 2
  77. ENDIF
  78. GOTO 1
  79. *
  80. * LECTURE DE LA LISTE DES COMPOSANTES
  81. * ===================================
  82. 2 ICODE = 0
  83. CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  84. IF (IRETOU .EQ. 0) THEN
  85. IPLMOT = 0
  86. ELSE IF (MOTCLE .EQ. ' ') THEN
  87. * PAR DEFAUT, LES COMPOSANTES NOMMEES SONT LES COMPOSANTES
  88. * PRISES EN COMPTE (ET NON PAS LES COMPOSANTES EXCLUES)
  89. MOTCLE = 'AVEC'
  90. END IF
  91.  
  92. ELSEIF (INORM.EQ.2) THEN
  93. *
  94. * LECTURE DE LA MATRICE
  95. * =====================
  96. ICODE=0
  97. CALL LIROBJ('RIGIDITE',IRIG1,ICODE,IZRIG)
  98. *
  99. ENDIF
  100. *
  101. *
  102. * LECTURE DE L'OBJET
  103. * ==================
  104. CALL QUETYP(MONTYP,0,IRETOU)
  105. IF (IRETOU.EQ.0) THEN
  106. CALL ERREUR(533)
  107. RETURN
  108. ENDIF
  109.  
  110. CALL PLACE(LISTYP,NBTYPE,IPOS,MONTYP)
  111. IF(IPOS .EQ. 0)THEN
  112. MOTERR(1:8)=MONTYP
  113. CALL ERREUR(39)
  114. RETURN
  115. ENDIF
  116.  
  117. IF (IPOS.EQ.2) THEN
  118. CALL LIRTAB('BASE_DE_MODES',ITBAS,0,IRETOU)
  119. IF (IRETOU .NE. 0) THEN
  120. IPOINT = ITBAS
  121.  
  122. ELSE
  123. CALL LIRTAB('BASE_MODALE',IPOINT,0,IRETOU)
  124. IF (IRETOU.NE.0) THEN
  125. CHA8=' '
  126. CALL ACMO(IPOINT,'MODES',CHA8,ITBAS)
  127. IF (CHA8.NE.'TABLE' .OR. ITBAS .LE. 0) THEN
  128. CALL ERREUR(647)
  129. RETURN
  130. ENDIF
  131.  
  132. ELSE
  133. MOTERR(1:8)='TABLE'
  134. CALL ERREUR(302)
  135. RETURN
  136. ENDIF
  137. ENDIF
  138.  
  139. ELSE
  140. CALL LIROBJ(MONTYP,IPOINT,1,IRETOU)
  141. CALL ACTOBJ(MONTYP,IPOINT,1)
  142. C Copie du CHPOINT (OPERATEUR)
  143. MCHPOI=IPOINT
  144. SEGINI,MCHPO1=MCHPOI
  145. IPOINT=MCHPO1
  146. ENDIF
  147. IF (IERR.NE.0) RETURN
  148. *
  149. *
  150. * NORMALISATION
  151. * =============
  152. IF(IFLUI.EQ.0) THEN
  153. COEFP =0.D0
  154. COEFPI=0.D0
  155. ELSE IF(IFLUI.EQ.14) THEN
  156. IF(FLUI(3).EQ.0.D0) THEN
  157. CALL ERREUR(284)
  158. RETURN
  159. ENDIF
  160. COEFP =FLUI(1)*FLUI(2)*FLUI(2)/FLUI(3)
  161. COEFPI=FLUI(1)*FLUI(3)
  162. ELSE
  163. CALL ERREUR(284)
  164. * IL MANQUE DES VALEURS
  165. ENDIF
  166. *
  167. *
  168. * NORMALISATION D'UN "CHPOINT"
  169. IF (IPOS .EQ. 1) THEN
  170. IF (INORM.EQ.1) THEN
  171. CALL NORMA3 (IPOINT,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI,PGRAND)
  172. ELSEIF (INORM.EQ.2) THEN
  173. CALL NORMB3(IPOINT,IRIG1,VNOR)
  174. ENDIF
  175. *
  176. * NORMALISATION D'UNE TABLE DE SOUS TYPE "BASE_DE_MODES"
  177. ELSEIF (IPOS .EQ. 2) THEN
  178. IF (INORM.EQ.1) THEN
  179. CALL NORMA5 (ITBAS,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI)
  180. ELSEIF (INORM.EQ.2) THEN
  181. CALL NORMB5(ITBAS,IRIG1,VNOR)
  182. ENDIF
  183. ENDIF
  184. IF (IERR .NE. 0) RETURN
  185.  
  186. CALL ACTOBJ(MONTYP,IPOINT,1)
  187. CALL ECROBJ(MONTYP,IPOINT)
  188. RETURN
  189. *
  190. END
  191.  
  192.  
  193.  
  194.  

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