OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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 (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 (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 (nb, len, bufr, nelems, a, stifn, fcont, ixs, ixs16, frots, h3d_data)
subroutine spmd_fiadd20_poff (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 (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 (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 (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 (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 (nb, len, bufr, irects, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, nlg, h3d_data)
subroutine spmd_fiadd17_pon (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 6284 of file spmd_i7tool.F.

6285C
6286C-----------------------------------------------
6287C I m p l i c i t T y p e s
6288C-----------------------------------------------
6289#include "implicit_f.inc"
6290C-----------------------------------------------
6291C C o m m o n B l o c k s
6292C-----------------------------------------------
6293#include "com01_c.inc"
6294C-----------------------------------------------
6295C D u m m y A r g u m e n t s
6296C-----------------------------------------------
6297 INTEGER LENI20,
6298 . NSNFI(*), NSVFI(*), ISIZENV(2,*)
6299C-----------------------------------------------
6300C L o c a l V a r i a b l e s
6301C-----------------------------------------------
6302 INTEGER IDEB, P, N, NB
6303C-----------------------------------------------
6304C S o u r c e L i n e s
6305C-----------------------------------------------
6306C
6307C IDEB = 0
6308 DO p = 1, nspmd
6309 nb = nsnfi(p)
6310 isizenv(1,p) = isizenv(1,p) + nb*leni20
6311C envoi tjrs mais peut etre optimise
6312C DO N = 1, NB
6313C IF(NSVFI(IDEB+N)<0) THEN
6314C ISIZENV(P) = ISIZENV(P) + LENI20
6315C END IF
6316C END DO
6317C IDEB = IDEB + NB
6318 END DO
6319C
6320 RETURN

◆ adddp()

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

Definition at line 7115 of file spmd_i7tool.F.

7116C
7117C-----------------------------------------------
7118C I m p l i c i t T y p e s
7119C-----------------------------------------------
7120#include "implicit_f.inc"
7121C-----------------------------------------------
7122C D u m m y A r g u m e n t s
7123C-----------------------------------------------
7124 INTEGER LEN
7125 double precision
7126 . daanc6(*), daanc6l(*)
7127C-----------------------------------------------
7128C L o c a l V a r i a b l e s
7129C-----------------------------------------------
7130 INTEGER I
7131 double precision
7132 . datmp(len)
7133C-----------------------------------------------
7134C S o u r c e L i n e s
7135C-----------------------------------------------
7136 DO i = 1,len
7137 datmp(i) = daanc6(i) + daanc6l(i)
7138 END DO
7139C 2 loops to avoid integer dp alignment problem on pgi
7140 DO i = 1,len
7141 daanc6(i) = datmp(i)
7142 END DO
7143C
7144 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 7190 of file spmd_i7tool.F.

7191C
7192C-----------------------------------------------
7193C I m p l i c i t T y p e s
7194C-----------------------------------------------
7195#include "implicit_f.inc"
7196C-----------------------------------------------
7197C D u m m y A r g u m e n t s
7198C-----------------------------------------------
7199 INTEGER LEN, SIZ, IREM(2,*)
7200 real*4 xrem(siz,*)
7201 double precision
7202 . xrem_dp(siz,*)
7203C-----------------------------------------------
7204C L o c a l V a r i a b l e s
7205C-----------------------------------------------
7206 INTEGER I, J
7207C-----------------------------------------------
7208C S o u r c e L i n e s
7209C-----------------------------------------------
7210 DO i = 1, len
7211 irem(1,i) = nint(xrem_dp(9,i))
7212 irem(2,i) = nint(xrem_dp(17,i))
7213 END DO
7214 DO i = 1, len
7215 DO j = 1, siz
7216 xrem(j,i) = xrem_dp(j,i)
7217 END DO
7218 END DO
7219C
7220 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 7152 of file spmd_i7tool.F.

7153C
7154C-----------------------------------------------
7155C I m p l i c i t T y p e s
7156C-----------------------------------------------
7157#include "implicit_f.inc"
7158C-----------------------------------------------
7159C D u m m y A r g u m e n t s
7160C-----------------------------------------------
7161 INTEGER LEN, SIZ, IREM(1,*)
7162 real*4 xrem(siz,*)
7163 double precision
7164 . xrem_dp(siz,*)
7165C-----------------------------------------------
7166C L o c a l V a r i a b l e s
7167C-----------------------------------------------
7168 INTEGER I, J
7169C-----------------------------------------------
7170C S o u r c e L i n e s
7171C-----------------------------------------------
7172 DO i = 1, len
7173 irem(1,i) = nint(xrem_dp(10,i))
7174 END DO
7175 DO i = 1, len
7176 DO j = 1, siz
7177 xrem(j,i) = xrem_dp(j,i)
7178 END DO
7179 END DO
7180C
7181 RETURN

◆ getdpdaanc()

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

Definition at line 7360 of file spmd_i7tool.F.

7361C
7362C-----------------------------------------------
7363C I m p l i c i t T y p e s
7364C-----------------------------------------------
7365#include "implicit_f.inc"
7366C-----------------------------------------------
7367C D u m m y A r g u m e n t s
7368C-----------------------------------------------
7369 INTEGER IRESP,INC
7370 my_real
7371 . buf(*), daanc6(*)
7372C-----------------------------------------------
7373C L o c a l V a r i a b l e s
7374C-----------------------------------------------
7375 INTEGER I
7376C-----------------------------------------------
7377C S o u r c e L i n e s
7378C-----------------------------------------------
7379C si double precision, on compacte 18 valeurs dp
7380C si simple precision, on compacte 18 valeurs dp soit 36 sp
7381 inc = 18*(1+iresp)
7382 DO i = 1,inc
7383 daanc6(i) = buf(i)
7384 END DO
7385C
7386 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ intcontp()

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

Definition at line 6232 of file spmd_i7tool.F.

6233C
6234C-----------------------------------------------
6235C I m p l i c i t T y p e s
6236C-----------------------------------------------
6237#include "implicit_f.inc"
6238C-----------------------------------------------
6239C C o m m o n B l o c k s
6240C-----------------------------------------------
6241#include "com01_c.inc"
6242C-----------------------------------------------
6243C D u m m y A r g u m e n t s
6244C-----------------------------------------------
6245 INTEGER N, LEN,
6246 . NSNFI(*), ISKY(*), ISIZENV(2,*), NSNFITOT(*)
6247C-----------------------------------------------
6248C L o c a l V a r i a b l e s
6249C-----------------------------------------------
6250 INTEGER IG, P, I, LASTIG
6251C-----------------------------------------------
6252C S o u r c e L i n e s
6253C-----------------------------------------------
6254C
6255 IF(n>0)THEN
6256 i = 1
6257 p = 1
6258 lastig = nsnfi(p)
6259 DO WHILE (i <= n)
6260 ig = isky(i)
6261 IF(ig<=lastig)THEN
6262 isizenv(1,p) = isizenv(1,p) + len
6263 isizenv(2,p) = isizenv(2,p) + 1
6264 i = i + 1
6265 ELSE
6266 p = p + 1
6267 lastig = lastig+nsnfi(p)
6268 END IF
6269 END DO
6270 END IF
6271C
6272 DO p = 1, nspmd
6273 nsnfitot(p) = nsnfitot(p) + nsnfi(p)
6274 END DO
6275C
6276 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, intent(inout) need_comm_int25_solid_erosion,
integer, intent(inout) comm_int25_solid_erosion )
Parameters
[in,out]need_comm_int25_solid_erosionboolean, true if the proc needs to comm some values related to interface type 25 with solid erosion
[in,out]comm_int25_solid_erosioninteger, sub-communicator related to interface type 25 with solid erosion

Definition at line 2857 of file spmd_i7tool.F.

2867C-----------------------------------------------
2868C M o d u l e s
2869C-----------------------------------------------
2870 USE tri7box
2871 USE tri25ebox
2872 USE message_mod
2873 USE intbufdef_mod
2874 USE groupdef_mod
2875 USE interface_modification_mod
2876 USE inter_sorting_mod
2877 USE sensor_mod
2878 USE my_alloc_mod
2879C-----------------------------------------------
2880C I m p l i c i t T y p e s
2881C-----------------------------------------------
2882#include "implicit_f.inc"
2883C-----------------------------------------------
2884C C o m m o n B l o c k s
2885C-----------------------------------------------
2886#include "com01_c.inc"
2887#include "com04_c.inc"
2888#include "com08_c.inc"
2889#include "scr17_c.inc"
2890#include "scr18_c.inc"
2891#include "task_c.inc"
2892#include "param_c.inc"
2893#include "units_c.inc"
2894#include "warn_c.inc"
2895#include "tabsiz_c.inc"
2896C common local to spmd_init and spmd_ring_mmx
2897 COMMON /ring/irecvf,isendt,iring
2898 INTEGER IRECVF,ISENDT,IRING
2899C-----------------------------------------------
2900C D u m m y A r g u m e n t s
2901C-----------------------------------------------
2902 INTEGER ,INTENT(IN) :: NSENSOR
2903 INTEGER ISENDTO(NINTER+1,NSPMD+1),
2904 . IRCVFROM(NINTER+1,NSPMD+1), IPARI(NPARI,*),
2905 . INTLIST(NINTER), IAD_ELEM(2,*),
2906 . NBINTC, ISIZXV, ILENXV, I2SIZE,ITASK,
2907 . ISLEN7, IRLEN7, ISLEN11, IRLEN11, NME17, ISLEN17, IRLEN17,
2908 . IRLEN7T, ISLEN7T, LINDIDEL, LBUFIDEL,
2909 . IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,NBINT20,
2910 . IRLEN20E, ISLEN20E, NRBYKIN_L, IRBKIN_L(*),KINDRBY(*),
2911 . FR_RBY(*), FR_RBY6(*), NPBY(NNPBY,*),LBUFIDEL24
2912 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2913 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
2914 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
2915 LOGICAL, 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
2916 INTEGER, INTENT(inout) :: COMM_INT25_SOLID_EROSION !< integer, sub-communicator related to interface type 25 with solid erosion
2917C-----------------------------------------------
2918 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
2919C-----------------------------------------------
2920C L o c a l V a r i a b l e s
2921C-----------------------------------------------
2922 INTEGER I, J, K, NSN, NMN, ITYP, IERROR, IERROR1, KK, NIN, P,
2923 . SCPMAX1,ISD,IRC,MY_RANK,LAST, IGE, IGN, NME, NMES,INTTH,
2924 . NRTM, NRTS, NLINM, NLINS,NSNE, NMNE,N,M,
2925 . WORK(70000),ITY,NOINT,INACTI,ISENS,INTERACT
2926 INTEGER,DIMENSION(:), ALLOCATABLE:: INDX
2927 INTEGER,DIMENSION(:), ALLOCATABLE:: PPAR
2928 INTEGER,DIMENSION(:), ALLOCATABLE:: INDP
2929 INTEGER,DIMENSION(:), ALLOCATABLE:: NNP
2930 INTEGER,DIMENSION(:), ALLOCATABLE:: RANK
2931 INTEGER,DIMENSION(:), ALLOCATABLE:: IRBODY
2932 INTEGER,DIMENSION(:), ALLOCATABLE:: INDB
2933 INTEGER,DIMENSION(:), ALLOCATABLE:: NNSN
2934 my_real startt, stopt,ts
2935C-----------------------------------------------
2936C S o u r c e L i n e s
2937C-----------------------------------------------
2938 CALL my_alloc(indx,2*ninter)
2939 CALL my_alloc(ppar,ninter)
2940 CALL my_alloc(indp,2*nspmd)
2941 CALL my_alloc(nnp,nspmd)
2942 CALL my_alloc(rank,nspmd)
2943 CALL my_alloc(irbody,numnod)
2944 CALL my_alloc(indb,2*nrbykin)
2945 CALL my_alloc(nnsn,nrbykin)
2946C-----------------------------------------------
2947C
2948C iexicodt : flag for sending icodt during run
2949 iexicodt = 0
2950C
2951 lindidel = 0
2952 lbufidel = 0
2953 lbufidel24 = 0
2954C
2955 !init ISENDTO/IRCVFROM
2956 DO i=1,ninter+1
2957 DO j=1,nspmd+1
2958 isendto(i,j)=0
2959 ircvfrom(i,j)=0
2960 ENDDO
2961 ENDDO
2962C
2963 !-----------------------------------------------
2964 IF(ninter/=0) THEN
2965C Case INACTI = 5, 6 or 7 + TSTART
2966 ALLOCATE(nsnfi_flag(ninter))
2967 nsnfi_flag(1:ninter)=0
2968
2969 DO i=1,ninter
2970 ity = ipari(7,i)
2971 IF(ity==7.OR.ity==10.OR.ity==11.OR.
2972 . ity==17.OR.ity==20.OR.
2973 . ity==22.OR.ity==23.OR.ity==24.OR.ity==25) THEN
2974 inacti=ipari(22,i)
2975 IF (inacti==5.OR.inacti==6.OR.inacti==7.OR.ity==23.OR.inacti==-1)THEN
2976C
2977 interact = 1
2978 isens = 0
2979 IF(ity == 7.OR.ity == 11.OR.ity == 24.OR.ity == 25)
2980 . isens = ipari(64,i)
2981 IF (isens > 0) THEN
2982 ts = sensor_tab(isens)%TSTART
2983 IF (ts>tt) interact = 0
2984 ELSE
2985 startt = intbuf_tab(i)%VARIABLES(3)
2986 stopt = intbuf_tab(i)%VARIABLES(11)
2987 IF (startt>tt) interact = 0
2988 ENDIF
2989C
2990 IF (interact==0)THEN
2991 noint =ipari(15,i)
2992C Printout Warning
2993 IF(ispmd==0)THEN
2994 CALL ancmsg(msgid=220,anmode=aninfo,
2995 * i1=noint,i2=inacti,r1=startt,r2=startt)
2996 ENDIF
2997 ENDIF
2998 IF (interact==0 .AND. ity /=25)THEN ! All but ITY == 25
2999 ALLOCATE(nsnfi_sav(i)%P(nspmd))
3000 ALLOCATE(nsnsi_sav(i)%P(nspmd))
3001 nsnfi_sav(i)%P(1:nspmd)=nsnfi(i)%P(1:nspmd)
3002 nsnfi(i)%P(1:nspmd)=0
3003 nsnsi_sav(i)%P(1:nspmd)=nsnsi(i)%P(1:nspmd)
3004 nsnsi(i)%P(1:nspmd)=0
3005
3006 nsnfi_flag(i)=1
3007 ENDIF
3008 ENDIF
3009 ENDIF
3010 ENDDO
3011
3012C
3013C Alloc Idel
3014C
3015 IF(idel7ng>0)THEN
3016 DO i = 1, ninter
3017 IF(ipari(17,i)>0)THEN
3018 ityp = ipari(7,i)
3019 nrts = ipari(3,i)
3020 nrtm = ipari(4,i)
3021 nsn = ipari(5,i)
3022 IF(ityp==7.OR.ityp==22.OR.
3023 . ityp==10.OR.ityp==5.OR.
3024 . ityp==23.OR.ityp==24.OR.
3025 . ityp==25)THEN
3026 lindidel = lindidel+nrtm
3027 lbufidel = lbufidel+4*nrtm+4
3028 IF(ityp==24.OR.ityp==25) lbufidel24 = lbufidel24 + nrtm
3029 ELSEIF(ityp==11)THEN
3030 lindidel = lindidel+nrtm+nrts
3031 lbufidel = lbufidel+2*(nrtm+nrts)+4
3032 ELSEIF(ityp==3)THEN
3033 lindidel = lindidel+nrtm+nrts
3034 lbufidel = lbufidel+4*(nrtm+nrts)+4
3035 ELSEIF(ityp==2)THEN
3036 lindidel = lindidel+nsn
3037 lbufidel = lbufidel+4*nsn+4
3038 ELSEIF(ityp==20)THEN
3039 lindidel = lindidel+nrtm
3040 lbufidel = lbufidel+4*nrtm+4
3041C partie edge
3042 nlins = ipari(51,i)
3043 nlinm = ipari(52,i)
3044 lindidel = lindidel+nlinm+nlins
3045 lbufidel = lbufidel+2*(nlinm+nlins)+4
3046 END IF
3047 END IF
3048 END DO
3049 END IF
3050C
3051 nme17=0
3052C
3053 DO i=1,ninter
3054 ityp = ipari(7,i)
3055 IF (ityp==7.OR.ityp==10.OR.ityp==22.OR.
3056 . ityp==11.OR.ityp==23.OR.ityp==24.OR.
3057 . ityp==25) THEN
3058 nsn = ipari(5,i)
3059 nmn = ipari(6,i)
3060 IF(nsn/=0) THEN
3061 isendto(i,ispmd+1)=nsn
3062 isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
3063 isendto(ninter+1,ispmd+1)=isendto(ninter+1,ispmd+1)+nsn
3064 ENDIF
3065 IF(nmn/=0) THEN
3066 ircvfrom(i,ispmd+1) = nmn
3067 ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
3068 ircvfrom(ninter+1,ispmd+1)=ircvfrom(ninter+1,ispmd+1)
3069 + +nmn
3070 ENDIF
3071
3072
3073 ELSEIF(ityp==17)THEN
3074 IF(ipari(33,i)==0)THEN
3075 ign = ipari(36,i)
3076 ige = ipari(34,i)
3077 nmes= igrbric(ign)%NENTITY
3078 nme = igrbric(ige)%NENTITY
3079 nme17 = nme17+nme+nmes
3080 IF(nmes/=0) THEN
3081 isendto(i,ispmd+1)=nmes
3082 isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
3083 isendto(ninter+1,ispmd+1)=isendto(ninter+1,ispmd+1)
3084 + +nmes
3085 ENDIF
3086 IF(nme/=0) THEN
3087 ircvfrom(i,ispmd+1) = nme
3088 ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
3089 ircvfrom(ninter+1,ispmd+1)=ircvfrom(ninter+1,ispmd+1)
3090 + +nme
3091 ENDIF
3092 END IF
3093 ELSEIF(ityp==20)THEN
3094 nsn = ipari(5,i)
3095 nmn = ipari(6,i)
3096C partie edge rajoutee
3097 nsne = ipari(55,i)
3098 nmne = ipari(56,i)
3099 IF(nsn+nsne/=0) THEN
3100 isendto(i,ispmd+1)=nsn+nsne
3101 isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
3102 isendto(ninter+1,ispmd+1)=isendto(ninter+1,ispmd+1)
3103 + +nsn+nsne
3104 ENDIF
3105 IF(nmn+nmne/=0) THEN
3106 ircvfrom(i,ispmd+1) = nmn+nmne
3107 ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
3108 ircvfrom(ninter+1,ispmd+1)=ircvfrom(ninter+1,ispmd+1)
3109 + +nmn+nmne
3110 ENDIF
3111 ENDIF
3112 ENDDO
3113C
3114 IF(nspmd > 1) THEN
3115 DO k = 1, nspmd
3116 CALL spmd_ibcast(isendto(1,k),isendto(1,k),ninter+1,1,
3117 . it_spmd(k),0)
3118 CALL spmd_ibcast(ircvfrom(1,k),ircvfrom(1,k),ninter+1,1,
3119 . it_spmd(k),0)
3120 ENDDO
3121 END IF
3122 DO i=1,ninter
3123 isendto(i,nspmd+1)=0
3124 ircvfrom(i,nspmd+1)=0
3125 DO k=1,nspmd
3126 IF(ircvfrom(i,k)/=0) THEN
3127 ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
3128 ENDIF
3129 IF(isendto(i,k)/=0) THEN
3130 isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
3131 ENDIF
3132 END DO
3133 END DO
3134 END IF !(NINTER/=0)
3135 !-----------------------------------------------
3136
3137 nbintc = 0
3138 DO i=1,ninter
3139 ityp = ipari(7,i)
3140 IF (ityp==7.OR.ityp==10.OR.ityp==11.OR.
3141 . (ityp==17.AND.ipari(33,i) == 0).OR.ityp==20.OR.
3142 . ityp==22.OR.ityp==23.OR.ityp==24.OR.ityp==25) THEN
3143 nbintc = nbintc + 1
3144 intlist(nbintc) = i
3145 scpmax1=0
3146 DO j=1,nspmd
3147 scpmax1=max(scpmax1,ircvfrom(i,j))
3148 ENDDO
3149 ppar(nbintc)=scpmax1
3150 ENDIF
3151 ENDDO
3152C
3153 CALL my_orders(0,work,ppar,indx,nbintc,1)
3154 DO i=1,nbintc
3155 indx(i+nbintc)=intlist(i)
3156 ENDDO
3157 DO i=1,nbintc
3158 intlist(i)=indx(indx(i)+nbintc)
3159 ENDDO
3160C
3161 IF(debug(3)>=1.AND.ispmd==0.AND.nspmd>1) THEN
3162 WRITE(istdo,*)'** INTERFACES NODAL DECOMPOSITION '
3163 WRITE(istdo,*)'#PROC NSN TOT NMN TOT TOTAL'
3164 WRITE(iout,*)'** INTERFACES NODAL DECOMPOSITION '
3165 WRITE(iout,*)'#PROC NSN TOT NMN TOT TOTAL'
3166 DO j = 1, nspmd
3167 isd = 0
3168 irc = 0
3169 DO i=1,ninter
3170 isd = isd + isendto(i,j)
3171 irc = irc + ircvfrom(i,j)
3172 ENDDO
3173 WRITE(istdo,'(I4,3X,I8,2X,I8,2X,I8)')j,isd,irc,isd+irc
3174 WRITE(iout,'(I4,3X,I8,2X,I8,2X,I8)')j,isd,irc,isd+irc
3175 ENDDO
3176 ENDIF
3177C
3178C preparation for communication in spmd_icrit
3179C
3180 DO k=1,nspmd
3181 nnp(k) = ircvfrom(ninter+1,k) + isendto(ninter+1,k)
3182 indp(k)=k
3183 END DO
3184 IF(nspmd > 1) CALL my_orders(0,work,nnp,indp,nspmd,1)
3185 DO k=1,nspmd
3186 rank(indp(k)) = k
3187 ENDDO
3188 irecvf = 0
3189 isendt = 0
3190 iring = 0
3191 IF(nnp(ispmd+1)>0)THEN
3192 my_rank = rank(ispmd+1)
3193 IF(my_rank>1)THEN
3194 last = indp(my_rank-1)
3195 IF(nnp(last)>0)THEN
3196 irecvf = last
3197 END IF
3198 END IF
3199 IF(my_rank==nspmd)THEN ! DERNIER PROC DU RING
3200 IF(irecvf/=0) isendt = -1 ! -1 : ENVOI A TS LE MONDE (SI COMM NECESSAIRE)
3201 ELSE ! PROCESSEUR DANS LE RING
3202 isendt = indp(my_rank+1)
3203 END IF
3204 IF(nspmd>1) THEN
3205 IF(nnp(indp(nspmd-1))>0)iring= indp(nspmd) ! IRING = NO DU DERNIER PROCESSEUR DS LE RING (OU 0 SI PAS DE RING NECESSAIRE)
3206 END IF
3207 END IF
3208C
3209C longueur comm routine SPMD_SD_XV
3210C
3211 isizxv = 0
3212 DO i = 1, nspmd
3213 isizxv = isizxv + iad_elem(1,i+1)-iad_elem(2,i)
3214 ENDDO
3215
3216 ilenxv = 10 + 3*iroddl
3217C comm w
3218 IF(iale/=0.AND.ninter>0) ilenxv = ilenxv + 6
3219
3220 IF(idtmin(11)==3.OR.idtmin(10)==3) ilenxv = ilenxv + 2
3221C
3222C longueur comm routine EXCH_A_INT2_PON
3223C
3224 IF(iroddl==0) THEN
3225 i2size = 5
3226 ELSE
3227 i2size = 10
3228 ENDIF
3229C
3230C longueur comm routine I7XVCOM et I7FCOM
3231C
3232 islen7 = 0
3233 irlen7 = 0
3234 islen7t = 0
3235 irlen7t = 0
3236 islen11 = 0
3237 irlen11 = 0
3238 islen17 = 0
3239 irlen17 = 0
3240 irlen20 = 0
3241 islen20 = 0
3242 irlen20t = 0
3243 islen20t = 0
3244 irlen20e = 0
3245 islen20e = 0
3246 nbint20 = 0
3247
3248 irlen25e = 0
3249 islen25e = 0
3250
3251
3252 DO i = 1, nbintc
3253 nin = intlist(i)
3254 ityp = ipari(7,nin)
3255 intth = ipari(47,nin)
3256C type 7 ou 10
3257 IF(ityp==7 .OR.ityp==10.OR.
3258 . ityp==23.OR.ityp==22.OR.ityp==24.OR.
3259 . ityp==25)THEN
3260 IF(intth == 0) THEN
3261 DO p = 1, nspmd
3262 islen7 = islen7 + nsnsi(nin)%P(p)
3263 irlen7 = irlen7 + nsnfi(nin)%P(p)
3264 END DO
3265 ELSE
3266 DO p = 1, nspmd
3267 islen7t = islen7t + nsnsi(nin)%P(p)
3268 irlen7t = irlen7t + nsnfi(nin)%P(p)
3269 END DO
3270 ENDIF
3271
3272 IF(ityp == 25 .AND. ipari(58,nin) >0) THEN
3273 islen25e= sum(nsnsie(nin)%P(1:nspmd))
3274 irlen25e= sum(nsnfie(nin)%P(1:nspmd))
3275 ENDIF
3276
3277 ELSEIF(ityp==11) THEN
3278C type 11
3279 DO p = 1, nspmd
3280 islen11 = islen11 + nsnsi(nin)%P(p)
3281 irlen11 = irlen11 + nsnfi(nin)%P(p)
3282 END DO
3283 ELSEIF(ityp==17.AND.ipari(33,nin)==0)THEN
3284C type 17 curvature
3285 DO p = 1, nspmd
3286 islen17 = islen17 + nsnsi(nin)%P(p)
3287 irlen17 = irlen17 + nsnfi(nin)%P(p)
3288 END DO
3289 ELSEIF(ityp==20)THEN
3290C type 20
3291 nbint20 = nbint20 + 1
3292 IF(intth == 0) THEN
3293 DO p = 1, nspmd
3294 islen20 = islen20 + nsnsi(nin)%P(p)
3295 irlen20 = irlen20 + nsnfi(nin)%P(p)
3296 islen20e= islen20e+ nsnsie(nin)%P(p)
3297 irlen20e= irlen20e+ nsnfie(nin)%P(p)
3298 END DO
3299 ELSE
3300 DO p = 1, nspmd
3301 islen20t = islen20t + nsnsi(nin)%P(p)
3302 irlen20t = irlen20t + nsnfi(nin)%P(p)
3303 islen20e = islen20e + nsnsie(nin)%P(p)
3304 irlen20e = irlen20e + nsnfie(nin)%P(p)
3305 END DO
3306 ENDIF
3307 END IF
3308 ENDDO
3309
3310 IF(nrbykin > 0) THEN
3311C
3312C Tempo RBY a remonter dans starter conversion no noeud vers no rigid body
3313C
3314 DO n=1,numnod
3315 irbody(n)=0
3316 END DO
3317C
3318 nrbykin_l=0
3319 k=1
3320 DO n=1,nrbykin
3321 m = npby(1,n)
3322 IF(m > 0) THEN
3323 irbody(m) = n
3324 nrbykin_l=nrbykin_l+1
3325 nnsn(nrbykin_l)=-npby(2,n)
3326 irbkin_l(nrbykin_l)=n
3327c ELSE
3328c if(NPBY(2,N) /= 0) print*,'error!!!'
3329 END IF
3330 kindrby(n)=k
3331 k=k+npby(2,n)
3332 END DO
3333C
3334 DO n = 1, sfr_rby
3335 fr_rby6(n)=irbody(fr_rby(n))
3336 END DO
3337C optimisation RBY
3338 CALL my_orders(0,work,nnsn,indb,nrbykin_l,1)
3339c if(ispmd==0)print*,'opt RBD:',NRBYKIN,NRBYKIN_L
3340 DO n = 1, nrbykin_l
3341 indb(nrbykin_l+n)=irbkin_l(n)
3342 END DO
3343 DO n = 1, nrbykin_l
3344 irbkin_l(n)=indb(nrbykin_l+indb(n))
3345c if(ispmd==0)print*,'>>>',N,NPBY(2,IRBKIN_L(N))
3346 END DO
3347 END IF
3348
3349 DO i=1,nbintc
3350 indx(i+nbintc)=intlist(i)
3351 ENDDO
3352 DO i=1,nbintc
3353 intlist(i)=indx(indx(i)+nbintc)
3354 ENDDO
3355C
3356C Create Contact Communicator
3357C
3358 CALL spmd_split_comm(
3359 . ircvfrom(ninter+1,ispmd+1)+isendto(ninter+1,ispmd+1),comm_cont)
3360
3361 IF(ninter/=0) CALL spmd_split_comm_inter( nbintc,intlist,ipari,isendto,ircvfrom,sort_comm,
3362 . need_comm_int25_solid_erosion,comm_int25_solid_erosion )
3363
3364! Create CJOINT communicator
3365 CALL spmd_split_comm_joint()
3366
3367 DEALLOCATE(indx)
3368 DEALLOCATE(ppar)
3369 DEALLOCATE(indp)
3370 DEALLOCATE(nnp)
3371 DEALLOCATE(rank)
3372 DEALLOCATE(irbody)
3373 DEALLOCATE(indb)
3374 DEALLOCATE(nnsn)
3375
3376 RETURN
max
#define max(a, b)
Definition macros.h:21
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
groupdef_mod
Definition groupdef_mod.F:662
inter_sorting_mod
Definition inter_sorting_mod.F:57
interface_modification_mod
Definition interface_modification_mod.F:33
interface_modification_mod::nsnsi_sav
type(int_pointer), dimension(:), allocatable nsnsi_sav
Definition interface_modification_mod.F:35
message_mod
Definition message_mod.F:1249
tri25ebox::islen25e
integer islen25e
Definition tri25ebox.F:77
tri25ebox::irlen25e
integer irlen25e
Definition tri25ebox.F:77
tri7box::nsnfie
type(int_pointer), dimension(:), allocatable nsnfie
Definition tri7box.F:440
tri7box::nsnsie
type(int_pointer), dimension(:), allocatable nsnsie
Definition tri7box.F:491
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nsnfi_sav
type(int_pointer), dimension(:), allocatable nsnfi_sav
Definition tri7box.F:440
tri7box::nsnfi_flag
integer, dimension(:), allocatable nsnfi_flag
Definition tri7box.F:530
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_split_comm
subroutine spmd_split_comm(isactive, comm_local)
Definition spmd_split_comm.F:33
spmd_split_comm_inter
subroutine spmd_split_comm_inter(nbintc, intlist, ipari, isendto, ircvfrom, sort_comm, need_comm_int25_solid_erosion, comm_int25_solid_erosion)
Definition spmd_split_comm_inter.F:37
spmd_split_comm_joint
subroutine spmd_split_comm_joint()
Definition spmd_split_comm_joint.F:33
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889

◆ putdpdaanc()

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

Definition at line 7398 of file spmd_i7tool.F.

7399C
7400C-----------------------------------------------
7401C I m p l i c i t T y p e s
7402C-----------------------------------------------
7403#include "implicit_f.inc"
7404C-----------------------------------------------
7405C D u m m y A r g u m e n t s
7406C-----------------------------------------------
7407 INTEGER IRESP,INC
7408 my_real
7409 . buf(*), daanc6(*)
7410C-----------------------------------------------
7411C L o c a l V a r i a b l e s
7412C-----------------------------------------------
7413 INTEGER I
7414C-----------------------------------------------
7415C S o u r c e L i n e s
7416C-----------------------------------------------
7417C si double precision, on compacte 18 valeurs dp
7418C si simple precision, on compacte 18 valeurs dp soit 36 sp
7419 inc = 18*(1+iresp)
7420 DO i = 1,inc
7421 buf(i) = daanc6(i)
7422 END DO
7423C
7424 RETURN

◆ putdpzero()

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

Definition at line 7073 of file spmd_i7tool.F.

7074C
7075C-----------------------------------------------
7076C I m p l i c i t T y p e s
7077C-----------------------------------------------
7078#include "implicit_f.inc"
7079C-----------------------------------------------
7080C D u m m y A r g u m e n t s
7081C-----------------------------------------------
7082 INTEGER IRESP,INC
7083 my_real
7084 . buf(*), zz(*)
7085C-----------------------------------------------
7086C L o c a l V a r i a b l e s
7087C-----------------------------------------------
7088 INTEGER I
7089C-----------------------------------------------
7090C S o u r c e L i n e s
7091C-----------------------------------------------
7092C si double precision, on compacte 18 valeurs dp
7093C si simple precision, on compacte 18 valeurs dp soit 36 sp
7094 inc = 18
7095 IF(iresp==0) THEN
7096 DO i = 1,inc
7097 buf(i) = zz(1)
7098 END DO
7099 ELSE
7100 DO i = 1, inc
7101 buf(2*i-1) = zz(1)
7102 buf(2*i) = zz(2)
7103 END DO
7104 inc = inc + 18
7105 END IF
7106C
7107 RETURN

◆ sorti11()

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

Definition at line 6328 of file spmd_i7tool.F.

6329C
6330C-----------------------------------------------
6331C I m p l i c i t T y p e s
6332C-----------------------------------------------
6333#include "implicit_f.inc"
6334C-----------------------------------------------
6335C D u m m y A r g u m e n t s
6336C-----------------------------------------------
6337 INTEGER N, NFSKYI, ISKY(*)
6338 my_real
6339 . fskyi(2*nfskyi,*)
6340C-----------------------------------------------
6341C L o c a l V a r i a b l e s
6342C-----------------------------------------------
6343 INTEGER I, J, L, IR, IIA
6344 my_real
6345 . rra1, rra2, rra3, rra4, rra5,
6346 . rra6, rra7, rra8, rra9, rra10
6347C-----------------------------------------------
6348C S o u r c e L i n e s
6349C-----------------------------------------------
6350C test sur n=0
6351 IF (n==0) RETURN
6352 l=n/2+1
6353 ir=n
6354 IF(nfskyi==4)THEN
635510 CONTINUE
6356 IF(l>1)THEN
6357 l=l-1
6358 iia =isky(l)
6359 rra1=fskyi(1,l)
6360 rra2=fskyi(2,l)
6361 rra3=fskyi(3,l)
6362 rra4=fskyi(4,l)
6363 rra5=fskyi(5,l)
6364 rra6=fskyi(6,l)
6365 rra7=fskyi(7,l)
6366 rra8=fskyi(8,l)
6367 ELSE
6368 iia =isky(ir)
6369 rra1=fskyi(1,ir)
6370 rra2=fskyi(2,ir)
6371 rra3=fskyi(3,ir)
6372 rra4=fskyi(4,ir)
6373 rra5=fskyi(5,ir)
6374 rra6=fskyi(6,ir)
6375 rra7=fskyi(7,ir)
6376 rra8=fskyi(8,ir)
6377 isky(ir)=isky(1)
6378 fskyi(1,ir)=fskyi(1,1)
6379 fskyi(2,ir)=fskyi(2,1)
6380 fskyi(3,ir)=fskyi(3,1)
6381 fskyi(4,ir)=fskyi(4,1)
6382 fskyi(5,ir)=fskyi(5,1)
6383 fskyi(6,ir)=fskyi(6,1)
6384 fskyi(7,ir)=fskyi(7,1)
6385 fskyi(8,ir)=fskyi(8,1)
6386 ir=ir-1
6387C IF(IR==1)THEN
6388 IF(ir<=1)THEN
6389 isky(1)=iia
6390 fskyi(1,1)=rra1
6391 fskyi(2,1)=rra2
6392 fskyi(3,1)=rra3
6393 fskyi(4,1)=rra4
6394 fskyi(5,1)=rra5
6395 fskyi(6,1)=rra6
6396 fskyi(7,1)=rra7
6397 fskyi(8,1)=rra8
6398 RETURN
6399 ENDIF
6400 ENDIF
6401 i=l
6402 j=l+l
640320 IF(j<=ir)THEN
6404 IF(j<ir)THEN
6405 IF(isky(j)<isky(j+1))j=j+1
6406 ENDIF
6407 IF(iia<isky(j))THEN
6408 isky(i)=isky(j)
6409 fskyi(1,i)=fskyi(1,j)
6410 fskyi(2,i)=fskyi(2,j)
6411 fskyi(3,i)=fskyi(3,j)
6412 fskyi(4,i)=fskyi(4,j)
6413 fskyi(5,i)=fskyi(5,j)
6414 fskyi(6,i)=fskyi(6,j)
6415 fskyi(7,i)=fskyi(7,j)
6416 fskyi(8,i)=fskyi(8,j)
6417 i=j
6418 j=j+j
6419 ELSE
6420 j=ir+1
6421 ENDIF
6422 GO TO 20
6423 ENDIF
6424 isky(i)=iia
6425 fskyi(1,i)=rra1
6426 fskyi(2,i)=rra2
6427 fskyi(3,i)=rra3
6428 fskyi(4,i)=rra4
6429 fskyi(5,i)=rra5
6430 fskyi(6,i)=rra6
6431 fskyi(7,i)=rra7
6432 fskyi(8,i)=rra8
6433 GO TO 10
6434 ELSE
6435100 CONTINUE
6436 IF(l>1)THEN
6437 l=l-1
6438 iia =isky(l)
6439 rra1=fskyi(1,l)
6440 rra2=fskyi(2,l)
6441 rra3=fskyi(3,l)
6442 rra4=fskyi(4,l)
6443 rra5=fskyi(5,l)
6444 rra6=fskyi(6,l)
6445 rra7=fskyi(7,l)
6446 rra8=fskyi(8,l)
6447 rra9=fskyi(9,l)
6448 rra10=fskyi(10,l)
6449 ELSE
6450 iia =isky(ir)
6451 rra1=fskyi(1,ir)
6452 rra2=fskyi(2,ir)
6453 rra3=fskyi(3,ir)
6454 rra4=fskyi(4,ir)
6455 rra5=fskyi(5,ir)
6456 rra6=fskyi(6,ir)
6457 rra7=fskyi(7,ir)
6458 rra8=fskyi(8,ir)
6459 rra9=fskyi(9,ir)
6460 rra10=fskyi(10,ir)
6461 isky(ir)=isky(1)
6462 fskyi(1,ir)=fskyi(1,1)
6463 fskyi(2,ir)=fskyi(2,1)
6464 fskyi(3,ir)=fskyi(3,1)
6465 fskyi(4,ir)=fskyi(4,1)
6466 fskyi(5,ir)=fskyi(5,1)
6467 fskyi(6,ir)=fskyi(6,1)
6468 fskyi(7,ir)=fskyi(7,1)
6469 fskyi(8,ir)=fskyi(8,1)
6470 fskyi(9,ir)=fskyi(9,1)
6471 fskyi(10,ir)=fskyi(10,1)
6472 ir=ir-1
6473C IF(IR==1)THEN
6474 IF(ir<=1)THEN
6475 isky(1)=iia
6476 fskyi(1,1)=rra1
6477 fskyi(2,1)=rra2
6478 fskyi(3,1)=rra3
6479 fskyi(4,1)=rra4
6480 fskyi(5,1)=rra5
6481 fskyi(6,1)=rra6
6482 fskyi(7,1)=rra7
6483 fskyi(8,1)=rra8
6484 fskyi(9,1)=rra9
6485 fskyi(10,1)=rra10
6486 RETURN
6487 ENDIF
6488 ENDIF
6489 i=l
6490 j=l+l
6491200 IF(j<=ir)THEN
6492 IF(j<ir)THEN
6493 IF(isky(j)<isky(j+1))j=j+1
6494 ENDIF
6495 IF(iia<isky(j))THEN
6496 isky(i)=isky(j)
6497 fskyi(1,i)=fskyi(1,j)
6498 fskyi(2,i)=fskyi(2,j)
6499 fskyi(3,i)=fskyi(3,j)
6500 fskyi(4,i)=fskyi(4,j)
6501 fskyi(5,i)=fskyi(5,j)
6502 fskyi(6,i)=fskyi(6,j)
6503 fskyi(7,i)=fskyi(7,j)
6504 fskyi(8,i)=fskyi(8,j)
6505 fskyi(9,i)=fskyi(9,j)
6506 fskyi(10,i)=fskyi(10,j)
6507 i=j
6508 j=j+j
6509 ELSE
6510 j=ir+1
6511 ENDIF
6512 GO TO 200
6513 ENDIF
6514 isky(i)=iia
6515 fskyi(1,i)=rra1
6516 fskyi(2,i)=rra2
6517 fskyi(3,i)=rra3
6518 fskyi(4,i)=rra4
6519 fskyi(5,i)=rra5
6520 fskyi(6,i)=rra6
6521 fskyi(7,i)=rra7
6522 fskyi(8,i)=rra8
6523 fskyi(9,i)=rra9
6524 fskyi(10,i)=rra10
6525 GO TO 100
6526 ENDIF
6527C
6528 RETURN

◆ sorti11t()

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

Definition at line 6536 of file spmd_i7tool.F.

6537C
6538C-----------------------------------------------
6539C I m p l i c i t T y p e s
6540C-----------------------------------------------
6541#include "implicit_f.inc"
6542C-----------------------------------------------
6543C D u m m y A r g u m e n t s
6544C-----------------------------------------------
6545 INTEGER N, NFSKYI, ISKY(*)
6546 my_real
6547 . fskyi(2*nfskyi,*),ftheskyi(*)
6548C-----------------------------------------------
6549C L o c a l V a r i a b l e s
6550C-----------------------------------------------
6551 INTEGER I, J, L, IR, IIA
6552 my_real
6553 . rra1, rra2, rra3, rra4, rra5,
6554 . rra6, rra7, rra8, rra9, rra10,
6555 . rra11,rra12
6556C-----------------------------------------------
6557C S o u r c e L i n e s
6558C-----------------------------------------------
6559C test sur n=0
6560 IF (n==0) RETURN
6561 l=n/2+1
6562 ir=n
6563 IF(nfskyi==4)THEN
656410 CONTINUE
6565 IF(l>1)THEN
6566 l=l-1
6567 iia =isky(l)
6568 rra1=fskyi(1,l)
6569 rra2=fskyi(2,l)
6570 rra3=fskyi(3,l)
6571 rra4=fskyi(4,l)
6572 rra5=fskyi(5,l)
6573 rra6=fskyi(6,l)
6574 rra7=fskyi(7,l)
6575 rra8=fskyi(8,l)
6576 rra9=ftheskyi(l)
6577 ELSE
6578 iia =isky(ir)
6579 rra1=fskyi(1,ir)
6580 rra2=fskyi(2,ir)
6581 rra3=fskyi(3,ir)
6582 rra4=fskyi(4,ir)
6583 rra5=fskyi(5,ir)
6584 rra6=fskyi(6,ir)
6585 rra7=fskyi(7,ir)
6586 rra8=fskyi(8,ir)
6587 rra9=ftheskyi(ir)
6588 isky(ir)=isky(1)
6589 fskyi(1,ir)=fskyi(1,1)
6590 fskyi(2,ir)=fskyi(2,1)
6591 fskyi(3,ir)=fskyi(3,1)
6592 fskyi(4,ir)=fskyi(4,1)
6593 fskyi(5,ir)=fskyi(5,1)
6594 fskyi(6,ir)=fskyi(6,1)
6595 fskyi(7,ir)=fskyi(7,1)
6596 fskyi(8,ir)=fskyi(8,1)
6597 ftheskyi(ir)=ftheskyi(1)
6598 ir=ir-1
6599C IF(IR==1)THEN
6600 IF(ir<=1)THEN
6601 isky(1)=iia
6602 fskyi(1,1)=rra1
6603 fskyi(2,1)=rra2
6604 fskyi(3,1)=rra3
6605 fskyi(4,1)=rra4
6606 fskyi(5,1)=rra5
6607 fskyi(6,1)=rra6
6608 fskyi(7,1)=rra7
6609 fskyi(8,1)=rra8
6610 ftheskyi(1)=rra9
6611 RETURN
6612 ENDIF
6613 ENDIF
6614 i=l
6615 j=l+l
661620 IF(j<=ir)THEN
6617 IF(j<ir)THEN
6618 IF(isky(j)<isky(j+1))j=j+1
6619 ENDIF
6620 IF(iia<isky(j))THEN
6621 isky(i)=isky(j)
6622 fskyi(1,i)=fskyi(1,j)
6623 fskyi(2,i)=fskyi(2,j)
6624 fskyi(3,i)=fskyi(3,j)
6625 fskyi(4,i)=fskyi(4,j)
6626 fskyi(5,i)=fskyi(5,j)
6627 fskyi(6,i)=fskyi(6,j)
6628 fskyi(7,i)=fskyi(7,j)
6629 fskyi(8,i)=fskyi(8,j)
6630 ftheskyi(i)=ftheskyi(j)
6631 i=j
6632 j=j+j
6633 ELSE
6634 j=ir+1
6635 ENDIF
6636 GO TO 20
6637 ENDIF
6638 isky(i)=iia
6639 fskyi(1,i)=rra1
6640 fskyi(2,i)=rra2
6641 fskyi(3,i)=rra3
6642 fskyi(4,i)=rra4
6643 fskyi(5,i)=rra5
6644 fskyi(6,i)=rra6
6645 fskyi(7,i)=rra7
6646 fskyi(8,i)=rra8
6647 ftheskyi(i)=rra9
6648 GO TO 10
6649 ELSE
6650100 CONTINUE
6651 IF(l>1)THEN
6652 l=l-1
6653 iia =isky(l)
6654 rra1=fskyi(1,l)
6655 rra2=fskyi(2,l)
6656 rra3=fskyi(3,l)
6657 rra4=fskyi(4,l)
6658 rra5=fskyi(5,l)
6659 rra6=fskyi(6,l)
6660 rra7=fskyi(7,l)
6661 rra8=fskyi(8,l)
6662 rra9=fskyi(9,l)
6663 rra10=fskyi(10,l)
6664 rra9=ftheskyi(l)
6665 ELSE
6666 iia =isky(ir)
6667 rra1=fskyi(1,ir)
6668 rra2=fskyi(2,ir)
6669 rra3=fskyi(3,ir)
6670 rra4=fskyi(4,ir)
6671 rra5=fskyi(5,ir)
6672 rra6=fskyi(6,ir)
6673 rra7=fskyi(7,ir)
6674 rra8=fskyi(8,ir)
6675 rra9=fskyi(9,ir)
6676 rra10=fskyi(10,ir)
6677 rra11=ftheskyi(ir)
6678 isky(ir)=isky(1)
6679 fskyi(1,ir)=fskyi(1,1)
6680 fskyi(2,ir)=fskyi(2,1)
6681 fskyi(3,ir)=fskyi(3,1)
6682 fskyi(4,ir)=fskyi(4,1)
6683 fskyi(5,ir)=fskyi(5,1)
6684 fskyi(6,ir)=fskyi(6,1)
6685 fskyi(7,ir)=fskyi(7,1)
6686 fskyi(8,ir)=fskyi(8,1)
6687 fskyi(9,ir)=fskyi(9,1)
6688 fskyi(10,ir)=fskyi(10,1)
6689 ftheskyi(ir)=ftheskyi(1)
6690 ir=ir-1
6691C IF(IR==1)THEN
6692 IF(ir<=1)THEN
6693 isky(1)=iia
6694 fskyi(1,1)=rra1
6695 fskyi(2,1)=rra2
6696 fskyi(3,1)=rra3
6697 fskyi(4,1)=rra4
6698 fskyi(5,1)=rra5
6699 fskyi(6,1)=rra6
6700 fskyi(7,1)=rra7
6701 fskyi(8,1)=rra8
6702 fskyi(9,1)=rra9
6703 fskyi(10,1)=rra10
6704 ftheskyi(1)=rra11
6705 RETURN
6706 ENDIF
6707 ENDIF
6708 i=l
6709 j=l+l
6710200 IF(j<=ir)THEN
6711 IF(j<ir)THEN
6712 IF(isky(j)<isky(j+1))j=j+1
6713 ENDIF
6714 IF(iia<isky(j))THEN
6715 isky(i)=isky(j)
6716 fskyi(1,i)=fskyi(1,j)
6717 fskyi(2,i)=fskyi(2,j)
6718 fskyi(3,i)=fskyi(3,j)
6719 fskyi(4,i)=fskyi(4,j)
6720 fskyi(5,i)=fskyi(5,j)
6721 fskyi(6,i)=fskyi(6,j)
6722 fskyi(7,i)=fskyi(7,j)
6723 fskyi(8,i)=fskyi(8,j)
6724 fskyi(9,i)=fskyi(9,j)
6725 fskyi(10,i)=fskyi(10,j)
6726 ftheskyi(i)=ftheskyi(j)
6727 i=j
6728 j=j+j
6729 ELSE
6730 j=ir+1
6731 ENDIF
6732 GO TO 200
6733 ENDIF
6734 isky(i)=iia
6735 fskyi(1,i)=rra1
6736 fskyi(2,i)=rra2
6737 fskyi(3,i)=rra3
6738 fskyi(4,i)=rra4
6739 fskyi(5,i)=rra5
6740 fskyi(6,i)=rra6
6741 fskyi(7,i)=rra7
6742 fskyi(8,i)=rra8
6743 fskyi(9,i)=rra9
6744 fskyi(10,i)=rra10
6745 ftheskyi(i)=rra11
6746 GO TO 100
6747 ENDIF
6748C
6749 RETURN

◆ sorti11tt()

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

Definition at line 6757 of file spmd_i7tool.F.

6758C
6759C-----------------------------------------------
6760C I m p l i c i t T y p e s
6761C-----------------------------------------------
6762#include "implicit_f.inc"
6763C-----------------------------------------------
6764C D u m m y A r g u m e n t s
6765C-----------------------------------------------
6766 INTEGER N, NFSKYI, ISKY(*)
6767 my_real
6768 . fskyi(2*nfskyi,*),ftheskyi(*),condnskyi(*)
6769C-----------------------------------------------
6770C L o c a l V a r i a b l e s
6771C-----------------------------------------------
6772 INTEGER I, J, L, IR, IIA
6773 my_real
6774 . rra1, rra2, rra3, rra4, rra5,
6775 . rra6, rra7, rra8, rra9, rra10,
6776 . rra11,rra12
6777C-----------------------------------------------
6778C S o u r c e L i n e s
6779C-----------------------------------------------
6780C test sur n=0
6781 IF (n==0) RETURN
6782 l=n/2+1
6783 ir=n
6784 IF(nfskyi==4)THEN
678510 CONTINUE
6786 IF(l>1)THEN
6787 l=l-1
6788 iia =isky(l)
6789 rra1=fskyi(1,l)
6790 rra2=fskyi(2,l)
6791 rra3=fskyi(3,l)
6792 rra4=fskyi(4,l)
6793 rra5=fskyi(5,l)
6794 rra6=fskyi(6,l)
6795 rra7=fskyi(7,l)
6796 rra8=fskyi(8,l)
6797 rra9=ftheskyi(l)
6798 rra10=condnskyi(l)
6799 ELSE
6800 iia =isky(ir)
6801 rra1=fskyi(1,ir)
6802 rra2=fskyi(2,ir)
6803 rra3=fskyi(3,ir)
6804 rra4=fskyi(4,ir)
6805 rra5=fskyi(5,ir)
6806 rra6=fskyi(6,ir)
6807 rra7=fskyi(7,ir)
6808 rra8=fskyi(8,ir)
6809 rra9=ftheskyi(ir)
6810 rra10=condnskyi(ir)
6811 isky(ir)=isky(1)
6812 fskyi(1,ir)=fskyi(1,1)
6813 fskyi(2,ir)=fskyi(2,1)
6814 fskyi(3,ir)=fskyi(3,1)
6815 fskyi(4,ir)=fskyi(4,1)
6816 fskyi(5,ir)=fskyi(5,1)
6817 fskyi(6,ir)=fskyi(6,1)
6818 fskyi(7,ir)=fskyi(7,1)
6819 fskyi(8,ir)=fskyi(8,1)
6820 ftheskyi(ir)=ftheskyi(1)
6821 condnskyi(ir)=condnskyi(1)
6822 ir=ir-1
6823C IF(IR==1)THEN
6824 IF(ir<=1)THEN
6825 isky(1)=iia
6826 fskyi(1,1)=rra1
6827 fskyi(2,1)=rra2
6828 fskyi(3,1)=rra3
6829 fskyi(4,1)=rra4
6830 fskyi(5,1)=rra5
6831 fskyi(6,1)=rra6
6832 fskyi(7,1)=rra7
6833 fskyi(8,1)=rra8
6834 ftheskyi(1)=rra9
6835 condnskyi(1)=rra10
6836 RETURN
6837 ENDIF
6838 ENDIF
6839 i=l
6840 j=l+l
684120 IF(j<=ir)THEN
6842 IF(j<ir)THEN
6843 IF(isky(j)<isky(j+1))j=j+1
6844 ENDIF
6845 IF(iia<isky(j))THEN
6846 isky(i)=isky(j)
6847 fskyi(1,i)=fskyi(1,j)
6848 fskyi(2,i)=fskyi(2,j)
6849 fskyi(3,i)=fskyi(3,j)
6850 fskyi(4,i)=fskyi(4,j)
6851 fskyi(5,i)=fskyi(5,j)
6852 fskyi(6,i)=fskyi(6,j)
6853 fskyi(7,i)=fskyi(7,j)
6854 fskyi(8,i)=fskyi(8,j)
6855 ftheskyi(i)=ftheskyi(j)
6856 condnskyi(i)=condnskyi(j)
6857 i=j
6858 j=j+j
6859 ELSE
6860 j=ir+1
6861 ENDIF
6862 GO TO 20
6863 ENDIF
6864 isky(i)=iia
6865 fskyi(1,i)=rra1
6866 fskyi(2,i)=rra2
6867 fskyi(3,i)=rra3
6868 fskyi(4,i)=rra4
6869 fskyi(5,i)=rra5
6870 fskyi(6,i)=rra6
6871 fskyi(7,i)=rra7
6872 fskyi(8,i)=rra8
6873 ftheskyi(i)=rra9
6874 condnskyi(i)=rra10
6875 GO TO 10
6876 ELSE
6877100 CONTINUE
6878 IF(l>1)THEN
6879 l=l-1
6880 iia =isky(l)
6881 rra1=fskyi(1,l)
6882 rra2=fskyi(2,l)
6883 rra3=fskyi(3,l)
6884 rra4=fskyi(4,l)
6885 rra5=fskyi(5,l)
6886 rra6=fskyi(6,l)
6887 rra7=fskyi(7,l)
6888 rra8=fskyi(8,l)
6889 rra9=fskyi(9,l)
6890 rra10=fskyi(10,l)
6891 rra9=ftheskyi(l)
6892 rra10=condnskyi(l)
6893 ELSE
6894 iia =isky(ir)
6895 rra1=fskyi(1,ir)
6896 rra2=fskyi(2,ir)
6897 rra3=fskyi(3,ir)
6898 rra4=fskyi(4,ir)
6899 rra5=fskyi(5,ir)
6900 rra6=fskyi(6,ir)
6901 rra7=fskyi(7,ir)
6902 rra8=fskyi(8,ir)
6903 rra9=fskyi(9,ir)
6904 rra10=fskyi(10,ir)
6905 rra11=ftheskyi(ir)
6906 rra12=condnskyi(ir)
6907 isky(ir)=isky(1)
6908 fskyi(1,ir)=fskyi(1,1)
6909 fskyi(2,ir)=fskyi(2,1)
6910 fskyi(3,ir)=fskyi(3,1)
6911 fskyi(4,ir)=fskyi(4,1)
6912 fskyi(5,ir)=fskyi(5,1)
6913 fskyi(6,ir)=fskyi(6,1)
6914 fskyi(7,ir)=fskyi(7,1)
6915 fskyi(8,ir)=fskyi(8,1)
6916 fskyi(9,ir)=fskyi(9,1)
6917 fskyi(10,ir)=fskyi(10,1)
6918 ftheskyi(ir)=ftheskyi(1)
6919 condnskyi(ir)=condnskyi(1)
6920 ir=ir-1
6921C IF(IR==1)THEN
6922 IF(ir<=1)THEN
6923 isky(1)=iia
6924 fskyi(1,1)=rra1
6925 fskyi(2,1)=rra2
6926 fskyi(3,1)=rra3
6927 fskyi(4,1)=rra4
6928 fskyi(5,1)=rra5
6929 fskyi(6,1)=rra6
6930 fskyi(7,1)=rra7
6931 fskyi(8,1)=rra8
6932 fskyi(9,1)=rra9
6933 fskyi(10,1)=rra10
6934 ftheskyi(1)=rra11
6935 condnskyi(1)=rra12
6936 RETURN
6937 ENDIF
6938 ENDIF
6939 i=l
6940 j=l+l
6941200 IF(j<=ir)THEN
6942 IF(j<ir)THEN
6943 IF(isky(j)<isky(j+1))j=j+1
6944 ENDIF
6945 IF(iia<isky(j))THEN
6946 isky(i)=isky(j)
6947 fskyi(1,i)=fskyi(1,j)
6948 fskyi(2,i)=fskyi(2,j)
6949 fskyi(3,i)=fskyi(3,j)
6950 fskyi(4,i)=fskyi(4,j)
6951 fskyi(5,i)=fskyi(5,j)
6952 fskyi(6,i)=fskyi(6,j)
6953 fskyi(7,i)=fskyi(7,j)
6954 fskyi(8,i)=fskyi(8,j)
6955 fskyi(9,i)=fskyi(9,j)
6956 fskyi(10,i)=fskyi(10,j)
6957 ftheskyi(i)=ftheskyi(j)
6958 condnskyi(i)=condnskyi(j)
6959 i=j
6960 j=j+j
6961 ELSE
6962 j=ir+1
6963 ENDIF
6964 GO TO 200
6965 ENDIF
6966 isky(i)=iia
6967 fskyi(1,i)=rra1
6968 fskyi(2,i)=rra2
6969 fskyi(3,i)=rra3
6970 fskyi(4,i)=rra4
6971 fskyi(5,i)=rra5
6972 fskyi(6,i)=rra6
6973 fskyi(7,i)=rra7
6974 fskyi(8,i)=rra8
6975 fskyi(9,i)=rra9
6976 fskyi(10,i)=rra10
6977 ftheskyi(i)=rra11
6978 condnskyi(i)=rra12
6979 GO TO 100
6980 ENDIF
6981C
6982 RETURN

◆ sorti17()

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

Definition at line 6990 of file spmd_i7tool.F.

6991C
6992C-----------------------------------------------
6993C I m p l i c i t T y p e s
6994C-----------------------------------------------
6995#include "implicit_f.inc"
6996C-----------------------------------------------
6997C D u m m y A r g u m e n t s
6998C-----------------------------------------------
6999 INTEGER N, NFSKYI, ISKY(*)
7000 my_real
7001 . fskyi(40,*)
7002C-----------------------------------------------
7003C L o c a l V a r i a b l e s
7004C-----------------------------------------------
7005 INTEGER I, J, L, IR, IIA, II
7006 my_real
7007 . rra(40)
7008C-----------------------------------------------
7009C S o u r c e L i n e s
7010C-----------------------------------------------
7011 IF (n==0) RETURN
7012 l=n/2+1
7013 ir=n
701410 CONTINUE
7015 IF(l>1)THEN
7016 l=l-1
7017 iia =isky(l)
7018 DO ii = 1, 40
7019 rra(ii)=fskyi(ii,l)
7020 END DO
7021 ELSE
7022 iia =isky(ir)
7023 DO ii = 1, 40
7024 rra(ii)=fskyi(ii,ir)
7025 END DO
7026 isky(ir)=isky(1)
7027 DO ii = 1, 40
7028 fskyi(ii,ir)=fskyi(ii,1)
7029 END DO
7030 ir=ir-1
7031 IF(ir<=1)THEN
7032 isky(1)=iia
7033 DO ii = 1, 40
7034 fskyi(ii,1)=rra(ii)
7035 END DO
7036 RETURN
7037 ENDIF
7038 ENDIF
7039 i=l
7040 j=l+l
704120 IF(j<=ir)THEN
7042 IF(j<ir)THEN
7043 IF(isky(j)<isky(j+1))j=j+1
7044 ENDIF
7045 IF(iia<isky(j))THEN
7046 isky(i)=isky(j)
7047 DO ii = 1, 40
7048 fskyi(ii,i)=fskyi(ii,j)
7049 END DO
7050 i=j
7051 j=j+j
7052 ELSE
7053 j=ir+1
7054 ENDIF
7055 GO TO 20
7056 ENDIF
7057 isky(i)=iia
7058 DO ii = 1, 40
7059 fskyi(ii,i)=rra(ii)
7060 END DO
7061 GO TO 10
7062C
7063 RETURN

◆ sorti20()

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

Definition at line 6077 of file spmd_i7tool.F.

6078C
6079C-----------------------------------------------
6080C I m p l i c i t T y p e s
6081C-----------------------------------------------
6082#include "implicit_f.inc"
6083C-----------------------------------------------
6084C D u m m y A r g u m e n t s
6085C-----------------------------------------------
6086 INTEGER N, NFSKYI, ISKY(*)
6087 my_real
6088 . fskyi(nfskyi,*)
6089C-----------------------------------------------
6090C L o c a l V a r i a b l e s
6091C-----------------------------------------------
6092 INTEGER I, J, L, IR, IIA
6093 my_real
6094 . rra1, rra2, rra3, rra4, rra5
6095C-----------------------------------------------
6096C S o u r c e L i n e s
6097C-----------------------------------------------
6098C test sur n=0
6099 IF (n==0) RETURN
6100 l=n/2+1
6101 ir=n
6102 IF(nfskyi==4)THEN
610310 CONTINUE
6104 IF(l>1)THEN
6105 l=l-1
6106 iia =isky(l)
6107 rra1=fskyi(1,l)
6108 rra2=fskyi(2,l)
6109 rra3=fskyi(3,l)
6110 rra4=fskyi(4,l)
6111 ELSE
6112 iia =isky(ir)
6113 rra1=fskyi(1,ir)
6114 rra2=fskyi(2,ir)
6115 rra3=fskyi(3,ir)
6116 rra4=fskyi(4,ir)
6117 isky(ir)=isky(1)
6118 fskyi(1,ir)=fskyi(1,1)
6119 fskyi(2,ir)=fskyi(2,1)
6120 fskyi(3,ir)=fskyi(3,1)
6121 fskyi(4,ir)=fskyi(4,1)
6122 ir=ir-1
6123C IF(IR==1)THEN
6124 IF(ir<=1)THEN
6125 isky(1)=iia
6126 fskyi(1,1)=rra1
6127 fskyi(2,1)=rra2
6128 fskyi(3,1)=rra3
6129 fskyi(4,1)=rra4
6130 RETURN
6131 ENDIF
6132 ENDIF
6133 i=l
6134 j=l+l
613520 IF(j<=ir)THEN
6136 IF(j<ir)THEN
6137 IF(isky(j)<isky(j+1))j=j+1
6138 ENDIF
6139 IF(iia<isky(j))THEN
6140 isky(i)=isky(j)
6141 fskyi(1,i)=fskyi(1,j)
6142 fskyi(2,i)=fskyi(2,j)
6143 fskyi(3,i)=fskyi(3,j)
6144 fskyi(4,i)=fskyi(4,j)
6145 i=j
6146 j=j+j
6147 ELSE
6148 j=ir+1
6149 ENDIF
6150 GO TO 20
6151 ENDIF
6152 isky(i)=iia
6153 fskyi(1,i)=rra1
6154 fskyi(2,i)=rra2
6155 fskyi(3,i)=rra3
6156 fskyi(4,i)=rra4
6157 GO TO 10
6158 ELSE
6159100 CONTINUE
6160 IF(l>1)THEN
6161 l=l-1
6162 iia =isky(l)
6163 rra1=fskyi(1,l)
6164 rra2=fskyi(2,l)
6165 rra3=fskyi(3,l)
6166 rra4=fskyi(4,l)
6167 rra5=fskyi(5,l)
6168 ELSE
6169 iia =isky(ir)
6170 rra1=fskyi(1,ir)
6171 rra2=fskyi(2,ir)
6172 rra3=fskyi(3,ir)
6173 rra4=fskyi(4,ir)
6174 rra5=fskyi(5,ir)
6175 isky(ir)=isky(1)
6176 fskyi(1,ir)=fskyi(1,1)
6177 fskyi(2,ir)=fskyi(2,1)
6178 fskyi(3,ir)=fskyi(3,1)
6179 fskyi(4,ir)=fskyi(4,1)
6180 fskyi(5,ir)=fskyi(5,1)
6181 ir=ir-1
6182C IF(IR==1)THEN
6183 IF(ir<=1)THEN
6184 isky(1)=iia
6185 fskyi(1,1)=rra1
6186 fskyi(2,1)=rra2
6187 fskyi(3,1)=rra3
6188 fskyi(4,1)=rra4
6189 fskyi(5,1)=rra5
6190 RETURN
6191 ENDIF
6192 ENDIF
6193 i=l
6194 j=l+l
6195200 IF(j<=ir)THEN
6196 IF(j<ir)THEN
6197 IF(isky(j)<isky(j+1))j=j+1
6198 ENDIF
6199 IF(iia<isky(j))THEN
6200 isky(i)=isky(j)
6201 fskyi(1,i)=fskyi(1,j)
6202 fskyi(2,i)=fskyi(2,j)
6203 fskyi(3,i)=fskyi(3,j)
6204 fskyi(4,i)=fskyi(4,j)
6205 fskyi(5,i)=fskyi(5,j)
6206 i=j
6207 j=j+j
6208 ELSE
6209 j=ir+1
6210 ENDIF
6211 GO TO 200
6212 ENDIF
6213 isky(i)=iia
6214 fskyi(1,i)=rra1
6215 fskyi(2,i)=rra2
6216 fskyi(3,i)=rra3
6217 fskyi(4,i)=rra4
6218 fskyi(5,i)=rra5
6219 GO TO 100
6220 ENDIF
6221C
6222 RETURN

◆ sorti7()

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

Definition at line 5740 of file spmd_i7tool.F.

5741C
5742C-----------------------------------------------
5743C I m p l i c i t T y p e s
5744C-----------------------------------------------
5745#include "implicit_f.inc"
5746C-----------------------------------------------
5747C D u m m y A r g u m e n t s
5748C-----------------------------------------------
5749 INTEGER N, NFSKYI, ISKY(*)
5750 my_real
5751 . fskyi(nfskyi,*),ftheskyi(*)
5752C-----------------------------------------------
5753C L o c a l V a r i a b l e s
5754C-----------------------------------------------
5755 INTEGER I, J, L, IR, IIA
5756 my_real
5757 . rra1, rra2, rra3, rra4, rra5,ppa
5758C-----------------------------------------------
5759C S o u r c e L i n e s
5760C-----------------------------------------------
5761C test sur n=0
5762 IF (n==0) RETURN
5763 l=n/2+1
5764 ir=n
5765 IF(nfskyi==4)THEN
576610 CONTINUE
5767 IF(l>1)THEN
5768 l=l-1
5769 iia =isky(l)
5770 rra1=fskyi(1,l)
5771 rra2=fskyi(2,l)
5772 rra3=fskyi(3,l)
5773 rra4=fskyi(4,l)
5774 ppa =ftheskyi(l)
5775 ELSE
5776 iia =isky(ir)
5777 rra1=fskyi(1,ir)
5778 rra2=fskyi(2,ir)
5779 rra3=fskyi(3,ir)
5780 rra4=fskyi(4,ir)
5781 ppa =ftheskyi(ir)
5782 isky(ir)=isky(1)
5783 fskyi(1,ir)=fskyi(1,1)
5784 fskyi(2,ir)=fskyi(2,1)
5785 fskyi(3,ir)=fskyi(3,1)
5786 fskyi(4,ir)=fskyi(4,1)
5787 ftheskyi(ir)=ftheskyi(1)
5788 ir=ir-1
5789C IF(IR==1)THEN
5790 IF(ir<=1)THEN
5791 isky(1)=iia
5792 fskyi(1,1)=rra1
5793 fskyi(2,1)=rra2
5794 fskyi(3,1)=rra3
5795 fskyi(4,1)=rra4
5796 ftheskyi(1)=ppa
5797 RETURN
5798 ENDIF
5799 ENDIF
5800 i=l
5801 j=l+l
580220 IF(j<=ir)THEN
5803 IF(j<ir)THEN
5804 IF(isky(j)<isky(j+1))j=j+1
5805 ENDIF
5806 IF(iia<isky(j))THEN
5807 isky(i)=isky(j)
5808 fskyi(1,i)=fskyi(1,j)
5809 fskyi(2,i)=fskyi(2,j)
5810 fskyi(3,i)=fskyi(3,j)
5811 fskyi(4,i)=fskyi(4,j)
5812 ftheskyi(i)=ftheskyi(j)
5813 i=j
5814 j=j+j
5815 ELSE
5816 j=ir+1
5817 ENDIF
5818 GO TO 20
5819 ENDIF
5820 isky(i)=iia
5821 fskyi(1,i)=rra1
5822 fskyi(2,i)=rra2
5823 fskyi(3,i)=rra3
5824 fskyi(4,i)=rra4
5825 ftheskyi(i)=ppa
5826 GO TO 10
5827 ELSE
5828100 CONTINUE
5829 IF(l>1)THEN
5830 l=l-1
5831 iia =isky(l)
5832 rra1=fskyi(1,l)
5833 rra2=fskyi(2,l)
5834 rra3=fskyi(3,l)
5835 rra4=fskyi(4,l)
5836 rra5=fskyi(5,l)
5837 ppa =ftheskyi(l)
5838 ELSE
5839 iia =isky(ir)
5840 rra1=fskyi(1,ir)
5841 rra2=fskyi(2,ir)
5842 rra3=fskyi(3,ir)
5843 rra4=fskyi(4,ir)
5844 rra5=fskyi(5,ir)
5845 isky(ir)=isky(1)
5846 fskyi(1,ir)=fskyi(1,1)
5847 fskyi(2,ir)=fskyi(2,1)
5848 fskyi(3,ir)=fskyi(3,1)
5849 fskyi(4,ir)=fskyi(4,1)
5850 fskyi(5,ir)=fskyi(5,1)
5851 ftheskyi(ir)=ftheskyi(1)
5852 ir=ir-1
5853C IF(IR==1)THEN
5854 IF(ir<=1)THEN
5855 isky(1)=iia
5856 fskyi(1,1)=rra1
5857 fskyi(2,1)=rra2
5858 fskyi(3,1)=rra3
5859 fskyi(4,1)=rra4
5860 fskyi(5,1)=rra5
5861 ftheskyi(1)=ppa
5862 RETURN
5863 ENDIF
5864 ENDIF
5865 i=l
5866 j=l+l
5867200 IF(j<=ir)THEN
5868 IF(j<ir)THEN
5869 IF(isky(j)<isky(j+1))j=j+1
5870 ENDIF
5871 IF(iia<isky(j))THEN
5872 isky(i)=isky(j)
5873 fskyi(1,i)=fskyi(1,j)
5874 fskyi(2,i)=fskyi(2,j)
5875 fskyi(3,i)=fskyi(3,j)
5876 fskyi(4,i)=fskyi(4,j)
5877 fskyi(5,i)=fskyi(5,j)
5878 ftheskyi(i)=ftheskyi(j)
5879 i=j
5880 j=j+j
5881 ELSE
5882 j=ir+1
5883 ENDIF
5884 GO TO 200
5885 ENDIF
5886 isky(i)=iia
5887 fskyi(1,i)=rra1
5888 fskyi(2,i)=rra2
5889 fskyi(3,i)=rra3
5890 fskyi(4,i)=rra4
5891 fskyi(5,i)=rra5
5892 ftheskyi(i)=ppa
5893 GO TO 100
5894 ENDIF
5895C
5896 RETURN

◆ sorti7t()

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

Definition at line 5902 of file spmd_i7tool.F.

5903C
5904C-----------------------------------------------
5905C I m p l i c i t T y p e s
5906C-----------------------------------------------
5907#include "implicit_f.inc"
5908C-----------------------------------------------
5909C D u m m y A r g u m e n t s
5910C-----------------------------------------------
5911 INTEGER N, NFSKYI, ISKY(*)
5912 my_real
5913 . fskyi(nfskyi,*),ftheskyi(*),condnskyi(*)
5914C-----------------------------------------------
5915C L o c a l V a r i a b l e s
5916C-----------------------------------------------
5917 INTEGER I, J, L, IR, IIA
5918 my_real
5919 . rra1, rra2, rra3, rra4, rra5,ppa,kka
5920C-----------------------------------------------
5921C S o u r c e L i n e s
5922C-----------------------------------------------
5923C test sur n=0
5924 IF (n==0) RETURN
5925 l=n/2+1
5926 ir=n
5927 IF(nfskyi==4)THEN
592810 CONTINUE
5929 IF(l>1)THEN
5930 l=l-1
5931 iia =isky(l)
5932 rra1=fskyi(1,l)
5933 rra2=fskyi(2,l)
5934 rra3=fskyi(3,l)
5935 rra4=fskyi(4,l)
5936 ppa =ftheskyi(l)
5937 kka =condnskyi(l)
5938 ELSE
5939 iia =isky(ir)
5940 rra1=fskyi(1,ir)
5941 rra2=fskyi(2,ir)
5942 rra3=fskyi(3,ir)
5943 rra4=fskyi(4,ir)
5944 ppa =ftheskyi(ir)
5945 isky(ir)=isky(1)
5946 fskyi(1,ir)=fskyi(1,1)
5947 fskyi(2,ir)=fskyi(2,1)
5948 fskyi(3,ir)=fskyi(3,1)
5949 fskyi(4,ir)=fskyi(4,1)
5950 ftheskyi(ir)=ftheskyi(1)
5951 condnskyi(ir)=condnskyi(1)
5952 ir=ir-1
5953C IF(IR==1)THEN
5954 IF(ir<=1)THEN
5955 isky(1)=iia
5956 fskyi(1,1)=rra1
5957 fskyi(2,1)=rra2
5958 fskyi(3,1)=rra3
5959 fskyi(4,1)=rra4
5960 ftheskyi(1)=ppa
5961 condnskyi(1)=kka
5962 RETURN
5963 ENDIF
5964 ENDIF
5965 i=l
5966 j=l+l
596720 IF(j<=ir)THEN
5968 IF(j<ir)THEN
5969 IF(isky(j)<isky(j+1))j=j+1
5970 ENDIF
5971 IF(iia<isky(j))THEN
5972 isky(i)=isky(j)
5973 fskyi(1,i)=fskyi(1,j)
5974 fskyi(2,i)=fskyi(2,j)
5975 fskyi(3,i)=fskyi(3,j)
5976 fskyi(4,i)=fskyi(4,j)
5977 ftheskyi(i)=ftheskyi(j)
5978 condnskyi(i)=condnskyi(j)
5979 i=j
5980 j=j+j
5981 ELSE
5982 j=ir+1
5983 ENDIF
5984 GO TO 20
5985 ENDIF
5986 isky(i)=iia
5987 fskyi(1,i)=rra1
5988 fskyi(2,i)=rra2
5989 fskyi(3,i)=rra3
5990 fskyi(4,i)=rra4
5991 ftheskyi(i)=ppa
5992 condnskyi(i)=kka
5993 GO TO 10
5994 ELSE
5995100 CONTINUE
5996 IF(l>1)THEN
5997 l=l-1
5998 iia =isky(l)
5999 rra1=fskyi(1,l)
6000 rra2=fskyi(2,l)
6001 rra3=fskyi(3,l)
6002 rra4=fskyi(4,l)
6003 rra5=fskyi(5,l)
6004 ppa =ftheskyi(l)
6005 kka =condnskyi(l)
6006 ELSE
6007 iia =isky(ir)
6008 rra1=fskyi(1,ir)
6009 rra2=fskyi(2,ir)
6010 rra3=fskyi(3,ir)
6011 rra4=fskyi(4,ir)
6012 rra5=fskyi(5,ir)
6013 isky(ir)=isky(1)
6014 fskyi(1,ir)=fskyi(1,1)
6015 fskyi(2,ir)=fskyi(2,1)
6016 fskyi(3,ir)=fskyi(3,1)
6017 fskyi(4,ir)=fskyi(4,1)
6018 fskyi(5,ir)=fskyi(5,1)
6019 ftheskyi(ir)=ftheskyi(1)
6020 condnskyi(ir)=condnskyi(1)
6021 ir=ir-1
6022C IF(IR==1)THEN
6023 IF(ir<=1)THEN
6024 isky(1)=iia
6025 fskyi(1,1)=rra1
6026 fskyi(2,1)=rra2
6027 fskyi(3,1)=rra3
6028 fskyi(4,1)=rra4
6029 fskyi(5,1)=rra5
6030 ftheskyi(1)=ppa
6031 condnskyi(1)=ppa
6032 RETURN
6033 ENDIF
6034 ENDIF
6035 i=l
6036 j=l+l
6037200 IF(j<=ir)THEN
6038 IF(j<ir)THEN
6039 IF(isky(j)<isky(j+1))j=j+1
6040 ENDIF
6041 IF(iia<isky(j))THEN
6042 isky(i)=isky(j)
6043 fskyi(1,i)=fskyi(1,j)
6044 fskyi(2,i)=fskyi(2,j)
6045 fskyi(3,i)=fskyi(3,j)
6046 fskyi(4,i)=fskyi(4,j)
6047 fskyi(5,i)=fskyi(5,j)
6048 ftheskyi(i)=ftheskyi(j)
6049 condnskyi(i)=condnskyi(j)
6050 i=j
6051 j=j+j
6052 ELSE
6053 j=ir+1
6054 ENDIF
6055 GO TO 200
6056 ENDIF
6057 isky(i)=iia
6058 fskyi(1,i)=rra1
6059 fskyi(2,i)=rra2
6060 fskyi(3,i)=rra3
6061 fskyi(4,i)=rra4
6062 fskyi(5,i)=rra5
6063 ftheskyi(i)=ppa
6064 condnskyi(i)=ppa
6065 GO TO 100
6066 ENDIF
6067C
6068 RETURN

◆ sortint()

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

Definition at line 5670 of file spmd_i7tool.F.

5671C
5672C-----------------------------------------------
5673C I m p l i c i t T y p e s
5674C-----------------------------------------------
5675#include "implicit_f.inc"
5676C-----------------------------------------------
5677C D u m m y A r g u m e n t s
5678C-----------------------------------------------
5679 INTEGER N, ISKY(*),INDEX(*)
5680C-----------------------------------------------
5681C L o c a l V a r i a b l e s
5682C-----------------------------------------------
5683 INTEGER I, J, L, IR, IIA,IIA2
5684 my_real
5685 . rra1, rra2, rra3, rra4, rra5,ppa
5686C-----------------------------------------------
5687C S o u r c e L i n e s
5688C-----------------------------------------------
5689C test sur n=0
5690 IF (n==0) RETURN
5691 l=n/2+1
5692 ir=n
5693
569410 CONTINUE
5695 IF(l>1)THEN
5696 l=l-1
5697 iia =isky(l)
5698 iia2=index(l)
5699 ELSE
5700 iia =isky(ir)
5701 iia2=index(ir)
5702
5703 isky(ir)=isky(1)
5704 index(ir)=index(1)
5705
5706 ir=ir-1
5707
5708 IF(ir<=1)THEN
5709 isky(1)=iia
5710 index(1)=iia2
5711 RETURN
5712 ENDIF
5713 ENDIF
5714 i=l
5715 j=l+l
571620 IF(j<=ir)THEN
5717 IF(j<ir)THEN
5718 IF(isky(j)<isky(j+1))j=j+1
5719 ENDIF
5720 IF(iia<isky(j))THEN
5721 isky(i)=isky(j)
5722 index(i)=index(j)
5723 i=j
5724 j=j+j
5725 ELSE
5726 j=ir+1
5727 ENDIF
5728 GO TO 20
5729 ENDIF
5730 isky(i)=iia
5731 index(i)=iia2
5732 GO TO 10
5733C
5734 RETURN

◆ spmd_fiadd11_poff()

subroutine spmd_fiadd11_poff ( 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 677 of file spmd_i7tool.F.

683C-----------------------------------------------
684C M o d u l e s
685C-----------------------------------------------
686 USE h3d_mod
687 USE anim_mod
688C-----------------------------------------------
689C I m p l i c i t T y p e s
690C-----------------------------------------------
691#include "implicit_f.inc"
692C-----------------------------------------------
693C C o m m o n B l o c k s
694C-----------------------------------------------
695#include "scr07_c.inc"
696#include "scr14_c.inc"
697#include "scr16_c.inc"
698#include "scr18_c.inc"
699#include "com01_c.inc"
700#include "com04_c.inc"
701#include "com06_c.inc"
702#include "com08_c.inc"
703#include "impl1_c.inc"
704C-----------------------------------------------
705C D u m m y A r g u m e n t s
706C-----------------------------------------------
707 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT,INTTH,
708 . IRECTS(2,*), ICODT(*), NSTRF(*),ICONTACT(*),
709 . TAGNCONT(NLOADP_HYD_INTER,*),
710 . KLOADPINTER(*),LOADPINTER(*),LOADP_HYD_INTER(*)
711 INTEGER, INTENT(IN) :: NODADT_THERM
712 my_real
713 . bufr(len,*), a(3,*), stifn(*), viscn(*),
714 . secfcum(7,numnod,nsect),
715 . fcont(3,*),fthe(*),condn(*)
716 TYPE(H3D_DATABASE) :: H3D_DATA
717C-----------------------------------------------
718C L o c a l V a r i a b l e s
719C-----------------------------------------------
720 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL,NOD1,NOD2,NP
721C-----------------------------------------------
722C S o u r c e L i n e s
723C-----------------------------------------------
724 IF(intth == 0) THEN
725 IF(kdtint==0)THEN
726 DO i = 1, nb
727 n = nint(bufr(1,i))
728 nod = irects(1,n)
729 a(1,nod) = a(1,nod) + bufr(2,i)
730 a(2,nod) = a(2,nod) + bufr(3,i)
731 a(3,nod) = a(3,nod) + bufr(4,i)
732 stifn(nod) = stifn(nod) + bufr(5,i)
733 nod = irects(2,n)
734 a(1,nod) = a(1,nod) + bufr(6,i)
735 a(2,nod) = a(2,nod) + bufr(7,i)
736 a(3,nod) = a(3,nod) + bufr(8,i)
737 stifn(nod) = stifn(nod) + bufr(9,i)
738 ENDDO
739 ELSE
740 DO i = 1, nb
741 n = nint(bufr(1,i))
742 nod = irects(1,n)
743 a(1,nod) = a(1,nod) + bufr(2,i)
744 a(2,nod) = a(2,nod) + bufr(3,i)
745 a(3,nod) = a(3,nod) + bufr(4,i)
746 stifn(nod) = stifn(nod) + bufr(5,i)
747 viscn(nod) = viscn(nod) + bufr(6,i)
748 nod = irects(2,n)
749 a(1,nod) = a(1,nod) + bufr(7,i)
750 a(2,nod) = a(2,nod) + bufr(8,i)
751 a(3,nod) = a(3,nod) + bufr(9,i)
752 stifn(nod) = stifn(nod) + bufr(10,i)
753 viscn(nod) = viscn(nod) + bufr(11,i)
754 ENDDO
755 ENDIF
756 ELSE
757 IF(nodadt_therm ==1 )THEN
758 IF(kdtint==0)THEN
759 DO i = 1, nb
760 n = nint(bufr(1,i))
761 nod = irects(1,n)
762 a(1,nod) = a(1,nod) + bufr(2,i)
763 a(2,nod) = a(2,nod) + bufr(3,i)
764 a(3,nod) = a(3,nod) + bufr(4,i)
765 stifn(nod) = stifn(nod) + bufr(5,i)
766 fthe(nod) = fthe(nod) + bufr(6,i)
767 condn(nod) = condn(nod) + bufr(7,i)
768 nod = irects(2,n)
769 a(1,nod) = a(1,nod) + bufr(8,i)
770 a(2,nod) = a(2,nod) + bufr(9,i)
771 a(3,nod) = a(3,nod) + bufr(10,i)
772 stifn(nod) = stifn(nod) + bufr(11,i)
773 fthe(nod) = fthe(nod) + bufr(12,i)
774 condn(nod) = condn(nod) + bufr(13,i)
775 ENDDO
776 ELSE
777 DO i = 1, nb
778 n = nint(bufr(1,i))
779 nod = irects(1,n)
780 a(1,nod) = a(1,nod) + bufr(2,i)
781 a(2,nod) = a(2,nod) + bufr(3,i)
782 a(3,nod) = a(3,nod) + bufr(4,i)
783 stifn(nod) = stifn(nod) + bufr(5,i)
784 viscn(nod) = viscn(nod) + bufr(6,i)
785 fthe(nod) = fthe(nod) + bufr(7,i)
786 condn(nod) = condn(nod) + bufr(8,i)
787 nod = irects(2,n)
788 a(1,nod) = a(1,nod) + bufr(9,i)
789 a(2,nod) = a(2,nod) + bufr(10,i)
790 a(3,nod) = a(3,nod) + bufr(11,i)
791 stifn(nod) = stifn(nod) + bufr(12,i)
792 viscn(nod) = viscn(nod) + bufr(13,i)
793 fthe(nod) = fthe(nod) + bufr(14,i)
794 condn(nod) = condn(nod) + bufr(15,i)
795 ENDDO
796 ENDIF
797 ELSE
798 IF(kdtint==0)THEN
799 DO i = 1, nb
800 n = nint(bufr(1,i))
801 nod = irects(1,n)
802 a(1,nod) = a(1,nod) + bufr(2,i)
803 a(2,nod) = a(2,nod) + bufr(3,i)
804 a(3,nod) = a(3,nod) + bufr(4,i)
805 stifn(nod) = stifn(nod) + bufr(5,i)
806 fthe(nod) = fthe(nod) + bufr(6,i)
807 nod = irects(2,n)
808 a(1,nod) = a(1,nod) + bufr(7,i)
809 a(2,nod) = a(2,nod) + bufr(8,i)
810 a(3,nod) = a(3,nod) + bufr(9,i)
811 stifn(nod) = stifn(nod) + bufr(10,i)
812 fthe(nod) = fthe(nod) + bufr(11,i)
813 ENDDO
814 ELSE
815 DO i = 1, nb
816 n = nint(bufr(1,i))
817 nod = irects(1,n)
818 a(1,nod) = a(1,nod) + bufr(2,i)
819 a(2,nod) = a(2,nod) + bufr(3,i)
820 a(3,nod) = a(3,nod) + bufr(4,i)
821 stifn(nod) = stifn(nod) + bufr(5,i)
822 viscn(nod) = viscn(nod) + bufr(6,i)
823 fthe(nod) = fthe(nod) + bufr(7,i)
824 nod = irects(2,n)
825 a(1,nod) = a(1,nod) + bufr(8,i)
826 a(2,nod) = a(2,nod) + bufr(9,i)
827 a(3,nod) = a(3,nod) + bufr(10,i)
828 stifn(nod) = stifn(nod) + bufr(11,i)
829 viscn(nod) = viscn(nod) + bufr(12,i)
830 fthe(nod) = fthe(nod) + bufr(13,i)
831 ENDDO
832 ENDIF
833 ENDIF
834 ENDIF
835C
836C continue i11for3 processing on secondary node
837C
838 IF(inconv == 1) THEN
839 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
840 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
841 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
842 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
843C Anim FCONT
844 IF(kdtint==0)THEN
845 DO i = 1, nb
846 n = nint(bufr(1,i))
847 nod = irects(1,n)
848 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
849 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
850 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
851 nod = irects(2,n)
852 fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
853 fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
854 fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
855 END DO
856 ELSE
857 DO i = 1, nb
858 n = nint(bufr(1,i))
859 nod = irects(1,n)
860 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
861 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
862 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
863 nod = irects(2,n)
864 fcont(1,nod)=fcont(1,nod)+ bufr(7,i)
865 fcont(2,nod)=fcont(2,nod)+ bufr(8,i)
866 fcont(3,nod)=fcont(3,nod)+ bufr(9,i)
867 END DO
868 END IF
869 END IF
870 END IF
871C------------For /LOAD/PRESSURE tag nodes in contact-------------
872 IF(nintloadp > 0) THEN
873 DO i = 1, nb
874 n = nint(bufr(1,i))
875 nod1 = irects(1,n)
876 nod2 = irects(2,n)
877 DO np = kloadpinter(noint)+1, kloadpinter(noint+1)
878 pp = loadpinter(np)
879 ppl = loadp_hyd_inter(pp)
880 tagncont(ppl,nod1) = 1
881 tagncont(ppl,nod2) = 1
882 ENDDO
883 ENDDO
884 ENDIF
885C
886 IF(isecin>0)THEN
887C Sections
888 k0=nstrf(25)
889 IF(nstrf(1)+nstrf(2)/=0)THEN
890 DO i=1,nsect
891 nbinter=nstrf(k0+14)
892 k1s=k0+30
893 DO j=1,nbinter
894 IF(nstrf(k1s)==noint)THEN
895 IF(isecut/=0)THEN
896 IF(kdtint==0)THEN
897 DO ii = 1, nb
898 n = nint(bufr(1,ii))
899 nod = irects(1,n)
900 IF(secfcum(4,nod,i)==1.)THEN
901 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
902 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
903 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
904 ENDIF
905 nod = irects(2,n)
906 IF(secfcum(4,nod,i)==1.)THEN
907 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(6,ii)
908 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(7,ii)
909 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(8,ii)
910 ENDIF
911 ENDDO
912 ELSE
913 DO ii = 1, nb
914 n = nint(bufr(1,ii))
915 nod = irects(1,n)
916 IF(secfcum(4,nod,i)==1.)THEN
917 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
918 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
919 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
920 ENDIF
921 nod = irects(2,n)
922 IF(secfcum(4,nod,i)==1.)THEN
923 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
924 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
925 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
926 ENDIF
927 ENDDO
928 END IF
929 ENDIF
930 ENDIF
931 k1s=k1s+1
932 ENDDO
933 k0=nstrf(k0+24)
934 ENDDO
935 ENDIF
936 ENDIF
937C
938 IF ((ibag/=0).OR.(idamp_rdof/=0)) THEN
939C Airbags IBAG
940 IF(kdtint==0)THEN
941 DO i = 1, nb
942 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
943 + bufr(4,i)/=zero) THEN
944 n = nint(bufr(1,i))
945 nod = irects(1,n)
946 icontact(nod)=1
947 END IF
948 IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
949 + bufr(8,i)/=zero) THEN
950 nod = irects(2,n)
951 icontact(nod)=1
952 END IF
953 END DO
954 ELSE
955 DO i = 1, nb
956 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
957 + bufr(4,i)/=zero) THEN
958 n = nint(bufr(1,i))
959 nod = irects(1,n)
960 icontact(nod)=1
961 END IF
962 IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
963 + bufr(9,i)/=zero) THEN
964 nod = irects(2,n)
965 icontact(nod)=1
966 END IF
967 END DO
968 END IF
969 END IF
970C
971 RETURN
anim_mod
Definition anim_mod.F:96
h3d_mod
Definition h3d_mod.F:308

◆ spmd_fiadd11_pon()

subroutine spmd_fiadd11_pon ( 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 2191 of file spmd_i7tool.F.

2198C-----------------------------------------------
2199C M o d u l e s
2200C-----------------------------------------------
2201 USE message_mod
2202 USE h3d_mod
2203 USE anim_mod
2204C-----------------------------------------------
2205C I m p l i c i t T y p e s
2206C-----------------------------------------------
2207#include "implicit_f.inc"
2208C-----------------------------------------------
2209C C o m m o n B l o c k s
2210C-----------------------------------------------
2211#include "parit_c.inc"
2212#include "scr07_c.inc"
2213#include "scr14_c.inc"
2214#include "scr16_c.inc"
2215#include "scr18_c.inc"
2216#include "com01_c.inc"
2217#include "com04_c.inc"
2218#include "com06_c.inc"
2219#include "com08_c.inc"
2220C-----------------------------------------------
2221C D u m m y A r g u m e n t s
2222C-----------------------------------------------
2223 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT,INTTH,NIN,
2224 . IRECTS(2,*), ISKY(*), ICODT(*), NSTRF(*),
2225 . ICONTACT(*),
2226 . TAGNCONT(NLOADP_HYD_INTER,*),KLOADPINTER(*),LOADPINTER(*),
2227 . LOADP_HYD_INTER(*)
2228 INTEGER, INTENT(IN) :: NODADT_THERM
2229 my_real
2230 . bufr(len,*),
2231 . fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
2232 . fcont(3,*),ftheskyi(*),condnskyi(*)
2233 TYPE(H3D_DATABASE) :: H3D_DATA
2234C-----------------------------------------------
2235C L o c a l V a r i a b l e s
2236C-----------------------------------------------
2237 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL,NOD1,NOD2,NP
2238C-----------------------------------------------
2239C S o u r c e L i n e s
2240C-----------------------------------------------
2241 IF ((nisky+nb)> lskyi)THEN
2242 CALL ancmsg(msgid=26,anmode=aninfo)
2243 CALL arret(2)
2244 ENDIF
2245
2246 IF(intth == 0 ) THEN
2247 IF(kdtint==0)THEN
2248 DO i = 1, nb
2249 n = nint(bufr(1,i))
2250 nod = irects(1,n)
2251 nisky = nisky + 1
2252 fskyi(nisky,1)=bufr(2,i)
2253 fskyi(nisky,2)=bufr(3,i)
2254 fskyi(nisky,3)=bufr(4,i)
2255 fskyi(nisky,4)=bufr(5,i)
2256 isky(nisky) = nod
2257 nod = irects(2,n)
2258 nisky = nisky + 1
2259 fskyi(nisky,1)=bufr(6,i)
2260 fskyi(nisky,2)=bufr(7,i)
2261 fskyi(nisky,3)=bufr(8,i)
2262 fskyi(nisky,4)=bufr(9,i)
2263 isky(nisky) = nod
2264 ENDDO
2265 ELSE
2266 DO i = 1, nb
2267 n = nint(bufr(1,i))
2268 nod = irects(1,n)
2269 nisky = nisky + 1
2270 fskyi(nisky,1)=bufr(2,i)
2271 fskyi(nisky,2)=bufr(3,i)
2272 fskyi(nisky,3)=bufr(4,i)
2273 fskyi(nisky,4)=bufr(5,i)
2274 fskyi(nisky,5)=bufr(6,i)
2275 isky(nisky) = nod
2276 nod = irects(2,n)
2277 nisky = nisky + 1
2278 fskyi(nisky,1)=bufr(7,i)
2279 fskyi(nisky,2)=bufr(8,i)
2280 fskyi(nisky,3)=bufr(9,i)
2281 fskyi(nisky,4)=bufr(10,i)
2282 fskyi(nisky,5)=bufr(11,i)
2283 isky(nisky) = nod
2284 ENDDO
2285 ENDIF
2286 ELSE
2287 IF(nodadt_therm == 1) THEN ! Thermal Time Step
2288 IF(kdtint==0)THEN
2289 DO i = 1, nb
2290 n = nint(bufr(1,i))
2291 nod = irects(1,n)
2292 nisky = nisky + 1
2293 fskyi(nisky,1)=bufr(2,i)
2294 fskyi(nisky,2)=bufr(3,i)
2295 fskyi(nisky,3)=bufr(4,i)
2296 fskyi(nisky,4)=bufr(5,i)
2297 ftheskyi(nisky) =bufr(10,i)
2298 condnskyi(nisky)=bufr(12,i)
2299 isky(nisky) = nod
2300 nod = irects(2,n)
2301 nisky = nisky + 1
2302 fskyi(nisky,1)=bufr(6,i)
2303 fskyi(nisky,2)=bufr(7,i)
2304 fskyi(nisky,3)=bufr(8,i)
2305 fskyi(nisky,4)=bufr(9,i)
2306 ftheskyi(nisky) =bufr(11,i)
2307 condnskyi(nisky)=bufr(13,i)
2308 isky(nisky) = nod
2309 ENDDO
2310 ELSE
2311 DO i = 1, nb
2312 n = nint(bufr(1,i))
2313 nod = irects(1,n)
2314 nisky = nisky + 1
2315 fskyi(nisky,1)=bufr(2,i)
2316 fskyi(nisky,2)=bufr(3,i)
2317 fskyi(nisky,3)=bufr(4,i)
2318 fskyi(nisky,4)=bufr(5,i)
2319 fskyi(nisky,5)=bufr(6,i)
2320 ftheskyi(nisky) =bufr(12,i)
2321 condnskyi(nisky)=bufr(13,i)
2322 isky(nisky) = nod
2323 nod = irects(2,n)
2324 nisky = nisky + 1
2325 fskyi(nisky,1)=bufr(7,i)
2326 fskyi(nisky,2)=bufr(8,i)
2327 fskyi(nisky,3)=bufr(9,i)
2328 fskyi(nisky,4)=bufr(10,i)
2329 fskyi(nisky,5)=bufr(11,i)
2330 ftheskyi(nisky) =bufr(13,i)
2331 condnskyi(nisky)=bufr(14,i)
2332 isky(nisky) = nod
2333 ENDDO
2334 ENDIF
2335 ELSE
2336 IF(kdtint==0)THEN
2337 DO i = 1, nb
2338 n = nint(bufr(1,i))
2339 nod = irects(1,n)
2340 nisky = nisky + 1
2341 fskyi(nisky,1)=bufr(2,i)
2342 fskyi(nisky,2)=bufr(3,i)
2343 fskyi(nisky,3)=bufr(4,i)
2344 fskyi(nisky,4)=bufr(5,i)
2345 ftheskyi(nisky) =bufr(10,i)
2346 isky(nisky) = nod
2347 nod = irects(2,n)
2348 nisky = nisky + 1
2349 fskyi(nisky,1)=bufr(6,i)
2350 fskyi(nisky,2)=bufr(7,i)
2351 fskyi(nisky,3)=bufr(8,i)
2352 fskyi(nisky,4)=bufr(9,i)
2353 ftheskyi(nisky) =bufr(11,i)
2354 isky(nisky) = nod
2355 ENDDO
2356 ELSE
2357 DO i = 1, nb
2358 n = nint(bufr(1,i))
2359 nod = irects(1,n)
2360 nisky = nisky + 1
2361 fskyi(nisky,1)=bufr(2,i)
2362 fskyi(nisky,2)=bufr(3,i)
2363 fskyi(nisky,3)=bufr(4,i)
2364 fskyi(nisky,4)=bufr(5,i)
2365 fskyi(nisky,5)=bufr(6,i)
2366 ftheskyi(nisky) =bufr(12,i)
2367 isky(nisky) = nod
2368 nod = irects(2,n)
2369 nisky = nisky + 1
2370 fskyi(nisky,1)=bufr(7,i)
2371 fskyi(nisky,2)=bufr(8,i)
2372 fskyi(nisky,3)=bufr(9,i)
2373 fskyi(nisky,4)=bufr(10,i)
2374 fskyi(nisky,5)=bufr(11,i)
2375 ftheskyi(nisky) =bufr(13,i)
2376 isky(nisky) = nod
2377 ENDDO
2378 ENDIF
2379 ENDIF
2380 ENDIF
2381C
2382C continue i11for3 processing on secondary node
2383C
2384 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
2385 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
2386 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
2387 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
2388C Anim FCONT
2389 IF(kdtint==0)THEN
2390 DO i = 1, nb
2391 n = nint(bufr(1,i))
2392 nod = irects(1,n)
2393 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
2394 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
2395 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
2396 nod = irects(2,n)
2397 fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
2398 fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
2399 fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
2400 END DO
2401 ELSE
2402 DO i = 1, nb
2403 n = nint(bufr(1,i))
2404 nod = irects(1,n)
2405 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
2406 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
2407 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
2408 nod = irects(2,n)
2409 fcont(1,nod)=fcont(1,nod)+ bufr(7,i)
2410 fcont(2,nod)=fcont(2,nod)+ bufr(8,i)
2411 fcont(3,nod)=fcont(3,nod)+ bufr(9,i)
2412 END DO
2413 END IF
2414 END IF
2415C
2416C------------For /LOAD/PRESSURE tag nodes in contact-------------
2417 IF(nintloadp > 0) THEN
2418 DO i = 1, nb
2419 n = nint(bufr(1,i))
2420 nod1 = irects(1,n)
2421 nod2 = irects(2,n)
2422 DO np = kloadpinter(nin)+1, kloadpinter(nin+1)
2423 pp = loadpinter(np)
2424 ppl = loadp_hyd_inter(pp)
2425 tagncont(ppl,nod1) = 1
2426 tagncont(ppl,nod2) = 1
2427 ENDDO
2428 ENDDO
2429 ENDIF
2430C
2431 IF(isecin>0)THEN
2432C Sections
2433 k0=nstrf(25)
2434 IF(nstrf(1)+nstrf(2)/=0)THEN
2435 DO i=1,nsect
2436 nbinter=nstrf(k0+14)
2437 k1s=k0+30
2438 DO j=1,nbinter
2439 IF(nstrf(k1s)==noint)THEN
2440 IF(isecut/=0)THEN
2441 IF(kdtint==0)THEN
2442 DO ii = 1, nb
2443 n = nint(bufr(1,ii))
2444 nod = irects(1,n)
2445 IF(secfcum(4,nod,i)==1.)THEN
2446 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2447 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2448 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2449 ENDIF
2450 nod = irects(2,n)
2451 IF(secfcum(4,nod,i)==1.)THEN
2452 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(6,ii)
2453 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(7,ii)
2454 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(8,ii)
2455 ENDIF
2456 ENDDO
2457 ELSE
2458 DO ii = 1, nb
2459 n = nint(bufr(1,ii))
2460 nod = irects(1,n)
2461 IF(secfcum(4,nod,i)==1.)THEN
2462 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2463 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2464 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2465 ENDIF
2466 nod = irects(2,n)
2467 IF(secfcum(4,nod,i)==1.)THEN
2468 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
2469 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
2470 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
2471 ENDIF
2472 ENDDO
2473 END IF
2474 ENDIF
2475 ENDIF
2476 k1s=k1s+1
2477 ENDDO
2478 k0=nstrf(k0+24)
2479 ENDDO
2480 ENDIF
2481 ENDIF
2482C
2483 IF((ibag/=0).OR.(idamp_rdof/=0))THEN
2484C Airbags IBAG
2485 IF(kdtint==0)THEN
2486 DO i = 1, nb
2487 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2488 + bufr(4,i)/=zero) THEN
2489 n = nint(bufr(1,i))
2490 nod = irects(1,n)
2491 icontact(nod)=1
2492 END IF
2493 IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
2494 + bufr(8,i)/=zero) THEN
2495 nod = irects(2,n)
2496 icontact(nod)=1
2497 END IF
2498 END DO
2499 ELSE
2500 DO i = 1, nb
2501 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2502 + bufr(4,i)/=zero) THEN
2503 n = nint(bufr(1,i))
2504 nod = irects(1,n)
2505 icontact(nod)=1
2506 END IF
2507 IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
2508 + bufr(9,i)/=zero) THEN
2509 nod = irects(2,n)
2510 icontact(nod)=1
2511 END IF
2512 END DO
2513 END IF
2514 END IF
2515C
2516 RETURN
arret
subroutine arret(nn)
Definition arret.F:87

◆ spmd_fiadd17_poff()

subroutine spmd_fiadd17_poff ( 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 982 of file spmd_i7tool.F.

986C-----------------------------------------------
987C M o d u l e s
988C-----------------------------------------------
989 USE h3d_mod
990 USE anim_mod
991C-----------------------------------------------
992C I m p l i c i t T y p e s
993C-----------------------------------------------
994#include "implicit_f.inc"
995C-----------------------------------------------
996C C o m m o n B l o c k s
997C-----------------------------------------------
998#include "scr07_c.inc"
999#include "scr14_c.inc"
1000#include "scr16_c.inc"
1001#include "com06_c.inc"
1002#include "com08_c.inc"
1003C-----------------------------------------------
1004C D u m m y A r g u m e n t s
1005C-----------------------------------------------
1006 INTEGER NB, LEN, NN,
1007 . NELEMS(*), IXS(NIXS,*) ,IXS16(8,*)
1008 my_real
1009 . bufr(len,*), a(3,*), stifn(*),
1010 . fcont(3,*), frots(7,*)
1011 TYPE(H3D_DATABASE) :: H3D_DATA
1012C-----------------------------------------------
1013C L o c a l V a r i a b l e s
1014C-----------------------------------------------
1015 INTEGER I, NOD, NE
1016C-----------------------------------------------
1017C S o u r c e L i n e s
1018C-----------------------------------------------
1019 DO i = 1, nb
1020 nn = nint(bufr(1,i))
1021 ne = nelems(nn)
1022C
1023 nod = ixs(2,ne)
1024 a(1,nod) = a(1,nod) + bufr(2,i)
1025 a(2,nod) = a(2,nod) + bufr(3,i)
1026 a(3,nod) = a(3,nod) + bufr(4,i)
1027 stifn(nod) = stifn(nod) + bufr(5,i)
1028 nod = ixs(3,ne)
1029 a(1,nod) = a(1,nod) + bufr(6,i)
1030 a(2,nod) = a(2,nod) + bufr(7,i)
1031 a(3,nod) = a(3,nod) + bufr(8,i)
1032 stifn(nod) = stifn(nod) + bufr(9,i)
1033 nod = ixs(4,ne)
1034 a(1,nod) = a(1,nod) + bufr(10,i)
1035 a(2,nod) = a(2,nod) + bufr(11,i)
1036 a(3,nod) = a(3,nod) + bufr(12,i)
1037 stifn(nod) = stifn(nod) + bufr(13,i)
1038 nod = ixs(5,ne)
1039 a(1,nod) = a(1,nod) + bufr(14,i)
1040 a(2,nod) = a(2,nod) + bufr(15,i)
1041 a(3,nod) = a(3,nod) + bufr(16,i)
1042 stifn(nod) = stifn(nod) + bufr(17,i)
1043 nod = ixs(6,ne)
1044 a(1,nod) = a(1,nod) + bufr(18,i)
1045 a(2,nod) = a(2,nod) + bufr(19,i)
1046 a(3,nod) = a(3,nod) + bufr(20,i)
1047 stifn(nod) = stifn(nod) + bufr(21,i)
1048 nod = ixs(7,ne)
1049 a(1,nod) = a(1,nod) + bufr(22,i)
1050 a(2,nod) = a(2,nod) + bufr(23,i)
1051 a(3,nod) = a(3,nod) + bufr(24,i)
1052 stifn(nod) = stifn(nod) + bufr(25,i)
1053 nod = ixs(8,ne)
1054 a(1,nod) = a(1,nod) + bufr(26,i)
1055 a(2,nod) = a(2,nod) + bufr(27,i)
1056 a(3,nod) = a(3,nod) + bufr(28,i)
1057 stifn(nod) = stifn(nod) + bufr(29,i)
1058 nod = ixs(9,ne)
1059 a(1,nod) = a(1,nod) + bufr(30,i)
1060 a(2,nod) = a(2,nod) + bufr(31,i)
1061 a(3,nod) = a(3,nod) + bufr(32,i)
1062 stifn(nod) = stifn(nod) + bufr(33,i)
1063C
1064 nod = ixs16(1,ne)
1065 a(1,nod) = a(1,nod) + bufr(34,i)
1066 a(2,nod) = a(2,nod) + bufr(35,i)
1067 a(3,nod) = a(3,nod) + bufr(36,i)
1068 stifn(nod) = stifn(nod) + bufr(37,i)
1069 nod = ixs16(2,ne)
1070 a(1,nod) = a(1,nod) + bufr(38,i)
1071 a(2,nod) = a(2,nod) + bufr(39,i)
1072 a(3,nod) = a(3,nod) + bufr(40,i)
1073 stifn(nod) = stifn(nod) + bufr(41,i)
1074 nod = ixs16(3,ne)
1075 a(1,nod) = a(1,nod) + bufr(42,i)
1076 a(2,nod) = a(2,nod) + bufr(43,i)
1077 a(3,nod) = a(3,nod) + bufr(44,i)
1078 stifn(nod) = stifn(nod) + bufr(45,i)
1079 nod = ixs16(4,ne)
1080 a(1,nod) = a(1,nod) + bufr(46,i)
1081 a(2,nod) = a(2,nod) + bufr(47,i)
1082 a(3,nod) = a(3,nod) + bufr(48,i)
1083 stifn(nod) = stifn(nod) + bufr(49,i)
1084 nod = ixs16(5,ne)
1085 a(1,nod) = a(1,nod) + bufr(50,i)
1086 a(2,nod) = a(2,nod) + bufr(51,i)
1087 a(3,nod) = a(3,nod) + bufr(52,i)
1088 stifn(nod) = stifn(nod) + bufr(53,i)
1089 nod = ixs16(6,ne)
1090 a(1,nod) = a(1,nod) + bufr(54,i)
1091 a(2,nod) = a(2,nod) + bufr(55,i)
1092 a(3,nod) = a(3,nod) + bufr(56,i)
1093 stifn(nod) = stifn(nod) + bufr(57,i)
1094 nod = ixs16(7,ne)
1095 a(1,nod) = a(1,nod) + bufr(58,i)
1096 a(2,nod) = a(2,nod) + bufr(59,i)
1097 a(3,nod) = a(3,nod) + bufr(60,i)
1098 stifn(nod) = stifn(nod) + bufr(61,i)
1099 nod = ixs16(8,ne)
1100 a(1,nod) = a(1,nod) + bufr(62,i)
1101 a(2,nod) = a(2,nod) + bufr(63,i)
1102 a(3,nod) = a(3,nod) + bufr(64,i)
1103 stifn(nod) = stifn(nod) + bufr(65,i)
1104C
1105 frots(1,nn) = frots(1,nn) + bufr(66,i)
1106 frots(2,nn) = frots(2,nn) + bufr(67,i)
1107 frots(3,nn) = frots(3,nn) + bufr(68,i)
1108 frots(4,nn) = frots(4,nn) + bufr(69,i)
1109 ENDDO
1110C
1111C continue i11for3 processing on secondary node
1112C
1113 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
1114 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
1115 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
1116 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
1117C Anim FCONT
1118 DO i = 1, nb
1119 ne = nint(bufr(1,i))
1120C
1121 nod = ixs(2,ne)
1122 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
1123 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
1124 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
1125 nod = ixs(3,ne)
1126 fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
1127 fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
1128 fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
1129 nod = ixs(4,ne)
1130 fcont(1,nod)=fcont(1,nod)+ bufr(10,i)
1131 fcont(2,nod)=fcont(2,nod)+ bufr(11,i)
1132 fcont(3,nod)=fcont(3,nod)+ bufr(12,i)
1133 nod = ixs(5,ne)
1134 fcont(1,nod)=fcont(1,nod)+ bufr(14,i)
1135 fcont(2,nod)=fcont(2,nod)+ bufr(15,i)
1136 fcont(3,nod)=fcont(3,nod)+ bufr(16,i)
1137 nod = ixs(6,ne)
1138 fcont(1,nod)=fcont(1,nod)+ bufr(18,i)
1139 fcont(2,nod)=fcont(2,nod)+ bufr(19,i)
1140 fcont(3,nod)=fcont(3,nod)+ bufr(20,i)
1141 nod = ixs(7,ne)
1142 fcont(1,nod)=fcont(1,nod)+ bufr(22,i)
1143 fcont(2,nod)=fcont(2,nod)+ bufr(23,i)
1144 fcont(3,nod)=fcont(3,nod)+ bufr(24,i)
1145 nod = ixs(8,ne)
1146 fcont(1,nod)=fcont(1,nod)+ bufr(26,i)
1147 fcont(2,nod)=fcont(2,nod)+ bufr(27,i)
1148 fcont(3,nod)=fcont(3,nod)+ bufr(28,i)
1149 nod = ixs(9,ne)
1150 fcont(1,nod)=fcont(1,nod)+ bufr(30,i)
1151 fcont(2,nod)=fcont(2,nod)+ bufr(31,i)
1152 fcont(3,nod)=fcont(3,nod)+ bufr(32,i)
1153C
1154 nod = ixs16(1,ne)
1155 fcont(1,nod)=fcont(1,nod)+ bufr(34,i)
1156 fcont(2,nod)=fcont(2,nod)+ bufr(35,i)
1157 fcont(3,nod)=fcont(3,nod)+ bufr(36,i)
1158 nod = ixs16(2,ne)
1159 fcont(1,nod)=fcont(1,nod)+ bufr(38,i)
1160 fcont(2,nod)=fcont(2,nod)+ bufr(39,i)
1161 fcont(3,nod)=fcont(3,nod)+ bufr(40,i)
1162 nod = ixs16(3,ne)
1163 fcont(1,nod)=fcont(1,nod)+ bufr(42,i)
1164 fcont(2,nod)=fcont(2,nod)+ bufr(43,i)
1165 fcont(3,nod)=fcont(3,nod)+ bufr(44,i)
1166 nod = ixs16(4,ne)
1167 fcont(1,nod)=fcont(1,nod)+ bufr(46,i)
1168 fcont(2,nod)=fcont(2,nod)+ bufr(47,i)
1169 fcont(3,nod)=fcont(3,nod)+ bufr(48,i)
1170 nod = ixs16(5,ne)
1171 fcont(1,nod)=fcont(1,nod)+ bufr(50,i)
1172 fcont(2,nod)=fcont(2,nod)+ bufr(51,i)
1173 fcont(3,nod)=fcont(3,nod)+ bufr(52,i)
1174 nod = ixs16(6,ne)
1175 fcont(1,nod)=fcont(1,nod)+ bufr(54,i)
1176 fcont(2,nod)=fcont(2,nod)+ bufr(55,i)
1177 fcont(3,nod)=fcont(3,nod)+ bufr(56,i)
1178 nod = ixs16(7,ne)
1179 fcont(1,nod)=fcont(1,nod)+ bufr(58,i)
1180 fcont(2,nod)=fcont(2,nod)+ bufr(59,i)
1181 fcont(3,nod)=fcont(3,nod)+ bufr(60,i)
1182 nod = ixs16(8,ne)
1183 fcont(1,nod)=fcont(1,nod)+ bufr(62,i)
1184 fcont(2,nod)=fcont(2,nod)+ bufr(63,i)
1185 fcont(3,nod)=fcont(3,nod)+ bufr(64,i)
1186 END DO
1187 END IF
1188C
1189 RETURN

◆ spmd_fiadd17_pon()

subroutine spmd_fiadd17_pon ( 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 2751 of file spmd_i7tool.F.

2754C-----------------------------------------------
2755C M o d u l e s
2756C-----------------------------------------------
2757 USE h3d_mod
2758 USE anim_mod
2759C-----------------------------------------------
2760C I m p l i c i t T y p e s
2761C-----------------------------------------------
2762#include "implicit_f.inc"
2763C-----------------------------------------------
2764C C o m m o n B l o c k s
2765C-----------------------------------------------
2766#include "parit_c.inc"
2767#include "scr07_c.inc"
2768#include "scr14_c.inc"
2769#include "scr16_c.inc"
2770#include "com04_c.inc"
2771#include "com06_c.inc"
2772#include "com08_c.inc"
2773C-----------------------------------------------
2774C D u m m y A r g u m e n t s
2775C-----------------------------------------------
2776 INTEGER NB, LEN,
2777 . NELEMS(*), ISKY(*), IXS(NIXS,*), IXS16(8,*)
2778 my_real bufr(len,*),
2779 . fskyi(lskyi,nfskyi),
2780 . fcont(3,*)
2781 TYPE(H3D_DATABASE) :: H3D_DATA
2782C-----------------------------------------------
2783C L o c a l V a r i a b l e s
2784C-----------------------------------------------
2785 INTEGER I, J, II, IIIS, NOD, IES, NN
2786C-----------------------------------------------
2787C S o u r c e L i n e s
2788C-----------------------------------------------
2789 DO i = 1, nb
2790 nn = nint(bufr(1,i))
2791 ies = nelems(nn)
2792 DO ii =1,8
2793 iiis = nint(bufr(6+(ii-1)*5,i))
2794 IF(iiis<=8)THEN
2795 nod = ixs(iiis+1,ies)
2796 ELSE
2797 nod = ixs16(iiis-8,ies-numels8-numels10-numels20)
2798 END IF
2799 nisky = nisky + 1
2800 fskyi(nisky,1)=bufr(2+(ii-1)*5,i)
2801 fskyi(nisky,2)=bufr(3+(ii-1)*5,i)
2802 fskyi(nisky,3)=bufr(4+(ii-1)*5,i)
2803 fskyi(nisky,4)=bufr(5+(ii-1)*5,i)
2804 isky(nisky) = nod
2805 END DO
2806 END DO
2807C
2808C following i11for3 process on secondary nodes
2809C
2810 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
2811 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
2812 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
2813 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
2814C Anim FCONT
2815 DO i = 1, nb
2816 ies = nelems(nint(bufr(1,i)))
2817 DO ii =1,8
2818 iiis = nint(bufr(6+(ii-1)*5,i))
2819c IIIS = NINT(BUFR(10+(II-1)*5,I))
2820 IF(iiis<=8)THEN
2821 nod = ixs(iiis+1,ies)
2822 ELSE
2823 nod = ixs16(iiis-8,ies-numels8-numels10-numels20)
2824 END IF
2825 fcont(1,nod)=fcont(1,nod)+ bufr(2+(ii-1)*5,i)
2826 fcont(2,nod)=fcont(2,nod)+ bufr(3+(ii-1)*5,i)
2827 fcont(3,nod)=fcont(3,nod)+ bufr(4+(ii-1)*5,i)
2828 END DO
2829 END DO
2830 END IF
2831C
2832 RETURN

◆ spmd_fiadd20_poff()

subroutine spmd_fiadd20_poff ( 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 1203 of file spmd_i7tool.F.

1209C-----------------------------------------------
1210C M o d u l e s
1211C-----------------------------------------------
1212 USE h3d_mod
1213 USE anim_mod
1214C-----------------------------------------------
1215C I m p l i c i t T y p e s
1216C-----------------------------------------------
1217#include "implicit_f.inc"
1218C-----------------------------------------------
1219C C o m m o n B l o c k s
1220C-----------------------------------------------
1221#include "scr05_c.inc"
1222#include "scr07_c.inc"
1223#include "scr14_c.inc"
1224#include "scr16_c.inc"
1225#include "scr18_c.inc"
1226#include "com01_c.inc"
1227#include "com04_c.inc"
1228#include "com06_c.inc"
1229#include "com08_c.inc"
1230C-----------------------------------------------
1231C D u m m y A r g u m e n t s
1232C-----------------------------------------------
1233 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT, INACTI,
1234 . NSV(*), ICODT(*), NSTRF(*), NLG(*),
1235 . ICONTACT(*), IADM,INTTH
1236 my_real
1237 . bufr(len,*), a(3,*), stifn(*), viscn(*),
1238 . secfcum(7,numnod,nsect),
1239 . fcont(3,*),fthe(*), alphak(3,*)
1240 DOUBLE PRECISION DAANC6(3,6,*)
1241 TYPE(H3D_DATABASE) :: H3D_DATA
1242C-----------------------------------------------
1243C L o c a l V a r i a b l e s
1244C-----------------------------------------------
1245 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER, INC,ISIGN
1246 DOUBLE PRECISION DAANC6L(3,6)
1247C-----------------------------------------------
1248C S o u r c e L i n e s
1249C-----------------------------------------------
1250C
1251 IF(intth == 0 ) THEN
1252 IF(kdtint==0)THEN
1253 DO i = 1, nb
1254 n = nsv(nint(bufr(1,i)))
1255 nod = nlg(n)
1256 a(1,nod) = a(1,nod) + bufr(2,i)
1257 a(2,nod) = a(2,nod) + bufr(3,i)
1258 a(3,nod) = a(3,nod) + bufr(4,i)
1259 stifn(nod) = stifn(nod) + bufr(5,i)
1260C type20 interface treatment
1261 isign = 1
1262 IF(alphak(2,n) < zero .or. bufr(6,i) < zero)isign = -1
1263 alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(6,i)))
1264 CALL getdpdaanc(daanc6l,bufr(7,i),iresp,inc)
1265 daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
1266 daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
1267 daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
1268 daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
1269 daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
1270 daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
1271 daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
1272 daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
1273 daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
1274 daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
1275 daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
1276 daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
1277 daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
1278 daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
1279 daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
1280 daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
1281 daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
1282 daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
1283 ENDDO
1284 ELSE
1285 DO i = 1, nb
1286 n = nsv(nint(bufr(1,i)))
1287 nod = nlg(n)
1288 a(1,nod) = a(1,nod) + bufr(2,i)
1289 a(2,nod) = a(2,nod) + bufr(3,i)
1290 a(3,nod) = a(3,nod) + bufr(4,i)
1291 stifn(nod) = stifn(nod) + bufr(5,i)
1292 viscn(nod) = viscn(nod) + bufr(6,i)
1293 isign = 1
1294 IF(alphak(2,n) < zero .or. bufr(7,i) < zero)isign = -1
1295 alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(7,i)))
1296C type20 interface treatment
1297 CALL getdpdaanc(daanc6l,bufr(8,i),iresp,inc)
1298 daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
1299 daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
1300 daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
1301 daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
1302 daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
1303 daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
1304 daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
1305 daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
1306 daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
1307 daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
1308 daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
1309 daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
1310 daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
1311 daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
1312 daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
1313 daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
1314 daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
1315 daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
1316 ENDDO
1317 ENDIF
1318C
1319 ELSE
1320 IF(kdtint==0)THEN
1321 DO i = 1, nb
1322 n = nsv(nint(bufr(1,i)))
1323 nod = nlg(n)
1324 a(1,nod) = a(1,nod) + bufr(2,i)
1325 a(2,nod) = a(2,nod) + bufr(3,i)
1326 a(3,nod) = a(3,nod) + bufr(4,i)
1327 stifn(nod) = stifn(nod) + bufr(5,i)
1328 fthe(nod) = fthe(nod) + bufr(6,i)
1329C type20 interface treatment
1330 isign = 1
1331 IF(alphak(2,n) < zero .or. bufr(7,i) < zero)isign = -1
1332 alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(7,i)))
1333 CALL getdpdaanc(daanc6l,bufr(8,i),iresp,inc)
1334 daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
1335 daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
1336 daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
1337 daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
1338 daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
1339 daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
1340 daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
1341 daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
1342 daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
1343 daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
1344 daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
1345 daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
1346 daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
1347 daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
1348 daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
1349 daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
1350 daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
1351 daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
1352 ENDDO
1353 ELSE
1354 DO i = 1, nb
1355 n = nsv(nint(bufr(1,i)))
1356 nod = nlg(n)
1357 a(1,nod) = a(1,nod) + bufr(2,i)
1358 a(2,nod) = a(2,nod) + bufr(3,i)
1359 a(3,nod) = a(3,nod) + bufr(4,i)
1360 stifn(nod) = stifn(nod) + bufr(5,i)
1361 viscn(nod) = viscn(nod) + bufr(6,i)
1362 fthe(nod) = fthe(nod) + bufr(7,i)
1363C type20 interface treatment
1364 isign = 1
1365 IF(alphak(2,n) < zero .or. bufr(8,i) < zero)isign = -1
1366 alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(8,i)))
1367 CALL getdpdaanc(daanc6l,bufr(9,i),iresp,inc)
1368 daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
1369 daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
1370 daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
1371 daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
1372 daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
1373 daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
1374 daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
1375 daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
1376 daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
1377 daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
1378 daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
1379 daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
1380 daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
1381 daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
1382 daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
1383 daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
1384 daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
1385 daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
1386 ENDDO
1387 ENDIF
1388 ENDIF
1389C
1390C following i7for3 & i10for3 process on secondary nodes
1391C
1392 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
1393 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
1394 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
1395 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
1396C Anim FCONT
1397 DO i = 1, nb
1398 n = nint(bufr(1,i))
1399 nod = nlg(nsv(n))
1400 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
1401 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
1402 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
1403 END DO
1404 END IF
1405C
1406 IF(isecin>0)THEN
1407C Sections
1408 k0=nstrf(25)
1409 IF(nstrf(1)+nstrf(2)/=0)THEN
1410 DO i=1,nsect
1411 nbinter=nstrf(k0+14)
1412 k1s=k0+30
1413 DO j=1,nbinter
1414 IF(nstrf(k1s)==noint)THEN
1415 IF(isecut/=0)THEN
1416 DO ii = 1, nb
1417 n = nint(bufr(1,ii))
1418 nod = nsv(n)
1419 IF(secfcum(4,nod,i)==1.)THEN
1420 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
1421 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
1422 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
1423 ENDIF
1424 ENDDO
1425 ENDIF
1426 ENDIF
1427 k1s=k1s+1
1428 ENDDO
1429 k0=nstrf(k0+24)
1430 ENDDO
1431 ENDIF
1432 ENDIF
1433C
1434 IF((ibag/=0.AND.inacti/=7).OR.
1435 . iadm/=0)THEN ! warning conflict inacti=7 and ibag=3
1436C Airbags IBAG
1437 DO i = 1, nb
1438 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
1439 + bufr(4,i)/=zero) THEN
1440 n = nint(bufr(1,i))
1441 nod = nlg(nsv(n))
1442 icontact(nod)=1
1443 END IF
1444 END DO
1445 END IF
1446C
1447 IF(ibc/=0) THEN
1448 ibcm = ibc / 8
1449 ibcs = ibc - 8 * ibcm
1450C Boundary cond.
1451 IF(ibcs>0) THEN
1452 DO i = 1, nb
1453 n = nint(bufr(1,i))
1454 nod = nlg(nsv(n))
1455 CALL ibcoff(ibcs,icodt(nod))
1456 END DO
1457 END IF
1458 END IF
1459C
1460 RETURN
ibcoff
subroutine ibcoff(ibc, icodt)
Definition ibcoff.F:44
min
#define min(a, b)
Definition macros.h:20
getdpdaanc
subroutine getdpdaanc(daanc6, buf, iresp, inc)
Definition spmd_i7tool.F:7361

