qmorth2_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/.

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

!||    qmorth2                ../starter/source/elements/solid_2d/quad/qmorth2.F

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

!||    q4init2                ../starter/source/elements/solid_2d/quad4/q4init2.F

!||    qinit2                 ../starter/source/elements/solid_2d/quad/qinit2.F

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

!||    ancmsg                 ../starter/source/output/message/message.f

!||    fretitl2               ../starter/source/starter/freform.f

!||--- uses       -----------------------------------------------------

!||    message_mod            ../starter/share/message_module/message_mod.F

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


      SUBROUTINE qmorth2(PID  ,GEO  ,IGEO ,GAMA, NEL,

     .                   RY   ,RZ   ,SY   ,SZ,

     .                   E1Y  ,E1Z  ,E2Y  ,E2Z)

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

C   M o d u l e s

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

      USE message_mod

      USE names_and_titles_mod , ONLY : nchartitle

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      "param_c.inc"

#include      "scr17_c.inc"

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

C   D u m m y   A r g u m e n t s

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

      INTEGER JHBE,NEL

      INTEGER PID(*),IGEO(NPROPGI,*)

      my_real

     .   geo(npropg,*),gama(nel,6),

     .   ry(*) ,rz(*) ,sy(*) ,sz(*),

     .   e1y(*),e1z(*),e2y(*),e2z(*)

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

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

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

      INTEGER I,IG,ID,ISK,IPNUM,IIS,II,J,JJ,N,IFLAGINI

C     REAL

      my_real

     .   xl,yl,zl,sum,hx,hy,hz,kx,ky,kz,

     .   lx,ly,lz,phi,cp,sp,vx,vy,vz,vn,

     .   f3x,f3y,f3z,

     .   g11,g22,g33,g12,g21,g23,g32,g13,g31

      my_real

     .   sk(6)

      CHARACTER(LEN=NCHARTITLE)::TITR

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

C     Repere orthotrope

C=======================================================================

      DO i=lft,llt

        ig = pid(i)

        id=igeo(1,ig)

        CALL fretitl2(titr,igeo(npropgi-ltitr+1,ig),ltitr)

        ipnum = igeo(2,ig)

        vx  = geo(7,ig)

        vy  = geo(8,ig)

        vz  = geo(9,ig)

        phi = geo(1,ig) * pi/hundred80

        cp  = cos(phi)

        sp  = sin(phi)

c

        IF (jcvt == 0) THEN

c ------------------------------

c Angle d'orthotropie defini par rapport

c a la premiere direction du repere isoparametrique

c ------------------------------

          IF(ipnum==11) THEN

            sum=sqrt(ry(i)**2+rz(i)**2)

            sum=one/max(sum,em20)

            hx=zero

            hy=ry(i)*sum

            hz=rz(i)*sum

            lx=hy*sz(i)-hz*sy(i)

            ly=-hx*sz(i)

            lz=zero

            sum = sqrt(lx**2+ly**2+lz**2)

            sum=one/max(sum,em20)

            lx=lx*sum

            ly=ly*sum

            lz=lz*sum

            kx=ly*hz-lz*hy

            ky=lz*hx-lx*hz

            kz=lx*hy-ly*hx

            sum = sqrt(kx**2+ky**2+kz**2)

            IF (sum > zero) sum=one/sum

            kx=kx*sum

            ky=ky*sum

            kz=kz*sum

            vn = vx*lx + vy*ly + vz*lz

            vx = vx - vn*lx

            vy = vy - vn*ly

            vz = vz - vn*lz

            sum = sqrt(vx**2+vy**2+vz**2)

            IF (sum < em10) THEN

              CALL ancmsg(msgid=1620,

     .                    msgtype=msgwarning,

     .                    anmode=aninfo_blind_1,

     .                    i1=id,

     .                    c1=titr)

              sk(1) = hx

              sk(2) = hy

              sk(3) = hz

            ELSE

              sum = one / sum

              sk(1) = vx * sum

              sk(2) = vy * sum

              sk(3) = vz * sum

            ENDIF

            sk(4) = ly* sk(3) - lz* sk(2)

            sk(5) = lz* sk(1) - lx* sk(3)

            sk(6) = lx* sk(2) - ly* sk(1)

            gama(i,1) = sk(1)*hx + sk(2)*hy + sk(3)*hz

            gama(i,2) = sk(1)*kx + sk(2)*ky + sk(3)*kz

            gama(i,3) = zero

            gama(i,4) = sk(4)*hx + sk(5)*hy + sk(6)*hz

            gama(i,5) = sk(4)*kx + sk(5)*ky + sk(6)*kz

            gama(i,6) = zero

          ELSE

            gama(i,1)= cp

            gama(i,2)= sp

            gama(i,3)= zero

            gama(i,4)=-sp

            gama(i,5)= cp

            gama(i,6)= zero

          ENDIF

        ELSEIF (jcvt > 0) THEN

          IF(ipnum==11) THEN

            sum=sqrt(e1y(i)**2+e1z(i)**2)

            IF (sum > zero) sum=one/sum

            hx=zero

            hy=e1y(i)*sum

            hz=e1z(i)*sum

            lx=hy*e2z(i)-hz*e2y(i)

            ly=-hx*e2z(i)

            lz=zero

            sum = sqrt(lx**2+ly**2+lz**2)

            IF (sum > zero) sum=one/sum

            lx=lx*sum

            ly=ly*sum

            lz=lz*sum

            kx=ly*hz-lz*hy

            ky=lz*hx-lx*hz

            kz=lx*hy-ly*hx

            sum = sqrt(kx**2+ky**2+kz**2)

            IF (sum > zero) sum=one/sum

            kx=kx*sum

            ky=ky*sum

            kz=kz*sum

            vn = vx*lx + vy*ly + vz*lz

            vx = vx - vn*lx

            vy = vy - vn*ly

            vz = vz - vn*lz

            sum = sqrt(vx**2+vy**2+vz**2)

            IF (sum < em10) THEN

              CALL ancmsg(msgid=1620,

     .                    msgtype=msgwarning,

     .                    anmode=aninfo_blind_1,

     .                    i1=id,

     .                    c1=titr)

              sk(1) = hx

              sk(2) = hy

              sk(3) = hz

            ELSE

              sum = one / sum

              sk(1) = vx * sum

              sk(2) = vy * sum

              sk(3) = vz * sum

            ENDIF

            sk(4) = ly* sk(3) - lz* sk(2)

            sk(5) = lz* sk(1) - lx* sk(3)

            sk(6) = lx* sk(2) - ly* sk(1)

          ELSE

