OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
send_cand.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "scr17_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "intstamp_c.inc"
#include "parit_c.inc"
#include "scr18_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_get_inacti7 (inacti, ipari22, nin, isendto, ircvfrom, inactii)
subroutine spmd_get_stif (newfront, i_stok, cand_n, stfn, nsn, nin, isendto, ircvfrom, nsv, itab)
subroutine spmd_get_stif25 (newfront, stfn, nsn, nin, isendto, ircvfrom, nsv, itab)
subroutine spmd_get_stif20 (newfront, i_stok, cand_n, stfa, nsn, nin, isendto, ircvfrom, nsv, itab, nlg)
subroutine spmd_get_stif11 (newfront, i_stok, cand_s, stfs, nrts, nin, isendto, ircvfrom, irects, itab)
subroutine spmd_get_stif20e (newfront, i_stok, cand_s, stfs, nlinsa, nin, isendto, ircvfrom, ixlins, itab, nlg)
subroutine spmd_sd_stfn (loc_proc, pmain, lenx, cand_n, nsv, i_stok, nsn, stfn, ienvoi, isendto, ircvfrom, itab, nin)
subroutine spmd_sd_stfn25 (loc_proc, pmain, lenx, nsv, nsn, stfn, ienvoi, isendto, ircvfrom, itab, nin)
subroutine spmd_sd_stfa20 (loc_proc, pmain, lenx, cand_n, nsv, i_stok, nsn, stfa, ienvoi, isendto, ircvfrom, itab, nlg, nin)
subroutine spmd_sd_stfn11 (loc_proc, pmain, lenx, cand_s, irects, i_stok, nrts, stfs, ienvoi, isendto, ircvfrom, itab, nin)
subroutine spmd_sd_stfn20e (loc_proc, pmain, lenx, cand_s, ixlins, i_stok, nlinsa, stfs, ienvoi, isendto, ircvfrom, itab, nlg, nin)
subroutine spmd_ifront_stamp (ipari, nsensor, intbuf_tab, retri, temp, sensor_tab, nbintc21, intlist21)
subroutine spmd_i21tempcom (ipari, temp, intbuf_tab, nsensor, sensor_tab)
subroutine spmd_i21fthecom (ipari, fthe, intbuf_tab, sensor_tab, niskyfi, ftheskyi, isky, fskyi, condnskyi, nsensor, nodadt_therm)
subroutine spmd_get_penis (penis, nin)
subroutine spmd_get_penis20 (nsv, ixlins, penis, penise, penia, nin)

Function/Subroutine Documentation

◆ spmd_get_inacti7()

subroutine spmd_get_inacti7 ( integer inacti,
integer ipari22,
integer nin,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer inactii )

Definition at line 55 of file send_cand.F.

58 USE spmd_mod
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "com01_c.inc"
67#include "com04_c.inc"
68#include "task_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER INACTI,NIN,IPARI22,
73 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*),
74 . INACTII
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78#ifdef MPI
79 INTEGER K,INACTI_R,
80 . MSGOFF,MSGTYP, PMAIN, LOC_PROC
81 DATA msgoff/1000/
82C-----------------------------------------------
83C S o u r c e L i n e s
84C-----------------------------------------------
85C
86 loc_proc=ispmd+1
87 IF(nspmd==1.OR.(isendto(nin,loc_proc)==0.AND.
88 . ircvfrom(nin,loc_proc)==0)) THEN
89 RETURN
90 ENDIF
91 pmain = 1
92C
93C determination du proc main (celui qui fait joue le role de P0)
94C
95 DO k = 1, nspmd
96 IF (isendto(nin,k)/=0.OR.
97 . ircvfrom(nin,k)/=0) THEN
98 pmain = k
99 GOTO 110
100 ENDIF
101 ENDDO
102 110 CONTINUE
103C temporary change for exchange and cumul
104 IF(inacti < 0) inacti=0
105 IF (loc_proc/=pmain) THEN
106 msgtyp=msgoff
107 CALL spmd_send(inacti,1,it_spmd(pmain),msgtyp)
108C p0 envoi la liste des noeuds pour lesquels stfn=0
109 CALL spmd_recv(inacti,1,it_spmd(pmain),msgtyp)
110 ELSE
111 DO k = 1, nspmd
112 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
113 . ircvfrom(nin,k)/=0)) THEN
114 msgtyp=msgoff
115 CALL spmd_recv(inacti_r,1,it_spmd(k),msgtyp)
116 inacti = inacti+inacti_r
117 ENDIF
118 ENDDO
119C
120 IF (inacti/=0) THEN
121 inacti=inactii
122 ELSE
123C pour le cas inacti passe en negatif sur tous les procs
124 inacti=-abs(inactii)
125 END IF
126C
127 DO k = 1, nspmd
128 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
129 . ircvfrom(nin,k)/=0)) THEN
130 msgtyp=msgoff
131 CALL spmd_send(inacti,1,it_spmd(k),msgtyp)
132 ENDIF
133 ENDDO
134 ENDIF
135C
136
137 ipari22 = inacti
138C
139#endif
140 RETURN

◆ spmd_get_penis()

subroutine spmd_get_penis ( penis,
integer nin )

Definition at line 2656 of file send_cand.F.

2657C-----------------------------------------------
2658C M o d u l e s
2659C-----------------------------------------------
2660 USE tri7box
2661 USE message_mod
2662 USE spmd_mod
2663C-----------------------------------------------
2664C I m p l i c i t T y p e s
2665C-----------------------------------------------
2666#include "implicit_f.inc"
2667C-----------------------------------------------
2668C C o m m o n B l o c k s
2669C-----------------------------------------------
2670#include "com01_c.inc"
2671#include "task_c.inc"
2672C-----------------------------------------------
2673C D u m m y A r g u m e n t s
2674C-----------------------------------------------
2675 INTEGER NIN
2676 my_real
2677 . penis(2,*)
2678C-----------------------------------------------
2679C L o c a l V a r i a b l e s
2680C-----------------------------------------------
2681#ifdef MPI
2682 INTEGER N, P, NOD, NB, IDEB, MSGTYP, LOC_PROC, IERROR,
2683 . IERROR1, LENS, LENR, LENSR, MSGOFF, MSGOFF2
2684 INTEGER REQ_SI(NSPMD)
2685 my_real ,DIMENSION(:), ALLOCATABLE :: bufs, bufr
2686 DATA msgoff/2017/
2687 DATA msgoff2/2018/
2688C-----------------------------------------------
2689C S o u r c e L i n e s
2690C-----------------------------------------------
2691C
2692 IF(nspmd==1) RETURN
2693 lens = 0
2694 lenr = 0
2695 DO p = 1, nspmd
2696 lens = lens + nsnfi(nin)%P(p)
2697 lenr = lenr + nsnsi(nin)%P(p)
2698 END DO
2699 lensr = max(lens,lenr)
2700 IF(lensr>0)THEN
2701 ierror=0
2702 ALLOCATE(bufs(lensr),stat=ierror)
2703 ierror1=0
2704 ALLOCATE(bufr(lensr),stat=ierror1)
2705 IF(ierror+ierror1/=0) THEN
2706 CALL ancmsg(msgid=20,anmode=aninfo)
2707 CALL arret(2)
2708 END IF
2709 END IF
2710 loc_proc = ispmd+1
2711C
2712C Envoi PENIS(2)
2713C
2714 ideb = 0
2715 DO p = 1, nspmd
2716 IF(p/=loc_proc)THEN
2717 nb = nsnfi(nin)%P(p)
2718 DO n = 1, nb
2719 bufs(ideb+n) = penfi(nin)%P(2,ideb+n)
2720 END DO
2721 IF(nb>0)THEN
2722 msgtyp = msgoff
2723 CALL spmd_isend(
2724 . bufs(ideb+1),nb ,it_spmd(p),msgtyp,
2725 . req_si(p))
2726 ideb = ideb + nb
2727 END IF
2728 END IF
2729 END DO
2730C
2731C Recep PENIS(2) remote et maj PENIS
2732C
2733 ideb = 0
2734 DO p = 1, nspmd
2735 IF(p/=loc_proc)THEN
2736 nb = nsnsi(nin)%P(p)
2737 IF(nb>0)THEN
2738 msgtyp = msgoff
2739 CALL spmd_recv(bufr,nb ,it_spmd(p),msgtyp)
2740 DO n = 1, nb
2741 nod = nsvsi(nin)%P(ideb+n)
2742 penis(2,nod) = max(penis(2,nod),bufr(n))
2743 END DO
2744 ideb = ideb + nb
2745 END IF
2746 END IF
2747 END DO
2748C
2749C Attente reception 1er envoi
2750C
2751 DO p = 1, nspmd
2752 IF(p/=loc_proc)THEN
2753 nb = nsnfi(nin)%P(p)
2754 IF(nb>0)THEN
2755 CALL spmd_wait(req_si(p))
2756 ENDIF
2757 END IF
2758 END DO
2759
2760C
2761C Renvoi PENIS(2) update
2762C
2763 ideb =0
2764 DO p = 1, nspmd
2765 IF(p/=loc_proc)THEN
2766 nb = nsnsi(nin)%P(p)
2767 DO n = 1, nb
2768 nod = nsvsi(nin)%P(ideb+n)
2769 bufs(ideb+n) = penis(2,nod)
2770 END DO
2771 IF(nb>0)THEN
2772 msgtyp = msgoff2
2773 CALL spmd_isend(bufs(ideb+1),nb,it_spmd(p),msgtyp, req_si(p))
2774 ideb = ideb + nb
2775 END IF
2776 END IF
2777 END DO
2778C
2779C Reception PENIS(2) update dans PENFI et maj PENFI (cf i11buce_crit)
2780C
2781 ideb =0
2782 DO p = 1, nspmd
2783 IF(p/=loc_proc)THEN
2784 nb = nsnfi(nin)%P(p)
2785 IF(nb>0)THEN
2786 msgtyp = msgoff2
2787 CALL spmd_recv(bufr,nb ,it_spmd(p),msgtyp)
2788 DO n = 1, nb
2789 penfi(nin)%P(1,ideb+n) = min(penfi(nin)%P(1,ideb+n),
2790 . bufr(n))
2791 penfi(nin)%P(2,ideb+n) = zero
2792 END DO
2793 ideb = ideb + nb
2794 END IF
2795 END IF
2796 END DO
2797C
2798C Attente reception 2eme envoi
2799C
2800 DO p = 1, nspmd
2801 IF(p/=loc_proc)THEN
2802 nb = nsnsi(nin)%P(p)
2803 IF(nb>0)THEN
2804 CALL spmd_wait(req_si(p))
2805 ENDIF
2806 END IF
2807 END DO
2808C
2809 IF(lensr>0)THEN
2810 DEALLOCATE(bufr)
2811 DEALLOCATE(bufs)
2812 END IF
2813C
2814#endif
2815 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::penfi
type(real_pointer2), dimension(:), allocatable penfi
Definition tri7box.F:459
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
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
arret
subroutine arret(nn)
Definition arret.F:87

◆ spmd_get_penis20()

subroutine spmd_get_penis20 ( integer, dimension(*) nsv,
integer, dimension(2,*) ixlins,
penis,
penise,
penia,
integer nin )

Definition at line 2831 of file send_cand.F.

