Télécharger nnor.eso

Retour à la liste

Numérotation des lignes :

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

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