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

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

!||    noise             ../engine/source/general_controls/computation/noise.F

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

!||    sortie_main       ../engine/source/output/sortie_main.F

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

!||    cur_fil_c         ../common_source/tools/input_output/write_routtines.c

!||    initnoise         ../engine/source/general_controls/computation/initnoise.F

!||    initnoise2        ../engine/source/general_controls/computation/initnoise.F

!||    pnoise            ../engine/source/general_controls/computation/pnoise.F

!||    spmd_glob_dsum9   ../engine/source/mpi/interfaces/spmd_th.F

!||    wrtdes            ../engine/source/output/th/wrtdes.F

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

!||    elbufdef_mod      ../common_source/modules/mat_elem/elbufdef_mod.F90

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


      SUBROUTINE noise(

     1   DT2R  ,IN,J     ,BUF  ,V     ,

     2   A     ,IXS,ELBUF_TAB,IPARG,WEIGHT,

     3   IXQ   )

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

C   M o d u l e s

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

      USE elbufdef_mod

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

#include      "com04_c.inc"

#include      "com08_c.inc"

#include      "units_c.inc"

#include      "scrnoi_c.inc"

#include      "scr05_c.inc"

#include      "scr13_c.inc"

#include      "task_c.inc"

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

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

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

      INTEGER IN(*),J(*),IXS(*),IPARG(*), WEIGHT(*),IXQ(*)

      my_real

     . BUF(NCNOIS,*),V(3,*),DT2R ,A(3,*)

      TYPE (elbuf_struct_), DIMENSION(NGROUP) :: elbuf_tab

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

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

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

      INTEGER , DIMENSION(:), ALLOCATABLE :: ELNOI,ELG,NOIADD

      my_real,DIMENSION(:),ALLOCATABLE ::  C

      INTEGER IPELNOI,IPNOIADD,IPTC

      INTEGER IFIRST,I,K,L,NE,NC,KK,IAD, LEN

      my_real pi1,pi2,tol,te,tc,fne,fac,dec,to,trans,xi,w,cc,ttn

      INTEGER LENGTH, ITAG(0:NUMNOD)

      SAVE ifirst,te,iptc,c,nc,to,ipelnoi,elnoi,elg,ipnoiadd,noiadd

      DATA ifirst/0/

      my_real wa(nnoise)

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

C INITIALIALISATION DES COEFFICIENTS DU FILTRE

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

      ne = 0

      tol=em01

      IF(ispmd==0) THEN

        iunit=iunoi

        IF(itform==3) CALL cur_fil_c(iunit)

      ENDIF

      IF(ifirst==0)THEN

        ifirst=1

        IF(rnoi==0)THEN

C NE : NOMBRE D'ECHANTILLON ENTRE CHAQUE SORTIE

        te=dt2

         dt2r=te

        ne=max(1,int(dtnoise/te))

         j(7)=ne

        ELSEIF(rnoi==1)THEN

         te=dt2r

         ne=j(7)

        ENDIF

C

C INITIALISATION DES TABLEAUX D'ELEMENTS PAR NOEUDS SAUVES

C

        IF(noisep/=0)THEN

          ALLOCATE (noiadd(nnoise+1))

          CALL initnoise(in,noiadd,ixs,itag(0),length,ixq)

          ALLOCATE(elnoi(length))

          ALLOCATE(elg(length))

          CALL initnoise2(in,elnoi,elg,noiadd,ixs,itag(1),iparg,ixq)

        ENDIF

C TC PERIODE DE COUPURE

        dtnoise=float(ne)*te

        tc=2.*dtnoise

C NOMBRE DE COEFFICIENTS ET ALLOCATION ; TO DEPHASAGE

        nc=6*ne

        fac=one/float(ne)

        dec=float(3*ne) - half

        to=float(3*ne)*te

        IF(nc>0)THEN

          ALLOCATE(c(nc))

        ENDIF

C

C COEFF. DU FILTRE PARFAIT AVEC FENETRE DE HAMMING

C

        pi2 = two*pi

        trans=0

        DO i=1,nc

          xi=float(i-1)-dec

          w=0.54+0.46*cos(pi2*xi/float(nc))

          IF(abs(pi*fac*xi)<tol)THEN

            c(i)=fac

          ELSE

            c(i)=w*sin(pi*xi*fac)/pi/xi

          ENDIF

          trans=trans+c(i)

        ENDDO

C

        IF(ispmd==0) THEN

          WRITE(iout,1000)one/dtnoise,one/tc,nc,trans

          WRITE(iout,'(1P8E10.3)')(c(i),i=1,nc)

          WRITE(iout,'(//)')

        ENDIF

