Télécharger nnor.eso

Retour à la liste

Numérotation des lignes :

  1. C NNOR SOURCE CB215821 18/04/04 21:15:05 9798
  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. C Copie du CHPOINT (OPERATEUR)
  142. MCHPOI=IPOINT
  143. SEGINI,MCHPO1=MCHPOI
  144. IPOINT=MCHPO1
  145. ENDIF
  146. IF (IERR.NE.0) RETURN
  147. *
  148. *
  149. * NORMALISATION
  150. * =============
  151. IF(IFLUI.EQ.0) THEN
  152. COEFP =0.D0
  153. COEFPI=0.D0
  154. ELSE IF(IFLUI.EQ.14) THEN
  155. IF(FLUI(3).EQ.0.D0) THEN
  156. CALL ERREUR(284)
  157. RETURN
  158. ENDIF
  159. COEFP =FLUI(1)*FLUI(2)*FLUI(2)/FLUI(3)
  160. COEFPI=FLUI(1)*FLUI(3)
  161. ELSE
  162. CALL ERREUR(284)
  163. * IL MANQUE DES VALEURS
  164. ENDIF
  165. *
  166. *
  167. * NORMALISATION D'UN "CHPOINT"
  168. IF (IPOS .EQ. 1) THEN
  169. IF (INORM.EQ.1) THEN
  170. CALL NORMA3 (IPOINT,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI,PGRAND)
  171. ELSEIF (INORM.EQ.2) THEN
  172. CALL NORMB3(IPOINT,IRIG1,VNOR)
  173. ENDIF
  174. *
  175. * NORMALISATION D'UNE TABLE DE SOUS TYPE "BASE_DE_MODES"
  176. ELSEIF (IPOS .EQ. 2) THEN
  177. IF (INORM.EQ.1) THEN
  178. CALL NORMA5 (ITBAS,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI)
  179. ELSEIF (INORM.EQ.2) THEN
  180. CALL NORMB5(ITBAS,IRIG1,VNOR)
  181. ENDIF
  182. ENDIF
  183. IF (IERR .NE. 0) RETURN
  184.  
  185. CALL ECROBJ(MONTYP,IPOINT)
  186. RETURN
  187. *
  188. END
  189.  
  190.  
  191.  

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