thsol_count.F File Reference

#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	thsol_count (nthgrp2, ithgrp, wa_size, index_wa_sol, iparg, ithbuf, sithbuf)

Function/Subroutine Documentation

thsol_count()

subroutine thsol_count	(	integer, intent(inout)	nthgrp2,
		integer, dimension(nithgr,*), intent(in)	ithgrp,
		integer, intent(inout)	wa_size,
		integer, dimension(2*nthgrp2+1), intent(inout)	index_wa_sol,
		integer, dimension(nparg,ngroup)	iparg,
		integer, dimension(*)	ithbuf,
		integer, intent(in)	sithbuf )

Definition at line 28 of file thsol_count.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      "vect01_c.inc"
#include      "com01_c.inc"
#include      "task_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: SITHBUF
      INTEGER IPARG(NPARG,NGROUP),ITHBUF(*)
      INTEGER, INTENT(inout) :: WA_SIZE,NTHGRP2
      INTEGER, DIMENSION(2*NTHGRP2+1), INTENT(inout) :: INDEX_WA_SOL
      INTEGER, DIMENSION(NITHGR,*), INTENT(in) :: ITHGRP
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      LOGICAL :: BOOL
      INTEGER II,I,J,JJ,K,L,N, IH, NG, MTE,LWA,NEL,
     .   NUVAR, IP,IPT,ISOLNOD,ITENS,IPWWA,ISPAU,IUWWA,
     .   IT,IR,IS,J1,J2,J3,NPTG,NPTR,NPTT,NPTS,NLAY,NFAIL,NVARF,
     .   NC1,NC2,NC3,NC4,NC5,NC6,NC7,NC8,KHBE,KCVT,NUVARTH,
     .   CPT,PID,ISVIS,TSHELL,TSH_ORT,ICSIG,IVISC,NPTL,IL,KK(6)
      INTEGER :: J_FIRST,NITER,IADB,NN,IADV,NVAR,ITYP,IJK
      INTEGER, DIMENSION(NTHGRP2) :: INDEX_SOL
 
C--------------------------------------------   
 
        ijk = 0
        wa_size = 0
        index_sol(1:nthgrp2) = 0
        DO niter=1,nthgrp2
            ityp=ithgrp(2,niter)
            nn  =ithgrp(4,niter)
            iadb =ithgrp(5,niter)
            nvar=ithgrp(6,niter)
            iadv=ithgrp(7,niter)
            ii=0
            IF(ityp==1)THEN
!   -------------------------------
                ih=iadb
                                          
                DO WHILE((ithbuf(ih+nn) /= ispmd).AND.(ih < iadb+nn))                
                    ih = ih + 1                           
                ENDDO  
                      
                IF (ih >= iadb+nn) GOTO 666
 
                DO ng=1,ngroup
                        ity     = iparg(5,ng)
                        isvis   = iparg(60,ng)
                        ivisc   = iparg(61,ng)
                        nft     = iparg(3,ng)  
c               
                        IF (ity == ityp) THEN
                            mte = iparg(1,ng)
                            nel = iparg(2,ng)  
                            IF (mte /= 0 .AND. mte /= 13) THEN
                                DO i=1,nel
                                    n =i+nft
                                    k =ithbuf(ih)
                                    ip=ithbuf(ih+nn)
 
                                    IF (k == n)THEN
                                        ih=ih+1
                                        ii = ((ih-1) - iadb)*nvar
                                        DO WHILE((ithbuf(ih+nn) /= ispmd).AND.(ih < iadb+nn))
                                            ih = ih + 1
                                        ENDDO
                                        IF (ih > iadb+nn) GOTO 666
                                        wa_size = wa_size + nvar + 1
                                    ENDIF   ! element = ITHBUF()
                                ENDDO ! NEL
                            ENDIF ! mte /= 13
                        ENDIF   ! ITY
                ENDDO     ! groupe
!   -------------------------------
            ENDIF
 666        continue
                index_sol(niter) = wa_size
        ENDDO
 
 
        j_first = 0
        bool = .true.
        DO i=1,nthgrp2
            IF(bool.EQV..true.) THEN
                IF( index_sol(i)/=0 ) THEN
                    bool = .false.
                    j_first = i
                ENDIF
            ENDIF
        ENDDO
 
        j = 0
        IF(j_first>0) THEN
            j=j+1
            index_wa_sol(j) = index_sol(j_first)
            j=j+1
            index_wa_sol(j) = j_first
            DO i=j_first+1,nthgrp2
                IF( index_sol(i)-index_sol(i-1)>0 ) THEN
                    j=j+1
                    index_wa_sol(j) = index_sol(i)
                    j=j+1
                    index_wa_sol(j) = i
                ENDIF
            ENDDO
        ENDIF
        index_wa_sol(2*nthgrp2+1) = j  !   number of non-zero index
C-----------
      RETURN