i23mainf.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "impl1_c.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "task_c.inc"
#include "timeri_c.inc"
#include "warn_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine

i23mainf (output, timers, ipari, intbuf_tab, x, a, icodt, fsav, v, ms, itab, stifn, fskyi, isky, fcont, nin, lindmax, jtask, nb_jlt, nb_jlt_new, nb_stok_n, nstrf, secfcum, icontact, viscn, num_imp, ns_imp, ne_imp, ind_imp, nrtmdim, fncont, ftcont, rcontact, acontact, pcontact, kinet, weight, mskyi_sms, iskyi_sms, nodnx_sms, nodglob, npc, tf, niskyfi, newfront, mwag, fbsav6, isensint, dimfb, dt2t, h3d_data)

Function/Subroutine Documentation

i23mainf()

subroutine i23mainf	(	type(output_), intent(inout)	output,
		type(timer_), intent(inout)	timers,
		integer, dimension(npari,ninter)	ipari,
		type(intbuf_struct_)	intbuf_tab,
			x,
			a,
		integer, dimension(*)	icodt,
			fsav,
			v,
			ms,
		integer, dimension(*)	itab,
			stifn,
			fskyi,
		integer, dimension(*)	isky,
			fcont,
		integer	nin,
		integer	lindmax,
		integer	jtask,
		integer	nb_jlt,
		integer	nb_jlt_new,
		integer	nb_stok_n,
		integer, dimension(*)	nstrf,
			secfcum,
		integer, dimension(*)	icontact,
			viscn,
		integer	num_imp,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(*)	ind_imp,
		integer	nrtmdim,
			fncont,
			ftcont,
			rcontact,
			acontact,
			pcontact,
		integer, dimension(*)	kinet,
		integer, dimension(*)	weight,
			mskyi_sms,
		integer, dimension(*)	iskyi_sms,
		integer, dimension(*)	nodnx_sms,
		integer, dimension(*)	nodglob,
		integer, dimension(*)	npc,
			tf,
		integer	niskyfi,
		integer	newfront,
		integer, dimension(*)	mwag,
		double precision, dimension(12,6,dimfb)	fbsav6,
		integer, dimension(*)	isensint,
		integer	dimfb,
			dt2t,
		type(h3d_database)	h3d_data )

Definition at line 46 of file i23mainf.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      use output_mod
      USE timer_mod
      USE intbufdef_mod 
      USE h3d_mod 
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "impl1_c.inc"
#include      "param_c.inc"
#include      "parit_c.inc"
#include      "task_c.inc"
#include      "timeri_c.inc"
#include      "warn_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      type(output_), intent(inout) :: output
      TYPE(TIMER_), INTENT(inout) :: TIMERS
      INTEGER NIN, NSTRF(*), NRTMDIM, NEWFRONT, 
     .        NISKYFI
      INTEGER IPARI(NPARI,NINTER), ICODT(*),ICONTACT(*),
     .        ITAB(*), ISKY(*), KINET(*), ISKYI_SMS(*), NODNX_SMS(*),
     . NODGLOB(*), NPC(*), MWAG(*)
      INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,JTASK,
     .        LINDMAX,DIMFB
      INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*), WEIGHT(*)
C     REAL
      my_real 
     .   x(*), a(3,*), fsav(*), v(3,*),
     .   ms(*),stifn(*),fskyi(lskyi,4), fcont(3,*),
     .   secfcum(7,numnod,nsect), viscn(*),
     .   fncont(3,*), ftcont(3,*), rcontact(*), acontact(*),
     .   pcontact(*), mskyi_sms(*),
     .   tf(*), dt2t
      DOUBLE PRECISION FBSAV6(12,6,DIMFB)
 
      TYPE(INTBUF_STRUCT_) INTBUF_TAB
      TYPE(H3D_DATABASE) :: H3D_DATA
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, I_STOK, JLT_NEW, JLT , NFT, J,
     . IBC, NOINT, ISECIN, IBAG,
     .        IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB,
     .        NB_LOC, I_STOK_LOC,DEBUT,
     . INTTH, IFSTF, H, IERROR
      INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
     .        NSVG(MVSIZ), CN_LOC(MVSIZ),CE_LOC(MVSIZ),
     .        CAND_N_N(MVSIZ), CAND_E_N(MVSIZ), KINI(MVSIZ),
     .        INDEX2(LINDMAX),
     .        NSMS(MVSIZ), ISENSINT(*)
