spmd_i7tool.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr18_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "impl1_c.inc"
#include "scr05_c.inc"
#include "parit_c.inc"
#include "scr17_c.inc"
#include "task_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "warn_c.inc"
#include "tabsiz_c.inc"
#include "i25edge_c.inc"
#include "spmd_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	spmd_oldnumcd (renum, oldnum, nsnr, nsnrold, intheat, idt_therm, nodadt_therm)
subroutine	spmd_rnumcd20 (cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
subroutine	spmd_rnumcd (cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
subroutine	spmd_rnumcd10 (cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
subroutine	spmd_rnum25 (renum, nin, nsn, nsnfiold, nsnrold)
subroutine	spmd_rnumcd11 (cand_n, renum, ii_stok, nin, nrts, nsnfiold, nsnrold, addcm, chaine, cand_m, nsn4, nrtm)
subroutine	spmd_fiadd_poff (output, nb, len, bufr, nsv, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, fthe, condn, h3d_data, multi_fvm, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, intcarea, fsav, parameters, nodadt_therm)
subroutine	spmd_fiadd11_poff (output, nb, len, bufr, irects, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, intth, fthe, condn, h3d_data, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, nodadt_therm)
subroutine	spmd_fiadd17_poff (output, nb, len, bufr, nelems, a, stifn, fcont, ixs, ixs16, frots, h3d_data)
subroutine	spmd_fiadd20_poff (output, nb, len, bufr, nsv, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, daanc6, fthe, nlg, alphak, h3d_data)
subroutine	spmd_fiadd20e_poff (output, nb, len, bufr, ixlins, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, daanc6, nlg, alphak, h3d_data)
subroutine	spmd_fiadd_pon (output, nb, len, bufr, nsv, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, ftheskyi, condnskyi, h3d_data, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, intcarea, fsav, parameters, nodadt_therm)
subroutine	spmd_fiadd20f_pon (output, nb, len, bufr, nsv, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, ftheskyi, nlg, h3d_data)
subroutine	spmd_fiadd11_pon (output, nb, len, bufr, irects, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, intth, ftheskyi, condnskyi, h3d_data, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, nodadt_therm)
subroutine	spmd_fiadd20fe_pon (output, nb, len, bufr, irects, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, nlg, h3d_data)
subroutine	spmd_fiadd17_pon (output, nb, len, bufr, nelems, fskyi, isky, fcont, ixs, ixs16, h3d_data)
subroutine	mpp_init (ipari, isendto, ircvfrom, intlist, nbintc, isizxv, ilenxv, iad_elem, i2size, itask, islen7, irlen7, islen11, irlen11, igrbric, nme17, islen17, irlen17, irlen7t, islen7t, lindidel, lbufidel, irlen20, islen20, irlen20t, islen20t, nbint20, irlen20e, islen20e, fr_rby, fr_rby6, npby, irbkin_l, nrbykin_l, kindrby, nsensor, sensor_tab, lbufidel24, intbuf_tab, sort_comm, need_comm_int25_solid_erosion, comm_int25_solid_erosion)
subroutine	spmd_initfi (ipari, iflag, h3d_data, parameters, idt_therm, intheat)
subroutine	spmd_savefi (ipari, iflag, intbuf_tab, nsensor, sensor_tab, parameters)
subroutine	sortint (n, isky, index)
subroutine	sorti7 (n, isky, fskyi, ftheskyi, nfskyi)
subroutine	sorti7t (n, isky, fskyi, ftheskyi, condnskyi, nfskyi)
subroutine	sorti20 (n, isky, fskyi, nfskyi)
subroutine	intcontp (n, isky, nsnfi, isizenv, nsnfitot, len)
subroutine	addcomi20 (nsnfi, nsvfi, isizenv, leni20)
subroutine	sorti11 (n, isky, fskyi, nfskyi)
subroutine	sorti11t (n, isky, fskyi, ftheskyi, nfskyi)
subroutine	sorti11tt (n, isky, fskyi, ftheskyi, condnskyi, nfskyi)
subroutine	sorti17 (n, isky, fskyi)
subroutine	putdpzero (zz, buf, iresp, inc)
subroutine	adddp (daanc6, daanc6l, len)
subroutine	conversion7 (xrem, xrem_dp, irem, siz, len)
subroutine	conversion11 (xrem, xrem_dp, irem, siz, len)
subroutine	upgrade_rem_2ry (ipari, count_remslv, count_remslve, nodadt_therm)
subroutine	getdpdaanc (daanc6, buf, iresp, inc)
subroutine	putdpdaanc (daanc6, buf, iresp, inc)

Function/Subroutine Documentation

addcomi20()

subroutine addcomi20	(	integer, dimension(*)	nsnfi,
		integer, dimension(*)	nsvfi,
		integer, dimension(2,*)	isizenv,
		integer	leni20 )

Definition at line 6298 of file spmd_i7tool.F.

C
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LENI20,
     .        NSNFI(*), NSVFI(*), ISIZENV(2,*) 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IDEB, P, N, NB
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
C      IDEB = 0
      DO p = 1, nspmd
        nb = nsnfi(p)
        isizenv(1,p) = isizenv(1,p) + nb*leni20
C always send but maybe optimistic
C        DO N = 1, NB
C          IF(NSVFI(IDEB+N)<0) THEN
C            ISIZENV(P) = ISIZENV(P) + LENI20
C          END IF
C        END DO
C        IDEB = IDEB + NB
      END DO
C
      RETURN

adddp()

subroutine adddp	(	double precision, dimension(*)	daanc6,
		double precision, dimension(*)	daanc6l,
		integer	len )

Definition at line 7129 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LEN
      double precision
     .        daanc6(*), daanc6l(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
      double precision
     .        datmp(len)       
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      DO i = 1,len
        datmp(i) = daanc6(i) + daanc6l(i)
      END DO
C 2 loops to avoid integer dp alignment problem on pgi
      DO i = 1,len
        daanc6(i) = datmp(i)
      END DO
C
      RETURN

conversion11()

subroutine conversion11	(	real*4, dimension(siz,*)	xrem,
		double precision, dimension(siz,*)	xrem_dp,
		integer, dimension(2,*)	irem,
		integer	siz,
		integer	len )

Definition at line 7204 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LEN, SIZ, IREM(2,*)
      real*4  xrem(siz,*)
      double precision
     .        xrem_dp(siz,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      DO i = 1, len
        irem(1,i) =  nint(xrem_dp(9,i))
        irem(2,i) =  nint(xrem_dp(17,i))
      END DO
      DO i = 1, len
        DO j = 1, siz
          xrem(j,i) = xrem_dp(j,i)
        END DO
      END DO
C
      RETURN

conversion7()

subroutine conversion7	(	real*4, dimension(siz,*)	xrem,
		double precision, dimension(siz,*)	xrem_dp,
		integer, dimension(1,*)	irem,
		integer	siz,
		integer	len )

Definition at line 7166 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LEN, SIZ, IREM(1,*)
      real*4  xrem(siz,*)
      double precision
     .        xrem_dp(siz,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      DO i = 1, len
        irem(1,i) =  nint(xrem_dp(10,i))
      END DO
      DO i = 1, len
        DO j = 1, siz
          xrem(j,i) = xrem_dp(j,i)
        END DO
      END DO
C
      RETURN

getdpdaanc()

subroutine getdpdaanc	(		daanc6,
			buf,
		integer	iresp,
		integer	inc )

Definition at line 7374 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRESP,INC
      my_real
     .        buf(*), daanc6(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C If double precision, we compact 18 DP values
C If simple precision, we compact 18 DP values or 36 SP
      inc = 18*(1+iresp)
      DO i = 1,inc
        daanc6(i) = buf(i)
      END DO
C
      RETURN

intcontp()

subroutine intcontp	(	integer	n,
		integer, dimension(*)	isky,
		integer, dimension(*)	nsnfi,
		integer, dimension(2,*)	isizenv,
		integer, dimension(*)	nsnfitot,
		integer	len )

Definition at line 6246 of file spmd_i7tool.F.

C
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N, LEN,
     .        NSNFI(*), ISKY(*), ISIZENV(2,*), NSNFITOT(*) 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IG, P, I, LASTIG
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
      IF(n>0)THEN
        i = 1
        p = 1
        lastig = nsnfi(p)
        DO WHILE (i <= n)
          ig = isky(i)
          IF(ig<=lastig)THEN
            isizenv(1,p) = isizenv(1,p) + len
            isizenv(2,p) = isizenv(2,p) + 1
            i = i + 1
          ELSE
            p = p + 1
            lastig = lastig+nsnfi(p)
          END IF          
        END DO
      END IF
C
      DO p = 1, nspmd
        nsnfitot(p) = nsnfitot(p) + nsnfi(p)
      END DO
C
      RETURN

mpp_init()

subroutine mpp_init	(	integer, dimension(npari,*)	ipari,
		integer, dimension(ninter+1,nspmd+1)	isendto,
		integer, dimension(ninter+1,nspmd+1)	ircvfrom,
		integer, dimension(ninter)	intlist,
		integer	nbintc,
		integer	isizxv,
		integer	ilenxv,
		integer, dimension(2,*)	iad_elem,
		integer	i2size,
		integer	itask,
		integer	islen7,
		integer	irlen7,
		integer	islen11,
		integer	irlen11,
		type (group_), dimension(ngrbric)	igrbric,
		integer	nme17,
		integer	islen17,
		integer	irlen17,
		integer	irlen7t,
		integer	islen7t,
		integer	lindidel,
		integer	lbufidel,
		integer	irlen20,
		integer	islen20,
		integer	irlen20t,
		integer	islen20t,
		integer	nbint20,
		integer	irlen20e,
		integer	islen20e,
		integer, dimension(*)	fr_rby,
		integer, dimension(*)	fr_rby6,
		integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	irbkin_l,
		integer	nrbykin_l,
		integer, dimension(*)	kindrby,
		integer, intent(in)	nsensor,
		type (sensor_str_), dimension(nsensor)	sensor_tab,
		integer	lbufidel24,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		type(sorting_comm_type), dimension(ninter), intent(inout)	sort_comm,
		logical, dimension(nspmd), intent(inout)	need_comm_int25_solid_erosion,
		integer, intent(inout)	comm_int25_solid_erosion )

Parameters

[in,out]	need_comm_int25_solid_erosion	boolean, true if the proc needs to comm some values related to interface type 25 with solid erosion
[in,out]	comm_int25_solid_erosion	integer, sub-communicator related to interface type 25 with solid erosion

Definition at line 2871 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      USE tri25ebox
      USE message_mod
      USE intbufdef_mod
      USE groupdef_mod
      USE interface_modification_mod
      USE inter_sorting_mod
      USE sensor_mod
      USE my_alloc_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      "scr17_c.inc"
#include      "scr18_c.inc"
#include      "task_c.inc"
#include      "param_c.inc"
#include      "units_c.inc"
#include      "warn_c.inc"
#include      "tabsiz_c.inc"
C common local to spmd_init and spmd_ring_mmx
       COMMON /ring/irecvf,isendt,iring
       INTEGER IRECVF,ISENDT,IRING
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN) :: NSENSOR
      INTEGER ISENDTO(NINTER+1,NSPMD+1),
     .        IRCVFROM(NINTER+1,NSPMD+1), IPARI(NPARI,*),
     .        INTLIST(NINTER), IAD_ELEM(2,*),
     .        NBINTC, ISIZXV, ILENXV, I2SIZE,ITASK,
     .        ISLEN7, IRLEN7, ISLEN11, IRLEN11, NME17, ISLEN17, IRLEN17,
     .        IRLEN7T, ISLEN7T, LINDIDEL, LBUFIDEL,
     .        IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,NBINT20,
     .        IRLEN20E, ISLEN20E, NRBYKIN_L, IRBKIN_L(*),KINDRBY(*),
     .        FR_RBY(*), FR_RBY6(*), NPBY(NNPBY,*),LBUFIDEL24
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
      TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM   ! structure for interface sorting comm
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
      LOGICAL, DIMENSION(NSPMD), INTENT(inout) :: NEED_COMM_INT25_SOLID_EROSION !< boolean, true if the proc needs to comm some values related to interface type 25 with solid erosion
      INTEGER, INTENT(inout) :: COMM_INT25_SOLID_EROSION !< integer, sub-communicator related to interface type 25 with solid erosion
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRBRIC) :: IGRBRIC
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, K, NSN, NMN, ITYP, IERROR, IERROR1, KK, NIN, P,
     .        SCPMAX1,ISD,IRC,MY_RANK,LAST, IGE, IGN, NME, NMES,INTTH,
     .        NRTM, NRTS, NLINM, NLINS,NSNE, NMNE,N,M,
     .        WORK(70000),ITY,NOINT,INACTI,ISENS,INTERACT
      INTEGER,DIMENSION(:), ALLOCATABLE:: INDX
      INTEGER,DIMENSION(:), ALLOCATABLE:: PPAR
      INTEGER,DIMENSION(:), ALLOCATABLE:: INDP
      INTEGER,DIMENSION(:), ALLOCATABLE:: NNP
      INTEGER,DIMENSION(:), ALLOCATABLE:: RANK
      INTEGER,DIMENSION(:), ALLOCATABLE:: IRBODY
      INTEGER,DIMENSION(:), ALLOCATABLE:: INDB
      INTEGER,DIMENSION(:), ALLOCATABLE:: NNSN
      my_real startt, stopt,ts
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      CALL my_alloc(indx,2*ninter)
      CALL my_alloc(ppar,ninter)
      CALL my_alloc(indp,2*nspmd)
      CALL my_alloc(nnp,nspmd)
      CALL my_alloc(rank,nspmd)
      CALL my_alloc(irbody,numnod)
      CALL my_alloc(indb,2*nrbykin)
      CALL my_alloc(nnsn,nrbykin)
C-----------------------------------------------
C
C iexicodt : flag for sending icodt during run
        iexicodt = 0
C
        lindidel = 0
        lbufidel = 0
        lbufidel24 = 0
C
        !init ISENDTO/IRCVFROM
        DO i=1,ninter+1
          DO j=1,nspmd+1
            isendto(i,j)=0
            ircvfrom(i,j)=0
          ENDDO
        ENDDO
C
        !-----------------------------------------------        
        IF(ninter/=0) THEN
C Case INACTI = 5, 6 or 7 + TSTART
         ALLOCATE(nsnfi_flag(ninter))
         nsnfi_flag(1:ninter)=0 
 
         DO i=1,ninter
           ity = ipari(7,i)
           IF(ity==7.OR.ity==10.OR.ity==11.OR.
     .        ity==17.OR.ity==20.OR.
     .        ity==22.OR.ity==23.OR.ity==24.OR.ity==25) THEN
             inacti=ipari(22,i)
             IF (inacti==5.OR.inacti==6.OR.inacti==7.OR.ity==23.OR.inacti==-1)THEN
C
              interact = 1
              isens = 0
              IF(ity == 7.OR.ity == 11.OR.ity == 24.OR.ity == 25) 
     .           isens = ipari(64,i)      
              IF (isens > 0) THEN            
                ts = sensor_tab(isens)%TSTART
                IF (ts>tt) interact = 0
              ELSE
                startt = intbuf_tab(i)%VARIABLES(3)
                stopt  = intbuf_tab(i)%VARIABLES(11)
                IF (startt>tt) interact = 0
              ENDIF
C
              IF (interact==0)THEN
                 noint =ipari(15,i)
C Printout Warning
                 IF(ispmd==0)THEN
                    CALL ancmsg(msgid=220,anmode=aninfo,
     *                     i1=noint,i2=inacti,r1=startt,r2=startt)
                 ENDIF             
              ENDIF
              IF (interact==0 .AND. ity /=25)THEN ! All but ITY == 25
                 ALLOCATE(nsnfi_sav(i)%P(nspmd))
                 ALLOCATE(nsnsi_sav(i)%P(nspmd))
                 nsnfi_sav(i)%P(1:nspmd)=nsnfi(i)%P(1:nspmd)
                 nsnfi(i)%P(1:nspmd)=0
                 nsnsi_sav(i)%P(1:nspmd)=nsnsi(i)%P(1:nspmd)
                 nsnsi(i)%P(1:nspmd)=0
 
                 nsnfi_flag(i)=1
               ENDIF
             ENDIF
           ENDIF
         ENDDO
 
C
C Alloc Idel
C
          IF(idel7ng>0)THEN
            DO i = 1, ninter
              IF(ipari(17,i)>0)THEN
                ityp = ipari(7,i)
                nrts = ipari(3,i)
                nrtm = ipari(4,i)
                nsn  = ipari(5,i)
                IF(ityp==7.OR.ityp==22.OR.
     .             ityp==10.OR.ityp==5.OR.
     .             ityp==23.OR.ityp==24.OR.
     .             ityp==25)THEN
                  lindidel = lindidel+nrtm
                  lbufidel = lbufidel+4*nrtm+4
                  IF(ityp==24.OR.ityp==25) lbufidel24 = lbufidel24 + nrtm
                ELSEIF(ityp==11)THEN 
                  lindidel = lindidel+nrtm+nrts
                  lbufidel = lbufidel+2*(nrtm+nrts)+4
                ELSEIF(ityp==3)THEN
                  lindidel = lindidel+nrtm+nrts
                  lbufidel = lbufidel+4*(nrtm+nrts)+4
                ELSEIF(ityp==2)THEN
                  lindidel = lindidel+nsn
                  lbufidel = lbufidel+4*nsn+4
                ELSEIF(ityp==20)THEN
                  lindidel = lindidel+nrtm
                  lbufidel = lbufidel+4*nrtm+4
C Edge part
                  nlins  = ipari(51,i)                                   
                  nlinm  = ipari(52,i)                                   
                  lindidel = lindidel+nlinm+nlins
                  lbufidel = lbufidel+2*(nlinm+nlins)+4
                END IF
              END IF
            END DO
          END IF
C
          nme17=0
C
          DO i=1,ninter
            ityp = ipari(7,i)
            IF (ityp==7.OR.ityp==10.OR.ityp==22.OR.
     .          ityp==11.OR.ityp==23.OR.ityp==24.OR.
     .          ityp==25) THEN
              nsn = ipari(5,i)
              nmn = ipari(6,i)               
              IF(nsn/=0) THEN
                isendto(i,ispmd+1)=nsn
                isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
                isendto(ninter+1,ispmd+1)=isendto(ninter+1,ispmd+1)+nsn
              ENDIF
              IF(nmn/=0) THEN
                ircvfrom(i,ispmd+1) = nmn
                ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
                ircvfrom(ninter+1,ispmd+1)=ircvfrom(ninter+1,ispmd+1)
     +                                    +nmn
              ENDIF
 
 
            ELSEIF(ityp==17)THEN
              IF(ipari(33,i)==0)THEN
                ign = ipari(36,i)
                ige = ipari(34,i)
                nmes= igrbric(ign)%NENTITY
                nme = igrbric(ige)%NENTITY
                nme17 = nme17+nme+nmes
                IF(nmes/=0) THEN
                  isendto(i,ispmd+1)=nmes
                  isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
                  isendto(ninter+1,ispmd+1)=isendto(ninter+1,ispmd+1)
     +                                     +nmes
                ENDIF
                IF(nme/=0) THEN
                  ircvfrom(i,ispmd+1) = nme
                  ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
                  ircvfrom(ninter+1,ispmd+1)=ircvfrom(ninter+1,ispmd+1)
     +                                      +nme
                ENDIF                
              END IF
            ELSEIF(ityp==20)THEN
              nsn  = ipari(5,i)
              nmn = ipari(6,i)  
C Edge part added             
              nsne   = ipari(55,i)                                   
              nmne   = ipari(56,i)                                   
              IF(nsn+nsne/=0) THEN
                isendto(i,ispmd+1)=nsn+nsne
                isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
                isendto(ninter+1,ispmd+1)=isendto(ninter+1,ispmd+1)
     +                                   +nsn+nsne
              ENDIF
              IF(nmn+nmne/=0) THEN
                ircvfrom(i,ispmd+1) = nmn+nmne
                ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
                ircvfrom(ninter+1,ispmd+1)=ircvfrom(ninter+1,ispmd+1)
     +                                    +nmn+nmne
              ENDIF
            ENDIF
          ENDDO
C       
          IF(nspmd > 1) THEN
            DO k = 1, nspmd
              CALL spmd_ibcast(isendto(1,k),isendto(1,k),ninter+1,1,
     .                       it_spmd(k),0)
              CALL spmd_ibcast(ircvfrom(1,k),ircvfrom(1,k),ninter+1,1,
     .                       it_spmd(k),0)
            ENDDO
          END IF
          DO i=1,ninter
            isendto(i,nspmd+1)=0
            ircvfrom(i,nspmd+1)=0
            DO k=1,nspmd
              IF(ircvfrom(i,k)/=0) THEN
                ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
              ENDIF
              IF(isendto(i,k)/=0) THEN
                isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
              ENDIF
            END DO
          END DO
        END IF !(NINTER/=0)
        !-----------------------------------------------
        
        nbintc = 0
        DO i=1,ninter
          ityp = ipari(7,i)
          IF (ityp==7.OR.ityp==10.OR.ityp==11.OR.
     .        (ityp==17.AND.ipari(33,i) == 0).OR.ityp==20.OR.
     .        ityp==22.OR.ityp==23.OR.ityp==24.OR.ityp==25) THEN
            nbintc = nbintc + 1
            intlist(nbintc) = i
            scpmax1=0
            DO j=1,nspmd
              scpmax1=max(scpmax1,ircvfrom(i,j))
            ENDDO
            ppar(nbintc)=scpmax1
          ENDIF
        ENDDO
C
        CALL my_orders(0,work,ppar,indx,nbintc,1)
        DO i=1,nbintc
          indx(i+nbintc)=intlist(i)
        ENDDO        
        DO i=1,nbintc
          intlist(i)=indx(indx(i)+nbintc)
        ENDDO
C
        IF(debug(3)>=1.AND.ispmd==0.AND.nspmd>1) THEN
          WRITE(istdo,*)'** INTERFACES NODAL DECOMPOSITION '
          WRITE(istdo,*)'#PROC  NSN TOT   NMN TOT     TOTAL'
          WRITE(iout,*)'** INTERFACES NODAL DECOMPOSITION '
          WRITE(iout,*)'#PROC  NSN TOT   NMN TOT     TOTAL'
          DO j = 1, nspmd
            isd = 0
            irc = 0
            DO i=1,ninter
              isd = isd + isendto(i,j)
              irc = irc + ircvfrom(i,j)
            ENDDO
            WRITE(istdo,'(I4,3X,I8,2X,I8,2X,I8)')j,isd,irc,isd+irc
            WRITE(iout,'(i4,3x,i8,2x,i8,2x,i8)')J,ISD,IRC,ISD+IRC
          ENDDO
        ENDIF
C
C preparation for communication in spmd_icrit
C
        DO K=1,NSPMD
          NNP(K) = IRCVFROM(NINTER+1,K) + ISENDTO(NINTER+1,K)
          INDP(K)=K
        END DO
        IF(NSPMD > 1) CALL MY_ORDERS(0,WORK,NNP,INDP,NSPMD,1)
        DO K=1,NSPMD
          RANK(INDP(K)) = K
        ENDDO
        IRECVF = 0
        ISENDT = 0
        IRING = 0
        IF(NNP(ISPMD+1)>0)THEN
          MY_RANK = RANK(ISPMD+1)
          IF(MY_RANK>1)THEN
            LAST = INDP(MY_RANK-1)
            IF(NNP(LAST)>0)THEN
              IRECVF = LAST
            END IF
          END IF
          IF(MY_RANK==NSPMD)THEN         ! LAST PROC OF THE RING
            IF(IRECVF/=0) ISENDT = -1      ! -1 : ENVOI A TS LE MONDE (SI COMM NECESSAIRE)
          ELSE ! PROCESSOR IN THE RING
            ISENDT = INDP(MY_RANK+1)
          END IF
          IF(NSPMD>1) THEN
            IF(NNP(INDP(NSPMD-1))>0)IRING= INDP(NSPMD) ! IRING = NO OF THE LAST PROCESSOR IN THE RING (OR 0 IF NO RING NECESSARY)
          END IF
        END IF
C
C length com routine SPMD_SD_XV
C
        ISIZXV = 0
        DO I = 1, NSPMD
          ISIZXV = ISIZXV + IAD_ELEM(1,I+1)-IAD_ELEM(2,I)
        ENDDO
 
        ILENXV = 10 + 3*IRODDL
C comm w
.AND.        IF(IALE/=0NINTER>0) ILENXV = ILENXV + 6
 
.OR.        IF(IDTMIN(11)==3IDTMIN(10)==3) ILENXV = ILENXV + 2
C
C length com routine exch_a_int2_pon
C
        IF(IRODDL==0) THEN
          I2SIZE = 5
        ELSE
          I2SIZE = 10
        ENDIF
C
C Comm routine length i7 xcom and i7 xcom
C
        ISLEN7 = 0
        IRLEN7 = 0
        ISLEN7T = 0
        IRLEN7T = 0        
        ISLEN11 = 0
        IRLEN11 = 0
        ISLEN17 = 0
        IRLEN17 = 0
        IRLEN20 = 0
        ISLEN20 = 0
        IRLEN20T = 0
        ISLEN20T = 0
        IRLEN20E = 0
        ISLEN20E = 0
        NBINT20  = 0
 
        IRLEN25E = 0
        ISLEN25E = 0
 
 
        DO I = 1, NBINTC
          NIN = INTLIST(I)
          ITYP = IPARI(7,NIN)
          INTTH = IPARI(47,NIN)
C type 7 or 10
.OR..OR.          IF(ITYP==7 ITYP==10
.OR..OR..OR.     .       ITYP==23ITYP==22ITYP==24
     .       ITYP==25)THEN
           IF(INTTH == 0) THEN 
             DO P = 1, NSPMD
               ISLEN7 = ISLEN7 + NSNSI(NIN)%P(P)
               IRLEN7 = IRLEN7 + NSNFI(NIN)%P(P)
             END DO
           ELSE
             DO P = 1, NSPMD
               ISLEN7T = ISLEN7T + NSNSI(NIN)%P(P)
               IRLEN7T = IRLEN7T + NSNFI(NIN)%P(P)
             END DO
           ENDIF
 
.AND.          IF(ITYP == 25  IPARI(58,NIN) >0) THEN
            ISLEN25E= SUM(NSNSIE(NIN)%P(1:NSPMD))
            IRLEN25E= SUM(NSNFIE(NIN)%P(1:NSPMD))
          ENDIF
 
          ELSEIF(ITYP==11) THEN
C type 11
             DO P = 1, NSPMD
               ISLEN11 = ISLEN11 + NSNSI(NIN)%P(P)
               IRLEN11 = IRLEN11 + NSNFI(NIN)%P(P)
             END DO
.AND.          ELSEIF(ITYP==17IPARI(33,NIN)==0)THEN
C type 17 curvature
             DO P = 1, NSPMD
               ISLEN17 = ISLEN17 + NSNSI(NIN)%P(P)
               IRLEN17 = IRLEN17 + NSNFI(NIN)%P(P)
             END DO
          ELSEIF(ITYP==20)THEN
C type 20
           NBINT20 = NBINT20 + 1
           IF(INTTH == 0) THEN 
             DO P = 1, NSPMD
               ISLEN20 = ISLEN20 + NSNSI(NIN)%P(P)
               IRLEN20 = IRLEN20 + NSNFI(NIN)%P(P)
               ISLEN20E= ISLEN20E+ NSNSIE(NIN)%P(P)
               IRLEN20E= IRLEN20E+ NSNFIE(NIN)%P(P)
             END DO
           ELSE
             DO P = 1, NSPMD
               ISLEN20T = ISLEN20T + NSNSI(NIN)%P(P)
               IRLEN20T = IRLEN20T + NSNFI(NIN)%P(P)
               ISLEN20E = ISLEN20E + NSNSIE(NIN)%P(P)
               IRLEN20E = IRLEN20E + NSNFIE(NIN)%P(P)
             END DO
           ENDIF
          END IF
        ENDDO
 
        IF(NRBYKIN > 0) THEN
C
C Tempo RBY a remonter dans starter conversion no noeud vers no rigid body
C
          DO N=1,NUMNOD
            IRBODY(N)=0
          END DO
C
          NRBYKIN_L=0
          K=1
          DO N=1,NRBYKIN
            M = NPBY(1,N)
            IF(M > 0) THEN
              IRBODY(M) = N
              NRBYKIN_L=NRBYKIN_L+1
              NNSN(NRBYKIN_L)=-NPBY(2,N)
              IRBKIN_L(NRBYKIN_L)=N
c           ELSE
c             if(NPBY(2,N) /= 0) print*,'error!!!'
            END IF  
            KINDRBY(N)=K
            K=K+NPBY(2,N)
          END DO
C
          DO N = 1, SFR_RBY
            FR_RBY6(N)=IRBODY(FR_RBY(N))
          END DO
C optimisation RBY
          CALL MY_ORDERS(0,WORK,NNSN,INDB,NRBYKIN_L,1)
c         if(ispmd==0)print*,'opt RBD:',NRBYKIN,NRBYKIN_L
          DO N = 1, NRBYKIN_L
            INDB(NRBYKIN_L+N)=IRBKIN_L(N)
          END DO
          DO N = 1, NRBYKIN_L
            IRBKIN_L(N)=INDB(NRBYKIN_L+INDB(N))
c           if(ispmd==0)print*,'>>>',N,NPBY(2,IRBKIN_L(N))
          END DO
        END IF 
        
        DO I=1,NBINTC
          INDX(I+NBINTC)=INTLIST(I)
        ENDDO        
        DO I=1,NBINTC
          INTLIST(I)=INDX(INDX(I)+NBINTC)
        ENDDO
C
C     Create Contact Communicator
C
      CALL SPMD_SPLIT_COMM(
     .  IRCVFROM(NINTER+1,ISPMD+1)+ISENDTO(NINTER+1,ISPMD+1),COMM_CONT)
 
      IF(NINTER/=0) CALL SPMD_SPLIT_COMM_INTER( INTBUF_TAB, NBINTC,INTLIST,IPARI,ISENDTO,IRCVFROM,SORT_COMM,
     .                                          NEED_COMM_INT25_SOLID_EROSION,COMM_INT25_SOLID_EROSION )
 
!     Create CJOINT communicator
      CALL SPMD_SPLIT_COMM_JOINT()
 
      DEALLOCATE(INDX)
      DEALLOCATE(PPAR)
      DEALLOCATE(INDP)
      DEALLOCATE(NNP)
      DEALLOCATE(RANK)
      DEALLOCATE(IRBODY)
      DEALLOCATE(INDB)
      DEALLOCATE(NNSN)
 
      RETURN

putdpdaanc()

subroutine putdpdaanc	(		daanc6,
			buf,
		integer	iresp,
		integer	inc )

Definition at line 7412 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRESP,INC
      my_real
     .        buf(*), daanc6(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C If double precision, we compact 18 DP values
C If simple precision, we compact 18 DP values or 36 SP
      inc = 18*(1+iresp)
      DO i = 1,inc
        buf(i) = daanc6(i)
      END DO
C
      RETURN

putdpzero()

subroutine putdpzero	(		zz,
			buf,
		integer	iresp,
		integer	inc )

Definition at line 7087 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRESP,INC
      my_real
     .        buf(*), zz(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C If double precision, we compact 18 DP values
C If simple precision, we compact 18 DP values or 36 SP
      inc = 18
      IF(iresp==0) THEN
        DO i = 1,inc
          buf(i) = zz(1)
        END DO
      ELSE
        DO i = 1, inc
          buf(2*i-1) = zz(1)
          buf(2*i)   = zz(2)
        END DO
        inc = inc + 18
      END IF
C
      RETURN

sorti11()

subroutine sorti11	(	integer	n,
		integer, dimension(*)	isky,
			fskyi,
		integer	nfskyi )

Definition at line 6342 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N, NFSKYI, ISKY(*)
      my_real
     .        fskyi(2*nfskyi,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L, IR, IIA
      my_real
     .        rra1, rra2, rra3, rra4, rra5,
     .        rra6, rra7, rra8, rra9, rra10
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C   test on n=0
      IF (n==0) RETURN
      l=n/2+1
      ir=n
      IF(nfskyi==4)THEN
10     CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          rra5=fskyi(5,l)
          rra6=fskyi(6,l)
          rra7=fskyi(7,l)
          rra8=fskyi(8,l)
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          rra5=fskyi(5,ir)
          rra6=fskyi(6,ir)
          rra7=fskyi(7,ir)
          rra8=fskyi(8,ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          fskyi(5,ir)=fskyi(5,1)
          fskyi(6,ir)=fskyi(6,1)
          fskyi(7,ir)=fskyi(7,1)
          fskyi(8,ir)=fskyi(8,1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            fskyi(5,1)=rra5
            fskyi(6,1)=rra6
            fskyi(7,1)=rra7
            fskyi(8,1)=rra8
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
20      IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            fskyi(5,i)=fskyi(5,j)
            fskyi(6,i)=fskyi(6,j)
            fskyi(7,i)=fskyi(7,j)
            fskyi(8,i)=fskyi(8,j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 20
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        fskyi(5,i)=rra5
        fskyi(6,i)=rra6
        fskyi(7,i)=rra7
        fskyi(8,i)=rra8
       GO TO 10
      ELSE
100    CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          rra5=fskyi(5,l)
          rra6=fskyi(6,l)
          rra7=fskyi(7,l)
          rra8=fskyi(8,l)
          rra9=fskyi(9,l)
          rra10=fskyi(10,l)
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          rra5=fskyi(5,ir)
          rra6=fskyi(6,ir)
          rra7=fskyi(7,ir)
          rra8=fskyi(8,ir)
          rra9=fskyi(9,ir)
          rra10=fskyi(10,ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          fskyi(5,ir)=fskyi(5,1)
          fskyi(6,ir)=fskyi(6,1)
          fskyi(7,ir)=fskyi(7,1)
          fskyi(8,ir)=fskyi(8,1)
          fskyi(9,ir)=fskyi(9,1)
          fskyi(10,ir)=fskyi(10,1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            fskyi(5,1)=rra5
            fskyi(6,1)=rra6
            fskyi(7,1)=rra7
            fskyi(8,1)=rra8
            fskyi(9,1)=rra9
            fskyi(10,1)=rra10
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
200     IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            fskyi(5,i)=fskyi(5,j)
            fskyi(6,i)=fskyi(6,j)
            fskyi(7,i)=fskyi(7,j)
            fskyi(8,i)=fskyi(8,j)
            fskyi(9,i)=fskyi(9,j)
            fskyi(10,i)=fskyi(10,j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 200
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        fskyi(5,i)=rra5
        fskyi(6,i)=rra6
        fskyi(7,i)=rra7
        fskyi(8,i)=rra8
        fskyi(9,i)=rra9
        fskyi(10,i)=rra10
       GO TO 100
      ENDIF
C
      RETURN

sorti11t()

subroutine sorti11t	(	integer	n,
		integer, dimension(*)	isky,
			fskyi,
			ftheskyi,
		integer	nfskyi )

Definition at line 6550 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N, NFSKYI, ISKY(*)
      my_real
     .        fskyi(2*nfskyi,*),ftheskyi(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L, IR, IIA
      my_real
     .        rra1, rra2, rra3, rra4, rra5,
     .        rra6, rra7, rra8, rra9, rra10, 
     .        rra11,rra12
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C   test on n=0
      IF (n==0) RETURN
      l=n/2+1
      ir=n
      IF(nfskyi==4)THEN
10     CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          rra5=fskyi(5,l)
          rra6=fskyi(6,l)
          rra7=fskyi(7,l)
          rra8=fskyi(8,l)
          rra9=ftheskyi(l)
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          rra5=fskyi(5,ir)
          rra6=fskyi(6,ir)
          rra7=fskyi(7,ir)
          rra8=fskyi(8,ir)
          rra9=ftheskyi(ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          fskyi(5,ir)=fskyi(5,1)
          fskyi(6,ir)=fskyi(6,1)
          fskyi(7,ir)=fskyi(7,1)
          fskyi(8,ir)=fskyi(8,1)
          ftheskyi(ir)=ftheskyi(1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            fskyi(5,1)=rra5
            fskyi(6,1)=rra6
            fskyi(7,1)=rra7
            fskyi(8,1)=rra8
            ftheskyi(1)=rra9
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
20      IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            fskyi(5,i)=fskyi(5,j)
            fskyi(6,i)=fskyi(6,j)
            fskyi(7,i)=fskyi(7,j)
            fskyi(8,i)=fskyi(8,j)
            ftheskyi(i)=ftheskyi(j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 20
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        fskyi(5,i)=rra5
        fskyi(6,i)=rra6
        fskyi(7,i)=rra7
        fskyi(8,i)=rra8
        ftheskyi(i)=rra9
       GO TO 10
      ELSE
100    CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          rra5=fskyi(5,l)
          rra6=fskyi(6,l)
          rra7=fskyi(7,l)
          rra8=fskyi(8,l)
          rra9=fskyi(9,l)
          rra10=fskyi(10,l)
          rra9=ftheskyi(l)
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          rra5=fskyi(5,ir)
          rra6=fskyi(6,ir)
          rra7=fskyi(7,ir)
          rra8=fskyi(8,ir)
          rra9=fskyi(9,ir)
          rra10=fskyi(10,ir)
          rra11=ftheskyi(ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          fskyi(5,ir)=fskyi(5,1)
          fskyi(6,ir)=fskyi(6,1)
          fskyi(7,ir)=fskyi(7,1)
          fskyi(8,ir)=fskyi(8,1)
          fskyi(9,ir)=fskyi(9,1)
          fskyi(10,ir)=fskyi(10,1)
          ftheskyi(ir)=ftheskyi(1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            fskyi(5,1)=rra5
            fskyi(6,1)=rra6
            fskyi(7,1)=rra7
            fskyi(8,1)=rra8
            fskyi(9,1)=rra9
            fskyi(10,1)=rra10
            ftheskyi(1)=rra11
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
200     IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            fskyi(5,i)=fskyi(5,j)
            fskyi(6,i)=fskyi(6,j)
            fskyi(7,i)=fskyi(7,j)
            fskyi(8,i)=fskyi(8,j)
            fskyi(9,i)=fskyi(9,j)
            fskyi(10,i)=fskyi(10,j)
            ftheskyi(i)=ftheskyi(j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 200
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        fskyi(5,i)=rra5
        fskyi(6,i)=rra6
        fskyi(7,i)=rra7
        fskyi(8,i)=rra8
        fskyi(9,i)=rra9
        fskyi(10,i)=rra10
        ftheskyi(i)=rra11
       GO TO 100
      ENDIF
C
      RETURN

sorti11tt()

subroutine sorti11tt	(	integer	n,
		integer, dimension(*)	isky,
			fskyi,
			ftheskyi,
			condnskyi,
		integer	nfskyi )

Definition at line 6771 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N, NFSKYI, ISKY(*)
      my_real
     .        fskyi(2*nfskyi,*),ftheskyi(*),condnskyi(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L, IR, IIA
      my_real
     .        rra1, rra2, rra3, rra4, rra5,
     .        rra6, rra7, rra8, rra9, rra10, 
     .        rra11,rra12
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C   test on n=0
      IF (n==0) RETURN
      l=n/2+1
      ir=n
      IF(nfskyi==4)THEN
10     CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          rra5=fskyi(5,l)
          rra6=fskyi(6,l)
          rra7=fskyi(7,l)
          rra8=fskyi(8,l)
          rra9=ftheskyi(l)
          rra10=condnskyi(l)
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          rra5=fskyi(5,ir)
          rra6=fskyi(6,ir)
          rra7=fskyi(7,ir)
          rra8=fskyi(8,ir)
          rra9=ftheskyi(ir)
          rra10=condnskyi(ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          fskyi(5,ir)=fskyi(5,1)
          fskyi(6,ir)=fskyi(6,1)
          fskyi(7,ir)=fskyi(7,1)
          fskyi(8,ir)=fskyi(8,1)
          ftheskyi(ir)=ftheskyi(1)
          condnskyi(ir)=condnskyi(1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            fskyi(5,1)=rra5
            fskyi(6,1)=rra6
            fskyi(7,1)=rra7
            fskyi(8,1)=rra8
            ftheskyi(1)=rra9
            condnskyi(1)=rra10
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
20      IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            fskyi(5,i)=fskyi(5,j)
            fskyi(6,i)=fskyi(6,j)
            fskyi(7,i)=fskyi(7,j)
            fskyi(8,i)=fskyi(8,j)
            ftheskyi(i)=ftheskyi(j)
            condnskyi(i)=condnskyi(j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 20
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        fskyi(5,i)=rra5
        fskyi(6,i)=rra6
        fskyi(7,i)=rra7
        fskyi(8,i)=rra8
        ftheskyi(i)=rra9
        condnskyi(i)=rra10
       GO TO 10
      ELSE
100    CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          rra5=fskyi(5,l)
          rra6=fskyi(6,l)
          rra7=fskyi(7,l)
          rra8=fskyi(8,l)
          rra9=fskyi(9,l)
          rra10=fskyi(10,l)
          rra9=ftheskyi(l)
          rra10=condnskyi(l)
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          rra5=fskyi(5,ir)
          rra6=fskyi(6,ir)
          rra7=fskyi(7,ir)
          rra8=fskyi(8,ir)
          rra9=fskyi(9,ir)
          rra10=fskyi(10,ir)
          rra11=ftheskyi(ir)
          rra12=condnskyi(ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          fskyi(5,ir)=fskyi(5,1)
          fskyi(6,ir)=fskyi(6,1)
          fskyi(7,ir)=fskyi(7,1)
          fskyi(8,ir)=fskyi(8,1)
          fskyi(9,ir)=fskyi(9,1)
          fskyi(10,ir)=fskyi(10,1)
          ftheskyi(ir)=ftheskyi(1)
          condnskyi(ir)=condnskyi(1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            fskyi(5,1)=rra5
            fskyi(6,1)=rra6
            fskyi(7,1)=rra7
            fskyi(8,1)=rra8
            fskyi(9,1)=rra9
            fskyi(10,1)=rra10
            ftheskyi(1)=rra11
            condnskyi(1)=rra12
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
200     IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            fskyi(5,i)=fskyi(5,j)
            fskyi(6,i)=fskyi(6,j)
            fskyi(7,i)=fskyi(7,j)
            fskyi(8,i)=fskyi(8,j)
            fskyi(9,i)=fskyi(9,j)
            fskyi(10,i)=fskyi(10,j)
            ftheskyi(i)=ftheskyi(j)
            condnskyi(i)=condnskyi(j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 200
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        fskyi(5,i)=rra5
        fskyi(6,i)=rra6
        fskyi(7,i)=rra7
        fskyi(8,i)=rra8
        fskyi(9,i)=rra9
        fskyi(10,i)=rra10
        ftheskyi(i)=rra11
        condnskyi(i)=rra12
       GO TO 100
      ENDIF
C
      RETURN

sorti17()

subroutine sorti17	(	integer	n,
		integer, dimension(*)	isky,
			fskyi )

Definition at line 7004 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N, NFSKYI, ISKY(*)
      my_real
     .        fskyi(40,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L, IR, IIA, II
      my_real
     .        rra(40)
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      IF (n==0) RETURN
      l=n/2+1
      ir=n
10    CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          DO ii = 1, 40
            rra(ii)=fskyi(ii,l)
          END DO
        ELSE
          iia =isky(ir)
          DO ii = 1, 40
            rra(ii)=fskyi(ii,ir)
          END DO
          isky(ir)=isky(1)
          DO ii = 1, 40
            fskyi(ii,ir)=fskyi(ii,1)
          END DO
          ir=ir-1
          IF(ir<=1)THEN
            isky(1)=iia
            DO ii = 1, 40
              fskyi(ii,1)=rra(ii)
            END DO
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
20      IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            DO ii = 1, 40
              fskyi(ii,i)=fskyi(ii,j)
            END DO
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 20
        ENDIF
        isky(i)=iia
        DO ii = 1, 40
          fskyi(ii,i)=rra(ii)
        END DO
      GO TO 10
C
      RETURN

sorti20()

subroutine sorti20	(	integer	n,
		integer, dimension(*)	isky,
			fskyi,
		integer	nfskyi )

Definition at line 6091 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N, NFSKYI, ISKY(*)
      my_real
     .        fskyi(nfskyi,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L, IR, IIA
      my_real
     .        rra1, rra2, rra3, rra4, rra5
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C   test on n=0
      IF (n==0) RETURN
      l=n/2+1
      ir=n
      IF(nfskyi==4)THEN
10     CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
20      IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 20
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
       GO TO 10
      ELSE
100    CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          rra5=fskyi(5,l)
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          rra5=fskyi(5,ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          fskyi(5,ir)=fskyi(5,1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            fskyi(5,1)=rra5
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
200     IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            fskyi(5,i)=fskyi(5,j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 200
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        fskyi(5,i)=rra5
       GO TO 100
      ENDIF
C
      RETURN

sorti7()

subroutine sorti7	(	integer	n,
		integer, dimension(*)	isky,
			fskyi,
			ftheskyi,
		integer	nfskyi )

Definition at line 5754 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N, NFSKYI, ISKY(*)
      my_real
     .        fskyi(nfskyi,*),ftheskyi(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L, IR, IIA
      my_real
     .        rra1, rra2, rra3, rra4, rra5,ppa
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C   test on n=0
      IF (n==0) RETURN
      l=n/2+1
      ir=n
      IF(nfskyi==4)THEN
10     CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          ppa =ftheskyi(l)  
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          ppa =ftheskyi(ir)  
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          ftheskyi(ir)=ftheskyi(1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            ftheskyi(1)=ppa
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
20      IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            ftheskyi(i)=ftheskyi(j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 20
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        ftheskyi(i)=ppa
       GO TO 10
      ELSE
100    CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          rra5=fskyi(5,l)
          ppa =ftheskyi(l)
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          rra5=fskyi(5,ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          fskyi(5,ir)=fskyi(5,1)
          ftheskyi(ir)=ftheskyi(1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            fskyi(5,1)=rra5
            ftheskyi(1)=ppa
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
200     IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            fskyi(5,i)=fskyi(5,j)
            ftheskyi(i)=ftheskyi(j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 200
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        fskyi(5,i)=rra5
        ftheskyi(i)=ppa
       GO TO 100
      ENDIF
C
      RETURN

sorti7t()

subroutine sorti7t	(	integer	n,
		integer, dimension(*)	isky,
			fskyi,
			ftheskyi,
			condnskyi,
		integer	nfskyi )

Definition at line 5916 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N, NFSKYI, ISKY(*)
      my_real
     .        fskyi(nfskyi,*),ftheskyi(*),condnskyi(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L, IR, IIA
      my_real
     .        rra1, rra2, rra3, rra4, rra5,ppa,kka
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C   test on n=0
      IF (n==0) RETURN
      l=n/2+1
      ir=n
      IF(nfskyi==4)THEN
10     CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          ppa =ftheskyi(l)  
          kka =condnskyi(l) 
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          ppa =ftheskyi(ir)  
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          ftheskyi(ir)=ftheskyi(1)
          condnskyi(ir)=condnskyi(1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            ftheskyi(1)=ppa
            condnskyi(1)=kka
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
20      IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            ftheskyi(i)=ftheskyi(j)
            condnskyi(i)=condnskyi(j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 20
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        ftheskyi(i)=ppa
        condnskyi(i)=kka
       GO TO 10
      ELSE
100    CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          rra1=fskyi(1,l)
          rra2=fskyi(2,l)
          rra3=fskyi(3,l)
          rra4=fskyi(4,l)
          rra5=fskyi(5,l)
          ppa =ftheskyi(l)
          kka =condnskyi(l)   
        ELSE
          iia =isky(ir)
          rra1=fskyi(1,ir)
          rra2=fskyi(2,ir)
          rra3=fskyi(3,ir)
          rra4=fskyi(4,ir)
          rra5=fskyi(5,ir)
          isky(ir)=isky(1)
          fskyi(1,ir)=fskyi(1,1)
          fskyi(2,ir)=fskyi(2,1)
          fskyi(3,ir)=fskyi(3,1)
          fskyi(4,ir)=fskyi(4,1)
          fskyi(5,ir)=fskyi(5,1)
          ftheskyi(ir)=ftheskyi(1)
          condnskyi(ir)=condnskyi(1)
          ir=ir-1
C         IF(IR==1)THEN
          IF(ir<=1)THEN
            isky(1)=iia
            fskyi(1,1)=rra1
            fskyi(2,1)=rra2
            fskyi(3,1)=rra3
            fskyi(4,1)=rra4
            fskyi(5,1)=rra5
            ftheskyi(1)=ppa
            condnskyi(1)=ppa
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
200     IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            fskyi(1,i)=fskyi(1,j)
            fskyi(2,i)=fskyi(2,j)
            fskyi(3,i)=fskyi(3,j)
            fskyi(4,i)=fskyi(4,j)
            fskyi(5,i)=fskyi(5,j)
            ftheskyi(i)=ftheskyi(j)
            condnskyi(i)=condnskyi(j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 200
        ENDIF
        isky(i)=iia
        fskyi(1,i)=rra1
        fskyi(2,i)=rra2
        fskyi(3,i)=rra3
        fskyi(4,i)=rra4
        fskyi(5,i)=rra5
        ftheskyi(i)=ppa
        condnskyi(i)=ppa
       GO TO 100
      ENDIF
C
      RETURN

sortint()

subroutine sortint	(	integer	n,
		integer, dimension(*)	isky,
		integer, dimension(*)	index )

Definition at line 5684 of file spmd_i7tool.F.

C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N, ISKY(*),INDEX(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L, IR, IIA,IIA2
      my_real
     .        rra1, rra2, rra3, rra4, rra5,ppa
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C   test on n=0
      IF (n==0) RETURN
      l=n/2+1
      ir=n
 
10     CONTINUE
        IF(l>1)THEN
          l=l-1
          iia =isky(l)
          iia2=index(l)
        ELSE
          iia =isky(ir)
          iia2=index(ir)
 
          isky(ir)=isky(1)
          index(ir)=index(1)
          
          ir=ir-1
 
          IF(ir<=1)THEN
            isky(1)=iia
            index(1)=iia2
            RETURN
          ENDIF
        ENDIF
        i=l
        j=l+l
20      IF(j<=ir)THEN
          IF(j<ir)THEN
            IF(isky(j)<isky(j+1))j=j+1
          ENDIF
          IF(iia<isky(j))THEN
            isky(i)=isky(j)
            index(i)=index(j)
            i=j
            j=j+j
          ELSE
            j=ir+1
          ENDIF
        GO TO 20
        ENDIF
        isky(i)=iia
        index(i)=iia2
       GO TO 10
C
      RETURN

spmd_fiadd11_poff()

subroutine spmd_fiadd11_poff	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(2,*)	irects,
			a,
			stifn,
			viscn,
		integer	ibc,
		integer	isecin,
		integer	noint,
		integer	ibag,
		integer, dimension(*)	icodt,
			secfcum,
		integer, dimension(*)	nstrf,
		integer, dimension(*)	icontact,
			fcont,
		integer	intth,
			fthe,
			condn,
		type(h3d_database)	h3d_data,
		integer, dimension(nloadp_hyd_inter,*)	tagncont,
		integer, dimension(*)	kloadpinter,
		integer, dimension(*)	loadpinter,
		integer, dimension(*)	loadp_hyd_inter,
		integer, intent(in)	nodadt_therm )

Definition at line 678 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE h3d_mod
      USE output_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      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "scr18_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(OUTPUT_), intent(inout) :: OUTPUT
      INTEGER NB, LEN, IBC  ,ISECIN  ,IBAG , NOINT,INTTH,
     .        IRECTS(2,*), ICODT(*), NSTRF(*),ICONTACT(*),
     .        TAGNCONT(NLOADP_HYD_INTER,*),
     .        KLOADPINTER(*),LOADPINTER(*),LOADP_HYD_INTER(*)
      INTEGER, INTENT(IN) :: NODADT_THERM
      my_real
     .        bufr(len,*), a(3,*), stifn(*), viscn(*),
     .        secfcum(7,numnod,nsect),
     .        fcont(3,*),fthe(*),condn(*)
      TYPE(H3D_DATABASE) :: H3D_DATA
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL,NOD1,NOD2,NP
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      IF(intth == 0) THEN
       IF(kdtint==0)THEN
        DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)          
          nod = irects(2,n)
          a(1,nod)   = a(1,nod) + bufr(6,i)
          a(2,nod)   = a(2,nod) + bufr(7,i)
          a(3,nod)   = a(3,nod) + bufr(8,i)
          stifn(nod) = stifn(nod) + bufr(9,i)          
        ENDDO
       ELSE
        DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)          
          viscn(nod) = viscn(nod) + bufr(6,i)          
          nod = irects(2,n)
          a(1,nod)   = a(1,nod) + bufr(7,i)
          a(2,nod)   = a(2,nod) + bufr(8,i)
          a(3,nod)   = a(3,nod) + bufr(9,i)
          stifn(nod) = stifn(nod) + bufr(10,i)          
          viscn(nod) = viscn(nod) + bufr(11,i)          
        ENDDO
       ENDIF
      ELSE
       IF(nodadt_therm ==1 )THEN
        IF(kdtint==0)THEN
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)   
          fthe(nod)  = fthe(nod) + bufr(6,i)     
          condn(nod) = condn(nod) + bufr(7,i)                   
          nod = irects(2,n)
          a(1,nod)   = a(1,nod) + bufr(8,i)
          a(2,nod)   = a(2,nod) + bufr(9,i)
          a(3,nod)   = a(3,nod) + bufr(10,i)
          stifn(nod) = stifn(nod) + bufr(11,i)  
          fthe(nod) = fthe(nod) + bufr(12,i)  
          condn(nod) = condn(nod) + bufr(13,i)                                    
         ENDDO
        ELSE
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)          
          viscn(nod) = viscn(nod) + bufr(6,i)
          fthe(nod) = fthe(nod) + bufr(7,i)  
          condn(nod) = condn(nod) + bufr(8,i)                                          
          nod = irects(2,n)
          a(1,nod)   = a(1,nod) + bufr(9,i)
          a(2,nod)   = a(2,nod) + bufr(10,i)
          a(3,nod)   = a(3,nod) + bufr(11,i)
          stifn(nod) = stifn(nod) + bufr(12,i)          
          viscn(nod) = viscn(nod) + bufr(13,i)  
          fthe(nod) = fthe(nod) + bufr(14,i)  
          condn(nod) = condn(nod) + bufr(15,i)                                          
         ENDDO
        ENDIF
       ELSE
        IF(kdtint==0)THEN
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)   
          fthe(nod)  = fthe(nod) + bufr(6,i)            
          nod = irects(2,n)
          a(1,nod)   = a(1,nod) + bufr(7,i)
          a(2,nod)   = a(2,nod) + bufr(8,i)
          a(3,nod)   = a(3,nod) + bufr(9,i)
          stifn(nod) = stifn(nod) + bufr(10,i)  
          fthe(nod)  = fthe(nod) + bufr(11,i)                   
         ENDDO
        ELSE
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)          
          viscn(nod) = viscn(nod) + bufr(6,i)
          fthe(nod)  = fthe(nod) + bufr(7,i)                           
          nod = irects(2,n)
          a(1,nod)   = a(1,nod) + bufr(8,i)
          a(2,nod)   = a(2,nod) + bufr(9,i)
          a(3,nod)   = a(3,nod) + bufr(10,i)
          stifn(nod) = stifn(nod) + bufr(11,i)          
          viscn(nod) = viscn(nod) + bufr(12,i)  
          fthe(nod)  = fthe(nod) + bufr(13,i)                           
         ENDDO
        ENDIF
       ENDIF
      ENDIF
C
C continue i11for3 processing on secondary node
C
      IF(inconv == 1) THEN
       IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .   ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .   (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .   .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C Anim FCONT
         IF(kdtint==0)THEN
          DO i = 1, nb
           n = nint(bufr(1,i))
           nod = irects(1,n)
           fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
           fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
           fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
           nod = irects(2,n)
           fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
           fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
           fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
          END DO
         ELSE
          DO i = 1, nb
           n = nint(bufr(1,i))
           nod = irects(1,n)
           fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
           fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
           fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
           nod = irects(2,n)
           fcont(1,nod)=fcont(1,nod)+ bufr(7,i)
           fcont(2,nod)=fcont(2,nod)+ bufr(8,i)
           fcont(3,nod)=fcont(3,nod)+ bufr(9,i)
          END DO
         END IF
       END IF
      END IF
C------------For /LOAD/PRESSURE tag nodes in contact-------------
      IF(nintloadp > 0) THEN
         DO i = 1, nb
            n = nint(bufr(1,i))
            nod1 = irects(1,n)
            nod2 = irects(2,n)
            DO np = kloadpinter(noint)+1, kloadpinter(noint+1) 
               pp = loadpinter(np)
               ppl = loadp_hyd_inter(pp)
               tagncont(ppl,nod1) = 1
               tagncont(ppl,nod2) = 1
            ENDDO
         ENDDO
      ENDIF
C
      IF(isecin>0)THEN
C Sections
        k0=nstrf(25)
        IF(nstrf(1)+nstrf(2)/=0)THEN
          DO i=1,nsect
           nbinter=nstrf(k0+14)
           k1s=k0+30
           DO j=1,nbinter
            IF(nstrf(k1s)==noint)THEN
              IF(isecut/=0)THEN
               IF(kdtint==0)THEN
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  nod = irects(1,n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                  ENDIF
                  nod = irects(2,n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(6,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(7,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(8,ii)
                  ENDIF
                ENDDO
               ELSE
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  nod = irects(1,n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                  ENDIF
                  nod = irects(2,n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
                  ENDIF
                ENDDO
               END IF
              ENDIF
            ENDIF
            k1s=k1s+1
           ENDDO
           k0=nstrf(k0+24)
          ENDDO
        ENDIF
      ENDIF
C
      IF ((ibag/=0).OR.(idamp_rdof/=0)) THEN
C Airbags IBAG
       IF(kdtint==0)THEN
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
           n = nint(bufr(1,i))
           nod = irects(1,n)
           icontact(nod)=1
          END IF
          IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
     +       bufr(8,i)/=zero) THEN
           nod = irects(2,n)
           icontact(nod)=1
          END IF
        END DO
       ELSE
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
           n = nint(bufr(1,i))
           nod = irects(1,n)
           icontact(nod)=1
          END IF
          IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
     +       bufr(9,i)/=zero) THEN
           nod = irects(2,n)
           icontact(nod)=1
          END IF
        END DO
       END IF
      END IF
C
      RETURN

spmd_fiadd11_pon()

subroutine spmd_fiadd11_pon	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(2,*)	irects,
			fskyi,
		integer, dimension(*)	isky,
		integer	ibc,
		integer	isecin,
		integer	noint,
		integer	ibag,
		integer, dimension(*)	icodt,
			secfcum,
		integer, dimension(*)	nstrf,
		integer, dimension(*)	icontact,
			fcont,
		integer	intth,
			ftheskyi,
			condnskyi,
		type(h3d_database)	h3d_data,
		integer	nin,
		integer, dimension(nloadp_hyd_inter,*)	tagncont,
		integer, dimension(*)	kloadpinter,
		integer, dimension(*)	loadpinter,
		integer, dimension(*)	loadp_hyd_inter,
		integer, intent(in)	nodadt_therm )

Definition at line 2200 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE h3d_mod
      USE output_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      "parit_c.inc"
#include      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "scr18_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(output_), intent(inout) :: OUTPUT
      INTEGER NB, LEN, IBC  ,ISECIN  ,IBAG , NOINT,INTTH,NIN,
     .        IRECTS(2,*), ISKY(*), ICODT(*), NSTRF(*),
     .        ICONTACT(*), 
     .        TAGNCONT(NLOADP_HYD_INTER,*),KLOADPINTER(*),LOADPINTER(*),
     .        LOADP_HYD_INTER(*)
      INTEGER, INTENT(IN) :: NODADT_THERM
      my_real
     .        bufr(len,*),
     .        fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
     .        fcont(3,*),ftheskyi(*),condnskyi(*)
      TYPE(H3D_DATABASE) :: H3D_DATA
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL,NOD1,NOD2,NP 
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      IF ((nisky+nb)> lskyi)THEN
           CALL ancmsg(msgid=26,anmode=aninfo)
           CALL arret(2)
      ENDIF
 
      IF(intth == 0 ) THEN
       IF(kdtint==0)THEN
        DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          isky(nisky) = nod
          nod = irects(2,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(6,i)
          fskyi(nisky,2)=bufr(7,i)
          fskyi(nisky,3)=bufr(8,i)
          fskyi(nisky,4)=bufr(9,i)
          isky(nisky) = nod
        ENDDO
       ELSE
        DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          fskyi(nisky,5)=bufr(6,i)
          isky(nisky) = nod
          nod = irects(2,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(7,i)
          fskyi(nisky,2)=bufr(8,i)
          fskyi(nisky,3)=bufr(9,i)
          fskyi(nisky,4)=bufr(10,i)
          fskyi(nisky,5)=bufr(11,i)
          isky(nisky) = nod
        ENDDO
       ENDIF
      ELSE
       IF(nodadt_therm == 1) THEN ! Thermal Time Step
        IF(kdtint==0)THEN
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          ftheskyi(nisky) =bufr(10,i)
          condnskyi(nisky)=bufr(12,i)
          isky(nisky) = nod
          nod = irects(2,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(6,i)
          fskyi(nisky,2)=bufr(7,i)
          fskyi(nisky,3)=bufr(8,i)
          fskyi(nisky,4)=bufr(9,i)
          ftheskyi(nisky) =bufr(11,i)
          condnskyi(nisky)=bufr(13,i)
          isky(nisky) = nod
         ENDDO
        ELSE
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          fskyi(nisky,5)=bufr(6,i)
          ftheskyi(nisky) =bufr(12,i)
          condnskyi(nisky)=bufr(13,i)
          isky(nisky) = nod
          nod = irects(2,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(7,i)
          fskyi(nisky,2)=bufr(8,i)
          fskyi(nisky,3)=bufr(9,i)
          fskyi(nisky,4)=bufr(10,i)
          fskyi(nisky,5)=bufr(11,i)
          ftheskyi(nisky) =bufr(13,i)
          condnskyi(nisky)=bufr(14,i)
          isky(nisky) = nod
         ENDDO
        ENDIF
       ELSE
        IF(kdtint==0)THEN
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          ftheskyi(nisky) =bufr(10,i)
          isky(nisky) = nod
          nod = irects(2,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(6,i)
          fskyi(nisky,2)=bufr(7,i)
          fskyi(nisky,3)=bufr(8,i)
          fskyi(nisky,4)=bufr(9,i)
          ftheskyi(nisky) =bufr(11,i)
          isky(nisky) = nod
         ENDDO
        ELSE
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          fskyi(nisky,5)=bufr(6,i)
          ftheskyi(nisky) =bufr(12,i)
          isky(nisky) = nod
          nod = irects(2,n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(7,i)
          fskyi(nisky,2)=bufr(8,i)
          fskyi(nisky,3)=bufr(9,i)
          fskyi(nisky,4)=bufr(10,i)
          fskyi(nisky,5)=bufr(11,i)
          ftheskyi(nisky) =bufr(13,i)
          isky(nisky) = nod
         ENDDO
        ENDIF
       ENDIF
      ENDIF
C
C continue i11for3 processing on secondary node
C
      IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .   ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .   (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .   .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C Anim FCONT
        IF(kdtint==0)THEN
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
          nod = irects(2,n)
          fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
         END DO
        ELSE
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = irects(1,n)
          fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
          nod = irects(2,n)
          fcont(1,nod)=fcont(1,nod)+ bufr(7,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(8,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(9,i)
         END DO
        END IF
      END IF
C
C------------For /LOAD/PRESSURE tag nodes in contact-------------
      IF(nintloadp > 0) THEN
         DO i = 1, nb
            n = nint(bufr(1,i))
            nod1 = irects(1,n)
            nod2 = irects(2,n)
            DO np = kloadpinter(nin)+1, kloadpinter(nin+1)
               pp = loadpinter(np) 
               ppl = loadp_hyd_inter(pp)
               tagncont(ppl,nod1) = 1
               tagncont(ppl,nod2) = 1
            ENDDO
         ENDDO
      ENDIF
C
      IF(isecin>0)THEN
C Sections
        k0=nstrf(25)
        IF(nstrf(1)+nstrf(2)/=0)THEN
          DO i=1,nsect
           nbinter=nstrf(k0+14)
           k1s=k0+30
           DO j=1,nbinter
            IF(nstrf(k1s)==noint)THEN
              IF(isecut/=0)THEN
               IF(kdtint==0)THEN
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  nod = irects(1,n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                  ENDIF
                  nod = irects(2,n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(6,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(7,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(8,ii)
                  ENDIF
                ENDDO
               ELSE
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  nod = irects(1,n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                  ENDIF
                  nod = irects(2,n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
                  ENDIF
                ENDDO
               END IF
              ENDIF
            ENDIF
            k1s=k1s+1
           ENDDO
           k0=nstrf(k0+24)
          ENDDO
        ENDIF
      ENDIF
C
      IF((ibag/=0).OR.(idamp_rdof/=0))THEN
C Airbags IBAG
       IF(kdtint==0)THEN
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
           n = nint(bufr(1,i))
           nod = irects(1,n)
           icontact(nod)=1
          END IF
          IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
     +       bufr(8,i)/=zero) THEN
           nod = irects(2,n)
           icontact(nod)=1
          END IF
        END DO
       ELSE
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
           n = nint(bufr(1,i))
           nod = irects(1,n)
           icontact(nod)=1
          END IF
          IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
     +       bufr(9,i)/=zero) THEN
           nod = irects(2,n)
           icontact(nod)=1
          END IF
        END DO
       END IF
      END IF
C
      RETURN

spmd_fiadd17_poff()

subroutine spmd_fiadd17_poff	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(*)	nelems,
			a,
			stifn,
			fcont,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(8,*)	ixs16,
			frots,
		type(h3d_database)	h3d_data )

Definition at line 985 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE h3d_mod
      USE output_mod
      use element_mod , only :nixs
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      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(OUTPUT_), intent(inout) :: OUTPUT
      INTEGER NB, LEN, NN,
     .        NELEMS(*), IXS(NIXS,*)  ,IXS16(8,*)
      my_real
     .        bufr(len,*), a(3,*), stifn(*),
     .        fcont(3,*), frots(7,*)
      TYPE(H3D_DATABASE) :: H3D_DATA
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, NOD, NE 
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
        DO i = 1, nb
          nn = nint(bufr(1,i))
          ne = nelems(nn)
C          
          nod = ixs(2,ne)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)          
          nod = ixs(3,ne)
          a(1,nod)   = a(1,nod) + bufr(6,i)
          a(2,nod)   = a(2,nod) + bufr(7,i)
          a(3,nod)   = a(3,nod) + bufr(8,i)
          stifn(nod) = stifn(nod) + bufr(9,i)          
          nod = ixs(4,ne)
          a(1,nod)   = a(1,nod) + bufr(10,i)
          a(2,nod)   = a(2,nod) + bufr(11,i)
          a(3,nod)   = a(3,nod) + bufr(12,i)
          stifn(nod) = stifn(nod) + bufr(13,i)         
          nod = ixs(5,ne)
          a(1,nod)   = a(1,nod) + bufr(14,i)
          a(2,nod)   = a(2,nod) + bufr(15,i)
          a(3,nod)   = a(3,nod) + bufr(16,i)
          stifn(nod) = stifn(nod) + bufr(17,i)         
          nod = ixs(6,ne)
          a(1,nod)   = a(1,nod) + bufr(18,i)
          a(2,nod)   = a(2,nod) + bufr(19,i)
          a(3,nod)   = a(3,nod) + bufr(20,i)
          stifn(nod) = stifn(nod) + bufr(21,i)         
          nod = ixs(7,ne)
          a(1,nod)   = a(1,nod) + bufr(22,i)
          a(2,nod)   = a(2,nod) + bufr(23,i)
          a(3,nod)   = a(3,nod) + bufr(24,i)
          stifn(nod) = stifn(nod) + bufr(25,i)         
          nod = ixs(8,ne)
          a(1,nod)   = a(1,nod) + bufr(26,i)
          a(2,nod)   = a(2,nod) + bufr(27,i)
          a(3,nod)   = a(3,nod) + bufr(28,i)
          stifn(nod) = stifn(nod) + bufr(29,i)
          nod = ixs(9,ne)
          a(1,nod)   = a(1,nod) + bufr(30,i)
          a(2,nod)   = a(2,nod) + bufr(31,i)
          a(3,nod)   = a(3,nod) + bufr(32,i)
          stifn(nod) = stifn(nod) + bufr(33,i)
C
          nod = ixs16(1,ne)
          a(1,nod)   = a(1,nod) + bufr(34,i)
          a(2,nod)   = a(2,nod) + bufr(35,i)
          a(3,nod)   = a(3,nod) + bufr(36,i)
          stifn(nod) = stifn(nod) + bufr(37,i)         
          nod = ixs16(2,ne)
          a(1,nod)   = a(1,nod) + bufr(38,i)
          a(2,nod)   = a(2,nod) + bufr(39,i)
          a(3,nod)   = a(3,nod) + bufr(40,i)
          stifn(nod) = stifn(nod) + bufr(41,i)         
          nod = ixs16(3,ne)
          a(1,nod)   = a(1,nod) + bufr(42,i)
          a(2,nod)   = a(2,nod) + bufr(43,i)
          a(3,nod)   = a(3,nod) + bufr(44,i)
          stifn(nod) = stifn(nod) + bufr(45,i)         
          nod = ixs16(4,ne)
          a(1,nod)   = a(1,nod) + bufr(46,i)
          a(2,nod)   = a(2,nod) + bufr(47,i)
          a(3,nod)   = a(3,nod) + bufr(48,i)
          stifn(nod) = stifn(nod) + bufr(49,i)         
          nod = ixs16(5,ne)
          a(1,nod)   = a(1,nod) + bufr(50,i)
          a(2,nod)   = a(2,nod) + bufr(51,i)
          a(3,nod)   = a(3,nod) + bufr(52,i)
          stifn(nod) = stifn(nod) + bufr(53,i)         
          nod = ixs16(6,ne)
          a(1,nod)   = a(1,nod) + bufr(54,i)
          a(2,nod)   = a(2,nod) + bufr(55,i)
          a(3,nod)   = a(3,nod) + bufr(56,i)
          stifn(nod) = stifn(nod) + bufr(57,i)         
          nod = ixs16(7,ne)
          a(1,nod)   = a(1,nod) + bufr(58,i)
          a(2,nod)   = a(2,nod) + bufr(59,i)
          a(3,nod)   = a(3,nod) + bufr(60,i)
          stifn(nod) = stifn(nod) + bufr(61,i)         
          nod = ixs16(8,ne)
          a(1,nod)   = a(1,nod) + bufr(62,i)
          a(2,nod)   = a(2,nod) + bufr(63,i)
          a(3,nod)   = a(3,nod) + bufr(64,i)
          stifn(nod) = stifn(nod) + bufr(65,i)
C
          frots(1,nn) = frots(1,nn) + bufr(66,i)                       
          frots(2,nn) = frots(2,nn) + bufr(67,i)                       
          frots(3,nn) = frots(3,nn) + bufr(68,i)                       
          frots(4,nn) = frots(4,nn) + bufr(69,i)                       
        ENDDO
C
C continue i11for3 processing on secondary node
C
      IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .   ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .   (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .   .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C Anim FCONT
        DO i = 1, nb
          ne = nint(bufr(1,i))
C          
          nod = ixs(2,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
          nod = ixs(3,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
          nod = ixs(4,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(10,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(11,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(12,i)
          nod = ixs(5,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(14,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(15,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(16,i)
          nod = ixs(6,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(18,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(19,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(20,i)
          nod = ixs(7,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(22,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(23,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(24,i)
          nod = ixs(8,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(26,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(27,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(28,i)
          nod = ixs(9,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(30,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(31,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(32,i)
C
          nod = ixs16(1,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(34,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(35,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(36,i)
          nod = ixs16(2,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(38,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(39,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(40,i)
          nod = ixs16(3,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(42,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(43,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(44,i)
          nod = ixs16(4,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(46,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(47,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(48,i)
          nod = ixs16(5,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(50,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(51,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(52,i)
          nod = ixs16(6,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(54,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(55,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(56,i)
          nod = ixs16(7,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(58,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(59,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(60,i)
          nod = ixs16(8,ne)
          fcont(1,nod)=fcont(1,nod)+ bufr(62,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(63,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(64,i)
        END DO
      END IF
C
      RETURN

spmd_fiadd17_pon()

subroutine spmd_fiadd17_pon	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(*)	nelems,
			fskyi,
		integer, dimension(*)	isky,
			fcont,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(8,*)	ixs16,
		type(h3d_database)	h3d_data )

Definition at line 2763 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE h3d_mod
      USE output_mod
      use element_mod , only : nixs
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      "parit_c.inc"
#include      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
      INTEGER NB, LEN, 
     .        NELEMS(*), ISKY(*), IXS(NIXS,*), IXS16(8,*)
      my_real bufr(len,*),
     .        fskyi(lskyi,nfskyi),
     .        fcont(3,*)
      TYPE(H3D_DATABASE) :: H3D_DATA
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, II, IIIS, NOD, IES, NN
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      DO i = 1, nb
        nn = nint(bufr(1,i))
        ies = nelems(nn)                    
        DO ii =1,8
          iiis = nint(bufr(6+(ii-1)*5,i))
          IF(iiis<=8)THEN
            nod = ixs(iiis+1,ies)
          ELSE
            nod = ixs16(iiis-8,ies-numels8-numels10-numels20)
          END IF
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2+(ii-1)*5,i)
          fskyi(nisky,2)=bufr(3+(ii-1)*5,i)
          fskyi(nisky,3)=bufr(4+(ii-1)*5,i)
          fskyi(nisky,4)=bufr(5+(ii-1)*5,i)
          isky(nisky) = nod
        END DO
      END DO
C
C following i11for3 process on secondary nodes
C
      IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .   ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .   (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .   .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C Anim FCONT
        DO i = 1, nb
          ies = nelems(nint(bufr(1,i)))
          DO ii =1,8
            iiis = nint(bufr(6+(ii-1)*5,i))
c            IIIS = NINT(BUFR(10+(II-1)*5,I))
            IF(iiis<=8)THEN
              nod = ixs(iiis+1,ies)
            ELSE
              nod = ixs16(iiis-8,ies-numels8-numels10-numels20)
            END IF
            fcont(1,nod)=fcont(1,nod)+ bufr(2+(ii-1)*5,i)
            fcont(2,nod)=fcont(2,nod)+ bufr(3+(ii-1)*5,i)
            fcont(3,nod)=fcont(3,nod)+ bufr(4+(ii-1)*5,i)
          END DO
        END DO
      END IF
C
      RETURN

spmd_fiadd20_poff()

subroutine spmd_fiadd20_poff	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(*)	nsv,
			a,
			stifn,
			viscn,
		integer	ibc,
		integer	isecin,
		integer	noint,
		integer	ibag,
		integer, dimension(*)	icodt,
			secfcum,
		integer, dimension(*)	nstrf,
		integer, dimension(*)	icontact,
			fcont,
		integer	inacti,
		integer	iadm,
		integer	intth,
		double precision, dimension(3,6,*)	daanc6,
			fthe,
		integer, dimension(*)	nlg,
			alphak,
		type(h3d_database)	h3d_data )

Definition at line 1208 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE h3d_mod
      USE output_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      "scr05_c.inc"
#include      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "scr18_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(OUTPUT_), intent(inout) :: OUTPUT
      INTEGER NB, LEN, IBC  ,ISECIN  ,IBAG , NOINT, INACTI,
     .        NSV(*), ICODT(*), NSTRF(*), NLG(*),
     .        ICONTACT(*), IADM,INTTH
      my_real
     .        bufr(len,*), a(3,*), stifn(*), viscn(*),
     .        secfcum(7,numnod,nsect),
     .        fcont(3,*),fthe(*), alphak(3,*)
      DOUBLE PRECISION DAANC6(3,6,*)
      TYPE(H3D_DATABASE) :: H3D_DATA
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER, INC,ISIGN
      DOUBLE PRECISION DAANC6L(3,6) 
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
      IF(intth == 0 ) THEN
       IF(kdtint==0)THEN
        DO i = 1, nb
          n = nsv(nint(bufr(1,i)))
          nod = nlg(n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)          
C type20 interface treatment
          isign = 1
          IF(alphak(2,n) < zero .or. bufr(6,i) < zero)isign = -1
          alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(6,i)))             
          CALL getdpdaanc(daanc6l,bufr(7,i),iresp,inc)
          daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
          daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
          daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
          daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
          daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
          daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
          daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
          daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
          daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
          daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
          daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
          daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
          daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
          daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
          daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
          daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
          daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
          daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
        ENDDO
       ELSE
        DO i = 1, nb
          n = nsv(nint(bufr(1,i)))
          nod = nlg(n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)          
          viscn(nod) = viscn(nod) + bufr(6,i)          
          isign = 1
          IF(alphak(2,n) < zero .or. bufr(7,i) < zero)isign = -1
          alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(7,i)))             
C type20 interface treatment
          CALL getdpdaanc(daanc6l,bufr(8,i),iresp,inc)
          daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
          daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
          daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
          daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
          daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
          daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
          daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
          daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
          daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
          daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
          daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
          daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
          daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
          daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
          daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
          daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
          daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
          daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
        ENDDO
       ENDIF
C
      ELSE
        IF(kdtint==0)THEN
         DO i = 1, nb
          n = nsv(nint(bufr(1,i)))
          nod = nlg(n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)
          fthe(nod) = fthe(nod) + bufr(6,i)       
C type20 interface treatment
          isign = 1
          IF(alphak(2,n) < zero .or. bufr(7,i) < zero)isign = -1
          alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(7,i)))             
          CALL getdpdaanc(daanc6l,bufr(8,i),iresp,inc)
          daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
          daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
          daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
          daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
          daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
          daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
          daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
          daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
          daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
          daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
          daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
          daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
          daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
          daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
          daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
          daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
          daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
          daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
         ENDDO
        ELSE
         DO i = 1, nb
          n = nsv(nint(bufr(1,i)))
          nod = nlg(n)
          a(1,nod)   = a(1,nod) + bufr(2,i)
          a(2,nod)   = a(2,nod) + bufr(3,i)
          a(3,nod)   = a(3,nod) + bufr(4,i)
          stifn(nod) = stifn(nod) + bufr(5,i)          
          viscn(nod) = viscn(nod) + bufr(6,i)
          fthe(nod) = fthe(nod) + bufr(7,i)            
C type20 interface treatment
          isign = 1
          IF(alphak(2,n) < zero .or. bufr(8,i) < zero)isign = -1
          alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(8,i)))             
          CALL getdpdaanc(daanc6l,bufr(9,i),iresp,inc)
          daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
          daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
          daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
          daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
          daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
          daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
          daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
          daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
          daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
          daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
          daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
          daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
          daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
          daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
          daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
          daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
          daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
          daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
         ENDDO
        ENDIF
      ENDIF
C
C following i7for3 & i10for3 process on secondary nodes
C
      IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .   ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .   (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .    .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C Anim FCONT
        DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(nsv(n))
          fcont(1,nod)=fcont(1,nod)+bufr(2,i)
          fcont(2,nod)=fcont(2,nod)+bufr(3,i)
          fcont(3,nod)=fcont(3,nod)+bufr(4,i)
        END DO
      END IF
C
      IF(isecin>0)THEN
C Sections
        k0=nstrf(25)
        IF(nstrf(1)+nstrf(2)/=0)THEN
          DO i=1,nsect
           nbinter=nstrf(k0+14)
           k1s=k0+30
           DO j=1,nbinter
            IF(nstrf(k1s)==noint)THEN
              IF(isecut/=0)THEN
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  nod = nsv(n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                  ENDIF
                ENDDO
              ENDIF
            ENDIF
            k1s=k1s+1
           ENDDO
           k0=nstrf(k0+24)
          ENDDO
        ENDIF
      ENDIF
C
      IF((ibag/=0.AND.inacti/=7).OR.
     .   iadm/=0)THEN ! warning conflict inacti=7 and ibag=3
C Airbags IBAG
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
            n = nint(bufr(1,i))
            nod = nlg(nsv(n))
            icontact(nod)=1
          END IF
        END DO
      END IF
C
      IF(ibc/=0) THEN
        ibcm = ibc / 8
        ibcs = ibc - 8 * ibcm
C Boundary cond.
        IF(ibcs>0) THEN
          DO i = 1, nb
            n = nint(bufr(1,i))
            nod = nlg(nsv(n))
            CALL ibcoff(ibcs,icodt(nod))
          END DO
        END IF
      END IF
C
      RETURN

spmd_fiadd20e_poff()

subroutine spmd_fiadd20e_poff	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(2,*)	ixlins,
			a,
			stifn,
			viscn,
		integer	ibc,
		integer	isecin,
		integer	noint,
		integer	ibag,
		integer, dimension(*)	icodt,
			secfcum,
		integer, dimension(*)	nstrf,
		integer, dimension(*)	icontact,
			fcont,
		double precision, dimension(3,6,*)	daanc6,
		integer, dimension(*)	nlg,
			alphak,
		type(h3d_database)	h3d_data )

Definition at line 1479 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE h3d_mod
      USE output_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      "scr05_c.inc"
#include      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "scr18_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(OUTPUT_), intent(inout)  :: OUTPUT
      INTEGER NB, LEN, IBC  ,ISECIN  ,IBAG , NOINT,
     .        IXLINS(2,*), ICODT(*), NSTRF(*),
     .        ICONTACT(*), NLG(*)
      my_real
     .        bufr(len,*), a(3,*), stifn(*), viscn(*),
     .        secfcum(7,numnod,nsect),
     .        fcont(3,*), alphak(3,*)
      DOUBLE PRECISION DAANC6(3,6,*)
      TYPE(H3D_DATABASE) :: H3D_DATA
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, II, N, N1, N2, N1G, N2G, K0, K1S, NBINTER, INC,ISIGN 
      DOUBLE PRECISION DAANC6L(3,6) 
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
       IF(kdtint==0)THEN
        DO i = 1, nb
          n = nint(bufr(1,i))
          n1 = ixlins(1,n)
          n2 = ixlins(2,n)
          n1g = nlg(n1)
          n2g = nlg(n2)
          a(1,n1g)   = a(1,n1g) + bufr(2,i)
          a(2,n1g)   = a(2,n1g) + bufr(3,i)
          a(3,n1g)   = a(3,n1g) + bufr(4,i)
          stifn(n1g) = stifn(n1g) + bufr(5,i)
C              
          a(1,n2g)   = a(1,n2g) + bufr(6,i)
          a(2,n2g)   = a(2,n2g) + bufr(7,i)
          a(3,n2g)   = a(3,n2g) + bufr(8,i)
          stifn(n2g) = stifn(n2g) + bufr(9,i)          
C Traitement interface type20
          isign = 1
          IF(alphak(2,n1) < zero .or. bufr(10,i) < zero)isign = -1
          alphak(2,n1) = isign*min(abs(alphak(2,n1)),abs(bufr(10,i)))          
          isign = 1
          IF(alphak(2,n2) < zero .or. bufr(11,i) < zero)isign = -1
          alphak(2,n2) = isign*min(abs(alphak(2,n2)),abs(bufr(11,i)))          
          CALL getdpdaanc(daanc6l,bufr(12,i),iresp,inc)
          daanc6(1,1,n1) = daanc6(1,1,n1)+daanc6l(1,1)
          daanc6(1,2,n1) = daanc6(1,2,n1)+daanc6l(1,2)
          daanc6(1,3,n1) = daanc6(1,3,n1)+daanc6l(1,3)
          daanc6(1,4,n1) = daanc6(1,4,n1)+daanc6l(1,4)
          daanc6(1,5,n1) = daanc6(1,5,n1)+daanc6l(1,5)
          daanc6(1,6,n1) = daanc6(1,6,n1)+daanc6l(1,6)
          daanc6(2,1,n1) = daanc6(2,1,n1)+daanc6l(2,1)
          daanc6(2,2,n1) = daanc6(2,2,n1)+daanc6l(2,2)
          daanc6(2,3,n1) = daanc6(2,3,n1)+daanc6l(2,3)
          daanc6(2,4,n1) = daanc6(2,4,n1)+daanc6l(2,4)
          daanc6(2,5,n1) = daanc6(2,5,n1)+daanc6l(2,5)
          daanc6(2,6,n1) = daanc6(2,6,n1)+daanc6l(2,6)
          daanc6(3,1,n1) = daanc6(3,1,n1)+daanc6l(3,1)
          daanc6(3,2,n1) = daanc6(3,2,n1)+daanc6l(3,2)
          daanc6(3,3,n1) = daanc6(3,3,n1)+daanc6l(3,3)
          daanc6(3,4,n1) = daanc6(3,4,n1)+daanc6l(3,4)
          daanc6(3,5,n1) = daanc6(3,5,n1)+daanc6l(3,5)
          daanc6(3,6,n1) = daanc6(3,6,n1)+daanc6l(3,6)
          CALL getdpdaanc(daanc6l,bufr(12+inc,i),iresp,inc)
          daanc6(1,1,n2) = daanc6(1,1,n2)+daanc6l(1,1)
          daanc6(1,2,n2) = daanc6(1,2,n2)+daanc6l(1,2)
          daanc6(1,3,n2) = daanc6(1,3,n2)+daanc6l(1,3)
          daanc6(1,4,n2) = daanc6(1,4,n2)+daanc6l(1,4)
          daanc6(1,5,n2) = daanc6(1,5,n2)+daanc6l(1,5)
          daanc6(1,6,n2) = daanc6(1,6,n2)+daanc6l(1,6)
          daanc6(2,1,n2) = daanc6(2,1,n2)+daanc6l(2,1)
          daanc6(2,2,n2) = daanc6(2,2,n2)+daanc6l(2,2)
          daanc6(2,3,n2) = daanc6(2,3,n2)+daanc6l(2,3)
          daanc6(2,4,n2) = daanc6(2,4,n2)+daanc6l(2,4)
          daanc6(2,5,n2) = daanc6(2,5,n2)+daanc6l(2,5)
          daanc6(2,6,n2) = daanc6(2,6,n2)+daanc6l(2,6)
          daanc6(3,1,n2) = daanc6(3,1,n2)+daanc6l(3,1)
          daanc6(3,2,n2) = daanc6(3,2,n2)+daanc6l(3,2)
          daanc6(3,3,n2) = daanc6(3,3,n2)+daanc6l(3,3)
          daanc6(3,4,n2) = daanc6(3,4,n2)+daanc6l(3,4)
          daanc6(3,5,n2) = daanc6(3,5,n2)+daanc6l(3,5)
          daanc6(3,6,n2) = daanc6(3,6,n2)+daanc6l(3,6)
        ENDDO
       ELSE
        DO i = 1, nb
          n = nint(bufr(1,i))
          n1 = ixlins(1,n)
          n2 = ixlins(2,n)
          n1g = nlg(n1)
          n2g = nlg(n2)
          a(1,n1g)   = a(1,n1g) + bufr(2,i)
          a(2,n1g)   = a(2,n1g) + bufr(3,i)
          a(3,n1g)   = a(3,n1g) + bufr(4,i)
          stifn(n1g) = stifn(n1g) + bufr(5,i)
          viscn(n1g) = viscn(n1g) + bufr(6,i)          
C              
          a(1,n2g)   = a(1,n2g) + bufr(7,i)
          a(2,n2g)   = a(2,n2g) + bufr(8,i)
          a(3,n2g)   = a(3,n2g) + bufr(9,i)
          stifn(n2g) = stifn(n2g) + bufr(10,i)         
          viscn(n2g) = viscn(n2g) + bufr(11,i)         
C Traitement interface type20
          isign = 1
          IF(alphak(2,n1) < zero .or. bufr(12,i) < zero)isign = -1
          alphak(2,n1) = isign*min(abs(alphak(2,n1)),abs(bufr(12,i)))          
          isign = 1
          IF(alphak(2,n2) < zero .or. bufr(13,i) < zero)isign = -1
          alphak(2,n2) = isign*min(abs(alphak(2,n2)),abs(bufr(13,i)))          
          CALL getdpdaanc(daanc6l,bufr(14,i),iresp,inc)
          daanc6(1,1,n1) = daanc6(1,1,n1)+daanc6l(1,1)
          daanc6(1,2,n1) = daanc6(1,2,n1)+daanc6l(1,2)
          daanc6(1,3,n1) = daanc6(1,3,n1)+daanc6l(1,3)
          daanc6(1,4,n1) = daanc6(1,4,n1)+daanc6l(1,4)
          daanc6(1,5,n1) = daanc6(1,5,n1)+daanc6l(1,5)
          daanc6(1,6,n1) = daanc6(1,6,n1)+daanc6l(1,6)
          daanc6(2,1,n1) = daanc6(2,1,n1)+daanc6l(2,1)
          daanc6(2,2,n1) = daanc6(2,2,n1)+daanc6l(2,2)
          daanc6(2,3,n1) = daanc6(2,3,n1)+daanc6l(2,3)
          daanc6(2,4,n1) = daanc6(2,4,n1)+daanc6l(2,4)
          daanc6(2,5,n1) = daanc6(2,5,n1)+daanc6l(2,5)
          daanc6(2,6,n1) = daanc6(2,6,n1)+daanc6l(2,6)
          daanc6(3,1,n1) = daanc6(3,1,n1)+daanc6l(3,1)
          daanc6(3,2,n1) = daanc6(3,2,n1)+daanc6l(3,2)
          daanc6(3,3,n1) = daanc6(3,3,n1)+daanc6l(3,3)
          daanc6(3,4,n1) = daanc6(3,4,n1)+daanc6l(3,4)
          daanc6(3,5,n1) = daanc6(3,5,n1)+daanc6l(3,5)
          daanc6(3,6,n1) = daanc6(3,6,n1)+daanc6l(3,6)
          CALL getdpdaanc(daanc6l,bufr(14+inc,i),iresp,inc)
          daanc6(1,1,n2) = daanc6(1,1,n2)+daanc6l(1,1)
          daanc6(1,2,n2) = daanc6(1,2,n2)+daanc6l(1,2)
          daanc6(1,3,n2) = daanc6(1,3,n2)+daanc6l(1,3)
          daanc6(1,4,n2) = daanc6(1,4,n2)+daanc6l(1,4)
          daanc6(1,5,n2) = daanc6(1,5,n2)+daanc6l(1,5)
          daanc6(1,6,n2) = daanc6(1,6,n2)+daanc6l(1,6)
          daanc6(2,1,n2) = daanc6(2,1,n2)+daanc6l(2,1)
          daanc6(2,2,n2) = daanc6(2,2,n2)+daanc6l(2,2)
          daanc6(2,3,n2) = daanc6(2,3,n2)+daanc6l(2,3)
          daanc6(2,4,n2) = daanc6(2,4,n2)+daanc6l(2,4)
          daanc6(2,5,n2) = daanc6(2,5,n2)+daanc6l(2,5)
          daanc6(2,6,n2) = daanc6(2,6,n2)+daanc6l(2,6)
          daanc6(3,1,n2) = daanc6(3,1,n2)+daanc6l(3,1)
          daanc6(3,2,n2) = daanc6(3,2,n2)+daanc6l(3,2)
          daanc6(3,3,n2) = daanc6(3,3,n2)+daanc6l(3,3)
          daanc6(3,4,n2) = daanc6(3,4,n2)+daanc6l(3,4)
          daanc6(3,5,n2) = daanc6(3,5,n2)+daanc6l(3,5)
          daanc6(3,6,n2) = daanc6(3,6,n2)+daanc6l(3,6)
        ENDDO
       ENDIF
C
C
C continue i7for3 and i10for3 processing on secondary node
C
      IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .   ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .   (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .    .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C Anim FCONT
        DO i = 1, nb
          n = nint(bufr(1,i))
          n1 = ixlins(1,n)
          n2 = ixlins(2,n)
          n1g = nlg(n1)
          n2g = nlg(n2)
C
          fcont(1,n1g)=fcont(1,n1g)+bufr(2,i)
          fcont(2,n1g)=fcont(2,n1g)+bufr(3,i)
          fcont(3,n1g)=fcont(3,n1g)+bufr(4,i)
C
          fcont(1,n2g)=fcont(1,n2g)+bufr(5,i)
          fcont(2,n2g)=fcont(2,n2g)+bufr(6,i)
          fcont(3,n2g)=fcont(3,n2g)+bufr(7,i)
        END DO
      END IF
C
      IF(isecin>0)THEN
C Sections
        k0=nstrf(25)
        IF(nstrf(1)+nstrf(2)/=0)THEN
          DO i=1,nsect
           nbinter=nstrf(k0+14)
           k1s=k0+30
           DO j=1,nbinter
            IF(nstrf(k1s)==noint)THEN
              IF(isecut/=0)THEN
               IF(kdtint==0)THEN
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  n1 = ixlins(1,n)
                  n2 = ixlins(2,n)
                  n1g = nlg(n1)
                  n2g = nlg(n2)
                  IF(secfcum(4,n1g,i)==1.)THEN
                    secfcum(1,n1g,i)=secfcum(1,n1g,i)+bufr(2,ii)
                    secfcum(2,n1g,i)=secfcum(2,n1g,i)+bufr(3,ii)
                    secfcum(3,n1g,i)=secfcum(3,n1g,i)+bufr(4,ii)
                  ENDIF
                  IF(secfcum(4,n2g,i)==1.)THEN
                    secfcum(1,n2g,i)=secfcum(1,n2g,i)+bufr(6,ii)
                    secfcum(2,n2g,i)=secfcum(2,n2g,i)+bufr(7,ii)
                    secfcum(3,n2g,i)=secfcum(3,n2g,i)+bufr(8,ii)
                  ENDIF
                ENDDO
               ELSE
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  n1 = ixlins(1,n)
                  n2 = ixlins(2,n)
                  n1g = nlg(n1)
                  n2g = nlg(n2)
                  IF(secfcum(4,n1g,i)==1.)THEN
                    secfcum(1,n1g,i)=secfcum(1,n1g,i)+bufr(2,ii)
                    secfcum(2,n1g,i)=secfcum(2,n1g,i)+bufr(3,ii)
                    secfcum(3,n1g,i)=secfcum(3,n1g,i)+bufr(4,ii)
                  ENDIF
                  IF(secfcum(4,n2g,i)==1.)THEN
                    secfcum(1,n2g,i)=secfcum(1,n2g,i)+bufr(7,ii)
                    secfcum(2,n2g,i)=secfcum(2,n2g,i)+bufr(8,ii)
                    secfcum(3,n2g,i)=secfcum(3,n2g,i)+bufr(9,ii)
                  ENDIF
                ENDDO
               END IF
              ENDIF
            ENDIF
            k1s=k1s+1
           ENDDO
           k0=nstrf(k0+24)
          ENDDO
        ENDIF
      ENDIF
C
      IF(ibag/=0)THEN
C Airbags IBAG
       IF(kdtint==0)THEN
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
            n = nint(bufr(1,i))
            n1 = ixlins(1,n)
            n1g = nlg(n1)
            icontact(n1g)=1
          END IF
          IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
     +       bufr(8,i)/=zero) THEN
            n = nint(bufr(1,i))
            n2 = ixlins(2,n)
            n2g = nlg(n2)
            icontact(n2g)=1
          END IF
        END DO
       ELSE
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
            n = nint(bufr(1,i))
            n1 = ixlins(1,n)
            n1g = nlg(n1)
            icontact(n1g)=1
          END IF
          IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
     +       bufr(9,i)/=zero) THEN
            n = nint(bufr(1,i))
            n2 = ixlins(2,n)
            n2g = nlg(n2)
            icontact(n2g)=1
          END IF
        END DO
       END IF
      END IF
C
      RETURN

spmd_fiadd20f_pon()

subroutine spmd_fiadd20f_pon	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(*)	nsv,
			fskyi,
		integer, dimension(*)	isky,
		integer	ibc,
		integer	isecin,
		integer	noint,
		integer	ibag,
		integer, dimension(*)	icodt,
			secfcum,
		integer, dimension(*)	nstrf,
		integer, dimension(*)	icontact,
			fcont,
		integer	inacti,
		integer	iadm,
		integer	intth,
			ftheskyi,
		integer, dimension(*)	nlg,
		type(h3d_database)	h3d_data )

Definition at line 2006 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE h3d_mod
      USE output_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      "parit_c.inc"
#include      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "scr18_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(OUTPUT_), intent(inout) :: OUTPUT
      INTEGER NB, LEN, IBC  ,ISECIN  ,IBAG , NOINT, INACTI,
     .        NSV(*), ISKY(*), ICODT(*), NSTRF(*), NLG(*),
     .        ICONTACT(*), IADM,INTTH
      my_real
     .        bufr(len,*),
     .        fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
     .        fcont(3,*),ftheskyi(lskyi)
      TYPE(H3D_DATABASE) :: H3D_DATA
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER 
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      IF ((nisky+nb)> lskyi)THEN
           CALL ancmsg(msgid=26,anmode=aninfo)
           CALL arret(2)
      ENDIF
C
      IF(intth == 0 ) THEN
       IF(kdtint==0)THEN
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(nsv(n))
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          isky(nisky) = nod
         ENDDO
       ELSE
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(nsv(n))
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          fskyi(nisky,5)=bufr(6,i)
          isky(nisky) = nod
         ENDDO
       ENDIF
C
C --- interface type 7 + thermal
C
      ELSE
       IF(kdtint==0)THEN
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(nsv(n))
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          ftheskyi(nisky) =bufr(6,i)
          isky(nisky) = nod
         ENDDO
        ELSE
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(nsv(n))
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          fskyi(nisky,5)=bufr(6,i)
          ftheskyi(nisky) =bufr(7,i)
          isky(nisky) = nod
         ENDDO
        ENDIF
       ENDIF       
C
C continue i7for3 and i10for3 processing on secondary node
C
      IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .   ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .   (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .   .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C Anim FCONT
        DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(nsv(n))
          fcont(1,nod)=fcont(1,nod)+bufr(2,i)
          fcont(2,nod)=fcont(2,nod)+bufr(3,i)
          fcont(3,nod)=fcont(3,nod)+bufr(4,i)
        END DO
      END IF
C
      IF(isecin>0)THEN
C Sections
        k0=nstrf(25)
        IF(nstrf(1)+nstrf(2)/=0)THEN
          DO i=1,nsect
           nbinter=nstrf(k0+14)
           k1s=k0+30
           DO j=1,nbinter
            IF(nstrf(k1s)==noint)THEN
              IF(isecut/=0)THEN
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  nod = nlg(nsv(n))
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                  ENDIF
                ENDDO
              ENDIF
            ENDIF
            k1s=k1s+1
           ENDDO
           k0=nstrf(k0+24)
          ENDDO
        ENDIF
      ENDIF
C
      IF((ibag/=0.AND.inacti/=7).OR.
     .   iadm/=0)THEN ! warning conflict inacti=7 and ibag=3
C Airbags IBAG
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
            n = nint(bufr(1,i))
            nod = nlg(nsv(n))
            icontact(nod)=1
          END IF
        END DO
      END IF
C
      IF(ibc/=0) THEN
        ibcm = ibc / 8
        ibcs = ibc - 8 * ibcm
C Boundary cond.
        IF(ibcs>0) THEN
          DO i = 1, nb
            n = nint(bufr(1,i))
            nod = nlg(nsv(n))
            CALL ibcoff(ibcs,icodt(nod))
          END DO
        END IF
      END IF
C
      RETURN

spmd_fiadd20fe_pon()

subroutine spmd_fiadd20fe_pon	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(2,*)	irects,
			fskyi,
		integer, dimension(*)	isky,
		integer	ibc,
		integer	isecin,
		integer	noint,
		integer	ibag,
		integer, dimension(*)	icodt,
			secfcum,
		integer, dimension(*)	nstrf,
		integer, dimension(*)	icontact,
			fcont,
		integer, dimension(*)	nlg,
		type(h3d_database)	h3d_data )

Definition at line 2541 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE h3d_mod
      USE output_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      "parit_c.inc"
#include      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "scr18_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
      INTEGER NB, LEN, IBC  ,ISECIN  ,IBAG , NOINT,
     .        IRECTS(2,*), ISKY(*), ICODT(*), NSTRF(*),
     .        ICONTACT(*),NLG(*)
      my_real
     .        bufr(len,*),
     .        fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
     .        fcont(3,*)
      TYPE(H3D_DATABASE) :: H3D_DATA
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER 
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      IF ((nisky+nb)> lskyi)THEN
           CALL ancmsg(msgid=26,anmode=aninfo)
           CALL arret(2)
      ENDIF
 
      IF(kdtint==0)THEN
        DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(irects(1,n))
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          isky(nisky) = nod
          nod = nlg(irects(2,n))
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(6,i)
          fskyi(nisky,2)=bufr(7,i)
          fskyi(nisky,3)=bufr(8,i)
          fskyi(nisky,4)=bufr(9,i)
          isky(nisky) = nod
        ENDDO
      ELSE
        DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(irects(1,n))
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          fskyi(nisky,5)=bufr(6,i)
          isky(nisky) = nod
          nod = nlg(irects(2,n))
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(7,i)
          fskyi(nisky,2)=bufr(8,i)
          fskyi(nisky,3)=bufr(9,i)
          fskyi(nisky,4)=bufr(10,i)
          fskyi(nisky,5)=bufr(11,i)
          isky(nisky) = nod
        ENDDO
      ENDIF
C
C continue i11for3 processing on secondary node
C
      IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .   ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .   (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .   .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C Anim FCONT
        IF(kdtint==0)THEN
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(irects(1,n))
          fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
          nod = nlg(irects(2,n))
          fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
         END DO
        ELSE
         DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nlg(irects(1,n))
          fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
          nod = nlg(irects(2,n))
          fcont(1,nod)=fcont(1,nod)+ bufr(7,i)
          fcont(2,nod)=fcont(2,nod)+ bufr(8,i)
          fcont(3,nod)=fcont(3,nod)+ bufr(9,i)
         END DO
        END IF
      END IF
C
      IF(isecin>0)THEN
C Sections
        k0=nstrf(25)
        IF(nstrf(1)+nstrf(2)/=0)THEN
          DO i=1,nsect
           nbinter=nstrf(k0+14)
           k1s=k0+30
           DO j=1,nbinter
            IF(nstrf(k1s)==noint)THEN
              IF(isecut/=0)THEN
               IF(kdtint==0)THEN
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  nod = nlg(irects(1,n))
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                  ENDIF
                  nod = nlg(irects(2,n))
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(6,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(7,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(8,ii)
                  ENDIF
                ENDDO
               ELSE
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  nod = nlg(irects(1,n))
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                  ENDIF
                  nod = nlg(irects(2,n))
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
                  ENDIF
                ENDDO
               END IF
              ENDIF
            ENDIF
            k1s=k1s+1
           ENDDO
           k0=nstrf(k0+24)
          ENDDO
        ENDIF
      ENDIF
C
      IF(ibag/=0)THEN
C Airbags IBAG
       IF(kdtint==0)THEN
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
           n = nint(bufr(1,i))
           nod = nlg(irects(1,n))
           icontact(nod)=1
          END IF
          IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
     +       bufr(8,i)/=zero) THEN
           nod = nlg(irects(2,n))
           icontact(nod)=1
          END IF
        END DO
       ELSE
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
           n = nint(bufr(1,i))
           nod = nlg(irects(1,n))
           icontact(nod)=1
          END IF
          IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
     +       bufr(9,i)/=zero) THEN
           nod = nlg(irects(2,n))
           icontact(nod)=1
          END IF
        END DO
       END IF
      END IF
C
      RETURN

spmd_fiadd_poff()

subroutine spmd_fiadd_poff	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(*)	nsv,
			a,
			stifn,
			viscn,
		integer	ibc,
		integer	isecin,
		integer	noint,
		integer	ibag,
		integer, dimension(*)	icodt,
			secfcum,
		integer, dimension(*)	nstrf,
		integer, dimension(*)	icontact,
			fcont,
		integer	inacti,
		integer	iadm,
		integer	intth,
			fthe,
			condn,
		type(h3d_database)	h3d_data,
		type(multi_fvm_struct), intent(inout)	multi_fvm,
		integer, intent(in)	nin,
		integer, dimension(nloadp_hyd_inter,*)	tagncont,
		integer, dimension(*)	kloadpinter,
		integer, dimension(*)	loadpinter,
		integer, dimension(*)	loadp_hyd_inter,
		integer, intent(in)	intcarea,
		dimension(*), intent(inout)	fsav,
		type (parameters_), intent(in)	parameters,
		integer, intent(in)	nodadt_therm )

Definition at line 476 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE h3d_mod
      USE multi_fvm_mod
      USE output_mod
      USE parameters_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      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "scr18_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(OUTPUT_), intent(inout) :: OUTPUT
      INTEGER NB, LEN, IBC  ,ISECIN  ,IBAG , NOINT, INACTI,
     .        NSV(*), ICODT(*), NSTRF(*),ICONTACT(*),
     .        TAGNCONT(NLOADP_HYD_INTER,*),KLOADPINTER(*),LOADPINTER(*),
     .        LOADP_HYD_INTER(*),
     .        IADM,INTTH
      INTEGER, INTENT(in) :: NIN, INTCAREA
      INTEGER, INTENT(IN) :: NODADT_THERM
      my_real
     .        bufr(len,*), a(3,*), stifn(*), viscn(*),
     .        secfcum(7,numnod,nsect),
     .        fcont(3,*),fthe(*),condn(*)
      my_real, INTENT(INOUT) :: fsav(*)
      TYPE(H3D_DATABASE) :: H3D_DATA
      TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
      TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      my_real :: mass, fsav29
      INTEGER :: IBRIC
      INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL,NP  
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
      IF (multi_fvm%INT18_GLOBAL_LIST(nin)) THEN
         DO i = 1, nb
            n = nint(bufr(1, i))
            ibric = nsv(n)
            multi_fvm%FORCE_INT(1, ibric) = multi_fvm%FORCE_INT(1, ibric) + bufr(2,i)
            multi_fvm%FORCE_INT(2, ibric) = multi_fvm%FORCE_INT(2, ibric) + bufr(3,i)
            multi_fvm%FORCE_INT(3, ibric) = multi_fvm%FORCE_INT(3, ibric) + bufr(4,i)
         ENDDO
      ELSE
         IF(intth == 0 ) THEN
            DO i = 1, nb
               n = nint(bufr(1,i))
               nod = nsv(n)
               a(1,nod)   = a(1,nod) + bufr(2,i)
               a(2,nod)   = a(2,nod) + bufr(3,i)
               a(3,nod)   = a(3,nod) + bufr(4,i)
               stifn(nod) = stifn(nod) + bufr(5,i)          
               IF(kdtint /= 0) viscn(nod) = viscn(nod) + bufr(6,i)          
            ENDDO
         ELSE
            IF(kdtint==0)THEN
                DO i = 1, nb
                   n = nint(bufr(1,i))
                   nod = nsv(n)
                   a(1,nod)   = a(1,nod) + bufr(2,i)
                   a(2,nod)   = a(2,nod) + bufr(3,i)
                   a(3,nod)   = a(3,nod) + bufr(4,i)
                   stifn(nod) = stifn(nod) + bufr(5,i)
                   fthe(nod) = fthe(nod) + bufr(6,i)     
                   IF(nodadt_therm == 1) condn(nod) = condn(nod) + bufr(7,i)         
                ENDDO
            ELSE
               DO i = 1, nb
                  n = nint(bufr(1,i))
                  nod = nsv(n)
                  a(1,nod)   = a(1,nod) + bufr(2,i)
                  a(2,nod)   = a(2,nod) + bufr(3,i)
                  a(3,nod)   = a(3,nod) + bufr(4,i)
                  stifn(nod) = stifn(nod) + bufr(5,i)               
                  viscn(nod) = viscn(nod) + bufr(6,i)
                  fthe(nod) = fthe(nod) + bufr(7,i)     
                  IF(nodadt_therm == 1) condn(nod) = condn(nod) + bufr(8,i)         
               ENDDO
            ENDIF
         ENDIF      
C     
C     following i7for3 & i10for3 process on secondary nodes
C     
         IF (inconv == 1) THEN
            IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .           ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .           (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .          .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C     Anim FCONT
               DO i = 1, nb
                  n = nint(bufr(1,i))
                  nod = nsv(n)
                  fcont(1,nod)=fcont(1,nod)+bufr(2,i)
                  fcont(2,nod)=fcont(2,nod)+bufr(3,i)
                  fcont(3,nod)=fcont(3,nod)+bufr(4,i)
               END DO
            END IF
         END IF
C------------For /LOAD/PRESSURE tag nodes in contact-------------
         IF(nintloadp > 0) THEN
           DO i = 1, nb
              n = nint(bufr(1,i))
              nod = nsv(n)
              DO np = kloadpinter(nin)+1, kloadpinter(nin+1) 
                 pp = loadpinter(np)
                 ppl = loadp_hyd_inter(pp)
                 tagncont(ppl,nod) = 1
              ENDDO
            ENDDO
         ENDIF
C     
         IF(isecin>0)THEN
C     Sections
            k0=nstrf(25)
            IF(nstrf(1)+nstrf(2)/=0)THEN
               DO i=1,nsect
                  nbinter=nstrf(k0+14)
                  k1s=k0+30
                  DO j=1,nbinter
                     IF(nstrf(k1s)==noint)THEN
                        IF(isecut/=0)THEN
                           DO ii = 1, nb
                              n = nint(bufr(1,ii))
                              nod = nsv(n)
                              IF(secfcum(4,nod,i)==1.)THEN
                                 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                                 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                                 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                              ENDIF
                           ENDDO
                        ENDIF
                     ENDIF
                     k1s=k1s+1
                  ENDDO
                  k0=nstrf(k0+24)
               ENDDO
            ENDIF
         ENDIF
C     
         IF((ibag/=0.AND.inacti/=7).OR.
     .        (iadm/=0).OR.(idamp_rdof/=0)) THEN ! warning conflict inacti=7 and ibag=3
C     Airbags IBAG
            DO i = 1, nb
               IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +              bufr(4,i)/=zero) THEN
                  n = nint(bufr(1,i))
                  nod = nsv(n)
                  icontact(nod)=1
               END IF
            END DO
         END IF
C     
         IF(ibc/=0) THEN
            ibcm = ibc / 8
            ibcs = ibc - 8 * ibcm
C     Boundary cond.
            IF(ibcs>0) THEN
               DO i = 1, nb
                  n = nint(bufr(1,i))
                  nod = nsv(n)
                  CALL ibcoff(ibcs,icodt(nod))
               END DO
            END IF
         END IF
      ENDIF
C
      RETURN

spmd_fiadd_pon()

subroutine spmd_fiadd_pon	(	type(output_), intent(inout)	output,
		integer	nb,
		integer	len,
			bufr,
		integer, dimension(*)	nsv,
			fskyi,
		integer, dimension(*)	isky,
		integer	ibc,
		integer	isecin,
		integer	noint,
		integer	ibag,
		integer, dimension(*)	icodt,
			secfcum,
		integer, dimension(*)	nstrf,
		integer, dimension(*)	icontact,
			fcont,
		integer	inacti,
		integer	iadm,
		integer	intth,
			ftheskyi,
			condnskyi,
		type(h3d_database)	h3d_data,
		integer	nin,
		integer, dimension(nloadp_hyd_inter,*)	tagncont,
		integer, dimension(*)	kloadpinter,
		integer, dimension(*)	loadpinter,
		integer, dimension(*)	loadp_hyd_inter,
		integer, intent(in)	intcarea,
		dimension(*), intent(inout)	fsav,
		type (parameters_), intent(in)	parameters,
		integer, intent(in)	nodadt_therm )

Definition at line 1793 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE h3d_mod
      USE output_mod
      USE parameters_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      "parit_c.inc"
#include      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "scr18_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(OUTPUT_), intent(inout) :: OUTPUT
      INTEGER NB, LEN, IBC  ,ISECIN  ,IBAG , NOINT, INACTI,NIN,
     .        NSV(*), ISKY(*), ICODT(*), NSTRF(*),ICONTACT(*),
     .        TAGNCONT(NLOADP_HYD_INTER,*),KLOADPINTER(*),LOADPINTER(*),
     .        LOADP_HYD_INTER(*),
     .        IADM,INTTH
      INTEGER ,INTENT(IN):: INTCAREA
      INTEGER, INTENT(IN) :: NODADT_THERM
      my_real
     .        bufr(len,*),
     .        fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
     .        fcont(3,*),ftheskyi(lskyi),condnskyi(lskyi)
      my_real, INTENT(INOUT) :: fsav(*) 
      TYPE(H3D_DATABASE) :: H3D_DATA
      TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,
     .        NISKY_SAV,TEMP_SIZ,IERROR,PP,PPL,NP
      my_real fsav29
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      IF ((nisky+nb)> lskyi)THEN
           CALL ancmsg(msgid=26,anmode=aninfo)
           CALL arret(2)
      ENDIF
C
      nisky_sav = nisky
      DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nsv(n)
          nisky = nisky + 1
          fskyi(nisky,1)=bufr(2,i)
          fskyi(nisky,2)=bufr(3,i)
          fskyi(nisky,3)=bufr(4,i)
          fskyi(nisky,4)=bufr(5,i)
          isky(nisky) = nod
      ENDDO
      temp_siz=6
      
      IF(kdtint /= 0 ) THEN
         nisky = nisky_sav
         DO i = 1, nb
          nisky = nisky + 1
          fskyi(nisky,5)=bufr(temp_siz,i)
         ENDDO
         temp_siz=temp_siz+1
      ENDIF
      
      IF(intth /= 0 ) THEN
         nisky = nisky_sav
         DO i = 1, nb
          nisky = nisky + 1
          ftheskyi(nisky)=bufr(temp_siz,i)
         ENDDO
         temp_siz=temp_siz+1
         
         IF(nodadt_therm ==1) THEN
           nisky = nisky_sav
           DO i = 1, nb
             nisky = nisky + 1
             condnskyi(nisky)=bufr(temp_siz,i)
           ENDDO
           temp_siz=temp_siz+1
         ENDIF        
      ENDIF
 
 
C
C continue i7for3 and i10for3 processing on secondary node
C
      IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .   ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .   (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
     .   .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
C Anim FCONT
        DO i = 1, nb
          n = nint(bufr(1,i))
          nod = nsv(n)
          fcont(1,nod)=fcont(1,nod)+bufr(2,i)
          fcont(2,nod)=fcont(2,nod)+bufr(3,i)
          fcont(3,nod)=fcont(3,nod)+bufr(4,i)
        END DO
      END IF
C
C------------For /LOAD/PRESSURE tag nodes in contact-------------
      IF(nintloadp > 0) THEN
         DO i = 1, nb
            n = nint(bufr(1,i))
            nod = nsv(n)
            DO np = kloadpinter(nin)+1, kloadpinter(nin+1) 
                 pp = loadpinter(np)
                 ppl = loadp_hyd_inter(pp)
                 tagncont(ppl,nod) = 1
            ENDDO
         ENDDO
       ENDIF
C------------For outputting total contact area------------
c         IF(INTCAREA > 0) THEN
c           FSAV29 = ZERO
c           DO I = 1, NB
c              N = NINT(BUFR(1,I))
c              NOD = NSV(N)
c              FSAV29 = FSAV29 + PARAMETERS%INTAREAN(NOD)
c            ENDDO
c            FSAV(29) = FSAV(29) + FSAV29
c         ENDIF
C 
C
      IF(isecin>0)THEN
C Sections
        k0=nstrf(25)
        IF(nstrf(1)+nstrf(2)/=0)THEN
          DO i=1,nsect
           nbinter=nstrf(k0+14)
           k1s=k0+30
           DO j=1,nbinter
            IF(nstrf(k1s)==noint)THEN
              IF(isecut/=0)THEN
                DO ii = 1, nb
                  n = nint(bufr(1,ii))
                  nod = nsv(n)
                  IF(secfcum(4,nod,i)==1.)THEN
                    secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
                    secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
                    secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
                  ENDIF
                ENDDO
              ENDIF
            ENDIF
            k1s=k1s+1
           ENDDO
           k0=nstrf(k0+24)
          ENDDO
        ENDIF
      ENDIF
C
      IF((ibag/=0.AND.inacti/=7).OR.
     .   (iadm/=0).OR.(idamp_rdof/=0))THEN ! warning conflict inacti=7 and ibag=3
C Airbags IBAG   
        DO i = 1, nb
          IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
     +       bufr(4,i)/=zero) THEN
            n = nint(bufr(1,i))
            nod = nsv(n)
            icontact(nod)=1
          END IF
        END DO
      END IF
C
      IF(ibc/=0) THEN
        ibcm = ibc / 8
        ibcs = ibc - 8 * ibcm
C Boundary cond.
        IF(ibcs>0) THEN
          DO i = 1, nb
            n = nint(bufr(1,i))
            nod = nsv(n)
            CALL ibcoff(ibcs,icodt(nod))
          END DO
        END IF
      END IF
C
      RETURN

spmd_initfi()

subroutine spmd_initfi	(	integer, dimension(npari,*)	ipari,
		integer	iflag,
		type(h3d_database)	h3d_data,
		type (parameters_), intent(in)	parameters,
		integer, intent(in)	idt_therm,
		integer, intent(in)	intheat )

Definition at line 3411 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      USE tri25ebox
      USE message_mod
      USE intstamp_glob_mod
      USE h3d_mod
      USE interface_modification_mod
      USE parameters_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "i25edge_c.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      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "scr18_c.inc"
#include      "task_c.inc"
#include      "param_c.inc"
#include      "parit_c.inc"
#include      "spmd_c.inc"
#include      "sms_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*), IFLAG
      INTEGER, INTENT(IN) :: IDT_THERM
      INTEGER, INTENT(IN) :: INTHEAT
      TYPE(H3D_DATABASE) :: H3D_DATA
      TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, P, NSN, NMN, ITYP, IGAP, IERROR, IERROR1, LENS, LENR,
     .        LSKYFI, INACTI, NBINTC, LENI, J,INTTH, K, L,IEDGE4 ,INTFRIC ,
     .        FLAGREMN ,SIZREMNORFI, IVIS2 ,INTNITSCHE,ITIED,IPSTIF
      INTEGER :: LENR_EDGE,LENS_EDGE
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      IF(iflag==1) THEN
C Init Pointer + Reading Wait
       IF(ninter/=0) THEN
        ierror = 0
        ALLOCATE(nsvfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(nsnfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(edge_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(nsnfi_sav(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(nsnsi_sav(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(itafi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(pmainfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(kinfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(msfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(stifi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(gapfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(gap_lfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(xfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(vfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(nsvsi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(nsnsi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(afi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(stnfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(vscfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(penfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(fskyfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(iskyfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
C
        ALLOCATE(nisubsfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(lisubsfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(inflg_subsfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(addsubsfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        IF(parameters%INTCAREA > 0 ) THEN
           ALLOCATE(intareanfi(ninter),stat=ierror1)
           ierror = ierror + ierror1
        ENDIF
 
        ALLOCATE(nisubsfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(lisubsfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(inflg_subsfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(addsubsfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
 
C
        ALLOCATE(fnconti(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(ftconti(ninter),stat=ierror1)
        ierror = ierror + ierror1
C
        ALLOCATE (nlskyfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        nlskyfi(1:ninter)=0
C Int17
        ALLOCATE (eminxfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (ksfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (frotsfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (stnfi17(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(xfi17(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(vfi17(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(afi17(ninter),stat=ierror1)
        ierror = ierror + ierror1
C Int20
        ALLOCATE(nbinflfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(daanc6fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(dxancfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(dvancfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(penfia(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(alphakfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(daancfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(diag_smsfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
C Int20 edge
        ALLOCATE(nsvfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(nsnfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(itafie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(msfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(stifie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(gapfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(xfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(vfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(nsvsie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(nsnsie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(afie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(stnfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(vscfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(penfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(fskyfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(iskyfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
C
        ALLOCATE (nlskyfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        nlskyfie(1:ninter)=0
C
        ALLOCATE(daanc6fie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(dxancfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(dvancfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(penfiae(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(alphakfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(daancfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(diag_smsfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
C
        ALLOCATE (nodnxfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (nodamsfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (procamsfie(ninter),stat=ierror1)
        ierror = ierror + ierror1
C Fin Int20 edge
 
C I18KINE
        ALLOCATE (mtfi_pene(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (mtfi_penemin(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (mtfi_v(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (mtfi_a(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (i18kafi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (mtfi_n(ninter),stat=ierror1)
        ierror = ierror + ierror1
C INT 24 & 25
        ALLOCATE (time_sfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (irtlm_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (secnd_frfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (pene_oldfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (stif_oldfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (icont_i_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (isedge_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (irtse_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (is2pt_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (isegpt_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (is2se_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (ispt2_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (remnor_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (kremnor_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
C INT 25
        ALLOCATE (islide_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (icodt_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (iskew_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ipstif = 0
        DO i = 1,ninter
          IF(ipari(97,i) > 0) ipstif = ipstif + ipari(97,i)
        END DO
        IF(parameters%ISTIF_DT > 0 .OR. ipstif>0 ) THEN
           ALLOCATE(stif_msdt_fi(ninter))
           ALLOCATE(stife_msdt_fi(ninter))
        ENDIF
C
        IF(intheat > 0 ) THEN
         ALLOCATE (ftheskyfi(ninter),stat=ierror1)
         ierror = ierror + ierror1
         ALLOCATE(fthefi(ninter),stat=ierror1)        
         ierror = ierror + ierror1
          ALLOCATE(tempfi(ninter),stat=ierror1)        
         ierror = ierror + ierror1
         ALLOCATE(matsfi(ninter),stat=ierror1)        
         ierror = ierror + ierror1   
         ALLOCATE(nmtemp(ninter),stat=ierror1)
         ierror = ierror + ierror1
         IF(idt_therm == 1) THEN  
            ALLOCATE(condnfi(ninter),stat=ierror1)
            ierror = ierror + ierror1 
            ALLOCATE(condnskyfi(ninter),stat=ierror1)
            ierror = ierror + ierror1 
         ENDIF
        ENDIF  
        IF(intheat > 0 .OR.nintloadp21 > 0) THEN
         ALLOCATE(nmnfi(ninter),stat=ierror1)
         ierror = ierror + ierror1 
         ALLOCATE(nmvfi(ninter),stat=ierror1)
         ierror = ierror + ierror1     
         ALLOCATE(nmnsi(ninter),stat=ierror1)
         ierror = ierror + ierror1 
         ALLOCATE(nmvsi(ninter),stat=ierror1)
         ierror = ierror + ierror1   
         ALLOCATE(tempnod(ninter),stat=ierror1)
         ierror = ierror + ierror1 
        ENDIF
        IF(nintloadp21 > 0) THEN
           ALLOCATE(tagncontfi(ninter),stat=ierror1)
           ierror = ierror + ierror1
        ENDIF
        IF(ninterfric > 0 ) THEN
         ALLOCATE(ipartfricsfi(ninter),stat=ierror1)        
         ierror = ierror + ierror1 
         ALLOCATE(ipartfric_fie(ninter),stat=ierror1)        
         ierror = ierror + ierror1
        ENDIF
C
        ALLOCATE (nodnxfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (nodamsfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (procamsfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
C
        ALLOCATE (t2main_sms_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE (t2fac_sms_fi(ninter),stat=ierror1)
        ierror = ierror + ierror1
C
        IF(intheat > 0.OR.interadhesion > 0 ) THEN
         ALLOCATE(areasfi(ninter),stat=ierror1)        
          DO i = 1, ninter
            NULLIFY(areasfi(i)%p)
          ENDDO
         ierror = ierror + ierror1 
        ENDIF
C
        IF(interadhesion > 0) THEN
         ALLOCATE(if_adhfi(ninter),stat=ierror1)        
          DO i = 1, ninter
            NULLIFY(if_adhfi(i)%p)
          ENDDO
         ierror = ierror + ierror1 
        ENDIF
 
        ALLOCATE(candf_si(ninter),stat=ierror1)        
        ierror = ierror + ierror1 
C
        IF(nitsche > 0 ) THEN
         ALLOCATE(forneqsfi(ninter),stat=ierror1)        
         ierror = ierror + ierror1 
        ENDIF
 
C
        ALLOCATE(efricfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
        ALLOCATE(efricgfi(ninter),stat=ierror1)
        ierror = ierror + ierror1
 
C       ALLOCATE(MAIN_FIE(NINTER))
        ALLOCATE(gape_l_fie(ninter))
        ALLOCATE(edg_bisector_fie(ninter))
        ALLOCATE(vtx_bisector_fie(ninter))
        ALLOCATE(x_seg_fie(ninter))
        ALLOCATE(ledge_fie(ninter))
 
 
C
        DO i=1,ninter
          NULLIFY(nsvfi(i)%p)
          NULLIFY(nsnfi(i)%p)
          NULLIFY(edge_fi(i)%p)
          NULLIFY(pmainfi(i)%p)
          NULLIFY(nsnfi_sav(i)%p)
          NULLIFY(nsnsi_sav(i)%p)
          NULLIFY(itafi(i)%p)
          NULLIFY(kinfi(i)%p)
          NULLIFY(msfi(i)%p)
          NULLIFY(stifi(i)%p)
          NULLIFY(gapfi(i)%p)
          NULLIFY(gap_lfi(i)%p)
          NULLIFY(xfi(i)%p)
          NULLIFY(vfi(i)%p)
          NULLIFY(nsvsi(i)%p)
          NULLIFY(nsnsi(i)%p)
          NULLIFY(afi(i)%p)
          NULLIFY(stnfi(i)%p)
          NULLIFY(vscfi(i)%p)
          NULLIFY(penfi(i)%p)
          NULLIFY(fskyfi(i)%p)
          NULLIFY(iskyfi(i)%p)
 
          NULLIFY(nisubsfi(i)%p)
          NULLIFY(lisubsfi(i)%p)
          NULLIFY(inflg_subsfi(i)%p)
          NULLIFY(addsubsfi(i)%p)
          IF(parameters%INTCAREA > 0) NULLIFY(intareanfi(i)%p)
 
          NULLIFY(nisubsfie(i)%p)
          NULLIFY(lisubsfie(i)%p)
          NULLIFY(inflg_subsfie(i)%p)
          NULLIFY(addsubsfie(i)%p)
 
 
C
          NULLIFY(fnconti(i)%p)
          NULLIFY(ftconti(i)%p)
C
          NULLIFY(eminxfi(i)%p)
          NULLIFY(ksfi(i)%p)
          NULLIFY(frotsfi(i)%p)
          NULLIFY(stnfi17(i)%p)
          NULLIFY(xfi17(i)%p)
          NULLIFY(vfi17(i)%p)
          NULLIFY(afi17(i)%p)
C
          NULLIFY(nbinflfi(i)%p)
          NULLIFY(daanc6fi(i)%p)
          NULLIFY(dxancfi(i)%p)
          NULLIFY(dvancfi(i)%p)
          NULLIFY(penfia(i)%p)
          NULLIFY(alphakfi(i)%p)
          NULLIFY(daancfi(i)%p)
          NULLIFY(diag_smsfi(i)%p)
C
          NULLIFY(nodnxfi(i)%p)
          NULLIFY(nodamsfi(i)%p)
          NULLIFY(procamsfi(i)%p)
C
C Int20 edge
          NULLIFY(nsvfie(i)%p)
          NULLIFY(nsnfie(i)%p)
          NULLIFY(itafie(i)%p)
          NULLIFY(msfie(i)%p)
          NULLIFY(stifie(i)%p)
          NULLIFY(gapfie(i)%p)
          NULLIFY(xfie(i)%p)
          NULLIFY(vfie(i)%p)
          NULLIFY(nsvsie(i)%p)
          NULLIFY(nsnsie(i)%p)
          NULLIFY(afie(i)%p)
          NULLIFY(stnfie(i)%p)
          NULLIFY(vscfie(i)%p)
          NULLIFY(penfie(i)%p)
          NULLIFY(fskyfie(i)%p)
          NULLIFY(iskyfie(i)%p)
          NULLIFY(daanc6fie(i)%p)
          NULLIFY(dxancfie(i)%p)
          NULLIFY(dvancfie(i)%p)
          NULLIFY(penfiae(i)%p)
          NULLIFY(alphakfie(i)%p)
          NULLIFY(daancfie(i)%p)
C    
          NULLIFY(nodnxfie(i)%p)
          NULLIFY(nodamsfie(i)%p)
          NULLIFY(diag_smsfie(i)%p)
          NULLIFY(procamsfie(i)%p)
C I18KINE
          NULLIFY(mtfi_pene(i)%p)
          NULLIFY(mtfi_penemin(i)%p)
          NULLIFY(mtfi_v(i)%p)
          NULLIFY(mtfi_a(i)%p)
C INT24 & 25
          NULLIFY(time_sfi(i)%P)
          NULLIFY(irtlm_fi(i)%P)
          NULLIFY(secnd_frfi(i)%P)
          NULLIFY(stif_oldfi(i)%P)
          NULLIFY(pene_oldfi(i)%P)
          NULLIFY(icont_i_fi(i)%P)
          NULLIFY(isedge_fi(i)%P)
          NULLIFY(irtse_fi(i)%P)
          NULLIFY(is2pt_fi(i)%P)
          NULLIFY(ispt2_fi(i)%P)
          NULLIFY(isegpt_fi(i)%P)
          NULLIFY(is2se_fi(i)%P)
          NULLIFY(remnor_fi(i)%P) 
          NULLIFY(kremnor_fi(i)%P)
C INT25
          NULLIFY(islide_fi(i)%P)
          NULLIFY(t2main_sms_fi(i)%p)
          NULLIFY(t2fac_sms_fi(i)%p)
          NULLIFY(candf_si(i)%P)
          NULLIFY(iskew_fi(i)%P)
          NULLIFY(icodt_fi(i)%P)
          IF(parameters%ISTIF_DT > 0 .OR. ipari(97,i)>0 ) THEN
             NULLIFY(stif_msdt_fi(i)%P)
             NULLIFY(stife_msdt_fi(i)%P)
          ENDIF
C INT25 E2E
C         NULLIFY(MAIN_FIE(I)%P)
          NULLIFY(gape_l_fie(i)%P)
          NULLIFY(edg_bisector_fie(i)%P)
          NULLIFY(vtx_bisector_fie(i)%P)
          NULLIFY(ledge_fie(i)%P)
          NULLIFY(x_seg_fie(i)%P)
C
           NULLIFY(efricfi(i)%P)  
           NULLIFY(efricgfi(i)%P)                
        END DO
C
        IF(intheat /= 0) THEN
          DO i=1,ninter
            NULLIFY(fthefi(i)%p)
            NULLIFY(ftheskyfi(i)%p)
            NULLIFY(tempfi(i)%p)
            NULLIFY(matsfi(i)%p)
            NULLIFY(areasfi(i)%p)
            NULLIFY(nmtemp(i)%p)
          END DO    
         IF(interadhesion /= 0) THEN
          DO i=1,ninter
            NULLIFY(if_adhfi(i)%P)
          ENDDO
         ENDIF
         IF(idt_therm == 1) THEN  
          DO i=1,ninter
            NULLIFY(condnfi(i)%p)
            NULLIFY(condnskyfi(i)%p)
          ENDDO
         ENDIF       
        ENDIF
        IF(intheat /= 0.OR.nintloadp21 > 0) THEN
          DO i=1,ninter
            NULLIFY(nmnfi(i)%p)
            NULLIFY(nmvfi(i)%p)
            NULLIFY(nmnsi(i)%p)
            NULLIFY(nmvsi(i)%p)
            NULLIFY(tempnod(i)%p)
          END DO 
        ENDIF
        IF(nintloadp21 > 0) THEN
          DO i=1,ninter
            NULLIFY(tagncontfi(i)%p)
          END DO 
        ENDIF
C
        IF(ninterfric > 0 ) THEN
          DO i=1,ninter
            NULLIFY(ipartfricsfi(i)%p) 
            NULLIFY(ipartfric_fie(i)%p) 
          ENDDO
        ENDIF
C
        IF(nitsche > 0 ) THEN
          DO i=1,ninter
            NULLIFY(forneqsfi(i)%p) 
          ENDDO   
        ENDIF
C        
        IF(ierror/=0) THEN
          CALL ancmsg(msgid=20,anmode=aninfo)
          CALL arret(2)
        ENDIF
C
C Allocation and reading Strings Interfaces on Restart file (integer part)
C
        nbintc = 0
        DO i =1, ninter
          ityp = ipari(7,i)
          ivis2 = ipari(14,i) ! ivis2==-1 : Flag for interface adhesion
          igap = ipari(21,i)
          inacti = ipari(22,i)
          intth = ipari(47,i)
          intfric = ipari(72,i)
          flagremn = ipari(63,i)
          intnitsche = ipari(86,i)
          itied = ipari(85,i)
          nsn =ipari(5,i)
 
          IF(ityp==24) THEN
             iedge4 = ipari(59,i)
          ELSE
             iedge4 = 0
          ENDIF
          IF(ityp==7.OR.ityp==10.OR.ityp==11.OR.
     +      (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
     +       ityp==22.OR.ityp==23.OR.ityp==24.OR.
     +       ityp==25)THEN
C
            nbintc = nbintc + 1
            ALLOCATE(nsnsi(i)%P(nspmd),stat=ierror)
            ALLOCATE(nsnfi(i)%P(nspmd),stat=ierror1)
 
 
            IF(ierror+ierror1/=0) THEN
              CALL ancmsg(msgid=20,anmode=aninfo)
              CALL arret(2)
            ENDIF
            CALL read_i_c(nsnsi(i)%P(1),nspmd)
            CALL read_i_c(nsnfi(i)%P(1),nspmd)
            lens = 0
            lenr = 0
            DO p = 1, nspmd
              lens = lens + nsnsi(i)%P(p)
              lenr = lenr + nsnfi(i)%P(p)
            END DO
C
            ierror = 0
C
            ierror1 = 0
            IF(lens>0) THEN
              ALLOCATE(nsvsi(i)%P(lens),stat=ierror1)
              CALL read_i_c(nsvsi(i)%P(1),lens)
              ierror = ierror + ierror1
            ENDIF
            ALLOCATE(candf_si(i)%P(nsn),stat=ierror1)      
            candf_si(i)%P(1:nsn)=0
C
            IF(lenr>0) THEN
              ALLOCATE(nsvfi(i)%P(lenr),stat=ierror1)
              ierror = ierror + ierror1
              CALL read_i_c(nsvfi(i)%P(1),lenr)
              IF(ityp==7.OR.ityp==10.OR.
     +           ityp==20.OR.ityp==22.OR.
     +           ityp==23.OR.ityp==24.OR.
     +           ityp==25)THEN
               ALLOCATE(itafi(i)%P(lenr),stat=ierror1)
               ierror = ierror + ierror1
               CALL read_i_c(itafi(i)%P(1),lenr)
               IF(ityp==7.OR.ityp==20.OR.ityp==22.OR.
     +            ityp==23.OR.ityp==24.OR.ityp==25)THEN
                 ALLOCATE(kinfi(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
                 CALL read_i_c(kinfi(i)%P(1),lenr)
C
                 IF(ityp==20)THEN
                   ALLOCATE(nbinflfi(i)%P(lenr),stat=ierror1)
                   ierror = ierror + ierror1
                   CALL read_i_c(nbinflfi(i)%P(1),lenr)
                 END IF
C
                 IF(intth > 0 ) THEN
                  ALLOCATE(matsfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror
                  CALL read_i_c(matsfi(i)%P(1),lenr) 
                 ENDIF
                 IF((ityp==7.OR.ityp==24.OR.ityp==25).AND.intfric > 0) THEN
                  ALLOCATE(ipartfricsfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror
                  CALL read_i_c(ipartfricsfi(i)%P(1),lenr) 
                 ENDIF
C                
                 IF (ityp==24)THEN
                  IF(.NOT.ASSOCIATED(irtlm_fi(i)%P))
     *                      ALLOCATE(irtlm_fi(i)%P(2,lenr),stat=ierror1)
 
                  CALL read_i_c(irtlm_fi(i)%P(1,1),2*lenr)
                  IF(.NOT.ASSOCIATED(icont_i_fi(i)%P))
     *                      ALLOCATE(icont_i_fi(i)%P(lenr),stat=ierror1)
                  CALL read_i_c(icont_i_fi(i)%P(1),lenr)
 
                  IF(.NOT.ASSOCIATED(isedge_fi(i)%P))
     *                      ALLOCATE(isedge_fi(i)%P(lenr),stat=ierror1)
                  CALL read_i_c(isedge_fi(i)%P(1),lenr)
 
                  IF(iedge4 >0)THEN
                      IF(.NOT.ASSOCIATED(irtse_fi(i)%P))
     *                      ALLOCATE(irtse_fi(i)%P(5,lenr),stat=ierror1)
                      CALL read_i_c(irtse_fi(i)%P(1,1),5*lenr)
 
                      IF(.NOT.ASSOCIATED(is2pt_fi(i)%P))
     *                      ALLOCATE(is2pt_fi(i)%P(lenr),stat=ierror1)
                      CALL read_i_c(is2pt_fi(i)%P(1),lenr)
 
                      IF(.NOT.ASSOCIATED(ispt2_fi(i)%P))
     *                      ALLOCATE(ispt2_fi(i)%P(lenr),stat=ierror1)
                      CALL read_i_c(ispt2_fi(i)%P(1),lenr)
 
                      IF(.NOT.ASSOCIATED(isegpt_fi(i)%P))
     *                      ALLOCATE(isegpt_fi(i)%P(lenr),stat=ierror1)
                      CALL read_i_c(isegpt_fi(i)%P(1),lenr)
 
                      IF(.NOT.ASSOCIATED(is2se_fi(i)%P))
     *                      ALLOCATE(is2se_fi(i)%P(2,lenr),stat=ierror1)
                      CALL read_i_c(is2se_fi(i)%P(1,1),2*lenr)
 
                  ENDIF
                  IF(intnitsche >0)THEN
                      IF(.NOT.ASSOCIATED(forneqsfi(i)%P))
     *                      ALLOCATE(forneqsfi(i)%P(3,lenr),stat=ierror1)
                      CALL read_i_c(forneqsfi(i)%P(1,1),3*lenr)
                  ENDIF
 
                 ENDIF
C
                 IF (ityp==25)THEN
                  IF(.NOT.ASSOCIATED(pmainfi(i)%P))
     *                      ALLOCATE(pmainfi(i)%P(lenr),stat=ierror1)
                  CALL read_i_c(pmainfi(i)%P(1),lenr)
                  IF(.NOT.ASSOCIATED(irtlm_fi(i)%P))
     *                      ALLOCATE(irtlm_fi(i)%P(4,lenr),stat=ierror1)
                  CALL read_i_c(irtlm_fi(i)%P(1,1),4*lenr)
                  IF(.NOT.ASSOCIATED(icont_i_fi(i)%P))
     *                      ALLOCATE(icont_i_fi(i)%P(lenr),stat=ierror1)
                  CALL read_i_c(icont_i_fi(i)%P(1),lenr)
 
                  IF(.NOT.ASSOCIATED(icodt_fi(i)%P))
     *                      ALLOCATE(icodt_fi(i)%P(lenr),stat=ierror1)
C                 CALL READ_I_C(ICODT_FI(I)%P(1),LENR)
                  icodt_fi(i)%P(1:lenr) = 0
 
                  IF(.NOT.ASSOCIATED(iskew_fi(i)%P))
     *                      ALLOCATE(iskew_fi(i)%P(lenr),stat=ierror1)
                  iskew_fi(i)%P(1:lenr) = 0
 
C                 CALL READ_I_C(ISKEW_FI(I)%P(1),LENR)
 
                  IF(.NOT.ASSOCIATED(islide_fi(i)%P))
     *                      ALLOCATE(islide_fi(i)%P(4,lenr),stat=ierror1)
C                 no need in restart file
                  islide_fi(i)%P(1:4,1:lenr)=0
C Remove banned main segment
                  IF(flagremn==2) THEN
                    IF(.NOT.ASSOCIATED(kremnor_fi(i)%P))
     *                      ALLOCATE(kremnor_fi(i)%P(lenr+1),stat=ierror1)
                    CALL read_i_c(kremnor_fi(i)%P(1),lenr+1)
                    sizremnorfi = kremnor_fi(i)%P(lenr+1)
                    IF(sizremnorfi /= 0) THEN
                      IF(.NOT.ASSOCIATED(remnor_fi(i)%P))
     *                      ALLOCATE(remnor_fi(i)%P(sizremnorfi),stat=ierror1)
                      CALL read_i_c(remnor_fi(i)%P(1),sizremnorfi)
                    ELSE IF(sizremnorfi == 0) THEN
                      IF(.NOT.ASSOCIATED(remnor_fi(i)%P))
     *                      ALLOCATE(remnor_fi(i)%P(sizremnorfi),stat=ierror1)
                    ENDIF
                   ENDIF
                  ENDIF
                END IF
C
               IF(idtmins_old == 2) THEN
                ALLOCATE (nodnxfi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(nodnxfi(i)%P(1),lenr)
                ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(nodamsfi(i)%P(1),lenr)
                ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(procamsfi(i)%P(1),lenr)
                IF (ityp==24) THEN
                  ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
                  ierror = ierror + ierror1
                  CALL read_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
                ENDIF
               ELSEIF(idtmins_int_old /= 0) THEN
                ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(nodamsfi(i)%P(1),lenr)
                ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(procamsfi(i)%P(1),lenr)
                IF (ityp==24) THEN
                  ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
                  ierror = ierror + ierror1
                  CALL read_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
                ENDIF
               ENDIF 
C
               IF(idtmins==2) THEN
                 IF(.NOT.ASSOCIATED(nodnxfi(i)%P)) THEN
                   ALLOCATE (nodnxfi(i)%P(lenr),stat=ierror1)
                   ierror = ierror + ierror1
                   nodnxfi(i)%P(1:lenr)=0
                 ENDIF
                 IF(.NOT.ASSOCIATED(nodamsfi(i)%P)) THEN
                   ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
                   ierror = ierror + ierror1
                   nodamsfi(i)%P(1:lenr)=0
                 ENDIF
                 IF(.NOT.ASSOCIATED(procamsfi(i)%P)) THEN
                   ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
                   ierror = ierror + ierror1
                   procamsfi(i)%P(1:lenr)=0
                 ENDIF
                 IF (ityp==24) THEN
                   IF(.NOT.ASSOCIATED(t2main_sms_fi(i)%P)) THEN
                     ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
                     ierror = ierror + ierror1
                     t2main_sms_fi(i)%P(1:6,1:lenr)=0
                   ENDIF
                 ENDIF
               ELSEIF(idtmins_int /= 0) THEN
                 IF(.NOT.ASSOCIATED(nodamsfi(i)%P)) THEN
                   ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
                   ierror = ierror + ierror1
                   nodamsfi(i)%P(1:lenr)=0
                 ENDIF
                 IF(.NOT.ASSOCIATED(procamsfi(i)%P)) THEN
                   ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
                   ierror = ierror + ierror1
                   procamsfi(i)%P(1:lenr)=0
                 ENDIF
                 IF (ityp==24) THEN
                   IF(.NOT.ASSOCIATED(t2main_sms_fi(i)%P)) THEN
                     ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
                     ierror = ierror + ierror1
                     t2main_sms_fi(i)%P(1:6,1:lenr)=0
                   ENDIF
                 ENDIF           
               END IF
C
               ALLOCATE(msfi(i)%P(lenr),stat=ierror1)
               ierror = ierror + ierror1
               ALLOCATE(stifi(i)%P(lenr),stat=ierror1)
               ierror = ierror + ierror1
               IF(igap/=0)THEN
                ALLOCATE(gapfi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                 IF(igap==3)THEN
                  ALLOCATE(gap_lfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                 END IF
               END IF
               ALLOCATE(xfi(i)%P(3,lenr),stat=ierror1)
               ierror = ierror + ierror1
               ALLOCATE(vfi(i)%P(3,lenr),stat=ierror1)
               ierror = ierror + ierror1
 
               IF(iparit==0) THEN
                ALLOCATE(afi(i)%P(3,lenr*nthread),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(stnfi(i)%P(lenr*nthread),stat=ierror1)
                ierror = ierror + ierror1
                IF(kdtint/=0)THEN
                  ALLOCATE(vscfi(i)%P(lenr*nthread),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
 
                DO k=1,lenr*nthread
                   afi(i)%P(1,k)=zero
                   afi(i)%P(2,k)=zero
                   afi(i)%P(3,k)=zero
                   stnfi(i)%P(k)=zero
                ENDDO
 
                IF(kdtint/=0)THEN
                   vscfi(i)%P(1:lenr*nthread)=zero
                ENDIF
 
 
                nlskyfi(i) = lenr
C
                IF(intth > 0 )THEN    
                 ALLOCATE(fthefi(i)%P(lenr*nthread),stat=ierror1)
                 ierror = ierror + ierror1
 
                 fthefi(i)%P(1:lenr*nthread)=zero
 
                 ALLOCATE(tempfi(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
c                  ALLOCATE(MATSFI(I)%P(LENR),STAT=IERROR1)
c                 IERROR = IERROR + IERROR
                ENDIF
                IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
                  ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
C
                IF(ityp == 25.AND.ivis2==-1) THEN
                  ALLOCATE(if_adhfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
C
                IF(idt_therm ==1.AND.intth > 0) THEN
                 ALLOCATE(condnfi(i)%P(lenr*nthread),stat=ierror1)
                 ierror = ierror + ierror1
                 condnfi(i)%P(1:lenr*nthread)=zero
                ENDIF
               ELSE
 
 
                nlskyfi(i) = 0 
                lskyfi = 0
 
 
                IF(intth > 0 )  THEN      
                 ALLOCATE(tempfi(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
                ENDIF
C
                IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
                  ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
                IF(ityp == 25.AND.ivis2==-1) THEN
                  ALLOCATE(if_adhfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
C  
               END IF
               IF(ityp == 24)THEN
                 ALLOCATE(time_sfi(i)%P(lenr),stat=ierror1)
                 time_sfi(i)%P(1:lenr)=zero
                 ierror = ierror + ierror1
               ELSEIF(ityp == 25)THEN
                 ALLOCATE(time_sfi(i)%P(2*lenr),stat=ierror1)
                 time_sfi(i)%P(1:2*lenr)=zero
                 ierror = ierror + ierror1
               END IF
               IF(ityp == 24 .OR. ityp == 25)THEN
                 ALLOCATE(secnd_frfi(i)%P(6,lenr),stat=ierror1)
                 secnd_frfi(i)%P(1:6,1:lenr)=zero
                 ierror = ierror + ierror1
                 ALLOCATE(pene_oldfi(i)%P(5,lenr),stat=ierror1)
                 pene_oldfi(i)%P(1:5,1:lenr)=zero
                 ierror = ierror + ierror1
                 ALLOCATE(stif_oldfi(i)%P(2,lenr),stat=ierror1)
                 stif_oldfi(i)%P(1:2,1:lenr)=zero
                 ierror = ierror + ierror1
 
                 IF(ipari(97,i) > 0) THEN
                    ALLOCATE(stif_msdt_fi(i)%P(lenr))
                    stif_msdt_fi(i)%P(1:lenr)=zero
                 ENDIF
 
                 IF(ityp == 25.AND.parameters%INTCAREA > 0.AND.ipari(36,i)>0) THEN
                   ALLOCATE(intareanfi(i)%P(lenr),stat=ierror1)
                   ierror = ierror + ierror1
                   intareanfi(i)%P(1:lenr) =zero
                ENDIF
                 IF(ityp == 24.AND.parameters%INTCAREA > 0) THEN
                   ALLOCATE(intareanfi(i)%P(lenr),stat=ierror1)
                   ierror = ierror + ierror1
                   intareanfi(i)%P(1:lenr) =zero
                ENDIF
               ENDIF
              ELSEIF(ityp==11)THEN
C type11
               ALLOCATE(itafi(i)%P(2*lenr),stat=ierror1)
               ierror = ierror + ierror1
               CALL read_i_c(itafi(i)%P(1),2*lenr)
C
               IF(idtmins_old == 2) THEN
                ALLOCATE (nodnxfi(i)%P(2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(nodnxfi(i)%P(1),2*lenr)
                ALLOCATE (nodamsfi(i)%P(2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(nodamsfi(i)%P(1),2*lenr)
                ALLOCATE (procamsfi(i)%P(2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(procamsfi(i)%P(1),2*lenr)
               ELSEIF(idtmins_int_old /= 0) THEN
                ALLOCATE (nodamsfi(i)%P(2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(nodamsfi(i)%P(1),2*lenr)
                ALLOCATE (procamsfi(i)%P(2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(procamsfi(i)%P(1),2*lenr)
               ENDIF 
C
                 IF(intth > 0 ) THEN
                  ALLOCATE(matsfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                  CALL read_i_c(matsfi(i)%P(1),lenr) 
                 ENDIF
C
                 IF(intfric > 0) THEN
                  ALLOCATE(ipartfricsfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror
                  CALL read_i_c(ipartfricsfi(i)%P(1),lenr) 
                 ENDIF
C 
               ALLOCATE(msfi(i)%P(2*lenr),stat=ierror1)
               ierror = ierror + ierror1
               ALLOCATE(stifi(i)%P(lenr),stat=ierror1)
               ierror = ierror + ierror1
               IF(igap/=0)THEN
                ALLOCATE(gapfi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                 IF(igap==3)THEN
                  ALLOCATE(gap_lfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                 END IF
               END IF
               ALLOCATE(xfi(i)%P(3,2*lenr),stat=ierror1)
               ierror = ierror + ierror1
               ALLOCATE(vfi(i)%P(3,2*lenr),stat=ierror1)
               ierror = ierror + ierror1
               IF(inacti==5.OR.inacti==6) THEN
                 ALLOCATE(penfi(i)%P(2,lenr),stat=ierror1)
               END IF
               IF(iparit==0) THEN
                ALLOCATE(afi(i)%P(3,2*lenr*nthread),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(stnfi(i)%P(2*lenr*nthread),stat=ierror1)
                ierror = ierror + ierror1
                IF(kdtint/=0)THEN
                  ALLOCATE(vscfi(i)%P(2*lenr*nthread),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
                IF(intth > 0 )THEN    
                 ALLOCATE(fthefi(i)%P(2*lenr*nthread),stat=ierror1)
                 ierror = ierror + ierror1
                  ALLOCATE(tempfi(i)%P(2*lenr),stat=ierror1)
                 ierror = ierror + ierror1
c                  ALLOCATE(MATSFI(I)%P(LENR),STAT=IERROR1)
c                 IERROR = IERROR + IERROR
                  ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
                ENDIF
                IF(idt_therm ==1.AND.intth > 0) THEN
                 ALLOCATE(condnfi(i)%P(2*lenr*nthread),stat=ierror1)
                 ierror = ierror + ierror1
                ENDIF
                nlskyfi(i) = 2*lenr
 
               ELSE 
                lskyfi = 0
                nlskyfi(i) = 0
 
                IF(intth > 0 )  THEN      
                 ALLOCATE(tempfi(i)%P(2*lenr),stat=ierror1)
                 ierror = ierror + ierror1
c                  ALLOCATE(MATSFI(I)%P(LENR),STAT=IERROR1)
c                 IERROR = IERROR + IERROR
                ENDIF
 
                IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
                  ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
               END IF
C fin type11
              ELSEIF(ityp==17)THEN
               ALLOCATE(xfi17(i)%P(3,16,lenr),stat=ierror1)
               ierror = ierror + ierror1
               ALLOCATE(vfi17(i)%P(3,16,lenr),stat=ierror1)
               ierror = ierror + ierror1
               ALLOCATE(frotsfi(i)%P(7,lenr),stat=ierror1)
               ierror = ierror + ierror1
               ALLOCATE(ksfi(i)%P(2,lenr),stat=ierror1)
               ierror = ierror + ierror1
               ALLOCATE(eminxfi(i)%P(6,lenr),stat=ierror1)
               ierror = ierror + ierror1
               IF(iparit==0) THEN
                ALLOCATE(afi17(i)%P(3,16,lenr),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(stnfi17(i)%P(16,lenr),stat=ierror1)
                ierror = ierror + ierror1
                nlskyfi(i) = 0
               ELSE
                lskyfi = lenr * multimax
                nlskyfi(i) = lskyfi
 
                ALLOCATE(iskyfi(i)%P(lskyfi),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(fskyfi(i)%P(40,lskyfi),stat=ierror1)
                ierror = ierror + ierror1
               END IF
C fin type 17
              END IF
C Lenr case = 0, we don't need an iskyfi and fskyfi table
            ELSE
              nlskyfi(i) = 0
            ENDIF
C
            IF(ierror/=0) THEN
              CALL ancmsg(msgid=20,anmode=aninfo)
              CALL arret(2)
            ENDIF
C
            IF(ityp==20)THEN
              ALLOCATE(daanc6fi(i)%P(3,6,lenr),stat=ierror1)
              ierror = ierror + ierror1
              ALLOCATE(dxancfi(i)%P(3,lenr),stat=ierror1)
              ierror = ierror + ierror1
              ALLOCATE(dvancfi(i)%P(3,lenr),stat=ierror1)
              ierror = ierror + ierror1
              IF((inacti==5.OR.inacti==6) .AND. lenr > 0) THEN
                ALLOCATE(penfi(i)%P(2,lenr),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(penfia(i)%P(5,lenr),stat=ierror1)
                ierror = ierror + ierror1
              END IF
              IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
                ALLOCATE (diag_smsfi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
              ENDIF 
              ALLOCATE(alphakfi(i)%P(lenr),stat=ierror1)
              ierror = ierror + ierror1
              ALLOCATE(daancfi(i)%P(3,lenr),stat=ierror1)
              daancfi(i)%P(1:3,1:lenr)=zero
              ierror = ierror + ierror1
              IF(ierror/=0) THEN
                CALL ancmsg(msgid=20,anmode=aninfo)
                CALL arret(2)
              END IF                   
C type20 edge
              ALLOCATE(nsnsie(i)%P(nspmd),stat=ierror1)
              ierror = ierror + ierror1
              ALLOCATE(nsnfie(i)%P(nspmd),stat=ierror1)
              ierror = ierror + ierror1
              CALL read_i_c(nsnsie(i)%P(1),nspmd)
              CALL read_i_c(nsnfie(i)%P(1),nspmd)
              lens = 0
              lenr = 0
              DO p = 1, nspmd
                lens = lens + nsnsie(i)%P(p)
                lenr = lenr + nsnfie(i)%P(p)
              END DO
C
              IF(lens>0) THEN
                ALLOCATE(nsvsie(i)%P(lens),stat=ierror1)
                CALL read_i_c(nsvsie(i)%P(1),lens)
                ierror = ierror + ierror1
              ENDIF
C
              IF(lenr>0) THEN
                ALLOCATE(nsvfie(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(nsvfie(i)%P(1),lenr)
                ALLOCATE(itafie(i)%P(2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(itafie(i)%P(1),2*lenr)
                ALLOCATE(msfie(i)%P(2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(stifie(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                IF(igap/=0)THEN
                  ALLOCATE(gapfie(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                END IF
                ALLOCATE(xfie(i)%P(3,2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(vfie(i)%P(3,2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                IF(inacti==5.OR.inacti==6) THEN
                  ALLOCATE(penfie(i)%P(2,lenr),stat=ierror1)
                  ierror = ierror + ierror1
                  ALLOCATE(penfiae(i)%P(5,2*lenr),stat=ierror1)
                  ierror = ierror + ierror1
                END IF
                IF(iparit==0) THEN
                  ALLOCATE(afie(i)%P(3,2*lenr*nthread),stat=ierror1)
                  ierror = ierror + ierror1
                  ALLOCATE(stnfie(i)%P(2*lenr*nthread),stat=ierror1)
                  ierror = ierror + ierror1
                  IF(kdtint/=0)THEN
                    ALLOCATE(vscfie(i)%P(2*lenr*nthread),stat=ierror1)
                    ierror = ierror + ierror1
                  ENDIF
                  nlskyfie(i) = 2*lenr
                ELSE
                  lskyfi = lenr * multimax
                  nlskyfie(i) = lskyfi
                  ALLOCATE(iskyfie(i)%P(lskyfi),stat=ierror1)
                  ierror = ierror + ierror1
                  IF(kdtint==0) THEN
C                   ALLOCATE(FSKYFIE(I)%P(8,LSKYFI),STAT=IERROR1)
                    ALLOCATE(fskyfie(i)%P(10,lskyfi),stat=ierror1)
 
                  ELSE
                    ALLOCATE(fskyfie(i)%P(10,lskyfi),stat=ierror1)
                  END IF
                  ierror = ierror + ierror1
                END IF
                ALLOCATE(daanc6fie(i)%P(3,6,2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(dxancfie(i)%P(3,2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(dvancfie(i)%P(3,2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(alphakfie(i)%P(2*lenr),stat=ierror1)
                ierror = ierror + ierror1
                ALLOCATE(daancfie(i)%P(3,lenr),stat=ierror1)
                ierror = ierror + ierror1
                IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
                  ALLOCATE (diag_smsfie(i)%P(lenr),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
C
                IF(idtmins_old == 2) THEN
                 ALLOCATE (nodnxfie(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
                 CALL read_i_c(nodnxfie(i)%P(1),lenr)
                 ALLOCATE (nodamsfie(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
                 CALL read_i_c(nodamsfie(i)%P(1),lenr)
                 ALLOCATE (procamsfie(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
                 CALL read_i_c(procamsfie(i)%P(1),lenr)
                ELSEIF(idtmins_int_old /= 0) THEN
                 ALLOCATE (nodamsfie(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
                 CALL read_i_c(nodamsfie(i)%P(1),lenr)
                 ALLOCATE (procamsfie(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
                 CALL read_i_c(procamsfie(i)%P(1),lenr)
                ENDIF 
C
                IF(ierror/=0) THEN
                  CALL ancmsg(msgid=20,anmode=aninfo)
                  CALL arret(2)
                END IF
C Lenr case = 0, we don't need an iskyfi and fskyfi table
              ELSE
                nlskyfie(i) = 0
              END IF
            END IF         ! Fin type20 edge
 
            IF(ityp == 25 ) THEN 
              ALLOCATE(edge_fi(i)%P(nspmd))
              ALLOCATE(nsnsie(i)%P(nspmd),stat=ierror1)
              ALLOCATE(nsnfie(i)%P(nspmd),stat=ierror1)
              edge_fi(i)%P(1:nspmd) = 0
              nsnsie(i)%P(1:nspmd) = 0
              nsnfie(i)%P(1:nspmd) = 0
 
              IF(ipari(58,i) /=0) THEN 
 
                CALL read_i_c(nsnsie(i)%P(1),nspmd)
                CALL read_i_c(nsnfie(i)%P(1),nspmd)
 
                lens_edge = 0
                lenr_edge = 0
                DO p = 1, nspmd
                  lens_edge = lens_edge + nsnsie(i)%P(p)
                  lenr_edge = lenr_edge + nsnfie(i)%P(p)
                END DO
C
                IF(lens_edge>0) THEN
                  ALLOCATE(nsvsie(i)%P(lens_edge),stat=ierror1)
                  CALL read_i_c(nsvsie(i)%P(1),lens_edge)
                  ierror = ierror + ierror1
                ENDIF
C
                IF(iparit == 0) THEN
                   nlskyfie(i) = lenr_edge*2
                   ALLOCATE(afie(i)%P(3,2*lenr_edge*nthread),stat=ierror1)
                   ierror = ierror + ierror1
                   ALLOCATE(stnfie(i)%P(2*lenr_edge*nthread),stat=ierror1)
                   ierror = ierror + ierror1
                   IF(kdtint/=0)THEN
                     ALLOCATE(vscfie(i)%P(2*lenr_edge*nthread),stat=ierror1)
                     ierror = ierror + ierror1
                   ENDIF
                ELSE
                  lskyfi = lenr_edge * multimax
                  nlskyfie(i) = lskyfi
                  ALLOCATE(iskyfie(i)%P(lskyfi),stat=ierror1)
                  ierror = ierror + ierror1
                  IF(kdtint==0) THEN
                    ALLOCATE(fskyfie(i)%P(8,lskyfi),stat=ierror1)
                  ELSE
                    ALLOCATE(fskyfie(i)%P(8,lskyfi),stat=ierror1)
                  END IF
                  ierror = ierror + ierror1
                ENDIF
                IF(lenr_edge>0) THEN
                  ALLOCATE(nsvfie(i)%P(lenr_edge)) 
                  ALLOCATE(itafie(i)%P(lenr_edge*2))
                  ALLOCATE(ledge_fie(i)%P(e_ledge_size,lenr_edge)) 
                  ALLOCATE(xfie(i)%P(3,lenr_edge*2)) 
                  ALLOCATE(vfie(i)%P(3,lenr_edge*2)) 
                  ALLOCATE(msfie(i)%P(lenr_edge*2)) 
                  ALLOCATE(gapfie(i)%P(lenr_edge)) 
                  IF( igap == 3) THEN
                    ALLOCATE(gape_l_fie(i)%P(lenr_edge)) 
                  ENDIF
                  ALLOCATE(stifie(i)%P(lenr_edge)) 
                  ALLOCATE(edg_bisector_fie(i)%P(3,3,lenr_edge)) 
                  ALLOCATE(vtx_bisector_fie(i)%P(3,4,lenr_edge)) 
                  ALLOCATE(x_seg_fie(i)%P(3,4,lenr_edge)) 
                  edg_bisector_fie(i)%P(1:3,1:3,1:lenr_edge) = 0
                  vtx_bisector_fie(i)%P(1:3,1:4,1:lenr_edge) = 0
                  x_seg_fie(i)%P(1:3,1:4,1:lenr_edge) = 0
 
                  CALL read_i_c(nsvfie(i)%P,lenr_edge)
 
                  CALL read_i_c(ledge_fie(i)%P,e_ledge_size*lenr_edge)
                  ipari(69,i) = lenr_edge
                  IF(intfric > 0) THEN
                     ALLOCATE(ipartfric_fie(i)%P(lenr_edge),stat=ierror1)
                     CALL read_i_c(ipartfric_fie(i)%P,lenr_edge)
                  ENDIF
                  IF(ipari(97,i) > 0) THEN
                    ALLOCATE(stife_msdt_fi(i)%P(lenr_edge))
                    stife_msdt_fi(i)%P(1:lenr_edge)=zero
                  ENDIF
 
                ENDIF
              ENDIF
            ENDIF
 
C
C
            IF(ipari(36,i)>0.AND.ipari(7,i)/=17) THEN
C Output structure under interfaces
              ierror = 0
              ALLOCATE(nisubsfi(i)%P(nspmd),stat=ierror1)
              ierror = ierror + ierror1
              CALL read_i_c(nisubsfi(i)%P(1),nspmd)
              leni = 0
              lenr = 0
              DO p = 1, nspmd
                leni = leni + nisubsfi(i)%P(p)
                lenr = lenr + nsnfi(i)%P(p)
              END DO
 
              IF(leni>0) THEN
                IF(lenr>0) THEN
                  ALLOCATE(addsubsfi(i)%P(lenr+1),stat=ierror1)
                  ierror = ierror + ierror1
                  CALL read_i_c(addsubsfi(i)%P(1),lenr+1)
                END IF
                ALLOCATE(lisubsfi(i)%P(leni),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(lisubsfi(i)%P(1),leni)
                IF(ipari(7,i)==25.OR.ipari(7,i)==7.OR.ipari(7,i)==24.OR.ipari(7,i)==11)THEN
                  ALLOCATE(inflg_subsfi(i)%P(leni),stat=ierror1)
                  ierror = ierror + ierror1
                  CALL read_i_c(inflg_subsfi(i)%P(1),leni)
                END IF
              ELSE
                IF(lenr>0) THEN
                  ALLOCATE(addsubsfi(i)%P(lenr+1),stat=ierror1)
                  DO j=1,lenr+1
                    addsubsfi(i)%P(j)=1
                  END DO
                END IF
              END IF
              IF(ierror/=0) THEN
                CALL ancmsg(msgid=20,anmode=aninfo)
                CALL arret(2)
              END IF               
C =================== EDGES TO EDGE
C Output structure under interfaces
              IF(ipari(7,i) == 25 .AND. ipari(58,i) > 0) THEN
                ierror = 0
                ALLOCATE(nisubsfie(i)%P(nspmd),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_i_c(nisubsfie(i)%P(1),nspmd)
                leni = 0
                DO p = 1, nspmd
                  leni = leni + nisubsfie(i)%P(p)
                END DO
                IF(leni>0) THEN
                  IF(lenr_edge>0) THEN
                    ALLOCATE(addsubsfie(i)%P(lenr_edge+1),stat=ierror1)
                    ierror = ierror + ierror1
                    CALL read_i_c(addsubsfie(i)%P(1),lenr_edge+1)
                  END IF
                  ALLOCATE(lisubsfie(i)%P(leni),stat=ierror1)
                  ierror = ierror + ierror1
                  CALL read_i_c(lisubsfie(i)%P(1),leni)
                  ALLOCATE(inflg_subsfie(i)%P(leni),stat=ierror1)
                  ierror = ierror + ierror1
                  CALL read_i_c(inflg_subsfie(i)%P(1),leni)
                ELSE
                  IF(lenr_edge>0) THEN
                    ALLOCATE(addsubsfie(i)%P(lenr_edge+1),stat=ierror1)
                    DO j=1,lenr_edge+1
                      addsubsfie(i)%P(j)=1
                    END DO
                  END IF
                END IF
              ENDIF
            END IF
 
C
            IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT >0)THEN
              ierror = 0
              ALLOCATE(fnconti(i)%P(3,lenr),stat=ierror1)
              ierror = ierror + ierror1
              ALLOCATE(ftconti(i)%P(3,lenr),stat=ierror1)
              ierror = ierror + ierror1
              IF(ierror/=0) THEN
                CALL ancmsg(msgid=20,anmode=aninfo)
                CALL arret(2)
              ELSE
                DO j = 1, lenr
                  fnconti(i)%P(1,j)=zero
                  fnconti(i)%P(2,j)=zero
                  fnconti(i)%P(3,j)=zero
                  ftconti(i)%P(1,j)=zero
                  ftconti(i)%P(2,j)=zero
                  ftconti(i)%P(3,j)=zero
                END DO                  
              END IF                   
            END IF
          END IF
C
C Allocate and Read in RST file inter 21 structure for nodal temperature 
C                Actualisation
C
          IF(ityp==21) THEN
C
            IF(intth==2.OR.ipari(95,i) > 0) THEN
              nbintc = nbintc + 1
C
              ierror = 0
C
              ierror1 = 0
              ALLOCATE(nmnsi(i)%P(nspmd),stat=ierror1)
              ierror = ierror + ierror1
C
              ALLOCATE(nmnfi(i)%P(nspmd),stat=ierror1)
              ierror = ierror + ierror1
              IF(ierror/=0) THEN
                CALL ancmsg(msgid=20,anmode=aninfo)
                CALL arret(2)
              ENDIF
              CALL read_i_c(nmnsi(i)%P(1),nspmd)
              CALL read_i_c(nmnfi(i)%P(1),nspmd)
              lens = 0
              lenr = 0
              DO p = 1, nspmd
                lens = lens + nmnsi(i)%P(p)
                lenr = lenr + nmnfi(i)%P(p)
              END DO
C
              ierror = 0
C
              ierror1 = 0
              IF(lens>0) THEN
                ALLOCATE(nmvsi(i)%P(lens),stat=ierror1)
                CALL read_i_c(nmvsi(i)%P(1),lens)
                ierror = ierror + ierror1
 
                ALLOCATE(tempnod(i)%P(lens),stat=ierror1)
                CALL read_i_c(tempnod(i)%P(1),lens)
                ierror = ierror + ierror1
 
              ENDIF
C
              IF(lenr>0) THEN
                ALLOCATE(nmvfi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
 
                IF(ierror/=0) THEN
                  CALL ancmsg(msgid=20,anmode=aninfo)
                  CALL arret(2)
                ENDIF
 
                CALL read_i_c(nmvfi(i)%P(1),lenr)
 
                IF(ipari(95,i) > 0) THEN
                   ALLOCATE(tagncontfi(i)%P(lenr),stat=ierror1)
                   DO j = 1, lenr
                      tagncontfi(i)%P(j)=0
                   END DO           
                ENDIF
 
                IF(ipari(48,i) /= 0 )THEN 
                 IF(iparit==0) THEN   
                   ALLOCATE(fthefi(i)%P(lenr*nthread),stat=ierror1)
                   ierror = ierror + ierror1
 
                    fthefi(i)%P(1:lenr*nthread)=zero
                 ELSE
                    lskyfi = lenr * multimax
                    ALLOCATE(iskyfi(i)%P(lskyfi),stat=ierror1)
                    ierror = ierror + ierror1
                    ALLOCATE(ftheskyfi(i)%P(lskyfi),stat=ierror1)
                    ierror = ierror + ierror1
                    iskyfi(i)%P(1:lskyfi)=0
                    ftheskyfi(i)%P(1:lskyfi)=zero
                 ENDIF
                ENDIF
 
              ENDIF
C
 
           ENDIF
          ENDIF
        ENDDO
C Buffer Allocation Exchanges => replaced by Dynamic Alloc in the exchanges
       ENDIF
C
       
      ELSE
C Iflag = 2 Reading part Reel
       IF(ninter/=0) THEN
        DO i =1, ninter
          ityp = ipari(7,i)
          ivis2 = ipari(14,i) ! ivis2==-1 : Flag for interface adhesion
          igap = ipari(21,i)
          inacti = ipari(22,i)
          intth = ipari(47,i)
          IF(ityp==7.OR.ityp==10.OR.ityp==11.OR.
     +      (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
     +       ityp==22.OR.ityp==23.OR.ityp==24.OR.
     +       ityp==25)THEN
            lenr = 0
            DO p = 1, nspmd
              lenr = lenr + nsnfi(i)%P(p)
            END DO
            IF(lenr>0) THEN
              IF(ityp==7.OR.ityp==22.OR.ityp==23.OR.
     +           ityp==20.OR.ityp==10.OR.ityp==24.OR.
     +           ityp==25)THEN
                CALL read_db(msfi(i)%P(1),lenr)
                CALL read_db(stifi(i)%P(1),lenr)
                IF(igap/=0)THEN
                  CALL read_db(gapfi(i)%P(1),lenr)
                  IF(igap==3)THEN
                    CALL read_db(gap_lfi(i)%P(1),lenr)
                  END IF
                END IF
                CALL read_db(xfi(i)%P(1,1),3*lenr)
                CALL read_db(vfi(i)%P(1,1),3*lenr)
C
                IF((ityp == 7.OR.ityp == 20.OR.
     +              ityp==22.OR.ityp==23.OR.ityp==24.OR.
     +              ityp==25).AND.ipari(47,i) > 0) THEN
                  CALL read_db(tempfi(i)%P(1),lenr)
                ENDIF
                IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
                  CALL read_db(areasfi(i)%P(1),lenr)
                ENDIF
                IF(ityp == 25.AND.ivis2==-1) THEN
                  CALL read_i_c(if_adhfi(i)%P(1),lenr)
                ENDIF
 
 
C
              ELSEIF(ityp==11) THEN
                CALL read_db(msfi(i)%P(1),2*lenr)
                CALL read_db(stifi(i)%P(1),lenr)
                IF(igap/=0)THEN
                  CALL read_db(gapfi(i)%P(1),lenr)
                  IF(igap==3)THEN
                    CALL read_db(gap_lfi(i)%P(1),lenr)
                  END IF
                END IF
                CALL read_db(xfi(i)%P(1,1),3*2*lenr)
                CALL read_db(vfi(i)%P(1,1),3*2*lenr)
                IF(inacti==5.OR.inacti==6) THEN
                  CALL read_db(penfi(i)%P(1,1),2*lenr)
                END IF
                IF(ipari(47,i)>0) THEN
                  CALL read_db(tempfi(i)%P(1),2*lenr)
                  CALL read_db(areasfi(i)%P(1),lenr)
                ENDIF 
              ELSEIF(ityp==17.AND.ipari(33,i)==0)THEN
                CALL read_db(xfi17(i)%P(1,1,1),3*16*lenr)
                CALL read_db(vfi17(i)%P(1,1,1),3*16*lenr)
                CALL read_db(frotsfi(i)%P(1,1),7*lenr)
                CALL read_db(ksfi(i)%P(1,1),2*lenr)
                CALL read_db(eminxfi(i)%P(1,1),6*lenr)
              END IF
            END IF
          END IF
C Int 20 Specifique
          IF(ityp==20)THEN
C Addition anchoring
            IF(lenr>0) THEN
              CALL read_db(daanc6fi(i)%P(1,1,1),3*6*lenr)
              CALL read_db(dxancfi(i)%P(1,1),3*lenr)
              CALL read_db(dvancfi(i)%P(1,1),3*lenr)
              IF(inacti==5.OR.inacti==6) THEN
                CALL read_db(penfi(i)%P(1,1),2*lenr)
                CALL read_db(penfia(i)%P(1,1),5*lenr)
              END IF
              CALL read_db(daancfi(i)%P(1,1),3*lenr)
              CALL read_db(alphakfi(i)%P(1),lenr)                
              IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
                CALL read_db(diag_smsfi(i)%P(1),lenr)
              ENDIF 
            END IF
C Edge part addition
            lenr = 0
            DO p = 1, nspmd
              lenr = lenr + nsnfie(i)%P(p)
            END DO
            IF(lenr>0) THEN
              CALL read_db(msfie(i)%P(1),2*lenr)
              CALL read_db(stifie(i)%P(1),lenr)
              IF(igap/=0)THEN
                CALL read_db(gapfie(i)%P(1),lenr)
              END IF
              CALL read_db(xfie(i)%P(1,1),3*2*lenr)
              CALL read_db(vfie(i)%P(1,1),3*2*lenr)
              IF(inacti==5.OR.inacti==6) THEN
                CALL read_db(penfie(i)%P(1,1),2*lenr)
                CALL read_db(penfiae(i)%P(1,1),5*2*lenr)
              END IF
              CALL read_db(daanc6fie(i)%P(1,1,1),3*6*2*lenr)
              CALL read_db(dxancfie(i)%P(1,1),3*2*lenr)
              CALL read_db(dvancfie(i)%P(1,1),3*2*lenr)
              IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
                CALL read_db(diag_smsfie(i)%P(1),lenr)
              ENDIF 
            END IF
          END IF     ! fin partie type 20 edge
          IF (ityp==24)THEN
              CALL read_db(time_sfi(i)%P(1),lenr)
          ELSEIF(ityp==25)THEN
              CALL read_db(time_sfi(i)%P(1),2*lenr)
          END IF
          IF (ityp==24.OR.ityp==25)THEN
              CALL read_db(secnd_frfi(i)%P(1,1),6*lenr)
              CALL read_db(pene_oldfi(i)%P(1,1),5*lenr)
              CALL read_db(stif_oldfi(i)%P(1,1),2*lenr)
              IF(ipari(97,i) > 0) THEN
                 CALL read_db(stif_msdt_fi(i)%P(1),lenr) ! stif based on mass and dt
              ENDIF
              IF(ityp==25.AND.parameters%INTCAREA > 0.AND.ipari(36,i)>0) THEN
                 CALL read_db(intareanfi(i)%P(1),lenr) ! Area of secondary node
              ENDIF
              IF(ityp==24.AND.parameters%INTCAREA > 0) THEN
                 CALL read_db(intareanfi(i)%P(1),lenr) ! Area of secondary node
              ENDIF
          ENDIF  ! fin partie type 24 & 25
C
          IF (ityp==24) THEN
            IF(idtmins_old == 2) THEN
              ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
              ierror = ierror + ierror1
              CALL read_db(t2fac_sms_fi(i)%P(1),lenr)
            ELSEIF(idtmins_int_old /= 0) THEN
              ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
              ierror = ierror + ierror1
              CALL read_db(t2fac_sms_fi(i)%P(1),lenr)
            ENDIF 
C
            IF(idtmins==2) THEN
              IF(.NOT.ASSOCIATED(t2fac_sms_fi(i)%P)) THEN
                ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                t2fac_sms_fi(i)%P(1:lenr)=0
              ENDIF
            ELSEIF(idtmins_int /= 0) THEN
              IF(.NOT.ASSOCIATED(t2fac_sms_fi(i)%P)) THEN
                 ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
                 ierror = ierror + ierror1
                 t2fac_sms_fi(i)%P(1:lenr)=0
              ENDIF          
            END IF
          ENDIF
 
          IF(ityp == 25 ) THEN 
            IF(ipari(58,i) /=0) THEN   !E2E
              lenr = 0
              DO p = 1, nspmd
                lenr = lenr + nsnfie(i)%P(p)
              END DO
              IF(lenr>0) THEN
                CALL read_db(xfie(i)%P(1,1),3*(lenr*2))
                CALL read_db(vfie(i)%P(1,1),3*(lenr*2))
                CALL read_db(msfie(i)%P(1),lenr*2)
                CALL read_db(stifie(i)%P(1),lenr)
                CALL read_db(gapfie(i)%P(1),lenr)
                IF( igap == 3) THEN
                  CALL read_db(gape_l_fie(i)%P,lenr)
                ENDIF
                CALL read_r_c(edg_bisector_fie(i)%P(1,1,1),3*3*lenr)
                CALL read_r_c(vtx_bisector_fie(i)%P(1,1,1),3*4*lenr)
                CALL read_db(x_seg_fie(i)%P(1,1,1),3*4*lenr)
                IF(idtmins_old == 2) THEN
                 ALLOCATE(nodnxfie(i)%P(lenr*2))
                 CALL read_i_c(nodnxfie(i)%P(1),lenr*2)
                 ALLOCATE(nodamsfie(i)%P(lenr*2))
                 CALL read_i_c(nodamsfie(i)%P(1),lenr*2)
                 ALLOCATE(procamsfie(i)%P(lenr*2))
                 CALL read_i_c(procamsfie(i)%P(1),lenr*2)
                ELSEIF(idtmins_int_old /= 0) THEN
                 ALLOCATE(nodamsfie(i)%P(lenr*2))
                 CALL read_i_c(nodamsfie(i)%P(1),lenr*2)
                 ALLOCATE(procamsfie(i)%P(lenr*2))
                 CALL read_i_c(procamsfie(i)%P(1),lenr*2)
                ENDIF
 
                IF(ipari(97,i) > 0) THEN
                   CALL read_db(stife_msdt_fi(i)%P(1),lenr)
                ENDIF
              ENDIF
            ENDIF
          ENDIF
 
          IF(ityp==21) THEN
C
            IF(intth==2) THEN
C
              lenr = 0
              DO p = 1, nspmd
                 lenr = lenr + nmnfi(i)%P(p)
              END DO
C
              ierror = 0
C
              ierror1 = 0
C
              IF(lenr>0) THEN
                ALLOCATE(nmtemp(i)%P(lenr),stat=ierror1)
                ierror = ierror + ierror1
                CALL read_db(nmtemp(i)%P(1),lenr)
              ENDIF
              IF(ierror/=0) THEN
                CALL ancmsg(msgid=20,anmode=aninfo)
                CALL arret(2)
              ENDIF
            ENDIF
          ENDIF
C
        END DO
       END IF
      END IF
C
      RETURN

spmd_oldnumcd()

subroutine spmd_oldnumcd	(	integer, dimension(*)	renum,
		integer, dimension(*)	oldnum,
		integer	nsnr,
		integer	nsnrold,
		integer, intent(in)	intheat,
		integer, intent(in)	idt_therm,
		integer, intent(in)	nodadt_therm )

Definition at line 36 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN) :: INTHEAT
      INTEGER ,INTENT(IN) :: IDT_THERM
      INTEGER ,INTENT(IN) :: NODADT_THERM 
      INTEGER :: NSNR, NSNROLD
      INTEGER :: OLDNUM(*), RENUM(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
C old numbering of new candidates
C
      DO i = 1, nsnr 
        oldnum(i) = 0
      END DO
      DO i = 1, nsnrold
        IF(renum(i)>0)        ! case non-penetrated and non-retained element
     +    oldnum(renum(i)) = i
      END DO
C
      RETURN

spmd_rnum25()

subroutine spmd_rnum25	(	integer, dimension(*)	renum,
		integer	nin,
		integer	nsn,
		integer, dimension(*)	nsnfiold,
		integer	nsnrold )

Definition at line 320 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSNFIOLD(*), RENUM(*),
     .        NIN, NSN, NSNROLD
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      DO i = 1, nsnrold
        renum(i) = 0
      END DO
 
      ideb = 0
      jdeb = 0
      DO p = 1, nspmd
        i = 1
        j = 1
        DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
          IF(irem(1,j+jdeb)==
     +       nsvfi(nin)%P(i+ideb)) THEN
            renum(i+ideb) = j+jdeb
            i = i + 1
            j = j + 1
          ELSEIF(irem(1,j+jdeb)<
     +           nsvfi(nin)%P(i+ideb)) THEN
            j = j + 1
          ELSEIF(irem(1,j+jdeb)>
     +           nsvfi(nin)%P(i+ideb)) THEN
Case non-penetrated and non-retained candidate
            i = i + 1
          END IF
        END DO
        jdeb = jdeb + nsnfi(nin)%P(p)  
        ideb = ideb + nsnfiold(p)
      END DO
C
      RETURN

spmd_rnumcd()

subroutine spmd_rnumcd	(	integer, dimension(*)	cand_n,
		integer, dimension(*)	renum,
		integer	ii_stok,
		integer	nin,
		integer	nsn,
		integer, dimension(*)	nsnfiold,
		integer	nsnrold )

Definition at line 159 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
     .        NIN, NSN, NSNROLD,II_STOK
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      DO i = 1, nsnrold
        renum(i) = 0
      END DO
      i_stok = ii_stok
      ideb = 0
      jdeb = 0
      DO p = 1, nspmd
        i = 1
        j = 1
        DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
          IF(irem(1,j+jdeb)==
     +       nsvfi(nin)%P(i+ideb)) THEN
            renum(i+ideb) = j+jdeb
            i = i + 1
            j = j + 1
          ELSEIF(irem(1,j+jdeb)<
     +           nsvfi(nin)%P(i+ideb)) THEN
            j = j + 1
          ELSEIF(irem(1,j+jdeb)>
     +           nsvfi(nin)%P(i+ideb)) THEN
Case non-penetrated and non-retained candidate
            i = i + 1
          END IF
        END DO
        jdeb = jdeb + nsnfi(nin)%P(p)  
        ideb = ideb + nsnfiold(p)
      END DO
C
C renumbering of old candidates according to new numbers
C
      DO i = 1, i_stok
        ni = cand_n(i)
        IF(ni>nsn) THEN
          ni = ni - nsn
          cand_n(i) = renum(ni) + nsn
        END IF        
        
      END DO
C
      RETURN

spmd_rnumcd10()

subroutine spmd_rnumcd10	(	integer, dimension(*)	cand_n,
		integer, dimension(*)	renum,
		integer	ii_stok,
		integer	nin,
		integer	nsn,
		integer, dimension(*)	nsnfiold,
		integer	nsnrold )

Definition at line 236 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
     .        NIN, NSN, NSNROLD,II_STOK
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      LOGICAL ISFOUND
      DO i = 1, nsnrold
        renum(i) = 0
      END DO
      i_stok = ii_stok
      ideb = 0
      jdeb = 0
      isfound = .false.
      DO p = 1, nspmd
        i = 1
        j = 1
        DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
 
          IF(irem(1,j+jdeb)==
     +       nsvfi(nin)%P(i+ideb)) THEN
            renum(i+ideb) = j+jdeb
            i = i + 1
            j = j + 1
          ELSEIF(irem(1,j+jdeb)<
     +           nsvfi(nin)%P(i+ideb)) THEN
            j = j + 1
          ELSEIF(irem(1,j+jdeb)>
     +           nsvfi(nin)%P(i+ideb)) THEN
Case non-penetrated and non-retained candidate
            i = i + 1
          END IF
        END DO
        
        jdeb = jdeb + nsnfi(nin)%P(p)  
        ideb = ideb + nsnfiold(p)
      END DO
C
C renumbering of old candidates according to new numbers
C
      DO i = 1, i_stok
        ni = cand_n(i)
        IF(ni>nsn) THEN
          ni = ni - nsn
          IF(renum(ni) > 0) THEN
             cand_n(i) = renum(ni) + nsn
          ELSE
             cand_n(i) = 0 ! NSN + 1
             WRITE(6,*) "possible p/on issue for",
     .  "/INTER/TYPE10 bouncing node",itafi(nin)%P(ni)
          ENDIF
        END IF        
      END DO
C
      RETURN

spmd_rnumcd11()

subroutine spmd_rnumcd11	(	integer, dimension(*)	cand_n,
		integer, dimension(*)	renum,
		integer	ii_stok,
		integer	nin,
		integer	nrts,
		integer, dimension(*)	nsnfiold,
		integer	nsnrold,
		integer, dimension(*)	addcm,
		integer, dimension(2,*)	chaine,
		integer, dimension(*)	cand_m,
		integer	nsn4,
		integer	nrtm )

Definition at line 384 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
     .        NIN, NRTS, NSNROLD,ADDCM(*),CHAINE(2,*),
     .        CAND_M(*),NSN4,NRTM,II_STOK
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, P, I_STOK, IDEB, JDEB, NI, IAD,IADM1
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      DO i = 1, nsnrold
        renum(i) = 0
      END DO
      i_stok = ii_stok
      ideb = 0
      jdeb = 0
      DO p = 1, nspmd
        i = 1
        j = 1
        DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
          IF(irem(1,j+jdeb)==
     +       nsvfi(nin)%P(i+ideb)) THEN
            renum(i+ideb) = j+jdeb
            i = i + 1
            j = j + 1
          ELSEIF(irem(1,j+jdeb)<
     +           nsvfi(nin)%P(i+ideb)) THEN
            j = j + 1
          ELSEIF(irem(1,j+jdeb)>
     +           nsvfi(nin)%P(i+ideb)) THEN
Case non-penetrated and non-retained candidate
            i = i + 1
          END IF
        END DO
        jdeb = jdeb + nsnfi(nin)%P(p)  
        ideb = ideb + nsnfiold(p)
      END DO
C
C renumbering of old candidates according to new numbers
C
      DO i = 1, i_stok
        ni = cand_n(i)
        IF(ni>nrts) THEN
          ni = ni - nrts
          cand_n(i) = renum(ni) + nrts
        END IF        
      END DO
      DO i=1,nrtm
        j=0
        iad = addcm(i)
        DO WHILE(iad>0.AND.j<nsn4)
          j=j+1
          IF(chaine(1,iad) > nrts )THEN
            chaine(1,iad) = renum(chaine(1,iad)-nrts)+nrts
          ENDIF
          iad=chaine(2,iad)
        ENDDO
      ENDDO
C
      RETURN

spmd_rnumcd20()

subroutine spmd_rnumcd20	(	integer, dimension(*)	cand_n,
		integer, dimension(*)	renum,
		integer	ii_stok,
		integer	nin,
		integer	nsn,
		integer, dimension(*)	nsnfiold,
		integer	nsnrold )

Definition at line 82 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
     .        NIN, NSN, NSNROLD,II_STOK
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      DO i = 1, nsnrold
        renum(i) = 0
      END DO
      i_stok = ii_stok
      ideb = 0
      jdeb = 0
      DO p = 1, nspmd
        i = 1
        j = 1
        DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
          IF(nint(xrem(4,j+jdeb))==
     +       nsvfi(nin)%P(i+ideb)) THEN
            renum(i+ideb) = j+jdeb
            i = i + 1
            j = j + 1
          ELSEIF(nint(xrem(4,j+jdeb))<
     +           nsvfi(nin)%P(i+ideb)) THEN
            j = j + 1
          ELSEIF(nint(xrem(4,j+jdeb))>
     +           nsvfi(nin)%P(i+ideb)) THEN
Case non-penetrated and non-retained candidate
            i = i + 1
          END IF
        END DO
        jdeb = jdeb + nsnfi(nin)%P(p)  
        ideb = ideb + nsnfiold(p)
      END DO
C
C renumbering of old candidates according to new numbers
C
      DO i = 1, i_stok
        ni = cand_n(i)
        IF(ni>nsn) THEN
          ni = ni - nsn
          cand_n(i) = renum(ni) + nsn
        END IF        
      END DO
C
      RETURN

spmd_savefi()

subroutine spmd_savefi	(	integer, dimension(npari,*)	ipari,
		integer	iflag,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, intent(in)	nsensor,
		type (sensor_str_), dimension(nsensor)	sensor_tab,
		type (parameters_), intent(in)	parameters )

Definition at line 5133 of file spmd_i7tool.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      USE tri25ebox
      USE intbufdef_mod
      USE intstamp_glob_mod
      USE interface_modification_mod
      USE sensor_mod
      USE parameters_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      "param_c.inc"
#include      "sms_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN) :: NSENSOR
      INTEGER IPARI(NPARI,*), IFLAG
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
      TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, P, NSN, NMN, ITYP, IGAP, LENS, LENR, MULTIMP,
     .        INACTI, LSKYFI, LENI,INTTH,IEDGE4, IVIS2, INTNITSCHE
      INTEGER INTERACT,ISENS
      my_real ts,startt,stopt
      INTEGER, DIMENSION(NSPMD) :: SAVE_NSNFI,SAVE_NSNSI
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C Global init of variable
      iedge4=0
C
C Building Structure Interfaces on Restart
C
      IF(iflag==1) THEN
        IF(ninter/=0) THEN
C Writing Structures Interfaces on Restart file (integer part)
          DO i =1, ninter
            ityp = ipari(7,i)
            IF(ityp==7.OR.
     +         ityp==10.OR.ityp==11.OR.
     +        (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
     +         ityp==22.OR.ityp==23.OR.ityp==24.OR.
     +         ityp==25)THEN
 
C Issue : Restarts + INACTI + TSTART when Start timee was not reached before Restart
               interact = 1
 
               save_nsnfi(1:nspmd) = nsnfi(i)%P(1:nspmd)
               save_nsnsi(1:nspmd) = nsnsi(i)%P(1:nspmd)
 
               inacti=ipari(22,i)
               IF (inacti==5.OR.inacti==6.OR.inacti==7.OR.ityp==23.OR.inacti==-1)THEN
C
               isens = 0
               IF(ityp == 7.OR.ityp == 11.OR.ityp == 24) ! All but ITYP == 25
     .            isens = ipari(64,i)      
                  IF (isens > 0) THEN            
                    ts = sensor_tab(isens)%TSTART
                    IF (ts>tt) interact = 0
                  ELSE
                    startt = intbuf_tab(i)%VARIABLES(3)
                    stopt  = intbuf_tab(i)%VARIABLES(11)
                    IF (startt>tt) interact = 0
                  ENDIF
               ENDIF
               IF((interact == 0 .OR. nsnfi_flag(i)==1).AND.ityp/=25) THEN
                    nsnfi(i)%P(1:nspmd) = nsnfi_sav(i)%P(1:nspmd)
                    nsnsi(i)%P(1:nspmd) = nsnsi_sav(i)%P(1:nspmd)
 
                    nsnfi_sav(i)%P(1:nspmd) = save_nsnfi(1:nspmd)
                    nsnsi_sav(i)%P(1:nspmd) = save_nsnsi(1:nspmd)
               ENDIF
 
              IF(ityp==24)THEN
                 iedge4=ipari(59,i)
              ELSE
                 iedge4=0
              ENDIF
              intnitsche=ipari(86,i)
 
              lens = 0
              lenr = 0
              DO p = 1, nspmd
                lens = lens + nsnsi(i)%P(p)
                lenr = lenr + nsnfi(i)%P(p)
              END DO
C
              CALL write_i_c(nsnsi(i)%P(1),nspmd)
              CALL write_i_c(nsnfi(i)%P(1),nspmd)
 
              IF (lens>0)
     .         CALL write_i_c(nsvsi(i)%P(1),lens)
C
              IF (lenr>0) THEN
                CALL write_i_c(nsvfi(i)%P(1),lenr)
                IF(ityp==7.OR.ityp==20.OR.ityp==22.OR.
     +             ityp==23.OR.ityp==24.OR.ityp==25) THEN
                  CALL write_i_c(itafi(i)%P(1),lenr)
                  CALL write_i_c(kinfi(i)%P(1),lenr)
                  IF(ityp==20)THEN
                    CALL write_i_c(nbinflfi(i)%P(1),lenr)
                  END IF
C
                  IF(ipari(47,i) > 0)CALL write_i_c(matsfi(i)%P(1),lenr)
C
                  IF((ityp == 7.OR.ityp == 24.OR.ityp == 25).AND.ipari(72,i) > 0) THEN
                    CALL write_i_c(ipartfricsfi(i)%P(1),lenr)
                  ENDIF
C
                  IF (ityp==24)THEN
                    CALL write_i_c(irtlm_fi(i)%P(1,1),2*lenr)
                    CALL write_i_c(icont_i_fi(i)%P(1),lenr)
C E2E Arrays
                    CALL write_i_c(isedge_fi(i)%P(1),lenr)
 
                    IF(iedge4>0)THEN
                       CALL write_i_c(irtse_fi(i)%P(1,1),5*lenr)
                       CALL write_i_c(is2pt_fi(i)%P(1),lenr)
                       CALL write_i_c(ispt2_fi(i)%P(1),lenr)
                       CALL write_i_c(isegpt_fi(i)%P(1),lenr)
                       CALL write_i_c(is2se_fi(i)%P(1,1),2*lenr)
                    ENDIF
                    IF(intnitsche > 0) CALL write_i_c(forneqsfi(i)%P(1,1),3*lenr)
 
                  ENDIF
C
                  IF (ityp==25)THEN
                    CALL write_i_c(pmainfi(i)%P(1),lenr)
                    CALL write_i_c(irtlm_fi(i)%P(1,1),4*lenr)
                    CALL write_i_c(icont_i_fi(i)%P(1),lenr)
C                   Not added to rst files
C                   CALL WRITE_I_C(ICODT_FI(I)%P(1),LENR)
C                   CALL WRITE_I_C(ISKEW_FI(I)%P(1),LENR)
 
C Remove banned main segment
                    IF(ipari(63,i)==2) THEN
                       CALL write_i_c(kremnor_fi(i)%P(1),lenr+1)
                       IF(kremnor_fi(i)%P(lenr+1)/=0) THEN
                        CALL write_i_c(remnor_fi(i)%P(1),kremnor_fi(i)%P(lenr+1))
                       ENDIF
                    ENDIF
                  ENDIF
C
                  IF(idtmins==2)THEN
                    CALL write_i_c(nodnxfi(i)%P(1),lenr)
                    CALL write_i_c(nodamsfi(i)%P(1),lenr)
                    CALL write_i_c(procamsfi(i)%P(1),lenr)
                    IF (ityp==24) CALL write_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
                  ELSEIF(idtmins_int/=0)THEN
                    CALL write_i_c(nodamsfi(i)%P(1),lenr)
                    CALL write_i_c(procamsfi(i)%P(1),lenr)
                    IF (ityp==24) CALL write_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
                  END IF
C
                ELSEIF(ityp==10) THEN
                  CALL write_i_c(itafi(i)%P(1),lenr)
C
                  IF(idtmins==2)THEN
                    CALL write_i_c(nodnxfi(i)%P(1),lenr)
                    CALL write_i_c(nodamsfi(i)%P(1),lenr)
                    CALL write_i_c(procamsfi(i)%P(1),lenr)
                  ELSEIF(idtmins_int/=0)THEN
                    CALL write_i_c(nodamsfi(i)%P(1),lenr)
                    CALL write_i_c(procamsfi(i)%P(1),lenr)
                  END IF
C
                ELSEIF(ityp==11) THEN
                  CALL write_i_c(itafi(i)%P(1),2*lenr)
C
                  IF(idtmins==2)THEN
                    CALL write_i_c(nodnxfi(i)%P(1),2*lenr)
                    CALL write_i_c(nodamsfi(i)%P(1),2*lenr)
                    CALL write_i_c(procamsfi(i)%P(1),2*lenr)
                  ELSEIF(idtmins_int/=0)THEN
                    CALL write_i_c(nodamsfi(i)%P(1),2*lenr)
                    CALL write_i_c(procamsfi(i)%P(1),2*lenr)
                  END IF
C
                  IF(ipari(47,i) > 0) CALL write_i_c(matsfi(i)%P(1),lenr)
C
                  IF(ipari(72,i) > 0) CALL write_i_c(ipartfricsfi(i)%P(1),lenr)
C
                ELSEIF(ityp==17)THEN
                END IF
              END IF
C type20 edge
              IF(ityp==20)THEN
                lens = 0
                lenr = 0
                DO p = 1, nspmd
                  lens = lens + nsnsie(i)%P(p)
                  lenr = lenr + nsnfie(i)%P(p)
                END DO
C
                CALL write_i_c(nsnsie(i)%P(1),nspmd)
                CALL write_i_c(nsnfie(i)%P(1),nspmd)
                IF (lens>0)
     .            CALL write_i_c(nsvsie(i)%P(1),lens)
C
                IF (lenr>0) THEN
                  CALL write_i_c(nsvfie(i)%P(1),lenr)
                  CALL write_i_c(itafie(i)%P(1),2*lenr)
                END IF
C
                IF(idtmins==2)THEN
                  CALL write_i_c(nodnxfie(i)%P(1),lenr)
                  CALL write_i_c(nodamsfie(i)%P(1),lenr)
                  CALL write_i_c(procamsfie(i)%P(1),lenr)
                ELSEIF(idtmins_int/=0)THEN
                  CALL write_i_c(nodamsfie(i)%P(1),lenr)
                  CALL write_i_c(procamsfie(i)%P(1),lenr)
                END IF
C
              END IF    ! Fin type 20 edge
 
              IF(ityp == 25 ) THEN 
                IF(ipari(58,i) /=0) THEN 
                  CALL write_i_c(nsnsie(i)%P(1),nspmd)
                  CALL write_i_c(nsnfie(i)%P(1),nspmd)
                  lens = 0
                  lenr = 0
                  DO p = 1, nspmd
                    lens = lens + nsnsie(i)%P(p)
                    lenr = lenr + nsnfie(i)%P(p)
                  END DO
 
                  IF(lens>0) THEN
                    CALL write_i_c(nsvsie(i)%P(1),lens)
                  ENDIF
                  IF(lenr>0) THEN
                    CALL write_i_c(nsvfie(i)%P,lenr)
                    CALL write_i_c(ledge_fie(i)%P,e_ledge_size*lenr)
                    IF(ipari(72,i) > 0) CALL write_i_c(ipartfric_fie(i)%P(1),lenr)
                  ENDIF
                ENDIF
              ENDIF
C
              IF(ipari(36,i)>0.AND.ipari(7,i)/=17) THEN
                CALL write_i_c(nisubsfi(i)%P(1),nspmd)
                leni = 0
                lenr = 0
                DO p = 1, nspmd
                  leni = leni + nisubsfi(i)%P(p)
                  lenr = lenr + nsnfi(i)%P(p)
                END DO
                IF(leni>0) THEN
                  IF(lenr>0) THEN
                    CALL write_i_c(addsubsfi(i)%P(1),lenr+1)
                  END IF
                  CALL write_i_c(lisubsfi(i)%P(1),leni)
                  IF(ipari(7,i)==25.OR.ipari(7,i)==7.OR.ipari(7,i)==24.OR.ipari(7,i)==11)THEN
                    CALL write_i_c(inflg_subsfi(i)%P(1),leni)
                  END IF
                END IF
C =================== EDGES TO EDGE
C Output structure under interfaces
                IF(ipari(7,i) == 25 .AND. ipari(58,i) > 0) THEN
                  CALL write_i_c(nisubsfie(i)%P(1),nspmd)
                  leni = 0
                  DO p = 1, nspmd
                    leni = leni +nisubsfie(i)%P(p)
                  END DO
                  lenr = 0
                  DO p = 1, nspmd
                    lenr = lenr + nsnfie(i)%P(p)
                  END DO
                  IF(leni > 0 .AND. lenr > 0) THEN
                    CALL write_i_c(addsubsfie(i)%P(1),lenr+1)
                  ENDIF
                  IF(leni > 0) THEN
                  CALL write_i_c(lisubsfie(i)%P(1),leni)
                  CALL write_i_c(inflg_subsfie(i)%P(1),leni)
                ENDIF
              ENDIF
            END IF
            END IF
 
 
C
C Write in RST file inter 21 structure for nodal temperature 
C                Actualisation
C
            IF(ityp==21) THEN
              intth = ipari(47,i)
C
              IF(intth==2.OR.ipari(95,i) > 0) THEN
                lens = 0
                lenr = 0
                DO p = 1, nspmd
                  lens = lens + nmnsi(i)%P(p)
                  lenr = lenr + nmnfi(i)%P(p)
                END DO
C
                CALL write_i_c(nmnsi(i)%P(1),nspmd)
                CALL write_i_c(nmnfi(i)%P(1),nspmd)
 
                IF (lens>0) THEN
                  CALL write_i_c(nmvsi(i)%P(1),lens)
                  CALL write_i_c(tempnod(i)%P(1),lens)
                ENDIF
C
                IF (lenr>0) THEN
                  CALL write_i_c(nmvfi(i)%P(1),lenr)
                ENDIF
              ENDIF
            ENDIF
 
         ENDDO
        END IF
C
      ELSE ! WRITE REAL
 
        IF(ninter/=0) THEN
C Writing Structures Interfaces on Restart file (real part)
          DO i =1, ninter
            ityp = ipari(7,i)
            igap = ipari(21,i)
            inacti = ipari(22,i)
            ivis2 = ipari(14,i) ! ivis2==-1 : Flag for interface adhesion
            lenr = 0
            IF(ityp==7.OR.
     +         ityp==10.OR.ityp==11.OR.
     +        (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
     +         ityp==22.OR.ityp==23.OR.ityp==24.OR.
     +         ityp==25)THEN
              lenr = 0
              DO p = 1, nspmd
                lenr = lenr + nsnfi(i)%P(p)
              END DO
 
C In case deactivated Interface - Flush NSNFI back to Zero
C Issue : Restarts + INACTI + TSTART when Start timee was not reached before Restart
               interact = 1
 
               isens = 0
               IF(ityp == 7.OR.ityp == 11.OR.ityp == 24)  isens = ipari(64,i)  ! All but ITYP == 25
 
               IF (isens > 0) THEN               ! Sensors may be deactivated w/o INACTI            
                  ts = sensor_tab(isens)%TSTART
                  IF (ts>tt) interact = 0
               ENDIF
 
               inacti=ipari(22,i)
               IF (inacti==5.OR.inacti==6.OR.inacti==7.OR.ityp==23.OR.inacti==-1)THEN
C
               isens = 0
               IF(ityp == 7.OR.ityp == 11.OR.ityp == 24)  isens = ipari(64,i) ! All but ITYP == 25
                  IF(isens == 0)THEN
                    startt = intbuf_tab(i)%VARIABLES(3)
                    stopt  = intbuf_tab(i)%VARIABLES(11)
                   IF (startt>tt) interact = 0
                  ENDIF
               ENDIF
 
               IF((interact == 0 .OR. nsnfi_flag(i)==1).AND.ityp/=25) THEN
                    nsnfi(i)%P(1:nspmd) = nsnfi_sav(i)%P(1:nspmd)
                    nsnsi(i)%P(1:nspmd) = nsnsi_sav(i)%P(1:nspmd)
               ENDIF
              
C
              IF(lenr>0) THEN
C
                IF(ityp==7.OR.ityp==22.OR.ityp==23.OR.
     +             ityp==10.OR.ityp==20.OR.ityp==24.OR.
     +             ityp==25) THEN
                  CALL write_db(msfi(i)%P(1),lenr)
                  CALL write_db(stifi(i)%P(1),lenr)
                  IF(igap/=0)CALL write_db(gapfi(i)%P(1),lenr)
                  IF(igap==3)CALL write_db(gap_lfi(i)%P(1),lenr)
                  CALL write_db(xfi(i)%P(1,1),3*lenr)
                  CALL write_db(vfi(i)%P(1,1),3*lenr)
C
                   IF((ityp == 7.OR.ityp == 20.OR.ityp == 22.OR.
     +                 ityp == 23.OR.ityp == 24.OR.ityp == 25).AND.
     +                 ipari(47,i)>0) THEN
                    CALL write_db(tempfi(i)%P(1),lenr)
                   ENDIF
                   IF(ipari(47,i)>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
                      CALL write_db(areasfi(i)%P(1),lenr) 
                   ENDIF
                   IF(ityp == 25.AND.ivis2==-1) THEN
                      CALL write_i_c(if_adhfi(i)%P(1),lenr) 
                   ENDIF
C
                ELSEIF(ityp==11)THEN
                  CALL write_db(msfi(i)%P(1),2*lenr)
                  CALL write_db(stifi(i)%P(1),lenr)
                  IF(igap/=0)CALL write_db(gapfi(i)%P(1),lenr)
                  IF(igap==3)CALL write_db(gap_lfi(i)%P(1),lenr)
                  CALL write_db(xfi(i)%P(1,1),3*2*lenr)
                  CALL write_db(vfi(i)%P(1,1),3*2*lenr)
                  IF(inacti==5.OR.inacti==6)
     .              CALL write_db(penfi(i)%P(1,1),2*lenr)
                  IF(ipari(47,i)>0) THEN
                    CALL write_db(tempfi(i)%P(1),2*lenr)
                    CALL write_db(areasfi(i)%P(1),lenr) 
                   ENDIF
C
                ELSEIF(ityp==17)THEN
                  CALL write_db(xfi17(i)%P(1,1,1),3*16*lenr)
                  CALL write_db(vfi17(i)%P(1,1,1),3*16*lenr)
                  CALL write_db(frotsfi(i)%P(1,1),7*lenr)
                  CALL write_db(ksfi(i)%P(1,1),2*lenr)
                  CALL write_db(eminxfi(i)%P(1,1),6*lenr)
                END IF
              END IF
            END IF
C SPECIFIC TYPE20
            IF(ityp==20)THEN
C Addition anchoring
              IF(lenr>0) THEN
                CALL write_db(daanc6fi(i)%P(1,1,1),3*6*lenr)
                CALL write_db(dxancfi(i)%P(1,1),3*lenr)
                CALL write_db(dvancfi(i)%P(1,1),3*lenr)
                IF(inacti==5.OR.inacti==6) THEN
                  CALL write_db(penfi(i)%P(1,1),2*lenr)
                  CALL write_db(penfia(i)%P(1,1),5*lenr)
                END IF
                CALL write_db(daancfi(i)%P(1,1),3*lenr)
                CALL write_db(alphakfi(i)%P(1),lenr)                
                IF(idtmins > 0 .OR. idtmins_int/=0) THEN
                  CALL write_db(diag_smsfi(i)%P(1),lenr)
                ENDIF 
              END IF
C rajout edge
              lenr = 0
              DO p = 1, nspmd
                lenr = lenr + nsnfie(i)%P(p)
              END DO
C
              IF(lenr>0) THEN
                CALL write_db(msfie(i)%P(1),2*lenr)
                CALL write_db(stifie(i)%P(1),lenr)
                IF(igap/=0)CALL write_db(gapfie(i)%P(1),lenr)
                CALL write_db(xfie(i)%P(1,1),3*2*lenr)
                CALL write_db(vfie(i)%P(1,1),3*2*lenr)
                IF(inacti==5.OR.inacti==6) THEN
                  CALL write_db(penfie(i)%P(1,1),2*lenr)
                  CALL write_db(penfiae(i)%P(1,1),5*2*lenr)
                END IF
                CALL write_db(daanc6fie(i)%P(1,1,1),3*6*2*lenr)
                CALL write_db(dxancfie(i)%P(1,1),3*2*lenr)
                CALL write_db(dvancfie(i)%P(1,1),3*2*lenr)
                IF(idtmins > 0 .OR. idtmins_int/=0) THEN
                  CALL write_db(diag_smsfie(i)%P(1),lenr)
                ENDIF
              END IF
            END IF    ! fin type 20 edge
 
            IF(lenr > 0) THEN
              IF (ityp==24)THEN
                CALL write_db(time_sfi(i)%P(1),lenr)
              ELSEIF(ityp==25)THEN
                CALL write_db(time_sfi(i)%P(1),2*lenr)
              END IF
              IF (ityp==24.OR.ityp==25)THEN
                CALL write_db(secnd_frfi(i)%P(1,1),6*lenr)
                CALL write_db(pene_oldfi(i)%P(1,1),5*lenr)
                CALL write_db(stif_oldfi(i)%P(1,1),2*lenr)
                IF(ipari(97,i) > 0) CALL write_db(stif_msdt_fi(i)%P(1),lenr) ! stif based on mass and dt
              ENDIF  ! fin partie type 24 & 25
              IF(ityp==25.AND.parameters%INTCAREA > 0.AND.ipari(36,i)>0) CALL write_db(intareanfi(i)%P(1),lenr) ! output carea th (only case NISUB)
              IF(ityp==24.AND.parameters%INTCAREA > 0) CALL write_db(intareanfi(i)%P(1),lenr) ! output carea th 
C             
              IF (ityp==24) THEN
                IF(idtmins==2)THEN
                  CALL write_db(t2fac_sms_fi(i)%P(1),lenr)
                ELSEIF(idtmins_int/=0)THEN
                  CALL write_db(t2fac_sms_fi(i)%P(1),lenr)
                ENDIF
              END IF
            ENDIF
C
            IF(ityp == 25 ) THEN 
              IF(ipari(58,i) /=0) THEN  !E2E
                lenr = 0
                DO p = 1, nspmd
                  lenr = lenr + nsnfie(i)%P(p)
                END DO
                IF(lenr>0) THEN
                  CALL write_db(xfie(i)%P(1,1),3*(lenr*2))
                  CALL write_db(vfie(i)%P(1,1),3*(lenr*2))
                  CALL write_db(msfie(i)%P(1),lenr*2)
                  CALL write_db(stifie(i)%P(1),lenr)
                  CALL write_db(gapfie(i)%P(1),lenr)
                  IF( igap == 3) THEN
                    CALL write_db(gape_l_fie(i)%P,lenr)
                  ENDIF
                  CALL write_r_c(edg_bisector_fie(i)%P(1,1,1),3*3*lenr)
                  CALL write_r_c(vtx_bisector_fie(i)%P(1,1,1),3*4*lenr)
                  CALL write_db(x_seg_fie(i)%P(1,1,1),3*4*lenr)
 
                  IF(idtmins==2)THEN
                    CALL write_i_c(nodnxfie(i)%P(1),lenr*2)
                    CALL write_i_c(nodamsfie(i)%P(1),lenr*2)
                    CALL write_i_c(procamsfie(i)%P(1),lenr*2)
                  ELSEIF(idtmins_int/=0)THEN
                    CALL write_i_c(nodamsfie(i)%P(1),lenr*2)
                    CALL write_i_c(procamsfie(i)%P(1),lenr*2)
                  END IF
 
                  IF(ipari(97,i) > 0) THEN
                   CALL write_db(stife_msdt_fi(i)%P(1),lenr)
                  ENDIF
 
                ENDIF
              ENDIF
            ENDIF
 
           IF(ityp==21) THEN
            intth = ipari(47,i)
C
            IF(intth==2) THEN
               lenr = 0
               DO p = 1, nspmd
                lenr = lenr + nmnfi(i)%P(p)
               END DO
C
               IF (lenr>0) THEN
                 CALL write_db(nmtemp(i)%P(1),lenr)
               ENDIF
            ENDIF
          ENDIF
C
          END DO
        END IF
      ENDIF
C
      RETURN

upgrade_rem_2ry()

subroutine upgrade_rem_2ry	(	integer, dimension(npari,*)	ipari,
		integer, dimension(*)	count_remslv,
		integer, dimension(*)	count_remslve,
		integer, intent(in)	nodadt_therm )

Definition at line 7248 of file spmd_i7tool.F.

      USE tri7box
      USE tri25ebox
      USE message_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      "com04_c.inc"
#include      "scr18_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),COUNT_REMSLV(*),COUNT_REMSLVE(*)
      INTEGER, INTENT(IN) :: NODADT_THERM 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NI,ITYP,LSKYFI,IERROR1,INTTH,IERROR
C-----------------------------------------------
      lskyfi = 0
      DO ni=1,ninter
        ierror = 0
        ierror1 = 0
 
        IF (count_remslv(ni) > nlskyfi(ni))THEN
 
           ityp   = ipari(7,ni)
C           
           nlskyfi(ni)=nint(count_remslv(ni)*1.20d0)
 
           lskyfi=nlskyfi(ni)
C
           IF(ityp==7.OR.ityp==10.OR.ityp==20.OR.
     .        ityp==22.OR.ityp==23.OR.ityp==24.OR.
     .        ityp==25)THEN
              intth = ipari(47,ni)
 
              IF (ASSOCIATED(iskyfi(ni)%P)) DEALLOCATE(iskyfi(ni)%P)
              IF (ASSOCIATED(fskyfi(ni)%P)) DEALLOCATE(fskyfi(ni)%P)
C
              ALLOCATE(iskyfi(ni)%P(lskyfi),stat=ierror1)
              ierror = ierror + ierror1
              IF(kdtint==0) THEN
                ALLOCATE(fskyfi(ni)%P(4,lskyfi),stat=ierror1)
                ierror = ierror + ierror1
              ELSE
                ALLOCATE(fskyfi(ni)%P(5,lskyfi),stat=ierror1)
                ierror = ierror + ierror1
              END IF
              IF(ityp==7 .OR. ityp==25) THEN
                IF(intth /=0 ) THEN 
                  IF(ASSOCIATED(ftheskyfi(ni)%P)) DEALLOCATE(ftheskyfi(ni)%P)
                  ALLOCATE(ftheskyfi(ni)%P(lskyfi),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
                IF(intth /= 0 .AND. nodadt_therm ==1) THEN
                  IF(ASSOCIATED(condnskyfi(ni)%P)) DEALLOCATE(condnskyfi(ni)%P)
                  ALLOCATE(condnskyfi(ni)%P(lskyfi),stat=ierror1)
                  ierror = ierror + ierror1
                ENDIF
              ENDIF
           ELSEIF(ityp==11)THEN
              intth = ipari(47,ni)
              ierror = 0
              IF(ASSOCIATED(iskyfi(ni)%P))     DEALLOCATE(iskyfi(ni)%P)
              IF(ASSOCIATED(fskyfi(ni)%P))     DEALLOCATE(fskyfi(ni)%P)
              ALLOCATE(iskyfi(ni)%P(lskyfi),stat=ierror1)
              ierror = ierror + ierror1
              IF(intth /=0 ) THEN
                IF(ASSOCIATED(ftheskyfi(ni)%P)) DEALLOCATE(ftheskyfi(ni)%P)
                ALLOCATE(ftheskyfi(ni)%P(2*lskyfi),stat=ierror1)
                ierror = ierror + ierror1
              ENDIF
              IF(kdtint==0) THEN
                ALLOCATE(fskyfi(ni)%P(8,lskyfi),stat=ierror1)
                ierror = ierror + ierror1
              ELSE
                ALLOCATE(fskyfi(ni)%P(10,lskyfi),stat=ierror1)
                ierror = ierror + ierror1
              END IF
              IF(intth /= 0 .AND. nodadt_therm ==1) THEN
                IF(ASSOCIATED(condnskyfi(ni)%P)) DEALLOCATE(condnskyfi(ni)%P)
                ALLOCATE(condnskyfi(ni)%P(2*lskyfi),stat=ierror1)
                ierror = ierror + ierror1
              ENDIF
           ENDIF
        ENDIF
        IF( count_remslve(ni) > nlskyfie(ni) )THEN
          nlskyfie(ni) = nint(1.2d0 * count_remslve(ni))
          lskyfi = count_remslve(ni)
          IF (ASSOCIATED(fskyfie(ni)%P))DEALLOCATE(fskyfie(ni)%P)
          IF (ASSOCIATED(iskyfie(ni)%P)) DEALLOCATE(iskyfie(ni)%P)
          ALLOCATE(iskyfie(ni)%P(lskyfi),stat=ierror1)
          IF(kdtint==0) THEN
C            ALLOCATE(FSKYFIE(NI)%P(8,LSKYFI),STAT=IERROR1)
             ALLOCATE(fskyfie(ni)%P(8,lskyfi),stat=ierror1)
             ierror = ierror + ierror1
          ELSE
             ALLOCATE(fskyfie(ni)%P(8,lskyfi),stat=ierror1)
             ierror = ierror + ierror1
          END IF
        ENDIF
 
        IF(ierror/=0) THEN
            CALL ancmsg(msgid=20,anmode=aninfo)
            CALL arret(2)
        ENDIF
      ENDDO
      RETURN