2832C-----------------------------------------------
2833C M o d u l e s
2834C-----------------------------------------------
2835 USE tri7box
2836 USE message_mod
2837 USE spmd_mod
2838C-----------------------------------------------
2839C I m p l i c i t T y p e s
2840C-----------------------------------------------
2841#include "implicit_f.inc"
2842C-----------------------------------------------
2843C C o m m o n B l o c k s
2844C-----------------------------------------------
2845#include "com01_c.inc"
2846#include "task_c.inc"
2847C-----------------------------------------------
2848C D u m m y A r g u m e n t s
2849C-----------------------------------------------
2850 INTEGER NIN, NSV(*), IXLINS(2,*)
2851 my_real
2852 . penis(2,*), penise(2,*), penia(5,*)
2853C-----------------------------------------------
2854C L o c a l V a r i a b l e s
2855C-----------------------------------------------
2856#ifdef MPI
2857 INTEGER N, P, NB, IDEB, MSGTYP, LOC_PROC, IERROR,
2858 . IERROR1, LENS, LENR, LENSR, NB1, NB2, IDEB1, IDEB2,
2859 . II, IL, IL1, IL2, MSGOFF, MSGOFF2
2860 INTEGER REQ_SI(NSPMD)
2861 my_real
2862 . ,DIMENSION(:), ALLOCATABLE :: bufs, bufr
2863 DATA msgoff/2019/
2864 DATA msgoff2/2020/
2865C-----------------------------------------------
2866C S o u r c e L i n e s
2867C-----------------------------------------------
2868C
2869 IF(nspmd==1) RETURN
2870 lens = 0
2871 lenr = 0
2872 DO p = 1, nspmd
2873 lens = lens + 2*nsnfi(nin)%P(p)+ 3*nsnfie(nin)%P(p)
2874 lenr = lenr + 2*nsnsi(nin)%P(p)+ 3*nsnsie(nin)%P(p)
2875 END DO
2876 lensr = max(lens,lenr)
2877 IF(lensr>0)THEN
2878 ierror=0
2879 ALLOCATE(bufs(lensr),stat=ierror)
2880 ierror1=0
2881 ALLOCATE(bufr(lensr),stat=ierror1)
2882 IF(ierror+ierror1/=0) THEN
2883 CALL ancmsg(msgid=20,anmode=aninfo)
2884 CALL arret(2)
2885 END IF
2886 END IF
2887 loc_proc = ispmd+1
2888C
2889C Envoi PENIS(2)
2890C
2891 ideb = 0
2892 ideb1= 0
2893 ideb2= 0
2894 DO p = 1, nspmd
2895 IF(p/=loc_proc)THEN
2896 nb1 = nsnfi(nin)%P(p)
2897 DO n = 1, nb1
2898 bufs(ideb+n) = penfi(nin)%P(2,ideb1+n)
2899 bufs(ideb+nb1+n)= penfia(nin)%P(5,ideb1+n)
2900 END DO
2901 ideb1 = ideb1 + nb1
2902 nb2 = nsnfie(nin)%P(p)
2903 DO n = 1, nb2
2904 bufs(ideb+2*nb1+n) = penfie(nin)%P(2,ideb2+n)
2905 bufs(ideb+2*nb1+nb2+2*(n-1)+1)=
2906 + penfiae(nin)%P(5,2*ideb2+2*(n-1)+1)
2907 bufs(ideb+2*nb1+nb2+2*n) = penfiae(nin)%P(5,2*ideb2+2*n)
2908 END DO
2909 ideb2 = ideb2 + nb2
2910 nb=2*nb1+3*nb2
2911 IF(nb>0)THEN
2912 msgtyp = msgoff
2913 CALL spmd_isend(bufs(ideb+1),nb,it_spmd(p),msgtyp,req_si(p))
2914 ideb = ideb + nb
2915 END IF
2916 END IF
2917 END DO
2918C
2919C Recep PENIS(2) remote et maj PENIS
2920C
2921 ideb1 = 0
2922 ideb2 = 0
2923 DO p = 1, nspmd
2924 IF(p/=loc_proc)THEN
2925 nb1 = nsnsi(nin)%P(p)
2926 nb2 = nsnsie(nin)%P(p)
2927 nb=2*nb1+3*nb2
2928 IF(nb>0)THEN
2929 msgtyp = msgoff
2930 CALL spmd_recv(bufr,nb,it_spmd(p),msgtyp)
2931 DO n = 1, nb1
2932 ii = nsvsi(nin)%P(ideb1+n)
2933 il = nsv(ii)
2934 penis(2,ii) = max(penis(2,ii),bufr(n))
2935 penia(5,il) = max(penia(5,il),bufr(nb1+n))
2936 END DO
2937 ideb1 = ideb1+nb1
2938 DO n = 1, nb2
2939 ii = nsvsie(nin)%P(ideb2+n)
2940 il1=ixlins(1,ii)
2941 il2=ixlins(2,ii)
2942 penise(2,ii)=max(penise(2,ii),bufr(2*nb1+n))
2943 penia(5,il1)=max(penia(5,il1),bufr(2*nb1+nb2+2*(n-1)+1))
2944 penia(5,il2)=max(penia(5,il2),bufr(2*nb1+nb2+2*n))
2945 END DO
2946 ideb2 = ideb2 + nb2
2947 END IF
2948 END IF
2949 END DO
2950C
2951C Attente reception 1er envoi
2952C
2953 DO p = 1, nspmd
2954 IF(p/=loc_proc)THEN
2955 nb = nsnfi(nin)%P(p)+nsnfie(nin)%P(p)
2956 IF(nb>0)THEN
2957 CALL spmd_wait(req_si(p))
2958 ENDIF
2959 END IF
2960 END DO
2961
2962C
2963C Renvoi PENIS(2) update
2964C
2965 ideb =0
2966 ideb1 =0
2967 ideb2 =0
2968 DO p = 1, nspmd
2969 IF(p/=loc_proc)THEN
2970 nb1 = nsnsi(nin)%P(p)
2971 DO n = 1, nb1
2972 ii = nsvsi(nin)%P(ideb1+n)
2973 il = nsv(ii)
2974 bufs(ideb+n) = penis(2,ii)
2975 bufs(ideb+nb1+n) = penia(5,il)
2976 END DO
2977 ideb1 = ideb1 + nb1
2978 nb2 = nsnsie(nin)%P(p)
2979 DO n = 1, nb2
2980 ii = nsvsie(nin)%P(ideb2+n)
2981 il1=ixlins(1,ii)
2982 il2=ixlins(2,ii)
2983 bufs(ideb+2*nb1+n) = penise(2,ii)
2984 bufs(ideb+2*nb1+nb2+2*(n-1)+1) = penia(5,il1)
2985 bufs(ideb+2*nb1+nb2+2*n) = penia(5,il2)
2986 END DO
2987 ideb2 = ideb2 + nb2
2988 nb=2*nb1+3*nb2
2989 IF(nb>0)THEN
2990 msgtyp = msgoff2
2991 CALL spmd_isend(
2992 . bufs(ideb+1),nb ,it_spmd(p),msgtyp,
2993 . req_si(p))
2994 ideb = ideb + nb
2995 END IF
2996 END IF
2997 END DO
2998C
2999C Reception PENIS(2) update dans PENFI et maj PENFI (cf i11buce_crit)
3000C
3001 ideb1 =0
3002 ideb2 =0
3003 DO p = 1, nspmd
3004 IF(p/=loc_proc)THEN
3005 nb1 = nsnfi(nin)%P(p)
3006 nb2 = nsnfie(nin)%P(p)
3007 nb=2*nb1+3*nb2
3008 IF(nb>0)THEN
3009 msgtyp = msgoff2
3010 CALL spmd_recv(bufr,nb,it_spmd(p),msgtyp)
3011 DO n = 1, nb1
3012 penfi(nin)%P(1,ideb1+n) = min(penfi(nin)%P(1,ideb1+n),
3013 . bufr(n))
3014 penfi(nin)%P(2,ideb1+n) = zero
3015 penfia(nin)%P(4,ideb1+n)= min(penfia(nin)%P(4,ideb1+n),
3016 . bufr(nb1+n))
3017 penfia(nin)%P(5,ideb1+n) = zero
3018 END DO
3019 ideb1 = ideb1 + nb1
3020 DO n = 1, nb2
3021 penfie(nin)%P(1,ideb2+n) = min(penfie(nin)%P(1,ideb2+n),
3022 . bufr(2*nb1+n))
3023 penfie(nin)%P(2,ideb2+n) = zero
3024 penfiae(nin)%P(4,2*ideb2+2*(n-1)+1) =
3025 . min(penfiae(nin)%P(4,2*ideb2+2*(n-1)+1),
3026 . bufr(2*nb1+nb2+2*(n-1)+1))
3027 penfiae(nin)%P(5,2*ideb2+2*(n-1)+1) = zero
3028 penfiae(nin)%P(4,2*ideb2+2*n) =
3029 . min(penfiae(nin)%P(4,2*ideb2+2*n),
3030 . bufr(2*nb1+nb2+2*n))
3031 penfiae(nin)%P(5,2*ideb2+2*n) = zero
3032 END DO
3033 ideb2 = ideb2 + nb2
3034 END IF
3035 END IF
3036 END DO
3037C
3038C Attente reception 2eme envoi
3039C
3040 DO p = 1, nspmd
3041 IF(p/=loc_proc)THEN
3042 nb = nsnsi(nin)%P(p)+nsnsie(nin)%P(p)
3043 IF(nb>0)THEN
3044 CALL spmd_wait(req_si(p))
3045 ENDIF
3046 END IF
3047 END DO
3048C
3049 IF(lensr>0)THEN
3050 DEALLOCATE(bufr)
3051 DEALLOCATE(bufs)
3052 END IF
3053C
3054#endif
3055 RETURN
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::penfia
type(real_pointer2), dimension(:), allocatable penfia
Definition tri7box.F:459
tri7box::nsvsie
type(int_pointer), dimension(:), allocatable nsvsie
Definition tri7box.F:485
tri7box::penfie
type(real_pointer2), dimension(:), allocatable penfie
Definition tri7box.F:459
tri7box::penfiae
type(real_pointer2), dimension(:), allocatable penfiae
Definition tri7box.F:459

◆ spmd_get_stif()

subroutine spmd_get_stif ( integer newfront,
integer i_stok,
integer, dimension(*) cand_n,
stfn,
integer nsn,
integer nin,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(*) nsv,
integer, dimension(*) itab )

Definition at line 153 of file send_cand.F.

156C-----------------------------------------------
157C M o d u l e s
158C-----------------------------------------------
159 USE tri7box
160 USE spmd_mod
161C-----------------------------------------------
162C I m p l i c i t T y p e s
163C-----------------------------------------------
164#include "implicit_f.inc"
165C-----------------------------------------------
166C C o m m o n B l o c k s
167C-----------------------------------------------
168#include "com01_c.inc"
169#include "com04_c.inc"
170#include "scr17_c.inc"
171#include "task_c.inc"
172C-----------------------------------------------
173C D u m m y A r g u m e n t s
174C-----------------------------------------------
175 INTEGER NEWFRONT, I_STOK, NSN, NIN, CAND_N(*), NSV(*),
176 . ITAB(*),
177 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*)
178 my_real
179 . stfn(*)
180C-----------------------------------------------
181C L o c a l V a r i a b l e s
182C-----------------------------------------------
183#ifdef MPI
184 INTEGER I,K,LEN,LENX,LENR,IDEB,P,NB,
185 . MSGOFF,MSGTYP,PMAIN, LOC_PROC,
186 . IENVOI(NSPMD)
187 DATA msgoff/1001/
188C-----------------------------------------------
189C S o u r c e L i n e s
190C-----------------------------------------------
191C
192 loc_proc=ispmd+1
193 IF(nspmd==1.OR.(isendto(nin,loc_proc)==0.AND.
194 . ircvfrom(nin,loc_proc)==0)) THEN
195 newfront = 0
196 RETURN
197 ENDIF
198C
199C determination du proc main (celui qui fait joue le role de P0)
200C
201 DO k = 1, nspmd
202 IF (isendto(nin,k)/=0.OR.
203 . ircvfrom(nin,k)/=0) THEN
204 pmain = k
205 GOTO 110
206 ENDIF
207 ENDDO
208 110 CONTINUE
209C
210 len = 0
211C traitement sur tout NSN pour le cas shooting nodes
212 IF(idel7ng>=1)THEN
213 DO i = 1, nsn
214 IF(stfn(i)<zero) THEN
215 len = len + 1
216 ENDIF
217 ENDDO
218 ideb = 0
219 DO p = 1, nspmd
220 IF(p/=loc_proc)THEN
221 nb = nsnfi(nin)%P(p)
222 DO i = ideb+1, ideb+nb
223 IF(stifi(nin)%P(i)<zero) THEN
224 len = len + 1
225 END IF
226 END DO
227 ideb = ideb + nb
228 END IF
229 END DO
230 ELSE
231 DO i = 1, i_stok
232 IF(cand_n(i)<=nsn) THEN
233Candidat interne
234 IF(stfn(cand_n(i))<zero) THEN
235 len = len + 1
236 ENDIF
237Candidat frontiere
238 ELSEIF(stifi(nin)%P(cand_n(i)-nsn)<zero) THEN
239 len = len + 1
240 END IF
241 END DO
242 END IF
243 ienvoi(loc_proc) = len
244C
245 IF (loc_proc/=pmain) THEN
246C pack des candidats ayant stifness negative
247C
248 msgtyp=msgoff
249 CALL spmd_send(len,1,it_spmd(pmain),msgtyp)
250 CALL spmd_recv(lenx,1,it_spmd(pmain),msgtyp)
251 ELSE
252Calcul taille totale
253 lenx = len
254 DO k = 1, nspmd
255 ienvoi(k) = 0
256 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
257 . ircvfrom(nin,k)/=0)) THEN
258 msgtyp=msgoff
259 CALL spmd_recv(lenr,1,it_spmd(k),msgtyp)
260 lenx = lenx + lenr
261 ienvoi(k) = lenr
262 ENDIF
263 ENDDO
264C
265 DO k = 1, nspmd
266 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
267 . ircvfrom(nin,k)/=0)) THEN
268 msgtyp=msgoff
269 CALL spmd_send(lenx,1,it_spmd(k),msgtyp)
270 ENDIF
271 ENDDO
272 ENDIF
273C envoi des stifness
274 CALL spmd_sd_stfn(loc_proc,pmain ,lenx ,cand_n,nsv ,
275 2 i_stok ,nsn ,stfn ,ienvoi,isendto,
276 3 ircvfrom,itab ,nin )
277C
278 newfront = 0
279C
280#endif
281 RETURN
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
spmd_sd_stfn
subroutine spmd_sd_stfn(loc_proc, pmain, lenx, cand_n, nsv, i_stok, nsn, stfn, ienvoi, isendto, ircvfrom, itab, nin)
Definition send_cand.F:849

◆ spmd_get_stif11()

subroutine spmd_get_stif11 ( integer newfront,
integer i_stok,
integer, dimension(*) cand_s,
stfs,
integer nrts,
integer nin,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(2,*) irects,
integer, dimension(*) itab )

Definition at line 563 of file send_cand.F.