C     REAL
      my_real
     .   startt, fric, gap, stopt, 
     .   visc,stiglo,gapmin,
     . kmin, kmax, gapmax,
     .   scal_t, deri
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      my_real  
     .        finter
C-----------------------------------------------
C     REAL
      my_real
     .
     .   x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
     .   y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
     .   z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
     .   xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
     .   nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
     .   ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
     .   nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
     .   nx(mvsiz), ny(mvsiz), nz(mvsiz), pene(mvsiz),
     .   gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz),
     .   fxt(mvsiz), fyt(mvsiz), fzt(mvsiz)
      my_real
     .    vxm(mvsiz), vym(mvsiz), vzm(mvsiz), 
     .    h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz)
      INTEGER ICURV, SFSAVPARIT
 
      my_real, DIMENSION(:,:,:), ALLOCATABLE :: fsavparit
      INTEGER :: NSN                 
      INTEGER :: NMN                
      INTEGER :: NTY                
 
C---------------------------------------------------- 
C
      nsn   =ipari(5,nin) 
      nmn   =ipari(6,nin)
      nty   =ipari(7,nin)
      ibc   =ipari(11,nin)
      IF(ipari(33,nin)==1) RETURN
      noint =ipari(15,nin)
      igap  =ipari(21,nin)
      inacti=ipari(22,nin)
      isecin=ipari(28,nin)
      mfrot =ipari(30,nin)
      ifq =ipari(31,nin) 
      ibag =ipari(32,nin) 
      igsti=ipari(34,nin)
      nisub =ipari(36,nin)
      icurv =ipari(39,nin)
      ifstf =ipari(48,nin)
C no heat interface
      intth = ipari(47,nin)
      scal_t= intbuf_tab%VARIABLES(33)
C      
      stiglo=-intbuf_tab%STFAC(1)
      IF(ifstf/=0)stiglo = stiglo*finter(ifstf,tt/scal_t,npc,tf,deri)
C
      startt=intbuf_tab%VARIABLES(3)
      stopt =intbuf_tab%VARIABLES(11)
      IF(startt>tt) RETURN
      IF(tt>stopt)  RETURN
C  
      fric  =intbuf_tab%VARIABLES(1)
      gap   =intbuf_tab%VARIABLES(2)
      gapmin=intbuf_tab%VARIABLES(13)
      visc  =intbuf_tab%VARIABLES(14)
C
      gapmax=intbuf_tab%VARIABLES(16)
      kmin  =intbuf_tab%VARIABLES(17)
      kmax  =intbuf_tab%VARIABLES(18)
C
C -------------------------------------------------------------
C     STORAGE OF OLD CANDIDATES
C -------------------------------------------------------------
C
C Barrier in all cases for bminma [and cur_max_max]
C
      CALL my_barrier
C
      i_stok     = intbuf_tab%I_STOK(1)
cC
c      ALLOCATE(ITAGP(NMN))
c      ITAGP(1:NMN)=0
cC
c      IP0 = 1
c      IP1 = IP0 + NSN + 3
cC     IP1 = IP0 + NSN + NSNROLD + 3
c      IP2 = IP1 + I_STOK
c      IF(JTASK==1)THEN
cC MWA = MWAG SUR TASK 0
c        CALL I23TRCF(
cC    1    NSN+NSNROLD  ,I_STOK       ,INBUF(KD(15)),INBUF(KD(14)),
c     1    NSN          ,I_STOK       ,INBUF(KD(15)),INBUF(KD(14)),
c     3    MWAG(IP0)    ,MWAG(IP1)    ,INBUF(KD(27)))
c      ENDIF
cC
c      IF(JTASK==1)THEN
c        ALLOCATE(IFPEN_SAV(I_STOK),CAND_P_SAV(I_STOK))
c        IFPEN_SAV(1:I_STOK) =INBUF(KD(27):KD(27)+I_STOK-1)
c        CAND_P_SAV(1:I_STOK)=BUFIN(JD(18):JD(18)+I_STOK-1)
c      END IF
C
C----------------------------------------------------
C
      CALL my_barrier
