ortho_normalization.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	orthrg (vect, mas, nddl, nb_modes)
subroutine	orthsr (vects, vectr, mas, nddl, nms, nmr)
subroutine	orthst (vects, mas, nddl, nms, nmsf, tole)
program	__ortho_normalization_f__
subroutine	wsum (v1, v2, a1, a2, nddl)

Function/Subroutine Documentation

__ortho_normalization_f__()

program __ortho_normalization_f__

Definition at line 186 of file ortho_normalization.F.

orthrg()

subroutine orthrg	(		vect,
			mas,
		integer	nddl,
		integer	nb_modes )

Definition at line 31 of file ortho_normalization.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, NB_MODES
      my_real
     .        vect(nddl,*), mas(nddl,nddl)      
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II
      my_real
     .        vt(nddl), s, ms, uns
C
      my_real
     .        prscal
      EXTERNAL prscal
C
         DO i=1,nddl
            vt(i)=zero
         ENDDO
         DO i=1,nb_modes
            CALL wsum(vt, vect(1,i), zero, one, nddl)
            DO ii=1,i-1
               s=prscal(vt, vect(1,ii), nddl, mas)
               ms=-s
               CALL wsum(vect(1,i), vect(1,ii), one, ms, nddl)
            ENDDO
            s=prscal(vect(1,i), vect(1,i), nddl, mas)
            uns=one/sqrt(s)
            CALL wsum(vect(1,i), vt, uns, zero, nddl)
         ENDDO
C
      RETURN

orthsr()

subroutine orthsr	(		vects,
			vectr,
			mas,
		integer	nddl,
		integer	nms,
		integer	nmr )

Definition at line 79 of file ortho_normalization.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, NMS, NMR
      my_real
     .        vects(nddl,*), vectr(nddl,*), mas(nddl,nddl)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II
      my_real
     .        vt(nddl), s, ms
C
      my_real 
     .        prscal
      EXTERNAL prscal
C
         DO i=1,nddl
            vt(i)=zero
         ENDDO
         DO i=1,nms
            CALL wsum(vt, vects(1,i), zero, one, nddl)
            DO ii=1,nmr
               s=prscal(vt, vectr(1,ii), nddl, mas)
               ms=-s
               CALL wsum(vects(1,i), vectr(1,ii), one, ms, nddl)
            ENDDO
         ENDDO
C      
      RETURN

orthst()

subroutine orthst	(		vects,
			mas,
		integer	nddl,
		integer	nms,
		integer	nmsf,
			tole )

Definition at line 124 of file ortho_normalization.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, NMS, NMSF
      my_real
     .        vects(nddl,*), mas(nddl,nddl), tole
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II
      my_real
     .        s, ms, norm, unsn, ref, vt(nddl)
C
      my_real 
     .        prscal,maxi
C-----------------------------------------------
      EXTERNAL prscal
C-----------------------------------------------
C
         DO i=1,nddl
            vt(i)=zero
         ENDDO
 
         maxi = zero
         DO i=1,nms
           norm=prscal(vects(1,i), vects(1,i), nddl, mas)
           IF (sqrt(norm)>maxi) maxi  = max(maxi,sqrt(norm))
         ENDDO
         ref = maxi
         nmsf=0
C
         DO i=1,nms
C
            CALL wsum(vt, vects(1,i), zero, one, nddl)
            DO ii=1,nmsf
               s=prscal(vt, vects(1,ii), nddl, mas)
               ms=-s
               CALL wsum(vects(1,i), vects(1,ii), one, ms, nddl)
            ENDDO
            norm=prscal(vects(1,i), vects(1,i), nddl, mas)
            IF (sqrt(norm)>tole*ref) THEN
               nmsf=nmsf+1
               unsn=one/sqrt(norm)
               CALL wsum(vects(1,nmsf), vects(1,i), zero, unsn, nddl)
            ENDIF
         ENDDO
C
      RETURN

wsum()

subroutine wsum	(		v1,
			v2,
			a1,
			a2,
		integer	nddl )

Definition at line 222 of file ortho_normalization.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
      my_real
     .        v1(*), v2(*), a1, a2
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C
      DO i=1,nddl
         v1(i)=a1*v1(i)+a2*v2(i)
      ENDDO
C
      RETURN