566C-----------------------------------------------
567C M o d u l e s
568C-----------------------------------------------
569 USE spmd_mod
570 USE tri7box
571C-----------------------------------------------
572C I m p l i c i t T y p e s
573C-----------------------------------------------
574#include "implicit_f.inc"
575C-----------------------------------------------
576C C o m m o n B l o c k s
577C-----------------------------------------------
578#include "com01_c.inc"
579#include "com04_c.inc"
580#include "scr17_c.inc"
581#include "task_c.inc"
582C-----------------------------------------------
583C D u m m y A r g u m e n t s
584C-----------------------------------------------
585 INTEGER NEWFRONT, I_STOK, NRTS, NIN, CAND_S(*), IRECTS(2,*),
586 . ITAB(*),
587 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*)
588 my_real
589 . stfs(*)
590C-----------------------------------------------
591C L o c a l V a r i a b l e s
592C-----------------------------------------------
593#ifdef MPI
594 INTEGER I,K,LEN,LENX,LENR,IDEB,P,NB,
595 . MSGOFF,MSGTYP,PMAIN, LOC_PROC,
596 . IENVOI(NSPMD)
597 DATA msgoff/1003/
598C-----------------------------------------------
599C S o u r c e L i n e s
600C-----------------------------------------------
601C
602 loc_proc=ispmd+1
603 IF(nspmd==1.OR.(isendto(nin,loc_proc)==0.AND.
604 . ircvfrom(nin,loc_proc)==0)) THEN
605 newfront = 0
606 RETURN
607 ENDIF
608C
609C determination du proc main (celui qui fait joue le role de P0)
610C
611 DO k = 1, nspmd
612 IF (isendto(nin,k)/=0.OR.
613 . ircvfrom(nin,k)/=0) THEN
614 pmain = k
615 GOTO 110
616 ENDIF
617 ENDDO
618 110 CONTINUE
619C
620 len = 0
621C traitement sur tout NRTS pour le cas shooting nodes
622 IF(idel7ng>=1)THEN
623 DO i = 1, nrts
624 IF(stfs(i)<zero) THEN
625 len = len + 2
626 ENDIF
627 ENDDO
628 ideb = 0
629 DO p = 1, nspmd
630 IF(p/=loc_proc)THEN
631 nb = nsnfi(nin)%P(p)
632 DO i = ideb+1, ideb+nb
633 IF(stifi(nin)%P(i)<zero) THEN
634 len = len + 2
635 END IF
636 END DO
637 ideb = ideb + nb
638 END IF
639 END DO
640 ELSE
641 DO i = 1, i_stok
642 IF(cand_s(i)<=nrts) THEN
643Candidat interne
644 IF(stfs(cand_s(i))<zero) THEN
645 len = len + 2
646 ENDIF
647Candidat frontiere
648 ELSEIF(stifi(nin)%P(cand_s(i)-nrts)<zero) THEN
649 len = len + 2
650 ENDIF
651 ENDDO
652 END IF
653 ienvoi(loc_proc) = len
654C
655 IF (loc_proc/=pmain) THEN
656C pack des candidats ayant stifness negative
657C
658 msgtyp=msgoff
659 CALL spmd_send(len,1,it_spmd(pmain),msgtyp)
660 CALL spmd_recv(lenx,1,it_spmd(pmain),msgtyp)
661 ELSE
662Calcul taille totale
663 lenx = len
664 DO k = 1, nspmd
665 ienvoi(k) = 0
666 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
667 . ircvfrom(nin,k)/=0)) THEN
668 msgtyp=msgoff
669 CALL spmd_recv(lenr,1,it_spmd(k),msgtyp)
670 lenx = lenx + lenr
671 ienvoi(k) = lenr
672 ENDIF
673 ENDDO
674C
675 DO k = 1, nspmd
676 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
677 . ircvfrom(nin,k)/=0)) THEN
678 msgtyp=msgoff
679 CALL spmd_send(lenx,1,it_spmd(k),msgtyp)
680 ENDIF
681 ENDDO
682 ENDIF
683C envoi des stifness
684 CALL spmd_sd_stfn11(loc_proc,pmain ,lenx ,cand_s,irects ,
685 2 i_stok ,nrts ,stfs ,ienvoi,isendto,
686 3 ircvfrom,itab ,nin )
687C
688 newfront = 0
689C
690#endif
691 RETURN
spmd_sd_stfn11
subroutine spmd_sd_stfn11(loc_proc, pmain, lenx, cand_s, irects, i_stok, nrts, stfs, ienvoi, isendto, ircvfrom, itab, nin)
Definition send_cand.F:1264

◆ spmd_get_stif20()

subroutine spmd_get_stif20 ( integer newfront,
integer i_stok,
integer, dimension(*) cand_n,
stfa,
integer nsn,
integer nin,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(*) nsv,
integer, dimension(*) itab,
integer, dimension(*) nlg )

Definition at line 420 of file send_cand.F.

424C-----------------------------------------------
425C M o d u l e s
426C-----------------------------------------------
427 USE tri7box
428 USE spmd_mod
429C-----------------------------------------------
430C I m p l i c i t T y p e s
431C-----------------------------------------------
432#include "implicit_f.inc"
433C-----------------------------------------------
434C C o m m o n B l o c k s
435C-----------------------------------------------
436#include "com01_c.inc"
437#include "com04_c.inc"
438#include "scr17_c.inc"
439#include "task_c.inc"
440C-----------------------------------------------
441C D u m m y A r g u m e n t s
442C-----------------------------------------------
443 INTEGER NEWFRONT, I_STOK, NSN, NIN, CAND_N(*), NSV(*),
444 . ITAB(*), NLG(*),
445 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*)
446 my_real
447 . stfa(*)
448C-----------------------------------------------
449C L o c a l V a r i a b l e s
450C-----------------------------------------------
451#ifdef MPI
452 INTEGER I,K,LEN,LENX,LENR,IDEB,P,NB,
453 . MSGOFF,MSGTYP,PMAIN, LOC_PROC,
454 . IENVOI(NSPMD)
455 DATA msgoff/1002/
456C-----------------------------------------------
457C S o u r c e L i n e s
458C-----------------------------------------------
459C
460 loc_proc=ispmd+1
461 IF(nspmd==1.OR.(isendto(nin,loc_proc)==0.AND.
462 . ircvfrom(nin,loc_proc)==0)) THEN
463 newfront = 0
464 RETURN
465 ENDIF
466C
467C determination du proc main (celui qui fait joue le role de P0)
468C
469 DO k = 1, nspmd
470 IF (isendto(nin,k)/=0.OR.
471 . ircvfrom(nin,k)/=0) THEN
472 pmain = k
473 GOTO 110
474 ENDIF
475 ENDDO
476 110 CONTINUE
477C
478 len = 0
479C traitement sur tout NSN pour le cas shooting nodes
480 IF(idel7ng>=1)THEN
481 DO i = 1, nsn
482 IF(stfa(nsv(i))<zero) THEN
483 len = len + 1
484 ENDIF
485 ENDDO
486 ideb = 0
487 DO p = 1, nspmd
488 IF(p/=loc_proc)THEN
489 nb = nsnfi(nin)%P(p)
490 DO i = ideb+1, ideb+nb
491 IF(stifi(nin)%P(i)<zero) THEN
492 len = len + 1
493 END IF
494 END DO
495 ideb = ideb + nb
496 END IF
497 END DO
498 ELSE
499 DO i = 1, i_stok
500 IF(cand_n(i)<=nsn) THEN
501Candidat interne
502 IF(stfa(nsv(cand_n(i)))<zero) THEN
503 len = len + 1
504 ENDIF
505Candidat frontiere
506 ELSEIF(stifi(nin)%P(cand_n(i)-nsn)<zero) THEN
507 len = len + 1
508 END IF
509 END DO
510 END IF
511 ienvoi(loc_proc) = len
512C
513 IF (loc_proc/=pmain) THEN
514C pack des candidats ayant stifness negative
515C
516 msgtyp=msgoff
517 CALL spmd_send(len,1,it_spmd(pmain),msgtyp)
518 CALL spmd_recv(lenx,1,it_spmd(pmain),msgtyp)
519 ELSE
520Calcul taille totale
521 lenx = len
522 DO k = 1, nspmd
523 ienvoi(k) = 0
524 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
525 . ircvfrom(nin,k)/=0)) THEN
526 msgtyp=msgoff
527 CALL spmd_recv(lenr,1,it_spmd(k),msgtyp)
528 lenx = lenx + lenr
529 ienvoi(k) = lenr
530 ENDIF
531 ENDDO
532C
533 DO k = 1, nspmd
534 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
535 . ircvfrom(nin,k)/=0)) THEN
536 msgtyp=msgoff
537 CALL spmd_send(lenx,1,it_spmd(k),msgtyp)
538 ENDIF
539 ENDDO
540 ENDIF
541C envoi des stifness
542 CALL spmd_sd_stfa20(loc_proc,pmain ,lenx ,cand_n,nsv ,
543 2 i_stok ,nsn ,stfa ,ienvoi,isendto,
544 3 ircvfrom,itab ,nlg ,nin )
545C
546 newfront = 0
547C
548#endif
549 RETURN
spmd_sd_stfa20
subroutine spmd_sd_stfa20(loc_proc, pmain, lenx, cand_n, nsv, i_stok, nsn, stfa, ienvoi, isendto, ircvfrom, itab, nlg, nin)
Definition send_cand.F:1120

◆ spmd_get_stif20e()

subroutine spmd_get_stif20e ( integer newfront,
integer i_stok,
integer, dimension(*) cand_s,
stfs,
integer nlinsa,
integer nin,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(2,*) ixlins,
integer, dimension(*) itab,
integer, dimension(*) nlg )

Definition at line 704 of file send_cand.F.

708C-----------------------------------------------
709C M o d u l e s
710C-----------------------------------------------
711 USE tri7box
712 USE spmd_mod
713C-----------------------------------------------
714C I m p l i c i t T y p e s
715C-----------------------------------------------
716#include "implicit_f.inc"
717C-----------------------------------------------
718C C o m m o n B l o c k s
719C-----------------------------------------------
720#include "com01_c.inc"
721#include "com04_c.inc"
722#include "scr17_c.inc"
723#include "task_c.inc"
724C-----------------------------------------------
725C D u m m y A r g u m e n t s
726C-----------------------------------------------
727 INTEGER NEWFRONT, I_STOK, NLINSA, NIN, CAND_S(*), IXLINS(2,*),
728 . ITAB(*), NLG(*),
729 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*)
730 my_real
731 . stfs(*)
732C-----------------------------------------------
733C L o c a l V a r i a b l e s
734C-----------------------------------------------
735#ifdef MPI
736 INTEGER I,K,LEN,LENX,LENR,IDEB,P,NB,
737 . MSGOFF,MSGTYP,PMAIN, LOC_PROC,
738 . IENVOI(NSPMD)
739 DATA msgoff/1004/
740C-----------------------------------------------
741C S o u r c e L i n e s
742C-----------------------------------------------
743C
744 loc_proc=ispmd+1
745 IF(nspmd==1.OR.(isendto(nin,loc_proc)==0.AND.
746 . ircvfrom(nin,loc_proc)==0)) THEN
747 newfront = 0
748 RETURN
749 ENDIF
750C
751C determination du proc main (celui qui fait joue le role de P0)
752C
753 DO k = 1, nspmd
754 IF (isendto(nin,k)/=0.OR.
755 . ircvfrom(nin,k)/=0) THEN
756 pmain = k
757 GOTO 110
758 ENDIF
759 ENDDO
760 110 CONTINUE
761C
762 len = 0
763C traitement sur tout NLINSA pour le cas shooting nodes
764 IF(idel7ng>=1)THEN
765 DO i = 1, nlinsa
766 IF(stfs(i)<zero) THEN
767 len = len + 2
768 ENDIF
769 ENDDO
770 ideb = 0
771 DO p = 1, nspmd
772 IF(p/=loc_proc)THEN
773 nb = nsnfie(nin)%P(p)
774 DO i = ideb+1, ideb+nb
775 IF(stifie(nin)%P(i)<zero) THEN
776 len = len + 2
777 END IF
778 END DO
779 ideb = ideb + nb
780 END IF
781 END DO
782 ELSE
783 DO i = 1, i_stok
784 IF(cand_s(i)<= nlinsa) THEN
785Candidat interne
786 IF(stfs(cand_s(i))<zero) THEN
787 len = len + 2
788 ENDIF
789Candidat frontiere
790 ELSEIF(stifie(nin)%P(cand_s(i)-nlinsa)<zero) THEN
791 len = len + 2
792 ENDIF
793 ENDDO
794 END IF
795 ienvoi(loc_proc) = len
796C
797 IF (loc_proc/=pmain) THEN
798C pack des candidats ayant stifness negative
799C
800 msgtyp=msgoff
801 CALL spmd_send(len,1,it_spmd(pmain),msgtyp)
802 CALL spmd_recv(lenx,1,it_spmd(pmain),msgtyp)
803 ELSE
804Calcul taille totale
805 lenx = len
806 DO k = 1, nspmd
807 ienvoi(k) = 0
808 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
809 . ircvfrom(nin,k)/=0)) THEN
810 msgtyp=msgoff
811 CALL spmd_recv(lenr,1,it_spmd(k),msgtyp)
812 lenx = lenx + lenr
813 ienvoi(k) = lenr
814 ENDIF
815 ENDDO
816C
817 DO k = 1, nspmd
818 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
819 . ircvfrom(nin,k)/=0)) THEN
820 msgtyp=msgoff
821 CALL spmd_send(lenx,1,it_spmd(k),msgtyp)
822 ENDIF
823 ENDDO
824 ENDIF
825C envoi des stifness
826 CALL spmd_sd_stfn20e(loc_proc,pmain ,lenx ,cand_s,ixlins ,
827 2 i_stok ,nlinsa ,stfs ,ienvoi,isendto,
828 3 ircvfrom,itab ,nlg ,nin )
829C
830 newfront = 0
831C
832#endif
833 RETURN
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449
spmd_sd_stfn20e
subroutine spmd_sd_stfn20e(loc_proc, pmain, lenx, cand_s, ixlins, i_stok, nlinsa, stfs, ienvoi, isendto, ircvfrom, itab, nlg, nin)
Definition send_cand.F:1427

◆ spmd_get_stif25()

subroutine spmd_get_stif25 ( integer newfront,
stfn,
integer nsn,
integer nin,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(*) nsv,
integer, dimension(*) itab )

Definition at line 294 of file send_cand.F.

