sensor_user_convert_local_id.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	sensor_user_convert_local_id (itabm1, pointer_entity, number_entity, list_entity, mode0, ipart)

Function/Subroutine Documentation

sensor_user_convert_local_id()

subroutine sensor_user_convert_local_id	(	integer, dimension(*), intent(in)	itabm1,
		integer, intent(inout)	pointer_entity,
		integer, intent(inout)	number_entity,
		integer, dimension(*), intent(inout)	list_entity,
		integer, intent(in)	mode0,
		integer, dimension(lipart1,*), intent(in)	ipart )

Definition at line 30 of file sensor_user_convert_local_id.F.

!$COMMENT
!       SENSOR_USER_CONVERT_LOCAL_I description
!       convert a list of User ID into a local ID
!       
!       SENSOR_USER_CONVERT_LOCAL_I organization :
!           - sort the list
!           - remove the duplicated ID
!           - compact the list
!$ENDCOMMENT
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   A n a l y s e   M o d u l e
C-----------------------------------------------
#include      "com04_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(in) :: MODE0
        INTEGER, INTENT(inout) :: POINTER_ENTITY
        INTEGER, INTENT(inout) :: NUMBER_ENTITY
        INTEGER, DIMENSION(*), INTENT(inout) :: LIST_ENTITY
        INTEGER ,DIMENSION(*)   ,INTENT(IN) :: ITABM1
        INTEGER,INTENT(IN)::IPART(LIPART1,*)
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
        INTEGER USR2SYS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER :: SIZE_LOCAL
        INTEGER :: MODE,WORK(70000)
        INTEGER, DIMENSION(:), ALLOCATABLE :: LOCAL_ARRAY,INDX
        INTEGER :: N1,NS,U_PART
        INTEGER :: I,J,K,IJK
        CHARACTER MESS*40
        DATA mess/'SENSOR DEFINITION                       '/
!   -------------------------------
        ns = 1
 
        ! -------------------
        ! sort the list of ID
        mode=0
        size_local = pointer_entity
        ALLOCATE( indx(2*size_local) )
        ALLOCATE( local_array(size_local) )
        DO i=1,size_local
            indx(i) = i
            local_array(i) = list_entity(i)
        ENDDO
        CALL my_orders(mode,work,list_entity,indx,size_local,1)
        DO i=1,size_local
            j = indx(i)
            list_entity(i) = local_array(j)
        ENDDO
        ! -------------------
        ! remove the duplicated ID
 
        ! example of list :
        ! position in the list + list
        ! 1  2  3  4  5  6  7  8  9  10    <-- position
        ! a  a  a  b  c  c  d  d  d  e     <-- list
        ! if node(i)/=node(i+1) --> save i
        ! 1  4  5  7  10  <-- index of saved nodes
        ! a  b  c  d  e   <-- compacted list
 
        ! compute the index of saved nodes
        k = 1
        local_array(1) = 1
        j = 0 
        DO i=2,size_local
            j = j + 1
            IF(list_entity(i)/=list_entity(i-1)) THEN
                k = k + 1
                local_array(k) = local_array(k-1) + j
                j = 0
            ENDIF
        ENDDO
 
        ! compact the list of node & save the new number of node + pointer
        DO i=1,k
            list_entity(i) = list_entity(local_array(i))
        ENDDO
        pointer_entity = k
        number_entity = k
        ! -------------------
        ! convert User node ID --> Local node ID
        IF(mode0==1)THEN
            DO i=1,number_entity
                n1 = list_entity(i)
                list_entity(i) = usr2sys(n1,itabm1,mess,ns)
            ENDDO
        ! -------------------
        ! convert User part ID --> Local part ID
        ELSEIF(mode0==2) THEN
            DO i=1,number_entity
                u_part = list_entity(i)
                ijk = 0
                DO j=1,npart
                    IF(u_part == ipart(4,j)) THEN
                        ijk = j
                        EXIT
                    ENDIF
                ENDDO
                list_entity(i) = ijk
            ENDDO
        ENDIF
        ! -------------------
 
        DEALLOCATE( indx )
        DEALLOCATE( local_array )
        RETURN