53
54
55
56 USE timer_mod
58 USE damping_vref_rby_mod
59 USE damping_vref_rby_stiff_mod
60
61
62
63#include "implicit_f.inc"
64#include "comlock.inc"
65
66
67
68#include "com01_c.inc"
69#include "com04_c.inc"
70#include "com08_c.inc"
71#include "param_c.inc"
72#include "task_c.inc"
73#include "timeri_c.inc"
74#include "intstamp_c.inc"
75
76
77
78 INTEGER, INTENT(IN) :: NHIER_RBY
79 TYPE(TIMER_), INTENT(inout) :: TIMERS
80 INTEGER ICODR(*),ISKEW(*),(*),LPBY(*),NPBY(NNPBY,*),
81 . KIND(NRBYKIN),FR_RBY6(*),IAD_RBY(*),IRBKIN_L(*),
82 . NRBYKIN_L, NATIV_SMS(*),DIMFB,STABSEN,TABSENSOR(*),
83 . NODREAC(*),CPTREAC,NDAMP_VREL_RBYG,SIZE_RBY6_C
84 my_real rby(nrby,*) ,a(3,*) ,ar(3,*) ,x(3,*) ,vr(3,*),fsav(nthvki,*),
85 . in(*) ,stifn(*),stifr(*),fani(3,*),ms(*),v(3,*) ,
86 . bufsf(*), skew(lskew,*),fthreac(6,*)
87 DOUBLE PRECISION RBY6(8,6,NRBYKIN),RBY6_C(2,6,SIZE_RBY6_C)
88 DOUBLE PRECISION FBSAV6(12,6,DIMFB),RBID(12,6),WFEXT
89 TYPE (SURF_), DIMENSION(NSURF) :: IGRSURF
90 INTEGER ,INTENT(IN) :: NDAMP_VREL,IPARIT,SDAMP
91 INTEGER ,INTENT(IN) :: ID_DAMP_VREL(NDAMP_VREL),(NUMNOD)
92 my_real,
INTENT(INOUT) :: dampr(nrdamp,ndamp),damp(sdamp)
93 TYPE(GROUP_), INTENT(IN) :: IGRNOD(NGRNOD)
94
95
96
97 INTEGER J,K,N,KK,N2,
98 . ISU,ADRSRF,IM, NRBDIM,IPARSENS,ISECT,
99 . DIM,NHI
100
101
102
103
104 rbid = zero
105 DO kk=1,nrbykin_l
106 n=irbkin_l(kk)
107 IF(npby(7,n)<=0) THEN
108 DO k = 1, 6
109 rby6(1,k,n) = zero
110 rby6(2,k,n) = zero
111 rby6(3,k,n) = zero
112 rby6(4,k,n) = zero
113 rby6(5,k,n) = zero
114 rby6(6,k,n) = zero
115 rby6(7,k,n) = zero
116 rby6(8,k,n) = zero
117 ENDDO
118 ENDIF
119 ENDDO
120
121 IF (nhier_rby ==0) THEN
122
123
124
125
126
127
128 DO kk=1,nrbykin_l
129 n=irbkin_l(kk)
130 k = kind(n)
131 IF (npby(4,n)/=0) THEN
132 IF(npby(7,n)>0) THEN
133 n2 = ninter+nrwall+n
134
135
136
137
138
139
140
141 isu=npby(8,n)
142 IF(ispmd==0.AND.isu/=0) THEN
143 im=npby(1,n)
144 adrsrf=igrsurf(isu)%IAD_BUFR
145 a(1,im) =a(1,im) +bufsf(adrsrf+25)
146 a(2,im) =a(2,im) +bufsf(adrsrf+26)
147 a(3,im) =a(3,im) +bufsf(adrsrf+27)
148 ar(1,im)=ar(1,im)+bufsf(adrsrf+28)
149 ar(2,im)=ar(2,im)+bufsf(adrsrf+29)
150 ar(3,im)=ar(3,im)+bufsf(adrsrf+30)
151 stifn(im)=stifn(im)+bufsf(adrsrf+31)
152 stifr(im)=stifr(im)+bufsf(adrsrf+32)
153
154 fsav(10,n2)=fsav(10,n2)+bufsf(adrsrf+25)*dt1
155 fsav(11,n2)=fsav(11,n2)+bufsf(adrsrf+26)*dt1
156 fsav(12,n2)=fsav(12,n2)+bufsf(adrsrf+27)*dt1
157 fsav(13,n2)=fsav(13,n2)+bufsf(adrsrf+28)*dt1
158 fsav(14,n2)=fsav(14,n2)+bufsf(adrsrf+29)*dt1
159 fsav(15,n2)=fsav(15,n2)+bufsf(adrsrf+30)*dt1
160 END IF
161
162 iparsens=0
163 isect=0
164 IF(stabsen/=0) isect=tabsensor(n+nsect+nintsub+ninter+nrwall+1)-
165 . tabsensor(n+nsect+nintsub+ninter+nrwall)
166 IF(isect/=0) THEN
167 iparsens=1
169 1 a ,ar ,x ,fsav(1,n2),rby(1,n),
170 2 lpby(k) ,npby(1,n),in ,vr ,stifn ,
171 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
172 4 1 ,icodr ,iskew ,skew ,rby6(1,1,n),
173 5 npby(2,n),nativ_sms,fbsav6(1,1,isect) ,iparsens,
174 6 nodreac,fthreac,cptreac,npby(5,n))
175 ELSE
177 1 a ,ar ,x
178 2 lpby(k) ,npby(1,n),in ,vr ,stifn ,
179 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
180 4 1 ,icodr ,iskew ,skew ,rby6(1,1,n),
181 5 npby(2,n),nativ_sms,rbid , iparsens,
182 6 nodreac,fthreac,cptreac,npby(5,n))
183 ENDIF
184 ENDIF
185 ENDIF
186 ENDDO
187
188
189
190
191
192
193
194
195
196
197
198
199
200 DO kk=1,nrbykin_l
201 n = irbkin_l(kk)
202 k = kind(n)
203 IF (npby(4,n)==0) THEN
204 IF(npby(7,n)>0) THEN
205 n2 = ninter+nrwall+n
206
207
208
209
210
211
212
213 isu=npby(8,n)
214 IF(ispmd==0.AND.isu/=0) THEN
215 im=npby(1,n)
216 adrsrf=igrsurf(isu)%IAD_BUFR
217 a(1,im) =a(1,im) +bufsf(adrsrf+25)
218 a(2,im) =a(2,im) +bufsf(adrsrf+26)
219 a(3,im) =a(3,im) +bufsf(adrsrf+27)
220 ar(1,im)=ar(1,im)+bufsf(adrsrf+28)
221 ar(2,im)=ar(2,im)+bufsf(adrsrf+29)
222 ar(3,im)=ar(3,im)+bufsf(adrsrf+30)
223 stifn(im)=stifn(im)+bufsf(adrsrf+31)
224 stifr(im)=stifr(im)+bufsf(adrsrf+32)
225
226 fsav(10,n2)=fsav(10,n2)+bufsf(adrsrf+25)*dt1
227 fsav(11,n2)=fsav(11,n2)+bufsf(adrsrf+26)*dt1
228 fsav(12,n2)=fsav(12,n2)+bufsf(adrsrf+27)*dt1
229 fsav(13,n2)=fsav(13,n2)+bufsf(adrsrf+28)*dt1
230 fsav(14,n2)=fsav(14,n2)+bufsf(adrsrf+29)*dt1
231 fsav(15,n2)=fsav(15,n2)+bufsf(adrsrf+30)*dt1
232 END IF
233
234 iparsens=0
235 isect=0
236 IF(stabsen/=0) isect=tabsensor(n+nsect+nintsub+ninter+nrwall+1)-
237 . tabsensor(n+nsect+nintsub+ninter+nrwall)
238 IF(isect/=0) THEN
239 iparsens=1
241 1 a ,ar ,x ,fsav(1,n2),rby(1,n),
242 2 lpby(k) ,npby(1,n) ,in ,vr ,stifn ,
243 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
244 4 1 ,icodr ,iskew ,skew ,rby6(1,1,n),
245 5 npby(2,n),nativ_sms,fbsav6(1,1,isect) ,iparsens,
246 6 nodreac,fthreac,cptreac,npby(5,n))
247 ELSE
249 1 a ,ar ,x ,fsav(1,n2),rby(1,n),
250 2 lpby(k) ,npby(1,n) ,in ,vr ,stifn ,
251 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
252 4 1 ,icodr ,iskew ,skew ,rby6(1,1,n),
253 5 npby(2,n),nativ_sms ,rbid ,iparsens ,
254 6 nodreac,fthreac,cptreac,npby(5,n))
255 ENDIF
256 ENDIF
257 ENDIF
258 ENDDO
259
260
261
262
263
264
265 IF ((ndamp_vrel_rbyg > 0).AND.(nrbykin_l > 0)) THEN
266
267 dim = 3+3*iroddl
268 CALL damping_vref_rby(igrnod ,ngrnod ,v ,vr ,a ,
269 . x ,ms ,dampr ,nrdamp ,ndamp ,
270 . ndamp_vrel,iparit ,numnod ,dt1 ,id_damp_vrel,
271 . tt ,nnpby ,nrbykin ,npby ,rby6 ,
272 . rby6_c ,tagslv_rby,weight ,lskew ,numskw ,
273 . dim ,damp ,skew ,wfext ,size_rby6_c,
274 . nhier_rby )
275
276 ENDIF
277
278 IF (nspmd > 1) THEN
279
280
281
282 IF (imon>0)
CALL startime(timers,11)
283
284
285
286
287 IF(nintstamp == 0) THEN
288 IF (ndamp_vrel_rbyg == 0) THEN
289
290 nrbdim=8
292 ELSE
293
294 nrbdim=10
296 . rby6_c,size_rby6_c)
297 ENDIF
298
299 ELSE
301 END IF
302
303 IF (imon>0)
CALL stoptime(timers,11)
304
305
306
307 END IF
308
309
310
311
312
313 DO kk=1,nrbykin_l
314 n = irbkin_l(kk)
315 k = kind(n)
316 n2 = ninter+nrwall+n
317 IF(npby(7,n)>0) THEN
318
319 iparsens=0
320 isect=0
321 IF(stabsen/=0) isect=tabsensor(n+nsect+nintsub+ninter+nrwall+1)-
322 . tabsensor(n+nsect+nintsub+ninter+nrwall)
323 IF(isect/=0) THEN
324 iparsens=1
326 1 a ,ar ,x ,fsav(1,n2),rby(1,n),
327 2 lpby(k) ,npby(1,n),in ,vr ,stifn ,
328 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
329 4 2 ,icodr ,iskew ,skew, rby6(1,1,n),
330 5 npby(2,n),nativ_sms,fbsav6(1,1,isect) ,iparsens,
331 6 nodreac,fthreac,cptreac,npby(5,n))
332 ELSE
334 1 a ,ar ,x ,fsav(1,n2),rby(1,n),
335 2 lpby(k) ,npby(1,n),in ,vr ,stifn ,
336 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
337 4 2 ,icodr ,iskew ,skew, rby6(1,1,n),
338 5 npby(2,n),nativ_sms,rbid ,iparsens,
339 6 nodreac,fthreac,cptreac,npby(5,n))
340 ENDIF
341 ENDIF
342 ENDDO
343
344
345
346
347
348 IF (ndamp_vrel_rbyg > 0) THEN
349
350 call damping_vref_rby_stiff(numnod,nnpby,nrbykin,nrbykin_l,npby,
351 . rby6_c,ms,in,stifn,stifr,size_rby6_c,
352 . irbkin_l ,nhier_rby)
353
354 ENDIF
355
356 ELSE
357
358 DO nhi = 0 ,nhier_rby
359 DO n=1,nrbykin
360 im = npby(1,n)
361 IF(npby(7,n)==0 .OR. im<=0 .OR. npby(20,n)/=nhi) cycle
362 k = kind(n)
363 n2 = ninter+nrwall+n
364 isu=npby(8,n)
365 IF(ispmd==0.AND.isu/=0) THEN
366 im=npby(1,n)
367 adrsrf=igrsurf(isu)%IAD_BUFR
368 a(1,im) =a(1,im) +bufsf(adrsrf+25)
369 a(2,im) =a(2,im) +bufsf(adrsrf+26)
370 a(3,im) =a(3,im) +bufsf(adrsrf+27)
371 ar(1,im)=ar(1,im)+bufsf(adrsrf+28)
372 ar(2,im)=ar(2,im)+bufsf(adrsrf+29)
373 ar(3,im)=ar(3,im)+bufsf(adrsrf+30)
374 stifn(im)=stifn(im)+bufsf(adrsrf+31)
375 stifr(im)=stifr(im)+bufsf(adrsrf+32)
376
377 fsav(10,n2)=fsav(10,n2)+bufsf(adrsrf+25)*dt1
378 fsav(11,n2)=fsav(11,n2)+bufsf(adrsrf+26)*dt1
379 fsav(12,n2)=fsav(12,n2)+bufsf(adrsrf+27)*dt1
380 fsav(13,n2)=fsav(13,n2)+bufsf(adrsrf+28)*dt1
381 fsav(14,n2)=fsav(14,n2)+bufsf(adrsrf+29)*dt1
382 fsav(15,n2)=fsav(15,n2)+bufsf(adrsrf+30)*dt1
383 END IF
384
385 iparsens=0
386 isect=0
387 IF(stabsen/=0) isect=tabsensor(n+nsect+nintsub+ninter+nrwall+1)-
388 . tabsensor(n+nsect+nintsub+ninter+nrwall)
389 IF(isect/=0) THEN
390 iparsens=1
392 1 a ,ar ,x ,fsav(1,n2),rby(1,n),
393 2 lpby(k) ,npby(1,n),in ,vr ,stifn ,
394 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
395 4 1 ,icodr ,iskew ,skew ,rby6(1,1,n),
396 5 npby(2,n),nativ_sms,fbsav6(1,1,isect) ,iparsens,
397 6 nodreac,fthreac,cptreac,npby(5,n))
398 ELSE
400 1 a ,ar ,x ,fsav(1,n2),rby(1,n),
401 2 lpby(k) ,npby(1,n),in ,vr ,stifn
402 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
403 4 1 ,icodr ,iskew ,skew ,rby6(1,1,n),
404 5 npby(2,n),nativ_sms,rbid , iparsens,
405 6 nodreac,fthreac,cptreac,npby(5,n))
406 END IF
407 END DO
408
409
410
411 IF ((ndamp_vrel_rbyg > 0).AND.(nrbykin_l > 0)) THEN
412 dim = 3+3*iroddl
413 CALL damping_vref_rby(igrnod ,ngrnod ,v ,vr ,a ,
414 . x ,ms ,dampr ,nrdamp ,ndamp ,
415 . ndamp_vrel,iparit ,numnod ,dt1 ,id_damp_vrel,
416 . tt ,nnpby ,nrbykin ,npby ,rby6 ,
417 . rby6_c ,tagslv_rby,weight ,lskew ,numskw ,
418 . dim ,damp ,skew ,wfext ,size_rby6_c,
419 . nhi )
420 ENDIF
421
422 IF (nspmd > 1) THEN
423 IF (imon>0)
CALL startime(timers,11)
424 IF(nintstamp == 0) THEN
425 IF (ndamp_vrel_rbyg == 0) THEN
426 nrbdim=8
428 ELSE
429 nrbdim=10
431 . rby6_c,size_rby6_c)
432 ENDIF
433 ELSE
435 END IF
436 IF (imon>0)
CALL stoptime(timers,11)
437 END IF
438! back to
main node : iflag=2
439 DO n=1,nrbykin
440 im = npby(1,n)
441 k = kind(n)
442 n2 = ninter+nrwall+n
443 IF(npby(7,n)==0 .OR. im<=0 .OR. npby(20,n)/=nhi) cycle
444
445 iparsens=0
446 isect=0
447 IF(stabsen/=0) isect=tabsensor(n+nsect+nintsub+ninter+nrwall+1)-
448 . tabsensor(n+nsect+nintsub+ninter+nrwall)
449 IF(isect/=0) THEN
450 iparsens=1
452 1 a ,ar ,x ,fsav(1,n2),rby(1,n),
453 2 lpby(k) ,npby(1,n),in ,vr ,stifn ,
454 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
455 4 2 ,icodr ,iskew ,skew, rby6(1,1,n),
456 5 npby(2,n),nativ_sms,fbsav6(1,1,isect) ,iparsens,
457 6 nodreac,fthreac,cptreac,npby(5,n))
458 ELSE
460 1 a ,ar ,x ,fsav(1,n2),rby(1,n),
461 2 lpby(k) ,npby(1,n),in ,vr ,stifn ,
462 3 stifr ,fani(1,1+2*(nsect+n-1)),weight,ms ,v ,
463 4 2 ,icodr ,iskew ,skew, rby6(1,1,n),
464 5 npby(2,n),nativ_sms,rbid ,iparsens,
465 6 nodreac,fthreac,cptreac,npby(5,n))
466 END IF
467 END DO
468
469
470
471 IF (ndamp_vrel_rbyg > 0) THEN
472 call damping_vref_rby_stiff(numnod,nnpby,nrbykin,nrbykin_l,npby,
473 . rby6_c,ms,in,stifn,stifr,size_rby6_c,
474 . irbkin_l ,nhi )
475 ENDIF
476 END DO
477
478 END IF
479
480 RETURN
subroutine rgbodfp(af, am, x, fs, rby, nod, m, in, vr, stifn, stifr, fopta, weight, ms, v, iflag, icodr, iskew, skew, rbf6, nsn, nativ_sms, fbsav6, iparsens, nodreac, fthreac, cptreac, ispher)
subroutine spmd_exch_a_rb6_vrel(nrbdim, iad_rby, fr_rby6, icsize, rby6, rby6_c, size_rby6_c)
subroutine spmd_exch_a_rb6(nrbdim, iad_rby, fr_rby6, icsize, rbf6)
subroutine spmd_exch_a_rb6g(npby, rbf6)
int main(int argc, char *argv[])
subroutine startime(event, itask)
subroutine stoptime(event, itask)