297C-----------------------------------------------
298C M o d u l e s
299C-----------------------------------------------
300 USE tri7box
301 USE spmd_mod
302C-----------------------------------------------
303C I m p l i c i t T y p e s
304C-----------------------------------------------
305#include "implicit_f.inc"
306C-----------------------------------------------
307C C o m m o n B l o c k s
308C-----------------------------------------------
309#include "com01_c.inc"
310#include "com04_c.inc"
311#include "task_c.inc"
312C-----------------------------------------------
313C D u m m y A r g u m e n t s
314C-----------------------------------------------
315 INTEGER NEWFRONT, NSN, NIN, NSV(*),
316 . ITAB(*),
317 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*)
318 my_real
319 . stfn(*)
320C-----------------------------------------------
321C L o c a l V a r i a b l e s
322C-----------------------------------------------
323#ifdef MPI
324 INTEGER I,K,LEN,LENX,LENR,IDEB,P,NB,
325 . MSGOFF,MSGTYP,PMAIN, LOC_PROC,
326 . IENVOI(NSPMD)
327 DATA msgoff/1001/
328C-----------------------------------------------
329C S o u r c e L i n e s
330C-----------------------------------------------
331C
332 loc_proc=ispmd+1
333 IF(nspmd==1.OR.(isendto(nin,loc_proc)==0.AND.
334 . ircvfrom(nin,loc_proc)==0)) THEN
335 newfront = 0
336 RETURN
337 ENDIF
338C
339C determination du proc main (celui qui fait joue le role de P0)
340C
341 DO k = 1, nspmd
342 IF (isendto(nin,k)/=0.OR.
343 . ircvfrom(nin,k)/=0) THEN
344 pmain = k
345 GOTO 110
346 ENDIF
347 ENDDO
348 110 CONTINUE
349C
350 len = 0
351C traitement sur tout NSN pour les nds precedemment impactes (ne figurent pas dans I_STOK)
352 DO i = 1, nsn
353 IF(stfn(i)<zero) THEN
354 len = len + 1
355 ENDIF
356 ENDDO
357 ideb = 0
358 DO p = 1, nspmd
359 IF(p/=loc_proc)THEN
360 nb = nsnfi(nin)%P(p)
361 DO i = ideb+1, ideb+nb
362 IF(stifi(nin)%P(i)<zero) THEN
363 len = len + 1
364 END IF
365 END DO
366 ideb = ideb + nb
367 END IF
368 END DO
369 ienvoi(loc_proc) = len
370C
371 IF (loc_proc/=pmain) THEN
372C pack des candidats ayant stifness negative
373C
374 msgtyp=msgoff
375 CALL spmd_send(len,1,it_spmd(pmain),msgtyp)
376 CALL spmd_recv(lenx,1,it_spmd(pmain),msgtyp)
377 ELSE
378Calcul taille totale
379 lenx = len
380 DO k = 1, nspmd
381 ienvoi(k) = 0
382 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
383 . ircvfrom(nin,k)/=0)) THEN
384 msgtyp=msgoff
385 CALL spmd_recv(lenr,1,it_spmd(k),msgtyp)
386 lenx = lenx + lenr
387 ienvoi(k) = lenr
388 ENDIF
389 ENDDO
390C
391 DO k = 1, nspmd
392 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
393 . ircvfrom(nin,k)/=0)) THEN
394 msgtyp=msgoff
395 CALL spmd_send(lenx,1,it_spmd(k),msgtyp)
396 ENDIF
397 ENDDO
398 ENDIF
399C envoi des stifness
400 CALL spmd_sd_stfn25(loc_proc,pmain ,lenx ,nsv ,
401 2 nsn ,stfn ,ienvoi,isendto,
402 3 ircvfrom,itab ,nin )
403C
404 newfront = 0
405C
406#endif
407 RETURN
spmd_sd_stfn25
subroutine spmd_sd_stfn25(loc_proc, pmain, lenx, nsv, nsn, stfn, ienvoi, isendto, ircvfrom, itab, nin)
Definition send_cand.F:993

◆ spmd_i21fthecom()

subroutine spmd_i21fthecom ( integer, dimension(npari,ninter) ipari,
fthe,
type(intbuf_struct_), dimension(*) intbuf_tab,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
integer, dimension(*) niskyfi,
ftheskyi,
integer, dimension(*) isky,
fskyi,
condnskyi,
integer, intent(in) nsensor,
integer, intent(in) nodadt_therm )

Definition at line 2189 of file send_cand.F.

2192C============================================================================
2193C M o d u l e s
2194C-----------------------------------------------
2195 USE message_mod
2196 USE intstamp_mod
2197 USE intstamp_glob_mod
2198 USE intbufdef_mod
2199 USE tri7box
2200 USE sensor_mod
2201 USE spmd_mod
2202C-----------------------------------------------
2203C I m p l i c i t T y p e s
2204C-----------------------------------------------
2205#include "implicit_f.inc"
2206C-----------------------------------------------
2207C C o m m o n B l o c k s
2208C-----------------------------------------------
2209#include "com01_c.inc"
2210#include "com04_c.inc"
2211#include "com08_c.inc"
2212#include "param_c.inc"
2213#include "task_c.inc"
2214#include "parit_c.inc"
2215#include "intstamp_c.inc"
2216#include "scr18_c.inc"
2217C-----------------------------------------------
2218C D u m m y A r g u m e n t s
2219C-----------------------------------------------
2220 INTEGER ,INTENT(IN) :: NSENSOR
2221 INTEGER ,INTENT(IN) :: NODADT_THERM
2222 INTEGER IPARI(NPARI,NINTER), ISKY(*), NISKYFI(*)
2223C REAL
2224 my_real :: fthe(*),ftheskyi(*),fskyi(lskyi,*),condnskyi(*)
2225 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2226 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR),INTENT(IN) :: SENSOR_TAB
2227C-----------------------------------------------
2228C L o c a l V a r i a b l e s
2229C-----------------------------------------------
2230#ifdef MPI
2231 INTEGER LEN, NI, NIN ,IDEB, IDEB2, P,I,
2232 . INTTH, LOC_PROC, MSGTYP,
2233 . MSGOFF,IERROR, REQ_S(NSPMD), IDEBUT2(NINTER),IDEBUT(NINTER),
2234 . ISENS,INTERACT,IFORM,NOD,N,
2235 . NODSITOT,NODSI(NINTSTAMP),NIACTIF,INTERACTIF(NINTSTAMP),
2236 . LENS(NSPMD),LENR(NSPMD),IADS(NSPMD),IADR(NSPMD),NODFITOT,
2237 . NODFI(NINTSTAMP),L,ISIZRCV(2,NSPMD),ISIZENV(2,NSPMD),
2238 . REQ_SI(NSPMD),siztemp(NSPMD),
2239 . REQ_R(NSPMD),SIZ, J, K, IALLOCS, IALLOCR, MSGOFF2, NIF, NB,LENR2(NSPMD)
2240 DATA msgoff/2016/
2241 DATA msgoff2/2017/
2242 LOGICAL ITEST
2243
2244 my_real,DIMENSION(:), ALLOCATABLE :: rbufs, rbufr
2245 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX
2246 my_real, DIMENSION(:), ALLOCATABLE :: tempo
2247C REAL
2248 my_real
2249 . startt,stopt,ts
2250C------------------------------------------------------------------------
2251 IF(nspmd==1) RETURN
2252C
2253 loc_proc = ispmd+1
2254C
2255 niactif = 0 ! Number of actif and Tri interfaces
2256 nodsitot = 0 ! Global Number of remote main node
2257 nodfitot = 0 ! Global Number of remote main node
2258C
2259 lens(1:nspmd) = 0
2260 lenr(1:nspmd) = 0
2261 lenr2(1:nspmd) = 0
2262 IF(iparit==0) THEN
2263 DO ni = 1, nintstamp
2264 nin = intstamp(ni)%NOINTER
2265 isens = ipari(64,nin) ! IF an interface sensor is defined
2266 interact = 0
2267
2268 IF (isens > 0) THEN ! Sensor ID
2269 ts = sensor_tab(isens)%TSTART
2270 IF (tt>=ts) interact = 1
2271 ELSE
2272 startt=intbuf_tab(nin)%VARIABLES(3)
2273 stopt =intbuf_tab(nin)%VARIABLES(11)
2274 IF (startt<=tt.AND.tt<=stopt) interact = 1
2275 ENDIF
2276C
2277 intth = ipari(47,nin)
2278 iform = ipari(48,nin)
2279C
2280 IF (interact/=0.AND.intth==2.AND.iform/=0)THEN
2281 niactif = niactif + 1
2282 interactif(niactif) = nin
2283 nodsi(niactif) = 0
2284 nodfi(niactif) = 0
2285 DO p=1,nspmd
2286 nodsi(niactif) = nodsi(niactif) + nmnsi(nin)%P(p)
2287 nodfi(niactif) = nodfi(niactif) + nmnfi(nin)%P(p)
2288 lens(p) = lens(p) + nmnsi(nin)%P(p)
2289 lenr(p)= lenr(p) + nmnfi(nin)%P(p)
2290 ENDDO
2291 nodsitot = nodsitot + nodsi(niactif)
2292 nodfitot = nodfitot + nodfi(niactif)
2293 ENDIF
2294 ENDDO
2295 IF(niactif /= 0 ) THEN
2296C alloc comm structure
2297 ALLOCATE(rbufs(2*nspmd*nodfitot),stat=ierror)
2298 IF(ierror/=0) THEN
2299 CALL ancmsg(msgid=20,anmode=aninfo)
2300 CALL arret(2)
2301 ENDIF
2302
2303 ALLOCATE(rbufr(2*nspmd*nodsitot),stat=ierror)
2304 IF(ierror/=0) THEN
2305 CALL ancmsg(msgid=20,anmode=aninfo)
2306 CALL arret(2)
2307 ENDIF
2308C FILL comm structure
2309 ideb = 0
2310 DO ni = 1, niactif
2311 idebut2(ni) = 0
2312 ENDDO
2313 IF(nodfitot/= 0) THEN
2314 DO p = 1, nspmd
2315 iads(p) = ideb +1
2316 IF(p/= loc_proc.AND.lenr(p)/= 0)THEN
2317 DO ni = 1, niactif
2318 nin = interactif(ni)
2319 len = nmnfi(nin)%P(p)
2320 IF(len /= 0) THEN
2321 ideb2 = idebut2(ni)
2322 DO i = 1,len
2323 rbufs(ideb+1)= nmvfi(nin)%P(ideb2+i)
2324 rbufs(ideb+2)= fthefi(nin)%P(ideb2+i)
2325 fthefi(nin)%P(ideb2+i)= zero
2326 ideb = ideb + 2
2327 ENDDO
2328 idebut2(ni) = idebut2(ni) + len
2329 ENDIF
2330 ENDDO
2331C SEND comm structure
2332
2333 msgtyp = msgoff
2334 CALL spmd_isend(
2335 s rbufs(iads(p)),2*lenr(p),it_spmd(p),msgtyp,
2336 g req_s(p))
2337 ENDIF
2338 ENDDO
2339 ENDIF
2340
2341 iadr(1) = 1
2342 DO p=1,nspmd-1
2343 iadr(p+1) =iadr(p)+2*lens(p)
2344 ENDDO
2345C RECEIVE comm structure
2346 DO ni = 1, niactif
2347 idebut2(ni) = 0
2348 ENDDO
2349 IF(nodsitot /=0) THEN
2350 DO p=1,nspmd
2351 IF(p/= loc_proc.AND.lens(p)/= 0)THEN
2352 msgtyp = msgoff
2353 CALL spmd_recv(rbufr(iadr(p)),2*lens(p),it_spmd(p),
2354 . msgtyp)
2355 ideb= iadr(p)-1
2356
2357 DO ni = 1, niactif
2358 nin = interactif(ni)
2359 len = nmnsi(nin)%P(p)
2360 IF(len /= 0) THEN
2361 ideb2 = idebut2(ni)
2362 DO i = 1,len
2363 n = nint(rbufr(ideb+1))
2364 nod = intbuf_tab(nin)%MSR_L(n)
2365 fthe(nod) = fthe(nod) + rbufr(ideb+2)
2366 ideb = ideb + 2
2367 ENDDO
2368 idebut2(ni) = idebut2(ni) + len
2369 ENDIF
2370 ENDDO
2371 ENDIF
2372 ENDDO
2373 ENDIF
2374C WAITING for receiving msg
2375 DO p = 1, nspmd
2376 IF(p/= loc_proc.AND.lenr(p)/= 0)THEN
2377 CALL spmd_wait(req_s(p))
2378 ENDIF
2379 ENDDO
2380 IF(ALLOCATED(rbufs)) DEALLOCATE(rbufs)
2381 IF(ALLOCATED(rbufr)) DEALLOCATE(rbufr)
2382 ENDIF
2383C
2384 ELSE ! PARTITH
2385C
2386 DO ni = 1, nintstamp
2387 nin = intstamp(ni)%NOINTER
2388 isens = ipari(64,nin) ! IF an interface sensor is defined
2389 interact = 0
2390
2391 IF (isens> 0) THEN ! Sensor ID
2392 ts = sensor_tab(isens)%TSTART
2393 IF (tt>=ts) interact = 1
2394 ELSE
2395 startt=intbuf_tab(nin)%VARIABLES(3)
2396 stopt =intbuf_tab(nin)%VARIABLES(11)
2397 IF (startt<=tt.AND.tt<=stopt) interact = 1
2398 ENDIF
2399C
2400 intth = ipari(47,nin)
2401 iform = ipari(48,nin)
2402C
2403 IF (interact/=0.AND.intth==2.AND.iform/=0)THEN
2404 niactif = niactif + 1
2405 interactif(niactif) = nin
2406 nodsi(niactif) = 0
2407 nodfi(niactif) = 0
2408 DO p=1,nspmd
2409 nodsi(niactif) = nodsi(niactif) + nmnsi(nin)%P(p)
2410 nodfi(niactif) = nodfi(niactif) + nmnfi(nin)%P(p)
2411 lens(p) = lens(p) + nmnsi(nin)%P(p)
2412 lenr(p)= lenr(p) + nmnfi(nin)%P(p)
2413 ENDDO
2414 nodsitot = nodsitot + nodsi(niactif)
2415 nodfitot = nodfitot + nodfi(niactif)
2416 ENDIF
2417 ENDDO
2418
2419C
2420C Init + ireceive sur taille communication
2421C
2422 siz = 0
2423 DO p = 1, nspmd
2424 isizrcv(1,p)=0
2425 isizrcv(2,p)=0
2426 isizenv(1,p) = 0
2427 isizenv(2,p) = 0
2428 IF(p/=loc_proc)THEN
2429 siz = lens(p)
2430 IF(siz>0)THEN
2431 msgtyp = msgoff
2432 CALL spmd_irecv(
2433 . isizrcv(1,p),2,it_spmd(p),msgtyp,
2434 . req_r(p))
2435 ENDIF
2436 ENDIF
2437 ENDDO
2438
2439C
2440C Partie 1 envoi et preparation buffer reception
2441C
2442 DO ni = 1, niactif
2443 nin = interactif(ni)
2444 nif = niskyfi(nin)
2445 IF(nif>0) THEN
2446 intth = ipari(47,nin)
2447
2448 ALLOCATE(index(nif),stat=ierror)
2449 IF(ierror/=0) THEN
2450 CALL ancmsg(msgid=20,anmode=aninfo)
2451 CALL arret(2)
2452 END IF
2453
2454 ALLOCATE( tempo(nif),stat=ierror)
2455
2456 IF(ierror/=0) THEN
2457 CALL ancmsg(msgid=20,anmode=aninfo)
2458 CALL arret(2)
2459 END IF
2460
2461 DO j=1,nif
2462 index(j)=j
2463 tempo(j)=ftheskyfi(nin)%P(j)
2464 ENDDO
2465
2466 CALL sortint(nif,iskyfi(nin)%P(1),index)
2467
2468 DO j=1,nif
2469 k=index(j)
2470 ftheskyfi(nin)%P(j)=tempo(k)
2471 ENDDO
2472C precomptage du nombre de contacts par processeur+calcul nsnfi total
2473 CALL intcontp(
2474 + nif,iskyfi(nin)%P(1),nmnfi(nin)%P(1),isizenv,lenr2,2)
2475
2476 IF (nif > 0 ) THEN
2477 DEALLOCATE(tempo,index)
2478 ENDIF
2479 ENDIF
2480
2481 ENDDO
2482C
2483C alloc comm structure
2484 iallocs = 0
2485 DO p = 1, nspmd
2486 IF(p/=loc_proc.AND.lenr(p)>0) THEN
2487 msgtyp = msgoff
2488 CALL spmd_isend(
2489 . isizenv(1,p),2,it_spmd(p),msgtyp,
2490 . req_s(p))
2491 iallocs = iallocs + isizenv(1,p)
2492 ENDIF
2493 END DO
2494 ierror=0
2495 IF(iallocs>0)
2496 + ALLOCATE(rbufs(iallocs+niactif*nspmd*2),stat=ierror) ! nbintc*NIACTIF*2 majorant place supplementaire bufs
2497 IF(ierror/=0) THEN
2498 CALL ancmsg(msgid=20,anmode=aninfo)
2499 CALL arret(2)
2500 END IF
2501C
2502C Send
2503C
2504
2505 IF(niactif /= 0 ) THEN
2506C FILL comm structure
2507 ideb = 0
2508 DO ni = 1, niactif
2509 idebut(ni) = 0
2510 idebut2(ni) = 1
2511 ENDDO
2512 l=0
2513 siz = 0
2514 DO p = 1, nspmd
2515 iads(p) = l +1
2516 IF(p/= loc_proc.AND.isizenv(1,p)/= 0)THEN
2517 DO ni = 1, niactif
2518 nin = interactif(ni)
2519 len = nmnfi(nin)%P(p)
2520 IF(len /= 0) THEN
2521 ideb2 = idebut2(ni)
2522 ideb = idebut(ni)
2523 l = l + 1
2524 DO i = 1,len
2525C noeud generant une force
2526 nod = nmvfi(nin)%P(ideb+i)
2527 IF(ideb2<=niskyfi(nin)) THEN
2528 itest = iskyfi(nin)%P(ideb2)==ideb+i
2529 ELSE
2530 itest = .false.
2531 ENDIF
2532 DO WHILE(itest)
2533 rbufs(l+1)= nod
2534 rbufs(l+2)= ftheskyfi(nin)%P(ideb2)
2535 l = l + 2
2536 ideb2= ideb2 +1
2537 IF(ideb2<=niskyfi(nin)) THEN
2538 itest = iskyfi(nin)%P(ideb2)==ideb+i
2539 ELSE
2540 itest = .false.
2541 ENDIF
2542 ENDDO
2543 ENDDO
2544 rbufs(iads(p)) = (l-iads(p))/2
2545 idebut2(ni) = ideb2
2546 ENDIF
2547 ENDDO
2548C SEND comm structure
2549 siz = l+1-iads(p)
2550 siztemp(p) = siz
2551 msgtyp = msgoff2
2552 CALL spmd_isend(
2553 s rbufs(iads(p)),siz,it_spmd(p),msgtyp,
2554 g req_si(p))
2555 ENDIF
2556 DO ni = 1, niactif
2557 nin = interactif(ni)
2558 len = nmnfi(nin)%P(p)
2559 idebut(ni) = idebut(ni) + len
2560 ENDDO
2561 ENDDO
2562 DO ni = 1, niactif
2563 nin = interactif(ni)
2564 niskyfi(nin) = 0
2565 ENDDO
2566
2567C
2568C Receive 1er message : taille communication
2569C
2570 iallocr = 0
2571 DO p = 1, nspmd
2572 IF(p/=loc_proc.AND.lens(p)>0)THEN
2573 CALL spmd_wait(req_r(p))
2574 iallocr = max(iallocr,isizrcv(1,p)) ! pour comm bloquantes
2575c IALLOCR = IALLOCR + ISIZRCV(P) ! pour comm non bloquantes
2576 END IF
2577 END DO
2578C
2579 ierror=0
2580 IF(iallocr>0)
2581 . ALLOCATE(rbufr(iallocr+niactif*2),stat=ierror)
2582 IF(ierror/=0) THEN
2583 CALL ancmsg(msgid=20,anmode=aninfo)
2584 CALL arret(2)
2585 ENDIF
2586C
2587
2588 DO p=1,nspmd
2589 IF(p/= loc_proc.AND.isizrcv(1,p)/= 0)THEN
2590 msgtyp = msgoff2
2591 l = 1 ! envoi bloquant + opti alloc memoire sur max des comm
2592 CALL spmd_recv(rbufr(l),isizrcv(1,p)+niactif,it_spmd(p),msgtyp)
2593
2594 DO ni = 1, niactif
2595 nin = interactif(ni)
2596 len = nmnsi(nin)%P(p)
2597 IF(len /= 0) THEN
2598 nb = nint(rbufr(l))
2599 l = l + 1
2600 IF(nb /= 0) THEN
2601 ideb = 1
2602 DO i = 1,nb
2603 n = nint(rbufr(ideb+1))
2604 nod = intbuf_tab(nin)%MSR_L(n)
2605 nisky = nisky + 1
2606 fskyi(nisky,1)=zero
2607 fskyi(nisky,2)=zero
2608 fskyi(nisky,3)=zero
2609 fskyi(nisky,4)=zero
2610 IF(nodadt_therm == 1 ) condnskyi(nisky)=zero
2611 ftheskyi(nisky)=rbufr(ideb+2)
2612 isky(nisky) = nod
2613 ideb = ideb + 2
2614 ENDDO
2615 l = l + 2*nb
2616 ENDIF
2617 ENDIF
2618 ENDDO
2619 ENDIF
2620 ENDDO
2621
2622C WAITING for receiving msg
2623 DO p = 1, nspmd
2624 IF(p/=loc_proc)THEN
2625 IF(lenr(p)>0) THEN
2626 CALL spmd_wait(req_s(p))
2627 END IF
2628 IF(isizenv(1,p)>0)THEN
2629 CALL spmd_wait(req_si(p))
2630 END IF
2631 END IF
2632 END DO
2633 IF(ALLOCATED(rbufs)) DEALLOCATE(rbufs)
2634 IF(ALLOCATED(rbufr)) DEALLOCATE(rbufr)
2635 ENDIF
2636C
2637 ENDIF
2638#endif
2639 RETURN
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
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::intstamp
type(intstamp_data), dimension(:), allocatable intstamp
Definition intstamp_glob_mod.F:40
intstamp_mod
Definition intstamp_mod.F:38
tri7box::ftheskyfi
type(real_pointer), dimension(:), allocatable ftheskyfi
Definition tri7box.F:449
tri7box::iskyfi
type(int_pointer), dimension(:), allocatable iskyfi
Definition tri7box.F:480
tri7box::fthefi
type(real_pointer), dimension(:), allocatable fthefi
Definition tri7box.F:449
intcontp
subroutine intcontp(n, isky, nsnfi, isizenv, nsnfitot, len)
Definition spmd_i7tool.F:6233
sortint
subroutine sortint(n, isky, index)
Definition spmd_i7tool.F:5671