C

        IF(rnoi==0)THEN

         DO k=1,6

          j(k)=(1-k)*ne-1

         ENDDO

         DO i=1,6*nnoise

          DO l=1,ncnois

            buf(l,i)=zero

          ENDDO

         ENDDO

        ENDIF

      ENDIF

      IF(ispmd==0) THEN

        IF(abs(1.-dt2/te)>tol)THEN

          WRITE(iout,1100)

          WRITE(istdo,1100)

        ENDIF

      ENDIF

      IF(rnoi==0 .AND. tt-to<tnoise-nc*te)RETURN

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

C PRESSION

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

      IF(noisep/=0)CALL pnoise(elnoi,elg,noiadd,elbuf_tab,wa,iparg)

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

C FILTRAGE

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

C

C Anullation buffer noise sur pi, i<>0 en SPMD

C

      IF(ispmd/=0) THEN

        DO i=1,6*nnoise

          DO l=1,ncnois

            buf(l,i)=zero

          ENDDO

        ENDDO

      ENDIF

C

      DO k=1,6

        j(k)=j(k)+1

        IF(j(k)>0)THEN

         cc=c(j(k))

         kk=(k-1)*nnoise

         DO i=1,nnoise

            kk=kk+1

            IF(in(i) /= 0)THEN      ! test if present on current domain (spmd)

             IF(weight(in(i))==1) THEN

              IF(noisev/=0)THEN

               buf(1,kk)=buf(1,kk)+cc *v(1,in(i))

               buf(2,kk)=buf(2,kk)+cc *v(2,in(i))

               buf(3,kk)=buf(3,kk)+cc *v(3,in(i))

              ENDIF

              IF(noisea/=0)THEN

               iad=3*noisev

               buf(iad+1,kk)=buf(iad+1,kk)+cc *a(1,in(i))

               buf(iad+2,kk)=buf(iad+2,kk)+cc *a(2,in(i))

               buf(iad+3,kk)=buf(iad+3,kk)+cc *a(3,in(i))

              ENDIF

             ENDIF

            END IF

            IF(noisep/=0.AND.ispmd==0)THEN

              iad=3*noisev+3*noisea+1

              buf(iad,kk)=buf(iad,kk)-cc *wa(i)

            ENDIF

          ENDDO ! I

        ENDIF

      ENDDO ! K

C

C GATHER SPMD BUF

C

      IF(nspmd>1) THEN

        len = 6*nnoise*ncnois

        CALL spmd_glob_dsum9(buf,len)

      ENDIF

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

C INCREMENTATION DES INDICES ET ECRITURE DES RESULTATS

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

      DO k=1,6

        IF(j(k)==nc)THEN

         j(k)=0

         kk=(k-1)*nnoise+1

         ttn=tt-to

         IF(ispmd==0) THEN

           CALL wrtdes(ttn,ttn,1,itform,1)

           CALL wrtdes(ttn,ttn,1,itform,1)

           CALL wrtdes(buf(1,kk),buf(1,kk),ncnois*nnoise,itform,1)

         ENDIF

         DO i=(k-1)*nnoise+1,k*nnoise

          DO l=1,ncnois

            buf(l,i)=zero

          ENDDO

         ENDDO

        ENDIF

      ENDDO

c

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

      RETURN

 1000 FORMAT(///

     .  ' OUTPUT OF SAMPLED VELOCITIES FOR NOISE AND VIBRATION  ',//

     .  ' EFFECTIVE SAMPLING FREQUENCY . . . . . . . . . . ',1pe10.4/

     .  ' HIGH FREQUENCY CUTOFF . . .  . . . . . . . . . . ',1pe10.4/

     .  ' NUMBER OF COEFFICIENT USED FOR FILTERING . . . . ',i10/

     .  ' STATIC TRANSMITANCE OF FILTER  . . . . . . . . . ',1pe10.4/

     .  ' LIST OF COEFFICIENTS USED FOR FILTERING  . . . . ')

 1100 FORMAT('*** WARNING STRUCTURAL TIME STEP MUST BE CONSTANT ***')


      END

initnoise2
subroutine initnoise2(in, elnoi, elg, noiadd, ixs, iwa, iparg, ixq)
Definition initnoise.F:99

initnoise
subroutine initnoise(in, noiadd, ixs, iwa, length, ixq)
Definition initnoise.F:29

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

noise
subroutine noise(dt2r, in, j, buf, v, a, ixs, elbuf_tab, iparg, weight, ixq)
Definition noise.F:41

pnoise
subroutine pnoise(elnoi, elg, noiadd, elbuf_tab, wa, iparg)
Definition pnoise.F:34

spmd_glob_dsum9
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:380

cur_fil_c
void cur_fil_c(int *nf)
Definition write_routtines.c:477

wrtdes
subroutine wrtdes(a, ia, l, iform, ir)
Definition wrtdes.F:45