hm_read_solid.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    hm_read_solid      ../starter/source/elements/reader/hm_read_solid.F
!||--- called by ------------------------------------------------------
!||    lectur             ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg             ../starter/source/output/message/message.F
!||    anodset            ../starter/source/output/analyse/analyse_node.c
!||    checkvolume_4n     ../starter/source/elements/solid/solide/checksvolume.f
!||    checkvolume_6n     ../starter/source/elements/solid/solide/checksvolume.F
!||    checkvolume_8n     ../starter/source/elements/solid/solide/checksvolume.F
!||    udouble            ../starter/source/system/sysfus.F
!||    usr2sys            ../starter/source/system/sysfus.f
!||--- uses       -----------------------------------------------------
!||    message_mod        ../starter/share/message_module/message_mod.F
!||    submodel_mod       ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_solid(IXS   ,PM     ,ITAB ,ITABM1,
     .                  IPART,IPARTS,ISOLNOD,IXS10 ,IXS20,IXS16 ,
     .                  IGEO ,LSUBMODEL,IS_DYNA,X  )
C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   READ /BRICK /TETRA4 /PENTA6 /TETRA10  /BRICK20 ELEMENTS USING HM_READER
C-----------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C
C     NAME            DESCRIPTION                         
C
C     IXS             SOLID ELEM ARRAY : CONNECTIVITY, ID, PID, MID
C     PM              MATERIAL ARRAY (REAL) 
C     ITAB            USER ID OF NODES         
C     ITABM1          REVERSE TAB ITAB
C     IPART           PART ARRAY      
C     IPARTS          INTERNAL PART ID OF A GIVEN SOLID ELEMENT 
C     ISOLNOD         NUMBER OF NODES OF SOLID ELEMENT 
C     IXS10           TETRA10 CONNECTIVITY NODES 5->10
C     IXS20           BRICK20 CONNECTIVITY NODES 9->20
C     IXS16           BRICK16 CONNECTIVITY NODES 9->16
C     IGEO            PROP ARRAY (INTEGER)
C     LSUBMODEL       SUBMODEL STRUCTURE     
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE submodel_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   A n a l y s e   M o d u l e
C-----------------------------------------------
#include      "analyse_name.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "scr17_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C INPUT ARGUMENTS
      INTEGER,INTENT(IN)::ITAB(*)
      INTEGER,INTENT(IN)::ITABM1(*)
      INTEGER,INTENT(IN)::IPART(LIPART1,*)
      INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
      INTEGER,INTENT(IN)::IS_DYNA
      my_real,INTENT(IN)::pm(npropm,*)
      my_real, DIMENSION(3,NUMNOD), INTENT(IN):: x
      TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
