Télécharger la plaquette Cast3M


fr en

Télécharger cfl1.eso

Retour à la liste

Numérotation des lignes : 

cfl1

  1. C CFL1      SOURCE    OF166741  24/10/07    21:15:06     12016          
  2.       SUBROUTINE CFL1(IPMODL,IPCHA1,IPCHA2,IPCHA3,IPCHA4,ICAS)
  3. *
  4. *-----------------------------------------------------------------------
  5. *
  6. *    calcul du pas de temps de stabilité operateur CFL
  7. *           de la vitesse du son  operateur CSON
  8. *           de la taille de propagation de l'information opérateur TAILLE
  9. *
  10. * en entrée
  11. *  ipmodl objet model
  12. *  ipcha1 champ de caractéristiques
  13. *  ipcha2 champ de vitesse du son composante 'CSON'
  14. *  ipcha3 champ de taille du maillage composante 'L' ( et 'L2H' facultatif)
  15. *  icas décrit le cas de figure
  16. *            entree            ------->                   sortie
  17. *        = 1 ipcha1                                pas de temps cfl
  18. *        = 2 ipcha2 ( et ipcha1 si cara geom )      "       "      "
  19. *        = 3 ipcha3 et ipcha1                       "       "      "
  20. *        = 4 ipcha1                                vitesse du son
  21. *        = 5 ( et ipcha1 si cara geom )            parametre de taille
  22. * en sortie
  23. *        ipcha4 le champ par element demandé
  24. *
  25. *-----------------------------------------------------------------------
  26. *
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8(A-H,O-Z)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC CCHAMP
  33. -INC CCGEOME
  34. -INC CCREEL
  35. -INC SMCHAML
  36. -INC SMINTE
  37. -INC SMELEME
  38. -INC SMRIGID
  39. -INC SMMODEL
  40. -INC SMCOORD
  41. -INC SMLREEL
  42.  
  43.       SEGMENT NOTYPE
  44.         CHARACTER*16 TYPE(NBTYPE)
  45.       ENDSEGMENT
  46.  
  47.       SEGMENT MPTVAL
  48.         INTEGER IPOS(NS)    ,NSOF(NS)
  49.         INTEGER      IVAL(NCOSOU)
  50.         CHARACTER*16 TYVAL(NCOSOU)
  51.       ENDSEGMENT
  52.  
  53.       CHARACTER*(NCONCH) CONM
  54.       CHARACTER*8 CMATE
  55.       PARAMETER ( NINF=3 )
  56.       INTEGER INFOS(NINF)
  57.       CHARACTER*4 CMOT
  58.       LOGICAL DEUCMP,lsupma
  59. *--------------------------------------------------------------------*
  60. *     call tcloc2(' ',-1,it)
  61.       deucmp=.FALSE.
  62.       IF ( ICAS .EQ. 1) THEN
  63.         IPCHE1 =  IPCHA1
  64.         IPCHE2 = 0
  65.       ELSE IF ( ICAS .EQ. 2 ) THEN
  66.         IPCHE1 = IPCHA1
  67.         IPCHE2 = IPCHA2
  68.       ELSE IF ( ICAS .EQ. 3 ) THEN
  69.          IPCHE1 = IPCHA1
  70.          IPCHE2 = IPCHA3
  71.       ELSE IF ( ICAS .EQ. 4 ) THEN
  72.          IPCHE1 = IPCHA1
  73.          IPCHE2 = 0
  74.       ELSE IF ( ICAS .EQ. 5 ) THEN
  75.          IPCHE1 = IPCHA1
  76.          IPCHE2 = 0
  77.       ENDIF
  78.  
  79.       MMODEL = IPMODL
  80.       SEGACT MMODEL
  81.       NSOUS = KMODEL(/1)
  82. *
  83. *  initialisation de l'objet résultat
  84. *
  85.       N1 = NSOUS
  86.       N3 = 6
  87.       L1 = 16
  88.       SEGINI MCHELM
  89.       IF ( ICAS .LE. 3 .OR. ICAS .GE. 1 ) THEN
  90.          TITCHE = 'PAS DE TEMPS CFL'
  91.       ELSE IF ( ICAS .EQ. 4 ) THEN
  92.          TITCHE = 'VITESSE DU SON'
  93.       ELSE IF ( ICAS .EQ. 5 ) THEN
  94.          TITCHE = 'TAILLE CFL'
  95.       ENDIF
  96.  
  97.       IFOCHE = IFOUR
  98. *--------------------------------------------------------------------*
  99. *
  100. *       BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF )
  101. *
  102. *--------------------------------------------------------------------*
  103. *
  104.       DO 500 ISOUS=1,NSOUS
  105.         IMODEL=KMODEL(ISOUS)
  106.         SEGACT IMODEL
  107.         lsupma=.true.
  108. *
  109. *    INITIALISATIONS
  110. *
  111.         IVAM1 = 0
  112.         IVAM2 = 0
  113. *
  114.         MELE  = NEFMOD
  115.         IPMAIL= IMAMOD
  116.         CONM  = CONMOD
  117.         NFOR  = FORMOD(/2)
  118.         NMAT  = MATMOD(/2)
  119. *
  120.         IVAMAT=0
  121.         IVACAR=0
  122.         NMATR=0
  123.         NMATF=0
  124.         NCARA=0
  125.         NCARF=0
  126.         MOCARA=0
  127.         MOMATR=0
  128.         DESCR=0
  129.         IMATRI=0
  130. C
  131. C   COQUE INTEGREE OU PAS ?
  132.         NPINT = imodel.INFMOD(1)
  133. *
  134. *    formulation et matériau ( ca peut servir par la suite )
  135. *
  136.         CMATE = imodel.CMATEE
  137.         MATE  = imodel.IMATEE
  138.         INAT  = imodel.INATUU
  139. *
  140. *    information sur l'élément finis : nécessaire pour les tests
  141. *                                      qui donnent les noms de composantes
  142. *
  143.          INTTYP = 2
  144. *
  145.          MFR   = INFELE(13)
  146.          IELE  = INFELE(14)
  147. *         IPINT = INFELE(11)
  148.          ipint=infmod(4)
  149. *
  150. *
  151. *    Verification de compatibilite de MCHAML du point de vue des
  152. *
  153. *    tableaux INFCHE et creation du tableau INFOS pour COMCHA
  154. *
  155.          CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD)
  156.          IF (IRTD.EQ.0) THEN
  157. *                    incompatibilité entre le modele et le chamelem
  158.            SEGSUP MCHELM
  159.            RETURN
  160.          ENDIF
  161.  
  162. *         call tcloc2('Apres ident',6,it)
  163. *
  164. *--------------------------------------------------------------------*
  165. *       determination des noms de composantes dans les champs
  166. *
  167. * on commence par le champ  2  qui n'existe que dans le cas 2 et 3
  168.         NOTYPE = MOTYR8
  169.         IF (ICAS.EQ.2 .OR.ICAS.EQ.3) THEN
  170.              IF (ICAS.EQ.2) THEN
  171. *             le champ 2 contient la vitesse du son
  172.                NBROBL=1
  173.                NBRFAC=0
  174.                SEGINI NOMID
  175.                LESOBL(1)='CSON'
  176.              ELSE IF(ICAS.EQ.3) THEN
  177. *             le champ 2 contient le parametre de taille
  178.                NBROBL=1
  179.                NBRFAC=1
  180.                SEGINI NOMID
  181.                LESOBL(1)='L'
  182.                LESFAC(1) = 'L2H'
  183.               ENDIF
  184.               MOTYPE = NOTYPE
  185.               MOMATR = NOMID
  186. * ===>
  187. *       write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche2'
  188. *       write(6,7001) (lesobl(i),i=1,nbrobl)
  189. *       write(6,*) 'facultatives'
  190. *       write(6,7001) (lesfac(i),i=1,nbrfac)
  191. * 7001  format(4(A4,2X))
  192. *           Recherche des valeurs des composantes dans les MELVAL d'un
  193. *           CHAMELEM. On distingue les composantes obligatoires des
  194. *            composantes facultatives.
  195.  
  196.           CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM2)
  197.           SEGSUP,NOMID
  198.           IF (NOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  199.           IF (IERR.NE.0) THEN
  200.             SEGSUP MCHELM
  201.             RETURN
  202.           ENDIF
  203.         ENDIF
  204. *        call tcloc2('Apres komcha1',6,it)
  205. *
  206. *     dans les cas 1,2 ou 5 il peut y avoir des caractéristiques geometriques
  207. *     dans les cas  1,3 ou 4  il y a des caractéristiques matériau
  208. *       on commence par traiter les caractéristiques matériau
  209.         IF (ICAS .EQ. 1 .OR. ICAS .EQ. 3 .OR. ICAS .EQ. 4) THEN
  210.             IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  211.                NBROBL=3
  212.                NBRFAC=0
  213.                SEGINI NOMID
  214.                MOMATR=NOMID
  215.                LESOBL(1)='YOUN'
  216.                LESOBL(2)='NU'
  217.                LESOBL(3)='RHO'
  218.                NMATR=NBROBL
  219.                NMATF=NBRFAC
  220.             ELSE
  221.      $      IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  222. *               indisponible! pour les volontaies voir voir rigi1.eso
  223. *              SEGSUP MCHELM
  224.                CALL ERREUR(251)
  225.                RETURN
  226.             ELSE
  227.      $      IF (FORMOD(1).EQ.'POREUX   '.AND.CMATE.EQ.'ISOTROPE') THEN
  228. *               indisponible! pour les volontaies voir rigi1.eso
  229.                CALL ERREUR(251)
  230.                SEGSUP MCHELM
  231.                RETURN
  232. *
  233.             ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  234. *               indisponible! pour les volontaies voir rigi1.eso
  235.                SEGSUP MCHELM
  236.                CALL ERREUR(251)
  237.                RETURN
  238. *
  239.             ELSE
  240.               if(lnomid(6).ne.0) then
  241.                nomid=lnomid(6)
  242.                momatr=nomid
  243.                nmatr=lesobl(/2)
  244.                nmatf=lesfac(/2)
  245.                lsupma=.false.
  246.               else
  247.                lsupma=.true.
  248.                CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  249.               endif
  250.             ENDIF
  251. *
  252. *   type des composantes
  253. *
  254.             IF (CMATE.EQ.'SECTION') THEN
  255.                SEGSUP MCHELM
  256.                SEGDES MMODEL,IMODEL
  257.                CALL ERREUR(251)
  258.                RETURN
  259.             ELSE
  260.               MOTYPE=MOTYR8
  261.             ENDIF
  262. *
  263. *  dans le cas ou il y des caractéristiques géometriques on augmente
  264. *  motype
  265. *
  266.           ELSE IF((ICAS.EQ.2 .OR. ICAS.EQ.5).AND.IPCHE1.NE.0)THEN
  267. *  dans ces cas il faut eventuellement récuperer les caractéristiques
  268. *  geométriques et avoir initialiser  notype avant
  269.                NBROBL=0
  270.                NBRFAC=0
  271.                SEGINI NOMID
  272.                MOMATR=NOMID
  273.                MOTYPE=MOTYR8
  274.                NMATR=NBROBL
  275.                NMATF=NBRFAC
  276.          ENDIF
  277. *
  278.          IF((IPCHE1.NE.0).AND.(ICAS.NE.4).AND.(ICAS.NE.3))THEN
  279. *
  280. *
  281. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  282. *
  283.          IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  284.              NBROBL=NBROBL+1
  285.              IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  286.                NBRFAC=NBRFAC+2
  287.              ELSE
  288.                NBRFAC=NBRFAC+1
  289.              ENDIF
  290.              SEGADJ NOMID
  291.              MOCARA=NOMID
  292.              LESOBL(NBROBL)='EPAI'
  293.              LESFAC(NBRFAC)='EXCE'
  294.              IF(MFR.EQ.3.AND.IFOUR.EQ.-2)  THEN
  295.                  LESFAC(NBRFAC-1)='EXCE'
  296.                  LESFAC(NBRFAC)='DIM3'
  297.              ELSE
  298.                  LESFAC(NBRFAC)='EXCE'
  299.              ENDIF
  300. *
  301. * SECTION POUR LES BARRES ET LES CERCES
  302. *
  303.           ELSE IF (MFR.EQ.27) THEN
  304.              NBROBL=NBROBL+1
  305.              SEGADJ NOMID
  306.              LESOBL(NBROBL)='SECT'
  307. *
  308. * section, excentrements et orientation pour les barres excentrees
  309. *
  310.           ELSE IF (MFR.EQ.49) THEN
  311.              NBROBL=NBROBL+6
  312.              SEGADJ NOMID
  313.              LESOBL(NBROBL-5)='SECT'
  314.              LESOBL(NBROBL-4)='EXCZ'
  315.              LESOBL(NBROBL-3)='EXCY'
  316.              LESOBL(NBROBL-2)='VX  '
  317.              LESOBL(NBROBL-1)='VY  '
  318.              LESOBL(NBROBL)='VZ  '
  319. *
  320. * CARACTERISTIQUES POUR LES POUTRES
  321. *
  322.           ELSE IF (MFR.EQ.7 ) THEN
  323.                NBROBL=NBROBL+4
  324.                NBRFAC=NBRFAC+2
  325.                SEGADJ NOMID
  326.                LESOBL(NBROBL-3)='TORS'
  327.                LESOBL(NBROBL-2)='INRY'
  328.                LESOBL(NBROBL-1)='INRZ'
  329.                LESOBL(NBROBL)='SECT'
  330.                LESFAC(NBRFAC-1)='SECY'
  331.                LESFAC(NBRFAC)='SECZ'
  332. *
  333. * CARACTERISTIQUES POUR LES TUYAUX
  334. *
  335.           ELSE IF (MFR.EQ.13) THEN
  336. *            pour les autres on ne ient pas compte des modification
  337. *            qui assouplissent le tuyau donc omega max diminue
  338.              NBROBL=NBROBL+2
  339.              SEGADJ NOMID
  340.              LESOBL(NBROBL-1)='EPAI'
  341.              LESOBL(NBROBL)='RAYO'
  342.           ELSE IF (MFR.EQ.39) THEN
  343.              NBROBL=NBROBL+2
  344.              NBRFAC=NBRFAC+2
  345.              SEGADJ NOMID
  346.              LESOBL(NBROBL-1)='EPAI'
  347.              LESOBL(NBROBL)='RAYO'
  348.              LESFAC(NBRFAC-1)='RACO'
  349.              LESFAC(NBRFAC)='PRES'
  350.           ENDIF
  351. *
  352.           MOMATR=NOMID
  353.           NMATR=NBROBL
  354.           NMATF=NBRFAC
  355. *
  356. * ===>
  357. *       write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche1'
  358. *       write(6,7001) (lesobl(i),i=1,nbrobl)
  359. *       write(6,*) 'facultatives'
  360. *       write(6,7001) (lesfac(i),i=1,nbrfac)
  361. *
  362.       ENDIF
  363. *
  364.       IF (NMATR.NE.0) THEN
  365.         CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM1)
  366.         IF (MOTYPE.NE.MOTYR8) SEGSUP NOTYPE
  367.         nomid=momatr
  368.         if(lsupma)segsup NOMID
  369.         IF (IERR.NE.0) THEN
  370.             SEGSUP MCHELM
  371.             RETURN
  372.         ENDIF
  373. *           call tcloc2('Apres komcha2',6,it)
  374.       ENDIF
  375. *
  376. *--------------------------------------------------------------------*
  377. *       remplissage de la description du sous champ résultat
  378. *
  379. * dimension
  380. *    = 2 si taille et coque ou poutre
  381. *        mfr obtenu par elquoi nous renseigne
  382. *
  383.        IF ((ICAS.EQ.5).AND.
  384.      &    (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.7.OR.MFR.EQ.9.OR.MFR.EQ.13))
  385.      &    THEN
  386.           DEUCMP = .TRUE.
  387.           N2 = 2
  388.           SEGINI MCHAML
  389.           NOMCHE(1) = 'L'
  390.           NOMCHE(2) = 'L2H'
  391.           TYPCHE(1) = 'REAL*8'
  392.           TYPCHE(2) = 'REAL*8'
  393.        ELSE IF (ICAS.EQ.5) THEN
  394.           N2 = 1
  395.           SEGINI MCHAML
  396.           NOMCHE(1) = 'L'
  397.           TYPCHE(1) = 'REAL*8'
  398.        ELSE IF (ICAS.EQ.4) THEN
  399.           N2 = 1
  400.           SEGINI MCHAML
  401.           NOMCHE(1) = 'CSON'
  402.           TYPCHE(1) = 'REAL*8'
  403.        ELSE IF (ICAS.EQ.1.OR.ICAS.EQ.2.OR.ICAS.EQ.3) THEN
  404.           N2 = 1
  405.           SEGINI MCHAML
  406.           NOMCHE(1) = 'TCFL'
  407.           TYPCHE(1) = 'REAL*8'
  408.        ENDIF
  409.        ICHAML(ISOUS) = MCHAML
  410. *
  411. * le chamelem est defini au centre de gravité
  412. *
  413.         INFCHE(ISOUS,6) = 2
  414. * il faut brancher sur le segment d'intégration
  415.         INFCHE(ISOUS,4)=IPINT
  416. * nom du constituant
  417.         CONCHE(ISOUS) = CONMOD
  418. * maillage
  419.         IMACHE(ISOUS) = IPMAIL
  420. * a priori info ne set plus
  421. *        SEGSUP INFO
  422. *
  423. *--------------------------------------------------------------------*
  424. *       appel au sous routine spécifiques
  425. *
  426. *     NUMERO DES ETIQUETTES      :
  427. *     Les elements sont groupes comme suit :
  428. *      - massif,liquide 'surface libre' poreux ----------------------> 4
  429. *      - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> 12
  430. *      - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> 27
  431. *      - joi4,joi2,poutre de timoschenko,joi3                          29
  432. *
  433. *           1            5              0              5             0
  434.       GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,12,99, 4, 4, 4, 4,99,99,99,
  435.      2      99,99, 4, 4, 4, 4,27,27,29,99,99,99,99,99,99,99,99,99,99,99,
  436.      4      27,29,99,27,99,29,12,99,27,99,99,99,99,99,12,27,99,99,99,99,
  437.      6      99,99,99,99,99,99,99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,
  438.      8      99,99,99,29,99,99,99,99,99,99,99,99,27,12,99,99,99,99,99,99,
  439.      1      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  440.      2      99,99,99,99,99,99,99),MELE
  441.  99   CONTINUE
  442.       MOTERR(1:4)=NOMTP(MELE)
  443.       MOTERR(9:12)='CFL1'
  444.       CALL ERREUR(86)
  445.       SEGSUP MCHELM,MCHAML
  446.       RETURN
  447. C
  448. C_______________________________________________________________________
  449. C
  450. C     massif
  451. C_______________________________________________________________________
  452. C
  453.    4  CONTINUE
  454. *      write(6,*) 'Appel a cfl2'
  455.       CALL CFL2(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  456.       IF (IERR.NE.0) RETURN
  457.       GOTO 400
  458.  
  459. C_______________________________________________________________________
  460. C
  461. C     ELTS DE RACCORD LIQUIDE SOLIDE  RAC2 RACO LIA3 LIA4 LICO LIC4
  462. C          PAS DE RIGIDITE
  463. C_______________________________________________________________________
  464. C
  465.   12  CONTINUE
  466. *      write(6,*) 'Appel a cfl3'
  467.       CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  468.       IF (IERR.NE.0) RETURN
  469.       GOTO 400
  470. C_______________________________________________________________________
  471. C
  472. C     coq3,dkt,coq4,coq8,coq2,dst
  473. C_______________________________________________________________________
  474. C
  475.   27  CONTINUE
  476. *      write(6,*) 'Appel a cfl4'
  477.       CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  478.       IF (IERR.NE.0) RETURN
  479.       GOTO 400
  480. C_______________________________________________________________________
  481. C
  482. C poutre,barre,homogeneise
  483. C poutre de Timoschenko
  484. C_______________________________________________________________________
  485. C
  486.   29  CONTINUE
  487. *      write(6,*) 'Appel a cfl5'
  488. *  ivam1 et 2 sont actifs , ipmail descativé
  489.       CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  490. *  en sortie melv1 et melv2 sont inactifs
  491.       IF (IERR.NE.0) RETURN
  492.       GOTO 400
  493. *
  494.  400  CONTINUE
  495. *  on raccroche le résultat
  496.       IELVAL(1) = MELV1
  497.       IF (DEUCMP)  IELVAL(2) = MELV2
  498.       SEGDES MCHAML
  499.       SEGDES IMODEL
  500.       IF (IVAM1.NE.0) THEN
  501.          MPTVAL = IVAM1
  502.          SEGSUP MPTVAL
  503.       ENDIF
  504.       IF (IVAM2.NE.0) THEN
  505.          MPTVAL = IVAM2
  506.          SEGSUP MPTVAL
  507.       ENDIF
  508. * fin boucle sur les sous zone des champs
  509.  500  CONTINUE
  510. *
  511.        IPCHA4 = MCHELM
  512.        SEGDES MCHELM,MMODEL
  513.        RETURN
  514.        END
  515.  
  516.  
  517.  

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