37
38
39
40
41
42
43
44
45
46
47
48
49 USE python_funct_mod
51 USE sensor_mod
52
53
54
55#include "implicit_f.inc"
56
57
58
59#include "mvsiz_p.inc"
60
61
62
63#include "vect01_c.inc"
64#include "com04_c.inc"
65#include "com08_c.inc"
66#include "param_c.inc"
67#include "task_c.inc"
68
69
70
71
72
73
74
75
76 TYPE(PYTHON_) , INTENT(IN) :: PYTHON
77 INTEGER ,INTENT(IN) :: NSENSOR
78 INTEGER :: IGRV(NIGRV,*), ITASK,LGRAV(*),NPC(*)
79 my_real :: agrv(lfacgrv,*),tf(*)
80
81
82
83 INTEGER :: J, K, K1, K2, K3, NL, NN, ISK, IFUNC, N2
84 INTEGER :: IADF,IADL,ISENS,N1
85 my_real :: ts,aa,fcx,fcy,a0,dydx,gama,wfextt
88 INTEGER :: ISMOOTH
89 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
90
91
92
93
94 IF(ngrav==0) RETURN
95
96
97
98
99
100
101
102 wfextt = zero
103
109 n2 = igrv(2,
nl)-10*isk
112 iadf = iad+itask*nn/nthread
113 iadl = iad-1+(itask+1)*nn/nthread
114
115 isens=0
116 DO k=1,nsensor
117 IF(igrv(6,
nl)==sensor_tab(k)%SENS_ID) isens=k
118 ENDDO
119 IF(isens==0)THEN
120 ts = tt
121 ELSE
122 ts = tt-sensor_tab(isens)%TSTART
123 IF(ts<0.0)cycle
124 ENDIF
125 ismooth = 0
126 IF (ifunc > 0) ismooth = npc(2*nfunct+ifunc+1)
127
128 IF (ifunc > 0) THEN
129 IF(ismooth >= 0) THEN
130 a0 = fcy*finter(ifunc,(ts-dt1)*fcx,npc,tf,dydx)
131 gama = fcy*finter(ifunc,ts*fcx,npc,tf,dydx)
132 ELSE IF (ismooth < 0) THEN
133 ismooth = -ismooth
134 CALL python_call_funct1d(python, ismooth,(ts-dt1)*fcx, a0)
135 CALL python_call_funct1d(python, ismooth,ts*fcx, gama)
136 a0 = fcy*a0
137 gama = fcy*gama
138 ENDIF
139 ELSE
140 a0 = fcy
141 gama = fcy
142 ENDIF
143 aa = gama
144
145 k1 = 3*n2-2
146 k2 = 3*n2-1
147 k3 = 3*n2
148
150
151#include "vectorize.inc"
152 DO j=iadf,iadl
153
154 n1=iabs(lgrav(j))
159
160
161
162 ENDDO
163 ELSE
164
165#include "vectorize.inc"
166 DO j=iadf,iadl
167
168 n1=iabs(lgrav(j))
173
174
175
176 ENDDO
177 ENDIF
178
179 END DO
180
181
182
183 RETURN
type(alefvm_buffer_), target alefvm_buffer
character *2 function nl()