◆ spmd_fiadd20e_poff()

subroutine spmd_fiadd20e_poff ( 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 1473 of file spmd_i7tool.F.

1478C-----------------------------------------------
1479C M o d u l e s
1480C-----------------------------------------------
1481 USE h3d_mod
1482 USE anim_mod
1483C-----------------------------------------------
1484C I m p l i c i t T y p e s
1485C-----------------------------------------------
1486#include "implicit_f.inc"
1487C-----------------------------------------------
1488C C o m m o n B l o c k s
1489C-----------------------------------------------
1490#include "scr05_c.inc"
1491#include "scr07_c.inc"
1492#include "scr14_c.inc"
1493#include "scr16_c.inc"
1494#include "scr18_c.inc"
1495#include "com01_c.inc"
1496#include "com04_c.inc"
1497#include "com06_c.inc"
1498#include "com08_c.inc"
1499C-----------------------------------------------
1500C D u m m y A r g u m e n t s
1501C-----------------------------------------------
1502 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT,
1503 . IXLINS(2,*), ICODT(*), NSTRF(*),
1504 . ICONTACT(*), NLG(*)
1505 my_real
1506 . bufr(len,*), a(3,*), stifn(*), viscn(*),
1507 . secfcum(7,numnod,nsect),
1508 . fcont(3,*), alphak(3,*)
1509 DOUBLE PRECISION DAANC6(3,6,*)
1510 TYPE(H3D_DATABASE) :: H3D_DATA
1511C-----------------------------------------------
1512C L o c a l V a r i a b l e s
1513C-----------------------------------------------
1514 INTEGER I, J, II, N, N1, N2, N1G, N2G, K0, K1S, NBINTER, INC,ISIGN
1515 DOUBLE PRECISION DAANC6L(3,6)
1516C-----------------------------------------------
1517C S o u r c e L i n e s
1518C-----------------------------------------------
1519C
1520 IF(kdtint==0)THEN
1521 DO i = 1, nb
1522 n = nint(bufr(1,i))
1523 n1 = ixlins(1,n)
1524 n2 = ixlins(2,n)
1525 n1g = nlg(n1)
1526 n2g = nlg(n2)
1527 a(1,n1g) = a(1,n1g) + bufr(2,i)
1528 a(2,n1g) = a(2,n1g) + bufr(3,i)
1529 a(3,n1g) = a(3,n1g) + bufr(4,i)
1530 stifn(n1g) = stifn(n1g) + bufr(5,i)
1531C
1532 a(1,n2g) = a(1,n2g) + bufr(6,i)
1533 a(2,n2g) = a(2,n2g) + bufr(7,i)
1534 a(3,n2g) = a(3,n2g) + bufr(8,i)
1535 stifn(n2g) = stifn(n2g) + bufr(9,i)
1536C Traitement interface type20
1537 isign = 1
1538 IF(alphak(2,n1) < zero .or. bufr(10,i) < zero)isign = -1
1539 alphak(2,n1) = isign*min(abs(alphak(2,n1)),abs(bufr(10,i)))
1540 isign = 1
1541 IF(alphak(2,n2) < zero .or. bufr(11,i) < zero)isign = -1
1542 alphak(2,n2) = isign*min(abs(alphak(2,n2)),abs(bufr(11,i)))
1543 CALL getdpdaanc(daanc6l,bufr(12,i),iresp,inc)
1544 daanc6(1,1,n1) = daanc6(1,1,n1)+daanc6l(1,1)
1545 daanc6(1,2,n1) = daanc6(1,2,n1)+daanc6l(1,2)
1546 daanc6(1,3,n1) = daanc6(1,3,n1)+daanc6l(1,3)
1547 daanc6(1,4,n1) = daanc6(1,4,n1)+daanc6l(1,4)
1548 daanc6(1,5,n1) = daanc6(1,5,n1)+daanc6l(1,5)
1549 daanc6(1,6,n1) = daanc6(1,6,n1)+daanc6l(1,6)
1550 daanc6(2,1,n1) = daanc6(2,1,n1)+daanc6l(2,1)
1551 daanc6(2,2,n1) = daanc6(2,2,n1)+daanc6l(2,2)
1552 daanc6(2,3,n1) = daanc6(2,3,n1)+daanc6l(2,3)
1553 daanc6(2,4,n1) = daanc6(2,4,n1)+daanc6l(2,4)
1554 daanc6(2,5,n1) = daanc6(2,5,n1)+daanc6l(2,5)
1555 daanc6(2,6,n1) = daanc6(2,6,n1)+daanc6l(2,6)
1556 daanc6(3,1,n1) = daanc6(3,1,n1)+daanc6l(3,1)
1557 daanc6(3,2,n1) = daanc6(3,2,n1)+daanc6l(3,2)
1558 daanc6(3,3,n1) = daanc6(3,3,n1)+daanc6l(3,3)
1559 daanc6(3,4,n1) = daanc6(3,4,n1)+daanc6l(3,4)
1560 daanc6(3,5,n1) = daanc6(3,5,n1)+daanc6l(3,5)
1561 daanc6(3,6,n1) = daanc6(3,6,n1)+daanc6l(3,6)
1562 CALL getdpdaanc(daanc6l,bufr(12+inc,i),iresp,inc)
1563 daanc6(1,1,n2) = daanc6(1,1,n2)+daanc6l(1,1)
1564 daanc6(1,2,n2) = daanc6(1,2,n2)+daanc6l(1,2)
1565 daanc6(1,3,n2) = daanc6(1,3,n2)+daanc6l(1,3)
1566 daanc6(1,4,n2) = daanc6(1,4,n2)+daanc6l(1,4)
1567 daanc6(1,5,n2) = daanc6(1,5,n2)+daanc6l(1,5)
1568 daanc6(1,6,n2) = daanc6(1,6,n2)+daanc6l(1,6)
1569 daanc6(2,1,n2) = daanc6(2,1,n2)+daanc6l(2,1)
1570 daanc6(2,2,n2) = daanc6(2,2,n2)+daanc6l(2,2)
1571 daanc6(2,3,n2) = daanc6(2,3,n2)+daanc6l(2,3)
1572 daanc6(2,4,n2) = daanc6(2,4,n2)+daanc6l(2,4)
1573 daanc6(2,5,n2) = daanc6(2,5,n2)+daanc6l(2,5)
1574 daanc6(2,6,n2) = daanc6(2,6,n2)+daanc6l(2,6)
1575 daanc6(3,1,n2) = daanc6(3,1,n2)+daanc6l(3,1)
1576 daanc6(3,2,n2) = daanc6(3,2,n2)+daanc6l(3,2)
1577 daanc6(3,3,n2) = daanc6(3,3,n2)+daanc6l(3,3)
1578 daanc6(3,4,n2) = daanc6(3,4,n2)+daanc6l(3,4)
1579 daanc6(3,5,n2) = daanc6(3,5,n2)+daanc6l(3,5)
1580 daanc6(3,6,n2) = daanc6(3,6,n2)+daanc6l(3,6)
1581 ENDDO
1582 ELSE
1583 DO i = 1, nb
1584 n = nint(bufr(1,i))
1585 n1 = ixlins(1,n)
1586 n2 = ixlins(2,n)
1587 n1g = nlg(n1)
1588 n2g = nlg(n2)
1589 a(1,n1g) = a(1,n1g) + bufr(2,i)
1590 a(2,n1g) = a(2,n1g) + bufr(3,i)
1591 a(3,n1g) = a(3,n1g) + bufr(4,i)
1592 stifn(n1g) = stifn(n1g) + bufr(5,i)
1593 viscn(n1g) = viscn(n1g) + bufr(6,i)
1594C
1595 a(1,n2g) = a(1,n2g) + bufr(7,i)
1596 a(2,n2g) = a(2,n2g) + bufr(8,i)
1597 a(3,n2g) = a(3,n2g) + bufr(9,i)
1598 stifn(n2g) = stifn(n2g) + bufr(10,i)
1599 viscn(n2g) = viscn(n2g) + bufr(11,i)
1600C Traitement interface type20
1601 isign = 1
1602 IF(alphak(2,n1) < zero .or. bufr(12,i) < zero)isign = -1
1603 alphak(2,n1) = isign*min(abs(alphak(2,n1)),abs(bufr(12,i)))
1604 isign = 1
1605 IF(alphak(2,n2) < zero .or. bufr(13,i) < zero)isign = -1
1606 alphak(2,n2) = isign*min(abs(alphak(2,n2)),abs(bufr(13,i)))
1607 CALL getdpdaanc(daanc6l,bufr(14,i),iresp,inc)
1608 daanc6(1,1,n1) = daanc6(1,1,n1)+daanc6l(1,1)
1609 daanc6(1,2,n1) = daanc6(1,2,n1)+daanc6l(1,2)
1610 daanc6(1,3,n1) = daanc6(1,3,n1)+daanc6l(1,3)
1611 daanc6(1,4,n1) = daanc6(1,4,n1)+daanc6l(1,4)
1612 daanc6(1,5,n1) = daanc6(1,5,n1)+daanc6l(1,5)
1613 daanc6(1,6,n1) = daanc6(1,6,n1)+daanc6l(1,6)
1614 daanc6(2,1,n1) = daanc6(2,1,n1)+daanc6l(2,1)
1615 daanc6(2,2,n1) = daanc6(2,2,n1)+daanc6l(2,2)
1616 daanc6(2,3,n1) = daanc6(2,3,n1)+daanc6l(2,3)
1617 daanc6(2,4,n1) = daanc6(2,4,n1)+daanc6l(2,4)
1618 daanc6(2,5,n1) = daanc6(2,5,n1)+daanc6l(2,5)
1619 daanc6(2,6,n1) = daanc6(2,6,n1)+daanc6l(2,6)
1620 daanc6(3,1,n1) = daanc6(3,1,n1)+daanc6l(3,1)
1621 daanc6(3,2,n1) = daanc6(3,2,n1)+daanc6l(3,2)
1622 daanc6(3,3,n1) = daanc6(3,3,n1)+daanc6l(3,3)
1623 daanc6(3,4,n1) = daanc6(3,4,n1)+daanc6l(3,4)
1624 daanc6(3,5,n1) = daanc6(3,5,n1)+daanc6l(3,5)
1625 daanc6(3,6,n1) = daanc6(3,6,n1)+daanc6l(3,6)
1626 CALL getdpdaanc(daanc6l,bufr(14+inc,i),iresp,inc)
1627 daanc6(1,1,n2) = daanc6(1,1,n2)+daanc6l(1,1)
1628 daanc6(1,2,n2) = daanc6(1,2,n2)+daanc6l(1,2)
1629 daanc6(1,3,n2) = daanc6(1,3,n2)+daanc6l(1,3)
1630 daanc6(1,4,n2) = daanc6(1,4,n2)+daanc6l(1,4)
1631 daanc6(1,5,n2) = daanc6(1,5,n2)+daanc6l(1,5)
1632 daanc6(1,6,n2) = daanc6(1,6,n2)+daanc6l(1,6)
1633 daanc6(2,1,n2) = daanc6(2,1,n2)+daanc6l(2,1)
1634 daanc6(2,2,n2) = daanc6(2,2,n2)+daanc6l(2,2)
1635 daanc6(2,3,n2) = daanc6(2,3,n2)+daanc6l(2,3)
1636 daanc6(2,4,n2) = daanc6(2,4,n2)+daanc6l(2,4)
1637 daanc6(2,5,n2) = daanc6(2,5,n2)+daanc6l(2,5)
1638 daanc6(2,6,n2) = daanc6(2,6,n2)+daanc6l(2,6)
1639 daanc6(3,1,n2) = daanc6(3,1,n2)+daanc6l(3,1)
1640 daanc6(3,2,n2) = daanc6(3,2,n2)+daanc6l(3,2)
1641 daanc6(3,3,n2) = daanc6(3,3,n2)+daanc6l(3,3)
1642 daanc6(3,4,n2) = daanc6(3,4,n2)+daanc6l(3,4)
1643 daanc6(3,5,n2) = daanc6(3,5,n2)+daanc6l(3,5)
1644 daanc6(3,6,n2) = daanc6(3,6,n2)+daanc6l(3,6)
1645 ENDDO
1646 ENDIF
1647C
1648C
1649C continue i7for3 and i10for3 processing on secondary node
1650C
1651 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
1652 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
1653 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
1654 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
1655C Anim FCONT
1656 DO i = 1, nb
1657 n = nint(bufr(1,i))
1658 n1 = ixlins(1,n)
1659 n2 = ixlins(2,n)
1660 n1g = nlg(n1)
1661 n2g = nlg(n2)
1662C
1663 fcont(1,n1g)=fcont(1,n1g)+bufr(2,i)
1664 fcont(2,n1g)=fcont(2,n1g)+bufr(3,i)
1665 fcont(3,n1g)=fcont(3,n1g)+bufr(4,i)
1666C
1667 fcont(1,n2g)=fcont(1,n2g)+bufr(5,i)
1668 fcont(2,n2g)=fcont(2,n2g)+bufr(6,i)
1669 fcont(3,n2g)=fcont(3,n2g)+bufr(7,i)
1670 END DO
1671 END IF
1672C
1673 IF(isecin>0)THEN
1674C Sections
1675 k0=nstrf(25)
1676 IF(nstrf(1)+nstrf(2)/=0)THEN
1677 DO i=1,nsect
1678 nbinter=nstrf(k0+14)
1679 k1s=k0+30
1680 DO j=1,nbinter
1681 IF(nstrf(k1s)==noint)THEN
1682 IF(isecut/=0)THEN
1683 IF(kdtint==0)THEN
1684 DO ii = 1, nb
1685 n = nint(bufr(1,ii))
1686 n1 = ixlins(1,n)
1687 n2 = ixlins(2,n)
1688 n1g = nlg(n1)
1689 n2g = nlg(n2)
1690 IF(secfcum(4,n1g,i)==1.)THEN
1691 secfcum(1,n1g,i)=secfcum(1,n1g,i)+bufr(2,ii)
1692 secfcum(2,n1g,i)=secfcum(2,n1g,i)+bufr(3,ii)
1693 secfcum(3,n1g,i)=secfcum(3,n1g,i)+bufr(4,ii)
1694 ENDIF
1695 IF(secfcum(4,n2g,i)==1.)THEN
1696 secfcum(1,n2g,i)=secfcum(1,n2g,i)+bufr(6,ii)
1697 secfcum(2,n2g,i)=secfcum(2,n2g,i)+bufr(7,ii)
1698 secfcum(3,n2g,i)=secfcum(3,n2g,i)+bufr(8,ii)
1699 ENDIF
1700 ENDDO
1701 ELSE
1702 DO ii = 1, nb
1703 n = nint(bufr(1,ii))
1704 n1 = ixlins(1,n)
1705 n2 = ixlins(2,n)
1706 n1g = nlg(n1)
1707 n2g = nlg(n2)
1708 IF(secfcum(4,n1g,i)==1.)THEN
1709 secfcum(1,n1g,i)=secfcum(1,n1g,i)+bufr(2,ii)
1710 secfcum(2,n1g,i)=secfcum(2,n1g,i)+bufr(3,ii)
1711 secfcum(3,n1g,i)=secfcum(3,n1g,i)+bufr(4,ii)
1712 ENDIF
1713 IF(secfcum(4,n2g,i)==1.)THEN
1714 secfcum(1,n2g,i)=secfcum(1,n2g,i)+bufr(7,ii)
1715 secfcum(2,n2g,i)=secfcum(2,n2g,i)+bufr(8,ii)
1716 secfcum(3,n2g,i)=secfcum(3,n2g,i)+bufr(9,ii)
1717 ENDIF
1718 ENDDO
1719 END IF
1720 ENDIF
1721 ENDIF
1722 k1s=k1s+1
1723 ENDDO
1724 k0=nstrf(k0+24)
1725 ENDDO
1726 ENDIF
1727 ENDIF
1728C
1729 IF(ibag/=0)THEN
1730C Airbags IBAG
1731 IF(kdtint==0)THEN
1732 DO i = 1, nb
1733 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
1734 + bufr(4,i)/=zero) THEN
1735 n = nint(bufr(1,i))
1736 n1 = ixlins(1,n)
1737 n1g = nlg(n1)
1738 icontact(n1g)=1
1739 END IF
1740 IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
1741 + bufr(8,i)/=zero) THEN
1742 n = nint(bufr(1,i))
1743 n2 = ixlins(2,n)
1744 n2g = nlg(n2)
1745 icontact(n2g)=1
1746 END IF
1747 END DO
1748 ELSE
1749 DO i = 1, nb
1750 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
1751 + bufr(4,i)/=zero) THEN
1752 n = nint(bufr(1,i))
1753 n1 = ixlins(1,n)
1754 n1g = nlg(n1)
1755 icontact(n1g)=1
1756 END IF
1757 IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
1758 + bufr(9,i)/=zero) THEN
1759 n = nint(bufr(1,i))
1760 n2 = ixlins(2,n)
1761 n2g = nlg(n2)
1762 icontact(n2g)=1
1763 END IF
1764 END DO
1765 END IF
1766 END IF
1767C
1768 RETURN