◆ spmd_i21tempcom()

subroutine spmd_i21tempcom ( integer, dimension(npari,ninter) ipari,
temp,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab )

Definition at line 1990 of file send_cand.F.

1991C============================================================================
1992C M o d u l e s
1993C-----------------------------------------------
1994 USE message_mod
1995 USE intstamp_mod
1996 USE intstamp_glob_mod
1997 USE intbufdef_mod
1998 USE sensor_mod
1999 USE spmd_mod
2000C-----------------------------------------------
2001C I m p l i c i t T y p e s
2002C-----------------------------------------------
2003#include "implicit_f.inc"
2004C-----------------------------------------------
2005C C o m m o n B l o c k s
2006C-----------------------------------------------
2007#include "com01_c.inc"
2008#include "com04_c.inc"
2009#include "com08_c.inc"
2010#include "param_c.inc"
2011#include "task_c.inc"
2012#include "intstamp_c.inc"
2013C-----------------------------------------------
2014C D u m m y A r g u m e n t s
2015C-----------------------------------------------
2016 INTEGER ,INTENT(IN) :: NSENSOR
2017 INTEGER IPARI(NPARI,NINTER)
2018C REAL
2019 my_real :: temp(*)
2020 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2021 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
2022C-----------------------------------------------
2023C L o c a l V a r i a b l e s
2024C-----------------------------------------------
2025#ifdef MPI
2026 INTEGER LEN, NI, NIN ,IDEB, IDEB2, P,I,
2027 . INTTH, LOC_PROC, MSGTYP,LENI,
2028 . MSGOFF,IERROR, REQ_S(NSPMD), IDEBUT2(NINTER),
2029 . ISENS,INTERACT,
2030 . NODSITOT,NODSI(NINTSTAMP),NIACTIF,INTERACTIF(NINTSTAMP),
2031 . LENS(NSPMD),LENR(NSPMD),IADS(NSPMD),IADR(NSPMD),NODFITOT,
2032 . NODFI(NINTSTAMP)
2033 DATA msgoff/2016/
2034
2035 my_real,DIMENSION(:), ALLOCATABLE :: rbufs, rbufr
2036C REAL
2037 my_real
2038 . startt,stopt,ts
2039C------------------------------------------------------------------------
2040 IF(nspmd==1) RETURN
2041C
2042 loc_proc = ispmd+1
2043C
2044 niactif = 0 ! Number of actif and Tri interfaces
2045 nodsitot = 0 ! Global Number of remote main node
2046 nodfitot = 0 ! Global Number of remote main node
2047C
2048 lens = 0
2049 lenr = 0
2050 DO ni = 1, nintstamp
2051 nin = intstamp(ni)%NOINTER
2052 isens = ipari(64,nin) ! IF an interface sensor is defined
2053 interact = 0
2054 IF (isens > 0) THEN ! Sensor ID
2055 ts = sensor_tab(isens)%TSTART
2056 IF (tt>=ts) interact = 1
2057 ELSE
2058 startt=intbuf_tab(nin)%VARIABLES(3)
2059 stopt =intbuf_tab(nin)%VARIABLES(11)
2060 IF (startt<=tt.AND.tt<=stopt) interact = 1
2061 ENDIF
2062C
2063 intth = ipari(47,nin)
2064C
2065 IF (interact/=0.AND.intth==2)THEN
2066 niactif = niactif + 1
2067 interactif(niactif) = nin
2068 nodsi(niactif) = 0
2069 nodfi(niactif) = 0
2070 DO p=1,nspmd
2071 nodsi(niactif) = nodsi(niactif) + nmnsi(nin)%P(p)
2072 nodfi(niactif) = nodfi(niactif) + nmnfi(nin)%P(p)
2073 lens(p) = lens(p) + nmnsi(nin)%P(p)
2074 lenr(p)= lenr(p) + nmnfi(nin)%P(p)
2075 ENDDO
2076 nodsitot = nodsitot + nodsi(niactif)
2077 nodfitot = nodfitot + nodfi(niactif)
2078 ENDIF
2079 ENDDO
2080
2081 IF(niactif /= 0 ) THEN
2082C alloc comm structure
2083 ALLOCATE(rbufs(nspmd*nodsitot),stat=ierror)
2084 IF(ierror/=0) THEN
2085 CALL ancmsg(msgid=20,anmode=aninfo)
2086 CALL arret(2)
2087 ENDIF
2088
2089 ALLOCATE(rbufr(nspmd*nodfitot),stat=ierror)
2090 IF(ierror/=0) THEN
2091 CALL ancmsg(msgid=20,anmode=aninfo)
2092 CALL arret(2)
2093 ENDIF
2094C FILL comm structure
2095 ideb = 0
2096 DO ni = 1, niactif
2097 idebut2(ni) = 0
2098 ENDDO
2099 IF(nodsitot/= 0) THEN
2100 DO p = 1, nspmd
2101 iads(p) = ideb +1
2102 IF(p/= loc_proc.AND.lens(p)/= 0)THEN
2103 DO ni = 1, niactif
2104 nin = interactif(ni)
2105 len = nmnsi(nin)%P(p)
2106 leni = nmnfi(nin)%P(p)
2107 IF(len /= 0) THEN
2108 ideb2 = idebut2(ni)
2109 DO i = 1,len
2110 rbufs(ideb+i)= temp(tempnod(nin)%P(ideb2+i))
2111 ENDDO
2112 ideb = ideb + len
2113 idebut2(ni) = idebut2(ni) + len
2114 ENDIF
2115 ENDDO
2116C SEND comm structure
2117
2118 msgtyp = msgoff
2119 CALL spmd_isend(
2120 s rbufs(iads(p)),lens(p),it_spmd(p),msgtyp,
2121 g req_s(p))
2122 ENDIF
2123 ENDDO
2124 ENDIF
2125
2126 iadr(1) = 1
2127 DO p=1,nspmd-1
2128 iadr(p+1) =iadr(p)+lenr(p)
2129 ENDDO
2130C RECEIVE comm structure
2131 DO ni = 1, niactif
2132 idebut2(ni) = 0
2133 ENDDO
2134 IF(nodfitot /=0) THEN
2135 DO p=1,nspmd
2136 IF(p/= loc_proc.AND.lenr(p)/= 0)THEN
2137 msgtyp = msgoff
2138 CALL spmd_recv(rbufr(iadr(p)),lenr(p),it_spmd(p),
2139 . msgtyp)
2140 ideb= iadr(p)-1
2141
2142 DO ni = 1, niactif
2143 nin = interactif(ni)
2144 len = nmnfi(nin)%P(p)
2145 IF(len /= 0) THEN
2146 ideb2 = idebut2(ni)
2147 DO i = 1,len
2148 nmtemp(nin)%P(ideb2+i)= rbufr(ideb+i)
2149 ENDDO
2150 idebut2(ni) = idebut2(ni) + len
2151 ENDIF
2152 ENDDO
2153 ENDIF
2154 ENDDO
2155 ENDIF
2156C WAITING for receiving msg
2157 DO p = 1, nspmd
2158 IF(p/= loc_proc.AND.lens(p)/= 0)THEN
2159 CALL spmd_wait(req_s(p))
2160 ENDIF
2161 ENDDO
2162 IF(ALLOCATED(rbufs)) DEALLOCATE(rbufs)
2163 IF(ALLOCATED(rbufr)) DEALLOCATE(rbufr)
2164 ENDIF
2165C
2166#endif
2167 RETURN
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

