i12s2m.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i12s2m (nsn, irtl, nrtm, jcodv, nodvars, mcount, nmn, nodvarm, irectm, ncount, msr, segvar, isegm, noint)

Function/Subroutine Documentation

i12s2m()

subroutine i12s2m	(	integer	nsn,
		integer, dimension(*)	irtl,
		integer	nrtm,
		integer, dimension(*)	jcodv,
			nodvars,
			mcount,
		integer	nmn,
			nodvarm,
		integer, dimension(4,*)	irectm,
			ncount,
		integer, dimension(*)	msr,
		type(t_segvar), target	segvar,
		integer, dimension(*)	isegm,
		integer	noint )

Definition at line 31 of file i12s2m.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE segvar_mod
      USE ale_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSN, NRTM,IRTL(*),JCODV(*),ISEGM(*),IRECTM(4,*),NMN,MSR(*),NOINT
      my_real mcount(*),nodvars(*),nodvarm(*),ncount(*)
      TYPE(t_segvar),TARGET :: SEGVAR
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NIR, I, J, II, L, JJ,KVAR,SEGAD,ADS,ADM,PB,TEST
      my_real,DIMENSION(:),POINTER :: ptr
C-----------------------------------------------
      test=0
      nir=2
      IF(n2d==0)nir=4
 
      DO kvar=1,ale%GLOBAL%NVCONV
      
        SELECT CASE(kvar)                
          CASE(1)                        
            ptr(1:) => segvar%RHO(1:)    
          CASE(2)                        
            ptr(1:) => segvar%EINT(1:)   
          CASE(3)                        
            ptr(1:) => segvar%RK(1:)     
          CASE(4)                        
            ptr(1:) => segvar%RE(1:)     
          CASE(5)                        
            ptr(1:) => segvar%UVAR(1:)   
        END SELECT 
                              
        DO i=1,nrtm
          ptr(isegm(i))=zero
        ENDDO
        
      ENDDO
      
      DO i=1,nrtm
        mcount(i)=zero 
      ENDDO
 
      DO ii=1,nsn
        l=irtl(ii)
        mcount(l)=mcount(l)+one
      ENDDO
 
      DO kvar=1,ale%GLOBAL%NVCONV
      
        SELECT CASE(kvar)                
          CASE(1)                        
            ptr(1:) => segvar%RHO(1:)    
          CASE(2)                        
            ptr(1:) => segvar%EINT(1:)   
          CASE(3)                        
            ptr(1:) => segvar%RK(1:)     
          CASE(4)                        
            ptr(1:) => segvar%RE(1:)     
          CASE(5)                        
            ptr(1:) => segvar%UVAR(1:)   
        END SELECT 
              
        DO ii=1,nsn
          l=irtl(ii)
          ads=ale%GLOBAL%NVCONV*(ii-1)+kvar
          ptr(isegm(l))=ptr(isegm(l))+nodvars(ads)
         ENDDO
         
      ENDDO
 
      !CALCUL PARTICULIER SI IL EXISTE ONE SEGMENT SANS NOEUD SECOND. DETECTE
      pb=0
      DO i=1,nrtm
        IF(mcount(i)==zero)pb=1
      ENDDO
      IF(pb==1)THEN
        DO i=1,nmn
 
          ncount(i)=zero
        ENDDO
        DO ii=1,nsn
            l=irtl(ii)
            DO jj=1,nir
              ncount(irectm(jj,l))= ncount(irectm(jj,l))+1
            ENDDO
        ENDDO
        DO kvar=1,ale%GLOBAL%NVCONV
          DO i=1,nmn
            adm=ale%GLOBAL%NVCONV*(i-1)+kvar
            nodvarm(adm)=zero
          ENDDO
          DO ii=1,nsn
            l=irtl(ii)
            ads=ale%GLOBAL%NVCONV*(ii-1)+kvar
            DO jj=1,nir
              adm=ale%GLOBAL%NVCONV*(irectm(jj,l)-1)+kvar
              nodvarm(adm)=nodvarm(adm)+nodvars(ads)
            ENDDO
          ENDDO
        ENDDO
        DO kvar=1,ale%GLOBAL%NVCONV
          DO i=1,nmn
            adm=ale%GLOBAL%NVCONV*(i-1)+kvar
            IF(ncount(i)>zero)THEN
              nodvarm(adm)=nodvarm(adm)/ncount(i)
            ENDIF
          ENDDO
        ENDDO
      ENDIF
 
      DO kvar=1,ale%GLOBAL%NVCONV
      
        SELECT CASE(kvar)                
          CASE(1)                        
            ptr(1:) => segvar%RHO(1:)    
          CASE(2)                        
            ptr(1:) => segvar%EINT(1:)   
          CASE(3)                        
            ptr(1:) => segvar%RK(1:)     
          CASE(4)                        
            ptr(1:) => segvar%RE(1:)     
          CASE(5)                        
            ptr(1:) => segvar%UVAR(1:)   
        END SELECT 
              
        DO i=1,nrtm
          segad=ale%GLOBAL%NVCONV*(isegm(i)-1)+kvar
          IF(mcount(i)>zero)THEN
            ptr(isegm(i))=ptr(isegm(i))/mcount(i)
          ELSE
            ptr(isegm(i))=zero
            l=0
            DO jj=1,nir
              ii=irectm(jj,i)
              adm=ale%GLOBAL%NVCONV*(ii-1)+kvar
              IF(ncount(ii)>zero)THEN
                ptr(isegm(i))=ptr(isegm(i))+nodvarm(adm)
                l=l+1
              ENDIF
            ENDDO
            IF(l>0)THEN
              ptr(isegm(i))=ptr(isegm(i))/float(l)
            ELSE
 
              test=test+1          
      !        WRITE(IOUT,'(A,I8,A,I8,A)')
      !+      '*** WARNING INTERF #',NOINT,'MAIN SEGMENT #',I,
      !+      ' WITHOUT SECONDARY NODE'            
            ENDIF
           ENDIF
      
        ENDDO
      ENDDO
      ! IF(TEST >0)WRITE(ISTDO,'(A,I8,I8,A)')
      !+      '*** WARNING INTERF #',NOINT,
      !+      TEST,' MAIN SEGMENTS WITHOUT SECONDARY NODE' 
 
      RETURN