source: trunk/WRF.COMMON/WRFV3/frame/libmassv.F @ 2760

Last change on this file since 2760 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 6.5 KB
Line 
1! IBM libmassv compatibility library
2!
3
4#ifndef NATIVE_MASSV
5      subroutine vdiv(z,x,y,n)
6      real*8 x(*),y(*),z(*)
7      do 10 j=1,n
8      z(j)=x(j)/y(j)
9   10 continue
10      return
11      end
12
13      subroutine vsdiv(z,x,y,n)
14      real*4 x(*),y(*),z(*)
15      do 10 j=1,n
16      z(j)=x(j)/y(j)
17   10 continue
18      return
19      end
20
21      subroutine vexp(y,x,n)
22      real*8 x(*),y(*)
23      do 10 j=1,n
24      y(j)=exp(x(j))
25   10 continue
26      return
27      end
28
29      subroutine vsexp(y,x,n)
30      real*4 x(*),y(*)
31      do 10 j=1,n
32      y(j)=exp(x(j))
33   10 continue
34      return
35      end
36
37      subroutine vlog(y,x,n)
38      real*8 x(*),y(*)
39      do 10 j=1,n
40      y(j)=log(x(j))
41   10 continue
42      return
43      end
44
45      subroutine vslog(y,x,n)
46      real*4 x(*),y(*)
47      do 10 j=1,n
48      y(j)=log(x(j))
49   10 continue
50      return
51      end
52
53      subroutine vrec(y,x,n)
54      real*8 x(*),y(*)
55      do 10 j=1,n
56      y(j)=1.d0/x(j)
57   10 continue
58      return
59      end
60
61      subroutine vsrec(y,x,n)
62      real*4 x(*),y(*)
63      do 10 j=1,n
64      y(j)=1.e0/x(j)
65   10 continue
66      return
67      end
68
69      subroutine vrsqrt(y,x,n)
70      real*8 x(*),y(*)
71      do 10 j=1,n
72      y(j)=1.d0/sqrt(x(j))
73   10 continue
74      return
75      end
76
77      subroutine vsrsqrt(y,x,n)
78      real*4 x(*),y(*)
79      do 10 j=1,n
80      y(j)=1.e0/sqrt(x(j))
81   10 continue
82      return
83      end
84
85      subroutine vsincos(x,y,z,n)
86      real*8 x(*),y(*),z(*)
87      do 10 j=1,n
88      x(j)=sin(z(j))
89      y(j)=cos(z(j))
90   10 continue
91      return
92      end
93
94      subroutine vssincos(x,y,z,n)
95      real*4 x(*),y(*),z(*)
96      do 10 j=1,n
97      x(j)=sin(z(j))
98      y(j)=cos(z(j))
99   10 continue
100      return
101      end
102
103      subroutine vsqrt(y,x,n)
104      real*8 x(*),y(*)
105      do 10 j=1,n
106      y(j)=sqrt(x(j))
107   10 continue
108      return
109      end
110
111      subroutine vssqrt(y,x,n)
112      real*4 x(*),y(*)
113      do 10 j=1,n
114      y(j)=sqrt(x(j))
115   10 continue
116      return
117      end
118
119      subroutine vtan(y,x,n)
120      real*8 x(*),y(*)
121      do 10 j=1,n
122      y(j)=tan(x(j))
123   10 continue
124      return
125      end
126
127      subroutine vstan(y,x,n)
128      real*4 x(*),y(*)
129      do 10 j=1,n
130      y(j)=tan(x(j))
131   10 continue
132      return
133      end
134
135      subroutine vatan2(z,y,x,n)
136      real*8 x(*),y(*),z(*)
137      do 10 j=1,n
138      z(j)=atan2(y(j),x(j))
139   10 continue
140      return
141      end
142
143      subroutine vsatan2(z,y,x,n)
144      real*4 x(*),y(*),z(*)
145      do 10 j=1,n
146      z(j)=atan2(y(j),x(j))
147   10 continue
148      return
149      end
150
151      subroutine vasin(y,x,n)
152      real*8 x(*),y(*)
153      do 10 j=1,n
154      y(j)=asin(x(j))
155   10 continue
156      return
157      end
158
159      subroutine vsin(y,x,n)
160      real*8 x(*),y(*)
161      do 10 j=1,n
162      y(j)=sin(x(j))
163   10 continue
164      return
165      end
166
167      subroutine vssin(y,x,n)
168      real*4 x(*),y(*)
169      do 10 j=1,n
170      y(j)=sin(x(j))
171   10 continue
172      return
173      end
174
175      subroutine vacos(y,x,n)
176      real*8 x(*),y(*)
177      do 10 j=1,n
178      y(j)=acos(x(j))
179   10 continue
180      return
181      end
182
183      subroutine vcos(y,x,n)
184      real*8 x(*),y(*)
185      do 10 j=1,n
186      y(j)=cos(x(j))
187   10 continue
188      return
189      end
190
191      subroutine vscos(y,x,n)
192      real*4 x(*),y(*)
193      do 10 j=1,n
194      y(j)=cos(x(j))
195   10 continue
196      return
197      end
198
199      subroutine vcosisin(y,x,n)
200      complex*16 y(*)
201      real*8 x(*)
202      do 10 j=1,n
203      y(j)=dcmplx(cos(x(j)),sin(x(j)))
204   10 continue
205      return
206      end
207
208      subroutine vscosisin(y,x,n)
209      complex*8 y(*)
210      real*4 x(*)
211      do 10 j=1,n
212      y(j)= cmplx(cos(x(j)),sin(x(j)))
213   10 continue
214      return
215      end
216
217      subroutine vdint(y,x,n)
218      real*8 x(*),y(*)
219      do 10 j=1,n
220!     y(j)=dint(x(j))
221      y(j)=int(x(j))
222   10 continue
223      return
224      end
225
226      subroutine vdnint(y,x,n)
227      real*8 x(*),y(*)
228      do 10 j=1,n
229!     y(j)=dnint(x(j))
230      y(j)=nint(x(j))
231   10 continue
232      return
233      end
234
235      subroutine vlog10(y,x,n)
236      real*8 x(*),y(*)
237      do 10 j=1,n
238      y(j)=log10(x(j))
239   10 continue
240      return
241      end
242
243!      subroutine vlog1p(y,x,n)
244!      real*8 x(*),y(*)
245!      interface
246!        real*8 function log1p(%val(x))
247!          real*8 x
248!        end function log1p
249!      end interface
250!      do 10 j=1,n
251!      y(j)=log1p(x(j))
252!   10 continue
253!      return
254!      end
255
256      subroutine vcosh(y,x,n)
257      real*8 x(*),y(*)
258      do 10 j=1,n
259      y(j)=cosh(x(j))
260   10 continue
261      return
262      end
263
264      subroutine vsinh(y,x,n)
265      real*8 x(*),y(*)
266      do 10 j=1,n
267      y(j)=sinh(x(j))
268   10 continue
269      return
270      end
271
272      subroutine vtanh(y,x,n)
273      real*8 x(*),y(*)
274      do 10 j=1,n
275      y(j)=tanh(x(j))
276   10 continue
277      return
278      end
279
280!      subroutine vexpm1(y,x,n)
281!      real*8 x(*),y(*)
282!      interface
283!        real*8 function expm1(%val(x))
284!          real*8 x
285!        end function expm1
286!      end interface
287!      do 10 j=1,n
288!      y(j)=expm1(x(j))
289!   10 continue
290!      return
291!      end
292
293
294      subroutine vsasin(y,x,n)
295      real*4 x(*),y(*)
296      do 10 j=1,n
297      y(j)=asin(x(j))
298   10 continue
299      return
300      end
301
302      subroutine vsacos(y,x,n)
303      real*4 x(*),y(*)
304      do 10 j=1,n
305      y(j)=acos(x(j))
306   10 continue
307      return
308      end
309
310      subroutine vscosh(y,x,n)
311      real*4 x(*),y(*)
312      do 10 j=1,n
313      y(j)=cosh(x(j))
314   10 continue
315      return
316      end
317
318!      subroutine vsexpm1(y,x,n)
319!      real*4 x(*),y(*)
320!      interface
321!        real*8 function expm1(%val(x))
322!          real*8 x
323!        end function expm1
324!      end interface
325!      do 10 j=1,n
326!      y(j)=expm1(real(x(j),8))
327!   10 continue
328!      return
329!      end
330
331      subroutine vslog10(y,x,n)
332      real*4 x(*),y(*)
333      do 10 j=1,n
334      y(j)=log10(x(j))
335   10 continue
336      return
337      end
338
339!      subroutine vslog1p(y,x,n)
340!      real*4 x(*),y(*)
341!      interface
342!        real*8 function log1p(%val(x))
343!          real*8 x
344!        end function log1p
345!      end interface
346!      do 10 j=1,n
347!      y(j)=log1p(real(x(j),8))
348!   10 continue
349!      return
350!      end
351
352
353      subroutine vssinh(y,x,n)
354      real*4 x(*),y(*)
355      do 10 j=1,n
356      y(j)=sinh(x(j))
357   10 continue
358      return
359      end
360
361      subroutine vstanh(y,x,n)
362      real*4 x(*),y(*)
363      do 10 j=1,n
364      y(j)=tanh(x(j))
365   10 continue
366      return
367      end
368#endif
369
370      subroutine vspow(z,y,x,n)
371      real*4 x(*),y(*),z(*)
372      do 10 j=1,n
373      z(j)=y(j)**x(j)
374   10 continue
375      return
376      end
377
378      subroutine vpow(z,y,x,n)
379      real*8 x(*),y(*),z(*)
380      do 10 j=1,n
381      z(j)=y(j)**x(j)
382   10 continue
383      return
384      end
385
Note: See TracBrowser for help on using the repository browser.