wrfv2_fire/frame/libmassv.F

   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