Télécharger la plaquette Cast3M


fr en

Télécharger zpmode.eso

Retour à la liste

Numérotation des lignes : 

zpmode

  1. C ZPMODE    SOURCE    OF166741  24/05/06    21:15:28     11082          
  2.  
  3. *---------------------------------------
  4. *      ECRITURE D'UN OBJET MODELE
  5. *---------------------------------------
  6.  
  7.       SUBROUTINE ZPMODE (MMODEL)
  8.  
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC CCHAMP
  15. C==DEB= FORMULATION HHO == Include specifique ==========================
  16. -INC CCHHOPA
  17. C==FIN= FORMULATION HHO ================================================
  18.  
  19. -INC SMMODEL
  20. -INC SMLMOTS
  21.  
  22.        EXTERNAL LONG
  23.  
  24.        character*16 mderiv(6)
  25.        character*6 cha6Fa,cha6Fb
  26.        character*8 nomtyp(19),MOT8
  27.        character*(LOCHAI) motlib,fmt1
  28.        character*12 MNLOCA(3)
  29.        logical b_z
  30.  
  31.        DATA MDERIV/'Lineaire        ','Quadratique     ',
  32.      $  'TRUSDELL        ','JAUMANN         ','Utilisateur     ',
  33.      $  'FEFP            '/
  34.        data nomtyp/
  35.      1              'INCOPRIM', 'INCODUAL', 'GRADIENT', 'CONTRAIN',
  36.      1              'DEFORMAT', 'MATERIAU', 'CARACTER', 'TEMPERAT',
  37.      1              'PRINCIPA', 'VARINTER', 'GRAFLEXI', 'PHASES  ',
  38.      1              'DEFINELA', 'PARAMEXT', '        ', 'SCAL    ',
  39.      1              'TEMP    ', 'MAHO    ', 'MAHT    '/
  40.       DATA MNLOCA /'Moyenne     ','Stress based','HELMHOLTZ   '/
  41.       SEGACT,MMODEL
  42.       N1=KMODEL(/1)
  43.  
  44.       WRITE(IOIMP,190)
  45.       WRITE(IOIMP,200)
  46.       WRITE(IOIMP,201)
  47.       WRITE(IOIMP,210) N1,MMODEL
  48.       WRITE(IOIMP,201)
  49.       WRITE(IOIMP,200)
  50.  
  51.       DO N=1,N1
  52.         IMODEL=KMODEL(N)
  53.         SEGACT,IMODEL
  54.         WRITE(IOIMP,2) N,IMODEL
  55.         WRITE(IOIMP,3) IMAMOD,NOMTP(NEFMOD)
  56.         IF (CONMOD.NE.'                ') WRITE(IOIMP,4)CONMOD
  57.         IF (conmod(17:24).NE.'        ') WRITE(IOIMP,8) conmod(17:24)
  58.  
  59.         nfor   = formod(/2)
  60.         NMAT   = MATMOD(/2)
  61.         nobmod = tymode(/2)
  62.         mn3    = infmod(/1)
  63.         if(mn3.ge.13) then
  64.           inloc = -1*infmod(13)
  65.           lulvia= infmod(14)
  66.         else
  67.           inloc = 0
  68.           lulvia= 0
  69.         endif
  70.  
  71.         WRITE(IOIMP,5) (FORMOD(i),i=1,NFOR)
  72.         IIPDPG = imodel.IPDPGE
  73.         IF (IIPDPG.NE.0) WRITE(IOIMP,7) IPTPOI(IIPDPG),IIPDPG
  74.         IF (NMAT.NE.0) WRITE(IOIMP,6) (MATMOD(i),i=1,NMAT)
  75.         mecfor=0
  76.         mdifor = 0
  77.         do i=1,nfor
  78.           if(formod(i).eq.'MECANIQUE'.or.formod(i).eq.'POREUX'.or.
  79.      &       formod(i).eq.'NAVIER_STOKES') mecfor=1
  80.           if(formod(i).eq.'DIFFUSION') mdifor=1
  81.         enddo
  82.         if(mecfor.eq.1) then
  83. c            write(ioimp,27) mderiv(ideriv)
  84. cbp,2020-12-10 : abandon de IDERIV (MMODEL)
  85.            if(inloc.ne.0) then
  86.              write(ioimp,28) mnloca(inloc)
  87.              if(lulvia.ne.0) then
  88.                mlmots=lulvia
  89.                segact,mlmots
  90.                write(ioimp,29) (mots(iu),iu=1,mots(/2))
  91.              endif
  92.            endif
  93.  
  94.         endif
  95.         do io=1,19
  96.           nomid = lnomid(io)
  97.           if(nomid.gt.0) then
  98. C         write(6,*) 'nomid',io,nomid
  99.              segact nomid
  100.              if(lesobl(/2).ne.0) then
  101.                write(ioimp,20) nomtyp(io),nomid
  102.           if(lesobl(/2).NE.0)write(ioimp,21)(lesobl(iu),iu=1,lesobl(/2))
  103.           if(lesfac(/2).NE.0)write(ioimp,21)(lesfac(iu),iu=1,lesfac(/2))
  104.              endif
  105.           endif
  106.         enddo
  107.  
  108.          write(ioimp,23)(infele(iu),iu=1,6),infele(13),infele(14)
  109.  
  110. c*        if (inatuu.ne.0 .or. imatee.ne.0) then
  111.         if (imatee.ne.0) then
  112.           write(ioimp,22) cmatee, imatee, inatuu
  113.           if (inatuu.eq.-1) then
  114.             write(ioimp,221) matmod(nmat)
  115.           endif
  116.           if (inatuu.eq.-2) then
  117.             iviex = 0
  118.             CALL PLACE(tymode,nobmod,iviex,'IVIEX   ')
  119.             write(ioimp,222) ivamod(iviex)
  120.           endif
  121.         endif
  122.  
  123. *       Impression du contenu de TYMODE et IVAMOD
  124.         cha6Fa(1:4)='(I )'
  125.         cha6Fb(1:2)='(A'
  126.         DO i=1,nobmod          
  127.           IF (i.EQ.1)WRITE(IOIMP,12)
  128.           MOT8=TYMODE(i)
  129.           IVA =IVAMOD(I)
  130.           IF    (MOT8 .EQ. 'MOT     ')THEN
  131.             CALL QUEVAL(IVA,'MOT     ',ier,lgmot,r_z, motlib,b_z,i_z)
  132.             IF(IER .NE. 0)CALL ERREUR(5)
  133.  
  134. C           Determination du FORMAT automatique
  135.             IFORMA = INT(LOG10(REAL(lgmot))) + 1
  136.             IF    (IFORMA.GE.1 .AND. IFORMA.LT.9 )THEN
  137.               WRITE(cha6Fa(3:3), '(I1)') IFORMA
  138.             ELSE
  139.               CALL ERREUR(5)
  140.             ENDIF
  141.  
  142.             WRITE(cha6Fb(3:3+IFORMA-1),FMT=cha6Fa) lgmot
  143.             cha6Fb(3+IFORMA:3+IFORMA)=')'
  144.  
  145.             fmt1='(11X,A8,2X,'//cha6Fb(2:3+IFORMA-1)//')'
  146.             WRITE(IOIMP,FMT=fmt1) MOT8,motlib(1:MIN(lgmot,72))
  147.           ELSE
  148.             WRITE(IOIMP,13) MOT8,IVA
  149.           ENDIF
  150.         ENDDO
  151.  
  152. *       if (infmod(/1).gt.2)  write(IOIMP,*)
  153. *     $ 'segment d integtration ',(infmod(iu),iu=3,infmod(/1))
  154.  
  155.         IF (nobmod.NE.0) THEN
  156.           if ((mecfor.eq.1 .and. inatuu.lt.0) .or. mdifor.eq.1) then
  157.  
  158.             noblib = 0
  159.             if (mdifor.eq.1) then
  160.               CALL PLACE(tymode,nobmod,noblib,'LDIEXT  ')
  161.             else
  162.               CALL PLACE(tymode,nobmod,noblib,'LMEEXT  ')
  163.             endif
  164.             if (noblib.gt.0) then
  165.               iva=ivamod(noblib+1)
  166.               call queval(iva,'MOT     ',ier,lgmot,r_z, motlib,b_z,i_z)
  167.               lglib = INDEX(motlib,'=')-1
  168.               m_libe = LONG(motlib(1:lglib))
  169.               if (m_libe.gt.72) then
  170.                 write(ioimp,223) motlib(1:72)//'...'
  171.               else
  172.                 write(ioimp,223) motlib(1:m_libe)
  173.               endif
  174.               m_mode = LONG(motlib(lglib+2:lgmot))
  175.               write(ioimp,224) motlib(lglib+2:lglib+m_mode+1)
  176.             endif
  177.           else
  178. C            WRITE(IOIMP,12) (TYMODE(i),IVAMOD(i),i=1,nobmod)
  179.           endif
  180.         ENDIF
  181.  
  182. C=DEB== FORMULATION HHO === Affichages specifiques =====================
  183.         mfr = NUMMFR(nefmod)
  184.         IF (mfr .EQ. HHO_MFR_ELEMENT) THEN
  185. c-dbg      write(ioimp,*)
  186. c-dbg      write(ioimp,*) 'HHO : IDIM, IFOUR =', IDIM,IFOUR
  187. c-dbg      write(ioimp,*) '      =>'//charHHO(1:LONG(charHHO))//'<='
  188. c-dbg      write(ioimp,*) '      FACE ORDER / DOF DIR = ',n_o_face,n_d_face
  189. c-dbg      write(ioimp,*) '      CELL ORDER / DOF DIR = ',n_o_cell,n_d_cell
  190. c-dbg      write(ioimp,*) '      HYPOTHESIS = ', hyp_z(2:3)
  191. c-dbg      write(ioimp,*)
  192.         ENDIF
  193. C=FIN== FORMULATION HHO ================================================
  194.  
  195.       ENDDO
  196.  
  197.       WRITE(IOIMP,190)
  198.  
  199.  190  FORMAT(//)
  200.  200  FORMAT(1X,'+',77('-'),'+')
  201.  201  FORMAT(1X,'|',T80,'|')
  202.  210  FORMAT(' |          OBJET  MMODEL  CONTENANT ',I6,
  203.      .       ' ZONE(S) ELEMENTAIRE(S)',I10,T80,'|')
  204.  2    FORMAT(//10X,' ZONE ELEMENTAIRE NUMERO ',I6,' : IMO',I10,
  205.      .        /10X,' -----------------------------------------------')
  206.  3    FORMAT(/1X,'  POINTEUR SUR L''OBJET MAILLAGE : ',I10,/,
  207.      .        1X,'  TYPE D''ELEMENT FINI  :  ',3X,A4)
  208.  4    FORMAT(1X,'  NOM DU CONSTITUANT   :  ',3X,A24)
  209.  5    FORMAT(1X,'  FORMULATION          :  ',5(3X,A16))
  210.  6    FORMAT(1X,'  MODELE DE MATERIAU   :  ',5(3X,A16))
  211.  7    FORMAT(1X,'  POINT SUPPORT DPGE   :  ',I10,/,
  212.      $       1X,'  stocke dans le maillage de pointeur', I10)
  213.  8    FORMAT(1X,'  NOM DE LA PHASE      :  ',3X,A8)
  214.  9    FORMAT(1X,'  VARIABLES INTERNES   :    ',12(1X,A4))
  215.  10   FORMAT(1X,'  PARAMETRES MATERIAUX :    ',12(1X,A4))
  216.  12   FORMAT(/'   Liste des objets associes : type - valeur')
  217.  13   FORMAT(11X,A8,2X,I16)
  218.  14   FORMAT(11X,A8,2X,A72)
  219.  20   FORMAT(1x,'  Liste des noms de composantes de ',a8, 
  220.      &          '    -    Pointeur nomid:',I10)
  221.  21   format (10x, 10(A8,1X))
  222.  22   format(1x,'  MATERIAU cmate imate inatu   : ',a8,2I5)
  223.  221  format(9x,'  NOM LOI UTILISATEUR : "',a16,'"')
  224.  222  format(9x,'  LOI VISCO_EXTERNE   : ',I5)
  225.  223  format(9x,'  "LIBRAIRIE" EXTERNE : "',A,'"')
  226.  224  format(9x,'  "FONCTION" EXTERNE  : "',A,'"')
  227.  
  228.  23   format(/1X,'  numero de l element fini (nefmod):' , i5,/,
  229.      $       1X,'  points integration epaisseur     :' , i5,/,
  230.      $       1X,'  points de gauss pour masse       :' , i5,/,
  231.      $       1X,'  points support de contraintes    :' , i5,/,
  232.      $       1X,'  nombre de caracteristiques       :' , i5,/,
  233.      $       1X,'  points de gauss pour rigidite    :' , i5,/,
  234.      $       1X,'  numero de la formulation E.F(mfr):' , i5,/,
  235.      $       1X,'  numero de  l element geometrique :' , i5)
  236.  27   format(1x,'  Hypothese de deformations : ',a16,/)
  237.  28   format(1x,'  Formulation non locale    : ',a12)
  238.  29   format(1x,'  Variables moyennees       :',12(1X,A4))
  239.  
  240. c      RETURN
  241.       END
  242.  
  243.  
  244.  

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