w_mad.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	w_mad (iexmad, nmadsh4_l, nmadsh3_l, nmadsol_l, nmadnod_l, madcl_nmadnod_l, cep, proc, nodlocal, cel, numels_l, numelc_l, numeltg_l, len_ia)

Function/Subroutine Documentation

w_mad()

subroutine w_mad	(	integer, dimension(*)	iexmad,
		integer	nmadsh4_l,
		integer	nmadsh3_l,
		integer	nmadsol_l,
		integer	nmadnod_l,
		integer	madcl_nmadnod_l,
		integer, dimension(*)	cep,
		integer	proc,
		integer, dimension(*)	nodlocal,
		integer, dimension(*)	cel,
		integer	numels_l,
		integer	numelc_l,
		integer	numeltg_l,
		integer	len_ia )

Definition at line 69 of file w_mad.F.

C-----------------------------------------------
C   M o d u l e s
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
       INTEGER  PROC, NMADSH4_L, NMADSH3_L, NMADSOL_L, NMADNOD_L,
     .          LEN_IA, NUMELS_L, NUMELC_L, NUMELTG_L,MADCL_NMADNOD_L,
     .          IEXMAD(*), CEP(*), NODLOCAL(*),CEL(*)
C-----------------------------------------------
C   F u n c t i o n
C-----------------------------------------------
      INTEGER  NLOCAL
      EXTERNAL nlocal    
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IDEB, K, ESHIFT, NMAD_L, P
      INTEGER, DIMENSION(:),ALLOCATABLE :: MADCL_TMPNOD,TMPSH3,TMPSH4,TMPSOL,
     .        TMPNOD,FAILSH4,FAILSH3,FAILSOL,ICONX_L
C-----------------------------------------------
!     allocate 1d arrays
      ALLOCATE(madcl_tmpnod(madcl_nmadnod_l))
      ALLOCATE( tmpsh3(nmadsh3_l),tmpsh4(nmadsh4_l) )
      ALLOCATE( tmpsol(nmadsol_l),tmpnod(nmadnod_l) )
      ALLOCATE( iconx_l(7*nconx) )
! -------------------------------
C
C Couplage etendu
C
      IF(nexmad/=0) THEN
C
C ELEM shell4
C
        ideb = 1 + 7*nconx + nmadprt
        eshift = numels+numelq
        nmad_l = 0
        DO i = 1, nmadsh4
          k = iexmad(ideb+i-1)
          IF(cep(k+eshift)==proc) THEN
            nmad_l = nmad_l+1
            tmpsh4(nmad_l) = cel(k+eshift)
          END IF
        END DO
C
C Elem shell3
C
        ideb = ideb + nmadsh4
        eshift = numels+numelq+numelc+numelt+numelp+numelr
        nmad_l = 0
        DO i = 1, nmadsh3
          k = iexmad(ideb+i-1)
          IF(cep(k+eshift)==proc) THEN
            nmad_l = nmad_l+1
            tmpsh3(nmad_l) = cel(k+eshift)
          END IF
        END DO
C
C Elem solides
C
        ideb = ideb + nmadsh3
        eshift = 0
        nmad_l = 0
        DO i = 1, nmadsol
          k = iexmad(ideb+i-1)
          IF(cep(k+eshift)==proc) THEN
            nmad_l = nmad_l+1
            tmpsol(nmad_l) = cel(k+eshift)
          END IF
        END DO
C
C Noeuds
C
        ideb = ideb + nmadsol
        nmad_l = 0
        DO i = 1, nmadnod
          k = iexmad(ideb+i-1)
          IF(nlocal(k,proc+1)==1) THEN
            DO p = 1, proc
              IF(nlocal(k,p)==1) GOTO 100
            END DO
            nmad_l = nmad_l+1
            tmpnod(nmad_l) = nodlocal(k)
          END IF
 100      CONTINUE
        END DO
C
C Noeuds MADCL
C
        nmad_l = 0
        DO i = 1, nmadnod
          k = iexmad(ideb+i-1)
          IF(nlocal(k,proc+1)==1) THEN
            nmad_l = nmad_l+1
            madcl_tmpnod(nmad_l) = nodlocal(k)
          END IF
        END DO
C
      END IF
C
      IF(proc==0) THEN
        DO i=1,7*nconx
          iconx_l(i) = iexmad(i)
        END DO
        DO i=1,nconx
          iconx_l(7*(i-1)+4) = nodlocal(iexmad(7*(i-1)+4))
        END DO
        CALL write_i_c(iconx_l,7*nconx)
        len_ia = len_ia + 7*nconx
      END IF
      IF(nexmad/=0) THEN
        IF(proc==0) THEN
          CALL write_i_c(iexmad(7*nconx+1),nmadprt)
          len_ia = len_ia + nmadprt
        END IF
        CALL write_i_c(tmpsh4,nmadsh4_l)
        len_ia = len_ia + nmadsh4_l
        CALL write_i_c(tmpsh3,nmadsh3_l)
        len_ia = len_ia + nmadsh3_l
        CALL write_i_c(tmpsol,nmadsol_l)
        len_ia = len_ia + nmadsol_l
        CALL write_i_c(tmpnod,nmadnod_l)
        len_ia = len_ia + nmadnod_l
        CALL write_i_c(madcl_tmpnod,madcl_nmadnod_l)
        len_ia = len_ia + madcl_nmadnod_l
        IF(proc==0)THEN
          ideb = 7*nconx+nmadprt+nmadsh4+nmadsh3+nmadsol+nmadnod
     +         + numelc+numeltg+numels + 1
          CALL write_i_c(iexmad(ideb),2*nmadnod+nmadsh4+nmadsh3+nmadsol)
          len_ia = len_ia + 2*nmadnod+nmadsh4+nmadsh3+nmadsol
        END IF
      END IF
C
! -------------------------------
!     deallocate 1d arrays
      DEALLOCATE(madcl_tmpnod)
      DEALLOCATE( tmpsh3,tmpsh4 )
      DEALLOCATE( tmpsol,tmpnod )
      DEALLOCATE( iconx_l )
! -------------------------------
      RETURN