source: lmdz_wrf/trunk/WRFV3/frame/libmassv.F @ 2295

Last change on this file since 2295 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 6.7 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#if defined (G95)
306! no reason why g95 should fail - oh well, we don't use this routine anyways
307      y(j)=asin( sqrt(1-x(j)*x(j)) )
308#else
309      y(j)=acos(x(j))
310#endif
311   10 continue
312      return
313      end
314
315      subroutine vscosh(y,x,n)
316      real*4 x(*),y(*)
317      do 10 j=1,n
318      y(j)=cosh(x(j))
319   10 continue
320      return
321      end
322
323!      subroutine vsexpm1(y,x,n)
324!      real*4 x(*),y(*)
325!      interface
326!        real*8 function expm1(%val(x))
327!          real*8 x
328!        end function expm1
329!      end interface
330!      do 10 j=1,n
331!      y(j)=expm1(real(x(j),8))
332!   10 continue
333!      return
334!      end
335
336      subroutine vslog10(y,x,n)
337      real*4 x(*),y(*)
338      do 10 j=1,n
339      y(j)=log10(x(j))
340   10 continue
341      return
342      end
343
344!      subroutine vslog1p(y,x,n)
345!      real*4 x(*),y(*)
346!      interface
347!        real*8 function log1p(%val(x))
348!          real*8 x
349!        end function log1p
350!      end interface
351!      do 10 j=1,n
352!      y(j)=log1p(real(x(j),8))
353!   10 continue
354!      return
355!      end
356
357
358      subroutine vssinh(y,x,n)
359      real*4 x(*),y(*)
360      do 10 j=1,n
361      y(j)=sinh(x(j))
362   10 continue
363      return
364      end
365
366      subroutine vstanh(y,x,n)
367      real*4 x(*),y(*)
368      do 10 j=1,n
369      y(j)=tanh(x(j))
370   10 continue
371      return
372      end
373#endif
374
375      subroutine vspow(z,y,x,n)
376      real*4 x(*),y(*),z(*)
377      do 10 j=1,n
378      z(j)=y(j)**x(j)
379   10 continue
380      return
381      end
382
383      subroutine vpow(z,y,x,n)
384      real*8 x(*),y(*),z(*)
385      do 10 j=1,n
386      z(j)=y(j)**x(j)
387   10 continue
388      return
389      end
390
Note: See TracBrowser for help on using the repository browser.