59
60
61
64 USE intbufdef_mod
67 USE sensor_mod
69
70
71
72#include "implicit_f.inc"
73#include "comlock.inc"
74
75
76
77#include "com01_c.inc"
78#include "com04_c.inc"
79#include "param_c.inc"
80#include "spmd_c.inc"
81#include "task_c.inc"
82#include "warn_c.inc"
83
84
85
86 INTEGER ,INTENT(IN) :: NSENSOR
87 INTEGER ,INTENT(IN) :: NODADT_THERM
88 INTEGER IPARI(NPARI,*), ITAB(*), INTLIST25(*), JTASK,
89 . IAD_ELEM(2,*) ,FR_ELEM(*), IAD_FRNOR(NINTER25,NSPMD+1), FR_NOR(*),
90 . KINET(*), NODNX_SMS(*), NB_DST1(PARASIZ), NB_DST2(PARASIZ)
91 INTEGER, INTENT(IN) :: ICODT(*),ISKEW(*)
92 my_real :: x(3,*), v(3,*), ms(*), temp(*)
93 TYPE(INTBUF_STRUCT_),DIMENSION(NINTER) :: INTBUF_TAB
94 INTEGER MAIN_PROC(NUMNOD)
95 INTEGER NBINTC,ISLEN7,IRLEN7,
96 . IRLEN7T,ISLEN7T,
97 . NEWFRONT(*), INTLIST(*),
98 . ISENDTO(NINTER+1,*) ,IRCVFROM(NINTER+1,*)
99 TYPE(H3D_DATABASE) :: H3D_DATA
100 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
101 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
102
103
104
105 INTEGER NIN, NI25, LENT25, IERROR, ITYP,
106 . IFQ, IGAP, INTTH, ILEV, IVIS2,
107 . I_STOK_GLO, I,J, NSNR, INACTI, NADMSR,
108 . N_OLD_IMPACT,
109 . P, RSIZ(NINTER25), ISIZ(NINTER25), SIZBUFS(NSPMD),
110 . NADMAX, LADMAX, NSLIDMX, NSENDTOT, NSNF, NSNL, NSNRF, NSNRL,INTFRIC ,
111 . FLAGREMN, LREMNORMAX, ISTIF_MSDT, IFSUB_CAREA
112 INTEGER SIZOPT, K_STOK, I_OPT_STOK
113 INTEGER, DIMENSION(:), ALLOCATABLE :: NADD, KADD,
114 . NSLIDE, FR_SLIDE, INDXTOSEND
115
116 TYPE(real_pointer), DIMENSION(NSPMD,NINTER25) :: RBUFS,RBUFR
117 TYPE(int_pointer) , DIMENSION(NSPMD,NINTER25) :: IBUFS,IBUFR
118
119
120 TYPE(MPI_COMM_STRUCT) :: COMM_INT
121 TYPE(MPI_COMM_STRUCT) :: COMM_REAL
122 TYPE(MPI_COMM_STRUCT) :: COMM_SIZ
123
124 INTEGER COMM_PATTERN(NSPMD,NINTER25)
125 INTEGER SIZBUFS_GLOB(NSPMD,NINTER25)
126 INTEGER SIZBUFR_GLOB(NSPMD,NINTER25)
127 INTEGER NB_TOT
128 INTEGER :: NRTM, NSN
129
130
131
132
133
134 DO ni25=1,ninter25
135
136 nin = intlist25(ni25)
137 nsn =ipari(5,nin)
138
139
140 nsnf = nsn*(jtask-1) / nthread
141 nsnl = nsn*jtask / nthread
142
143 intbuf_tab(nin)%ISLIDE(4*nsnf+1:4*nsnl)=0
144
145 END DO
146
147 IF(nspmd > 1)THEN
148 DO ni25=1,ninter25
149 nin = intlist25(ni25)
150 nsnr =ipari(24,nin)
151 nsnrf = 1 + nsnr*(jtask-1) / nthread
152 nsnrl = nsnr*jtask / nthread
154 END DO
155 END IF
156
158
159
160
161
162
163 DO ni25=1,ninter25
164 nin = intlist25(ni25)
165 ipari(29,nin) = 0
166 END DO
167
168
169 DO ni25=1,ninter25
170 nin = intlist25(ni25)
172 1 ipari ,intbuf_tab(nin),x ,itab ,nin ,
173 2 kinet ,jtask ,nb_dst1(jtask),v
174 3 sensor_tab)
175 ENDDO
176
178
179
180
184
185
186 nslidmx=0
187 nadmax =0
188
189 sizbufr_glob(1:nspmd,1:ninter25) = 0
190 sizbufs_glob(1:nspmd,1:ninter25) = 0
191 isiz(1:ninter25) = 0
192 rsiz(1:ninter25) = 0
193
194
195
196
197 comm_pattern(1:nspmd,1:ninter25) = 0
198 DO ni25=1,ninter25
199
200 nin = intlist25(ni25)
201
202 ipari(29,nin) = 0
203
204 DO p = 1,nspmd
205 lent25 = iad_frnor(ni25,p+1)-iad_frnor(ni25,p)
206 IF(p /= ispmd +1 .AND. lent25 /= 0) THEN
207 comm_pattern(p,ni25) = 1
208 ENDIF
209 ENDDO
210 ENDDO
211
212 DO ni25=1,ninter25
213 sizbufs(1:nspmd) = 0
214
215 nin = intlist25(ni25)
216
217 ipari(29,nin) = 0
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234 lent25 = iad_frnor(ni25,nspmd+1)-iad_frnor(ni25,1)
235
236 nsn =ipari(5,nin)
237 nsnr =ipari(24,nin)
238 nadmsr=ipari(67,nin)
239
240 nslidmx =
max(nslidmx,nsn+nsnr)
241 nadmax =
max(nadmax ,nadmsr)
242
243 END DO
244
245 lent25 = lent25 + nsnt25
246
247
248
249 IF(nspmd == 1) THEN
250
251 ALLOCATE(nadd(1),kadd(1))
252 ALLOCATE(nslide(1),fr_slide(1),indxtosend(1))
253
254 ELSE
255
256
257
258
259 ALLOCATE(nadd(nadmax+1),stat=ierror)
260 IF(ierror/=0) THEN
261 CALL ancmsg(msgid=20,anmode=aninfo)
263 ENDIF
264
265 ladmax = 4*nslidmx
266 ALLOCATE(kadd(ladmax),stat=ierror)
267 IF(ierror/=0) THEN
268 CALL ancmsg(msgid=20,anmode=aninfo)
270 ENDIF
271
272 DO ni25=1,ninter25
273
274 nin = intlist25(ni25)
275
276 ipari(29,nin) = 0
277
278
279
281 . ,sizbufr_glob,comm_int,comm_real,comm_siz
282 . ,2
283
284
285
286
287 nsn =ipari(5,nin)
288 nsnr =ipari(24,nin)
289 inacti=ipari(22,nin)
290 nadmsr=ipari(67,nin)
291 ilev =ipari(20,nin)
292 igap =ipari(21,nin)
293 ifq =ipari(31,nin)
294 intth =ipari(47,nin)
295 intfric =ipari(72,nin)
296 ivis2 =ipari(14,nin)
297 istif_msdt = ipari(97,nin)
298 ifsub_carea =0
299 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA > 0) ifsub_carea = 1
300 ityp = 25
301
302
303 nadd(1:nadmsr+1)=0
305 1 nin ,ni25 ,nsn ,nsnr ,itab ,
306 2 nadmsr ,intbuf_tab(nin)%ADMSR ,iad_frnor ,fr_nor ,nadd ,
307 3 kadd ,intbuf_tab(nin)%ISLIDE)
308
309
311 1 nin ,ni25 ,nsn ,nsnr ,
312 3 itab ,intbuf_tab(nin)%NSV,iad_frnor,fr_nor ,nadd ,
313 4 kadd ,sizbufs,nsendtot)
314
315 ALLOCATE(fr_slide(4*nsendtot),indxtosend(nsendtot),stat=ierror)
316 IF(ierror/=0) THEN
317 CALL ancmsg(msgid=20,anmode=aninfo)
319 ENDIF
320 fr_slide(1:4*nsendtot)=0
321
322
324 1 nin ,ni25 ,nsn ,nsnr ,ityp ,
325 2 ifq ,inacti ,igap ,intth ,ilev ,
326 3 itab ,intbuf_tab(nin)%NSV,iad_frnor,fr_nor ,nadd ,
327 4 kadd ,rsiz(ni25) ,isiz(ni25),sizbufs,fr_slide ,
328 5 indxtosend,intfric , ivis2 ,istif_msdt,ifsub_carea)
329
330 DO p=1,nspmd
331 NULLIFY(rbufs(p,ni25)%P)
332 NULLIFY(ibufs(p,ni25)%P)
333 IF(sizbufs(p) > 0) THEN
334 ALLOCATE(rbufs(p,ni25)%P(rsiz(ni25)*sizbufs(p)),stat=ierror)
335 ALLOCATE(ibufs(p,ni25)%P(isiz(ni25)*sizbufs(p)),stat=ierror)
336 ibufs(p,ni25)%P(1:isiz(ni25)*sizbufs(p)) = -1
337 rbufs(p,ni25)%P(1:rsiz(ni25)*sizbufs(p)) = -1
338 ENDIF
339 sizbufs_glob(p,ni25)=sizbufs(p)
340 IF(ierror/=0) THEN
341 CALL ancmsg(msgid=20,anmode=aninfo)
343 ENDIF
344 END DO
345
346
347
349 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
350 . ,0 ,ni25, comm_pattern)
351
352
353
355 1 nin ,ni25 ,nsn ,nsnr ,ityp ,
356 2 ifq ,inacti ,igap ,intth ,ilev ,
357 3 itab ,iad_frnor,fr_nor ,
358 4 lent25 ,nadd ,kadd ,kinet ,
359 5 nodnx_sms ,x ,v ,ms ,temp ,
360 . intbuf_tab(nin) ,rbufs, ibufs,
361 6 rsiz(ni25), isiz(ni25), sizbufs, fr_slide,indxtosend,
362 7 main_proc,intfric ,ivis2 , icodt ,iskew ,
363 8 istif_msdt,ifsub_carea,parameters%INTAREAN)
364
365
366
367
369 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
370 . ,1 ,ni25, comm_pattern)
371
372
373 DEALLOCATE(fr_slide)
374 DEALLOCATE(indxtosend)
375
376
377 END DO
378
379 END IF
380
381
382
383 DO ni25=1,ninter25
384
385 nin = intlist25(ni25)
386
387 ipari(29,nin) = 0
388
389
390 IF(nspmd > 1) THEN
392 . ,sizbufr_glob ,comm_int,comm_real,comm_siz
393 . ,3 ,ni25, comm_pattern)
394 ENDIF
395
396 nrtm =ipari(4,nin)
397 nsn =ipari(5,nin)
398 ivis2 =ipari(14,nin)
399 nsnr =ipari(24,nin)
400 inacti=ipari(22,nin)
401 nadmsr=ipari(67,nin)
402 ilev =ipari(20,nin)
403 igap =ipari(21,nin)
404 ifq =ipari(31,nin)
405 intth =ipari(47,nin)
406 intfric =ipari(72,nin)
407 flagremn =ipari(63,nin)
408 lremnormax =ipari(82,nin)
409 istif_msdt = ipari(97,nin)
410 ifsub_carea =0
411 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA > 0) ifsub_carea = 1
412 ityp = 25
413
414
415 IF(nspmd > 1) THEN
416
417
418
419
420
421
422
423
424
425
426
427 nb_tot = 0
428 DO p =1,nspmd
429 sizbufs(p) = sizbufr_glob(p,ni25)
430 nb_tot = nb_tot +sizbufs(p)
431 ENDDO
432 IF(ALLOCATED(xrem)) DEALLOCATE(xrem)
433 IF(
ALLOCATED(
irem))
DEALLOCATE(
irem)
434 ALLOCATE(xrem(rsiz(ni25),nb_tot))
435 ALLOCATE(
irem(isiz(ni25),nb_tot))
436
437
438 nb_tot = 0
439 DO p = 1,nspmd
440 DO i = 1,sizbufs(p)
441
442
443
444
445
446
447 nb_tot = nb_tot + 1
448 DO j =1,rsiz(ni25)
449 xrem(j,nb_tot) = rbufr(p,ni25)%P((i-1)*rsiz(ni25)+j)
450 ENDDO
451 DO j =1,isiz(ni25)
452 irem(j,nb_tot) = ibufr(p,ni25)%P((i-1)*isiz(ni25)+j)
453 ENDDO
454
455 ENDDO
456 ENDDO
457
458
459
460 i_stok_glo = intbuf_tab(nin)%I_STOK(2)
461
462 IF(nspmd > 1) THEN
463
464
465
467 2 igap ,nsnr ,intth ,ilev, intbuf_tab(nin),
468 3 fr_nor,iad_frnor, sizbufs, itab, h3d_data ,
469 4 intfric,flagremn,lremnormax,nrtm,ivis2 ,
470 5 istif_msdt,ifsub_carea,nodadt_therm)
471
472
473
474
475
476
477
478 ipari(24,nin) = nsnr
479 ENDIF
480
481
482
483 END IF
484
485
486 50 CONTINUE
487
488 sizopt = intbuf_tab(nin)%S_CAND_OPT_N
489 i_opt_stok = intbuf_tab(nin)%I_STOK(2)
491 1 intbuf_tab(nin)%CAND_OPT_N,intbuf_tab(nin)%CAND_OPT_E,nin ,ni25 ,nsn ,
492 2 nsnr ,nrtm ,sizopt ,k_stok ,intbuf_tab(nin)%MSEGLO,
493 3 intbuf_tab(nin)%MSEGTYP24,i_opt_stok ,itab ,intbuf_tab(nin)%IRECTM,nadmsr ,
494 4 intbuf_tab(nin)%ADMSR,intbuf_tab(nin)%ISLIDE,intbuf_tab(nin)%NSV,
495 . intbuf_tab(nin)%KNOR2MSR,intbuf_tab(nin)%NOR2MSR,
496 5 intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%STFM,flagremn,intbuf_tab(nin)%KREMNOR,
497 . intbuf_tab(nin)%REMNOR)
498
499
500
501
502
503 IF(intbuf_tab(nin)%I_STOK(2)+k_stok > sizopt)THEN
505 GOTO 50
506 END IF
507
508 intbuf_tab(nin)%I_STOK(2)=i_opt_stok
509 IF (debug(3)>=1) THEN
510 nb_dst1(jtask) = nb_dst1(jtask) + k_stok
511 nb_dst2(jtask) = nb_dst2(jtask) - k_stok
512 ENDIF
513
514
515 IF(nspmd > 1) THEN
517 . ,sizbufr_glob ,comm_int ,comm_real,comm_siz
518 . ,4 ,ni25 ,comm_pattern)
519 END IF
520
521 ENDDO
522
523 IF(nspmd > 1) THEN
524 DO ni25=1,ninter25
525 nin = intlist25(ni25)
526
527
529 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
530 . ,5 ,ni25, comm_pattern)
531
532 ENDDO
533 ENDIF
534
535 DEALLOCATE(nadd)
536 DEALLOCATE(kadd)
537
538
539
543
544
545
546
547
548
549 RETURN
subroutine i25comp_1(ipari, intbuf_tab, x, itab, nin, kinet, jtask, nb_dst1, v, nsensor, sensor_tab)
subroutine i25prep_add(nin, ni25, nsn, nsnr, itab, nadmsr, admsr, iad_frnor, fr_nor, nadd, kadd, islide)
subroutine i25prep_nindex(nin, ni25, nsn, nsnr, itab, nsv, iad_frnor, fr_nor, nadd, kadd, sizbufs, nsendtot)
subroutine i25prep_slid_2(cand_n, cand_e, nin, ni25, nsn, nsnr, nrtm, sizopt, k_stok, mseglo, msegtyp, i_stok_opt, itab, irect, nadmsr, admsr, islide, nsv, knor2msr, nor2msr, irtlm, stfm, flagremn, kremnor, remnor)
subroutine i25prep_send(nin, ni25, nsn, nsnr, ityp, ifq, inacti, igap, intth, ilev, itab, iad_frnor, fr_nor, lens, nadd, kadd, kinet, nodnx_sms, x, v, ms, temp, intbuf_tab, rbuf, ibuf, rsiz, isiz, sizbufs, fr_slide, index, main_proc, intfric, ivis2, icodt, iskew, istif_msdt, ifsub_carea, intarean)
subroutine i25prep_sizbufs(nin, ni25, nsn, nsnr, ityp, ifq, inacti, igap, intth, ilev, itab, nsv, iad_frnor, fr_nor, nadd, kadd, rsiz, isiz, sizbufs, fr_slide, index, intfric, ivis2, istif_msdt, ifsub_carea)
subroutine allocate_comm_struct(object, s1, s2)
subroutine deallocate_comm_struct(object, s1, s2)
type(int_pointer2), dimension(:), allocatable islide_fi
integer, dimension(:,:), allocatable irem
subroutine spmd_i25_slide_exch(ibuf, rbuf, isiz, rsiz, nb, comm_int, comm_real, comm_siz, mode, nin, comm_pattern)
subroutine spmd_i25_slide_gat(nsn, nin, ni25, igap, nsnr, intth, ilev, intbuf_tab, fr_nor, iad_frnor, nb_slid, itab, h3d_data, intfric, flagremn, lremnormax, nrtm, ivis2, istif_msdt, ifsub_carea, nodadt_therm)
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)
subroutine upgrade_cand_opt(ni, k_stok, intbuf_tab)