c ------------------------------

c ATTENTION !

c Angle d'orthotropie est desormais toujours donne par l'utilisateur

c par rapport au repere isoparametrique

c Puis transforme en interne en angle par rapport au repere corrotationnel

c (pour plus de simplicite cote utilisateur)

c (anciennement donne directement par rapport au repere corot)

c ------------------------------

            sum=sqrt(ry(i)**2+rz(i)**2)

            sum=one/max(sum,em20)

            hx=zero

            hy=ry(i)*sum

            hz=rz(i)*sum

            lx=hy*sz(i)-hz*sy(i)

            ly=-hx*sz(i)

            lz=zero

            sum = sqrt(lx**2+ly**2+lz**2)

            sum=one/max(sum,em20)

            lx=lx*sum

            ly=ly*sum

            lz=lz*sum

            kx=ly*hz-lz*hy

            ky=lz*hx-lx*hz

            kz=lx*hy-ly*hx

            sum = sqrt(kx**2+ky**2+kz**2)

            IF (sum > zero) sum=one/sum

            kx=kx*sum

            ky=ky*sum

            kz=kz*sum

            sk(1)= cp*hx+sp*kx

            sk(2)= cp*hy+sp*ky

            sk(3)= cp*hz+sp*kz

            sk(4)=-sp*hx+cp*kx

            sk(5)=-sp*hy+cp*ky

            sk(6)=-sp*hz+cp*kz

            hx=zero

            hy=e1y(i)

            hz=e1z(i)

            kx=zero

            ky=e2y(i)

            kz=e2z(i)

          ENDIF

          gama(i,1) = zero

          gama(i,2) = sk(1)*hx + sk(2)*hy + sk(3)*hz

          gama(i,3) = sk(1)*kx + sk(2)*ky + sk(3)*kz

          gama(i,4) = zero

          gama(i,5) = sk(4)*hx + sk(5)*hy + sk(6)*hz

          gama(i,6) = sk(4)*kx + sk(5)*ky + sk(6)*kz

        ENDIF

      ENDDO

C-----


      RETURN


      END SUBROUTINE qmorth2


my_real
#define my_real
Definition cppsort.cpp:32

freform
subroutine freform(irunn, irfl, irfe, h3d_data, flag_cst_ams, dynain_data, sensors, dt, output, glob_therm)
Definition freform.F:88

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

message_mod
Definition message_mod.F:1249

names_and_titles_mod
Definition names_and_titles_mod.F:997

names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003

qmorth2
subroutine qmorth2(pid, geo, igeo, gama, nel, ry, rz, sy, sz, e1y, e1z, e2y, e2z)
Definition qmorth2.F:37

ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889

fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804

starter
program starter
Definition starter.F:39