i25main_opt_tri.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	i25main_opt_tri (nin, ipari, intbuf_tab, x, v, itask, itab, kinet, count_remslv, count_remslve, nb_candt, i_opt_stok)

Function/Subroutine Documentation

i25main_opt_tri()

subroutine i25main_opt_tri	(	integer	nin,
		integer, dimension(npari,ninter)	ipari,
		type(intbuf_struct_)	intbuf_tab,
			x,
			v,
		integer	itask,
		integer, dimension(*)	itab,
		integer, dimension(*)	kinet,
		integer, dimension(*)	count_remslv,
		integer, dimension(*)	count_remslve,
		integer	nb_candt,
		integer	i_opt_stok )

Definition at line 38 of file i25main_opt_tri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE intbufdef_mod   
      USE tri7box
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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "param_c.inc"
#include      "warn_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,NINTER),ITASK, NIN, ITAB(*), KINET(*),
     .        COUNT_REMSLV(*), NB_CANDT, I_OPT_STOK
      INTEGER :: COUNT_REMSLVE(*)
C     REAL
      my_real 
     .   x(*), v(3,*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NSNR, IGAP, I_STOK_GLO, SIZOPT, IEDGE, NEDGE, IGAP0, I_STOK, L_STOK
      INTEGER N, NSNF, NSNL, NSNRF, NSNRL ,IFQ
      INTEGER :: NRTM, NSN
C     REAL
      my_real
     .   startt, stopt, drad, dgapload
C-----------------------------------------------------------
C     Prepare IRTLM 
C         - IRTLM/=0 <=> at the beginning of CAND_OPT
C-----------------------------------------------------------
!$OMP SINGLE
      CALL i25irtlm(
     1  ipari   ,intbuf_tab ,itab    ,nin     )
!$OMP END SINGLE
C-----------------------------------------------------------
      startt=intbuf_tab%VARIABLES(3)
      stopt =intbuf_tab%VARIABLES(11)
      IF(startt>tt.OR.tt>stopt) RETURN
C-----------------------------------------------------------
      nrtm   =ipari(4,nin)
      nsn   =ipari(5,nin)
      nsnr  =ipari(24,nin)
      igap  =ipari(21,nin)
      ifq   = ipari(31,nin)
      drad = zero
      IF(ipari(47,nin) > 0) drad =intbuf_tab%VARIABLES(32)
      dgapload  =intbuf_tab%VARIABLES(46)
C-----------------------------------------------------------
C     Filtrage des candidats a l'impact
C     (si candidat retenu, cand_n(i) = - cand_n(i))
C-----------------------------------------------------------
       i_stok_glo = intbuf_tab%I_STOK(1)
       IF (debug(3)>=1) THEN
         IF(itask==0) nb_candt  = nb_candt  + i_stok_glo
       ENDIF
       sizopt = intbuf_tab%S_CAND_OPT_N
C
C      I_OPT_STOK modifie ds i25optcd, apres barriere !
!$OMP SINGLE
       i_opt_stok = intbuf_tab%I_STOK(2)
!$OMP END SINGLE NOWAIT
       CALL i25optcd(
     1 intbuf_tab%NSV,intbuf_tab%CAND_E,intbuf_tab%CAND_N,x,i_stok_glo    ,
     2 intbuf_tab%IRECTM,intbuf_tab%GAP_S,intbuf_tab%GAP_M,v,ipari(39,nin),
     3 intbuf_tab%STFNS,itask     ,intbuf_tab%STFM,nin      ,ipari(5,nin) ,
     4 intbuf_tab%IRTLM,intbuf_tab%TIME_S,intbuf_tab%MSEGLO,count_remslv,itab,
     5 intbuf_tab%SECND_FR,nsnr       ,intbuf_tab%PENE_OLD,intbuf_tab%STIF_OLD,
     .                                                   intbuf_tab%MSEGTYP24,
     6 nrtm ,intbuf_tab%VARIABLES(23),i_opt_stok,intbuf_tab%CAND_OPT_E,
     .                                               intbuf_tab%CAND_OPT_N,
     7 sizopt,igap   ,intbuf_tab%GAP_SL,intbuf_tab%GAP_ML,drad,
     8 dgapload,intbuf_tab%ICONT_I)
C
C      I_OPT_STOK modifie ds i25optcd, avant barriere
       IF(i_opt_stok > sizopt)THEN
C
         IF(itask==0)THEN
           CALL upgrade_cand_opt(nin,i_opt_stok-intbuf_tab%I_STOK(2),intbuf_tab)
         END IF
C
         CALL my_barrier
C
C        I_OPT_STOK modifie ds i25optcd, apres barriere !
         sizopt = intbuf_tab%S_CAND_OPT_N
         i_opt_stok = intbuf_tab%I_STOK(2)
         CALL i25optcd(
     1     intbuf_tab%NSV,intbuf_tab%CAND_E,intbuf_tab%CAND_N,x,i_stok_glo    ,
     2     intbuf_tab%IRECTM,intbuf_tab%GAP_S,intbuf_tab%GAP_M,v,ipari(39,nin),
     3     intbuf_tab%STFNS,itask     ,intbuf_tab%STFM,nin      ,ipari(5,nin) ,
     4     intbuf_tab%IRTLM,intbuf_tab%TIME_S,intbuf_tab%MSEGLO,count_remslv,itab,
     5     intbuf_tab%SECND_FR,nsnr       ,intbuf_tab%PENE_OLD,intbuf_tab%STIF_OLD,
     .                                                       intbuf_tab%MSEGTYP24,
     6     nrtm ,intbuf_tab%VARIABLES(23),i_opt_stok,intbuf_tab%CAND_OPT_E,
     .                                                   intbuf_tab%CAND_OPT_N,
     7     sizopt,igap   ,intbuf_tab%GAP_SL,intbuf_tab%GAP_ML ,drad       ,
     8     dgapload,intbuf_tab%ICONT_I)
       END IF
C
C      I_OPT_STOK modifie ds i25optcd, avant barriere
!$OMP SINGLE
       intbuf_tab%I_STOK(2)=i_opt_stok
       ! nowait is ok, because there is a barrier in INTTRI
!$OMP END SINGLE NOWAIT
C
Cf barrier at the end of i25optcd
      nsnf = 1 + itask*nsn / nthread
      nsnl = (itask+1)*nsn / nthread
      DO n = nsnf,nsnl 
C       release node for future impact (at next cycles)
        IF(intbuf_tab%IRTLM(4*(n-1)+3) < 0) intbuf_tab%IRTLM(4*(n-1)+3)=0
      ENDDO
C
      nsnrf = 1 + itask*nsnr / nthread
      nsnrl = (itask+1)*nsnr / nthread
      DO n=nsnrf,nsnrl
        IF(irtlm_fi(nin)%P(3,n) < 0) irtlm_fi(nin)%P(3,n)=0
      ENDDO
C
      iedge = ipari(58,nin)
      igap0 = ipari(53,nin)
      IF(iedge/=0)THEN
        nedge  = ipari(68,nin)
        drad = zero
        CALL i25optcd_edg(intbuf_tab%CANDM_E2E,intbuf_tab%CANDS_E2E,
     .                       x      ,intbuf_tab%I_STOK_E(1),intbuf_tab%IRECTM  ,
     2                    nin   ,v     ,intbuf_tab%GAPE ,igap  ,itask ,
     3                    intbuf_tab%STFM,intbuf_tab%GAP_E_L,count_remslve,drad  ,
     4                    iedge ,nedge  ,intbuf_tab%LEDGE   ,intbuf_tab%MVOISIN ,
     .                                                           intbuf_tab%NSV ,
     5                    igap0 ,intbuf_tab%STFE,
     6                    intbuf_tab%S_STFM, intbuf_tab%S_STFE,ifq,intbuf_tab%IFPEN_E,
     7     intbuf_tab%FTSAVX_E,intbuf_tab%FTSAVY_E, intbuf_tab%FTSAVZ_E,dgapload )
 
 
 
        CALL i25optcd_e2s(intbuf_tab%CANDM_E2S,intbuf_tab%CANDS_E2S,
     .                      x      ,intbuf_tab%I_STOK_E(2),intbuf_tab%IRECTM  ,
     2                    nin   ,v     ,intbuf_tab%GAP_M ,igap  ,itask ,
     3                    intbuf_tab%STFM,intbuf_tab%GAP_ML,count_remslve,drad  ,
     4                    iedge ,nedge  ,intbuf_tab%LEDGE  ,intbuf_tab%MVOISIN ,
     .                                                          intbuf_tab%NSV ,
     5                    nrtm,intbuf_tab%GAPE ,intbuf_tab%GAP_E_L ,igap0,
     6                    intbuf_tab%STFE,intbuf_tab%S_STFE,ifq,intbuf_tab%IFPEN_E2S,
     7    intbuf_tab%FTSAVX_E2S,intbuf_tab%FTSAVY_E2S, intbuf_tab%FTSAVZ_E2S,dgapload)
      END IF
 
 
C-----------------------------------------------------------------------
      RETURN