C
C----------------------------------------------------
C static decoupage
        nb_loc = i_stok / nthread
        IF (jtask==nthread) THEN
          i_stok_loc = i_stok-nb_loc*(nthread-1)
        ELSE
          i_stok_loc = nb_loc
        ENDIF
        debut = (jtask-1)*nb_loc
C
        i_stok = 0
C
        IF (impl_s==1) THEN
          num_imp = 0
          visc  =zero
        ENDIF
C
        DO i = debut+1, debut+i_stok_loc
          IF(intbuf_tab%CAND_N(i)<0) THEN
            i_stok = i_stok + 1
            index2(i_stok) = i
C inbuf == cand_n
            intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
          ELSE
              intbuf_tab%CAND_P(i) = zero
              intbuf_tab%FTSAVX(i) = zero
              intbuf_tab%FTSAVY(i) = zero
              intbuf_tab%FTSAVZ(i) = zero
              intbuf_tab%IFPEN(i) = 0
          ENDIF
        ENDDO
C
c------------------------------------------------
        IF (debug(3)>=1) THEN
          nb_jlt = nb_jlt + i_stok_loc
          nb_stok_n = nb_stok_n + i_stok
        ENDIF
C
        sfsavparit = 0
        DO i=1,nisub+1
          IF(isensint(i)/=0) THEN
            sfsavparit = sfsavparit + 1
          ENDIF
        ENDDO
        IF (sfsavparit /= 0) THEN
          ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
          IF(ierror/=0) THEN
            CALL ancmsg(msgid=19,anmode=aninfo,
     .           c1='(/INTER/TYPE23)')
           CALL arret(2)
          ENDIF
          DO j=1,i_stok
            DO i=1,11
              DO h=1,nisub+1
                fsavparit(h,i,j) = zero
              ENDDO
            ENDDO
          ENDDO
        ELSE
          ALLOCATE(fsavparit(0,0,0),stat=ierror)
          IF(ierror/=0) THEN
            CALL ancmsg(msgid=19,anmode=aninfo,
     .           c1='(/INTER/TYPE23)')
           CALL arret(2)
          ENDIF
        ENDIF
c
        DO nft = 0 , i_stok - 1 , nvsiz
          jlt = min( nvsiz, i_stok - nft )
C preparation CANDIDATES retenus
          CALL i7cdcor3(
     1         jlt,index2(nft+1),intbuf_tab%CAND_E,intbuf_tab%CAND_N,
     2         cand_e_n,cand_n_n)
C cand_n and cand_e replaced by cand_n_n and cand_e_n
            CALL i23cor3(
     1  jlt    ,nin       ,x   ,intbuf_tab%IRECTM,nsn   ,
     2  intbuf_tab%NSV,cand_e_n ,cand_n_n ,intbuf_tab%STFM,
     +                  intbuf_tab%STFNS,
     3  intbuf_tab%MSR,ms     ,v    ,xi      ,yi   ,
     4  zi     ,ix1      ,ix2   ,ix3      ,ix4  ,
     5  nsvg     ,igsti    ,stif   ,kmin      ,kmax  ,
     6  igap     ,gap      ,intbuf_tab%GAP_S,gapv    ,gapmax  ,
     7  gapmin     ,intbuf_tab%GAP_M,vxi     ,vyi     ,vzi,
     8  msi     ,nodnx_sms,nsms     ,kinet   ,x1   ,
     9  y1      ,z1       ,x2  ,y2       ,z2  ,
     a  x3      ,y3       ,z3  ,x4       ,y4  ,
     b  z4      ,nx1      ,nx2     ,nx3      ,nx4       ,
     c  ny1      ,ny2      ,ny3  ,ny4       ,nz1      ,
     d  nz2     ,nz3      ,nz4      ,kini   ,index2(nft+1))