◆ spmd_fiadd20f_pon()

subroutine spmd_fiadd20f_pon ( 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 1998 of file spmd_i7tool.F.

2004C-----------------------------------------------
2005C M o d u l e s
2006C-----------------------------------------------
2007 USE message_mod
2008 USE h3d_mod
2009 USE anim_mod
2010C-----------------------------------------------
2011C I m p l i c i t T y p e s
2012C-----------------------------------------------
2013#include "implicit_f.inc"
2014C-----------------------------------------------
2015C C o m m o n B l o c k s
2016C-----------------------------------------------
2017#include "parit_c.inc"
2018#include "scr07_c.inc"
2019#include "scr14_c.inc"
2020#include "scr16_c.inc"
2021#include "scr18_c.inc"
2022#include "com01_c.inc"
2023#include "com04_c.inc"
2024#include "com06_c.inc"
2025#include "com08_c.inc"
2026C-----------------------------------------------
2027C D u m m y A r g u m e n t s
2028C-----------------------------------------------
2029 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT, INACTI,
2030 . NSV(*), ISKY(*), ICODT(*), NSTRF(*), NLG(*),
2031 . ICONTACT(*), IADM,INTTH
2032 my_real
2033 . bufr(len,*),
2034 . fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
2035 . fcont(3,*),ftheskyi(lskyi)
2036 TYPE(H3D_DATABASE) :: H3D_DATA
2037C-----------------------------------------------
2038C L o c a l V a r i a b l e s
2039C-----------------------------------------------
2040 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER
2041C-----------------------------------------------
2042C S o u r c e L i n e s
2043C-----------------------------------------------
2044 IF ((nisky+nb)> lskyi)THEN
2045 CALL ancmsg(msgid=26,anmode=aninfo)
2046 CALL arret(2)
2047 ENDIF
2048C
2049 IF(intth == 0 ) THEN
2050 IF(kdtint==0)THEN
2051 DO i = 1, nb
2052 n = nint(bufr(1,i))
2053 nod = nlg(nsv(n))
2054 nisky = nisky + 1
2055 fskyi(nisky,1)=bufr(2,i)
2056 fskyi(nisky,2)=bufr(3,i)
2057 fskyi(nisky,3)=bufr(4,i)
2058 fskyi(nisky,4)=bufr(5,i)
2059 isky(nisky) = nod
2060 ENDDO
2061 ELSE
2062 DO i = 1, nb
2063 n = nint(bufr(1,i))
2064 nod = nlg(nsv(n))
2065 nisky = nisky + 1
2066 fskyi(nisky,1)=bufr(2,i)
2067 fskyi(nisky,2)=bufr(3,i)
2068 fskyi(nisky,3)=bufr(4,i)
2069 fskyi(nisky,4)=bufr(5,i)
2070 fskyi(nisky,5)=bufr(6,i)
2071 isky(nisky) = nod
2072 ENDDO
2073 ENDIF
2074C
2075C --- interface type 7 + thermal
2076C
2077 ELSE
2078 IF(kdtint==0)THEN
2079 DO i = 1, nb
2080 n = nint(bufr(1,i))
2081 nod = nlg(nsv(n))
2082 nisky = nisky + 1
2083 fskyi(nisky,1)=bufr(2,i)
2084 fskyi(nisky,2)=bufr(3,i)
2085 fskyi(nisky,3)=bufr(4,i)
2086 fskyi(nisky,4)=bufr(5,i)
2087 ftheskyi(nisky) =bufr(6,i)
2088 isky(nisky) = nod
2089 ENDDO
2090 ELSE
2091 DO i = 1, nb
2092 n = nint(bufr(1,i))
2093 nod = nlg(nsv(n))
2094 nisky = nisky + 1
2095 fskyi(nisky,1)=bufr(2,i)
2096 fskyi(nisky,2)=bufr(3,i)
2097 fskyi(nisky,3)=bufr(4,i)
2098 fskyi(nisky,4)=bufr(5,i)
2099 fskyi(nisky,5)=bufr(6,i)
2100 ftheskyi(nisky) =bufr(7,i)
2101 isky(nisky) = nod
2102 ENDDO
2103 ENDIF
2104 ENDIF
2105C
2106C continue i7for3 and i10for3 processing on secondary node
2107C
2108 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
2109 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
2110 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
2111 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
2112C Anim FCONT
2113 DO i = 1, nb
2114 n = nint(bufr(1,i))
2115 nod = nlg(nsv(n))
2116 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
2117 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
2118 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
2119 END DO
2120 END IF
2121C
2122 IF(isecin>0)THEN
2123C Sections
2124 k0=nstrf(25)
2125 IF(nstrf(1)+nstrf(2)/=0)THEN
2126 DO i=1,nsect
2127 nbinter=nstrf(k0+14)
2128 k1s=k0+30
2129 DO j=1,nbinter
2130 IF(nstrf(k1s)==noint)THEN
2131 IF(isecut/=0)THEN
2132 DO ii = 1, nb
2133 n = nint(bufr(1,ii))
2134 nod = nlg(nsv(n))
2135 IF(secfcum(4,nod,i)==1.)THEN
2136 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2137 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2138 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2139 ENDIF
2140 ENDDO
2141 ENDIF
2142 ENDIF
2143 k1s=k1s+1
2144 ENDDO
2145 k0=nstrf(k0+24)
2146 ENDDO
2147 ENDIF
2148 ENDIF
2149C
2150 IF((ibag/=0.AND.inacti/=7).OR.
2151 . iadm/=0)THEN ! warning conflict inacti=7 and ibag=3
2152C Airbags IBAG
2153 DO i = 1, nb
2154 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2155 + bufr(4,i)/=zero) THEN
2156 n = nint(bufr(1,i))
2157 nod = nlg(nsv(n))
2158 icontact(nod)=1
2159 END IF
2160 END DO
2161 END IF
2162C
2163 IF(ibc/=0) THEN
2164 ibcm = ibc / 8
2165 ibcs = ibc - 8 * ibcm
2166C Boundary cond.
2167 IF(ibcs>0) THEN
2168 DO i = 1, nb
2169 n = nint(bufr(1,i))
2170 nod = nlg(nsv(n))
2171 CALL ibcoff(ibcs,icodt(nod))
2172 END DO
2173 END IF
2174 END IF
2175C
2176 RETURN

