imp_fac_ic.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	imp_fac_icj (nddl, nnz, iadk, jdik, diag_k, lt_k, iadm, jdim, diag_m, lt_m, psi, nnzm, max_l, isky, li, nne)
subroutine	diagmod (j0, j1, li, diag_m, aii, isky)

Function/Subroutine Documentation

diagmod()

subroutine diagmod	(	integer	j0,
		integer	j1,
			li,
			diag_m,
			aii,
		integer, dimension(*)	isky )

Definition at line 147 of file imp_fac_ic.F.

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  J0, J1,ISKY(*)
C     REAL
      my_real
     .  diag_m(*), li(*)  ,aii
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER J
      my_real
     .   ajj,s,fac
C-----------------------------------------------
       DO j = j0, j1
        IF (isky(j)/=j) THEN
         s = li(j)
         IF (s/=zero) THEN
          ajj = diag_m(j)
          s =abs(s)
          fac = sqrt(abs(aii/ajj))
          aii = aii +s*fac 
          IF (abs(aii)<ep30) THEN
          ELSE
          ENDIF
          diag_m(j) = ajj +s/fac
         ENDIF 
        ENDIF 
       ENDDO
C
      RETURN

imp_fac_icj()

subroutine imp_fac_icj	(	integer	nddl,
		integer	nnz,
		integer, dimension(*)	iadk,
		integer, dimension(*)	jdik,
			diag_k,
			lt_k,
		integer, dimension(*)	iadm,
		integer, dimension(*)	jdim,
			diag_m,
			lt_m,
			psi,
		integer	nnzm,
		integer	max_l,
		integer, dimension(*)	isky,
			li,
		integer	nne )

Definition at line 31 of file imp_fac_ic.F.

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  NDDL  ,NNZ  ,IADK(*) ,JDIK(*),NNZM ,IADM(*),JDIM(*),
     .         NNE,ISKY(*),MAX_L
C     REAL
      my_real
     .  diag_k(*), diag_m(*), lt_k(*)  ,lt_m(*) ,psi ,li(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,REJ,MAXK,
     1        K0 ,J0 ,K1, KFT,LSKY
      my_real
     .   aii,ajj,lkik,s, fac
C-----------------------------
C      PSI = SQRT(PSI)
      rej = 0
      maxk = 0
      nne = 0
      nnzm = 0
      iadm(1)=1
      DO i=1,nddl
       diag_m(i) = diag_k(i)
       isky(i)=i
       li(i)=zero
      ENDDO
C
      DO i=1,nddl
       aii = diag_m(i)
       k0 = iadk(i+1) - 1
       IF (k0>0) THEN
        j0 = jdik(k0)
        IF (j0>maxk) maxk=j0
       ENDIF 
       DO j = iadk(i),k0
        k1= jdik(j)
        li(k1) = lt_k(j)
C----------ISKY(J)=I for LT_K(I,J)-----
        IF (isky(k1)==k1) isky(k1)=i
       ENDDO
       kft =isky(i)
       DO k = kft,i-1
        lsky = isky(k)
C        IF (LSKY>=IADM(K+1)) write(*,*)'found 1',i       
        IF (lsky<iadm(k+1).AND.jdim(lsky)==i) THEN
         lkik = lt_m(lsky)/diag_m(k)
         aii = aii -lt_m(lsky)*lkik 
         isky(k)=lsky+1
         DO j = isky(k),iadm(k+1)-1
          k1= jdim(j)
C----------voir ici quand ca tombre sur diagonal---
          li(k1) = li(k1)-lkik*lt_m(j)
         ENDDO
        ENDIF 
       ENDDO 
       DO 100 j = i+1 , maxk
        IF (isky(j)==j) GOTO 100
        s = li(j)
        IF (s/=zero) THEN
         li(j)=zero
         ajj = diag_m(j)
         IF (psi==zero) THEN
          nnzm = nnzm +1
          IF (nnzm>max_l) CALL err_mem(nnzm)
          lt_m(nnzm)=s
          jdim(nnzm)=j
         ELSEIF (s*s<psi*aii*ajj) THEN
          s =abs(s)
          fac = sqrt(aii/ajj)
          aii = aii +s*fac 
          diag_m(j) = ajj +s/fac
          rej = rej +1
         ELSE
          nnzm = nnzm +1
          IF (nnzm>max_l) CALL err_mem(nnzm)
          lt_m(nnzm)=s
          jdim(nnzm)=j
         ENDIF 
        ENDIF 
 100   CONTINUE
       IF (aii<em20) THEN
        nne=nne+1
        aii=sign(max(abs(aii),em20),aii)
       ENDIF 
       diag_m(i) = one/aii
       iadm(i+1)=nnzm+1
       DO j = iadm(i),nnzm
        lt_m(j)=lt_m(j)*diag_m(i)
       ENDDO
       isky(i)=iadm(i)
       IF (isky(i)>nnzm) isky(i)= iadm(i)
      ENDDO
c      IF (NNE>0) then
c       write(*,*)'--WARNING: PIVOT PROBLEM',NNE
c      DO I=1,NDDL
c       write(*,*)'diag,i,iadm=',DIAG_M(I),I,IADM(I)
c      ENDDO
c      DO J=1,NNZM
c       write(*,*)'LT_M,i,j=',LT_M(J),J,JDIM(J)
c      ENDDO
c      endif
      RETURN