◆ spmd_ifront_stamp()

subroutine spmd_ifront_stamp ( integer, dimension(npari,ninter) ipari,
integer, intent(in) nsensor,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) retri,
temp,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
integer nbintc21,
integer, dimension(*) intlist21 )

Definition at line 1599 of file send_cand.F.

1602C============================================================================
1603C M o d u l e s
1604C-----------------------------------------------
1605 USE message_mod
1606 USE intstamp_mod
1607 USE intstamp_glob_mod
1608 USE intbufdef_mod
1609 USE sensor_mod
1610 USE spmd_mod
1611C-----------------------------------------------
1612C I m p l i c i t T y p e s
1613C-----------------------------------------------
1614#include "implicit_f.inc"
1615C-----------------------------------------------
1616C C o m m o n B l o c k s
1617C-----------------------------------------------
1618#include "com01_c.inc"
1619#include "com04_c.inc"
1620#include "com08_c.inc"
1621#include "param_c.inc"
1622#include "task_c.inc"
1623#include "intstamp_c.inc"
1624C-----------------------------------------------
1625C D u m m y A r g u m e n t s
1626C-----------------------------------------------
1627 INTEGER ,INTENT(IN) :: NSENSOR
1628 INTEGER IPARI(NPARI,NINTER),RETRI(*),
1629 . NBINTC21 ,INTLIST21(*)
1630C REAL
1631 my_real :: temp(*)
1632 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1633 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
1634C-----------------------------------------------
1635C L o c a l V a r i a b l e s
1636C-----------------------------------------------
1637#ifdef MPI
1638 INTEGER LEN, NI,NOD,
1639 . P, I, NIN ,IDEB, IDEB2, KK,
1640 . INTTH, LOC_PROC, MSGTYP,
1641 . MSGOFF1, MSGOFF2,IERROR1,MSGOFF3,
1642 . IERROR, REQ_S(NSPMD), IAD(NSPMD),
1643 . IDEBUT2(NINTER), ISENS,INTERACT,
1644 . NODFITOT,NODFI(NINTSTAMP),NIACTIF,INTERACTIF(NINTSTAMP),
1645 . LENS(NSPMD),LENR(NSPMD),LENI(NSPMD),NODSI(NINTSTAMP),
1646 . IADS(NSPMD),IADR(NSPMD),NODFITOTS,NODFITOTR,IFLAGLOADP
1647 DATA msgoff1/1013/
1648 DATA msgoff2/2014/
1649 DATA msgoff3/1015/
1650 INTEGER,DIMENSION(:), ALLOCATABLE :: IBUFS, IBUFR
1651 my_real,DIMENSION(:), ALLOCATABLE :: rbufs, rbufr
1652C REAL
1653 my_real
1654 . startt,stopt,ts
1655C-----------------------------------------------
1656 IF(nspmd==1) RETURN
1657C
1658 loc_proc = ispmd+1
1659C
1660C-------------------------------------------------------------------------------
1661C Check inactif interfaces and end of tri ( I21buce)
1662C------------------------------------------------------------------------------
1663 niactif = 0 ! Number of actif and Tri interfaces
1664 nodfitot = 0 ! Global Number of remote main node
1665 nodfitots = 0
1666 nodfitotr = 0
1667 interactif = 0
1668 nodfi = 0
1669
1670 DO kk = 1, nbintc21
1671 ni = intlist21(kk)
1672 nin = intstamp(ni)%NOINTER
1673 isens = ipari(64,nin) ! IF an interface sensor is defined
1674 interact = 0
1675 IF (isens > 0) THEN ! Sensor ID
1676 ts = sensor_tab(isens)%TSTART
1677 IF (tt>=ts) interact = 1
1678 ELSE
1679 startt=intbuf_tab(nin)%VARIABLES(3)
1680 stopt =intbuf_tab(nin)%VARIABLES(11)
1681 IF (startt<=tt.AND.tt<=stopt) interact = 1
1682 ENDIF
1683C
1684 iflagloadp = 0 !IPARI(95,NIN)
1685 intth = ipari(47,nin)
1686
1687 IF (retri(nin)== 1.AND.interact/=0.AND.(intth==2.OR.iflagloadp > 0))THEN
1688 niactif = niactif + 1
1689 interactif(niactif) = nin
1690 nodfi(niactif) = 0
1691 DO p=1,nspmd
1692 nodfi(niactif) = nodfi(niactif) + nmnfi(nin)%P(p)
1693 ENDDO
1694 nodfitot = nodfitot + nodfi(niactif)
1695 ENDIF
1696 ENDDO
1697C
1698C-------------------------------------------------------------------------------
1699C First COMM : COMM number of main remote node
1700C------------------------------------------------------------------------------
1701 IF(niactif /= 0) THEN
1702C alloc comm structure
1703 ALLOCATE(ibufs(niactif*nspmd),stat=ierror)
1704 IF(ierror/=0) THEN
1705 CALL ancmsg(msgid=20,anmode=aninfo)
1706 CALL arret(2)
1707 ENDIF
1708 ALLOCATE(ibufr(niactif*nspmd),stat=ierror)
1709 IF(ierror/=0) THEN
1710 CALL ancmsg(msgid=20,anmode=aninfo)
1711 CALL arret(2)
1712 ENDIF
1713C FILL comm structure
1714 ideb = 1
1715 DO p=1,nspmd
1716 lens(p) = 0
1717 IF (p/= loc_proc)THEN
1718 iad(p) = ideb
1719 DO ni = 1, niactif
1720 nin = interactif(ni)
1721 ibufs(ideb)= nmnfi(nin)%P(p)
1722 lens(p) = lens(p) + nmnfi(nin)%P(p)
1723 ideb = ideb +1
1724 nodfitots = nodfitots+nmnfi(nin)%P(p)
1725 ENDDO
1726
1727C SEND comm structure
1728 msgtyp = msgoff1
1729 CALL spmd_isend(
1730 s ibufs(iad(p)),niactif,it_spmd(p),msgtyp,
1731 g req_s(p))
1732
1733 ENDIF
1734 ENDDO
1735C RECEIVE comm structure
1736 DO ni = 1, niactif
1737 nodsi(ni) = 0
1738 ENDDO
1739c
1740 DO p=1,nspmd
1741 lenr(p) = 0
1742 msgtyp = msgoff1
1743 IF (p/= loc_proc)THEN
1744
1745 CALL spmd_recv(ibufr(iad(p)),niactif,it_spmd(p),msgtyp)
1746
1747 ideb= iad(p)
1748 lenr(p) = 0
1749 DO ni = 1, niactif
1750 nin = interactif(ni)
1751 nmnsi(nin)%P(p)= ibufr(ideb)
1752 lenr(p) = lenr(p) + nmnsi(nin)%P(p)
1753 nodsi(ni) = nodsi(ni) + nmnsi(nin)%P(p)
1754 ideb = ideb + 1
1755 nodfitotr = nodfitotr+nmnsi(nin)%P(p)
1756 ENDDO
1757 ENDIF
1758 ENDDO
1759C WAITING for receiving msg
1760 DO p = 1, nspmd
1761 IF (p/= loc_proc)THEN
1762 CALL spmd_wait(req_s(p))
1763 ENDIF
1764 ENDDO
1765C-------------------------------------------------------------------------------
1766C SECOND COMM : COMM main remote node
1767C------------------------------------------------------------------------------
1768C alloc comm structure
1769 DO ni = 1, niactif
1770 nin = interactif(ni)
1771 IF(ASSOCIATED( nmvsi(nin)%P )) DEALLOCATE(nmvsi(nin)%P)
1772 ALLOCATE(nmvsi(nin)%P(nodsi(ni)),stat=ierror1)
1773
1774 IF(ASSOCIATED( tempnod(nin)%P )) DEALLOCATE(tempnod(nin)%P)
1775 ALLOCATE(tempnod(nin)%P(nodsi(ni)),stat=ierror1)
1776
1777 ENDDO
1778
1779 IF(ALLOCATED(ibufs)) DEALLOCATE(ibufs)
1780
1781 ALLOCATE(ibufs(nspmd*nodfitots),stat=ierror)
1782
1783 IF(ierror/=0) THEN
1784 CALL ancmsg(msgid=20,anmode=aninfo)
1785 CALL arret(2)
1786 ENDIF
1787
1788 IF(ALLOCATED(ibufr)) DEALLOCATE(ibufr)
1789 ALLOCATE(ibufr(nspmd*nodfitotr),stat=ierror)
1790
1791 IF(ierror/=0) THEN
1792 CALL ancmsg(msgid=20,anmode=aninfo)
1793 CALL arret(2)
1794 ENDIF
1795C FILL comm structure
1796 iads(1) = 1
1797 iadr(1) = 1
1798 DO p=1,nspmd-1
1799 iads(p+1) =iads(p)+lens(p)
1800 iadr(p+1) =iadr(p)+lenr(p)
1801 ENDDO
1802 ideb = 0
1803 DO ni = 1, niactif
1804 idebut2(ni) = 0
1805 ENDDO
1806
1807 DO p = 1, nspmd
1808 IF(p/= loc_proc.AND.lens(p)/=0)THEN
1809 DO ni = 1, niactif
1810 nin = interactif(ni)
1811 len = nmnfi(nin)%P(p)
1812
1813 IF(len /= 0) THEN
1814 ideb2 = idebut2(ni)
1815 DO i = 1,len
1816 ibufs(ideb+i)= nmvfi(nin)%P(ideb2+i)
1817 ENDDO
1818 ideb = ideb + len
1819 idebut2(ni) = idebut2(ni) + len
1820 ENDIF
1821 ENDDO
1822
1823C SEND comm structure
1824 msgtyp = msgoff2
1825
1826 CALL spmd_isend(
1827 s ibufs(iads(p)),lens(p),it_spmd(p),msgtyp,
1828 g req_s(p))
1829
1830 ENDIF
1831 ENDDO
1832
1833C RECEIVE comm structure
1834c IDEB = 0
1835 DO ni = 1, niactif
1836 idebut2(ni) = 0
1837 ENDDO
1838
1839 DO p=1,nspmd
1840 IF(p/= loc_proc.AND.lenr(p)/=0)THEN
1841 msgtyp = msgoff2
1842
1843 CALL spmd_recv(ibufr(iadr(p)),lenr(p),it_spmd(p),
1844 . msgtyp)
1845 ideb = iadr(p)-1
1846 DO ni = 1, niactif
1847 nin = interactif(ni)
1848 len = nmnsi(nin)%P(p)
1849 IF(len /= 0) THEN
1850 ideb2 = idebut2(ni)
1851
1852 DO i = 1,len
1853 nmvsi(nin)%P(ideb2+i)= ibufr(ideb+i)
1854 nod = intbuf_tab(nin)%MSR_L(nmvsi(nin)%P(ideb2+i))
1855 tempnod(nin)%P(ideb2+i)= nod
1856 ENDDO
1857 ideb = ideb + len
1858 ideb2 = ideb2 + len
1859 idebut2(ni) = idebut2(ni) + len
1860 ENDIF
1861 ENDDO
1862 ENDIF
1863 ENDDO
1864C WAITING for receiving msg
1865 DO p = 1, nspmd
1866 IF(p/= loc_proc.AND.lens(p)/=0)THEN
1867 CALL spmd_wait(req_s(p))
1868 ENDIF
1869 ENDDO
1870
1871 IF(ALLOCATED(ibufs)) DEALLOCATE(ibufs)
1872 IF(ALLOCATED(ibufr)) DEALLOCATE(ibufr)
1873C-------------------------------------------------------------------------------
1874C THIRD COMM : COMM main temperature
1875C------------------------------------------------------------------------------
1876C alloc comm structure
1877
1878 IF( ftempvar21==1 ) THEN
1879
1880 DO ni = 1, niactif
1881 nin = interactif(ni)
1882
1883 IF(ASSOCIATED( nmtemp(nin)%P )) DEALLOCATE(nmtemp(nin)%P)
1884 ALLOCATE(nmtemp(nin)%P(nodfi(ni)),stat=ierror1)
1885
1886 ENDDO
1887
1888 ALLOCATE(rbufs(nspmd*nodfitotr),stat=ierror)
1889 IF(ierror/=0) THEN
1890 CALL ancmsg(msgid=20,anmode=aninfo)
1891 CALL arret(2)
1892 ENDIF
1893
1894 ALLOCATE(rbufr(nspmd*nodfitots),stat=ierror)
1895 IF(ierror/=0) THEN
1896 CALL ancmsg(msgid=20,anmode=aninfo)
1897 CALL arret(2)
1898 ENDIF
1899 ideb = 0
1900 DO ni = 1, niactif
1901 idebut2(ni) = 0
1902 ENDDO
1903 DO p = 1, nspmd
1904 ideb = iadr(p)-1
1905 leni(p) = 0
1906 IF(p/= loc_proc.AND.lenr(p)/=0)THEN
1907 DO ni = 1, niactif
1908 nin = interactif(ni)
1909 len = nmnsi(nin)%P(p)
1910 IF(len /= 0) THEN
1911 ideb2 = idebut2(ni)
1912 DO i = 1,len
1913 rbufs(ideb+i)= temp(tempnod(nin)%P(ideb2+i))
1914 ENDDO
1915 ideb = ideb + len
1916 idebut2(ni) = idebut2(ni) + len
1917 leni(p) = leni(p) + len
1918 ENDIF
1919 ENDDO
1920
1921C SEND comm structure
1922 msgtyp = msgoff3
1923 CALL spmd_isend(
1924 s rbufs(iadr(p)),lenr(p),it_spmd(p),msgtyp,
1925 g req_s(p))
1926 ENDIF
1927 ENDDO
1928
1929C RECEIVE comm structure
1930 DO ni = 1, niactif
1931 idebut2(ni) = 0
1932 ENDDO
1933
1934 DO p=1,nspmd
1935 IF(p/= loc_proc.AND.lens(p)/=0)THEN
1936 msgtyp = msgoff3
1937 CALL spmd_recv(rbufr(iads(p)),lens(p),it_spmd(p),
1938 . msgtyp)
1939
1940 ideb = iads(p)-1
1941 DO ni = 1, niactif
1942 nin = interactif(ni)
1943 len = nmnfi(nin)%P(p)
1944 IF(len /= 0) THEN
1945 ideb2 = idebut2(ni)
1946 DO i = 1,len
1947 nmtemp(nin)%P(ideb2+i)= rbufr(ideb+i)
1948 ENDDO
1949 ideb = ideb + len
1950 idebut2(ni) = idebut2(ni) + len
1951 ENDIF
1952 ENDDO
1953 ENDIF
1954 ENDDO
1955C WAITING for receiving msg
1956 DO p = 1, nspmd
1957 IF(p/= loc_proc.AND.lenr(p)/=0)THEN
1958 CALL spmd_wait(req_s(p))
1959 ENDIF
1960 ENDDO
1961
1962 IF(ALLOCATED(rbufs)) DEALLOCATE(rbufs)
1963 IF(ALLOCATED(rbufr)) DEALLOCATE(rbufr)
1964
1965 ENDIF
1966
1967 ENDIF
1968
1969C
1970#endif
1971 RETURN
intstamp_glob_mod::nmvsi
type(int_pointer), dimension(:), allocatable nmvsi
Definition intstamp_glob_mod.F:73