◆ spmd_fiadd20fe_pon()

subroutine spmd_fiadd20fe_pon ( 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 2531 of file spmd_i7tool.F.

2536C-----------------------------------------------
2537C M o d u l e s
2538C-----------------------------------------------
2539 USE message_mod
2540 USE h3d_mod
2541 USE anim_mod
2542C-----------------------------------------------
2543C I m p l i c i t T y p e s
2544C-----------------------------------------------
2545#include "implicit_f.inc"
2546C-----------------------------------------------
2547C C o m m o n B l o c k s
2548C-----------------------------------------------
2549#include "parit_c.inc"
2550#include "scr07_c.inc"
2551#include "scr14_c.inc"
2552#include "scr16_c.inc"
2553#include "scr18_c.inc"
2554#include "com01_c.inc"
2555#include "com04_c.inc"
2556#include "com06_c.inc"
2557#include "com08_c.inc"
2558C-----------------------------------------------
2559C D u m m y A r g u m e n t s
2560C-----------------------------------------------
2561 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT,
2562 . IRECTS(2,*), ISKY(*), ICODT(*), NSTRF(*),
2563 . ICONTACT(*),NLG(*)
2564 my_real
2565 . bufr(len,*),
2566 . fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
2567 . fcont(3,*)
2568 TYPE(H3D_DATABASE) :: H3D_DATA
2569C-----------------------------------------------
2570C L o c a l V a r i a b l e s
2571C-----------------------------------------------
2572 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER
2573C-----------------------------------------------
2574C S o u r c e L i n e s
2575C-----------------------------------------------
2576 IF ((nisky+nb)> lskyi)THEN
2577 CALL ancmsg(msgid=26,anmode=aninfo)
2578 CALL arret(2)
2579 ENDIF
2580
2581 IF(kdtint==0)THEN
2582 DO i = 1, nb
2583 n = nint(bufr(1,i))
2584 nod = nlg(irects(1,n))
2585 nisky = nisky + 1
2586 fskyi(nisky,1)=bufr(2,i)
2587 fskyi(nisky,2)=bufr(3,i)
2588 fskyi(nisky,3)=bufr(4,i)
2589 fskyi(nisky,4)=bufr(5,i)
2590 isky(nisky) = nod
2591 nod = nlg(irects(2,n))
2592 nisky = nisky + 1
2593 fskyi(nisky,1)=bufr(6,i)
2594 fskyi(nisky,2)=bufr(7,i)
2595 fskyi(nisky,3)=bufr(8,i)
2596 fskyi(nisky,4)=bufr(9,i)
2597 isky(nisky) = nod
2598 ENDDO
2599 ELSE
2600 DO i = 1, nb
2601 n = nint(bufr(1,i))
2602 nod = nlg(irects(1,n))
2603 nisky = nisky + 1
2604 fskyi(nisky,1)=bufr(2,i)
2605 fskyi(nisky,2)=bufr(3,i)
2606 fskyi(nisky,3)=bufr(4,i)
2607 fskyi(nisky,4)=bufr(5,i)
2608 fskyi(nisky,5)=bufr(6,i)
2609 isky(nisky) = nod
2610 nod = nlg(irects(2,n))
2611 nisky = nisky + 1
2612 fskyi(nisky,1)=bufr(7,i)
2613 fskyi(nisky,2)=bufr(8,i)
2614 fskyi(nisky,3)=bufr(9,i)
2615 fskyi(nisky,4)=bufr(10,i)
2616 fskyi(nisky,5)=bufr(11,i)
2617 isky(nisky) = nod
2618 ENDDO
2619 ENDIF
2620C
2621C continue i11for3 processing on secondary node
2622C
2623 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
2624 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
2625 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
2626 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
2627C Anim FCONT
2628 IF(kdtint==0)THEN
2629 DO i = 1, nb
2630 n = nint(bufr(1,i))
2631 nod = nlg(irects(1,n))
2632 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
2633 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
2634 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
2635 nod = nlg(irects(2,n))
2636 fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
2637 fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
2638 fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
2639 END DO
2640 ELSE
2641 DO i = 1, nb
2642 n = nint(bufr(1,i))
2643 nod = nlg(irects(1,n))
2644 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
2645 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
2646 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
2647 nod = nlg(irects(2,n))
2648 fcont(1,nod)=fcont(1,nod)+ bufr(7,i)
2649 fcont(2,nod)=fcont(2,nod)+ bufr(8,i)
2650 fcont(3,nod)=fcont(3,nod)+ bufr(9,i)
2651 END DO
2652 END IF
2653 END IF
2654C
2655 IF(isecin>0)THEN
2656C Sections
2657 k0=nstrf(25)
2658 IF(nstrf(1)+nstrf(2)/=0)THEN
2659 DO i=1,nsect
2660 nbinter=nstrf(k0+14)
2661 k1s=k0+30
2662 DO j=1,nbinter
2663 IF(nstrf(k1s)==noint)THEN
2664 IF(isecut/=0)THEN
2665 IF(kdtint==0)THEN
2666 DO ii = 1, nb
2667 n = nint(bufr(1,ii))
2668 nod = nlg(irects(1,n))
2669 IF(secfcum(4,nod,i)==1.)THEN
2670 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2671 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2672 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2673 ENDIF
2674 nod = nlg(irects(2,n))
2675 IF(secfcum(4,nod,i)==1.)THEN
2676 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(6,ii)
2677 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(7,ii)
2678 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(8,ii)
2679 ENDIF
2680 ENDDO
2681 ELSE
2682 DO ii = 1, nb
2683 n = nint(bufr(1,ii))
2684 nod = nlg(irects(1,n))
2685 IF(secfcum(4,nod,i)==1.)THEN
2686 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2687 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2688 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2689 ENDIF
2690 nod = nlg(irects(2,n))
2691 IF(secfcum(4,nod,i)==1.)THEN
2692 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
2693 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
2694 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
2695 ENDIF
2696 ENDDO
2697 END IF
2698 ENDIF
2699 ENDIF
2700 k1s=k1s+1
2701 ENDDO
2702 k0=nstrf(k0+24)
2703 ENDDO
2704 ENDIF
2705 ENDIF
2706C
2707 IF(ibag/=0)THEN
2708C Airbags IBAG
2709 IF(kdtint==0)THEN
2710 DO i = 1, nb
2711 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2712 + bufr(4,i)/=zero) THEN
2713 n = nint(bufr(1,i))
2714 nod = nlg(irects(1,n))
2715 icontact(nod)=1
2716 END IF
2717 IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
2718 + bufr(8,i)/=zero) THEN
2719 nod = nlg(irects(2,n))
2720 icontact(nod)=1
2721 END IF
2722 END DO
2723 ELSE
2724 DO i = 1, nb
2725 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2726 + bufr(4,i)/=zero) THEN
2727 n = nint(bufr(1,i))
2728 nod = nlg(irects(1,n))
2729 icontact(nod)=1
2730 END IF
2731 IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
2732 + bufr(9,i)/=zero) THEN
2733 nod = nlg(irects(2,n))
2734 icontact(nod)=1
2735 END IF
2736 END DO
2737 END IF
2738 END IF
2739C
2740 RETURN

