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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMTABLE
  37. -INC SMCHPOI
  38. *
  39. c REAL*8 VNOR,PGRAND,FLUI(3),COEFP,COEFPI,RET
  40. REAL*8 FLUI(3)
  41. *
  42. PARAMETER (NBTYPE = 2)
  43. PARAMETER (LCLEF = 5)
  44. PARAMETER (LNORM = 2)
  45. *
  46. CHARACTER*8 LISTYP(NBTYPE),MONTYP,CHA8
  47. CHARACTER*4 MOCLEF(LCLEF),MONORM(LNORM),MOTCLE
  48. *
  49. DATA LISTYP/'CHPOINT ','TABLE '/
  50. DATA MOCLEF/'RORF','CREF','LCAR','AVEC','SANS'/
  51. DATA MONORM/'INFI','EUCL'/
  52.  
  53. IFLUI=0
  54. INORM=1
  55. MOTCLE = ' '
  56. *
  57. * LECTURE DU TYPE DE NORME
  58. * ========================
  59. ICODE = 0
  60. CALL LIRMOT(MONORM,LNORM,IVAL,ICODE)
  61. IF (IVAL .GT. 1) INORM=IVAL
  62. *
  63. *
  64. IF (INORM.EQ.1) THEN
  65. *
  66. * LECTURE DES MOTS-CLES
  67. * =====================
  68. 1 ICODE = 0
  69. CALL LIRMOT(MOCLEF,LCLEF,IVAL,ICODE)
  70. IF(IVAL.EQ.1 .OR. IVAL.EQ.2 .OR. IVAL.EQ.3) THEN
  71. CALL LIRREE(RET,1,IRETOU)
  72. IF(IERR.NE.0) RETURN
  73. FLUI(IVAL)=RET
  74. IFLUI=IFLUI + 2**IVAL
  75. ELSEIF (IVAL.EQ.4 .OR. IVAL.EQ.5) THEN
  76. MOTCLE=MOCLEF(IVAL)
  77. ELSE
  78. GOTO 2
  79. ENDIF
  80. GOTO 1
  81. *
  82. * LECTURE DE LA LISTE DES COMPOSANTES
  83. * ===================================
  84. 2 ICODE = 0
  85. CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  86. IF (IRETOU .EQ. 0) THEN
  87. IPLMOT = 0
  88. ELSE IF (MOTCLE .EQ. ' ') THEN
  89. * PAR DEFAUT, LES COMPOSANTES NOMMEES SONT LES COMPOSANTES
  90. * PRISES EN COMPTE (ET NON PAS LES COMPOSANTES EXCLUES)
  91. MOTCLE = 'AVEC'
  92. END IF
  93.  
  94. ELSEIF (INORM.EQ.2) THEN
  95. *
  96. * LECTURE DE LA MATRICE
  97. * =====================
  98. ICODE=0
  99. CALL LIROBJ('RIGIDITE',IRIG1,ICODE,IZRIG)
  100. *
  101. ENDIF
  102. *
  103. *
  104. * LECTURE DE L'OBJET
  105. * ==================
  106. CALL QUETYP(MONTYP,0,IRETOU)
  107. IF (IRETOU.EQ.0) THEN
  108. CALL ERREUR(533)
  109. RETURN
  110. ENDIF
  111.  
  112. CALL PLACE(LISTYP,NBTYPE,IPOS,MONTYP)
  113. IF(IPOS .EQ. 0)THEN
  114. MOTERR(1:8)=MONTYP
  115. CALL ERREUR(39)
  116. RETURN
  117. ENDIF
  118.  
  119. IF (IPOS.EQ.2) THEN
  120. CALL LIRTAB('BASE_DE_MODES',ITBAS,0,IRETOU)
  121. IF (IRETOU .NE. 0) THEN
  122. IPOINT = ITBAS
  123.  
  124. ELSE
  125. CALL LIRTAB('BASE_MODALE',IPOINT,0,IRETOU)
  126. IF (IRETOU.NE.0) THEN
  127. CHA8=' '
  128. CALL ACMO(IPOINT,'MODES',CHA8,ITBAS)
  129. IF (CHA8.NE.'TABLE' .OR. ITBAS .LE. 0) THEN
  130. CALL ERREUR(647)
  131. RETURN
  132. ENDIF
  133.  
  134. ELSE
  135. MOTERR(1:8)='TABLE'
  136. CALL ERREUR(302)
  137. RETURN
  138. ENDIF
  139. ENDIF
  140.  
  141. ELSE
  142. CALL LIROBJ(MONTYP,IPOINT,1,IRETOU)
  143. CALL ACTOBJ(MONTYP,IPOINT,1)
  144. C Copie du CHPOINT (OPERATEUR)
  145. MCHPOI=IPOINT
  146. SEGINI,MCHPO1=MCHPOI
  147. IPOINT=MCHPO1
  148. ENDIF
  149. IF (IERR.NE.0) RETURN
  150. *
  151. *
  152. * NORMALISATION
  153. * =============
  154. IF(IFLUI.EQ.0) THEN
  155. COEFP =0.D0
  156. COEFPI=0.D0
  157. ELSE IF(IFLUI.EQ.14) THEN
  158. IF(FLUI(3).EQ.0.D0) THEN
  159. CALL ERREUR(284)
  160. RETURN
  161. ENDIF
  162. COEFP =FLUI(1)*FLUI(2)*FLUI(2)/FLUI(3)
  163. COEFPI=FLUI(1)*FLUI(3)
  164. ELSE
  165. CALL ERREUR(284)
  166. * IL MANQUE DES VALEURS
  167. ENDIF
  168. *
  169. *
  170. * NORMALISATION D'UN "CHPOINT"
  171. IF (IPOS .EQ. 1) THEN
  172. IF (INORM.EQ.1) THEN
  173. CALL NORMA3 (IPOINT,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI,PGRAND)
  174. ELSEIF (INORM.EQ.2) THEN
  175. CALL NORMB3(IPOINT,IRIG1,VNOR)
  176. ENDIF
  177. *
  178. * NORMALISATION D'UNE TABLE DE SOUS TYPE "BASE_DE_MODES"
  179. ELSEIF (IPOS .EQ. 2) THEN
  180. IF (INORM.EQ.1) THEN
  181. CALL NORMA5 (ITBAS,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI)
  182. ELSEIF (INORM.EQ.2) THEN
  183. CALL NORMB5(ITBAS,IRIG1,VNOR)
  184. ENDIF
  185. ENDIF
  186. IF (IERR .NE. 0) RETURN
  187.  
  188. CALL ACTOBJ(MONTYP,IPOINT,1)
  189. CALL ECROBJ(MONTYP,IPOINT)
  190. RETURN
  191. *
  192. END
  193.  
  194.  
  195.  
  196.  

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