      PROGRAM AVOIR_NOPO
C
C Creation d'un fichier AVOIR a partir d'un fichier NOPO
C
      PARAMETER(MEM=20000000)
      REAL*4 XM(MEM)
      INTEGER M(MEM)
C
      INTEGER NOP2(27),LNOP1_B(100)
      CHARACTER*128 NOPO
      CHARACTER*24 MOI
      CHARACTER*8  LADATE
      CHARACTER*4  HED(32),CARA(29),HED_SAUVE(20)
      EQUIVALENCE(M,XM)
      EQUIVALENCE(M,CARA)
      EQUIVALENCE(M,HED)
      COMMON M
C 
      INOPO    = 2
      IAVOIR   = 3
      CALL LIFICH('Prefix of the NOPO file ?',0,NOPO,LONG)
      OPEN(INOPO,FILE=NOPO(1:LONG),STATUS='OLD'
     &    ,FORM='UNFORMATTED',ERR=9876)
      GOTO 6789
 9876 OPEN(INOPO,FILE=NOPO(1:LONG)//'.nopo',STATUS='OLD'
     &    ,FORM='UNFORMATTED')
 6789 READ(INOPO) LNOP00,(M(I),I=1,LNOP00)
      PRINT*,'NOP00(',LNOP00,'):',(M(I),I=1,LNOP00)
      LNOP0_A = M(2)
      LNOP1_A = M(3)
      LNOP2_A = M(4)
      LNOP3_A = M(5)
      LNOP4_A = M(6)
      LNOP5_A = M(7)
C tableau nop0
      READ(INOPO) LNOP0,(M(I),I=1,LNOP0)
      PRINT*,'NOP0 (',LNOP0,') :',HED
      DO I=1,20
        HED_SAUVE(I) = HED(I)
      ENDDO
C tableau nop1
      IF (LNOP1_A.NE.0) THEN
        READ(INOPO) LNOP1,(M(I),I=1,LNOP1)
        PRINT*,'NOP1 (',LNOP1,'):',(HED(I),I=1,LNOP1)
cc        DO K=1,LNOP1_A/44
        DO K=1,LNOP1/22
          READ(INOPO) LNOP1_B(K),(M(I),I=1,LNOP1_B(K))
          PRINT*,'NOP1 (',LNOP1_B(K),'):',(HED(I),I=1,LNOP1_B(K))
cc          READ(INOPO) LNOP1B,(M(I),I=1,LNOP1B)
cc          PRINT*,'NOP1B(',LNOP1B,'):',(HED(I),I=1,LNOP1B)
        ENDDO
      ENDIF
C tableau nop2
      READ(INOPO) LNOP2,(NOP2(I),I=1,LNOP2)
 
      NDIM = NOP2(1)
      LONG_RAC = LRANG_POIN(NOPO,LONG)
      IF (NDIM.EQ.2) THEN
        PRINT*,'The result will be : '//NOPO(1:LONG_RAC)//'.avoir2D'
        OPEN(IAVOIR,FILE=NOPO(1:LONG_RAC)//'.avoir2D'
     &      ,FORM='UNFORMATTED')
      ELSE
        PRINT*,'The result will be : '//NOPO(1:LONG_RAC)//'.avoir3D'
        OPEN(IAVOIR,FILE=NOPO(1:LONG_RAC)//'.avoir3D'
     &      ,FORM='UNFORMATTED')
      ENDIF
 
      WRITE(*,1000) LNOP2,(NOP2(I),I=1,LNOP2)
 1000 FORMAT(/,
     &       'Length of tab nop2 :                           ',I8,/
     &       'Space dimension :                              ',I8,/
     &       'Maximum of reference numbers :                 ',I8,/
     &       'Maximum of subdomain numbers :                 ',I8,/
     &       'Nodes and points equal everywhere (1/0) :      ',I8,/
     &       'Number of elements of the mesh :               ',I8,/
     &       'Number of elements with only one point :       ',I8,/
     &       'Number of segments :                           ',I8,/
     &       'Number of triangles :                          ',I8,/
     &       'Number of rectangles :                         ',I8,/
     &       'Number of tetraedrons :                        ',I8,/
     &       'Number of pentaedrons :                        ',I8,/
     &       'Number of hexaedrons :                         ',I8,/
     &       'Number of super elements :                     ',I8,/
     &       'Number of boundary elements :                  ',I8,/
     &       'Number of nodes :                              ',I8,/
     &       'Number of nodes on a segment (extr. excluded)  ',I8,/
     &       'Number of internal nodes in each triangle :    ',I8,/
     &       'Number of internal nodes in each rectangle :   ',I8,/
     &       'Number of internal nodes in each tetraedron :  ',I8,/
     &       'Number of internal nodes in each pentaedron :  ',I8,/
     &       'Number of internal nodes in each hexaedron :   ',I8,/
     &       'Number of points :                             ',I8,/
     &       'Type of coordinates (2=real*4, 5=real*8) :     ',I8,/
     &       'Max difference between nodes in 1 element+1 :  ',I8,/
     &       'Number of macro elements in the mesh :         ',I8,/
     &       'Length of tabular NOP5 :                       ',I8,/
     &       'Type of axis (1=cartesian,2=polar,3=spherical):',I8,/)
 
      NUMSD   = NOP2(3)
      NCOPNP  = NOP2(4)
      NEL     = NOP2(5)
      NBTRI   = NOP2(8)
      NBQUA   = NOP2(9)