◆ spmd_fiadd_poff()

subroutine spmd_fiadd_poff ( 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.

484C-----------------------------------------------
485C M o d u l e s
486C-----------------------------------------------
487 USE h3d_mod
488 USE multi_fvm_mod
489 USE anim_mod
490 USE parameters_mod
491C-----------------------------------------------
492C I m p l i c i t T y p e s
493C-----------------------------------------------
494#include "implicit_f.inc"
495C-----------------------------------------------
496C C o m m o n B l o c k s
497C-----------------------------------------------
498#include "scr07_c.inc"
499#include "scr14_c.inc"
500#include "scr16_c.inc"
501#include "scr18_c.inc"
502#include "com01_c.inc"
503#include "com04_c.inc"
504#include "com06_c.inc"
505#include "com08_c.inc"
506#include "impl1_c.inc"
507C-----------------------------------------------
508C D u m m y A r g u m e n t s
509C-----------------------------------------------
510 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT, INACTI,
511 . NSV(*), ICODT(*), NSTRF(*),ICONTACT(*),
512 . TAGNCONT(NLOADP_HYD_INTER,*),KLOADPINTER(*),LOADPINTER(*),
513 . LOADP_HYD_INTER(*),
514 . IADM,INTTH
515 INTEGER, INTENT(in) :: NIN, INTCAREA
516 INTEGER, INTENT(IN) :: NODADT_THERM
517 my_real
518 . bufr(len,*), a(3,*), stifn(*), viscn(*),
519 . secfcum(7,numnod,nsect),
520 . fcont(3,*),fthe(*),condn(*)
521 my_real, INTENT(INOUT) :: fsav(*)
522 TYPE(H3D_DATABASE) :: H3D_DATA
523 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
524 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
525C-----------------------------------------------
526C L o c a l V a r i a b l e s
527C-----------------------------------------------
528 my_real :: mass, fsav29
529 INTEGER :: IBRIC
530 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL,NP
531C-----------------------------------------------
532C S o u r c e L i n e s
533C-----------------------------------------------
534C
535 IF (multi_fvm%INT18_GLOBAL_LIST(nin)) THEN
536 DO i = 1, nb
537 n = nint(bufr(1, i))
538 ibric = nsv(n)
539 multi_fvm%FORCE_INT(1, ibric) = multi_fvm%FORCE_INT(1, ibric) + bufr(2,i)
540 multi_fvm%FORCE_INT(2, ibric) = multi_fvm%FORCE_INT(2, ibric) + bufr(3,i)
541 multi_fvm%FORCE_INT(3, ibric) = multi_fvm%FORCE_INT(3, ibric) + bufr(4,i)
542 ENDDO
543 ELSE
544 IF(intth == 0 ) THEN
545 DO i = 1, nb
546 n = nint(bufr(1,i))
547 nod = nsv(n)
548 a(1,nod) = a(1,nod) + bufr(2,i)
549 a(2,nod) = a(2,nod) + bufr(3,i)
550 a(3,nod) = a(3,nod) + bufr(4,i)
551 stifn(nod) = stifn(nod) + bufr(5,i)
552 IF(kdtint /= 0) viscn(nod) = viscn(nod) + bufr(6,i)
553 ENDDO
554 ELSE
555 IF(kdtint==0)THEN
556 DO i = 1, nb
557 n = nint(bufr(1,i))
558 nod = nsv(n)
559 a(1,nod) = a(1,nod) + bufr(2,i)
560 a(2,nod) = a(2,nod) + bufr(3,i)
561 a(3,nod) = a(3,nod) + bufr(4,i)
562 stifn(nod) = stifn(nod) + bufr(5,i)
563 fthe(nod) = fthe(nod) + bufr(6,i)
564 IF(nodadt_therm == 1) condn(nod) = condn(nod) + bufr(7,i)
565 ENDDO
566 ELSE
567 DO i = 1, nb
568 n = nint(bufr(1,i))
569 nod = nsv(n)
570 a(1,nod) = a(1,nod) + bufr(2,i)
571 a(2,nod) = a(2,nod) + bufr(3,i)
572 a(3,nod) = a(3,nod) + bufr(4,i)
573 stifn(nod) = stifn(nod) + bufr(5,i)
574 viscn(nod) = viscn(nod) + bufr(6,i)
575 fthe(nod) = fthe(nod) + bufr(7,i)
576 IF(nodadt_therm == 1) condn(nod) = condn(nod) + bufr(8,i)
577 ENDDO
578 ENDIF
579 ENDIF
580C
581C following i7for3 & i10for3 process on secondary nodes
582C
583 IF (inconv == 1) THEN
584 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
585 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
586 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
587 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
588C Anim FCONT
589 DO i = 1, nb
590 n = nint(bufr(1,i))
591 nod = nsv(n)
592 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
593 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
594 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
595 END DO
596 END IF
597 END IF
598C------------For /LOAD/PRESSURE tag nodes in contact-------------
599 IF(nintloadp > 0) THEN
600 DO i = 1, nb
601 n = nint(bufr(1,i))
602 nod = nsv(n)
603 DO np = kloadpinter(nin)+1, kloadpinter(nin+1)
604 pp = loadpinter(np)
605 ppl = loadp_hyd_inter(pp)
606 tagncont(ppl,nod) = 1
607 ENDDO
608 ENDDO
609 ENDIF
610C
611 IF(isecin>0)THEN
612C Sections
613 k0=nstrf(25)
614 IF(nstrf(1)+nstrf(2)/=0)THEN
615 DO i=1,nsect
616 nbinter=nstrf(k0+14)
617 k1s=k0+30
618 DO j=1,nbinter
619 IF(nstrf(k1s)==noint)THEN
620 IF(isecut/=0)THEN
621 DO ii = 1, nb
622 n = nint(bufr(1,ii))
623 nod = nsv(n)
624 IF(secfcum(4,nod,i)==1.)THEN
625 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
626 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
627 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
628 ENDIF
629 ENDDO
630 ENDIF
631 ENDIF
632 k1s=k1s+1
633 ENDDO
634 k0=nstrf(k0+24)
635 ENDDO
636 ENDIF
637 ENDIF
638C
639 IF((ibag/=0.AND.inacti/=7).OR.
640 . (iadm/=0).OR.(idamp_rdof/=0)) THEN ! warning conflict inacti=7 and ibag=3
641C Airbags IBAG
642 DO i = 1, nb
643 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
644 + bufr(4,i)/=zero) THEN
645 n = nint(bufr(1,i))
646 nod = nsv(n)
647 icontact(nod)=1
648 END IF
649 END DO
650 END IF
651C
652 IF(ibc/=0) THEN
653 ibcm = ibc / 8
654 ibcs = ibc - 8 * ibcm
655C Boundary cond.
656 IF(ibcs>0) THEN
657 DO i = 1, nb
658 n = nint(bufr(1,i))
659 nod = nsv(n)
660 CALL ibcoff(ibcs,icodt(nod))
661 END DO
662 END IF
663 END IF
664 ENDIF
665C
666 RETURN
parameters_mod
Definition parameters_mod.F:49

◆ spmd_fiadd_pon()

subroutine spmd_fiadd_pon ( 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 1786 of file spmd_i7tool.F.

1793C-----------------------------------------------
1794C M o d u l e s
1795C-----------------------------------------------
1796 USE message_mod
1797 USE h3d_mod
1798 USE anim_mod
1799 USE parameters_mod
1800C-----------------------------------------------
1801C I m p l i c i t T y p e s
1802C-----------------------------------------------
1803#include "implicit_f.inc"
1804C-----------------------------------------------
1805C C o m m o n B l o c k s
1806C-----------------------------------------------
1807#include "parit_c.inc"
1808#include "scr07_c.inc"
1809#include "scr14_c.inc"
1810#include "scr16_c.inc"
1811#include "scr18_c.inc"
1812#include "com01_c.inc"
1813#include "com04_c.inc"
1814#include "com06_c.inc"
1815#include "com08_c.inc"
1816C-----------------------------------------------
1817C D u m m y A r g u m e n t s
1818C-----------------------------------------------
1819 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT, INACTI,NIN,
1820 . NSV(*), ISKY(*), ICODT(*), NSTRF(*),ICONTACT(*),
1821 . TAGNCONT(NLOADP_HYD_INTER,*),KLOADPINTER(*),LOADPINTER(*),
1822 . LOADP_HYD_INTER(*),
1823 . IADM,INTTH
1824 INTEGER ,INTENT(IN):: INTCAREA
1825 INTEGER, INTENT(IN) :: NODADT_THERM
1826 my_real
1827 . bufr(len,*),
1828 . fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
1829 . fcont(3,*),ftheskyi(lskyi),condnskyi(lskyi)
1830 my_real, INTENT(INOUT) :: fsav(*)
1831 TYPE(H3D_DATABASE) :: H3D_DATA
1832 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
1833C-----------------------------------------------
1834C L o c a l V a r i a b l e s
1835C-----------------------------------------------
1836 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,
1837 . NISKY_SAV,TEMP_SIZ,IERROR,PP,PPL,NP
1838 my_real fsav29
1839C-----------------------------------------------
1840C S o u r c e L i n e s
1841C-----------------------------------------------
1842 IF ((nisky+nb)> lskyi)THEN
1843 CALL ancmsg(msgid=26,anmode=aninfo)
1844 CALL arret(2)
1845 ENDIF
1846C
1847 nisky_sav = nisky
1848 DO i = 1, nb
1849 n = nint(bufr(1,i))
1850 nod = nsv(n)
1851 nisky = nisky + 1
1852 fskyi(nisky,1)=bufr(2,i)
1853 fskyi(nisky,2)=bufr(3,i)
1854 fskyi(nisky,3)=bufr(4,i)
1855 fskyi(nisky,4)=bufr(5,i)
1856 isky(nisky) = nod
1857 ENDDO
1858 temp_siz=6
1859
1860 IF(kdtint /= 0 ) THEN
1861 nisky = nisky_sav
1862 DO i = 1, nb
1863 nisky = nisky + 1
1864 fskyi(nisky,5)=bufr(temp_siz,i)
1865 ENDDO
1866 temp_siz=temp_siz+1
1867 ENDIF
1868
1869 IF(intth /= 0 ) THEN
1870 nisky = nisky_sav
1871 DO i = 1, nb
1872 nisky = nisky + 1
1873 ftheskyi(nisky)=bufr(temp_siz,i)
1874 ENDDO
1875 temp_siz=temp_siz+1
1876
1877 IF(nodadt_therm ==1) THEN
1878 nisky = nisky_sav
1879 DO i = 1, nb
1880 nisky = nisky + 1
1881 condnskyi(nisky)=bufr(temp_siz,i)
1882 ENDDO
1883 temp_siz=temp_siz+1
1884 ENDIF
1885 ENDIF
1886
1887
1888C
1889C continue i7for3 and i10for3 processing on secondary node
1890C
1891 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
1892 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
1893 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
1894 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
1895C Anim FCONT
1896 DO i = 1, nb
1897 n = nint(bufr(1,i))
1898 nod = nsv(n)
1899 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
1900 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
1901 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
1902 END DO
1903 END IF
1904C
1905C------------For /LOAD/PRESSURE tag nodes in contact-------------
1906 IF(nintloadp > 0) THEN
1907 DO i = 1, nb
1908 n = nint(bufr(1,i))
1909 nod = nsv(n)
1910 DO np = kloadpinter(nin)+1, kloadpinter(nin+1)
1911 pp = loadpinter(np)
1912 ppl = loadp_hyd_inter(pp)
1913 tagncont(ppl,nod) = 1
1914 ENDDO
1915 ENDDO
1916 ENDIF
1917C------------For outputting total contact area------------
1918c IF(INTCAREA > 0) THEN
1919c FSAV29 = ZERO
1920c DO I = 1, NB
1921c N = NINT(BUFR(1,I))
1922c NOD = NSV(N)
1923c FSAV29 = FSAV29 + PARAMETERS%INTAREAN(NOD)
1924c ENDDO
1925c FSAV(29) = FSAV(29) + FSAV29
1926c ENDIF
1927C
1928C
1929 IF(isecin>0)THEN
1930C Sections
1931 k0=nstrf(25)
1932 IF(nstrf(1)+nstrf(2)/=0)THEN
1933 DO i=1,nsect
1934 nbinter=nstrf(k0+14)
1935 k1s=k0+30
1936 DO j=1,nbinter
1937 IF(nstrf(k1s)==noint)THEN
1938 IF(isecut/=0)THEN
1939 DO ii = 1, nb
1940 n = nint(bufr(1,ii))
1941 nod = nsv(n)
1942 IF(secfcum(4,nod,i)==1.)THEN
1943 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
1944 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
1945 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
1946 ENDIF
1947 ENDDO
1948 ENDIF
1949 ENDIF
1950 k1s=k1s+1
1951 ENDDO
1952 k0=nstrf(k0+24)
1953 ENDDO
1954 ENDIF
1955 ENDIF
1956C
1957 IF((ibag/=0.AND.inacti/=7).OR.
1958 . (iadm/=0).OR.(idamp_rdof/=0))THEN ! warning conflict inacti=7 and ibag=3
1959C Airbags IBAG
1960 DO i = 1, nb
1961 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
1962 + bufr(4,i)/=zero) THEN
1963 n = nint(bufr(1,i))
1964 nod = nsv(n)
1965 icontact(nod)=1
1966 END IF
1967 END DO
1968 END IF
1969C
1970 IF(ibc/=0) THEN
1971 ibcm = ibc / 8
1972 ibcs = ibc - 8 * ibcm
1973C Boundary cond.
1974 IF(ibcs>0) THEN
1975 DO i = 1, nb
1976 n = nint(bufr(1,i))
1977 nod = nsv(n)
1978 CALL ibcoff(ibcs,icodt(nod))
1979 END DO
1980 END IF
1981 END IF
1982C
1983 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 3397 of file spmd_i7tool.F.

