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 ,ISLEN7,IRLEN7,
96 . IRLEN7T,ISLEN7T,
97 . NEWFRONT(*), INTLIST(*),
98 . (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 KK, NIN, NI25, ISENS, LENT25, IERROR, ITYP,
106 . IFQ, , INTTH, ILEV, IVIS2,
107 . I_STOK_GLO, I_STOK, I,J, LINDMAX, NSNR, INACTI, NADMSR,
108 . LENADD, MG, L, N, N_OLD_IMPACT,
109 . P, RSIZ(NINTER25), ISIZ(NINTER25), SIZBUFS(NSPMD), IADBUFR(NSPMD+1),
110 . NADMAX, LADMAX
111
112 INTEGER SIZOPT, K_STOK, I_OPT_STOK
114 . ts, startt, stopt
115 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX2, BUFR, NADD, KADD,
116 . NSLIDE, FR_SLIDE, INDXTOSEND
117
118 TYPE(real_pointer), DIMENSION(NSPMD,NINTER25) :: RBUFS,RBUFR
119 TYPE(int_pointer) , DIMENSION(NSPMD,NINTER25) :: IBUFS,IBUFR
120
121
122 TYPE(MPI_COMM_STRUCT) :: COMM_INT
123 TYPE(MPI_COMM_STRUCT) :: COMM_REAL
124 TYPE(MPI_COMM_STRUCT) :: COMM_SIZ
125
126 INTEGER COMM_PATTERN(NSPMD,NINTER25)
127 INTEGER SIZBUFS_GLOB(NSPMD,NINTER25)
128 INTEGER SIZBUFR_GLOB(NSPMD,NINTER25)
129 INTEGER NB_TOT
130 INTEGER :: NRTM, NSN
131
132
133
134
135
136 DO ni25=1,ninter25
137
138 nin = intlist25(ni25)
139 nsn =ipari(5,nin)
140
141
142 nsnf = nsn*(jtask-1) / nthread
143 nsnl = nsn*jtask / nthread
144
145 intbuf_tab(nin)%ISLIDE(4*nsnf+1:4*nsnl)=0
146
147 END DO
148
149 IF(nspmd > 1)THEN
150 DO ni25=1,ninter25
151 nin = intlist25(ni25)
152 nsnr =ipari(24,nin)
153 nsnrf = 1 + nsnr*(jtask-1) / nthread
154 nsnrl = nsnr*jtask / nthread
156 END DO
157 END IF
158
160
161
162
163
164
165 DO ni25=1,ninter25
166 nin = intlist25(ni25)
167 ipari(29,nin) = 0
168 END DO
169
170
171 DO ni25=1,ninter25
172 nin = intlist25(ni25)
174 1 ipari ,intbuf_tab(nin),x ,itab ,nin ,
175 2 kinet ,jtask ,nb_dst1(jtask),v ,nsensor ,
176 3 sensor_tab)
177 ENDDO
178
180
181
182
186
187
188 nslidmx=0
189 nadmax =0
190
191 sizbufr_glob(1:nspmd,1:ninter25) = 0
192 sizbufs_glob(1:nspmd,1:ninter25) = 0
193 isiz(1:ninter25) = 0
194 rsiz(1:ninter25) = 0
195
196
197
198
199 comm_pattern(1:nspmd,1:ninter25) = 0
200 DO ni25=1,ninter25
201
202 nin = intlist25(ni25)
203
204 ipari(29,nin) = 0
205
206 DO p = 1,nspmd
207 lent25 = iad_frnor(ni25,p+1)-iad_frnor(ni25,p)
208 IF(p /= ispmd +1 .AND. lent25 /= 0) THEN
209 comm_pattern(p,ni25) = 1
210 ENDIF
211 ENDDO
212 ENDDO
213
214 DO ni25=1,ninter25
215 sizbufs(1:nspmd) = 0
216
217 nin = intlist25(ni25)
218
219 ipari(29,nin) = 0
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236 lent25 = iad_frnor(ni25,nspmd+1)-iad_frnor(ni25,1)
237
238 nsn =ipari(5,nin)
239 nsnr =ipari(24,nin)
240 nadmsr=ipari(67,nin)
241
242 nslidmx =
max(nslidmx,nsn+nsnr)
243 nadmax =
max(nadmax ,nadmsr)
244
245 END DO
246
247 lent25 = lent25 + nsnt25
248
249
250
251 IF(nspmd == 1) THEN
252
253 ALLOCATE(nadd(1),kadd(1))
254 ALLOCATE(nslide(1),fr_slide(1),indxtosend(1))
255
256 ELSE
257
258
259
260
261 ALLOCATE(nadd(nadmax+1),stat=ierror)
262 IF(ierror/=0) THEN
263 CALL ancmsg(msgid=20,anmode=aninfo)
265 ENDIF
266
267 ladmax = 4*nslidmx
268 ALLOCATE(kadd(ladmax),stat=ierror)
269 IF(ierror/=0) THEN
270 CALL ancmsg(msgid=20,anmode=aninfo)
272 ENDIF
273
274 DO ni25=1,ninter25
275
276 nin = intlist25(ni25)
277
278 ipari(29,nin) = 0
279
280
281
283 . ,sizbufr_glob,comm_int,comm_real,comm_siz
284 . ,2 ,ni25, comm_pattern)
285
286
287
288
289 nsn =ipari(5,nin)
290 nsnr =ipari(24,nin)
291 inacti=ipari(22,nin)
292 nadmsr=ipari(67,nin)
293 ilev =ipari(20,nin)
294 igap =ipari(21,nin)
295 ifq =ipari(31,nin)
296 intth =ipari(47,nin)
297 intfric =ipari(72,nin)
298 ivis2 =ipari(14,nin)
299 istif_msdt = ipari(97,nin)
300 ifsub_carea =0
301 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA
302 ityp = 25
303
304
305 nadd(1:nadmsr+1)=0
307 1 nin ,ni25 ,nsn ,nsnr ,itab
308 2 nadmsr ,intbuf_tab(nin)%ADMSR ,iad_frnor ,fr_nor
309 3 kadd ,intbuf_tab(nin)%ISLIDE)
310
311
313 1 nin ,ni25 ,nsn ,nsnr ,
314 3 itab ,intbuf_tab(nin)%NSV,iad_frnor,fr_nor ,nadd ,
315 4 kadd ,sizbufs,nsendtot)
316
317 ALLOCATE(fr_slide(4*nsendtot),indxtosend(nsendtot),stat=ierror)
318 IF(ierror/=0) THEN
319 CALL ancmsg(msgid=20,anmode=aninfo)
321 ENDIF
322 fr_slide(1:4*nsendtot)=0
323
324
326 1 nin ,ni25 ,nsn ,nsnr ,ityp ,
327 2 ifq ,inacti ,igap ,intth ,ilev ,
328 3 itab ,intbuf_tab(nin)%NSV,iad_frnor,fr_nor ,nadd ,
329 4 kadd ,rsiz(ni25) ,isiz(ni25),sizbufs,fr_slide ,
330 5 indxtosend,intfric , ivis2 ,istif_msdt,ifsub_carea)
331
332 DO p=1,nspmd
333 NULLIFY(rbufs(p,ni25)%P)
334 NULLIFY(ibufs(p,ni25)%P)
335 IF(sizbufs(p) > 0) THEN
336 ALLOCATE(rbufs(p,ni25)%P(rsiz(ni25)*sizbufs(p)),stat=ierror)
337 ALLOCATE(ibufs(p,ni25)%P(isiz(ni25)*sizbufs(p)),stat=ierror)
338 ibufs(p,ni25)%P(1:isiz(ni25)*sizbufs(p)) = -1
339 rbufs(p,ni25)%P(1:rsiz(ni25)*sizbufs(p)) = -1
340 ENDIF
341 sizbufs_glob(p,ni25)=sizbufs(p)
342 IF(ierror/=0) THEN
343 CALL ancmsg(msgid=20,anmode=aninfo)
345 ENDIF
346 END DO
347
348
349
351 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
352 . ,0 ,ni25, comm_pattern)
353
354
355
357 1 nin ,ni25 ,nsn ,nsnr ,ityp ,
358 2 ifq ,inacti ,igap ,intth ,ilev ,
359 3 itab ,iad_frnor,fr_nor ,
360 4 lent25 ,nadd ,kadd ,kinet ,
361 5 nodnx_sms ,x ,v ,ms ,temp ,
362 . intbuf_tab(nin) ,rbufs, ibufs,
363 6 rsiz(ni25), isiz(ni25), sizbufs, fr_slide,indxtosend,
364 7 main_proc,intfric ,ivis2 , icodt ,iskew ,
365 8 istif_msdt,ifsub_carea,parameters%INTAREAN)
366
367
368
369
371 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
372 . ,1 ,ni25, comm_pattern)
373
374
375 DEALLOCATE(fr_slide)
376 DEALLOCATE(indxtosend)
377
378
379 END DO
380
381 END IF
382
383
384
385 DO ni25=1,ninter25
386
387 nin = intlist25(ni25)
388
389 ipari(29,nin) = 0
390
391
392 IF(nspmd > 1) THEN
394 . ,sizbufr_glob ,comm_int,comm_real,comm_siz
395 . ,3 ,ni25, comm_pattern)
396 ENDIF
397
398 nrtm =ipari(4,nin)
399 nsn =ipari(5,nin)
400 ivis2 =ipari(14,nin)
401 nsnr =ipari(24,nin)
402 inacti=ipari(22,nin)
403 nadmsr=ipari(67,nin)
404 ilev =ipari(20,nin)
405 igap =ipari(21,nin)
406 ifq =ipari(31,nin)
407 intth =ipari(47,nin)
408 intfric =ipari(72,nin)
409 flagremn =ipari(63,nin)
410 lremnormax =ipari(82,nin)
411 istif_msdt = ipari(97,nin)
412 ifsub_carea =0
413 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA > 0) ifsub_carea = 1
414 ityp = 25
415
416
417 IF(nspmd > 1) THEN
418
419
420
421
422
423
424
425
426
427
428
429 nb_tot = 0
430 DO p =1,nspmd
431 sizbufs(p) = sizbufr_glob(p,ni25)
432 nb_tot = nb_tot +sizbufs(p)
433 ENDDO
434 IF(ALLOCATED(xrem)) DEALLOCATE(xrem)
435 IF(
ALLOCATED(
irem))
DEALLOCATE(
irem)
436 ALLOCATE(xrem(rsiz(ni25),nb_tot))
437 ALLOCATE(
irem(isiz(ni25),nb_tot))
438
439
440 nb_tot = 0
441 DO p = 1,nspmd
442 DO i = 1,sizbufs(p)
443
444
445
446
447
448
449 nb_tot = nb_tot + 1
450 DO j =1,rsiz(ni25)
451 xrem(j,nb_tot) = rbufr(p,ni25)%P((i-1)*rsiz(ni25)+j)
452 ENDDO
453 DO j =1,isiz(ni25)
454 irem(j,nb_tot) = ibufr(p,ni25)%P((i-1)*isiz(ni25)+j)
455 ENDDO
456
457 ENDDO
458 ENDDO
459
460
461
462 i_stok_glo = intbuf_tab(nin)%I_STOK(2)
463
464 IF(nspmd > 1) THEN
465
466
467
469 2 igap ,nsnr ,intth ,ilev, intbuf_tab(nin),
470 3 fr_nor,iad_frnor, sizbufs, itab, h3d_data ,
471 4 intfric,flagremn,lremnormax,nrtm,ivis2 ,
472 5 istif_msdt,ifsub_carea,nodadt_therm)
473
474
475
476
477
478
479
480 ipari(24,nin) = nsnr
481 ENDIF
482
483
484
485 END IF
486
487
488 50 CONTINUE
489
490 sizopt = intbuf_tab(nin)%S_CAND_OPT_N
491 i_opt_stok = intbuf_tab(nin)%I_STOK(2)
493 1 intbuf_tab(nin)%CAND_OPT_N,intbuf_tab(nin)%CAND_OPT_E,nin ,ni25 ,nsn ,
494 2 nsnr ,nrtm ,sizopt ,k_stok ,intbuf_tab(nin)%MSEGLO,
495 3 intbuf_tab(nin)%MSEGTYP24,i_opt_stok ,itab ,intbuf_tab(nin)%IRECTM,nadmsr ,
496 4 intbuf_tab(nin)%ADMSR,intbuf_tab(nin)%ISLIDE,intbuf_tab(nin)%NSV,
497 . intbuf_tab(nin)%KNOR2MSR,intbuf_tab(nin)%NOR2MSR,
498 5 intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%STFM,flagremn,intbuf_tab(nin)%KREMNOR,
499 . intbuf_tab(nin)%REMNOR)
500
501
502
503
504
505 IF(intbuf_tab(nin)%I_STOK(2)+k_stok > sizopt)THEN
507 GOTO 50
508 END IF
509
510 intbuf_tab(nin)%I_STOK(2)=i_opt_stok
511 IF (debug(3)>=1) THEN
512 nb_dst1(jtask) = nb_dst1(jtask) + k_stok
513 nb_dst2(jtask) = nb_dst2(jtask) - k_stok
514 ENDIF
515
516
517 IF(nspmd > 1) THEN
519 . ,sizbufr_glob ,comm_int ,comm_real,comm_siz
520 . ,4 ,ni25 ,comm_pattern)
521 END IF
522
523 ENDDO
524
525 IF(nspmd > 1) THEN
526 DO ni25=1,ninter25
527 nin = intlist25(ni25)
528
529
531 . ,sizbufs_glob ,comm_int,comm_real,comm_siz
532 . ,5 ,ni25, comm_pattern)
533
534 ENDDO
535 ENDIF
536
537 DEALLOCATE(nadd)
538 DEALLOCATE(kadd)
539
540
541
545
546
547
548
549
550
551 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)