C OUTPUT ARGUMENTS
      INTEGER,INTENT(OUT)::ISOLNOD(*)
      INTEGER,INTENT(OUT)::IXS(NIXS,*)
      INTEGER,INTENT(OUT)::IXS10(6,*)
      INTEGER,INTENT(OUT)::IXS16(8,*)
      INTEGER,INTENT(OUT)::IXS20(12,*)
      INTEGER,INTENT(OUT)::IPARTS(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, MT, MLAW, JTUR, I1, I2, INEW,I10,I20,I16
      INTEGER IC,IC1,IC2,IC3,IC4,IPID,ID,IDS,N,JC,NSPHDIR,STAT
      INTEGER FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,NUMELS_READ,
     .        ioutn, ierror, index_part,ixs10_sav(6),ic5,ic6,
     .        ic7,ic8
      my_real bid
      CHARACTER MESS*40, MESS2*40
      INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SOL
C-----------------------------------------------
C   E x t e r n a l  F u n c t i o n s
C-----------------------------------------------
      my_real
     .   checkvolume_4n,checkvolume_6n,checkvolume_8n
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS
C
      DATA mess/'3D SOLID ELEMENTS DEFINITION            '/
      DATA mess2/'3D SOLID ELEMENTS SELECTION FOR TH PLOT '/
C=======================================================================
C--------------------------------------------------
C      ALLOCS & INITS
C--------------------------------------------------
      ALLOCATE (sub_sol(numels),stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
     .                             msgtype=msgerror,
     .                             c1='SUB_SOL') 
      sub_sol(1:numels) = 0
      index_part = 1
C--------------------------------------------------
C      READING BRICK INPUTS IN HM STRUCTURE
C-------------------------------------------------- 
      CALL cpp_brick_read(ixs,nixs,iparts,sub_sol)
C--------------------------------------------------
C      FILL OTHER STRUCTURES + CHECKS
C--------------------------------------------------
      i = 0
      DO n=1,numbrick
        i = i + 1
        IF(ixs(6,i)+ixs(7,i)+ixs(8,i)+ixs(9,i)==0)THEN
          DO j=2,5  
            ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
            CALL anodset(ixs(j,i), check_volu)
          ENDDO  
          ixs(9,i)=ixs(5,i)
          ixs(8,i)=ixs(4,i)
          ixs(7,i)=ixs(4,i)
          ixs(6,i)=ixs(5,i)
          ixs(5,i)=ixs(3,i)
          ixs(4,i)=ixs(3,i)
          ixs(3,i)=ixs(2,i)
          isolnod(i)=4
          IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
            ic2=ixs(6,i)
            ic4=ixs(4,i)
            ixs(4,i)=ic2
            ixs(6,i)=ic4
            ixs(5,i)=ic2
            ixs(9,i)=ic4
          END IF
        ELSEIF(ixs(8,i)+ixs(9,i)==0)THEN
          DO j=2,7  
            ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
            CALL anodset(ixs(j,i), check_volu)
          ENDDO  
          ixs(9,i)=ixs(5,i)
          ixs(8,i)=ixs(7,i)
          ixs(7,i)=ixs(6,i)
          ixs(6,i)=ixs(5,i)
          ixs(5,i)=ixs(2,i)
          isolnod(i)=6
          IF (checkvolume_6n(x ,ixs(1,i)) < zero) THEN
C           renumber connectivity
            ic1 = ixs(6,i)
            ic2 = ixs(7,i)
            ic3 = ixs(8,i)
            ic4 = ixs(2,i)
            ic5 = ixs(3,i)
            ic6 = ixs(4,i)
            ixs(2,i) = ic1
            ixs(3,i) = ic2
            ixs(4,i) = ic3
            ixs(6,i) = ic4
            ixs(7,i) = ic5
            ixs(8,i) = ic6
          ENDIF 
        ELSE
          DO j=2,9  
            ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
            CALL anodset(ixs(j,i), check_volu)
          ENDDO  
          isolnod(i)=8
          IF (checkvolume_8n(x ,ixs(1,i)) < zero) THEN
C         renumber connectivity
            ic1 = ixs(6,i)
            ic2 = ixs(7,i)
            ic3 = ixs(8,i)
            ic4 = ixs(9,i)
            ic5 = ixs(2,i)
            ic6 = ixs(3,i)
            ic7 = ixs(4,i)
            ic8 = ixs(5,i)
            ixs(2,i) = ic1
            ixs(3,i) = ic2
            ixs(4,i) = ic3
            ixs(5,i) = ic4
            ixs(6,i) = ic5
            ixs(7,i) = ic6
            ixs(8,i) = ic7
            ixs(9,i) = ic8
          ENDIF
        ENDIF
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
        IF( ipart(4,index_part) /= iparts(i) )THEN  
          DO j=1,npart 
            IF(ipart(4,j)== iparts(i) ) index_part = j
          ENDDO  
        ENDIF
        IF( ipart(4,index_part) /= iparts(i) ) THEN
          CALL ancmsg(msgid=402,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                c1="BRICK",
     .                i1=iparts(i),
     .                i2=iparts(i),
     .                prmod=msg_cumu)
        ENDIF 
        iparts(i) = index_part       
        mt=ipart(1,index_part)                         
        ipid=ipart(2,index_part)               
        ixs(1,i)=mt                                
        ixs(10,i)=ipid 
      ENDDO            
C--------------------------------------------------
C      READING TETRA4 INPUTS IN HM STRUCTURE
C--------------------------------------------------
      CALL cpp_tetra4_read(ixs,nixs,numbrick,iparts,sub_sol)
C--------------------------------------------------
C      FILL OTHER STRUCTURES + CHECKS
C--------------------------------------------------
      index_part = 1
      DO n=1,numtetra4
        i = i + 1
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
        IF( ipart(4,index_part) /= iparts(i) )THEN  
          DO j=1,npart                            
            IF(ipart(4,j)== iparts(i) ) index_part = j  
          ENDDO  
        ENDIF 
        IF( ipart(4,index_part) /= iparts(i) ) THEN
          CALL ancmsg(msgid=402,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                c1="TETRA4",
     .                i1=iparts(i),
     .                i2=iparts(i),
     .                prmod=msg_cumu)
        ENDIF
        iparts(i) = index_part 
C--------------------------------------------------      
        mt=ipart(1,index_part)                         
        ipid=ipart(2,index_part)                        
        ixs(1,i)=mt                                
        ixs(10,i)=ipid 
        DO j=2,5
          ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
          CALL anodset(ixs(j,i), check_volu)
        ENDDO
        ixs(9,i)=ixs(5,i)
        ixs(8,i)=ixs(4,i)
        ixs(7,i)=ixs(4,i)
        ixs(6,i)=ixs(5,i)
        ixs(5,i)=ixs(3,i)
        ixs(4,i)=ixs(3,i)
        ixs(3,i)=ixs(2,i)
        isolnod(i)=4
        IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
          ic2=ixs(6,i)
          ic4=ixs(4,i)
          ixs(4,i)=ic2
          ixs(6,i)=ic4
          ixs(5,i)=ic2
          ixs(9,i)=ic4
        END IF
      ENDDO
C--------------------------------------------------
C      READING PENTA6 INPUTS IN HM STRUCTURE
C-------------------------------------------------- 
      IF (is_dyna ==0) CALL cpp_penta6_read(ixs,nixs,numbrick+numtetra4,iparts,sub_sol)
C--------------------------------------------------
C      FILL OTHER STRUCTURES + CHECKS
C--------------------------------------------------
      index_part = 1
      DO n=1,numpenta6
        i = i + 1
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
        IF( ipart(4,index_part) /= iparts(i) )THEN  
          DO j=1,npart                            
            IF(ipart(4,j)== iparts(i) ) index_part = j             
          ENDDO  
        ENDIF 
        IF( ipart(4,index_part) /= iparts(i) ) THEN
          CALL ancmsg(msgid=402,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                c1="PENTA6",
     .                i1=iparts(i),
     .                i2=iparts(i),
     .                prmod=msg_cumu)
        ENDIF
        iparts(i) = index_part 
C--------------------------------------------------      
        mt=ipart(1,index_part)                         
        ipid=ipart(2,index_part)                   
        ixs(1,i)=mt                                
        ixs(10,i)=ipid 
        DO j=2,7
          ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
          CALL anodset(ixs(j,i), check_volu)
        ENDDO
        ixs(9,i)=ixs(5,i)
        ixs(8,i)=ixs(7,i)
        ixs(7,i)=ixs(6,i)
        ixs(6,i)=ixs(5,i)
        ixs(5,i)=ixs(2,i)
        isolnod(i)=6
      ENDDO
C--------------------------------------------------
C      READING TETRA10 INPUTS IN HM STRUCTURE
C-------------------------------------------------- 
      CALL cpp_tetra10_read(ixs,nixs,ixs10,6,numbrick+numtetra4+numpenta6,iparts,sub_sol)
C--------------------------------------------------
C      FILL OTHER STRUCTURES + CHECKS
C--------------------------------------------------
      index_part = 1
      i10=0
      DO n=1,numels10
        i = i + 1
        i10 = i10 + 1
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
        IF( ipart(4,index_part) /= iparts(i) )THEN  
          DO j=1,npart                            
            IF(ipart(4,j)== iparts(i) ) index_part = j
          ENDDO  
        ENDIF
        IF( ipart(4,index_part) /= iparts(i) ) THEN
          CALL ancmsg(msgid=402,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                c1="TETRA10",
     .                i1=iparts(i),
     .                i2=iparts(i),
     .                prmod=msg_cumu)
        ENDIF 
        iparts(i) = index_part 
C--------------------------------------------------      
        mt=ipart(1,index_part)                         
        ipid=ipart(2,index_part)              
        ixs(1,i)=mt                                
        ixs(10,i)=ipid  
        DO j=2,5             
          ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
          CALL anodset(ixs(j,i), check_volu)
        ENDDO
C
        DO j=1,6
          IF(ixs10(j,i10)/=0)THEN
            ixs10(j,i10)=usr2sys(ixs10(j,i10),itabm1,mess,ixs(11,i))
            CALL anodset(ixs10(j,i10), check_volu) 
          ENDIF
        ENDDO
C
        ixs(9,i)=ixs(5,i)
        ixs(8,i)=ixs(4,i)
        ixs(7,i)=ixs(4,i)
        ixs(6,i)=ixs(5,i)
        ixs(5,i)=ixs(3,i)
        ixs(4,i)=ixs(3,i)
        ixs(3,i)=ixs(2,i)
        isolnod(i)=10
        IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
            ic2=ixs(6,i)
            ic4=ixs(4,i)
            ixs10_sav(1:6) = ixs10(1:6,i10)
            ixs(4,i)=ic2
            ixs(6,i)=ic4
            ixs(5,i)=ic2
            ixs(9,i)=ic4
            ixs10(1,i10) = ixs10_sav(4)
            ixs10(2,i10) = ixs10_sav(6)
            ixs10(4,i10) = ixs10_sav(1)
            ixs10(6,i10) = ixs10_sav(2)
        END IF
      ENDDO
C--------------------------------------------------
C      READING BRIC20 INPUTS IN HM STRUCTURE
C--------------------------------------------------
      IF (is_dyna ==0) CALL cpp_brick20_read(ixs,nixs,ixs20,12,numbrick+numtetra4+numpenta6+numels10,iparts,sub_sol)
C--------------------------------------------------
C      FILL OTHER STRUCTURES + CHECKS
C--------------------------------------------------
      index_part = 1
      i20=0
      DO n=1,numels20
        i = i + 1
        i20 = i20 + 1
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
        IF( ipart(4,index_part) /= iparts(i) )THEN  
          DO j=1,npart                            
            IF(ipart(4,j)== iparts(i) ) index_part = j 
          ENDDO  
        ENDIF 
        IF( ipart(4,index_part) /= iparts(i) ) THEN
          CALL ancmsg(msgid=402,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                c1="BRIC20",
     .                i1=iparts(i),
     .                i2=iparts(i),
     .                prmod=msg_cumu)
        ENDIF
        iparts(i) = index_part 
C--------------------------------------------------      
        mt=ipart(1,index_part)                         
        ipid=ipart(2,index_part)               
        ixs(1,i)=mt                                
        ixs(10,i)=ipid  
        DO j=2,9 
          ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
          CALL anodset(ixs(j,i), check_volu)
        ENDDO
C
        DO j=1,12
          IF(ixs20(j,i20)/=0)THEN
             ixs20(j,i20)=usr2sys(ixs20(j,i20),itabm1,mess,ixs(11,i))
          CALL anodset(ixs20(j,i20), check_volu)
          ENDIF
        ENDDO
        isolnod(i)=20
      ENDDO
C--------------------------------------------------
C      READING SHEL16 INPUTS IN HM STRUCTURE
C--------------------------------------------------
      IF (is_dyna ==0) CALL cpp_shel16_read(ixs,nixs,ixs16,8,numbrick+numtetra4+numpenta6+numels10+numels20,iparts,sub_sol)
C--------------------------------------------------
C      FILL OTHER STRUCTURES + CHECKS
C--------------------------------------------------
      index_part = 1
      i16=0
      DO n=1,numels16
        i = i + 1
        i16 = i16 + 1
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
        IF( ipart(4,index_part) /= iparts(i) )THEN  
          DO j=1,npart                            
            IF(ipart(4,j)== iparts(i) ) index_part = j 
          ENDDO  
        ENDIF 
        IF( ipart(4,index_part) /= iparts(i) ) THEN
          CALL ancmsg(msgid=402,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                c1="SHEL16",
     .                i1=iparts(i),
     .                i2=iparts(i),
     .                prmod=msg_cumu)
        ENDIF
        iparts(i) = index_part 
C--------------------------------------------------      
        mt=ipart(1,index_part)                         
        ipid=ipart(2,index_part)               
        ixs(1,i)=mt                                
        ixs(10,i)=ipid  
        DO j=2,9 
          ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
          CALL anodset(ixs(j,i), check_volu)
        ENDDO
C
        DO j=1,8
          IF(ixs16(j,i16)/=0)THEN
             ixs16(j,i16)=usr2sys(ixs16(j,i16),itabm1,mess,ixs(11,i))
          CALL anodset(ixs16(j,i16), check_volu)
          ENDIF
        ENDDO
        isolnod(i)=16
      ENDDO
C-----------
      CALL ancmsg(msgid=402,                 
     .             msgtype=msgerror,         
     .             anmode=aninfo_blind_1,    
     .             prmod=msg_print) 
C-------------------------------------
      IF (ALLOCATED(sub_sol)) DEALLOCATE(sub_sol)
C-------------------------------------
C Recherche des ID doubles
C-------------------------------------
      CALL udouble(ixs(nixs,1),nixs,numels,mess,0,bid)
      RETURN
      END
C
!||====================================================================
!||    lce16s3        ../starter/source/elements/reader/hm_read_solid.F
!||--- called by ------------------------------------------------------
!||    lectur         ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    reordr         ../starter/source/elements/solid_2d/quad/reordr.F
!||    usr2sys        ../starter/source/system/sysfus.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE lce16s3(IXS    ,ISEL    ,PM      ,IPOINT  ,ITAB     ,ITABM1 ,
     .                   ICODE  ,IPARTS  ,IGRBRIC ,GEO     ,ISOLNOD  ,
     .                   IXS10  ,IPART   ,IXS20   ,IXS16   ,KNOD2ELS ,NOD2ELS,
     .                   IGRSURF,SPH2SOL ,SOL2SPH )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE groupdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "units_c.inc"
#include      "scr03_c.inc"
#include      "sphcom.inc"
#include      "param_c.inc"
#include      "titr_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXS(NIXS,*), ISEL(*), IPOINT(2,*), ITAB(*), ITABM1(*),
     .   ICODE(*),IPARTS(*),ISOLNOD(*),
     .   IXS10(6,*),IPART(LIPART1,*),IXS20(12,*),IXS16(8,*),
     .   KNOD2ELS(*),NOD2ELS(*),SPH2SOL(*),SOL2SPH(2,*)
      my_real PM(NPROPM,NUMMAT),GEO(NPROPG,*)
C-----------------------------------------------
      TYPE (GROUP_)  ,DIMENSION(NGRBRIC)  :: IGRBRIC
      TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, MT, MLAW, JTUR, I1, I2, INEW, K, N, IAD, NN
      INTEGER IC,IC1,IC2,IC3,IC4,MID,PID
      CHARACTER MESS*40, MESS2*40
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS
C
      DATA mess/'3D SOLID ELEMENTS DEFINITION            '/
      DATA mess2/'3D SOLID ELEMENTS SELECTION FOR TH PLOT '/
C
C----------------------------------------------------
C     DETECTION DES ELEMENTS LOIS 6 PAROI---->LOI 17
C----------------------------------------------------
C      LOI 17 SI LA BCS EST  111 (3D)
      DO i=1,numels8
        mt=ixs(1,i)
        mlaw=nint(pm(19,mt))
        jtur=nint(pm(70,mt))
        DO j=2,9
          IF((mlaw==6.AND.jtur/=0) .OR. mlaw==46) THEN
           ic=icode(ixs(j,i))
           ic1=ic/512
           ic2=(ic-512*ic1)/64
           ic3=(ic-512*ic1-64*ic2)/8
           ic4=(ic-512*ic1-64*ic2-8*ic3)
           IF(ic1==7 .OR. ic4==7)ixs(1,i)=-iabs(ixs(1,i))
          ENDIF
        ENDDO
      ENDDO
C----------------------------------------------------
C     CLASSEMENT DES ELEMENTS PAR LOI DE MATERIAU
C----------------------------------------------------
      CALL reordr(ixs   ,nixs   ,numels8,pm      ,ipoint ,
     .            iparts,ngrbric,igrbric,nummat)
C------------------------------------------
C RENUMEROTATION POUR SURFACES
C------------------------------------------
      DO i=1,nsurf
        nn =igrsurf(i)%NSEG
        DO j=1,nn
          IF (igrsurf(i)%ELTYP(j) == 1) THEN
            IF (igrsurf(i)%ELEM(j) <= numels8)
     .        igrsurf(i)%ELEM(j)=ipoint(1,igrsurf(i)%ELEM(j))
          END IF
        ENDDO
      ENDDO
C------------------------------------------
C     RENUMEROTATION DES PARTICULES SPH 
C------------------------------------------
      IF(nsphsol/=0)THEN
        DO i=1,numsph
          IF(sph2sol(i)/=0)sph2sol(i)=ipoint(1,sph2sol(i))
        ENDDO
C
C Rebuild SOL2SPH, SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
        DO n=1,numels8
          sol2sph(1,n)=0
          sol2sph(2,n)=0
        END DO
        n=sph2sol(first_sphsol)
        sol2sph(1,n)=0
        sol2sph(2,n)=sol2sph(1,n)+1
        DO i=first_sphsol+1,first_sphsol+nsphsol-1
          IF(sph2sol(i)==n)THEN
            sol2sph(2,n)=sol2sph(2,n)+1
          ELSE
            n=sph2sol(i)
            sol2sph(1,n)=i-1
            sol2sph(2,n)=sol2sph(1,n)+1
          END IF
        END DO          
      END IF
C------------------------------------------
C     PERMUTATION DE ISOLNOD
C------------------------------------------
      DO i=1,numels8
        ipoint(2,i)=isolnod(i)
      ENDDO
      DO i=1,numels8
        isolnod(ipoint(1,i))=ipoint(2,i)
      ENDDO
C------------------------------------------
C Reconstruction de la matrice Nod -> Solid elt
C------------------------------------------
      DO  k=2,9
        DO  i=1,numels
          n = ixs(k,i)
          knod2els(n) = knod2els(n) + 1
          IF(n/=0) nod2els(knod2els(n)) = i
        END DO
      END DO
C
      DO k=1,6
        DO i=1,numels10
          n = ixs10(k,i)
          IF (n/=0) THEN
            knod2els(n) = knod2els(n) + 1
            nod2els(knod2els(n)) = numels8+i
          END IF
        END DO
      END DO
C
      DO k=1,12
        DO i=1,numels20
          n = ixs20(k,i)
          IF (n/=0) THEN
            knod2els(n) = knod2els(n) + 1
            nod2els(knod2els(n)) = numels10+numels8+i
          END IF
        END DO
      END DO
C
      DO k=1,8
        DO i=1,numels16
          n = ixs16(k,i)
          IF (n/=0) THEN
            knod2els(n) = knod2els(n) + 1
            nod2els(knod2els(n)) = numels20+numels10+numels8+i
          END IF
        END DO
      END DO
C
      DO n=numnod,1,-1
        knod2els(n+1)=knod2els(n)
      END DO
      knod2els(1)=0
C------------------------------------------
C     PRINT
C------------------------------------------
      i1=1
      i2=50
C
      IF(ipri>=5)THEN
        WRITE (iout,'(//A//)') titre(206)
   90   CONTINUE
        i2=min0(i2,numels8)
         WRITE (iout,'(//A/A//A/A,A/)')
     .        titre(90),titre(91),
     .        '   ELEMENT   INTERNAL     PART     MATER     PRSET',
     .        '     NODE1     NODE2     NODE3     NODE4     NODE5',
     .        '     NODE6     NODE7     NODE8'
         DO i=i1,i2
          inew=ipoint(1,i)
          WRITE (iout,'(5I10)')
     .      ixs(11,inew),inew,ipart(4,iparts(inew)),
     .      ipart(5,iparts(inew)),ipart(6,iparts(inew))
          IF(isolnod(inew)==4)THEN
            WRITE (iout,'(8I10)')
     .        itab(ixs(2,inew)),itab(ixs(4,inew)),
     .        itab(ixs(7,inew)),itab(ixs(6,inew))
          ELSEIF(isolnod(inew)==6)THEN
            WRITE (iout,'(6I10)')
     .        itab(ixs(5,inew)),itab(ixs(3,inew)),itab(ixs(4,inew)),
     .        itab(ixs(6,inew)),itab(ixs(7,inew)),itab(ixs(8,inew))
          ELSE
            WRITE (iout,'(8I10)')
     .        (itab(ixs(j,inew)),j=2,9)
          ENDIF
         ENDDO
        IF(i2==numels8)GOTO 200
        i1=i1+50
        i2=i2+50
        GOTO 90
C
 200    CONTINUE
        i1=1
        i2=50
C
  290   CONTINUE
        WRITE (iout,'(//A/A//A/A,A/)')
     .        '            TEN NODE TETRA ELEMENTS',
     .        '            -----------------------',
     .        '   ELEMENT   INTERNAL     PART     MATER     PRSET',
     .        '     NODE1     NODE2     NODE3     NODE4     NODE5',
     .        '     NODE6     NODE7     NODE8     NODE9    NODE10'
        i2=min0(i2,numels10)
        DO i=i1,i2
          inew=i+numels8
          WRITE (iout,'(5I10)')
     .      ixs(11,inew),inew,ipart(4,iparts(inew)),
     .      ipart(5,iparts(inew)),ipart(6,iparts(inew))
          WRITE (iout,'(10I10)')
     .        itab(ixs(2,inew)),itab(ixs(4,inew)),
     .        itab(ixs(7,inew)),itab(ixs(6,inew)),
     .        (itab(ixs10(j,i)),j=1,6)
        ENDDO
        IF(i2==numels10)GOTO 300
        i1=i1+50
        i2=i2+50
        GOTO 290
C
 300    CONTINUE
        i1=1
        i2=50
C
        dowhile(i1<=numels20)
         WRITE (iout,'(//A/A//A/A,A/A/A)')
     .        '            TWENTY NODE BRICK ELEMENTS',
     .        '            --------------------------',
     .        ' ELEMENT INTERNAL   PART   MATER   PRSET',
     .        '   NODE1   NODE2   NODE3   NODE4   NODE5',
     .        '   NODE6   NODE7   NODE8',
     .        '   NODE9  NODE10  NODE11  NODE12  NODE13  NODE14',
     .        '  NODE15  NODE16  NODE17  NODE18  NODE19  NODE20'
         i2=min0(i2,numels20)
         DO i=i1,i2
          inew=i+numels8+numels10
          WRITE (iout,'(5I10)')
     .      ixs(11,inew),inew,ipart(4,iparts(inew)),
     .      ipart(5,iparts(inew)),ipart(6,iparts(inew))
          WRITE (iout,'(8I10/6I10/6I10)')
     .        (itab(ixs(j,inew)),j=2,9),
     .        (itab(ixs20(j,i)),j=1,12)
         ENDDO
         i1=i1+50
         i2=i2+50
        ENDDO
        i1=1
        i2=50
C
        dowhile(i1<=numels16)
         WRITE (iout,'(//A/A//A/A,A/A,A)')
     .        '            SIXTEEN NODE SHELL ELEMENTS',
     .        '            ---------------------------',
     .        ' ELEMENT INTERNAL   PART   MATER   PRSET',
     .        '   NODE1   NODE2   NODE3   NODE4   NODE5',
     .        '   NODE6   NODE7   NODE8',
     .        '   NODE9  NODE10  NODE11  NODE12  NODE13  NODE14',
     .        '  NODE15  NODE16'
         i2=min0(i2,numels16)
         DO i=i1,i2
          inew=i+numels8+numels10+numels20
          WRITE (iout,'(5i10)')
     .      IXS(11,INEW),INEW,IPART(4,IPARTS(INEW)),
     .      IPART(5,IPARTS(INEW)),IPART(6,IPARTS(INEW))
          WRITE (IOUT,'(8i10/8i10)')
     .        (ITAB(IXS(J,INEW)),J=2,9),
     .        (ITAB(IXS16(J,I)),J=1,8)
         ENDDO
         I1=I1+50
         I2=I2+50
        ENDDO
      ENDIF
C
      RETURN
      END
!||====================================================================
!||    lce16s4   ../starter/source/elements/reader/hm_read_solid.F
!||--- called by ------------------------------------------------------
!||    lectur    ../starter/source/starter/lectur.F
!||====================================================================
      SUBROUTINE LCE16S4(IXS,PM,ICODE)
C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXS(NIXS,*), ICODE(*)
C     REAL
      my_real
     .   PM(NPROPM,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, MT, MLAW, JTUR
      INTEGER IC,IC1,IC2,IC3,IC4
C-----------------------------------------------
C     DETECTION DES ELEMENTS LOIS 6 PAROI---->LOI 17
C----------------------------------------------------
C     LOI 17 SI LA BCS EST  111 (3D)
      DO I=1,NUMELS8
        MT=IXS(1,I)
        IF(MT < 1)CYCLE
        MLAW=NINT(PM(19,MT))
        JTUR=NINT(PM(70,MT))
        DO J=2,9
.AND..OR.          IF((MLAW==6JTUR/=0)  MLAW==46) THEN
           IC=ICODE(IXS(J,I))
           IC1=IC/512
           IC2=(IC-512*IC1)/64
           IC3=(IC-512*IC1-64*IC2)/8
           IC4=(IC-512*IC1-64*IC2-8*IC3)
.OR.           IF(IC1==7  IC4==7)IXS(1,I)=-IABS(IXS(1,I))
          ENDIF
        ENDDO
      ENDDO
C
      RETURN
      END
C
!||====================================================================
!||    hm_prelce16s      ../starter/source/elements/reader/hm_read_solid.F
!||--- called by ------------------------------------------------------
!||    contrl            ../starter/source/starter/contrl.F
!||--- calls      -----------------------------------------------------
!||    ancmsg            ../starter/source/output/message/message.F
!||    usr2sys           ../starter/source/system/sysfus.F
!||--- uses       -----------------------------------------------------
!||    message_mod       ../starter/share/message_module/message_mod.F
!||    reader_old_mod    ../starter/share/modules1/reader_old_mod.F90
!||    submodel_mod      ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE HM_PRELCE16S(IPART, IGEO, IXS, NSPHSOL ,LSUBMODEL, IS_DYNA )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE MESSAGE_MOD
      USE SUBMODEL_MOD , ONLY : NSUBMOD, SUBMODEL_DATA
      USE READER_OLD_MOD , ONLY : LINE
      USE USER_ID_MOD , ONLY : ID_LIMIT
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "scr17_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPART(LIPART1,*), IGEO(NPROPGI,NUMGEO), IXS(NIXS,*), NSPHSOL
      TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
      INTEGER,INTENT(IN)::IS_DYNA
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, K, IT, NT
      INTEGER IPID,ID,IDS,N,NSPHDIR,STAT
      INTEGER FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,INDEX_PART
      my_real BID
      CHARACTER MESS*40
      INTEGER, DIMENSION(:), ALLOCATABLE :: IPARTS
      INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SOL
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS
C
      DATA MESS/'3d solid elements definition            '/
C=======================================================================
        NSPHSOL=0
C
C--------------------------------------------------
C      ALLOCS & INITS
C--------------------------------------------------
      ALLOCATE (SUB_SOL(NUMELS),STAT=stat)
      IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
     .                             MSGTYPE=MSGERROR,
     .                             C1='sub_sol')
      SUB_SOL(1:NUMELS) = 0
      INDEX_PART = 1
C--------------------------------------------------
C      READING BRICKS INPUTS IN HM STRUCTURE
C--------------------------------------------------  
      ALLOCATE(IPARTS(NUMELS))
      CALL CPP_BRICK_READ(IXS,NIXS,IPARTS,SUB_SOL) 
C--------------------------------------------------
C      NSPHSOL NSPHDIR CALCULATION + CHECKS
C--------------------------------------------------
      DO I=1,NUMBRICK
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
        IF( IPART(4,INDEX_PART) /= IPARTS(I) )THEN  
          DO J=1,NPART                            
            IF(IPART(4,J)== IPARTS(I) )INDEX_PART = J             
          ENDDO
        ENDIF 
        IPARTS(I) = INDEX_PART 
C--------------------------------------------------
        IF (IXS(11,I)>ID_LIMIT%GLOBAL) THEN
          CALL ANCMSG(MSGID=509,ANMODE=ANINFO,MSGTYPE=MSGERROR,
     .                I1=IXS(11,I),C1=LINE,C2='/solid')
        ENDIF
C
        IF (IPART(2,IPARTS(I)) > 0) THEN
          NSPHDIR=IGEO(37,IPART(2,IPARTS(I)))
          IF(IXS(6,I)+IXS(7,I)+IXS(8,I)+IXS(9,I)==0)THEN
            NT=0
            DO IT=1,NSPHDIR
              NT=NT+IT
              NSPHSOL=NSPHSOL+NT
            END DO
          ELSEIF(IXS(8,I)+IXS(9,I)==0)THEN
            NT=0
            DO IT=1,NSPHDIR
              NT=NT+IT
            END DO
            NSPHSOL=NSPHSOL+NSPHDIR*NT
          ELSE
            NSPHSOL=NSPHSOL+NSPHDIR*NSPHDIR*NSPHDIR
          ENDIF
        ENDIF
C
      ENDDO
C
        FLAG_FMT = 0
        I=0
C--------------------------------------------------
C      READING TETRA4s INPUTS IN HM STRUCTURE
C-------------------------------------------------- 
      CALL CPP_TETRA4_READ(IXS,NIXS,NUMBRICK,IPARTS,SUB_SOL)
C--------------------------------------------------
C      NSPHSOL NSPHDIR CALCULATION + CHECKS
C--------------------------------------------------
        DO I=NUMBRICK+1,NUMBRICK+NUMTETRA4
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
          IF( IPART(4,INDEX_PART) /= IPARTS(I) )THEN  
            DO J=1,NPART                            
              IF(IPART(4,J)== IPARTS(I) )INDEX_PART = J             
            ENDDO  
          ENDIF 
          IPARTS(I) = INDEX_PART 
C--------------------------------------------------
C
          NSPHDIR=IGEO(37,IPART(2,IPARTS(I)))
          IF (IXS(11,I)>ID_LIMIT%GLOBAL) THEN
            CALL ANCMSG(MSGID=509,ANMODE=ANINFO,MSGTYPE=MSGERROR,
     .                  I1=IXS(11,I),C1=LINE,C2='/solid')
          ENDIF
          NT=0
          DO IT=1,NSPHDIR
            NT=NT+IT
            NSPHSOL=NSPHSOL+NT
          END DO
        ENDDO
C--------------------------------------------------
C      READING PENTA6s INPUTS IN HM STRUCTURE
C-------------------------------------------------- 
      IF (IS_DYNA ==0) CALL CPP_PENTA6_READ(IXS,NIXS,NUMBRICK+NUMTETRA4,IPARTS,SUB_SOL)
C--------------------------------------------------
C      NSPHSOL NSPHDIR CALCULATION + CHECKS
C--------------------------------------------------
        DO I=NUMBRICK+NUMTETRA4+1,NUMBRICK+NUMTETRA4+NUMPENTA6
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
          IF( IPART(4,INDEX_PART) /= IPARTS(I) )THEN  
            DO J=1,NPART                            
              IF(IPART(4,J)== IPARTS(I) )INDEX_PART = J             
            ENDDO  
          ENDIF 
          IPARTS(I) = INDEX_PART 
C--------------------------------------------------
          NSPHDIR=IGEO(37,IPARTS(I-NUMBRICK))
          IF (IXS(11,I)>ID_LIMIT%GLOBAL) THEN
            CALL ANCMSG(MSGID=509,ANMODE=ANINFO,MSGTYPE=MSGERROR,
     .                  I1=IXS(11,I),C1=LINE,C2='/solid')
          ENDIF
          NT=0
          DO IT=1,NSPHDIR
            NT=NT+IT
            NSPHSOL=NSPHSOL+NT
          END DO
        ENDDO
      IF (ALLOCATED(IPARTS)) DEALLOCATE(IPARTS)
      IF (ALLOCATED(SUB_SOL)) DEALLOCATE(SUB_SOL)
C--------------------------
      RETURN
      END