◆ spmd_sd_stfa20()

subroutine spmd_sd_stfa20 ( integer loc_proc,
integer pmain,
integer lenx,
integer, dimension(*) cand_n,
integer, dimension(*) nsv,
integer i_stok,
integer nsn,
stfa,
integer, dimension(*) ienvoi,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(*) itab,
integer, dimension(*) nlg,
integer nin )

Definition at line 1116 of file send_cand.F.

1120C-----------------------------------------------
1121C M o d u l e s
1122C-----------------------------------------------
1123 USE tri7box
1124 USE spmd_mod
1125C-----------------------------------------------
1126C I m p l i c i t T y p e s
1127C-----------------------------------------------
1128#include "implicit_f.inc"
1129C-----------------------------------------------
1130C C o m m o n B l o c k s
1131C-----------------------------------------------
1132#include "com01_c.inc"
1133#include "com04_c.inc"
1134#include "scr17_c.inc"
1135#include "task_c.inc"
1136C-----------------------------------------------
1137C D u m m y A r g u m e n t s
1138C-----------------------------------------------
1139 INTEGER LOC_PROC, PMAIN, I_STOK, NSN, LENX, NIN,
1140 . IENVOI(*), CAND_N(*), NSV(*), ITAB(*), NLG(*),
1141 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*)
1142 my_real
1143 . stfa(*)
1144C-----------------------------------------------
1145C L o c a l V a r i a b l e s
1146C-----------------------------------------------
1147#ifdef MPI
1148 INTEGER I,K,LEN,LENR,NUSER,IDEB,P,NB,
1149 . MSGOFF,MSGTYP,
1150 . IBUFFER(LENX)
1151 DATA msgoff/1006/
1152C-----------------------------------------------
1153C S o u r c e L i n e s
1154C-----------------------------------------------
1155C
1156 len = 0
1157C traitement sur tout NSN pour le cas shooting nodes
1158 IF(idel7ng>=1)THEN
1159 DO i = 1, nsn
1160 IF(stfa(nsv(i))<zero) THEN
1161 len = len + 1
1162 ibuffer(len) = itab(nlg(nsv(i)))
1163 ENDIF
1164 ENDDO
1165 ideb = 0
1166 DO p = 1, nspmd
1167 IF(p/=loc_proc)THEN
1168 nb = nsnfi(nin)%P(p)
1169 DO i = ideb+1, ideb+nb
1170 IF(stifi(nin)%P(i)<zero) THEN
1171 len = len + 1
1172 ibuffer(len) = itafi(nin)%P(i)
1173 END IF
1174 END DO
1175 ideb = ideb + nb
1176 END IF
1177 END DO
1178 ELSE
1179 DO i = 1, i_stok
1180 IF(cand_n(i)<=nsn) THEN
1181Candidat interne
1182 IF(stfa(nsv(cand_n(i)))<zero) THEN
1183 len = len + 1
1184 ibuffer(len) = itab(nlg(nsv(cand_n(i))))
1185 ENDIF
1186Candidat frontiere
1187 ELSEIF(stifi(nin)%P(cand_n(i)-nsn)<zero) THEN
1188 len = len + 1
1189 ibuffer(len) = itafi(nin)%P(cand_n(i)-nsn)
1190 ENDIF
1191 ENDDO
1192 END IF
1193C
1194 IF (loc_proc/=pmain) THEN
1195C pack des candidats ayant stifness negative
1196C
1197 msgtyp=msgoff
1198 IF(len>0) THEN
1199 CALL spmd_send(ibuffer,len,it_spmd(pmain),msgtyp)
1200 ENDIF
1201 CALL spmd_recv(ibuffer,lenx,it_spmd(pmain),msgtyp)
1202 ELSE
1203Calcul taille totale
1204 lenr = len
1205 DO k = 1, nspmd
1206 IF (ienvoi(k)/=0) THEN
1207 msgtyp=msgoff
1208 CALL spmd_recv(
1209 . ibuffer(lenr+1),ienvoi(k),it_spmd(k),msgtyp)
1210 lenr = lenr + ienvoi(k)
1211 ENDIF
1212 ENDDO
1213C
1214 DO k = 1, nspmd
1215 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
1216 . ircvfrom(nin,k)/=0)) THEN
1217 msgtyp=msgoff
1218 CALL spmd_send(ibuffer,lenx,it_spmd(k),msgtyp)
1219 ENDIF
1220 ENDDO
1221C envoi des stifness
1222 ENDIF
1223C
1224 DO i = 1, lenx
1225 nuser = ibuffer(i)
1226C noeud interne
1227 DO k = 1, nsn
1228 IF(itab(nlg(nsv(k)))==nuser) THEN
1229 stfa(nsv(k)) = zero
1230 ENDIF
1231 ENDDO
1232Candidat frontiere
1233 ideb = 0
1234 DO p = 1, nspmd
1235 IF(p/=loc_proc)THEN
1236 nb = nsnfi(nin)%P(p)
1237 DO k = ideb+1, ideb+nb
1238 IF(itafi(nin)%P(k)==nuser) THEN
1239 stifi(nin)%P(k) = zero
1240 END IF
1241 END DO
1242 ideb = ideb + nb
1243 END IF
1244 END DO
1245 ENDDO
1246C
1247#endif
1248 RETURN
tri7box::itafi
type(int_pointer), dimension(:), allocatable itafi
Definition tri7box.F:440

◆ spmd_sd_stfn()

subroutine spmd_sd_stfn ( integer loc_proc,
integer pmain,
integer lenx,
integer, dimension(*) cand_n,
integer, dimension(*) nsv,
integer i_stok,
integer nsn,
stfn,
integer, dimension(*) ienvoi,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(*) itab,
integer nin )

Definition at line 845 of file send_cand.F.

849C-----------------------------------------------
850C M o d u l e s
851C-----------------------------------------------
852 USE tri7box
853 USE spmd_mod
854C-----------------------------------------------
855C I m p l i c i t T y p e s
856C-----------------------------------------------
857#include "implicit_f.inc"
858C-----------------------------------------------
859C C o m m o n B l o c k s
860C-----------------------------------------------
861#include "com01_c.inc"
862#include "com04_c.inc"
863#include "scr17_c.inc"
864#include "task_c.inc"
865C-----------------------------------------------
866C D u m m y A r g u m e n t s
867C-----------------------------------------------
868 INTEGER LOC_PROC, PMAIN, I_STOK, NSN, LENX, NIN,
869 . IENVOI(*), CAND_N(*), NSV(*), ITAB(*),
870 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*)
871 my_real
872 . stfn(*)
873C-----------------------------------------------
874C L o c a l V a r i a b l e s
875C-----------------------------------------------
876#ifdef MPI
877 INTEGER I,K,LEN,LENR,NUSER,IDEB,P,NB,
878 . MSGOFF,MSGTYP,
879 . IBUFFER(LENX)
880 DATA msgoff/1005/
881C-----------------------------------------------
882C S o u r c e L i n e s
883C-----------------------------------------------
884C
885 len = 0
886C traitement sur tout NSN pour le cas shooting nodes
887 IF(idel7ng>=1)THEN
888 DO i = 1, nsn
889 IF(stfn(i)<zero) THEN
890 len = len + 1
891 ibuffer(len) = itab(nsv(i))
892 ENDIF
893 ENDDO
894 ideb = 0
895 DO p = 1, nspmd
896 IF(p/=loc_proc)THEN
897 nb = nsnfi(nin)%P(p)
898 DO i = ideb+1, ideb+nb
899 IF(stifi(nin)%P(i)<zero) THEN
900 len = len + 1
901 ibuffer(len) = itafi(nin)%P(i)
902 END IF
903 END DO
904 ideb = ideb + nb
905 END IF
906 END DO
907 ELSE
908 DO i = 1, i_stok
909 IF(cand_n(i)<=nsn) THEN
910Candidat interne
911 IF(stfn(cand_n(i))<zero) THEN
912 len = len + 1
913 ibuffer(len) = itab(nsv(cand_n(i)))
914 ENDIF
915Candidat frontiere
916 ELSEIF(stifi(nin)%P(cand_n(i)-nsn)<zero) THEN
917 len = len + 1
918 ibuffer(len) = itafi(nin)%P(cand_n(i)-nsn)
919 ENDIF
920 ENDDO
921 END IF
922C
923 IF (loc_proc/=pmain) THEN
924C pack des candidats ayant stifness negative
925C
926 msgtyp=msgoff
927 IF(len>0) THEN
928 CALL spmd_send(ibuffer,len,it_spmd(pmain),msgtyp)
929 ENDIF
930 CALL spmd_recv(ibuffer,lenx,it_spmd(pmain),msgtyp)
931 ELSE
932Calcul taille totale
933 lenr = len
934 DO k = 1, nspmd
935 IF (ienvoi(k)/=0) THEN
936 msgtyp=msgoff
937 CALL spmd_recv(
938 . ibuffer(lenr+1),ienvoi(k),it_spmd(k),msgtyp)
939 lenr = lenr + ienvoi(k)
940 ENDIF
941 ENDDO
942C
943 DO k = 1, nspmd
944 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
945 . ircvfrom(nin,k)/=0)) THEN
946 msgtyp=msgoff
947 CALL spmd_send(ibuffer,lenx,it_spmd(k),msgtyp)
948 ENDIF
949 ENDDO
950C envoi des stifness
951 ENDIF
952C
953 DO i = 1, lenx
954 nuser = ibuffer(i)
955C noeud interne
956 DO k = 1, nsn
957 IF(itab(nsv(k))==nuser) THEN
958 stfn(k) = zero
959 ENDIF
960 ENDDO
961Candidat frontiere
962 ideb = 0
963 DO p = 1, nspmd
964 IF(p/=loc_proc)THEN
965 nb = nsnfi(nin)%P(p)
966 DO k = ideb+1, ideb+nb
967 IF(itafi(nin)%P(k)==nuser) THEN
968 stifi(nin)%P(k) = zero
969 END IF
970 END DO
971 ideb = ideb + nb
972 END IF
973 END DO
974 ENDDO
975C
976#endif
977 RETURN

◆ spmd_sd_stfn11()

subroutine spmd_sd_stfn11 ( integer loc_proc,
integer pmain,
integer lenx,
integer, dimension(*) cand_s,
integer, dimension(2,*) irects,
integer i_stok,
integer nrts,
stfs,
integer, dimension(*) ienvoi,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(*) itab,
integer nin )

Definition at line 1260 of file send_cand.F.