C
          jlt_new = 0
C
            CALL i23dst3(
     1      jlt      ,cand_n_n ,cand_e_n ,cn_loc ,ce_loc ,
     2      x1     ,x2     ,x3     ,x4     ,y1     ,
     3      y2     ,y3     ,y4     ,z1     ,z2     ,
     4      z3     ,z4     ,xi     ,yi     ,zi     ,
     6      ix1    ,ix2    ,ix3    ,ix4    ,nsvg   ,
     7      gapv   ,inacti ,index2(nft+1),
     8      vxm    ,vym    ,vzm    ,h1     ,h2     ,
     9      h3     ,h4     ,intbuf_tab%IRECTM,intbuf_tab%CAND_P,
     a      intbuf_tab%IFPEN,nx   ,ny   ,nz  ,intbuf_tab%FTSAVX,
     b      intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ,fxt    ,fyt   ,fzt,
     c      pene   ,v   ,vxi   ,vyi  ,vzi   ,
     d      msi    ,stif ,jlt_new,nsms  ,kini  )
          jlt = jlt_new
          IF (imonm > 0) CALL startime(timers,20)
 
          IF(jlt_new/=0) THEN
            ipari(29,nin) = 1
            IF (debug(3)>=1)
     .        nb_jlt_new = nb_jlt_new + jlt
C 
              CALL i23for3(output,
     1  jlt       ,nin  ,noint        ,ibc  ,icodt        ,
     2  fsav       ,gap  ,stiglo       ,fric  ,visc        ,
     3  inacti       ,mfrot  ,ifq        ,ibag  ,
     4  ipari(39,nin),stif  ,gapv        ,itab  ,a        ,
     5  intbuf_tab%CAND_P,intbuf_tab%FRIC_P,intbuf_tab%XFILTR,v  ,icontact,
     6  niskyfi      ,nsvg     ,x1        ,y1      ,z1       ,
     7  x2       ,y2     ,z2        ,x3      ,y3       ,
     8  z3       ,x4     ,y4        ,z4      ,xi       ,
     9  yi       ,zi     ,vxi       ,vyi      ,vzi      ,
     a  msi       ,vxm     ,vym       ,vzm      ,nx       ,
     b  ny       ,nz     ,pene      ,h1      ,h2       ,
     c  h3       ,h4     ,index2(nft+1),cand_n_n  ,weight   ,
     f  fxt       ,fyt     ,fzt       ,dt2t         ,
     g  fcont       ,fncont     ,ftcont    ,stifn      ,viscn    ,
     h  newfront     ,isecin     ,nstrf     ,secfcum      ,fskyi    ,
     i  isky       ,intth     ,ms        ,ix1      ,ix2      ,
     j  ix3   ,ix4      ,intbuf_tab%FTSAVX,intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ,
     k  kmin       ,kmax    ,cn_loc     ,ce_loc  ,mskyi_sms    ,
     l  iskyi_sms    ,nsms     ,jtask     ,isensint ,fsavparit    ,
     m  nisub        ,nft          ,h3d_data  )
C
            ENDIF ! JLT_NEW/=0
          IF (imonm > 0) CALL stoptime(timers,20)
C
        ENDDO
c
        IF (sfsavparit /= 0)THEN
            CALL sum_6_float_sens(fsavparit, nisub+1, 11, i_stok,1,i_stok,
     .                            fbsav6, 12, 6, dimfb, isensint )
        ENDIF
        IF(ALLOCATED(fsavparit)) DEALLOCATE (fsavparit)
C
      CALL my_barrier
C
c      DEALLOCATE(ITAGP)
c      IF(JTASK==1)DEALLOCATE(IFPEN_SAV,CAND_P_SAV)
      RETURN