section_fio.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	section_fio (nstrf, v, vr, a, ar, secbuf, ms, in, weight, iad_cut, fr_cut, wfext)

Function/Subroutine Documentation

section_fio()

subroutine section_fio	(	integer, dimension(*)	nstrf,
			v,
			vr,
			a,
			ar,
			secbuf,
			ms,
			in,
		integer, dimension(*)	weight,
		integer, dimension(nspmd+2,*)	iad_cut,
		integer, dimension(*)	fr_cut,
		double precision, intent(inout)	wfext )

Definition at line 31 of file section_fio.F.

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      "comlock.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
!#include      "com06_c.inc"
#include      "com08_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSTRF(*),WEIGHT(*), IAD_CUT(NSPMD+2,*), FR_CUT(*)
      my_real v(3,*), vr(3,*), a(3,*), ar(3,*), ms(*),secbuf(*), in(*)
      DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .   j, i, k, ii, i1, i2, n, kr1,kr2,kr3,k0,kr0,k1,k2,
     .   ifrl1, ifrl2, l,TYPE, NNOD,KR11,KR12,
     .   KR21,KR22,NBINTER,LEN,NNODT
      my_real
     .   dw, tt1, tt2, tt3, vi, dd, d1, d2,wfextl,
     .   tnext, deltat,err(8), ff, fold, alpha,aa,dtinv
C
      IF(nsect==0)RETURN
      IF(nstrf(2)==0)RETURN
C-----------------------------------------------
C READ FILE dans l'ordre des sections lues sur le fichier
C  T = TT
C-----------------------------------------------
       IF(nspmd==1) THEN
         CALL section_read (tt ,nstrf  ,secbuf)
       ELSE
         nnodt = 0
         IF(ispmd==0) THEN
           k0  = nstrf(25)
           DO i = 1, nsect
             IF(nstrf(k0)>=100) nnodt = nnodt + iad_cut(nspmd+2,i)
             k0  = nstrf(k0+24)
           END DO
         END IF
C
C SPMD SPECIFIC : MAJ MODIF NSTRF et SECBUF dans SECT_READP
C
         CALL section_readp(tt,nstrf,secbuf,nnodt,iad_cut,fr_cut)
       END IF
C-----------------------------------------------
C IMPOSED FORCES
C-----------------------------------------------
       tt1 = secbuf(2)
       tt2 = secbuf(3)
       tt3 = secbuf(4)
       dtinv=zero
       IF(dt1>zero)dtinv=one/dt1
       IF(nstrf(2)>=1)THEN
        ifrl1=nstrf(7)
        ifrl2=mod(ifrl1+1,2)
        k0  = nstrf(25)
        kr0 = nstrf(26)
        DO n=1,nsect
          nnod = nstrf(k0+6)
          TYPE=nstrf(k0)
          nbinter = nstrf(k0+14)
          alpha = secbuf(kr0+2)
          IF(type>=101.AND.alpha/=0.0)THEN
            k2 = k0 + 30 + nbinter
            kr1 = kr0 + 10
            kr2 = kr1 + 12*nnod
            kr3 = kr2 + 12*nnod
            kr11 = kr1 + ifrl2*6*nnod
            kr12 = kr1 + ifrl1*6*nnod
            kr21 = kr2 + ifrl2*6*nnod
            kr22 = kr2 + ifrl1*6*nnod
            dw   = secbuf(kr0+3)
            IF(ispmd==0) THEN
              wfextl=dw*dt1
            ELSE
              wfextl=zero
            ENDIF
            wfext = wfext + wfextl
            dw=0.
            DO k=1,3
              DO i=1,nnod
                ii = nstrf(k2+i-1)
                d2 = secbuf(kr22+6*i-7+k)
                d1 = secbuf(kr21+6*i-7+k)
                aa = (tt*(d2-d1)+tt2*d1-tt1*d2) / (tt2-tt1)
                d2 = secbuf(kr12+6*i-7+k)
                d1 = secbuf(kr11+6*i-7+k)
                dd = ms(ii)*(d2-d1) / (tt2-tt1)
                aa = dd*dtinv + aa
                a(k,ii) = a(k,ii) + aa
                IF(weight(ii)==1) THEN
                  dw = dw + half*v(k,ii)*aa
                ENDIF
              ENDDO
              IF(iroddl/=0)THEN
                DO i=1,nnod
                  ii = nstrf(k2+i-1)
                  d2 = secbuf(kr22+6*i-4+k)
                  d1 = secbuf(kr21+6*i-4+k)
                  aa = (tt*(d2-d1)+tt2*d1-tt1*d2) / (tt2-tt1)
                  d2 = secbuf(kr12+6*i-4+k)
                  d1 = secbuf(kr11+6*i-4+k)
                  dd = in(ii)*(d2-d1) / (tt2-tt1)
                  aa = dd*dtinv + aa
                  ar(k,ii) = ar(k,ii) + aa
                  IF(weight(ii)==1) THEN
                    dw = dw + half*vr(k,ii)*aa
                  ENDIF
                ENDDO
              ENDIF
            ENDDO
            wfextl = wfextl + dt1*dw
            wfext = wfext + dt1*dw
            secbuf(kr0+3) = dw
            secbuf(kr0+4) = wfextl
          ENDIF
          kr0 = nstrf(k0+25)
          k0  = nstrf(k0+24)
        ENDDO
       ENDIF
C---------------------------------------------------------
      RETURN