3398C-----------------------------------------------
3399C M o d u l e s
3400C-----------------------------------------------
3401 USE tri7box
3402 USE tri25ebox
3403 USE message_mod
3404 USE intstamp_glob_mod
3405 USE h3d_mod
3406 USE interface_modification_mod
3407 USE parameters_mod
3408C-----------------------------------------------
3409C I m p l i c i t T y p e s
3410C-----------------------------------------------
3411#include "implicit_f.inc"
3412#include "i25edge_c.inc"
3413C-----------------------------------------------
3414C C o m m o n B l o c k s
3415C-----------------------------------------------
3416#include "com01_c.inc"
3417#include "com04_c.inc"
3418#include "scr14_c.inc"
3419#include "scr16_c.inc"
3420#include "scr18_c.inc"
3421#include "task_c.inc"
3422#include "param_c.inc"
3423#include "parit_c.inc"
3424#include "spmd_c.inc"
3425#include "sms_c.inc"
3426C-----------------------------------------------
3427C D u m m y A r g u m e n t s
3428C-----------------------------------------------
3429 INTEGER IPARI(NPARI,*), IFLAG
3430 INTEGER, INTENT(IN) :: IDT_THERM
3431 INTEGER, INTENT(IN) :: INTHEAT
3432 TYPE(H3D_DATABASE) :: H3D_DATA
3433 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
3434C-----------------------------------------------
3435C L o c a l V a r i a b l e s
3436C-----------------------------------------------
3437 INTEGER I, P, NSN, NMN, ITYP, IGAP, IERROR, IERROR1, LENS, LENR,
3438 . LSKYFI, INACTI, NBINTC, LENI, J,INTTH, K, L,IEDGE4 ,INTFRIC ,
3439 . FLAGREMN ,SIZREMNORFI, IVIS2 ,INTNITSCHE,ITIED,IPSTIF
3440 INTEGER :: LENR_EDGE,LENS_EDGE
3441C-----------------------------------------------
3442C S o u r c e L i n e s
3443C-----------------------------------------------
3444 IF(iflag==1) THEN
3445C init Pointeur + lecture partie entiere
3446 IF(ninter/=0) THEN
3447 ierror = 0
3448 ALLOCATE(nsvfi(ninter),stat=ierror1)
3449 ierror = ierror + ierror1
3450 ALLOCATE(nsnfi(ninter),stat=ierror1)
3451 ierror = ierror + ierror1
3452 ALLOCATE(edge_fi(ninter),stat=ierror1)
3453 ierror = ierror + ierror1
3454 ALLOCATE(nsnfi_sav(ninter),stat=ierror1)
3455 ierror = ierror + ierror1
3456 ALLOCATE(nsnsi_sav(ninter),stat=ierror1)
3457 ierror = ierror + ierror1
3458 ALLOCATE(itafi(ninter),stat=ierror1)
3459 ierror = ierror + ierror1
3460 ALLOCATE(pmainfi(ninter),stat=ierror1)
3461 ierror = ierror + ierror1
3462 ALLOCATE(kinfi(ninter),stat=ierror1)
3463 ierror = ierror + ierror1
3464 ALLOCATE(msfi(ninter),stat=ierror1)
3465 ierror = ierror + ierror1
3466 ALLOCATE(stifi(ninter),stat=ierror1)
3467 ierror = ierror + ierror1
3468 ALLOCATE(gapfi(ninter),stat=ierror1)
3469 ierror = ierror + ierror1
3470 ALLOCATE(gap_lfi(ninter),stat=ierror1)
3471 ierror = ierror + ierror1
3472 ALLOCATE(xfi(ninter),stat=ierror1)
3473 ierror = ierror + ierror1
3474 ALLOCATE(vfi(ninter),stat=ierror1)
3475 ierror = ierror + ierror1
3476 ALLOCATE(nsvsi(ninter),stat=ierror1)
3477 ierror = ierror + ierror1
3478 ALLOCATE(nsnsi(ninter),stat=ierror1)
3479 ierror = ierror + ierror1
3480 ALLOCATE(afi(ninter),stat=ierror1)
3481 ierror = ierror + ierror1
3482 ALLOCATE(stnfi(ninter),stat=ierror1)
3483 ierror = ierror + ierror1
3484 ALLOCATE(vscfi(ninter),stat=ierror1)
3485 ierror = ierror + ierror1
3486 ALLOCATE(penfi(ninter),stat=ierror1)
3487 ierror = ierror + ierror1
3488 ALLOCATE(fskyfi(ninter),stat=ierror1)
3489 ierror = ierror + ierror1
3490 ALLOCATE(iskyfi(ninter),stat=ierror1)
3491 ierror = ierror + ierror1
3492C
3493 ALLOCATE(nisubsfi(ninter),stat=ierror1)
3494 ierror = ierror + ierror1
3495 ALLOCATE(lisubsfi(ninter),stat=ierror1)
3496 ierror = ierror + ierror1
3497 ALLOCATE(inflg_subsfi(ninter),stat=ierror1)
3498 ierror = ierror + ierror1
3499 ALLOCATE(addsubsfi(ninter),stat=ierror1)
3500 ierror = ierror + ierror1
3501 IF(parameters%INTCAREA > 0 ) THEN
3502 ALLOCATE(intareanfi(ninter),stat=ierror1)
3503 ierror = ierror + ierror1
3504 ENDIF
3505
3506 ALLOCATE(nisubsfie(ninter),stat=ierror1)
3507 ierror = ierror + ierror1
3508 ALLOCATE(lisubsfie(ninter),stat=ierror1)
3509 ierror = ierror + ierror1
3510 ALLOCATE(inflg_subsfie(ninter),stat=ierror1)
3511 ierror = ierror + ierror1
3512 ALLOCATE(addsubsfie(ninter),stat=ierror1)
3513 ierror = ierror + ierror1
3514
3515C
3516 ALLOCATE(fnconti(ninter),stat=ierror1)
3517 ierror = ierror + ierror1
3518 ALLOCATE(ftconti(ninter),stat=ierror1)
3519 ierror = ierror + ierror1
3520C
3521 ALLOCATE (nlskyfi(ninter),stat=ierror1)
3522 ierror = ierror + ierror1
3523 nlskyfi(1:ninter)=0
3524C Int17
3525 ALLOCATE (eminxfi(ninter),stat=ierror1)
3526 ierror = ierror + ierror1
3527 ALLOCATE (ksfi(ninter),stat=ierror1)
3528 ierror = ierror + ierror1
3529 ALLOCATE (frotsfi(ninter),stat=ierror1)
3530 ierror = ierror + ierror1
3531 ALLOCATE (stnfi17(ninter),stat=ierror1)
3532 ierror = ierror + ierror1
3533 ALLOCATE(xfi17(ninter),stat=ierror1)
3534 ierror = ierror + ierror1
3535 ALLOCATE(vfi17(ninter),stat=ierror1)
3536 ierror = ierror + ierror1
3537 ALLOCATE(afi17(ninter),stat=ierror1)
3538 ierror = ierror + ierror1
3539C Int20
3540 ALLOCATE(nbinflfi(ninter),stat=ierror1)
3541 ierror = ierror + ierror1
3542 ALLOCATE(daanc6fi(ninter),stat=ierror1)
3543 ierror = ierror + ierror1
3544 ALLOCATE(dxancfi(ninter),stat=ierror1)
3545 ierror = ierror + ierror1
3546 ALLOCATE(dvancfi(ninter),stat=ierror1)
3547 ierror = ierror + ierror1
3548 ALLOCATE(penfia(ninter),stat=ierror1)
3549 ierror = ierror + ierror1
3550 ALLOCATE(alphakfi(ninter),stat=ierror1)
3551 ierror = ierror + ierror1
3552 ALLOCATE(daancfi(ninter),stat=ierror1)
3553 ierror = ierror + ierror1
3554 ALLOCATE(diag_smsfi(ninter),stat=ierror1)
3555 ierror = ierror + ierror1
3556C Int20 edge
3557 ALLOCATE(nsvfie(ninter),stat=ierror1)
3558 ierror = ierror + ierror1
3559 ALLOCATE(nsnfie(ninter),stat=ierror1)
3560 ierror = ierror + ierror1
3561 ALLOCATE(itafie(ninter),stat=ierror1)
3562 ierror = ierror + ierror1
3563 ALLOCATE(msfie(ninter),stat=ierror1)
3564 ierror = ierror + ierror1
3565 ALLOCATE(stifie(ninter),stat=ierror1)
3566 ierror = ierror + ierror1
3567 ALLOCATE(gapfie(ninter),stat=ierror1)
3568 ierror = ierror + ierror1
3569 ALLOCATE(xfie(ninter),stat=ierror1)
3570 ierror = ierror + ierror1
3571 ALLOCATE(vfie(ninter),stat=ierror1)
3572 ierror = ierror + ierror1
3573 ALLOCATE(nsvsie(ninter),stat=ierror1)
3574 ierror = ierror + ierror1
3575 ALLOCATE(nsnsie(ninter),stat=ierror1)
3576 ierror = ierror + ierror1
3577 ALLOCATE(afie(ninter),stat=ierror1)
3578 ierror = ierror + ierror1
3579 ALLOCATE(stnfie(ninter),stat=ierror1)
3580 ierror = ierror + ierror1
3581 ALLOCATE(vscfie(ninter),stat=ierror1)
3582 ierror = ierror + ierror1
3583 ALLOCATE(penfie(ninter),stat=ierror1)
3584 ierror = ierror + ierror1
3585 ALLOCATE(fskyfie(ninter),stat=ierror1)
3586 ierror = ierror + ierror1
3587 ALLOCATE(iskyfie(ninter),stat=ierror1)
3588 ierror = ierror + ierror1
3589C
3590 ALLOCATE (nlskyfie(ninter),stat=ierror1)
3591 ierror = ierror + ierror1
3592 nlskyfie(1:ninter)=0
3593C
3594 ALLOCATE(daanc6fie(ninter),stat=ierror1)
3595 ierror = ierror + ierror1
3596 ALLOCATE(dxancfie(ninter),stat=ierror1)
3597 ierror = ierror + ierror1
3598 ALLOCATE(dvancfie(ninter),stat=ierror1)
3599 ierror = ierror + ierror1
3600 ALLOCATE(penfiae(ninter),stat=ierror1)
3601 ierror = ierror + ierror1
3602 ALLOCATE(alphakfie(ninter),stat=ierror1)
3603 ierror = ierror + ierror1
3604 ALLOCATE(daancfie(ninter),stat=ierror1)
3605 ierror = ierror + ierror1
3606 ALLOCATE(diag_smsfie(ninter),stat=ierror1)
3607 ierror = ierror + ierror1
3608C
3609 ALLOCATE (nodnxfie(ninter),stat=ierror1)
3610 ierror = ierror + ierror1
3611 ALLOCATE (nodamsfie(ninter),stat=ierror1)
3612 ierror = ierror + ierror1
3613 ALLOCATE (procamsfie(ninter),stat=ierror1)
3614 ierror = ierror + ierror1
3615C Fin Int20 edge
3616
3617C I18KINE
3618 ALLOCATE (mtfi_pene(ninter),stat=ierror1)
3619 ierror = ierror + ierror1
3620 ALLOCATE (mtfi_penemin(ninter),stat=ierror1)
3621 ierror = ierror + ierror1
3622 ALLOCATE (mtfi_v(ninter),stat=ierror1)
3623 ierror = ierror + ierror1
3624 ALLOCATE (mtfi_a(ninter),stat=ierror1)
3625 ierror = ierror + ierror1
3626 ALLOCATE (i18kafi(ninter),stat=ierror1)
3627 ierror = ierror + ierror1
3628 ALLOCATE (mtfi_n(ninter),stat=ierror1)
3629 ierror = ierror + ierror1
3630C INT 24 & 25
3631 ALLOCATE (time_sfi(ninter),stat=ierror1)
3632 ierror = ierror + ierror1
3633 ALLOCATE (irtlm_fi(ninter),stat=ierror1)
3634 ierror = ierror + ierror1
3635 ALLOCATE (secnd_frfi(ninter),stat=ierror1)
3636 ierror = ierror + ierror1
3637 ALLOCATE (pene_oldfi(ninter),stat=ierror1)
3638 ierror = ierror + ierror1
3639 ALLOCATE (stif_oldfi(ninter),stat=ierror1)
3640 ierror = ierror + ierror1
3641 ALLOCATE (icont_i_fi(ninter),stat=ierror1)
3642 ierror = ierror + ierror1
3643 ALLOCATE (isedge_fi(ninter),stat=ierror1)
3644 ierror = ierror + ierror1
3645 ALLOCATE (irtse_fi(ninter),stat=ierror1)
3646 ierror = ierror + ierror1
3647 ALLOCATE (is2pt_fi(ninter),stat=ierror1)
3648 ierror = ierror + ierror1
3649 ALLOCATE (isegpt_fi(ninter),stat=ierror1)
3650 ierror = ierror + ierror1
3651 ALLOCATE (is2se_fi(ninter),stat=ierror1)
3652 ierror = ierror + ierror1
3653 ALLOCATE (ispt2_fi(ninter),stat=ierror1)
3654 ierror = ierror + ierror1
3655 ALLOCATE (remnor_fi(ninter),stat=ierror1)
3656 ierror = ierror + ierror1
3657 ALLOCATE (kremnor_fi(ninter),stat=ierror1)
3658 ierror = ierror + ierror1
3659C INT 25
3660 ALLOCATE (islide_fi(ninter),stat=ierror1)
3661 ierror = ierror + ierror1
3662 ALLOCATE (icodt_fi(ninter),stat=ierror1)
3663 ierror = ierror + ierror1
3664 ALLOCATE (iskew_fi(ninter),stat=ierror1)
3665 ierror = ierror + ierror1
3666 ipstif = 0
3667 DO i = 1,ninter
3668 IF(ipari(97,i) > 0) ipstif = ipstif + ipari(97,i)
3669 END DO
3670 IF(parameters%ISTIF_DT > 0 .OR. ipstif>0 ) THEN
3671 ALLOCATE(stif_msdt_fi(ninter))
3672 ALLOCATE(stife_msdt_fi(ninter))
3673 ENDIF
3674C
3675 IF(intheat > 0 ) THEN
3676 ALLOCATE (ftheskyfi(ninter),stat=ierror1)
3677 ierror = ierror + ierror1
3678 ALLOCATE(fthefi(ninter),stat=ierror1)
3679 ierror = ierror + ierror1
3680 ALLOCATE(tempfi(ninter),stat=ierror1)
3681 ierror = ierror + ierror1
3682 ALLOCATE(matsfi(ninter),stat=ierror1)
3683 ierror = ierror + ierror1
3684 ALLOCATE(nmtemp(ninter),stat=ierror1)
3685 ierror = ierror + ierror1
3686 IF(idt_therm == 1) THEN
3687 ALLOCATE(condnfi(ninter),stat=ierror1)
3688 ierror = ierror + ierror1
3689 ALLOCATE(condnskyfi(ninter),stat=ierror1)
3690 ierror = ierror + ierror1
3691 ENDIF
3692 ENDIF
3693 IF(intheat > 0 .OR.nintloadp21 > 0) THEN
3694 ALLOCATE(nmnfi(ninter),stat=ierror1)
3695 ierror = ierror + ierror1
3696 ALLOCATE(nmvfi(ninter),stat=ierror1)
3697 ierror = ierror + ierror1
3698 ALLOCATE(nmnsi(ninter),stat=ierror1)
3699 ierror = ierror + ierror1
3700 ALLOCATE(nmvsi(ninter),stat=ierror1)
3701 ierror = ierror + ierror1
3702 ALLOCATE(tempnod(ninter),stat=ierror1)
3703 ierror = ierror + ierror1
3704 ENDIF
3705 IF(nintloadp21 > 0) THEN
3706 ALLOCATE(tagncontfi(ninter),stat=ierror1)
3707 ierror = ierror + ierror1
3708 ENDIF
3709 IF(ninterfric > 0 ) THEN
3710 ALLOCATE(ipartfricsfi(ninter),stat=ierror1)
3711 ierror = ierror + ierror1
3712 ALLOCATE(ipartfric_fie(ninter),stat=ierror1)
3713 ierror = ierror + ierror1
3714 ENDIF
3715C
3716 ALLOCATE (nodnxfi(ninter),stat=ierror1)
3717 ierror = ierror + ierror1
3718 ALLOCATE (nodamsfi(ninter),stat=ierror1)
3719 ierror = ierror + ierror1
3720 ALLOCATE (procamsfi(ninter),stat=ierror1)
3721 ierror = ierror + ierror1
3722C
3723 ALLOCATE (t2main_sms_fi(ninter),stat=ierror1)
3724 ierror = ierror + ierror1
3725 ALLOCATE (t2fac_sms_fi(ninter),stat=ierror1)
3726 ierror = ierror + ierror1
3727C
3728 IF(intheat > 0.OR.interadhesion > 0 ) THEN
3729 ALLOCATE(areasfi(ninter),stat=ierror1)
3730 DO i = 1, ninter
3731 NULLIFY(areasfi(i)%p)
3732 ENDDO
3733 ierror = ierror + ierror1
3734 ENDIF
3735C
3736 IF(interadhesion > 0) THEN
3737 ALLOCATE(if_adhfi(ninter),stat=ierror1)
3738 DO i = 1, ninter
3739 NULLIFY(if_adhfi(i)%p)
3740 ENDDO
3741 ierror = ierror + ierror1
3742 ENDIF
3743
3744 ALLOCATE(candf_si(ninter),stat=ierror1)
3745 ierror = ierror + ierror1
3746C
3747 IF(nitsche > 0 ) THEN
3748 ALLOCATE(forneqsfi(ninter),stat=ierror1)
3749 ierror = ierror + ierror1
3750 ENDIF
3751
3752C
3753 ALLOCATE(efricfi(ninter),stat=ierror1)
3754 ierror = ierror + ierror1
3755 ALLOCATE(efricgfi(ninter),stat=ierror1)
3756 ierror = ierror + ierror1
3757
3758C ALLOCATE(MAIN_FIE(NINTER))
3759 ALLOCATE(gape_l_fie(ninter))
3760 ALLOCATE(edg_bisector_fie(ninter))
3761 ALLOCATE(vtx_bisector_fie(ninter))
3762 ALLOCATE(x_seg_fie(ninter))
3763 ALLOCATE(ledge_fie(ninter))
3764
3765
3766C
3767 DO i=1,ninter
3768 NULLIFY(nsvfi(i)%p)
3769 NULLIFY(nsnfi(i)%p)
3770 NULLIFY(edge_fi(i)%p)
3771 NULLIFY(pmainfi(i)%p)
3772 NULLIFY(nsnfi_sav(i)%p)
3773 NULLIFY(nsnsi_sav(i)%p)
3774 NULLIFY(itafi(i)%p)
3775 NULLIFY(kinfi(i)%p)
3776 NULLIFY(msfi(i)%p)
3777 NULLIFY(stifi(i)%p)
3778 NULLIFY(gapfi(i)%p)
3779 NULLIFY(gap_lfi(i)%p)
3780 NULLIFY(xfi(i)%p)
3781 NULLIFY(vfi(i)%p)
3782 NULLIFY(nsvsi(i)%p)
3783 NULLIFY(nsnsi(i)%p)
3784 NULLIFY(afi(i)%p)
3785 NULLIFY(stnfi(i)%p)
3786 NULLIFY(vscfi(i)%p)
3787 NULLIFY(penfi(i)%p)
3788 NULLIFY(fskyfi(i)%p)
3789 NULLIFY(iskyfi(i)%p)
3790
3791 NULLIFY(nisubsfi(i)%p)
3792 NULLIFY(lisubsfi(i)%p)
3793 NULLIFY(inflg_subsfi(i)%p)
3794 NULLIFY(addsubsfi(i)%p)
3795 IF(parameters%INTCAREA > 0) NULLIFY(intareanfi(i)%p)
3796
3797 NULLIFY(nisubsfie(i)%p)
3798 NULLIFY(lisubsfie(i)%p)
3799 NULLIFY(inflg_subsfie(i)%p)
3800 NULLIFY(addsubsfie(i)%p)
3801
3802
3803C
3804 NULLIFY(fnconti(i)%p)
3805 NULLIFY(ftconti(i)%p)
3806C
3807 NULLIFY(eminxfi(i)%p)
3808 NULLIFY(ksfi(i)%p)
3809 NULLIFY(frotsfi(i)%p)
3810 NULLIFY(stnfi17(i)%p)
3811 NULLIFY(xfi17(i)%p)
3812 NULLIFY(vfi17(i)%p)
3813 NULLIFY(afi17(i)%p)
3814C
3815 NULLIFY(nbinflfi(i)%p)
3816 NULLIFY(daanc6fi(i)%p)
3817 NULLIFY(dxancfi(i)%p)
3818 NULLIFY(dvancfi(i)%p)
3819 NULLIFY(penfia(i)%p)
3820 NULLIFY(alphakfi(i)%p)
3821 NULLIFY(daancfi(i)%p)
3822 NULLIFY(diag_smsfi(i)%p)
3823C
3824 NULLIFY(nodnxfi(i)%p)
3825 NULLIFY(nodamsfi(i)%p)
3826 NULLIFY(procamsfi(i)%p)
3827C
3828C Int20 edge
3829 NULLIFY(nsvfie(i)%p)
3830 NULLIFY(nsnfie(i)%p)
3831 NULLIFY(itafie(i)%p)
3832 NULLIFY(msfie(i)%p)
3833 NULLIFY(stifie(i)%p)
3834 NULLIFY(gapfie(i)%p)
3835 NULLIFY(xfie(i)%p)
3836 NULLIFY(vfie(i)%p)
3837 NULLIFY(nsvsie(i)%p)
3838 NULLIFY(nsnsie(i)%p)
3839 NULLIFY(afie(i)%p)
3840 NULLIFY(stnfie(i)%p)
3841 NULLIFY(vscfie(i)%p)
3842 NULLIFY(penfie(i)%p)
3843 NULLIFY(fskyfie(i)%p)
3844 NULLIFY(iskyfie(i)%p)
3845 NULLIFY(daanc6fie(i)%p)
3846 NULLIFY(dxancfie(i)%p)
3847 NULLIFY(dvancfie(i)%p)
3848 NULLIFY(penfiae(i)%p)
3849 NULLIFY(alphakfie(i)%p)
3850 NULLIFY(daancfie(i)%p)
3851C
3852 NULLIFY(nodnxfie(i)%p)
3853 NULLIFY(nodamsfie(i)%p)
3854 NULLIFY(diag_smsfie(i)%p)
3855 NULLIFY(procamsfie(i)%p)
3856C I18KINE
3857 NULLIFY(mtfi_pene(i)%p)
3858 NULLIFY(mtfi_penemin(i)%p)
3859 NULLIFY(mtfi_v(i)%p)
3860 NULLIFY(mtfi_a(i)%p)
3861C INT24 & 25
3862 NULLIFY(time_sfi(i)%P)
3863 NULLIFY(irtlm_fi(i)%P)
3864 NULLIFY(secnd_frfi(i)%P)
3865 NULLIFY(stif_oldfi(i)%P)
3866 NULLIFY(pene_oldfi(i)%P)
3867 NULLIFY(icont_i_fi(i)%P)
3868 NULLIFY(isedge_fi(i)%P)
3869 NULLIFY(irtse_fi(i)%P)
3870 NULLIFY(is2pt_fi(i)%P)
3871 NULLIFY(ispt2_fi(i)%P)
3872 NULLIFY(isegpt_fi(i)%P)
3873 NULLIFY(is2se_fi(i)%P)
3874 NULLIFY(remnor_fi(i)%P)
3875 NULLIFY(kremnor_fi(i)%P)
3876C INT25
3877 NULLIFY(islide_fi(i)%P)
3878 NULLIFY(t2main_sms_fi(i)%p)
3879 NULLIFY(t2fac_sms_fi(i)%p)
3880 NULLIFY(candf_si(i)%P)
3881 NULLIFY(iskew_fi(i)%P)
3882 NULLIFY(icodt_fi(i)%P)
3883 IF(parameters%ISTIF_DT > 0 .OR. ipari(97,i)>0 ) THEN
3884 NULLIFY(stif_msdt_fi(i)%P)
3885 NULLIFY(stife_msdt_fi(i)%P)
3886 ENDIF
3887C INT25 E2E
3888C NULLIFY(MAIN_FIE(I)%P)
3889 NULLIFY(gape_l_fie(i)%P)
3890 NULLIFY(edg_bisector_fie(i)%P)
3891 NULLIFY(vtx_bisector_fie(i)%P)
3892 NULLIFY(ledge_fie(i)%P)
3893 NULLIFY(x_seg_fie(i)%P)
3894C
3895 NULLIFY(efricfi(i)%P)
3896 NULLIFY(efricgfi(i)%P)
3897 END DO
3898C
3899 IF(intheat /= 0) THEN
3900 DO i=1,ninter
3901 NULLIFY(fthefi(i)%p)
3902 NULLIFY(ftheskyfi(i)%p)
3903 NULLIFY(tempfi(i)%p)
3904 NULLIFY(matsfi(i)%p)
3905 NULLIFY(areasfi(i)%p)
3906 NULLIFY(nmtemp(i)%p)
3907 END DO
3908 IF(interadhesion /= 0) THEN
3909 DO i=1,ninter
3910 NULLIFY(if_adhfi(i)%P)
3911 ENDDO
3912 ENDIF
3913 IF(idt_therm == 1) THEN
3914 DO i=1,ninter
3915 NULLIFY(condnfi(i)%p)
3916 NULLIFY(condnskyfi(i)%p)
3917 ENDDO
3918 ENDIF
3919 ENDIF
3920 IF(intheat /= 0.OR.nintloadp21 > 0) THEN
3921 DO i=1,ninter
3922 NULLIFY(nmnfi(i)%p)
3923 NULLIFY(nmvfi(i)%p)
3924 NULLIFY(nmnsi(i)%p)
3925 NULLIFY(nmvsi(i)%p)
3926 NULLIFY(tempnod(i)%p)
3927 END DO
3928 ENDIF
3929 IF(nintloadp21 > 0) THEN
3930 DO i=1,ninter
3931 NULLIFY(tagncontfi(i)%p)
3932 END DO
3933 ENDIF
3934C
3935 IF(ninterfric > 0 ) THEN
3936 DO i=1,ninter
3937 NULLIFY(ipartfricsfi(i)%p)
3938 NULLIFY(ipartfric_fie(i)%p)
3939 ENDDO
3940 ENDIF
3941C
3942 IF(nitsche > 0 ) THEN
3943 DO i=1,ninter
3944 NULLIFY(forneqsfi(i)%p)
3945 ENDDO
3946 ENDIF
3947C
3948 IF(ierror/=0) THEN
3949 CALL ancmsg(msgid=20,anmode=aninfo)
3950 CALL arret(2)
3951 ENDIF
3952C
3953C allocation et lecture strutures interfaces sur fichier restart (partie entiere)
3954C
3955 nbintc = 0
3956 DO i =1, ninter
3957 ityp = ipari(7,i)
3958 ivis2 = ipari(14,i) ! ivis2==-1 : Flag for interface adhesion
3959 igap = ipari(21,i)
3960 inacti = ipari(22,i)
3961 intth = ipari(47,i)
3962 intfric = ipari(72,i)
3963 flagremn = ipari(63,i)
3964 intnitsche = ipari(86,i)
3965 itied = ipari(85,i)
3966 nsn =ipari(5,i)
3967
3968 IF(ityp==24) THEN
3969 iedge4 = ipari(59,i)
3970 ELSE
3971 iedge4 = 0
3972 ENDIF
3973 IF(ityp==7.OR.ityp==10.OR.ityp==11.OR.
3974 + (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
3975 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
3976 + ityp==25)THEN
3977C
3978 nbintc = nbintc + 1
3979 ALLOCATE(nsnsi(i)%P(nspmd),stat=ierror)
3980 ALLOCATE(nsnfi(i)%P(nspmd),stat=ierror1)
3981
3982
3983 IF(ierror+ierror1/=0) THEN
3984 CALL ancmsg(msgid=20,anmode=aninfo)
3985 CALL arret(2)
3986 ENDIF
3987 CALL read_i_c(nsnsi(i)%P(1),nspmd)
3988 CALL read_i_c(nsnfi(i)%P(1),nspmd)
3989 lens = 0
3990 lenr = 0
3991 DO p = 1, nspmd
3992 lens = lens + nsnsi(i)%P(p)
3993 lenr = lenr + nsnfi(i)%P(p)
3994 END DO
3995C
3996 ierror = 0
3997C
3998 ierror1 = 0
3999 IF(lens>0) THEN
4000 ALLOCATE(nsvsi(i)%P(lens),stat=ierror1)
4001 CALL read_i_c(nsvsi(i)%P(1),lens)
4002 ierror = ierror + ierror1
4003 ENDIF
4004 ALLOCATE(candf_si(i)%P(nsn),stat=ierror1)
4005 candf_si(i)%P(1:nsn)=0
4006C
4007 IF(lenr>0) THEN
4008 ALLOCATE(nsvfi(i)%P(lenr),stat=ierror1)
4009 ierror = ierror + ierror1
4010 CALL read_i_c(nsvfi(i)%P(1),lenr)
4011 IF(ityp==7.OR.ityp==10.OR.
4012 + ityp==20.OR.ityp==22.OR.
4013 + ityp==23.OR.ityp==24.OR.
4014 + ityp==25)THEN
4015 ALLOCATE(itafi(i)%P(lenr),stat=ierror1)
4016 ierror = ierror + ierror1
4017 CALL read_i_c(itafi(i)%P(1),lenr)
4018 IF(ityp==7.OR.ityp==20.OR.ityp==22.OR.
4019 + ityp==23.OR.ityp==24.OR.ityp==25)THEN
4020 ALLOCATE(kinfi(i)%P(lenr),stat=ierror1)
4021 ierror = ierror + ierror1
4022 CALL read_i_c(kinfi(i)%P(1),lenr)
4023C
4024 IF(ityp==20)THEN
4025 ALLOCATE(nbinflfi(i)%P(lenr),stat=ierror1)
4026 ierror = ierror + ierror1
4027 CALL read_i_c(nbinflfi(i)%P(1),lenr)
4028 END IF
4029C
4030 IF(intth > 0 ) THEN
4031 ALLOCATE(matsfi(i)%P(lenr),stat=ierror1)
4032 ierror = ierror + ierror
4033 CALL read_i_c(matsfi(i)%P(1),lenr)
4034 ENDIF
4035 IF((ityp==7.OR.ityp==24.OR.ityp==25).AND.intfric > 0) THEN
4036 ALLOCATE(ipartfricsfi(i)%P(lenr),stat=ierror1)
4037 ierror = ierror + ierror
4038 CALL read_i_c(ipartfricsfi(i)%P(1),lenr)
4039 ENDIF
4040C
4041 IF (ityp==24)THEN
4042 IF(.NOT.ASSOCIATED(irtlm_fi(i)%P))
4043 * ALLOCATE(irtlm_fi(i)%P(2,lenr),stat=ierror1)
4044
4045 CALL read_i_c(irtlm_fi(i)%P(1,1),2*lenr)
4046 IF(.NOT.ASSOCIATED(icont_i_fi(i)%P))
4047 * ALLOCATE(icont_i_fi(i)%P(lenr),stat=ierror1)
4048 CALL read_i_c(icont_i_fi(i)%P(1),lenr)
4049
4050 IF(.NOT.ASSOCIATED(isedge_fi(i)%P))
4051 * ALLOCATE(isedge_fi(i)%P(lenr),stat=ierror1)
4052 CALL read_i_c(isedge_fi(i)%P(1),lenr)
4053
4054 IF(iedge4 >0)THEN
4055 IF(.NOT.ASSOCIATED(irtse_fi(i)%P))
4056 * ALLOCATE(irtse_fi(i)%P(5,lenr),stat=ierror1)
4057 CALL read_i_c(irtse_fi(i)%P(1,1),5*lenr)
4058
4059 IF(.NOT.ASSOCIATED(is2pt_fi(i)%P))
4060 * ALLOCATE(is2pt_fi(i)%P(lenr),stat=ierror1)
4061 CALL read_i_c(is2pt_fi(i)%P(1),lenr)
4062
4063 IF(.NOT.ASSOCIATED(ispt2_fi(i)%P))
4064 * ALLOCATE(ispt2_fi(i)%P(lenr),stat=ierror1)
4065 CALL read_i_c(ispt2_fi(i)%P(1),lenr)
4066
4067 IF(.NOT.ASSOCIATED(isegpt_fi(i)%P))
4068 * ALLOCATE(isegpt_fi(i)%P(lenr),stat=ierror1)
4069 CALL read_i_c(isegpt_fi(i)%P(1),lenr)
4070
4071 IF(.NOT.ASSOCIATED(is2se_fi(i)%P))
4072 * ALLOCATE(is2se_fi(i)%P(2,lenr),stat=ierror1)
4073 CALL read_i_c(is2se_fi(i)%P(1,1),2*lenr)
4074
4075 ENDIF
4076 IF(intnitsche >0)THEN
4077 IF(.NOT.ASSOCIATED(forneqsfi(i)%P))
4078 * ALLOCATE(forneqsfi(i)%P(3,lenr),stat=ierror1)
4079 CALL read_i_c(forneqsfi(i)%P(1,1),3*lenr)
4080 ENDIF
4081
4082 ENDIF
4083C
4084 IF (ityp==25)THEN
4085 IF(.NOT.ASSOCIATED(pmainfi(i)%P))
4086 * ALLOCATE(pmainfi(i)%P(lenr),stat=ierror1)
4087 CALL read_i_c(pmainfi(i)%P(1),lenr)
4088 IF(.NOT.ASSOCIATED(irtlm_fi(i)%P))
4089 * ALLOCATE(irtlm_fi(i)%P(4,lenr),stat=ierror1)
4090 CALL read_i_c(irtlm_fi(i)%P(1,1),4*lenr)
4091 IF(.NOT.ASSOCIATED(icont_i_fi(i)%P))
4092 * ALLOCATE(icont_i_fi(i)%P(lenr),stat=ierror1)
4093 CALL read_i_c(icont_i_fi(i)%P(1),lenr)
4094
4095 IF(.NOT.ASSOCIATED(icodt_fi(i)%P))
4096 * ALLOCATE(icodt_fi(i)%P(lenr),stat=ierror1)
4097C CALL READ_I_C(ICODT_FI(I)%P(1),LENR)
4098 icodt_fi(i)%P(1:lenr) = 0
4099
4100 IF(.NOT.ASSOCIATED(iskew_fi(i)%P))
4101 * ALLOCATE(iskew_fi(i)%P(lenr),stat=ierror1)
4102 iskew_fi(i)%P(1:lenr) = 0
4103
4104C CALL READ_I_C(ISKEW_FI(I)%P(1),LENR)
4105
4106 IF(.NOT.ASSOCIATED(islide_fi(i)%P))
4107 * ALLOCATE(islide_fi(i)%P(4,lenr),stat=ierror1)
4108C no need in restart file
4109 islide_fi(i)%P(1:4,1:lenr)=0
4110C Remove banned main segment
4111 IF(flagremn==2) THEN
4112 IF(.NOT.ASSOCIATED(kremnor_fi(i)%P))
4113 * ALLOCATE(kremnor_fi(i)%P(lenr+1),stat=ierror1)
4114 CALL read_i_c(kremnor_fi(i)%P(1),lenr+1)
4115 sizremnorfi = kremnor_fi(i)%P(lenr+1)
4116 IF(sizremnorfi /= 0) THEN
4117 IF(.NOT.ASSOCIATED(remnor_fi(i)%P))
4118 * ALLOCATE(remnor_fi(i)%P(sizremnorfi),stat=ierror1)
4119 CALL read_i_c(remnor_fi(i)%P(1),sizremnorfi)
4120 ELSE IF(sizremnorfi == 0) THEN
4121 IF(.NOT.ASSOCIATED(remnor_fi(i)%P))
4122 * ALLOCATE(remnor_fi(i)%P(sizremnorfi),stat=ierror1)
4123 ENDIF
4124 ENDIF
4125 ENDIF
4126 END IF
4127C
4128 IF(idtmins_old == 2) THEN
4129 ALLOCATE (nodnxfi(i)%P(lenr),stat=ierror1)
4130 ierror = ierror + ierror1
4131 CALL read_i_c(nodnxfi(i)%P(1),lenr)
4132 ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
4133 ierror = ierror + ierror1
4134 CALL read_i_c(nodamsfi(i)%P(1),lenr)
4135 ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
4136 ierror = ierror + ierror1
4137 CALL read_i_c(procamsfi(i)%P(1),lenr)
4138 IF (ityp==24) THEN
4139 ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
4140 ierror = ierror + ierror1
4141 CALL read_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
4142 ENDIF
4143 ELSEIF(idtmins_int_old /= 0) THEN
4144 ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
4145 ierror = ierror + ierror1
4146 CALL read_i_c(nodamsfi(i)%P(1),lenr)
4147 ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
4148 ierror = ierror + ierror1
4149 CALL read_i_c(procamsfi(i)%P(1),lenr)
4150 IF (ityp==24) THEN
4151 ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
4152 ierror = ierror + ierror1
4153 CALL read_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
4154 ENDIF
4155 ENDIF
4156C
4157 IF(idtmins==2) THEN
4158 IF(.NOT.ASSOCIATED(nodnxfi(i)%P)) THEN
4159 ALLOCATE (nodnxfi(i)%P(lenr),stat=ierror1)
4160 ierror = ierror + ierror1
4161 nodnxfi(i)%P(1:lenr)=0
4162 ENDIF
4163 IF(.NOT.ASSOCIATED(nodamsfi(i)%P)) THEN
4164 ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
4165 ierror = ierror + ierror1
4166 nodamsfi(i)%P(1:lenr)=0
4167 ENDIF
4168 IF(.NOT.ASSOCIATED(procamsfi(i)%P)) THEN
4169 ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
4170 ierror = ierror + ierror1
4171 procamsfi(i)%P(1:lenr)=0
4172 ENDIF
4173 IF (ityp==24) THEN
4174 IF(.NOT.ASSOCIATED(t2main_sms_fi(i)%P)) THEN
4175 ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
4176 ierror = ierror + ierror1
4177 t2main_sms_fi(i)%P(1:6,1:lenr)=0
4178 ENDIF
4179 ENDIF
4180 ELSEIF(idtmins_int /= 0) THEN
4181 IF(.NOT.ASSOCIATED(nodamsfi(i)%P)) THEN
4182 ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
4183 ierror = ierror + ierror1
4184 nodamsfi(i)%P(1:lenr)=0
4185 ENDIF
4186 IF(.NOT.ASSOCIATED(procamsfi(i)%P)) THEN
4187 ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
4188 ierror = ierror + ierror1
4189 procamsfi(i)%P(1:lenr)=0
4190 ENDIF
4191 IF (ityp==24) THEN
4192 IF(.NOT.ASSOCIATED(t2main_sms_fi(i)%P)) THEN
4193 ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
4194 ierror = ierror + ierror1
4195 t2main_sms_fi(i)%P(1:6,1:lenr)=0
4196 ENDIF
4197 ENDIF
4198 END IF
4199C
4200 ALLOCATE(msfi(i)%P(lenr),stat=ierror1)
4201 ierror = ierror + ierror1
4202 ALLOCATE(stifi(i)%P(lenr),stat=ierror1)
4203 ierror = ierror + ierror1
4204 IF(igap/=0)THEN
4205 ALLOCATE(gapfi(i)%P(lenr),stat=ierror1)
4206 ierror = ierror + ierror1
4207 IF(igap==3)THEN
4208 ALLOCATE(gap_lfi(i)%P(lenr),stat=ierror1)
4209 ierror = ierror + ierror1
4210 END IF
4211 END IF
4212 ALLOCATE(xfi(i)%P(3,lenr),stat=ierror1)
4213 ierror = ierror + ierror1
4214 ALLOCATE(vfi(i)%P(3,lenr),stat=ierror1)
4215 ierror = ierror + ierror1
4216
4217 IF(iparit==0) THEN
4218 ALLOCATE(afi(i)%P(3,lenr*nthread),stat=ierror1)
4219 ierror = ierror + ierror1
4220 ALLOCATE(stnfi(i)%P(lenr*nthread),stat=ierror1)
4221 ierror = ierror + ierror1
4222 IF(kdtint/=0)THEN
4223 ALLOCATE(vscfi(i)%P(lenr*nthread),stat=ierror1)
4224 ierror = ierror + ierror1
4225 ENDIF
4226
4227 DO k=1,lenr*nthread
4228 afi(i)%P(1,k)=zero
4229 afi(i)%P(2,k)=zero
4230 afi(i)%P(3,k)=zero
4231 stnfi(i)%P(k)=zero
4232 ENDDO
4233
4234 IF(kdtint/=0)THEN
4235 vscfi(i)%P(1:lenr*nthread)=zero
4236 ENDIF
4237
4238
4239 nlskyfi(i) = lenr
4240C
4241 IF(intth > 0 )THEN
4242 ALLOCATE(fthefi(i)%P(lenr*nthread),stat=ierror1)
4243 ierror = ierror + ierror1
4244
4245 fthefi(i)%P(1:lenr*nthread)=zero
4246
4247 ALLOCATE(tempfi(i)%P(lenr),stat=ierror1)
4248 ierror = ierror + ierror1
4249c ALLOCATE(MATSFI(I)%P(LENR),STAT=IERROR1)
4250c IERROR = IERROR + IERROR
4251 ENDIF
4252 IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
4253 ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
4254 ierror = ierror + ierror1
4255 ENDIF
4256C
4257 IF(ityp == 25.AND.ivis2==-1) THEN
4258 ALLOCATE(if_adhfi(i)%P(lenr),stat=ierror1)
4259 ierror = ierror + ierror1
4260 ENDIF
4261C
4262 IF(idt_therm ==1.AND.intth > 0) THEN
4263 ALLOCATE(condnfi(i)%P(lenr*nthread),stat=ierror1)
4264 ierror = ierror + ierror1
4265 condnfi(i)%P(1:lenr*nthread)=zero
4266 ENDIF
4267 ELSE
4268
4269
4270 nlskyfi(i) = 0
4271 lskyfi = 0
4272
4273
4274 IF(intth > 0 ) THEN
4275 ALLOCATE(tempfi(i)%P(lenr),stat=ierror1)
4276 ierror = ierror + ierror1
4277 ENDIF
4278C
4279 IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
4280 ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
4281 ierror = ierror + ierror1
4282 ENDIF
4283 IF(ityp == 25.AND.ivis2==-1) THEN
4284 ALLOCATE(if_adhfi(i)%P(lenr),stat=ierror1)
4285 ierror = ierror + ierror1
4286 ENDIF
4287C
4288 END IF
4289 IF(ityp == 24)THEN
4290 ALLOCATE(time_sfi(i)%P(lenr),stat=ierror1)
4291 time_sfi(i)%P(1:lenr)=zero
4292 ierror = ierror + ierror1
4293 ELSEIF(ityp == 25)THEN
4294 ALLOCATE(time_sfi(i)%P(2*lenr),stat=ierror1)
4295 time_sfi(i)%P(1:2*lenr)=zero
4296 ierror = ierror + ierror1
4297 END IF
4298 IF(ityp == 24 .OR. ityp == 25)THEN
4299 ALLOCATE(secnd_frfi(i)%P(6,lenr),stat=ierror1)
4300 secnd_frfi(i)%P(1:6,1:lenr)=zero
4301 ierror = ierror + ierror1
4302 ALLOCATE(pene_oldfi(i)%P(5,lenr),stat=ierror1)
4303 pene_oldfi(i)%P(1:5,1:lenr)=zero
4304 ierror = ierror + ierror1
4305 ALLOCATE(stif_oldfi(i)%P(2,lenr),stat=ierror1)
4306 stif_oldfi(i)%P(1:2,1:lenr)=zero
4307 ierror = ierror + ierror1
4308
4309 IF(ipari(97,i) > 0) THEN
4310 ALLOCATE(stif_msdt_fi(i)%P(lenr))
4311 stif_msdt_fi(i)%P(1:lenr)=zero
4312 ENDIF
4313
4314 IF(ityp == 25.AND.parameters%INTCAREA > 0.AND.ipari(36,i)>0) THEN
4315 ALLOCATE(intareanfi(i)%P(lenr),stat=ierror1)
4316 ierror = ierror + ierror1
4317 intareanfi(i)%P(1:lenr) =zero
4318 ENDIF
4319 IF(ityp == 24.AND.parameters%INTCAREA > 0) THEN
4320 ALLOCATE(intareanfi(i)%P(lenr),stat=ierror1)
4321 ierror = ierror + ierror1
4322 intareanfi(i)%P(1:lenr) =zero
4323 ENDIF
4324 ENDIF
4325 ELSEIF(ityp==11)THEN
4326C type11
4327 ALLOCATE(itafi(i)%P(2*lenr),stat=ierror1)
4328 ierror = ierror + ierror1
4329 CALL read_i_c(itafi(i)%P(1),2*lenr)
4330C
4331 IF(idtmins_old == 2) THEN
4332 ALLOCATE (nodnxfi(i)%P(2*lenr),stat=ierror1)
4333 ierror = ierror + ierror1
4334 CALL read_i_c(nodnxfi(i)%P(1),2*lenr)
4335 ALLOCATE (nodamsfi(i)%P(2*lenr),stat=ierror1)
4336 ierror = ierror + ierror1
4337 CALL read_i_c(nodamsfi(i)%P(1),2*lenr)
4338 ALLOCATE (procamsfi(i)%P(2*lenr),stat=ierror1)
4339 ierror = ierror + ierror1
4340 CALL read_i_c(procamsfi(i)%P(1),2*lenr)
4341 ELSEIF(idtmins_int_old /= 0) THEN
4342 ALLOCATE (nodamsfi(i)%P(2*lenr),stat=ierror1)
4343 ierror = ierror + ierror1
4344 CALL read_i_c(nodamsfi(i)%P(1),2*lenr)
4345 ALLOCATE (procamsfi(i)%P(2*lenr),stat=ierror1)
4346 ierror = ierror + ierror1
4347 CALL read_i_c(procamsfi(i)%P(1),2*lenr)
4348 ENDIF
4349C
4350 IF(intth > 0 ) THEN
4351 ALLOCATE(matsfi(i)%P(lenr),stat=ierror1)
4352 ierror = ierror + ierror1
4353 CALL read_i_c(matsfi(i)%P(1),lenr)
4354 ENDIF
4355C
4356 IF(intfric > 0) THEN
4357 ALLOCATE(ipartfricsfi(i)%P(lenr),stat=ierror1)
4358 ierror = ierror + ierror
4359 CALL read_i_c(ipartfricsfi(i)%P(1),lenr)
4360 ENDIF
4361C
4362 ALLOCATE(msfi(i)%P(2*lenr),stat=ierror1)
4363 ierror = ierror + ierror1
4364 ALLOCATE(stifi(i)%P(lenr),stat=ierror1)
4365 ierror = ierror + ierror1
4366 IF(igap/=0)THEN
4367 ALLOCATE(gapfi(i)%P(lenr),stat=ierror1)
4368 ierror = ierror + ierror1
4369 IF(igap==3)THEN
4370 ALLOCATE(gap_lfi(i)%P(lenr),stat=ierror1)
4371 ierror = ierror + ierror1
4372 END IF
4373 END IF
4374 ALLOCATE(xfi(i)%P(3,2*lenr),stat=ierror1)
4375 ierror = ierror + ierror1
4376 ALLOCATE(vfi(i)%P(3,2*lenr),stat=ierror1)
4377 ierror = ierror + ierror1
4378 IF(inacti==5.OR.inacti==6) THEN
4379 ALLOCATE(penfi(i)%P(2,lenr),stat=ierror1)
4380 END IF
4381 IF(iparit==0) THEN
4382 ALLOCATE(afi(i)%P(3,2*lenr*nthread),stat=ierror1)
4383 ierror = ierror + ierror1
4384 ALLOCATE(stnfi(i)%P(2*lenr*nthread),stat=ierror1)
4385 ierror = ierror + ierror1
4386 IF(kdtint/=0)THEN
4387 ALLOCATE(vscfi(i)%P(2*lenr*nthread),stat=ierror1)
4388 ierror = ierror + ierror1
4389 ENDIF
4390 IF(intth > 0 )THEN
4391 ALLOCATE(fthefi(i)%P(2*lenr*nthread),stat=ierror1)
4392 ierror = ierror + ierror1
4393 ALLOCATE(tempfi(i)%P(2*lenr),stat=ierror1)
4394 ierror = ierror + ierror1
4395c ALLOCATE(MATSFI(I)%P(LENR),STAT=IERROR1)
4396c IERROR = IERROR + IERROR
4397 ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
4398 ierror = ierror + ierror1
4399 ENDIF
4400 IF(idt_therm ==1.AND.intth > 0) THEN
4401 ALLOCATE(condnfi(i)%P(2*lenr*nthread),stat=ierror1)
4402 ierror = ierror + ierror1
4403 ENDIF
4404 nlskyfi(i) = 2*lenr
4405
4406 ELSE
4407 lskyfi = 0
4408 nlskyfi(i) = 0
4409
4410 IF(intth > 0 ) THEN
4411 ALLOCATE(tempfi(i)%P(2*lenr),stat=ierror1)
4412 ierror = ierror + ierror1
4413c ALLOCATE(MATSFI(I)%P(LENR),STAT=IERROR1)
4414c IERROR = IERROR + IERROR
4415 ENDIF
4416
4417 IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
4418 ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
4419 ierror = ierror + ierror1
4420 ENDIF
4421 END IF
4422C fin type11
4423 ELSEIF(ityp==17)THEN
4424 ALLOCATE(xfi17(i)%P(3,16,lenr),stat=ierror1)
4425 ierror = ierror + ierror1
4426 ALLOCATE(vfi17(i)%P(3,16,lenr),stat=ierror1)
4427 ierror = ierror + ierror1
4428 ALLOCATE(frotsfi(i)%P(7,lenr),stat=ierror1)
4429 ierror = ierror + ierror1
4430 ALLOCATE(ksfi(i)%P(2,lenr),stat=ierror1)
4431 ierror = ierror + ierror1
4432 ALLOCATE(eminxfi(i)%P(6,lenr),stat=ierror1)
4433 ierror = ierror + ierror1
4434 IF(iparit==0) THEN
4435 ALLOCATE(afi17(i)%P(3,16,lenr),stat=ierror1)
4436 ierror = ierror + ierror1
4437 ALLOCATE(stnfi17(i)%P(16,lenr),stat=ierror1)
4438 ierror = ierror + ierror1
4439 nlskyfi(i) = 0
4440 ELSE
4441 lskyfi = lenr * multimax
4442 nlskyfi(i) = lskyfi
4443
4444 ALLOCATE(iskyfi(i)%P(lskyfi),stat=ierror1)
4445 ierror = ierror + ierror1
4446 ALLOCATE(fskyfi(i)%P(40,lskyfi),stat=ierror1)
4447 ierror = ierror + ierror1
4448 END IF
4449C fin type 17
4450 END IF
4451C cas LENR = 0, on a pas besoin de tableau ISKYFI et FSKYFI
4452 ELSE
4453 nlskyfi(i) = 0
4454 ENDIF
4455C
4456 IF(ierror/=0) THEN
4457 CALL ancmsg(msgid=20,anmode=aninfo)
4458 CALL arret(2)
4459 ENDIF
4460C
4461 IF(ityp==20)THEN
4462 ALLOCATE(daanc6fi(i)%P(3,6,lenr),stat=ierror1)
4463 ierror = ierror + ierror1
4464 ALLOCATE(dxancfi(i)%P(3,lenr),stat=ierror1)
4465 ierror = ierror + ierror1
4466 ALLOCATE(dvancfi(i)%P(3,lenr),stat=ierror1)
4467 ierror = ierror + ierror1
4468 IF((inacti==5.OR.inacti==6) .AND. lenr > 0) THEN
4469 ALLOCATE(penfi(i)%P(2,lenr),stat=ierror1)
4470 ierror = ierror + ierror1
4471 ALLOCATE(penfia(i)%P(5,lenr),stat=ierror1)
4472 ierror = ierror + ierror1
4473 END IF
4474 IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
4475 ALLOCATE (diag_smsfi(i)%P(lenr),stat=ierror1)
4476 ierror = ierror + ierror1
4477 ENDIF
4478 ALLOCATE(alphakfi(i)%P(lenr),stat=ierror1)
4479 ierror = ierror + ierror1
4480 ALLOCATE(daancfi(i)%P(3,lenr),stat=ierror1)
4481 daancfi(i)%P(1:3,1:lenr)=zero
4482 ierror = ierror + ierror1
4483 IF(ierror/=0) THEN
4484 CALL ancmsg(msgid=20,anmode=aninfo)
4485 CALL arret(2)
4486 END IF
4487C type20 edge
4488 ALLOCATE(nsnsie(i)%P(nspmd),stat=ierror1)
4489 ierror = ierror + ierror1
4490 ALLOCATE(nsnfie(i)%P(nspmd),stat=ierror1)
4491 ierror = ierror + ierror1
4492 CALL read_i_c(nsnsie(i)%P(1),nspmd)
4493 CALL read_i_c(nsnfie(i)%P(1),nspmd)
4494 lens = 0
4495 lenr = 0
4496 DO p = 1, nspmd
4497 lens = lens + nsnsie(i)%P(p)
4498 lenr = lenr + nsnfie(i)%P(p)
4499 END DO
4500C
4501 IF(lens>0) THEN
4502 ALLOCATE(nsvsie(i)%P(lens),stat=ierror1)
4503 CALL read_i_c(nsvsie(i)%P(1),lens)
4504 ierror = ierror + ierror1
4505 ENDIF
4506C
4507 IF(lenr>0) THEN
4508 ALLOCATE(nsvfie(i)%P(lenr),stat=ierror1)
4509 ierror = ierror + ierror1
4510 CALL read_i_c(nsvfie(i)%P(1),lenr)
4511 ALLOCATE(itafie(i)%P(2*lenr),stat=ierror1)
4512 ierror = ierror + ierror1
4513 CALL read_i_c(itafie(i)%P(1),2*lenr)
4514 ALLOCATE(msfie(i)%P(2*lenr),stat=ierror1)
4515 ierror = ierror + ierror1
4516 ALLOCATE(stifie(i)%P(lenr),stat=ierror1)
4517 ierror = ierror + ierror1
4518 IF(igap/=0)THEN
4519 ALLOCATE(gapfie(i)%P(lenr),stat=ierror1)
4520 ierror = ierror + ierror1
4521 END IF
4522 ALLOCATE(xfie(i)%P(3,2*lenr),stat=ierror1)
4523 ierror = ierror + ierror1
4524 ALLOCATE(vfie(i)%P(3,2*lenr),stat=ierror1)
4525 ierror = ierror + ierror1
4526 IF(inacti==5.OR.inacti==6) THEN
4527 ALLOCATE(penfie(i)%P(2,lenr),stat=ierror1)
4528 ierror = ierror + ierror1
4529 ALLOCATE(penfiae(i)%P(5,2*lenr),stat=ierror1)
4530 ierror = ierror + ierror1
4531 END IF
4532 IF(iparit==0) THEN
4533 ALLOCATE(afie(i)%P(3,2*lenr*nthread),stat=ierror1)
4534 ierror = ierror + ierror1
4535 ALLOCATE(stnfie(i)%P(2*lenr*nthread),stat=ierror1)
4536 ierror = ierror + ierror1
4537 IF(kdtint/=0)THEN
4538 ALLOCATE(vscfie(i)%P(2*lenr*nthread),stat=ierror1)
4539 ierror = ierror + ierror1
4540 ENDIF
4541 nlskyfie(i) = 2*lenr
4542 ELSE
4543 lskyfi = lenr * multimax
4544 nlskyfie(i) = lskyfi
4545 ALLOCATE(iskyfie(i)%P(lskyfi),stat=ierror1)
4546 ierror = ierror + ierror1
4547 IF(kdtint==0) THEN
4548C ALLOCATE(FSKYFIE(I)%P(8,LSKYFI),STAT=IERROR1)
4549 ALLOCATE(fskyfie(i)%P(10,lskyfi),stat=ierror1)
4550
4551 ELSE
4552 ALLOCATE(fskyfie(i)%P(10,lskyfi),stat=ierror1)
4553 END IF
4554 ierror = ierror + ierror1
4555 END IF
4556 ALLOCATE(daanc6fie(i)%P(3,6,2*lenr),stat=ierror1)
4557 ierror = ierror + ierror1
4558 ALLOCATE(dxancfie(i)%P(3,2*lenr),stat=ierror1)
4559 ierror = ierror + ierror1
4560 ALLOCATE(dvancfie(i)%P(3,2*lenr),stat=ierror1)
4561 ierror = ierror + ierror1
4562 ALLOCATE(alphakfie(i)%P(2*lenr),stat=ierror1)
4563 ierror = ierror + ierror1
4564 ALLOCATE(daancfie(i)%P(3,lenr),stat=ierror1)
4565 ierror = ierror + ierror1
4566 IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
4567 ALLOCATE (diag_smsfie(i)%P(lenr),stat=ierror1)
4568 ierror = ierror + ierror1
4569 ENDIF
4570C
4571 IF(idtmins_old == 2) THEN
4572 ALLOCATE (nodnxfie(i)%P(lenr),stat=ierror1)
4573 ierror = ierror + ierror1
4574 CALL read_i_c(nodnxfie(i)%P(1),lenr)
4575 ALLOCATE (nodamsfie(i)%P(lenr),stat=ierror1)
4576 ierror = ierror + ierror1
4577 CALL read_i_c(nodamsfie(i)%P(1),lenr)
4578 ALLOCATE (procamsfie(i)%P(lenr),stat=ierror1)
4579 ierror = ierror + ierror1
4580 CALL read_i_c(procamsfie(i)%P(1),lenr)
4581 ELSEIF(idtmins_int_old /= 0) THEN
4582 ALLOCATE (nodamsfie(i)%P(lenr),stat=ierror1)
4583 ierror = ierror + ierror1
4584 CALL read_i_c(nodamsfie(i)%P(1),lenr)
4585 ALLOCATE (procamsfie(i)%P(lenr),stat=ierror1)
4586 ierror = ierror + ierror1
4587 CALL read_i_c(procamsfie(i)%P(1),lenr)
4588 ENDIF
4589C
4590 IF(ierror/=0) THEN
4591 CALL ancmsg(msgid=20,anmode=aninfo)
4592 CALL arret(2)
4593 END IF
4594C cas LENR = 0, on a pas besoin de tableau ISKYFI et FSKYFI
4595 ELSE
4596 nlskyfie(i) = 0
4597 END IF
4598 END IF ! Fin type20 edge
4599
4600 IF(ityp == 25 ) THEN
4601 ALLOCATE(edge_fi(i)%P(nspmd))
4602 ALLOCATE(nsnsie(i)%P(nspmd),stat=ierror1)
4603 ALLOCATE(nsnfie(i)%P(nspmd),stat=ierror1)
4604 edge_fi(i)%P(1:nspmd) = 0
4605 nsnsie(i)%P(1:nspmd) = 0
4606 nsnfie(i)%P(1:nspmd) = 0
4607
4608 IF(ipari(58,i) /=0) THEN
4609
4610 CALL read_i_c(nsnsie(i)%P(1),nspmd)
4611 CALL read_i_c(nsnfie(i)%P(1),nspmd)
4612
4613 lens_edge = 0
4614 lenr_edge = 0
4615 DO p = 1, nspmd
4616 lens_edge = lens_edge + nsnsie(i)%P(p)
4617 lenr_edge = lenr_edge + nsnfie(i)%P(p)
4618 END DO
4619C
4620 IF(lens_edge>0) THEN
4621 ALLOCATE(nsvsie(i)%P(lens_edge),stat=ierror1)
4622 CALL read_i_c(nsvsie(i)%P(1),lens_edge)
4623 ierror = ierror + ierror1
4624 ENDIF
4625C
4626 IF(iparit == 0) THEN
4627 nlskyfie(i) = lenr_edge*2
4628 ALLOCATE(afie(i)%P(3,2*lenr_edge*nthread),stat=ierror1)
4629 ierror = ierror + ierror1
4630 ALLOCATE(stnfie(i)%P(2*lenr_edge*nthread),stat=ierror1)
4631 ierror = ierror + ierror1
4632 IF(kdtint/=0)THEN
4633 ALLOCATE(vscfie(i)%P(2*lenr_edge*nthread),stat=ierror1)
4634 ierror = ierror + ierror1
4635 ENDIF
4636 ELSE
4637 lskyfi = lenr_edge * multimax
4638 nlskyfie(i) = lskyfi
4639 ALLOCATE(iskyfie(i)%P(lskyfi),stat=ierror1)
4640 ierror = ierror + ierror1
4641 IF(kdtint==0) THEN
4642 ALLOCATE(fskyfie(i)%P(8,lskyfi),stat=ierror1)
4643 ELSE
4644 ALLOCATE(fskyfie(i)%P(8,lskyfi),stat=ierror1)
4645 END IF
4646 ierror = ierror + ierror1
4647 ENDIF
4648 IF(lenr_edge>0) THEN
4649 ALLOCATE(nsvfie(i)%P(lenr_edge))
4650 ALLOCATE(itafie(i)%P(lenr_edge*2))
4651 ALLOCATE(ledge_fie(i)%P(e_ledge_size,lenr_edge))
4652 ALLOCATE(xfie(i)%P(3,lenr_edge*2))
4653 ALLOCATE(vfie(i)%P(3,lenr_edge*2))
4654 ALLOCATE(msfie(i)%P(lenr_edge*2))
4655 ALLOCATE(gapfie(i)%P(lenr_edge))
4656 IF( igap == 3) THEN
4657 ALLOCATE(gape_l_fie(i)%P(lenr_edge))
4658 ENDIF
4659 ALLOCATE(stifie(i)%P(lenr_edge))
4660 ALLOCATE(edg_bisector_fie(i)%P(3,3,lenr_edge))
4661 ALLOCATE(vtx_bisector_fie(i)%P(3,4,lenr_edge))
4662 ALLOCATE(x_seg_fie(i)%P(3,4,lenr_edge))
4663 edg_bisector_fie(i)%P(1:3,1:3,1:lenr_edge) = 0
4664 vtx_bisector_fie(i)%P(1:3,1:4,1:lenr_edge) = 0
4665 x_seg_fie(i)%P(1:3,1:4,1:lenr_edge) = 0
4666
4667 CALL read_i_c(nsvfie(i)%P,lenr_edge)
4668
4669 CALL read_i_c(ledge_fie(i)%P,e_ledge_size*lenr_edge)
4670 ipari(69,i) = lenr_edge
4671 IF(intfric > 0) THEN
4672 ALLOCATE(ipartfric_fie(i)%P(lenr),stat=ierror1)
4673 CALL read_i_c(ipartfric_fie(i)%P,lenr_edge)
4674 ENDIF
4675 IF(ipari(97,i) > 0) THEN
4676 ALLOCATE(stife_msdt_fi(i)%P(lenr_edge))
4677 stife_msdt_fi(i)%P(1:lenr_edge)=zero
4678 ENDIF
4679
4680 ENDIF
4681 ENDIF
4682 ENDIF
4683
4684C
4685C
4686 IF(ipari(36,i)>0.AND.ipari(7,i)/=17) THEN
4687C structure output sous interfaces
4688 ierror = 0
4689 ALLOCATE(nisubsfi(i)%P(nspmd),stat=ierror1)
4690 ierror = ierror + ierror1
4691 CALL read_i_c(nisubsfi(i)%P(1),nspmd)
4692 leni = 0
4693 lenr = 0
4694 DO p = 1, nspmd
4695 leni = leni + nisubsfi(i)%P(p)
4696 lenr = lenr + nsnfi(i)%P(p)
4697 END DO
4698
4699 IF(leni>0) THEN
4700 IF(lenr>0) THEN
4701 ALLOCATE(addsubsfi(i)%P(lenr+1),stat=ierror1)
4702 ierror = ierror + ierror1
4703 CALL read_i_c(addsubsfi(i)%P(1),lenr+1)
4704 END IF
4705 ALLOCATE(lisubsfi(i)%P(leni),stat=ierror1)
4706 ierror = ierror + ierror1
4707 CALL read_i_c(lisubsfi(i)%P(1),leni)
4708 IF(ipari(7,i)==25.OR.ipari(7,i)==7.OR.ipari(7,i)==24.OR.ipari(7,i)==11)THEN
4709 ALLOCATE(inflg_subsfi(i)%P(leni),stat=ierror1)
4710 ierror = ierror + ierror1
4711 CALL read_i_c(inflg_subsfi(i)%P(1),leni)
4712 END IF
4713 ELSE
4714 IF(lenr>0) THEN
4715 ALLOCATE(addsubsfi(i)%P(lenr+1),stat=ierror1)
4716 DO j=1,lenr+1
4717 addsubsfi(i)%P(j)=1
4718 END DO
4719 END IF
4720 END IF
4721 IF(ierror/=0) THEN
4722 CALL ancmsg(msgid=20,anmode=aninfo)
4723 CALL arret(2)
4724 END IF
4725C =================== EDGES TO EDGE
4726C structure output sous interfaces
4727 IF(ipari(7,i) == 25 .AND. ipari(58,i) > 0) THEN
4728 ierror = 0
4729 ALLOCATE(nisubsfie(i)%P(nspmd),stat=ierror1)
4730 ierror = ierror + ierror1
4731 CALL read_i_c(nisubsfie(i)%P(1),nspmd)
4732 leni = 0
4733 DO p = 1, nspmd
4734 leni = leni + nisubsfie(i)%P(p)
4735 END DO
4736 IF(leni>0) THEN
4737 IF(lenr_edge>0) THEN
4738 ALLOCATE(addsubsfie(i)%P(lenr_edge+1),stat=ierror1)
4739 ierror = ierror + ierror1
4740 CALL read_i_c(addsubsfie(i)%P(1),lenr_edge+1)
4741 END IF
4742 ALLOCATE(lisubsfie(i)%P(leni),stat=ierror1)
4743 ierror = ierror + ierror1
4744 CALL read_i_c(lisubsfie(i)%P(1),leni)
4745 ALLOCATE(inflg_subsfie(i)%P(leni),stat=ierror1)
4746 ierror = ierror + ierror1
4747 CALL read_i_c(inflg_subsfie(i)%P(1),leni)
4748 ELSE
4749 IF(lenr_edge>0) THEN
4750 ALLOCATE(addsubsfie(i)%P(lenr_edge+1),stat=ierror1)
4751 DO j=1,lenr_edge+1
4752 addsubsfie(i)%P(j)=1
4753 END DO
4754 END IF
4755 END IF
4756 ENDIF
4757 END IF
4758
4759C
4760 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT >0)THEN
4761 ierror = 0
4762 ALLOCATE(fnconti(i)%P(3,lenr),stat=ierror1)
4763 ierror = ierror + ierror1
4764 ALLOCATE(ftconti(i)%P(3,lenr),stat=ierror1)
4765 ierror = ierror + ierror1
4766 IF(ierror/=0) THEN
4767 CALL ancmsg(msgid=20,anmode=aninfo)
4768 CALL arret(2)
4769 ELSE
4770 DO j = 1, lenr
4771 fnconti(i)%P(1,j)=zero
4772 fnconti(i)%P(2,j)=zero
4773 fnconti(i)%P(3,j)=zero
4774 ftconti(i)%P(1,j)=zero
4775 ftconti(i)%P(2,j)=zero
4776 ftconti(i)%P(3,j)=zero
4777 END DO
4778 END IF
4779 END IF
4780 END IF
4781C
4782C Allocate and Read in RST file inter 21 structure for nodal temperature
4783C Actualisation
4784C
4785 IF(ityp==21) THEN
4786C
4787 IF(intth==2.OR.ipari(95,i) > 0) THEN
4788 nbintc = nbintc + 1
4789C
4790 ierror = 0
4791C
4792 ierror1 = 0
4793 ALLOCATE(nmnsi(i)%P(nspmd),stat=ierror1)
4794 ierror = ierror + ierror1
4795C
4796 ALLOCATE(nmnfi(i)%P(nspmd),stat=ierror1)
4797 ierror = ierror + ierror1
4798 IF(ierror/=0) THEN
4799 CALL ancmsg(msgid=20,anmode=aninfo)
4800 CALL arret(2)
4801 ENDIF
4802 CALL read_i_c(nmnsi(i)%P(1),nspmd)
4803 CALL read_i_c(nmnfi(i)%P(1),nspmd)
4804 lens = 0
4805 lenr = 0
4806 DO p = 1, nspmd
4807 lens = lens + nmnsi(i)%P(p)
4808 lenr = lenr + nmnfi(i)%P(p)
4809 END DO
4810C
4811 ierror = 0
4812C
4813 ierror1 = 0
4814 IF(lens>0) THEN
4815 ALLOCATE(nmvsi(i)%P(lens),stat=ierror1)
4816 CALL read_i_c(nmvsi(i)%P(1),lens)
4817 ierror = ierror + ierror1
4818
4819 ALLOCATE(tempnod(i)%P(lens),stat=ierror1)
4820 CALL read_i_c(tempnod(i)%P(1),lens)
4821 ierror = ierror + ierror1
4822
4823 ENDIF
4824C
4825 IF(lenr>0) THEN
4826 ALLOCATE(nmvfi(i)%P(lenr),stat=ierror1)
4827 ierror = ierror + ierror1
4828
4829 IF(ierror/=0) THEN
4830 CALL ancmsg(msgid=20,anmode=aninfo)
4831 CALL arret(2)
4832 ENDIF
4833
4834 CALL read_i_c(nmvfi(i)%P(1),lenr)
4835
4836 IF(ipari(95,i) > 0) THEN
4837 ALLOCATE(tagncontfi(i)%P(lenr),stat=ierror1)
4838 DO j = 1, lenr
4839 tagncontfi(i)%P(j)=0
4840 END DO
4841 ENDIF
4842
4843 IF(ipari(48,i) /= 0 )THEN
4844 IF(iparit==0) THEN
4845 ALLOCATE(fthefi(i)%P(lenr*nthread),stat=ierror1)
4846 ierror = ierror + ierror1
4847
4848 fthefi(i)%P(1:lenr*nthread)=zero
4849 ELSE
4850 lskyfi = lenr * multimax
4851 ALLOCATE(iskyfi(i)%P(lskyfi),stat=ierror1)
4852 ierror = ierror + ierror1
4853 ALLOCATE(ftheskyfi(i)%P(lskyfi),stat=ierror1)
4854 ierror = ierror + ierror1
4855 iskyfi(i)%P(1:lskyfi)=0
4856 ftheskyfi(i)%P(1:lskyfi)=zero
4857 ENDIF
4858 ENDIF
4859
4860 ENDIF
4861C
4862
4863 ENDIF
4864 ENDIF
4865 ENDDO
4866C allocation buffer echanges => remplace par alloc dynamique ds les echanges
4867 ENDIF
4868C
4869
4870 ELSE
4871C iflag = 2 lecture partie reelle
4872 IF(ninter/=0) THEN
4873 DO i =1, ninter
4874 ityp = ipari(7,i)
4875 ivis2 = ipari(14,i) ! ivis2==-1 : Flag for interface adhesion
4876 igap = ipari(21,i)
4877 inacti = ipari(22,i)
4878 intth = ipari(47,i)
4879 IF(ityp==7.OR.ityp==10.OR.ityp==11.OR.
4880 + (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
4881 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
4882 + ityp==25)THEN
4883 lenr = 0
4884 DO p = 1, nspmd
4885 lenr = lenr + nsnfi(i)%P(p)
4886 END DO
4887 IF(lenr>0) THEN
4888 IF(ityp==7.OR.ityp==22.OR.ityp==23.OR.
4889 + ityp==20.OR.ityp==10.OR.ityp==24.OR.
4890 + ityp==25)THEN
4891 CALL read_db(msfi(i)%P(1),lenr)
4892 CALL read_db(stifi(i)%P(1),lenr)
4893 IF(igap/=0)THEN
4894 CALL read_db(gapfi(i)%P(1),lenr)
4895 IF(igap==3)THEN
4896 CALL read_db(gap_lfi(i)%P(1),lenr)
4897 END IF
4898 END IF
4899 CALL read_db(xfi(i)%P(1,1),3*lenr)
4900 CALL read_db(vfi(i)%P(1,1),3*lenr)
4901C
4902 IF((ityp == 7.OR.ityp == 20.OR.
4903 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
4904 + ityp==25).AND.ipari(47,i) > 0) THEN
4905 CALL read_db(tempfi(i)%P(1),lenr)
4906 ENDIF
4907 IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
4908 CALL read_db(areasfi(i)%P(1),lenr)
4909 ENDIF
4910 IF(ityp == 25.AND.ivis2==-1) THEN
4911 CALL read_i_c(if_adhfi(i)%P(1),lenr)
4912 ENDIF
4913
4914
4915C
4916 ELSEIF(ityp==11) THEN
4917 CALL read_db(msfi(i)%P(1),2*lenr)
4918 CALL read_db(stifi(i)%P(1),lenr)
4919 IF(igap/=0)THEN
4920 CALL read_db(gapfi(i)%P(1),lenr)
4921 IF(igap==3)THEN
4922 CALL read_db(gap_lfi(i)%P(1),lenr)
4923 END IF
4924 END IF
4925 CALL read_db(xfi(i)%P(1,1),3*2*lenr)
4926 CALL read_db(vfi(i)%P(1,1),3*2*lenr)
4927 IF(inacti==5.OR.inacti==6) THEN
4928 CALL read_db(penfi(i)%P(1,1),2*lenr)
4929 END IF
4930 IF(ipari(47,i)>0) THEN
4931 CALL read_db(tempfi(i)%P(1),2*lenr)
4932 CALL read_db(areasfi(i)%P(1),lenr)
4933 ENDIF
4934 ELSEIF(ityp==17.AND.ipari(33,i)==0)THEN
4935 CALL read_db(xfi17(i)%P(1,1,1),3*16*lenr)
4936 CALL read_db(vfi17(i)%P(1,1,1),3*16*lenr)
4937 CALL read_db(frotsfi(i)%P(1,1),7*lenr)
4938 CALL read_db(ksfi(i)%P(1,1),2*lenr)
4939 CALL read_db(eminxfi(i)%P(1,1),6*lenr)
4940 END IF
4941 END IF
4942 END IF
4943C Int 20 specifique
4944 IF(ityp==20)THEN
4945C rajout ancrage
4946 IF(lenr>0) THEN
4947 CALL read_db(daanc6fi(i)%P(1,1,1),3*6*lenr)
4948 CALL read_db(dxancfi(i)%P(1,1),3*lenr)
4949 CALL read_db(dvancfi(i)%P(1,1),3*lenr)
4950 IF(inacti==5.OR.inacti==6) THEN
4951 CALL read_db(penfi(i)%P(1,1),2*lenr)
4952 CALL read_db(penfia(i)%P(1,1),5*lenr)
4953 END IF
4954 CALL read_db(daancfi(i)%P(1,1),3*lenr)
4955 CALL read_db(alphakfi(i)%P(1),lenr)
4956 IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
4957 CALL read_db(diag_smsfi(i)%P(1),lenr)
4958 ENDIF
4959 END IF
4960C rajout partie edge
4961 lenr = 0
4962 DO p = 1, nspmd
4963 lenr = lenr + nsnfie(i)%P(p)
4964 END DO
4965 IF(lenr>0) THEN
4966 CALL read_db(msfie(i)%P(1),2*lenr)
4967 CALL read_db(stifie(i)%P(1),lenr)
4968 IF(igap/=0)THEN
4969 CALL read_db(gapfie(i)%P(1),lenr)
4970 END IF
4971 CALL read_db(xfie(i)%P(1,1),3*2*lenr)
4972 CALL read_db(vfie(i)%P(1,1),3*2*lenr)
4973 IF(inacti==5.OR.inacti==6) THEN
4974 CALL read_db(penfie(i)%P(1,1),2*lenr)
4975 CALL read_db(penfiae(i)%P(1,1),5*2*lenr)
4976 END IF
4977 CALL read_db(daanc6fie(i)%P(1,1,1),3*6*2*lenr)
4978 CALL read_db(dxancfie(i)%P(1,1),3*2*lenr)
4979 CALL read_db(dvancfie(i)%P(1,1),3*2*lenr)
4980 IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
4981 CALL read_db(diag_smsfie(i)%P(1),lenr)
4982 ENDIF
4983 END IF
4984 END IF ! fin partie type 20 edge
4985 IF (ityp==24)THEN
4986 CALL read_db(time_sfi(i)%P(1),lenr)
4987 ELSEIF(ityp==25)THEN
4988 CALL read_db(time_sfi(i)%P(1),2*lenr)
4989 END IF
4990 IF (ityp==24.OR.ityp==25)THEN
4991 CALL read_db(secnd_frfi(i)%P(1,1),6*lenr)
4992 CALL read_db(pene_oldfi(i)%P(1,1),5*lenr)
4993 CALL read_db(stif_oldfi(i)%P(1,1),2*lenr)
4994 IF(ipari(97,i) > 0) THEN
4995 CALL read_db(stif_msdt_fi(i)%P(1),lenr) ! stif based on mass and dt
4996 ENDIF
4997 IF(ityp==25.AND.parameters%INTCAREA > 0.AND.ipari(36,i)>0) THEN
4998 CALL read_db(intareanfi(i)%P(1),lenr) ! Area of secondary node
4999 ENDIF
5000 IF(ityp==24.AND.parameters%INTCAREA > 0) THEN
5001 CALL read_db(intareanfi(i)%P(1),lenr) ! Area of secondary node
5002 ENDIF
5003 ENDIF ! fin partie type 24 & 25
5004C
5005 IF (ityp==24) THEN
5006 IF(idtmins_old == 2) THEN
5007 ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
5008 ierror = ierror + ierror1
5009 CALL read_db(t2fac_sms_fi(i)%P(1),lenr)
5010 ELSEIF(idtmins_int_old /= 0) THEN
5011 ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
5012 ierror = ierror + ierror1
5013 CALL read_db(t2fac_sms_fi(i)%P(1),lenr)
5014 ENDIF
5015C
5016 IF(idtmins==2) THEN
5017 IF(.NOT.ASSOCIATED(t2fac_sms_fi(i)%P)) THEN
5018 ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
5019 ierror = ierror + ierror1
5020 t2fac_sms_fi(i)%P(1:lenr)=0
5021 ENDIF
5022 ELSEIF(idtmins_int /= 0) THEN
5023 IF(.NOT.ASSOCIATED(t2fac_sms_fi(i)%P)) THEN
5024 ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
5025 ierror = ierror + ierror1
5026 t2fac_sms_fi(i)%P(1:lenr)=0
5027 ENDIF
5028 END IF
5029 ENDIF
5030
5031 IF(ityp == 25 ) THEN
5032 IF(ipari(58,i) /=0) THEN !E2E
5033 lenr = 0
5034 DO p = 1, nspmd
5035 lenr = lenr + nsnfie(i)%P(p)
5036 END DO
5037 IF(lenr>0) THEN
5038 CALL read_db(xfie(i)%P(1,1),3*(lenr*2))
5039 CALL read_db(vfie(i)%P(1,1),3*(lenr*2))
5040 CALL read_db(msfie(i)%P(1),lenr*2)
5041 CALL read_db(stifie(i)%P(1),lenr)
5042 CALL read_db(gapfie(i)%P(1),lenr)
5043 IF( igap == 3) THEN
5044 CALL read_db(gape_l_fie(i)%P,lenr)
5045 ENDIF
5046 CALL read_r_c(edg_bisector_fie(i)%P(1,1,1),3*3*lenr)
5047 CALL read_r_c(vtx_bisector_fie(i)%P(1,1,1),3*4*lenr)
5048 CALL read_db(x_seg_fie(i)%P(1,1,1),3*4*lenr)
5049 IF(idtmins_old == 2) THEN
5050 ALLOCATE(nodnxfie(i)%P(lenr*2))
5051 CALL read_i_c(nodnxfie(i)%P(1),lenr*2)
5052 ALLOCATE(nodamsfie(i)%P(lenr*2))
5053 CALL read_i_c(nodamsfie(i)%P(1),lenr*2)
5054 ALLOCATE(procamsfie(i)%P(lenr*2))
5055 CALL read_i_c(procamsfie(i)%P(1),lenr*2)
5056 ELSEIF(idtmins_int_old /= 0) THEN
5057 ALLOCATE(nodamsfie(i)%P(lenr*2))
5058 CALL read_i_c(nodamsfie(i)%P(1),lenr*2)
5059 ALLOCATE(procamsfie(i)%P(lenr*2))
5060 CALL read_i_c(procamsfie(i)%P(1),lenr*2)
5061 ENDIF
5062
5063 IF(ipari(97,i) > 0) THEN
5064 CALL read_db(stife_msdt_fi(i)%P(1),lenr)
5065 ENDIF
5066 ENDIF
5067 ENDIF
5068 ENDIF
5069
5070 IF(ityp==21) THEN
5071C
5072 IF(intth==2) THEN
5073C
5074 lenr = 0
5075 DO p = 1, nspmd
5076 lenr = lenr + nmnfi(i)%P(p)
5077 END DO
5078C
5079 ierror = 0
5080C
5081 ierror1 = 0
5082C
5083 IF(lenr>0) THEN
5084 ALLOCATE(nmtemp(i)%P(lenr),stat=ierror1)
5085 ierror = ierror + ierror1
5086 CALL read_db(nmtemp(i)%P(1),lenr)
5087 ENDIF
5088 IF(ierror/=0) THEN
5089 CALL ancmsg(msgid=20,anmode=aninfo)
5090 CALL arret(2)
5091 ENDIF
5092 ENDIF
5093 ENDIF
5094C
5095 END DO
5096 END IF
5097 END IF
5098C
5099 RETURN
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
intstamp_glob_mod::nmvsi
type(int_pointer), dimension(:), allocatable nmvsi
Definition intstamp_glob_mod.F:73
intstamp_glob_mod::nmnsi
type(int_pointer), dimension(:), allocatable nmnsi
Definition intstamp_glob_mod.F:73
intstamp_glob_mod::nmvfi
type(int_pointer), dimension(:), allocatable nmvfi
Definition intstamp_glob_mod.F:73
intstamp_glob_mod::nmnfi
type(int_pointer), dimension(:), allocatable nmnfi
Definition intstamp_glob_mod.F:73
intstamp_glob_mod::nmtemp
type(real_pointer), dimension(:), allocatable nmtemp
Definition intstamp_glob_mod.F:76
intstamp_glob_mod::tempnod
type(int_pointer), dimension(:), allocatable tempnod
Definition intstamp_glob_mod.F:73
tri25ebox::nisubsfie
type(int_pointer), dimension(:), allocatable nisubsfie
Definition tri25ebox.F:101
tri25ebox::inflg_subsfie
type(int_pointer), dimension(:), allocatable inflg_subsfie
Definition tri25ebox.F:109
tri25ebox::gape_l_fie
type(real_pointer), dimension(:), allocatable gape_l_fie
Definition tri25ebox.F:86
tri25ebox::lisubsfie
type(int_pointer), dimension(:), allocatable lisubsfie
Definition tri25ebox.F:105
tri25ebox::edg_bisector_fie
type(real4_pointer3), dimension(:), allocatable edg_bisector_fie
Definition tri25ebox.F:83
tri25ebox::vtx_bisector_fie
type(real4_pointer3), dimension(:), allocatable vtx_bisector_fie
Definition tri25ebox.F:84
tri25ebox::addsubsfie
type(int_pointer), dimension(:), allocatable addsubsfie
Definition tri25ebox.F:113
tri25ebox::x_seg_fie
type(real_pointer3), dimension(:), allocatable x_seg_fie
Definition tri25ebox.F:85
tri25ebox::edge_fi
type(int_pointer), dimension(:), allocatable edge_fi
Definition tri25ebox.F:67
tri25ebox::ledge_fie
type(int_pointer2), dimension(:), allocatable ledge_fie
Definition tri25ebox.F:88
tri7box::ispt2_fi
type(int_pointer), dimension(:), allocatable ispt2_fi
Definition tri7box.F:538
tri7box::stif_oldfi
type(real_pointer2), dimension(:), allocatable stif_oldfi
Definition tri7box.F:545
tri7box::dxancfi
type(real_pointer2), dimension(:), allocatable dxancfi
Definition tri7box.F:473
tri7box::stnfi17
type(real_pointer2), dimension(:), allocatable stnfi17
Definition tri7box.F:467
tri7box::gapfie
type(real_pointer), dimension(:), allocatable gapfie
Definition tri7box.F:449
tri7box::eminxfi
type(real_pointer2), dimension(:), allocatable eminxfi
Definition tri7box.F:467
tri7box::secnd_frfi
type(real_pointer2), dimension(:), allocatable secnd_frfi
Definition tri7box.F:543
tri7box::stif_msdt_fi
type(real_pointer), dimension(:), allocatable stif_msdt_fi
Definition tri7box.F:552
tri7box::condnfi
type(real_pointer), dimension(:), allocatable condnfi
Definition tri7box.F:449
tri7box::is2pt_fi
type(int_pointer), dimension(:), allocatable is2pt_fi
Definition tri7box.F:537
tri7box::inflg_subsfi
type(int_pointer), dimension(:), allocatable inflg_subsfi
Definition tri7box.F:505
tri7box::iskew_fi
type(int_pointer), dimension(:), allocatable iskew_fi
Definition tri7box.F:550
tri7box::ftheskyfi
type(real_pointer), dimension(:), allocatable ftheskyfi
Definition tri7box.F:449
tri7box::isegpt_fi
type(int_pointer), dimension(:), allocatable isegpt_fi
Definition tri7box.F:539
tri7box::forneqsfi
type(real_pointer2), dimension(:), allocatable forneqsfi
Definition tri7box.F:459
tri7box::vfie
type(real_pointer2), dimension(:), allocatable vfie
Definition tri7box.F:459
tri7box::time_sfi
type(real_pointer), dimension(:), allocatable time_sfi
Definition tri7box.F:542
tri7box::afi17
type(real_pointer3), dimension(:), allocatable afi17
Definition tri7box.F:470
tri7box::daancfi
type(real_pointer2), dimension(:), allocatable daancfi
Definition tri7box.F:459
tri7box::fskyfie
type(real_pointer2), dimension(:), allocatable fskyfie
Definition tri7box.F:459
tri7box::i18kafi
type(real_pointer2), dimension(:), allocatable i18kafi
Definition tri7box.F:459
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::fnconti
type(real_pointer2), dimension(:), allocatable fnconti
Definition tri7box.F:510
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::frotsfi
type(real_pointer2), dimension(:), allocatable frotsfi
Definition tri7box.F:467
tri7box::matsfi
type(int_pointer), dimension(:), allocatable matsfi
Definition tri7box.F:440
tri7box::is2se_fi
type(int_pointer2), dimension(:), allocatable is2se_fi
Definition tri7box.F:536
tri7box::ipartfric_fie
type(int_pointer), dimension(:), allocatable ipartfric_fie
Definition tri7box.F:440
tri7box::efricgfi
type(real_pointer), dimension(:), allocatable efricgfi
Definition tri7box.F:511
tri7box::dvancfi
type(real_pointer2), dimension(:), allocatable dvancfi
Definition tri7box.F:473
tri7box::tempfi
type(real_pointer), dimension(:), allocatable tempfi
Definition tri7box.F:449
tri7box::candf_si
type(int_pointer), dimension(:), allocatable candf_si
Definition tri7box.F:560
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::xfi17
type(real_pointer3), dimension(:), allocatable xfi17
Definition tri7box.F:470
tri7box::vfi17
type(real_pointer3), dimension(:), allocatable vfi17
Definition tri7box.F:470
tri7box::ksfi
type(real_pointer2), dimension(:), allocatable ksfi
Definition tri7box.F:467
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::xfie
type(real_pointer2), dimension(:), allocatable xfie
Definition tri7box.F:459
tri7box::iskyfie
type(int_pointer), dimension(:), allocatable iskyfie
Definition tri7box.F:480
tri7box::kremnor_fi
type(int_pointer), dimension(:), allocatable kremnor_fi
Definition tri7box.F:549
tri7box::gap_lfi
type(real_pointer), dimension(:), allocatable gap_lfi
Definition tri7box.F:449
tri7box::dvancfie
type(real_pointer2), dimension(:), allocatable dvancfie
Definition tri7box.F:473
tri7box::mtfi_a
type(real_pointer2), dimension(:), allocatable mtfi_a
Definition tri7box.F:459
tri7box::daanc6fi
type(r8_pointer3), dimension(:), allocatable daanc6fi
Definition tri7box.F:476
tri7box::condnskyfi
type(real_pointer), dimension(:), allocatable condnskyfi
Definition tri7box.F:449
tri7box::penfi
type(real_pointer2), dimension(:), allocatable penfi
Definition tri7box.F:459
tri7box::alphakfi
type(real_pointer), dimension(:), allocatable alphakfi
Definition tri7box.F:449
tri7box::stnfi
type(real_pointer), dimension(:), allocatable stnfi
Definition tri7box.F:449
tri7box::lisubsfi
type(int_pointer), dimension(:), allocatable lisubsfi
Definition tri7box.F:501
tri7box::irtse_fi
type(int_pointer2), dimension(:), allocatable irtse_fi
Definition tri7box.F:535
tri7box::penfia
type(real_pointer2), dimension(:), allocatable penfia
Definition tri7box.F:459
tri7box::afi
type(real_pointer2), dimension(:), allocatable afi
Definition tri7box.F:459
tri7box::nsvsie
type(int_pointer), dimension(:), allocatable nsvsie
Definition tri7box.F:485
tri7box::mtfi_pene
type(real_pointer), dimension(:), allocatable mtfi_pene
Definition tri7box.F:449
tri7box::nodamsfi
type(int_pointer), dimension(:), allocatable nodamsfi
Definition tri7box.F:440
tri7box::fskyfi
type(real_pointer2), dimension(:), allocatable fskyfi
Definition tri7box.F:459
tri7box::nisubsfi
type(int_pointer), dimension(:), allocatable nisubsfi
Definition tri7box.F:497
tri7box::remnor_fi
type(int_pointer), dimension(:), allocatable remnor_fi
Definition tri7box.F:548
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449
tri7box::pmainfi
type(int_pointer), dimension(:), allocatable pmainfi
Definition tri7box.F:435
tri7box::stnfie
type(real_pointer), dimension(:), allocatable stnfie
Definition tri7box.F:449
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::procamsfie
type(int_pointer), dimension(:), allocatable procamsfie
Definition tri7box.F:440
tri7box::nodnxfi
type(int_pointer), dimension(:), allocatable nodnxfi
Definition tri7box.F:440
tri7box::nodnxfie
type(int_pointer), dimension(:), allocatable nodnxfie
Definition tri7box.F:440
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::intareanfi
type(real_pointer), dimension(:), allocatable intareanfi
Definition tri7box.F:554
tri7box::areasfi
type(real_pointer), dimension(:), allocatable areasfi
Definition tri7box.F:449
tri7box::icodt_fi
type(int_pointer), dimension(:), allocatable icodt_fi
Definition tri7box.F:551
tri7box::iskyfi
type(int_pointer), dimension(:), allocatable iskyfi
Definition tri7box.F:480
tri7box::isedge_fi
type(int_pointer), dimension(:), allocatable isedge_fi
Definition tri7box.F:540
tri7box::afie
type(real_pointer2), dimension(:), allocatable afie
Definition tri7box.F:459
tri7box::nbinflfi
type(int_pointer), dimension(:), allocatable nbinflfi
Definition tri7box.F:440
tri7box::efricfi
type(real_pointer), dimension(:), allocatable efricfi
Definition tri7box.F:511
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::diag_smsfi
type(real_pointer), dimension(:), allocatable diag_smsfi
Definition tri7box.F:449
tri7box::vscfi
type(real_pointer), dimension(:), allocatable vscfi
Definition tri7box.F:449
tri7box::mtfi_n
type(real_pointer2), dimension(:), allocatable mtfi_n
Definition tri7box.F:459
tri7box::nsvfie
type(int_pointer), dimension(:), allocatable nsvfie
Definition tri7box.F:440
tri7box::addsubsfi
type(int_pointer), dimension(:), allocatable addsubsfi
Definition tri7box.F:509
tri7box::ipartfricsfi
type(int_pointer), dimension(:), allocatable ipartfricsfi
Definition tri7box.F:440
tri7box::nodamsfie
type(int_pointer), dimension(:), allocatable nodamsfie
Definition tri7box.F:440
tri7box::t2fac_sms_fi
type(real_pointer), dimension(:), allocatable t2fac_sms_fi
Definition tri7box.F:557
tri7box::daanc6fie
type(r8_pointer3), dimension(:), allocatable daanc6fie
Definition tri7box.F:476
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
tri7box::kinfi
type(int_pointer), dimension(:), allocatable kinfi
Definition tri7box.F:440
tri7box::vscfie
type(real_pointer), dimension(:), allocatable vscfie
Definition tri7box.F:449
tri7box::diag_smsfie
type(real_pointer), dimension(:), allocatable diag_smsfie
Definition tri7box.F:449
tri7box::alphakfie
type(real_pointer), dimension(:), allocatable alphakfie
Definition tri7box.F:449
tri7box::itafie
type(int_pointer), dimension(:), allocatable itafie
Definition tri7box.F:440
tri7box::nlskyfie
integer, dimension(:), allocatable nlskyfie
Definition tri7box.F:512
tri7box::penfie
type(real_pointer2), dimension(:), allocatable penfie
Definition tri7box.F:459
tri7box::dxancfie
type(real_pointer2), dimension(:), allocatable dxancfie
Definition tri7box.F:473
tri7box::stife_msdt_fi
type(real_pointer), dimension(:), allocatable stife_msdt_fi
Definition tri7box.F:553
tri7box::mtfi_penemin
type(real_pointer), dimension(:), allocatable mtfi_penemin
Definition tri7box.F:449
tri7box::nlskyfi
integer, dimension(:), allocatable nlskyfi
Definition tri7box.F:512
tri7box::fthefi
type(real_pointer), dimension(:), allocatable fthefi
Definition tri7box.F:449
tri7box::ftconti
type(real_pointer2), dimension(:), allocatable ftconti
Definition tri7box.F:510
tri7box::procamsfi
type(int_pointer), dimension(:), allocatable procamsfi
Definition tri7box.F:440
tri7box::islide_fi
type(int_pointer2), dimension(:), allocatable islide_fi
Definition tri7box.F:547
tri7box::pene_oldfi
type(real_pointer2), dimension(:), allocatable pene_oldfi
Definition tri7box.F:544
tri7box::icont_i_fi
type(int_pointer), dimension(:), allocatable icont_i_fi
Definition tri7box.F:532
tri7box::mtfi_v
type(real_pointer2), dimension(:), allocatable mtfi_v
Definition tri7box.F:459
tri7box::tagncontfi
type(int_pointer), dimension(:), allocatable tagncontfi
Definition tri7box.F:505
tri7box::if_adhfi
type(int_pointer), dimension(:), allocatable if_adhfi
Definition tri7box.F:440
tri7box::t2main_sms_fi
type(int_pointer2), dimension(:), allocatable t2main_sms_fi
Definition tri7box.F:558
tri7box::daancfie
type(real_pointer2), dimension(:), allocatable daancfie
Definition tri7box.F:459
tri7box::msfie
type(real_pointer), dimension(:), allocatable msfie
Definition tri7box.F:449
tri7box::itafi
type(int_pointer), dimension(:), allocatable itafi
Definition tri7box.F:440
tri7box::penfiae
type(real_pointer2), dimension(:), allocatable penfiae
Definition tri7box.F:459
read_db
subroutine read_db(a, n)
Definition read_db.F:88
read_i_c
void read_i_c(int *w, int *len)
Definition write_routtines.c:805
read_r_c
void read_r_c(float *w, int *len)
Definition write_routtines.c:756

◆ 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.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE tri7box
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER ,INTENT(IN) :: INTHEAT
50 INTEGER ,INTENT(IN) :: IDT_THERM
51 INTEGER ,INTENT(IN) :: NODADT_THERM
52 INTEGER :: NSNR, NSNROLD
53 INTEGER :: OLDNUM(*), RENUM(*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I
58C-----------------------------------------------
59C S o u r c e L i n e s
60C-----------------------------------------------
61C
62C old numbering of new candidates
63C
64 DO i = 1, nsnr
65 oldnum(i) = 0
66 END DO
67 DO i = 1, nsnrold
68 IF(renum(i)>0) ! case non-penetrated and non-retained element
69 + oldnum(renum(i)) = i
70 END DO
71C
72 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.

322C-----------------------------------------------
323C M o d u l e s
324C-----------------------------------------------
325 USE tri7box
326C-----------------------------------------------
327C I m p l i c i t T y p e s
328C-----------------------------------------------
329#include "implicit_f.inc"
330C-----------------------------------------------
331C C o m m o n B l o c k s
332C-----------------------------------------------
333#include "com01_c.inc"
334C-----------------------------------------------
335C D u m m y A r g u m e n t s
336C-----------------------------------------------
337 INTEGER NSNFIOLD(*), RENUM(*),
338 . NIN, NSN, NSNROLD
339C-----------------------------------------------
340C L o c a l V a r i a b l e s
341C-----------------------------------------------
342 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
343C-----------------------------------------------
344C S o u r c e L i n e s
345C-----------------------------------------------
346 DO i = 1, nsnrold
347 renum(i) = 0
348 END DO
349
350 ideb = 0
351 jdeb = 0
352 DO p = 1, nspmd
353 i = 1
354 j = 1
355 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
356 IF(irem(1,j+jdeb)==
357 + nsvfi(nin)%P(i+ideb)) THEN
358 renum(i+ideb) = j+jdeb
359 i = i + 1
360 j = j + 1
361 ELSEIF(irem(1,j+jdeb)<
362 + nsvfi(nin)%P(i+ideb)) THEN
363 j = j + 1
364 ELSEIF(irem(1,j+jdeb)>
365 + nsvfi(nin)%P(i+ideb)) THEN
366Case non-penetrated and non-retained candidate
367 i = i + 1
368 END IF
369 END DO
370 jdeb = jdeb + nsnfi(nin)%P(p)
371 ideb = ideb + nsnfiold(p)
372 END DO
373C
374 RETURN
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339

◆ 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.

162C-----------------------------------------------
163C M o d u l e s
164C-----------------------------------------------
165 USE tri7box
166C-----------------------------------------------
167C I m p l i c i t T y p e s
168C-----------------------------------------------
169#include "implicit_f.inc"
170C-----------------------------------------------
171C C o m m o n B l o c k s
172C-----------------------------------------------
173#include "com01_c.inc"
174C-----------------------------------------------
175C D u m m y A r g u m e n t s
176C-----------------------------------------------
177 INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
178 . NIN, NSN, NSNROLD,II_STOK
179C-----------------------------------------------
180C L o c a l V a r i a b l e s
181C-----------------------------------------------
182 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
183C-----------------------------------------------
184C S o u r c e L i n e s
185C-----------------------------------------------
186 DO i = 1, nsnrold
187 renum(i) = 0
188 END DO
189 i_stok = ii_stok
190 ideb = 0
191 jdeb = 0
192 DO p = 1, nspmd
193 i = 1
194 j = 1
195 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
196 IF(irem(1,j+jdeb)==
197 + nsvfi(nin)%P(i+ideb)) THEN
198 renum(i+ideb) = j+jdeb
199 i = i + 1
200 j = j + 1
201 ELSEIF(irem(1,j+jdeb)<
202 + nsvfi(nin)%P(i+ideb)) THEN
203 j = j + 1
204 ELSEIF(irem(1,j+jdeb)>
205 + nsvfi(nin)%P(i+ideb)) THEN
206Case non-penetrated and non-retained candidate
207 i = i + 1
208 END IF
209 END DO
210 jdeb = jdeb + nsnfi(nin)%P(p)
211 ideb = ideb + nsnfiold(p)
212 END DO
213C
214C renumbering of old candidates according to new numbers
215C
216 DO i = 1, i_stok
217 ni = cand_n(i)
218 IF(ni>nsn) THEN
219 ni = ni - nsn
220 cand_n(i) = renum(ni) + nsn
221 END IF
222
223 END DO
224C
225 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.

239C-----------------------------------------------
240C M o d u l e s
241C-----------------------------------------------
242 USE tri7box
243C-----------------------------------------------
244C I m p l i c i t T y p e s
245C-----------------------------------------------
246#include "implicit_f.inc"
247C-----------------------------------------------
248C C o m m o n B l o c k s
249C-----------------------------------------------
250#include "com01_c.inc"
251C-----------------------------------------------
252C D u m m y A r g u m e n t s
253C-----------------------------------------------
254 INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
255 . NIN, NSN, NSNROLD,II_STOK
256C-----------------------------------------------
257C L o c a l V a r i a b l e s
258C-----------------------------------------------
259 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
260C-----------------------------------------------
261C S o u r c e L i n e s
262C-----------------------------------------------
263 LOGICAL ISFOUND
264 DO i = 1, nsnrold
265 renum(i) = 0
266 END DO
267 i_stok = ii_stok
268 ideb = 0
269 jdeb = 0
270 isfound = .false.
271 DO p = 1, nspmd
272 i = 1
273 j = 1
274 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
275
276 IF(irem(1,j+jdeb)==
277 + nsvfi(nin)%P(i+ideb)) THEN
278 renum(i+ideb) = j+jdeb
279 i = i + 1
280 j = j + 1
281 ELSEIF(irem(1,j+jdeb)<
282 + nsvfi(nin)%P(i+ideb)) THEN
283 j = j + 1
284 ELSEIF(irem(1,j+jdeb)>
285 + nsvfi(nin)%P(i+ideb)) THEN
286Case non-penetrated and non-retained candidate
287 i = i + 1
288 END IF
289 END DO
290
291 jdeb = jdeb + nsnfi(nin)%P(p)
292 ideb = ideb + nsnfiold(p)
293 END DO
294C
295C renumbering of old candidates according to new numbers
296C
297 DO i = 1, i_stok
298 ni = cand_n(i)
299 IF(ni>nsn) THEN
300 ni = ni - nsn
301 IF(renum(ni) > 0) THEN
302 cand_n(i) = renum(ni) + nsn
303 ELSE
304 cand_n(i) = 0 ! NSN + 1
305 WRITE(6,*) "possible p/on issue for",
306 . "/INTER/TYPE10 bouncing node",itafi(nin)%P(ni)
307 ENDIF
308 END IF
309 END DO
310C
311 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.

387C-----------------------------------------------
388C M o d u l e s
389C-----------------------------------------------
390 USE tri7box
391C-----------------------------------------------
392C I m p l i c i t T y p e s
393C-----------------------------------------------
394#include "implicit_f.inc"
395C-----------------------------------------------
396C C o m m o n B l o c k s
397C-----------------------------------------------
398#include "com01_c.inc"
399C-----------------------------------------------
400C D u m m y A r g u m e n t s
401C-----------------------------------------------
402 INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
403 . NIN, NRTS, NSNROLD,ADDCM(*),CHAINE(2,*),
404 . CAND_M(*),NSN4,NRTM,II_STOK
405C-----------------------------------------------
406C L o c a l V a r i a b l e s
407C-----------------------------------------------
408 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI, IAD,IADM1
409C-----------------------------------------------
410C S o u r c e L i n e s
411C-----------------------------------------------
412 DO i = 1, nsnrold
413 renum(i) = 0
414 END DO
415 i_stok = ii_stok
416 ideb = 0
417 jdeb = 0
418 DO p = 1, nspmd
419 i = 1
420 j = 1
421 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
422 IF(irem(1,j+jdeb)==
423 + nsvfi(nin)%P(i+ideb)) THEN
424 renum(i+ideb) = j+jdeb
425 i = i + 1
426 j = j + 1
427 ELSEIF(irem(1,j+jdeb)<
428 + nsvfi(nin)%P(i+ideb)) THEN
429 j = j + 1
430 ELSEIF(irem(1,j+jdeb)>
431 + nsvfi(nin)%P(i+ideb)) THEN
432Case non-penetrated and non-retained candidate
433 i = i + 1
434 END IF
435 END DO
436 jdeb = jdeb + nsnfi(nin)%P(p)
437 ideb = ideb + nsnfiold(p)
438 END DO
439C
440C renumbering of old candidates according to new numbers
441C
442 DO i = 1, i_stok
443 ni = cand_n(i)
444 IF(ni>nrts) THEN
445 ni = ni - nrts
446 cand_n(i) = renum(ni) + nrts
447 END IF
448 END DO
449 DO i=1,nrtm
450 j=0
451 iad = addcm(i)
452 DO WHILE(iad>0.AND.j<nsn4)
453 j=j+1
454 IF(chaine(1,iad) > nrts )THEN
455 chaine(1,iad) = renum(chaine(1,iad)-nrts)+nrts
456 ENDIF
457 iad=chaine(2,iad)
458 ENDDO
459 ENDDO
460C
461 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.

85C-----------------------------------------------
86C M o d u l e s
87C-----------------------------------------------
88 USE tri7box
89C-----------------------------------------------
90C I m p l i c i t T y p e s
91C-----------------------------------------------
92#include "implicit_f.inc"
93C-----------------------------------------------
94C C o m m o n B l o c k s
95C-----------------------------------------------
96#include "com01_c.inc"
97C-----------------------------------------------
98C D u m m y A r g u m e n t s
99C-----------------------------------------------
100 INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
101 . NIN, NSN, NSNROLD,II_STOK
102C-----------------------------------------------
103C L o c a l V a r i a b l e s
104C-----------------------------------------------
105 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
106C-----------------------------------------------
107C S o u r c e L i n e s
108C-----------------------------------------------
109 DO i = 1, nsnrold
110 renum(i) = 0
111 END DO
112 i_stok = ii_stok
113 ideb = 0
114 jdeb = 0
115 DO p = 1, nspmd
116 i = 1
117 j = 1
118 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
119 IF(nint(xrem(4,j+jdeb))==
120 + nsvfi(nin)%P(i+ideb)) THEN
121 renum(i+ideb) = j+jdeb
122 i = i + 1
123 j = j + 1
124 ELSEIF(nint(xrem(4,j+jdeb))<
125 + nsvfi(nin)%P(i+ideb)) THEN
126 j = j + 1
127 ELSEIF(nint(xrem(4,j+jdeb))>
128 + nsvfi(nin)%P(i+ideb)) THEN
129Case non-penetrated and non-retained candidate
130 i = i + 1
131 END IF
132 END DO
133 jdeb = jdeb + nsnfi(nin)%P(p)
134 ideb = ideb + nsnfiold(p)
135 END DO
136C
137C renumbering of old candidates according to new numbers
138C
139 DO i = 1, i_stok
140 ni = cand_n(i)
141 IF(ni>nsn) THEN
142 ni = ni - nsn
143 cand_n(i) = renum(ni) + nsn
144 END IF
145 END DO
146C
147 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 5119 of file spmd_i7tool.F.

5120C-----------------------------------------------
5121C M o d u l e s
5122C-----------------------------------------------
5123 USE tri7box
5124 USE tri25ebox
5125 USE intbufdef_mod
5126 USE intstamp_glob_mod
5127 USE interface_modification_mod
5128 USE sensor_mod
5129 USE parameters_mod
5130C-----------------------------------------------
5131C I m p l i c i t T y p e s
5132C-----------------------------------------------
5133#include "implicit_f.inc"
5134C-----------------------------------------------
5135C C o m m o n B l o c k s
5136C-----------------------------------------------
5137#include "com01_c.inc"
5138#include "com04_c.inc"
5139#include "com08_c.inc"
5140#include "param_c.inc"
5141#include "sms_c.inc"
5142C-----------------------------------------------
5143C D u m m y A r g u m e n t s
5144C-----------------------------------------------
5145 INTEGER ,INTENT(IN) :: NSENSOR
5146 INTEGER IPARI(NPARI,*), IFLAG
5147 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
5148 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
5149 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
5150C-----------------------------------------------
5151C L o c a l V a r i a b l e s
5152C-----------------------------------------------
5153 INTEGER I, P, NSN, NMN, ITYP, IGAP, LENS, LENR, MULTIMP,
5154 . INACTI, LSKYFI, LENI,INTTH,IEDGE4, IVIS2, INTNITSCHE
5155 INTEGER INTERACT,ISENS
5156 my_real ts,startt,stopt
5157 INTEGER, DIMENSION(NSPMD) :: SAVE_NSNFI,SAVE_NSNSI
5158C-----------------------------------------------
5159C S o u r c e L i n e s
5160C-----------------------------------------------
5161C Global init of variable
5162 iedge4=0
5163C
5164C Sauvegarde Structure interfaces sur restart
5165C
5166 IF(iflag==1) THEN
5167 IF(ninter/=0) THEN
5168C ecriture strutures interfaces sur fichier restart (partie entiere)
5169 DO i =1, ninter
5170 ityp = ipari(7,i)
5171 IF(ityp==7.OR.
5172 + ityp==10.OR.ityp==11.OR.
5173 + (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
5174 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
5175 + ityp==25)THEN
5176
5177C Issue : Restarts + INACTI + TSTART when Start timee was not reached before Restart
5178 interact = 1
5179
5180 save_nsnfi(1:nspmd) = nsnfi(i)%P(1:nspmd)
5181 save_nsnsi(1:nspmd) = nsnsi(i)%P(1:nspmd)
5182
5183 inacti=ipari(22,i)
5184 IF (inacti==5.OR.inacti==6.OR.inacti==7.OR.ityp==23.OR.inacti==-1)THEN
5185C
5186 isens = 0
5187 IF(ityp == 7.OR.ityp == 11.OR.ityp == 24) ! All but ITYP == 25
5188 . isens = ipari(64,i)
5189 IF (isens > 0) THEN
5190 ts = sensor_tab(isens)%TSTART
5191 IF (ts>tt) interact = 0
5192 ELSE
5193 startt = intbuf_tab(i)%VARIABLES(3)
5194 stopt = intbuf_tab(i)%VARIABLES(11)
5195 IF (startt>tt) interact = 0
5196 ENDIF
5197 ENDIF
5198 IF((interact == 0 .OR. nsnfi_flag(i)==1).AND.ityp/=25) THEN
5199 nsnfi(i)%P(1:nspmd) = nsnfi_sav(i)%P(1:nspmd)
5200 nsnsi(i)%P(1:nspmd) = nsnsi_sav(i)%P(1:nspmd)
5201
5202 nsnfi_sav(i)%P(1:nspmd) = save_nsnfi(1:nspmd)
5203 nsnsi_sav(i)%P(1:nspmd) = save_nsnsi(1:nspmd)
5204 ENDIF
5205
5206 IF(ityp==24)THEN
5207 iedge4=ipari(59,i)
5208 ELSE
5209 iedge4=0
5210 ENDIF
5211 intnitsche=ipari(86,i)
5212
5213 lens = 0
5214 lenr = 0
5215 DO p = 1, nspmd
5216 lens = lens + nsnsi(i)%P(p)
5217 lenr = lenr + nsnfi(i)%P(p)
5218 END DO
5219C
5220 CALL write_i_c(nsnsi(i)%P(1),nspmd)
5221 CALL write_i_c(nsnfi(i)%P(1),nspmd)
5222
5223 IF (lens>0)
5224 . CALL write_i_c(nsvsi(i)%P(1),lens)
5225C
5226 IF (lenr>0) THEN
5227 CALL write_i_c(nsvfi(i)%P(1),lenr)
5228 IF(ityp==7.OR.ityp==20.OR.ityp==22.OR.
5229 + ityp==23.OR.ityp==24.OR.ityp==25) THEN
5230 CALL write_i_c(itafi(i)%P(1),lenr)
5231 CALL write_i_c(kinfi(i)%P(1),lenr)
5232 IF(ityp==20)THEN
5233 CALL write_i_c(nbinflfi(i)%P(1),lenr)
5234 END IF
5235C
5236 IF(ipari(47,i) > 0)CALL write_i_c(matsfi(i)%P(1),lenr)
5237C
5238 IF((ityp == 7.OR.ityp == 24.OR.ityp == 25).AND.ipari(72,i) > 0) THEN
5239 CALL write_i_c(ipartfricsfi(i)%P(1),lenr)
5240 ENDIF
5241C
5242 IF (ityp==24)THEN
5243 CALL write_i_c(irtlm_fi(i)%P(1,1),2*lenr)
5244 CALL write_i_c(icont_i_fi(i)%P(1),lenr)
5245C E2E Arrays
5246 CALL write_i_c(isedge_fi(i)%P(1),lenr)
5247
5248 IF(iedge4>0)THEN
5249 CALL write_i_c(irtse_fi(i)%P(1,1),5*lenr)
5250 CALL write_i_c(is2pt_fi(i)%P(1),lenr)
5251 CALL write_i_c(ispt2_fi(i)%P(1),lenr)
5252 CALL write_i_c(isegpt_fi(i)%P(1),lenr)
5253 CALL write_i_c(is2se_fi(i)%P(1,1),2*lenr)
5254 ENDIF
5255 IF(intnitsche > 0) CALL write_i_c(forneqsfi(i)%P(1,1),3*lenr)
5256
5257 ENDIF
5258C
5259 IF (ityp==25)THEN
5260 CALL write_i_c(pmainfi(i)%P(1),lenr)
5261 CALL write_i_c(irtlm_fi(i)%P(1,1),4*lenr)
5262 CALL write_i_c(icont_i_fi(i)%P(1),lenr)
5263C Not added to rst files
5264C CALL WRITE_I_C(ICODT_FI(I)%P(1),LENR)
5265C CALL WRITE_I_C(ISKEW_FI(I)%P(1),LENR)
5266
5267C Remove banned main segment
5268 IF(ipari(63,i)==2) THEN
5269 CALL write_i_c(kremnor_fi(i)%P(1),lenr+1)
5270 IF(kremnor_fi(i)%P(lenr+1)/=0) THEN
5271 CALL write_i_c(remnor_fi(i)%P(1),kremnor_fi(i)%P(lenr+1))
5272 ENDIF
5273 ENDIF
5274 ENDIF
5275C
5276 IF(idtmins==2)THEN
5277 CALL write_i_c(nodnxfi(i)%P(1),lenr)
5278 CALL write_i_c(nodamsfi(i)%P(1),lenr)
5279 CALL write_i_c(procamsfi(i)%P(1),lenr)
5280 IF (ityp==24) CALL write_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
5281 ELSEIF(idtmins_int/=0)THEN
5282 CALL write_i_c(nodamsfi(i)%P(1),lenr)
5283 CALL write_i_c(procamsfi(i)%P(1),lenr)
5284 IF (ityp==24) CALL write_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
5285 END IF
5286C
5287 ELSEIF(ityp==10) THEN
5288 CALL write_i_c(itafi(i)%P(1),lenr)
5289C
5290 IF(idtmins==2)THEN
5291 CALL write_i_c(nodnxfi(i)%P(1),lenr)
5292 CALL write_i_c(nodamsfi(i)%P(1),lenr)
5293 CALL write_i_c(procamsfi(i)%P(1),lenr)
5294 ELSEIF(idtmins_int/=0)THEN
5295 CALL write_i_c(nodamsfi(i)%P(1),lenr)
5296 CALL write_i_c(procamsfi(i)%P(1),lenr)
5297 END IF
5298C
5299 ELSEIF(ityp==11) THEN
5300 CALL write_i_c(itafi(i)%P(1),2*lenr)
5301C
5302 IF(idtmins==2)THEN
5303 CALL write_i_c(nodnxfi(i)%P(1),2*lenr)
5304 CALL write_i_c(nodamsfi(i)%P(1),2*lenr)
5305 CALL write_i_c(procamsfi(i)%P(1),2*lenr)
5306 ELSEIF(idtmins_int/=0)THEN
5307 CALL write_i_c(nodamsfi(i)%P(1),2*lenr)
5308 CALL write_i_c(procamsfi(i)%P(1),2*lenr)
5309 END IF
5310C
5311 IF(ipari(47,i) > 0) CALL write_i_c(matsfi(i)%P(1),lenr)
5312C
5313 IF(ipari(72,i) > 0) CALL write_i_c(ipartfricsfi(i)%P(1),lenr)
5314C
5315 ELSEIF(ityp==17)THEN
5316 END IF
5317 END IF
5318C type20 edge
5319 IF(ityp==20)THEN
5320 lens = 0
5321 lenr = 0
5322 DO p = 1, nspmd
5323 lens = lens + nsnsie(i)%P(p)
5324 lenr = lenr + nsnfie(i)%P(p)
5325 END DO
5326C
5327 CALL write_i_c(nsnsie(i)%P(1),nspmd)
5328 CALL write_i_c(nsnfie(i)%P(1),nspmd)
5329 IF (lens>0)
5330 . CALL write_i_c(nsvsie(i)%P(1),lens)
5331C
5332 IF (lenr>0) THEN
5333 CALL write_i_c(nsvfie(i)%P(1),lenr)
5334 CALL write_i_c(itafie(i)%P(1),2*lenr)
5335 END IF
5336C
5337 IF(idtmins==2)THEN
5338 CALL write_i_c(nodnxfie(i)%P(1),lenr)
5339 CALL write_i_c(nodamsfie(i)%P(1),lenr)
5340 CALL write_i_c(procamsfie(i)%P(1),lenr)
5341 ELSEIF(idtmins_int/=0)THEN
5342 CALL write_i_c(nodamsfie(i)%P(1),lenr)
5343 CALL write_i_c(procamsfie(i)%P(1),lenr)
5344 END IF
5345C
5346 END IF ! Fin type 20 edge
5347
5348 IF(ityp == 25 ) THEN
5349 IF(ipari(58,i) /=0) THEN
5350 CALL write_i_c(nsnsie(i)%P(1),nspmd)
5351 CALL write_i_c(nsnfie(i)%P(1),nspmd)
5352 lens = 0
5353 lenr = 0
5354 DO p = 1, nspmd
5355 lens = lens + nsnsie(i)%P(p)
5356 lenr = lenr + nsnfie(i)%P(p)
5357 END DO
5358
5359 IF(lens>0) THEN
5360 CALL write_i_c(nsvsie(i)%P(1),lens)
5361 ENDIF
5362 IF(lenr>0) THEN
5363 CALL write_i_c(nsvfie(i)%P,lenr)
5364 CALL write_i_c(ledge_fie(i)%P,e_ledge_size*lenr)
5365 IF(ipari(72,i) > 0) CALL write_i_c(ipartfric_fie(i)%P(1),lenr)
5366 ENDIF
5367 ENDIF
5368 ENDIF
5369C
5370 IF(ipari(36,i)>0.AND.ipari(7,i)/=17) THEN
5371 CALL write_i_c(nisubsfi(i)%P(1),nspmd)
5372 leni = 0
5373 lenr = 0
5374 DO p = 1, nspmd
5375 leni = leni + nisubsfi(i)%P(p)
5376 lenr = lenr + nsnfi(i)%P(p)
5377 END DO
5378 IF(leni>0) THEN
5379 IF(lenr>0) THEN
5380 CALL write_i_c(addsubsfi(i)%P(1),lenr+1)
5381 END IF
5382 CALL write_i_c(lisubsfi(i)%P(1),leni)
5383 IF(ipari(7,i)==25.OR.ipari(7,i)==7.OR.ipari(7,i)==24.OR.ipari(7,i)==11)THEN
5384 CALL write_i_c(inflg_subsfi(i)%P(1),leni)
5385 END IF
5386 END IF
5387C =================== EDGES TO EDGE
5388C structure output sous interfaces
5389 IF(ipari(7,i) == 25 .AND. ipari(58,i) > 0) THEN
5390 CALL write_i_c(nisubsfie(i)%P(1),nspmd)
5391 leni = 0
5392 DO p = 1, nspmd
5393 leni = leni +nisubsfie(i)%P(p)
5394 END DO
5395 lenr = 0
5396 DO p = 1, nspmd
5397 lenr = lenr + nsnfie(i)%P(p)
5398 END DO
5399 IF(leni > 0 .AND. lenr > 0) THEN
5400 CALL write_i_c(addsubsfie(i)%P(1),lenr+1)
5401 ENDIF
5402 IF(leni > 0) THEN
5403 CALL write_i_c(lisubsfie(i)%P(1),leni)
5404 CALL write_i_c(inflg_subsfie(i)%P(1),leni)
5405 ENDIF
5406 ENDIF
5407 END IF
5408 END IF
5409
5410
5411C
5412C Write in RST file inter 21 structure for nodal temperature
5413C Actualisation
5414C
5415 IF(ityp==21) THEN
5416 intth = ipari(47,i)
5417C
5418 IF(intth==2.OR.ipari(95,i) > 0) THEN
5419 lens = 0
5420 lenr = 0
5421 DO p = 1, nspmd
5422 lens = lens + nmnsi(i)%P(p)
5423 lenr = lenr + nmnfi(i)%P(p)
5424 END DO
5425C
5426 CALL write_i_c(nmnsi(i)%P(1),nspmd)
5427 CALL write_i_c(nmnfi(i)%P(1),nspmd)
5428
5429 IF (lens>0) THEN
5430 CALL write_i_c(nmvsi(i)%P(1),lens)
5431 CALL write_i_c(tempnod(i)%P(1),lens)
5432 ENDIF
5433C
5434 IF (lenr>0) THEN
5435 CALL write_i_c(nmvfi(i)%P(1),lenr)
5436 ENDIF
5437 ENDIF
5438 ENDIF
5439
5440 ENDDO
5441 END IF
5442C
5443 ELSE ! WRITE REAL
5444
5445 IF(ninter/=0) THEN
5446C ecriture strutures interfaces sur fichier restart (partie reelle)
5447 DO i =1, ninter
5448 ityp = ipari(7,i)
5449 igap = ipari(21,i)
5450 inacti = ipari(22,i)
5451 ivis2 = ipari(14,i) ! ivis2==-1 : Flag for interface adhesion
5452 lenr = 0
5453 IF(ityp==7.OR.
5454 + ityp==10.OR.ityp==11.OR.
5455 + (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
5456 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
5457 + ityp==25)THEN
5458 lenr = 0
5459 DO p = 1, nspmd
5460 lenr = lenr + nsnfi(i)%P(p)
5461 END DO
5462
5463C In case deactivated Interface - Flush NSNFI back to Zero
5464C Issue : Restarts + INACTI + TSTART when Start timee was not reached before Restart
5465 interact = 1
5466
5467 isens = 0
5468 IF(ityp == 7.OR.ityp == 11.OR.ityp == 24) isens = ipari(64,i) ! All but ITYP == 25
5469
5470 IF (isens > 0) THEN ! Sensors may be deactivated w/o INACTI
5471 ts = sensor_tab(isens)%TSTART
5472 IF (ts>tt) interact = 0
5473 ENDIF
5474
5475 inacti=ipari(22,i)
5476 IF (inacti==5.OR.inacti==6.OR.inacti==7.OR.ityp==23.OR.inacti==-1)THEN
5477C
5478 isens = 0
5479 IF(ityp == 7.OR.ityp == 11.OR.ityp == 24) isens = ipari(64,i) ! All but ITYP == 25
5480 IF(isens == 0)THEN
5481 startt = intbuf_tab(i)%VARIABLES(3)
5482 stopt = intbuf_tab(i)%VARIABLES(11)
5483 IF (startt>tt) interact = 0
5484 ENDIF
5485 ENDIF
5486
5487 IF((interact == 0 .OR. nsnfi_flag(i)==1).AND.ityp/=25) THEN
5488 nsnfi(i)%P(1:nspmd) = nsnfi_sav(i)%P(1:nspmd)
5489 nsnsi(i)%P(1:nspmd) = nsnsi_sav(i)%P(1:nspmd)
5490 ENDIF
5491
5492C
5493 IF(lenr>0) THEN
5494C
5495 IF(ityp==7.OR.ityp==22.OR.ityp==23.OR.
5496 + ityp==10.OR.ityp==20.OR.ityp==24.OR.
5497 + ityp==25) THEN
5498 CALL write_db(msfi(i)%P(1),lenr)
5499 CALL write_db(stifi(i)%P(1),lenr)
5500 IF(igap/=0)CALL write_db(gapfi(i)%P(1),lenr)
5501 IF(igap==3)CALL write_db(gap_lfi(i)%P(1),lenr)
5502 CALL write_db(xfi(i)%P(1,1),3*lenr)
5503 CALL write_db(vfi(i)%P(1,1),3*lenr)
5504C
5505 IF((ityp == 7.OR.ityp == 20.OR.ityp == 22.OR.
5506 + ityp == 23.OR.ityp == 24.OR.ityp == 25).AND.
5507 + ipari(47,i)>0) THEN
5508 CALL write_db(tempfi(i)%P(1),lenr)
5509 ENDIF
5510 IF(ipari(47,i)>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
5511 CALL write_db(areasfi(i)%P(1),lenr)
5512 ENDIF
5513 IF(ityp == 25.AND.ivis2==-1) THEN
5514 CALL write_i_c(if_adhfi(i)%P(1),lenr)
5515 ENDIF
5516C
5517 ELSEIF(ityp==11)THEN
5518 CALL write_db(msfi(i)%P(1),2*lenr)
5519 CALL write_db(stifi(i)%P(1),lenr)
5520 IF(igap/=0)CALL write_db(gapfi(i)%P(1),lenr)
5521 IF(igap==3)CALL write_db(gap_lfi(i)%P(1),lenr)
5522 CALL write_db(xfi(i)%P(1,1),3*2*lenr)
5523 CALL write_db(vfi(i)%P(1,1),3*2*lenr)
5524 IF(inacti==5.OR.inacti==6)
5525 . CALL write_db(penfi(i)%P(1,1),2*lenr)
5526 IF(ipari(47,i)>0) THEN
5527 CALL write_db(tempfi(i)%P(1),2*lenr)
5528 CALL write_db(areasfi(i)%P(1),lenr)
5529 ENDIF
5530C
5531 ELSEIF(ityp==17)THEN
5532 CALL write_db(xfi17(i)%P(1,1,1),3*16*lenr)
5533 CALL write_db(vfi17(i)%P(1,1,1),3*16*lenr)
5534 CALL write_db(frotsfi(i)%P(1,1),7*lenr)
5535 CALL write_db(ksfi(i)%P(1,1),2*lenr)
5536 CALL write_db(eminxfi(i)%P(1,1),6*lenr)
5537 END IF
5538 END IF
5539 END IF
5540C type20 specifique
5541 IF(ityp==20)THEN
5542C rajout ancrage
5543 IF(lenr>0) THEN
5544 CALL write_db(daanc6fi(i)%P(1,1,1),3*6*lenr)
5545 CALL write_db(dxancfi(i)%P(1,1),3*lenr)
5546 CALL write_db(dvancfi(i)%P(1,1),3*lenr)
5547 IF(inacti==5.OR.inacti==6) THEN
5548 CALL write_db(penfi(i)%P(1,1),2*lenr)
5549 CALL write_db(penfia(i)%P(1,1),5*lenr)
5550 END IF
5551 CALL write_db(daancfi(i)%P(1,1),3*lenr)
5552 CALL write_db(alphakfi(i)%P(1),lenr)
5553 IF(idtmins > 0 .OR. idtmins_int/=0) THEN
5554 CALL write_db(diag_smsfi(i)%P(1),lenr)
5555 ENDIF
5556 END IF
5557C rajout edge
5558 lenr = 0
5559 DO p = 1, nspmd
5560 lenr = lenr + nsnfie(i)%P(p)
5561 END DO
5562C
5563 IF(lenr>0) THEN
5564 CALL write_db(msfie(i)%P(1),2*lenr)
5565 CALL write_db(stifie(i)%P(1),lenr)
5566 IF(igap/=0)CALL write_db(gapfie(i)%P(1),lenr)
5567 CALL write_db(xfie(i)%P(1,1),3*2*lenr)
5568 CALL write_db(vfie(i)%P(1,1),3*2*lenr)
5569 IF(inacti==5.OR.inacti==6) THEN
5570 CALL write_db(penfie(i)%P(1,1),2*lenr)
5571 CALL write_db(penfiae(i)%P(1,1),5*2*lenr)
5572 END IF
5573 CALL write_db(daanc6fie(i)%P(1,1,1),3*6*2*lenr)
5574 CALL write_db(dxancfie(i)%P(1,1),3*2*lenr)
5575 CALL write_db(dvancfie(i)%P(1,1),3*2*lenr)
5576 IF(idtmins > 0 .OR. idtmins_int/=0) THEN
5577 CALL write_db(diag_smsfie(i)%P(1),lenr)
5578 ENDIF
5579 END IF
5580 END IF ! fin type 20 edge
5581
5582 IF(lenr > 0) THEN
5583 IF (ityp==24)THEN
5584 CALL write_db(time_sfi(i)%P(1),lenr)
5585 ELSEIF(ityp==25)THEN
5586 CALL write_db(time_sfi(i)%P(1),2*lenr)
5587 END IF
5588 IF (ityp==24.OR.ityp==25)THEN
5589 CALL write_db(secnd_frfi(i)%P(1,1),6*lenr)
5590 CALL write_db(pene_oldfi(i)%P(1,1),5*lenr)
5591 CALL write_db(stif_oldfi(i)%P(1,1),2*lenr)
5592 IF(ipari(97,i) > 0) CALL write_db(stif_msdt_fi(i)%P(1),lenr) ! stif based on mass and dt
5593 ENDIF ! fin partie type 24 & 25
5594 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)
5595 IF(ityp==24.AND.parameters%INTCAREA > 0) CALL write_db(intareanfi(i)%P(1),lenr) ! output carea th
5596C
5597 IF (ityp==24) THEN
5598 IF(idtmins==2)THEN
5599 CALL write_db(t2fac_sms_fi(i)%P(1),lenr)
5600 ELSEIF(idtmins_int/=0)THEN
5601 CALL write_db(t2fac_sms_fi(i)%P(1),lenr)
5602 ENDIF
5603 END IF
5604 ENDIF
5605C
5606 IF(ityp == 25 ) THEN
5607 IF(ipari(58,i) /=0) THEN !E2E
5608 lenr = 0
5609 DO p = 1, nspmd
5610 lenr = lenr + nsnfie(i)%P(p)
5611 END DO
5612 IF(lenr>0) THEN
5613 CALL write_db(xfie(i)%P(1,1),3*(lenr*2))
5614 CALL write_db(vfie(i)%P(1,1),3*(lenr*2))
5615 CALL write_db(msfie(i)%P(1),lenr*2)
5616 CALL write_db(stifie(i)%P(1),lenr)
5617 CALL write_db(gapfie(i)%P(1),lenr)
5618 IF( igap == 3) THEN
5619 CALL write_db(gape_l_fie(i)%P,lenr)
5620 ENDIF
5621 CALL write_r_c(edg_bisector_fie(i)%P(1,1,1),3*3*lenr)
5622 CALL write_r_c(vtx_bisector_fie(i)%P(1,1,1),3*4*lenr)
5623 CALL write_db(x_seg_fie(i)%P(1,1,1),3*4*lenr)
5624
5625 IF(idtmins==2)THEN
5626 CALL write_i_c(nodnxfie(i)%P(1),lenr*2)
5627 CALL write_i_c(nodamsfie(i)%P(1),lenr*2)
5628 CALL write_i_c(procamsfie(i)%P(1),lenr*2)
5629 ELSEIF(idtmins_int/=0)THEN
5630 CALL write_i_c(nodamsfie(i)%P(1),lenr*2)
5631 CALL write_i_c(procamsfie(i)%P(1),lenr*2)
5632 END IF
5633
5634 IF(ipari(97,i) > 0) THEN
5635 CALL write_db(stife_msdt_fi(i)%P(1),lenr)
5636 ENDIF
5637
5638 ENDIF
5639 ENDIF
5640 ENDIF
5641
5642 IF(ityp==21) THEN
5643 intth = ipari(47,i)
5644C
5645 IF(intth==2) THEN
5646 lenr = 0
5647 DO p = 1, nspmd
5648 lenr = lenr + nmnfi(i)%P(p)
5649 END DO
5650C
5651 IF (lenr>0) THEN
5652 CALL write_db(nmtemp(i)%P(1),lenr)
5653 ENDIF
5654 ENDIF
5655 ENDIF
5656C
5657 END DO
5658 END IF
5659 ENDIF
5660C
5661 RETURN
write_db
subroutine write_db(a, n)
Definition write_db.F:140
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519

◆ 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 7234 of file spmd_i7tool.F.

7235 USE tri7box
7236 USE tri25ebox
7237 USE message_mod
7238C-----------------------------------------------
7239C I m p l i c i t T y p e s
7240C-----------------------------------------------
7241#include "implicit_f.inc"
7242C-----------------------------------------------
7243C C o m m o n B l o c k s
7244C-----------------------------------------------
7245#include "com04_c.inc"
7246#include "scr18_c.inc"
7247#include "param_c.inc"
7248C-----------------------------------------------
7249C D u m m y A r g u m e n t s
7250C-----------------------------------------------
7251 INTEGER IPARI(NPARI,*),COUNT_REMSLV(*),COUNT_REMSLVE(*)
7252 INTEGER, INTENT(IN) :: NODADT_THERM
7253C-----------------------------------------------
7254C L o c a l V a r i a b l e s
7255C-----------------------------------------------
7256 INTEGER NI,ITYP,LSKYFI,IERROR1,INTTH,IERROR
7257C-----------------------------------------------
7258 lskyfi = 0
7259 DO ni=1,ninter
7260 ierror = 0
7261 ierror1 = 0
7262
7263 IF (count_remslv(ni) > nlskyfi(ni))THEN
7264
7265 ityp = ipari(7,ni)
7266C
7267 nlskyfi(ni)=nint(count_remslv(ni)*1.20d0)
7268
7269 lskyfi=nlskyfi(ni)
7270C
7271 IF(ityp==7.OR.ityp==10.OR.ityp==20.OR.
7272 . ityp==22.OR.ityp==23.OR.ityp==24.OR.
7273 . ityp==25)THEN
7274 intth = ipari(47,ni)
7275
7276 IF (ASSOCIATED(iskyfi(ni)%P)) DEALLOCATE(iskyfi(ni)%P)
7277 IF (ASSOCIATED(fskyfi(ni)%P)) DEALLOCATE(fskyfi(ni)%P)
7278C
7279 ALLOCATE(iskyfi(ni)%P(lskyfi),stat=ierror1)
7280 ierror = ierror + ierror1
7281 IF(kdtint==0) THEN
7282 ALLOCATE(fskyfi(ni)%P(4,lskyfi),stat=ierror1)
7283 ierror = ierror + ierror1
7284 ELSE
7285 ALLOCATE(fskyfi(ni)%P(5,lskyfi),stat=ierror1)
7286 ierror = ierror + ierror1
7287 END IF
7288 IF(ityp==7 .OR. ityp==25) THEN
7289 IF(intth /=0 ) THEN
7290 IF(ASSOCIATED(ftheskyfi(ni)%P)) DEALLOCATE(ftheskyfi(ni)%P)
7291 ALLOCATE(ftheskyfi(ni)%P(lskyfi),stat=ierror1)
7292 ierror = ierror + ierror1
7293 ENDIF
7294 IF(intth /= 0 .AND. nodadt_therm ==1) THEN
7295 IF(ASSOCIATED(condnskyfi(ni)%P)) DEALLOCATE(condnskyfi(ni)%P)
7296 ALLOCATE(condnskyfi(ni)%P(lskyfi),stat=ierror1)
7297 ierror = ierror + ierror1
7298 ENDIF
7299 ENDIF
7300 ELSEIF(ityp==11)THEN
7301 intth = ipari(47,ni)
7302 ierror = 0
7303 IF(ASSOCIATED(iskyfi(ni)%P)) DEALLOCATE(iskyfi(ni)%P)
7304 IF(ASSOCIATED(fskyfi(ni)%P)) DEALLOCATE(fskyfi(ni)%P)
7305 ALLOCATE(iskyfi(ni)%P(lskyfi),stat=ierror1)
7306 ierror = ierror + ierror1
7307 IF(intth /=0 ) THEN
7308 IF(ASSOCIATED(ftheskyfi(ni)%P)) DEALLOCATE(ftheskyfi(ni)%P)
7309 ALLOCATE(ftheskyfi(ni)%P(2*lskyfi),stat=ierror1)
7310 ierror = ierror + ierror1
7311 ENDIF
7312 IF(kdtint==0) THEN
7313 ALLOCATE(fskyfi(ni)%P(8,lskyfi),stat=ierror1)
7314 ierror = ierror + ierror1
7315 ELSE
7316 ALLOCATE(fskyfi(ni)%P(10,lskyfi),stat=ierror1)
7317 ierror = ierror + ierror1
7318 END IF
7319 IF(intth /= 0 .AND. nodadt_therm ==1) THEN
7320 IF(ASSOCIATED(condnskyfi(ni)%P)) DEALLOCATE(condnskyfi(ni)%P)
7321 ALLOCATE(condnskyfi(ni)%P(2*lskyfi),stat=ierror1)
7322 ierror = ierror + ierror1
7323 ENDIF
7324 ENDIF
7325 ENDIF
7326 IF( count_remslve(ni) > nlskyfie(ni) )THEN
7327 nlskyfie(ni) = nint(1.2d0 * count_remslve(ni))
7328 lskyfi = count_remslve(ni)
7329 IF (ASSOCIATED(fskyfie(ni)%P))DEALLOCATE(fskyfie(ni)%P)
7330 IF (ASSOCIATED(iskyfie(ni)%P)) DEALLOCATE(iskyfie(ni)%P)
7331 ALLOCATE(iskyfie(ni)%P(lskyfi),stat=ierror1)
7332 IF(kdtint==0) THEN
7333C ALLOCATE(FSKYFIE(NI)%P(8,LSKYFI),STAT=IERROR1)
7334 ALLOCATE(fskyfie(ni)%P(8,lskyfi),stat=ierror1)
7335 ierror = ierror + ierror1
7336 ELSE
7337 ALLOCATE(fskyfie(ni)%P(8,lskyfi),stat=ierror1)
7338 ierror = ierror + ierror1
7339 END IF
7340 ENDIF
7341
7342 IF(ierror/=0) THEN
7343 CALL ancmsg(msgid=20,anmode=aninfo)
7344 CALL arret(2)
7345 ENDIF
7346 ENDDO
7347 RETURN