c      NUMNP   = NOP2(15)
      NUMNP   = NOP2(22)
      NBEGM   = NOP2(25)
      LNOP5   = NOP2(26)
      MEMUTIL = LNOP0_A+LNOP1_A+LNOP2_A+LNOP3_A+LNOP4_A+LNOP5_A
      IF (NDIM.EQ.3) THEN
        NEL27 = NEL/8
        MEMUTIL = MEMUTIL + NUMNP + 36*NEL + 28*NEL27
      ENDIF
      IF (MEMUTIL.GT.MEM) THEN
        PRINT*,
     &'*** NOT ENOUGH MEMORY : I need',MEMUTIL,' and I only have',MEM
        GOTO 9999
      ENDIF
c
c tableau nop3
c
      IF (NBEGM.NE.0) READ(INOPO) NBEGM,(M(I),I=1,NBEGM)
c
c tableau nop4 (coordonnees)
c
      IA4 = 1
      READ(INOPO) LNOP4,(XM(IA4+I-1),I=1,LNOP4)
      IA5 = IA4 + LNOP4
c
c tableau nop5
c
      READ(INOPO) LNOP5,(M(IA5+I-1),I=1,LNOP5)
C
      NNNDS = M(IA5+3) 
      PRINT*,'Elements with',NNNDS,' nodes'
      EPS = 1.E-04
      INTERFACE = 0
      IF (NDIM.EQ.3.AND.NNNDS.LT.27.AND.NNNDS.GT.4) THEN
        CALL LIENTIER(
     & 'Creation of 27 nodes elements (yes:1,no:0) ?',0,IIII)
      ELSE
        IIII = 0
      ENDIF
      IF (IIII.NE.0) THEN
        IANOD  = IA5    + LNOP5
        IADOM  = IANOD  + 8*NEL
        IAVOIS = IADOM  + NEL
        IANVOI = IAVOIS + 26*NEL
        IAELM  = IANVOI + NEL
        IAREF  = IAELM  + NEL27*28
        IASD   = IAREF  + NUMNP
        PRINT*,' '
        PRINT*,'Looking for 8 nodes elements'
        CALL CHERCHE_NODE(M(IANOD),M(IA5),M(IADOM),NCOPNP,NEL)
        PRINT*,' '
        PRINT*,'Computing neighbours'
        CALL CHERCHE_VOIS(M(IANOD),M(IAVOIS),M(IANVOI),NEL)
        PRINT*,' '
        PRINT*,'Gathering elements'
        CALL ASSEMBLE (M(IAELM),M(IANOD),M(IAVOIS)
     &                ,M(IANVOI),M(IADOM),NEL,NEL27)
        IF (NUMSD.GT.1) THEN
          PRINT*,' '
          PRINT*,'Your nopo has',NUMSD,' subdomains'
          CALL LIENTIER(
     &         'Mark interfaces between subdomains (yes:1,no:0) ?'
     &                 ,0,IREP)
          IF (IREP.EQ.1) THEN
            INTERFACE = 1
            PRINT*,' '
            PRINT*,'Computing interfaces'
            CALL CHERCHE_INTER (M(IAELM),M(IAREF),NUMNP,NEL27)
            CALL CHERCHE_MINMAX (XM(IA4),NUMNP)
          ENDIF
        ENDIF
        PRINT*,' '
        PRINT*,'Writing coordinates'
        CALL ECR_PTS(IAVOIR,HED_SAUVE,NUMNP,NDIM,XM(IA4),M(IAREF)
     &              ,M(IASD),INTERFACE,EPS,NCOPNP,M(IA5),NEL)
        PRINT*,' '
        PRINT*,'Writing elements'
        CALL ECR_ELM3D(IAVOIR,NEL27,NUMSD,M(IAELM),27)
C
C Special treatment for 6 nodes elements (2d)
C
      ELSEIF(NNNDS.EQ.6.AND.NDIM.EQ.2.AND.NCOPNP.EQ.0) THEN
        PRINT*,' '
        PRINT*,'Reconstructing coordinates and writing avoir2D'
        NUMNP = NOP2(15)
        IAREF = IA5   + LNOP5
        IASD  = IAREF + NUMNP
        IACO  = IASD  + NUMNP
        CALL ECR_6NODES(IAVOIR,HED_SAUVE,NUMNP,NDIM,XM(IA4),M(IAREF)
     &                 ,M(IASD),XM(IACO),M(IA5),NEL)
      ELSE
        PRINT*,' '
        PRINT*,'Writing coordinates'
        IAREF = IA5   + LNOP5
        IASD  = IAREF + NUMNP
        CALL ECR_PTS(IAVOIR,HED_SAUVE,NUMNP,NDIM,XM(IA4),M(IAREF)
     &              ,M(IASD),INTERFACE,EPS,NCOPNP,M(IA5),NEL)
        PRINT*,' '
        PRINT*,'Writing elements'
        CALL ECR_ELM2D(IAVOIR,NEL,NCOPNP,M(IA5),NOP2(3),NBTRI,NBQUA)
      ENDIF
C
      CLOSE(IAVOIR)
 9999 CLOSE(INOPO)
      END