1264C-----------------------------------------------
1265C M o d u l e s
1266C-----------------------------------------------
1267 USE tri7box
1268 USE spmd_mod
1269C-----------------------------------------------
1270C I m p l i c i t T y p e s
1271C-----------------------------------------------
1272#include "implicit_f.inc"
1273C-----------------------------------------------
1274C C o m m o n B l o c k s
1275C-----------------------------------------------
1276#include "com01_c.inc"
1277#include "com04_c.inc"
1278#include "scr17_c.inc"
1279#include "task_c.inc"
1280C-----------------------------------------------
1281C D u m m y A r g u m e n t s
1282C-----------------------------------------------
1283 INTEGER LOC_PROC, PMAIN, I_STOK, LENX, NIN, NRTS,
1284 . IENVOI(*), CAND_S(*), IRECTS(2,*), ITAB(*),
1285 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*)
1286 my_real
1287 . stfs(*)
1288C-----------------------------------------------
1289C L o c a l V a r i a b l e s
1290C-----------------------------------------------
1291#ifdef MPI
1292 INTEGER I,K,LEN,LENR,NUSER1,NUSER2,N1,N2,NI,
1293 . MSGOFF,MSGTYP,IDEB,P,NB,
1294 . IBUFFER(LENX)
1295 DATA msgoff/1007/
1296C-----------------------------------------------
1297C S o u r c e L i n e s
1298C-----------------------------------------------
1299C
1300 len = 0
1301C traitement sur tout NSN pour le cas shooting nodes
1302 IF(idel7ng>=1)THEN
1303 DO i = 1, nrts
1304 IF(stfs(i)<zero) THEN
1305 n1 = irects(1,i)
1306 n2 = irects(2,i)
1307 ibuffer(len+1) = itab(n1)
1308 ibuffer(len+2) = itab(n2)
1309 len = len + 2
1310 END IF
1311 END DO
1312 ideb = 0
1313 DO p = 1, nspmd
1314 IF(p/=loc_proc)THEN
1315 nb = nsnfi(nin)%P(p)
1316 DO i = ideb+1, ideb+nb
1317 IF(stifi(nin)%P(i)<zero) THEN
1318 n1 = 2*(i-1)+1
1319 n2 = 2*i
1320 ibuffer(len+1) = itafi(nin)%P(n1)
1321 ibuffer(len+2) = itafi(nin)%P(n2)
1322 len = len + 2
1323 END IF
1324 END DO
1325 ideb = ideb + nb
1326 END IF
1327 END DO
1328 ELSE
1329 DO i = 1, i_stok
1330 IF(cand_s(i)<=nrts) THEN
1331Candidat interne
1332 IF(stfs(cand_s(i))<zero) THEN
1333 n1 = irects(1,cand_s(i))
1334 n2 = irects(2,cand_s(i))
1335 ibuffer(len+1) = itab(n1)
1336 ibuffer(len+2) = itab(n2)
1337 len = len + 2
1338 ENDIF
1339Candidat frontiere
1340 ELSEIF(stifi(nin)%P(cand_s(i)-nrts)<zero) THEN
1341 ni = cand_s(i)-nrts
1342 n1 = 2*(ni-1)+1
1343 n2 = 2*ni
1344 ibuffer(len+1) = itafi(nin)%P(n1)
1345 ibuffer(len+2) = itafi(nin)%P(n2)
1346 len = len + 2
1347 ENDIF
1348 ENDDO
1349 ENDIF
1350C
1351 IF (loc_proc/=pmain) THEN
1352C pack des candidats ayant stifness negative
1353C
1354 msgtyp=msgoff
1355 IF(len>0) THEN
1356 CALL spmd_send(ibuffer,len,it_spmd(pmain),msgtyp)
1357 ENDIF
1358 CALL spmd_recv(ibuffer,lenx,it_spmd(pmain),msgtyp)
1359 ELSE
1360Calcul taille totale
1361 lenr = len
1362 DO k = 1, nspmd
1363 IF (ienvoi(k)/=0) THEN
1364 msgtyp=msgoff
1365 CALL spmd_recv(
1366 . ibuffer(lenr+1),ienvoi(k),it_spmd(k),msgtyp)
1367 lenr = lenr + ienvoi(k)
1368 ENDIF
1369 ENDDO
1370C
1371 DO k = 1, nspmd
1372 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
1373 . ircvfrom(nin,k)/=0)) THEN
1374 msgtyp=msgoff
1375 CALL spmd_send(ibuffer,lenx,it_spmd(k),msgtyp)
1376 ENDIF
1377 ENDDO
1378C envoi des stifness
1379 ENDIF
1380C
1381 DO i = 1, lenx/2
1382 nuser1 = ibuffer(2*(i-1)+1)
1383 nuser2 = ibuffer(2*i)
1384C arete interne
1385 DO k = 1, nrts
1386 n1 = irects(1,k)
1387 n2 = irects(2,k)
1388 IF(itab(n1)==nuser1.AND.itab(n2)==nuser2) THEN
1389 stfs(k) = zero
1390 END IF
1391 END DO
1392Candidat frontiere
1393 ideb = 0
1394 DO p = 1, nspmd
1395 IF(p/=loc_proc)THEN
1396 nb = nsnfi(nin)%P(p)
1397 DO k = ideb+1, ideb+nb
1398 n1 = 2*(k-1)+1
1399 n2 = 2*k
1400 IF(itafi(nin)%P(n1)==nuser1.AND.
1401 . itafi(nin)%P(n2)==nuser2) THEN
1402 stifi(nin)%P(k) = zero
1403 END IF
1404 END DO
1405 ideb = ideb + nb
1406 END IF
1407 END DO
1408 END DO
1409C
1410#endif
1411 RETURN

◆ spmd_sd_stfn20e()

subroutine spmd_sd_stfn20e ( integer loc_proc,
integer pmain,
integer lenx,
integer, dimension(*) cand_s,
integer, dimension(2,*) ixlins,
integer i_stok,
integer nlinsa,
stfs,
integer, dimension(*) ienvoi,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(*) itab,
integer, dimension(*) nlg,
integer nin )

Definition at line 1423 of file send_cand.F.

1427C-----------------------------------------------
1428C M o d u l e s
1429C-----------------------------------------------
1430 USE tri7box
1431 USE spmd_mod
1432C-----------------------------------------------
1433C I m p l i c i t T y p e s
1434C-----------------------------------------------
1435#include "implicit_f.inc"
1436C-----------------------------------------------
1437C C o m m o n B l o c k s
1438C-----------------------------------------------
1439#include "com01_c.inc"
1440#include "com04_c.inc"
1441#include "scr17_c.inc"
1442#include "task_c.inc"
1443C-----------------------------------------------
1444C D u m m y A r g u m e n t s
1445C-----------------------------------------------
1446 INTEGER LOC_PROC, PMAIN, I_STOK, LENX, NIN, NLINSA,
1447 . IENVOI(*), CAND_S(*), IXLINS(2,*), ITAB(*),
1448 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*), NLG(*)
1449 my_real
1450 . stfs(*)
1451C-----------------------------------------------
1452C L o c a l V a r i a b l e s
1453C-----------------------------------------------
1454#ifdef MPI
1455 INTEGER I,K,LEN,LENR,NUSER1,NUSER2,N1,N2,NI,
1456 . MSGOFF,MSGTYP,IDEB,P,NB,N1L,N2L,
1457 . IBUFFER(LENX)
1458 DATA msgoff/1008/
1459C-----------------------------------------------
1460C S o u r c e L i n e s
1461C-----------------------------------------------
1462C
1463 len = 0
1464C traitement sur tout NSN pour le cas shooting nodes
1465 IF(idel7ng>=1)THEN
1466 DO i = 1, nlinsa
1467 IF(stfs(i)<zero) THEN
1468 n1l = ixlins(1,i)
1469 n2l = ixlins(2,i)
1470 n1 = nlg(n1l)
1471 n2 = nlg(n2l)
1472 ibuffer(len+1) = itab(n1)
1473 ibuffer(len+2) = itab(n2)
1474 len = len + 2
1475 END IF
1476 END DO
1477 ideb = 0
1478 DO p = 1, nspmd
1479 IF(p/=loc_proc)THEN
1480 nb = nsnfie(nin)%P(p)
1481 DO i = ideb+1, ideb+nb
1482 IF(stifie(nin)%P(i)<zero) THEN
1483 n1 = 2*(i-1)+1
1484 n2 = 2*i
1485 ibuffer(len+1) = itafie(nin)%P(n1)
1486 ibuffer(len+2) = itafie(nin)%P(n2)
1487 len = len + 2
1488 END IF
1489 END DO
1490 ideb = ideb + nb
1491 END IF
1492 END DO
1493 ELSE
1494 DO i = 1, i_stok
1495 IF(cand_s(i)<=nlinsa) THEN
1496Candidat interne
1497 IF(stfs(cand_s(i))<zero) THEN
1498 n1l = ixlins(1,cand_s(i))
1499 n2l = ixlins(2,cand_s(i))
1500 n1 = nlg(n1l)
1501 n2 = nlg(n2l)
1502 ibuffer(len+1) = itab(n1)
1503 ibuffer(len+2) = itab(n2)
1504 len = len + 2
1505 ENDIF
1506Candidat frontiere
1507 ELSEIF(stifie(nin)%P(cand_s(i)-nlinsa)<zero) THEN
1508 ni = cand_s(i)-nlinsa
1509 n1 = 2*(ni-1)+1
1510 n2 = 2*ni
1511 ibuffer(len+1) = itafie(nin)%P(n1)
1512 ibuffer(len+2) = itafie(nin)%P(n2)
1513 len = len + 2
1514 ENDIF
1515 ENDDO
1516 ENDIF
1517C
1518 IF (loc_proc/=pmain) THEN
1519C pack des candidats ayant stifness negative
1520C
1521 msgtyp=msgoff
1522 IF(len>0) THEN
1523 CALL spmd_send(ibuffer,len,it_spmd(pmain),msgtyp)
1524 ENDIF
1525 CALL spmd_recv(ibuffer,lenx,it_spmd(pmain),msgtyp)
1526 ELSE
1527Calcul taille totale
1528 lenr = len
1529 DO k = 1, nspmd
1530 IF (ienvoi(k)/=0) THEN
1531 msgtyp=msgoff
1532 CALL spmd_recv(
1533 . ibuffer(lenr+1),ienvoi(k),it_spmd(k),msgtyp)
1534 lenr = lenr + ienvoi(k)
1535 ENDIF
1536 ENDDO
1537C
1538 DO k = 1, nspmd
1539 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
1540 . ircvfrom(nin,k)/=0)) THEN
1541 msgtyp=msgoff
1542 CALL spmd_send(ibuffer,lenx,it_spmd(k),msgtyp)
1543 ENDIF
1544 ENDDO
1545C envoi des stifness
1546 ENDIF
1547C
1548 DO i = 1, lenx/2
1549 nuser1 = ibuffer(2*(i-1)+1)
1550 nuser2 = ibuffer(2*i)
1551C arete interne
1552 DO k = 1, nlinsa
1553 n1l = ixlins(1,k)
1554 n2l = ixlins(2,k)
1555 n1 = nlg(n1l)
1556 n2 = nlg(n2l)
1557 IF(itab(n1)==nuser1.AND.itab(n2)==nuser2) THEN
1558 stfs(k) = zero
1559 END IF
1560 END DO
1561Candidat frontiere
1562 ideb = 0
1563 DO p = 1, nspmd
1564 IF(p/=loc_proc)THEN
1565 nb = nsnfie(nin)%P(p)
1566 DO k = ideb+1, ideb+nb
1567 n1 = 2*(k-1)+1
1568 n2 = 2*k
1569 IF(itafie(nin)%P(n1)==nuser1.AND.
1570 . itafie(nin)%P(n2)==nuser2) THEN
1571 stifie(nin)%P(k) = zero
1572 END IF
1573 END DO
1574 ideb = ideb + nb
1575 END IF
1576 END DO
1577 END DO
1578C
1579#endif
1580 RETURN
tri7box::itafie
type(int_pointer), dimension(:), allocatable itafie
Definition tri7box.F:440

◆ spmd_sd_stfn25()

subroutine spmd_sd_stfn25 ( integer loc_proc,
integer pmain,
integer lenx,
integer, dimension(*) nsv,
integer nsn,
stfn,
integer, dimension(*) ienvoi,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(*) itab,
integer nin )

Definition at line 989 of file send_cand.F.

993C-----------------------------------------------
994C M o d u l e s
995C-----------------------------------------------
996 USE tri7box
997 USE spmd_mod
998C-----------------------------------------------
999C I m p l i c i t T y p e s
1000C-----------------------------------------------
1001#include "implicit_f.inc"
1002C-----------------------------------------------
1003C C o m m o n B l o c k s
1004C-----------------------------------------------
1005#include "com01_c.inc"
1006#include "com04_c.inc"
1007#include "task_c.inc"
1008C-----------------------------------------------
1009C D u m m y A r g u m e n t s
1010C-----------------------------------------------
1011 INTEGER LOC_PROC, PMAIN, NSN, LENX, NIN,
1012 . IENVOI(*), NSV(*), ITAB(*),
1013 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*)
1014 my_real
1015 . stfn(*)
1016C-----------------------------------------------
1017C L o c a l V a r i a b l e s
1018C-----------------------------------------------
1019#ifdef MPI
1020 INTEGER I,K,LEN,LENR,NUSER,IDEB,P,NB,
1021 . MSGOFF,MSGTYP,
1022 . IBUFFER(LENX)
1023 DATA msgoff/1005/
1024C-----------------------------------------------
1025C S o u r c e L i n e s
1026C-----------------------------------------------
1027C
1028 len = 0
1029C traitement sur tout NSN pour les nds precedemment impactes (ne figurent pas dans I_STOK)
1030 DO i = 1, nsn
1031 IF(stfn(i)<zero) THEN
1032 len = len + 1
1033 ibuffer(len) = itab(nsv(i))
1034 ENDIF
1035 ENDDO
1036 ideb = 0
1037 DO p = 1, nspmd
1038 IF(p/=loc_proc)THEN
1039 nb = nsnfi(nin)%P(p)
1040 DO i = ideb+1, ideb+nb
1041 IF(stifi(nin)%P(i)<zero) THEN
1042 len = len + 1
1043 ibuffer(len) = itafi(nin)%P(i)
1044 END IF
1045 END DO
1046 ideb = ideb + nb
1047 END IF
1048 END DO
1049C
1050 IF (loc_proc/=pmain) THEN
1051C pack des candidats ayant stifness negative
1052C
1053 msgtyp=msgoff
1054 IF(len>0) THEN
1055 CALL spmd_send(ibuffer,len,it_spmd(pmain),msgtyp)
1056 ENDIF
1057 CALL spmd_recv(ibuffer,lenx,it_spmd(pmain),msgtyp)
1058 ELSE
1059Calcul taille totale
1060 lenr = len
1061 DO k = 1, nspmd
1062 IF (ienvoi(k)/=0) THEN
1063 msgtyp=msgoff
1064 CALL spmd_recv(
1065 . ibuffer(lenr+1),ienvoi(k),it_spmd(k),msgtyp)
1066 lenr = lenr + ienvoi(k)
1067 ENDIF
1068 ENDDO
1069C
1070 DO k = 1, nspmd
1071 IF (k/=loc_proc.AND.(isendto(nin,k)/=0.OR.
1072 . ircvfrom(nin,k)/=0)) THEN
1073 msgtyp=msgoff
1074 CALL spmd_send(ibuffer,lenx,it_spmd(k),msgtyp)
1075 ENDIF
1076 ENDDO
1077C envoi des stifness
1078 ENDIF
1079C
1080 DO i = 1, lenx
1081 nuser = ibuffer(i)
1082C noeud interne
1083 DO k = 1, nsn
1084 IF(itab(nsv(k))==nuser) THEN
1085 stfn(k) = zero
1086 ENDIF
1087 ENDDO
1088Candidat frontiere
1089 ideb = 0
1090 DO p = 1, nspmd
1091 IF(p/=loc_proc)THEN
1092 nb = nsnfi(nin)%P(p)
1093 DO k = ideb+1, ideb+nb
1094 IF(itafi(nin)%P(k)==nuser) THEN
1095 stifi(nin)%P(k) = zero
1096 END IF
1097 END DO
1098 ideb = ideb + nb
1099 END IF
1100 END DO
1101 ENDDO
1102C
1103#endif
1104 RETURN