ortho__normalization_8F_source.html

Copyright>        OpenRadioss

Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.

Copyright>

Copyright>        This program is free software: you can redistribute it and/or modify

Copyright>        it under the terms of the GNU Affero General Public License as published by

Copyright>        the Free Software Foundation, either version 3 of the License, or

Copyright>        (at your option) any later version.

Copyright>

Copyright>        This program is distributed in the hope that it will be useful,

Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of

Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

Copyright>        GNU Affero General Public License for more details.

Copyright>

Copyright>        You should have received a copy of the GNU Affero General Public License

Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.

Copyright>

Copyright>

Copyright>        Commercial Alternative: Altair Radioss Software

Copyright>

Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss

Copyright>        software under a commercial license.  Contact Altair to discuss further if the

Copyright>        commercial version may interest you: https://www.altair.com/radioss/.

!||====================================================================

!||    orthrg       ../starter/source/constraints/fxbody/ortho_normalization.F

!||--- called by ------------------------------------------------------

!||    ini_fxbody   ../starter/source/constraints/fxbody/ini_fxbody.F

!||--- calls      -----------------------------------------------------

!||    prscal       ../starter/source/constraints/fxbody/ortho_normalization.F

!||    wsum         ../starter/source/constraints/fxbody/ortho_normalization.F

!||====================================================================


      SUBROUTINE orthrg(VECT, MAS, NDDL,NB_MODES )

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


      END

C

!||====================================================================

!||    orthsr       ../starter/source/constraints/fxbody/ortho_normalization.F

!||--- called by ------------------------------------------------------

!||    ini_fxbody   ../starter/source/constraints/fxbody/ini_fxbody.F

!||--- calls      -----------------------------------------------------

!||    prscal       ../starter/source/constraints/fxbody/ortho_normalization.F

!||    wsum         ../starter/source/constraints/fxbody/ortho_normalization.F

!||====================================================================


      SUBROUTINE orthsr(VECTS, VECTR, MAS, NDDL, NMS,NMR)

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


      END

C

!||====================================================================

!||    orthst       ../starter/source/constraints/fxbody/ortho_normalization.F

!||--- called by ------------------------------------------------------

!||    ini_fxbody   ../starter/source/constraints/fxbody/ini_fxbody.F

!||--- calls      -----------------------------------------------------

!||    prscal       ../starter/source/constraints/fxbody/ortho_normalization.F

!||    wsum         ../starter/source/constraints/fxbody/ortho_normalization.F

!||====================================================================


      SUBROUTINE orthst(VECTS, MAS  , NDDL, NMS, NMSF,TOLE)

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


      END

!||====================================================================

!||    prscal       ../starter/source/constraints/fxbody/ortho_normalization.F

!||--- called by ------------------------------------------------------

!||    ini_fxbody   ../starter/source/constraints/fxbody/ini_fxbody.F

!||    orthrg       ../starter/source/constraints/fxbody/ortho_normalization.F

!||    orthsr       ../starter/source/constraints/fxbody/ortho_normalization.F

!||    orthst       ../starter/source/constraints/fxbody/ortho_normalization.F

!||====================================================================

      my_real FUNCTION prscal(V1    , V2, NDDL, VALUE)

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(*), VALUE(nddl,nddl)

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER i,cpt

      my_real

     .        val

C

      prscal=zero

      DO i=1,nddl

         val=zero

         DO cpt=1,nddl

            val=val+value(i,cpt)*v2(cpt)

         ENDDO

         prscal=prscal+v1(i)*val

      ENDDO

C

      END

C

!||====================================================================

!||    wsum     ../starter/source/constraints/fxbody/ortho_normalization.F

!||--- called by ------------------------------------------------------

!||    orthrg   ../starter/source/constraints/fxbody/ortho_normalization.F

!||    orthsr   ../starter/source/constraints/fxbody/ortho_normalization.F

!||    orthst   ../starter/source/constraints/fxbody/ortho_normalization.F

!||====================================================================


      SUBROUTINE wsum(V1, V2, A1, A2, NDDL)

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


      END

my_real
#define my_real
Definition cppsort.cpp:32

norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB

max
#define max(a, b)
Definition macros.h:21

orthsr
subroutine orthsr(vects, vectr, mas, nddl, nms, nmr)
Definition ortho_normalization.F:80

orthrg
subroutine orthrg(vect, mas, nddl, nb_modes)
Definition ortho_normalization.F:32

orthst
subroutine orthst(vects, mas, nddl, nms, nmsf, tole)
Definition ortho_normalization.F:125

wsum
subroutine wsum(v1, v2, a1, a2, nddl)
Definition ortho_normalization.F:223