1MODULE mpfr 2 USE ISO_C_BINDING 3 4 IMPLICIT NONE 5 6 7 INTEGER, PARAMETER :: MAX_CHAR = 10000 8 INTEGER, PARAMETER, PUBLIC :: dp=KIND(0.0D0) 9 10 INTEGER, PARAMETER, PUBLIC :: GMP_RNDN=0,& 11 GMP_RNDZ=1,& 12 GMP_RNDU=2,& 13 GMP_RNDD=3,& 14 GMP_RND_MAX=4,& 15 GMP_RNDNA=-1 16 17 TYPE, BIND(C) :: mpfr_type 18 INTEGER(C_SHORT) :: mpfr_prec 19 INTEGER(C_LONG) :: mpfr_sign 20 INTEGER(C_LONG) :: mpfr 21 TYPE(C_PTR) :: mpfr_d 22 END TYPE mpfr_type 23 24 INTERFACE 25 SUBROUTINE mpfr_init2(value, precision) BIND(C, name="mpfr_init2") 26 IMPORT 27 TYPE(mpfr_type) :: value 28 INTEGER(C_SHORT), VALUE :: precision 29 END SUBROUTINE mpfr_init2 30 31 SUBROUTINE mpfr_init(value) BIND(C, name="mpfr_init") 32 IMPORT 33 TYPE(mpfr_type) :: value 34 END SUBROUTINE mpfr_init 35 36 SUBROUTINE mpfr_set_default_precision(precision) BIND(C, name="mpfr_set_default_prec") 37 IMPORT 38 INTEGER(C_SHORT), VALUE :: precision 39 END SUBROUTINE mpfr_set_default_precision 40 41 FUNCTION mpfr_get_default_precision() BIND(C, name="mpfr_get_default_prec") 42 IMPORT 43 INTEGER(C_SHORT) :: mpfr_get_default_precision 44 END FUNCTIOn mpfr_get_default_precision 45 46 FUNCTION mpfr_get_precision(variable) BIND(C, name="mpfr_get_prec") 47 IMPORT 48 INTEGER(C_SHORT) :: mpfr_get_precision 49 TYPE(mpfr_type) :: variable 50 END FUNCTION mpfr_get_precision 51 52 FUNCTION mpfr_set_d(variable,real_value,rounding) BIND(C, name="mpfr_set_d") 53 IMPORT 54 INTEGER(C_INT) :: mpfr_set_d 55 TYPE(mpfr_type) :: variable 56 REAL(C_DOUBLE), VALUE :: real_value 57 INTEGER(C_INT), VALUE :: rounding 58 END FUNCTION mpfr_set_d 59 60 FUNCTION mpfr_set_str(variable,str,base,rounding) BIND(C, name="mpfr_set_str") 61 IMPORT 62 INTEGER(C_INT) :: mpfr_set_str 63 TYPE(mpfr_type) :: variable 64 CHARACTER(C_CHAR) :: str 65 INTEGER(C_INT), VALUE :: base 66 INTEGER(C_INT), VALUE :: rounding 67 END FUNCTION mpfr_set_str 68 69 FUNCTION mpfr_strtofr(variable,str1,str2,base,rounding) BIND(C,name="mpfr_strtofr") 70 IMPORT 71 INTEGER(C_INT) :: mpfr_strtofr 72 TYPE(mpfr_type) :: variable 73 CHARACTER(C_CHAR) :: str1 74 CHARACTER(C_CHAR),VALUE :: str2 75 INTEGER(C_INT), VALUE :: base 76 INTEGER(C_INT), VALUE :: rounding 77 END FUNCTION mpfr_strtofr 78 79 PURE FUNCTION mpfr_get_d(variable,rounding) BIND(C, name="mpfr_get_d") 80 IMPORT 81 REAL(C_DOUBLE) :: mpfr_get_d 82 TYPE(mpfr_type), INTENT(IN) :: variable 83 INTEGER(C_INT), VALUE, INTENT(IN) :: rounding 84 END FUNCTION mpfr_get_d 85 86 FUNCTION mpfr_cmp(op1,op2) BIND(C,name="mpfr_cmp") 87 IMPORT 88 INTEGER(C_INT) :: mpfr_cmp 89 TYPE(mpfr_type) :: op1,op2 90 END FUNCTION mpfr_cmp 91 92 FUNCTION mpfr_add(result,op1,op2,rounding) BIND(C, name="mpfr_add") 93 IMPORT 94 INTEGER(C_INT) :: mpfr_add 95 TYPE(mpfr_type) :: result,op1,op2 96 INTEGER(C_INT), VALUE :: rounding 97 END FUNCTION mpfr_add 98 99 FUNCTION mpfr_sub(result,op1,op2,rounding) BIND(C, name="mpfr_sub") 100 IMPORT 101 INTEGER(C_INT) :: mpfr_sub 102 TYPE(mpfr_type) :: result,op1,op2 103 INTEGER(C_INT), VALUE :: rounding 104 END FUNCTION mpfr_sub 105 106 FUNCTION mpfr_mul_ui(result,op1,int,rounding) BIND(C, name="mpfr_mul_ui") 107 IMPORT 108 INTEGER(C_INT) :: mpfr_mul_ui 109 TYPE(mpfr_type) :: result,op1 110 INTEGER(C_INT), VALUE :: int 111 INTEGER(C_INT), VALUE :: rounding 112 END FUNCTION mpfr_mul_ui 113 114 FUNCTION mpfr_mul(result,op1,op2,rounding) BIND(C, name="mpfr_mul") 115 IMPORT 116 INTEGER(C_INT) :: mpfr_mul 117 TYPE(mpfr_type) :: result,op1,op2 118 INTEGER(C_INT), VALUE :: rounding 119 END FUNCTION mpfr_mul 120 121 FUNCTION mpfr_div(result,op1,op2,rounding) BIND(C, name="mpfr_div") 122 IMPORT 123 INTEGER(C_INT) :: mpfr_div 124 TYPE(mpfr_type) :: result,op1,op2 125 INTEGER(C_INT), VALUE :: rounding 126 END FUNCTION mpfr_div 127 128 FUNCTION mpfr_pow(result,op1,op2,rounding) BIND(C, name="mpfr_pow") 129 IMPORT 130 INTEGER(C_INT) :: mpfr_pow 131 TYPE(mpfr_type) :: result,op1,op2 132 INTEGER(C_INT), VALUE :: rounding 133 END FUNCTION mpfr_pow 134 135 FUNCTION mpfr_pow_si(result,op1,op2,rounding) BIND(C, name="mpfr_pow_si") 136 IMPORT 137 INTEGER(C_INT) :: mpfr_pow_si 138 TYPE(mpfr_type) :: result,op1 139 INTEGER(C_SHORT) :: op2 140 INTEGER(C_INT), VALUE :: rounding 141 END FUNCTION mpfr_pow_si 142 143 FUNCTION mpfr_dump(variable) BIND(C, name="mpfr_dump") 144 IMPORT 145 INTEGER(C_INT) :: mpfr_dump 146 TYPE(mpfr_type) :: variable 147 END FUNCTION mpfr_dump 148 149 SUBROUTINE mpfr_clear(variable) BIND(C, name="mpfr_clear") 150 IMPORT 151 TYPE(mpfr_type) :: variable 152 END SUBROUTINE mpfr_clear 153 154 FUNCTION mpfr_get_str(str,exp,base,n,variable,rounding) BIND(C,name="mpfr_get_str") 155 IMPORT 156 TYPE(C_PTR) :: mpfr_get_str 157 CHARACTER(C_CHAR) :: str 158 INTEGER(C_INT) :: exp 159 INTEGER(C_INT), VALUE :: base 160 INTEGER(C_SHORT), VALUE :: n 161 TYPE(mpfr_type) :: variable 162 INTEGER(C_INT), VALUE :: rounding 163 END FUNCTION mpfr_get_str 164 165 FUNCTION mpfr_log(result,op,rounding) BIND(C,name="mpfr_log") 166 IMPORT 167 INTEGER(C_INT) :: mpfr_log 168 TYPE(mpfr_type) :: result, op 169 INTEGER(C_INT), VALUE :: rounding 170 END FUNCTION mpfr_log 171 172 FUNCTION mpfr_log2(result,op,rounding) BIND(C,name="mpfr_log2") 173 IMPORT 174 INTEGER(C_INT) :: mpfr_log2 175 TYPE(mpfr_type) :: result, op 176 INTEGER(C_INT), VALUE :: rounding 177 END FUNCTION mpfr_log2 178 179 FUNCTION mpfr_log10(result,op,rounding) BIND(C,name="mpfr_log10") 180 IMPORT 181 INTEGER(C_INT) :: mpfr_log10 182 TYPE(mpfr_type) :: result, op 183 INTEGER(C_INT), VALUE :: rounding 184 END FUNCTION mpfr_log10 185 186 FUNCTION mpfr_exp(result,op,rounding) BIND(C,name="mpfr_exp") 187 IMPORT 188 INTEGER(C_INT) :: mpfr_exp 189 TYPE(mpfr_type) :: result, op 190 INTEGER(C_INT), VALUE :: rounding 191 END FUNCTION mpfr_exp 192 193 FUNCTION mpfr_exp2(result,op,rounding) BIND(C,name="mpfr_exp2") 194 IMPORT 195 INTEGER(C_INT) :: mpfr_exp2 196 TYPE(mpfr_type) :: result, op 197 INTEGER(C_INT), VALUE :: rounding 198 END FUNCTION mpfr_exp2 199 200 FUNCTION mpfr_exp10(result,op,rounding) BIND(C,name="mpfr_exp10") 201 IMPORT 202 INTEGER(C_INT) :: mpfr_exp10 203 TYPE(mpfr_type) :: result, op 204 INTEGER(C_INT), VALUE :: rounding 205 END FUNCTION mpfr_exp10 206 207 FUNCTION mpfr_cos(result,op,rounding) BIND(C,name="mpfr_cos") 208 IMPORT 209 INTEGER(C_INT) :: mpfr_cos 210 TYPE(mpfr_type) :: result, op 211 INTEGER(C_INT), VALUE :: rounding 212 END FUNCTION mpfr_cos 213 214 FUNCTION mpfr_sin(result,op,rounding) BIND(C,name="mpfr_sin") 215 IMPORT 216 INTEGER(C_INT) :: mpfr_sin 217 TYPE(mpfr_type) :: result, op 218 INTEGER(C_INT), VALUE :: rounding 219 END FUNCTION mpfr_sin 220 221 FUNCTION mpfr_tan(result,op,rounding) BIND(C,name="mpfr_tan") 222 IMPORT 223 INTEGER(C_INT) :: mpfr_tan 224 TYPE(mpfr_type) :: result, op 225 INTEGER(C_INT), VALUE :: rounding 226 END FUNCTION mpfr_tan 227 228 FUNCTION mpfr_sec(result,op,rounding) BIND(C,name="mpfr_sec") 229 IMPORT 230 INTEGER(C_INT) :: mpfr_sec 231 TYPE(mpfr_type) :: result, op 232 INTEGER(C_INT), VALUE :: rounding 233 END FUNCTION mpfr_sec 234 235 FUNCTION mpfr_csc(result,op,rounding) BIND(C,name="mpfr_csc") 236 IMPORT 237 INTEGER(C_INT) :: mpfr_csc 238 TYPE(mpfr_type) :: result, op 239 INTEGER(C_INT), VALUE :: rounding 240 END FUNCTION mpfr_csc 241 242 FUNCTION mpfr_cot(result,op,rounding) BIND(C,name="mpfr_cot") 243 IMPORT 244 INTEGER(C_INT) :: mpfr_cot 245 TYPE(mpfr_type) :: result, op 246 INTEGER(C_INT), VALUE :: rounding 247 END FUNCTION mpfr_cot 248 249 FUNCTION mpfr_acos(result,op,rounding) BIND(C,name="mpfr_acos") 250 IMPORT 251 INTEGER(C_INT) :: mpfr_acos 252 TYPE(mpfr_type) :: result, op 253 INTEGER(C_INT), VALUE :: rounding 254 END FUNCTION mpfr_acos 255 256 FUNCTION mpfr_asin(result,op,rounding) BIND(C,name="mpfr_asin") 257 IMPORT 258 INTEGER(C_INT) :: mpfr_asin 259 TYPE(mpfr_type) :: result, op 260 INTEGER(C_INT), VALUE :: rounding 261 END FUNCTION mpfr_asin 262 263 FUNCTION mpfr_atan(result,op,rounding) BIND(C,name="mpfr_atan") 264 IMPORT 265 INTEGER(C_INT) :: mpfr_atan 266 TYPE(mpfr_type) :: result, op 267 INTEGER(C_INT), VALUE :: rounding 268 END FUNCTION mpfr_atan 269 270 FUNCTION mpfr_atan2(result,x,y,rounding) BIND(C,name="mpfr_atan2") 271 IMPORT 272 INTEGER(C_INT) :: mpfr_atan2 273 TYPE(mpfr_type) :: result, x,y 274 INTEGER(C_INT), VALUE :: rounding 275 END FUNCTION mpfr_atan2 276 277 FUNCTION mpfr_cosh(result,op,rounding) BIND(C,name="mpfr_cosh") 278 IMPORT 279 INTEGER(C_INT) :: mpfr_cosh 280 TYPE(mpfr_type) :: result, op 281 INTEGER(C_INT), VALUE :: rounding 282 END FUNCTION mpfr_cosh 283 284 FUNCTION mpfr_sinh(result,op,rounding) BIND(C,name="mpfr_sinh") 285 IMPORT 286 INTEGER(C_INT) :: mpfr_sinh 287 TYPE(mpfr_type) :: result, op 288 INTEGER(C_INT), VALUE :: rounding 289 END FUNCTION mpfr_sinh 290 291 FUNCTION mpfr_tanh(result,op,rounding) BIND(C,name="mpfr_tanh") 292 IMPORT 293 INTEGER(C_INT) :: mpfr_tanh 294 TYPE(mpfr_type) :: result, op 295 INTEGER(C_INT), VALUE :: rounding 296 END FUNCTION mpfr_tanh 297 298 FUNCTION mpfr_sech(result,op,rounding) BIND(C,name="mpfr_sech") 299 IMPORT 300 INTEGER(C_INT) :: mpfr_sech 301 TYPE(mpfr_type) :: result, op 302 INTEGER(C_INT), VALUE :: rounding 303 END FUNCTION mpfr_sech 304 305 FUNCTION mpfr_csch(result,op,rounding) BIND(C,name="mpfr_csch") 306 IMPORT 307 INTEGER(C_INT) :: mpfr_csch 308 TYPE(mpfr_type) :: result, op 309 INTEGER(C_INT), VALUE :: rounding 310 END FUNCTION mpfr_csch 311 312 FUNCTION mpfr_coth(result,op,rounding) BIND(C,name="mpfr_coth") 313 IMPORT 314 INTEGER(C_INT) :: mpfr_coth 315 TYPE(mpfr_type) :: result, op 316 INTEGER(C_INT), VALUE :: rounding 317 END FUNCTION mpfr_coth 318 319 FUNCTION mpfr_acosh(result,op,rounding) BIND(C,name="mpfr_acosh") 320 IMPORT 321 INTEGER(C_INT) :: mpfr_acosh 322 TYPE(mpfr_type) :: result, op 323 INTEGER(C_INT), VALUE :: rounding 324 END FUNCTION mpfr_acosh 325 326 FUNCTION mpfr_asinh(result,op,rounding) BIND(C,name="mpfr_asinh") 327 IMPORT 328 INTEGER(C_INT) :: mpfr_asinh 329 TYPE(mpfr_type) :: result, op 330 INTEGER(C_INT), VALUE :: rounding 331 END FUNCTION mpfr_asinh 332 333 FUNCTION mpfr_atanh(result,op,rounding) BIND(C,name="mpfr_atanh") 334 IMPORT 335 INTEGER(C_INT) :: mpfr_atanh 336 TYPE(mpfr_type) :: result, op 337 INTEGER(C_INT), VALUE :: rounding 338 END FUNCTION mpfr_atanh 339 340 FUNCTION mpfr_eint(x,y,rounding) BIND(C,name="mpfr_eint") 341 IMPORT 342 INTEGER(C_INT) :: mpfr_eint 343 TYPE(mpfr_type) :: x,y 344 INTEGER(C_INT), VALUE :: rounding 345 END FUNCTION mpfr_eint 346 347 FUNCTION mpfr_gamma(result,op,rounding) BIND(C,name="mpfr_gamma") 348 IMPORT 349 INTEGER(C_INT) :: mpfr_gamma 350 TYPE(mpfr_type) :: result, op 351 INTEGER(C_INT), VALUE :: rounding 352 END FUNCTION mpfr_gamma 353 354 FUNCTION mpfr_lngamma(result,op,rounding) BIND(C,name="mpfr_lngamma") 355 IMPORT 356 INTEGER(C_INT) :: mpfr_lngamma 357 TYPE(mpfr_type) :: result, op 358 INTEGER(C_INT), VALUE :: rounding 359 END FUNCTION mpfr_lngamma 360 361 FUNCTION mpfr_erf(result,op,rounding) BIND(C,name="mpfr_erf") 362 IMPORT 363 INTEGER(C_INT) :: mpfr_erf 364 TYPE(mpfr_type) :: result, op 365 INTEGER(C_INT), VALUE :: rounding 366 END FUNCTION mpfr_erf 367 368 FUNCTION mpfr_erfc(result,op,rounding) BIND(C,name="mpfr_erfc") 369 IMPORT 370 INTEGER(C_INT) :: mpfr_erfc 371 TYPE(mpfr_type) :: result, op 372 INTEGER(C_INT), VALUE :: rounding 373 END FUNCTION mpfr_erfc 374 375 FUNCTION mpfr_bessel_j0(result,op,rounding) BIND(C,name="mpfr_j0") 376 IMPORT 377 INTEGER(C_INT) :: mpfr_bessel_j0 378 TYPE(mpfr_type) :: result, op 379 INTEGER(C_INT), VALUE :: rounding 380 END FUNCTION mpfr_bessel_j0 381 382 FUNCTION mpfr_bessel_j1(result,op,rounding) BIND(C,name="mpfr_j1") 383 IMPORT 384 INTEGER(C_INT) :: mpfr_bessel_j1 385 TYPE(mpfr_type) :: result, op 386 INTEGER(C_INT), VALUE :: rounding 387 END FUNCTION mpfr_bessel_j1 388 389 FUNCTION mpfr_bessel_y0(result,op,rounding) BIND(C,name="mpfr_y0") 390 IMPORT 391 INTEGER(C_INT) :: mpfr_bessel_y0 392 TYPE(mpfr_type) :: result, op 393 INTEGER(C_INT), VALUE :: rounding 394 END FUNCTION mpfr_bessel_y0 395 396 FUNCTION mpfr_bessel_y1(result,op,rounding) BIND(C,name="mpfr_y1") 397 IMPORT 398 INTEGER(C_INT) :: mpfr_bessel_y1 399 TYPE(mpfr_type) :: result, op 400 INTEGER(C_INT), VALUE :: rounding 401 END FUNCTION mpfr_bessel_y1 402 403 FUNCTION mpfr_const_log2(result,rounding) BIND(C,name="mpfr_const_log2") 404 IMPORT 405 INTEGER(C_INT) :: mpfr_const_log2 406 TYPE(mpfr_type) :: result 407 INTEGER(C_INT), VALUE :: rounding 408 END FUNCTION mpfr_const_log2 409 410 FUNCTION mpfr_const_pi(result,rounding) BIND(C,name="mpfr_const_pi") 411 IMPORT 412 INTEGER(C_INT) :: mpfr_const_pi 413 TYPE(mpfr_type) :: result 414 INTEGER(C_INT), VALUE :: rounding 415 END FUNCTION mpfr_const_pi 416 417 FUNCTION mpfr_const_euler(result,rounding) BIND(C,name="mpfr_const_euler") 418 IMPORT 419 INTEGER(C_INT) :: mpfr_const_euler 420 TYPE(mpfr_type) :: result 421 INTEGER(C_INT), VALUE :: rounding 422 END FUNCTION mpfr_const_euler 423 424 FUNCTION mpfr_sqrt(result,op,rounding) BIND(C,name="mpfr_sqrt") 425 IMPORT 426 INTEGER(C_INT) :: mpfr_sqrt 427 TYPE(mpfr_type) :: result, op 428 INTEGER(C_INT), VALUE :: rounding 429 END FUNCTION mpfr_sqrt 430 END INTERFACE 431 432END MODULE mpfr 433 434MODULE mpfr_ops 435 USE mpfr 436 437 INTERFACE OPERATOR (+) 438 MODULE PROCEDURE mpfr_addition_mp_mp,& 439 mpfr_addition_mp_real,& 440 mpfr_addition_real_mp,& 441 mpfr_addition_mp_int,& 442 mpfr_addition_int_mp 443 END INTERFACE 444 INTERFACE OPERATOR (-) 445 MODULE PROCEDURE mpfr_subtraction_mp_mp,& 446 mpfr_subtraction_mp_real,& 447 mpfr_subtraction_real_mp,& 448 mpfr_subtraction_int_mp,& 449 mpfr_subtraction_mp_int,& 450 mpfr_minus 451 END INTERFACE 452 INTERFACE OPERATOR (*) 453 MODULE PROCEDURE mpfr_multiplication_mp_mp,& 454 mpfr_multiplication_real_mp,& 455 mpfr_multiplication_mp_real,& 456 mpfr_multiplication_int_mp,& 457 mpfr_multiplication_mp_int 458 END INTERFACE 459 INTERFACE OPERATOR(/) 460 MODULE PROCEDURE mpfr_division_mp_mp,& 461 mpfr_division_real_mp,& 462 mpfr_division_mp_real,& 463 mpfr_division_int_mp,& 464 mpfr_division_mp_int 465 END INTERFACE 466 INTERFACE OPERATOR(**) 467 MODULE PROCEDURE mpfr_power_mp_mp,& 468 mpfr_power_mp_int,& 469 mpfr_power_int_mp,& 470 mpfr_power_real_mp,& 471 mpfr_power_mp_real 472 END INTERFACE 473 INTERFACE ASSIGNMENT(=) 474 MODULE PROCEDURE mpfr_assign_mp_real,& 475 mpfr_assign_mp_mp,& 476 mpfr_assign_mp_str,& 477 mpfr_assign_mp_int 478 END INTERFACE 479 480 INTERFACE OPERATOR(.CONVERT.) 481 MODULE PROCEDURE mpfr_convert_str 482 END INTERFACE 483 484 INTERFACE OPERATOR(<) 485 MODULE PROCEDURE mpfr_lt_mp_mp,& 486 mpfr_lt_mp_real,& 487 mpfr_lt_real_mp,& 488 mpfr_lt_mp_int,& 489 mpfr_lt_int_mp 490 END INTERFACE 491 492 INTERFACE OPERATOR(>) 493 MODULE PROCEDURE mpfr_gt_mp_mp,& 494 mpfr_gt_mp_real,& 495 mpfr_gt_real_mp,& 496 mpfr_gt_mp_int,& 497 mpfr_gt_int_mp 498 END INTERFACE 499 500 INTERFACE OPERATOR(<=) 501 MODULE PROCEDURE mpfr_lte_mp_mp,& 502 mpfr_lte_mp_real,& 503 mpfr_lte_real_mp,& 504 mpfr_lte_mp_int,& 505 mpfr_lte_int_mp 506 END INTERFACE 507 508 INTERFACE OPERATOR(>=) 509 MODULE PROCEDURE mpfr_gte_mp_mp,& 510 mpfr_gte_mp_real,& 511 mpfr_gte_real_mp,& 512 mpfr_gte_mp_int,& 513 mpfr_gte_int_mp 514 END INTERFACE 515 516 INTERFACE OPERATOR(==) 517 MODULE PROCEDURE mpfr_eq_mp_mp,& 518 mpfr_eq_mp_real,& 519 mpfr_eq_real_mp,& 520 mpfr_eq_mp_int,& 521 mpfr_eq_int_mp 522 END INTERFACE 523 524 INTERFACE OPERATOR(/=) 525 MODULE PROCEDURE mpfr_neq_mp_mp,& 526 mpfr_neq_mp_real,& 527 mpfr_neq_real_mp,& 528 mpfr_neq_mp_int,& 529 mpfr_neq_int_mp 530 END INTERFACE 531 532 INTERFACE set_value 533 MODULE PROCEDURE set_value_real, set_value_int, set_value_str 534 END INTERFACE 535 536 INTERFACE log 537 MODULE PROCEDURE log_mp 538 END INTERFACE 539 540 INTERFACE log2 541 MODULE PROCEDURE log2_mp 542 END INTERFACE 543 544 INTERFACE log10 545 MODULE PROCEDURE log10_mp 546 END INTERFACE 547 548 INTERFACE exp 549 MODULE PROCEDURE exp_mp 550 END INTERFACE 551 552 INTERFACE exp2 553 MODULE PROCEDURE exp2_mp 554 END INTERFACE 555 556 INTERFACE exp10 557 MODULE PROCEDURE exp10_mp 558 END INTERFACE 559 560 INTERFACE cos 561 MODULE PROCEDURE cos_mp 562 END INTERFACE 563 564 INTERFACE sin 565 MODULE PROCEDURE sin_mp 566 END INTERFACE 567 568 INTERFACE tan 569 MODULE PROCEDURE tan_mp 570 END INTERFACE 571 572 INTERFACE sec 573 MODULE PROCEDURE sec_mp 574 END INTERFACE 575 576 INTERFACE csc 577 MODULE PROCEDURE csc_mp 578 END INTERFACE 579 580 INTERFACE cot 581 MODULE PROCEDURE cot_mp 582 END INTERFACE 583 584 INTERFACE acos 585 MODULE PROCEDURE acos_mp 586 END INTERFACE 587 588 INTERFACE asin 589 MODULE PROCEDURE asin_mp 590 END INTERFACE 591 592 INTERFACE atan 593 MODULE PROCEDURE atan_mp 594 END INTERFACE 595 596 INTERFACE atan2 597 MODULE PROCEDURE atan2_mp 598 END INTERFACE 599 600 INTERFACE cosh 601 MODULE PROCEDURE cosh_mp 602 END INTERFACE 603 604 INTERFACE sinh 605 MODULE PROCEDURE sinh_mp 606 END INTERFACE 607 608 INTERFACE tanh 609 MODULE PROCEDURE tanh_mp 610 END INTERFACE 611 612 INTERFACE sech 613 MODULE PROCEDURE sech_mp 614 END INTERFACE 615 616 INTERFACE csch 617 MODULE PROCEDURE csch_mp 618 END INTERFACE 619 620 INTERFACE coth 621 MODULE PROCEDURE coth_mp 622 END INTERFACE 623 624 INTERFACE acosh 625 MODULE PROCEDURE acosh_mp 626 END INTERFACE 627 628 INTERFACE asinh 629 MODULE PROCEDURE asinh_mp 630 END INTERFACE 631 632 INTERFACE atanh 633 MODULE PROCEDURE atanh_mp 634 END INTERFACE 635 636 INTERFACE ei 637 MODULE PROCEDURE ei_mp 638 END INTERFACE 639 640 INTERFACE gamma 641 MODULE PROCEDURE gamma_mp 642 END INTERFACE 643 644 INTERFACE lngamma 645 MODULE PROCEDURE lngamma_mp 646 END INTERFACE 647 648 INTERFACE erf 649 MODULE PROCEDURE erf_mp 650 END INTERFACE 651 652 INTERFACE erfc 653 MODULE PROCEDURE erfc_mp 654 END INTERFACE 655 656 INTERFACE bessel_j0 657 MODULE PROCEDURE bessel_j0_mp 658 END INTERFACE 659 660 INTERFACE bessel_j1 661 MODULE PROCEDURE bessel_j1_mp 662 END INTERFACE 663 664 INTERFACE bessel_y0 665 MODULE PROCEDURE bessel_y0_mp 666 END INTERFACE 667 668 INTERFACE bessel_y1 669 MODULE PROCEDURE bessel_y1_mp 670 END INTERFACE 671 672 INTERFACE sqrt 673 MODULE PROCEDURE sqrt_mp 674 END INTERFACE 675 676 INTERFACE REAL 677 MODULE PROCEDURE mp_to_real 678 END INTERFACE 679 680 CONTAINS 681 682 SUBROUTINE initialize(variable,precision) 683 TYPE(mpfr_type) :: variable 684 INTEGER*2, OPTIONAL :: precision 685 686 IF( PRESENT(precision) ) THEN 687 CALL mpfr_init2(variable,precision) 688 ELSE 689 CALL mpfr_init(variable) 690 END IF 691 END SUBROUTINE initialize 692 693 SUBROUTINE mpfr_assign_mp_real(op1,op2) 694 TYPE(mpfr_type),& 695 INTENT(INOUT) :: op1 696 REAL(dp),& 697 INTENT(IN) :: op2 698 699 CALL initialize(op1) 700 CALL set_value(op1,op2) 701 END SUBROUTINE mpfr_assign_mp_real 702 703 SUBROUTINE mpfr_assign_mp_int(op1,op2) 704 TYPE(mpfr_type),& 705 INTENT(INOUT) :: op1 706 INTEGER,& 707 INTENT(IN) :: op2 708 709 REAL(dp) :: op2_real 710 711 CALL initialize(op1) 712 op2_real = REAL(op2,dp) 713 CALL set_value(op1,op2_real) 714 END SUBROUTINE mpfr_assign_mp_int 715 716 SUBROUTINE mpfr_assign_mp_str(op1,op2) 717 TYPE(mpfr_type),& 718 INTENT(INOUT) :: op1 719 CHARACTER(LEN=*),& 720 INTENT(IN) :: op2 721 722 CALL initialize(op1) 723 CALL set_value(op1,op2) 724 END SUBROUTINE mpfr_assign_mp_str 725 726 SUBROUTINE mpfr_assign_mp_mp(op1,op2) 727 TYPE(mpfr_type),& 728 INTENT(INOUT) :: op1 729 TYPE(mpfr_type),& 730 INTENT(IN) :: op2 731 732 CALL initialize(op1) 733 op1%mpfr_prec = op2%mpfr_prec 734 op1%mpfr_sign = op2%mpfr_sign 735 op1%mpfr = op2%mpfr 736 op1%mpfr_d = op2%mpfr_d 737 END SUBROUTINE mpfr_assign_mp_mp 738 739 ELEMENTAL FUNCTION mp_to_real(variable) 740 REAL(dp) :: mp_to_real 741 TYPE(mpfr_type), INTENT(IN) :: variable 742 743 mp_to_real = mpfr_get_d(variable,GMP_RNDN) 744 END FUNCTION mp_to_real 745 746 SUBROUTINE set_value_real(variable,value) 747 TYPE(mpfr_type) :: variable 748 REAL(dp) :: value 749 750 INTEGER :: retval 751 752 retval = mpfr_set_d(variable,value,GMP_RNDN) 753 END SUBROUTINE set_value_real 754 755 SUBROUTINE set_value_int(variable,value) 756 TYPE(mpfr_type) :: variable 757 INTEGER :: value 758 759 REAL(dp) :: real_value 760 761 real_value = REAL(value,dp) 762 retval = mpfr_set_d(variable,real_value,GMP_RNDN) 763 END SUBROUTINE set_value_int 764 765 SUBROUTINE set_value_str(variable,str) 766 TYPE(mpfr_type) :: variable 767 CHARACTER(LEN=*) :: str 768 769 retval = mpfr_set_str(variable,str,10,GMP_RNDN) 770 END SUBROUTINE set_value_str 771 772 FUNCTION mpfr_convert_str(a) 773 TYPE(mpfr_type) :: mpfr_convert_str 774 CHARACTER(LEN=*),& 775 INTENT(IN) :: a 776 777 CHARACTER(LEN=MAX_CHAR) :: buffer 778 INTEGER :: retval 779 780 CALL initialize(mpfr_convert_str) 781 buffer = TRIM(a)//C_NULL_CHAR 782 DO i=1,LEN_TRIM(a) 783 IF(buffer(i:i)=="D" .OR. buffer(i:i)=="d" ) buffer(i:i)="E" 784 ENDDO 785 786 retval = mpfr_set_str(mpfr_convert_str,buffer,10,GMP_RNDN) 787 END FUNCTION mpfr_convert_str 788 789 790 FUNCTION mpfr_addition_mp_mp(a1,a2) 791 TYPE(mpfr_type) :: mpfr_addition_mp_mp 792 TYPE(mpfr_type),INTENT(IN) :: a1,a2 793 794 INTEGER :: retval 795 796 CALL initialize(mpfr_addition_mp_mp) 797 retval = mpfr_add(mpfr_addition_mp_mp,a1,a2,GMP_RNDN) 798 END FUNCTION mpfr_addition_mp_mp 799 800 FUNCTION mpfr_addition_mp_real(a1,a2) 801 TYPE(mpfr_type) :: mpfr_addition_mp_real 802 TYPE(mpfr_type),INTENT(IN) :: a1 803 REAL(dp), INTENT(IN) :: a2 804 805 INTEGER :: retval 806 TYPE(mpfr_type) :: a2_mpfr 807 808 CALL initialize(a2_mpfr) 809 CALL set_value(a2_mpfr,a2) 810 mpfr_addition_mp_real = mpfr_addition_mp_mp(a1,a2_mpfr) 811 CALL mpfr_clear(a2_mpfr) 812 END FUNCTION mpfr_addition_mp_real 813 814 FUNCTION mpfr_addition_real_mp(a1,a2) 815 TYPE(mpfr_type) :: mpfr_addition_real_mp 816 REAL(dp), INTENT(IN) :: a1 817 TYPE(mpfr_type),INTENT(IN) :: a2 818 819 mpfr_addition_real_mp = mpfr_addition_mp_real(a2,a1) 820 END FUNCTION mpfr_addition_real_mp 821 822 FUNCTION mpfr_addition_mp_int(a1,a2) 823 TYPE(mpfr_type) :: mpfr_addition_mp_int 824 TYPE(mpfr_type),INTENT(IN) :: a1 825 INTEGER, INTENT(IN) :: a2 826 827 INTEGER :: retval 828 TYPE(mpfr_type) :: a2_mpfr 829 REAL(dp) :: a2_real 830 831 a2_real = REAL(a2,dp) 832 CALL initialize(a2_mpfr) 833 CALL set_value(a2_mpfr,a2_real) 834 mpfr_addition_mp_int = mpfr_addition_mp_mp(a1,a2_mpfr) 835 CALL mpfr_clear(a2_mpfr) 836 END FUNCTION mpfr_addition_mp_int 837 838 FUNCTION mpfr_addition_int_mp(a1,a2) 839 TYPE(mpfr_type) :: mpfr_addition_int_mp 840 INTEGER, INTENT(IN) :: a1 841 TYPE(mpfr_type),INTENT(IN) :: a2 842 843 mpfr_addition_int_mp = mpfr_addition_mp_int(a2,a1) 844 END FUNCTION mpfr_addition_int_mp 845 846 FUNCTION mpfr_subtraction_mp_mp(a1,a2) 847 TYPE(mpfr_type) :: mpfr_subtraction_mp_mp 848 TYPE(mpfr_type),INTENT(IN) :: a1,a2 849 850 INTEGER :: retval 851 852 CALL initialize(mpfr_subtraction_mp_mp) 853 retval = mpfr_sub(mpfr_subtraction_mp_mp,a1,a2,GMP_RNDN) 854 END FUNCTION mpfr_subtraction_mp_mp 855 856 FUNCTION mpfr_minus(a1) 857 TYPE(mpfr_type) :: mpfr_minus 858 TYPE(mpfr_type),INTENT(IN) :: a1 859 860 INTEGER :: retval 861 862 CALL initialize(mpfr_minus) 863 mpfr_minus = 0.0_dp - a1 864 END FUNCTION mpfr_minus 865 866 FUNCTION mpfr_subtraction_real_mp(a1,a2) 867 TYPE(mpfr_type) :: mpfr_subtraction_real_mp 868 REAL(dp), INTENT(IN) :: a1 869 TYPE(mpfr_type),INTENT(IN) :: a2 870 871 INTEGER :: retval 872 TYPE(mpfr_type) :: a1_mp 873 874 CALL initialize(a1_mp) 875 CALL set_value(a1_mp,a1) 876 mpfr_subtraction_real_mp = mpfr_subtraction_mp_mp(a1_mp,a2) 877 CALL mpfr_clear(a1_mp) 878 END FUNCTION mpfr_subtraction_real_mp 879 880 FUNCTION mpfr_subtraction_mp_real(a1,a2) 881 TYPE(mpfr_type) :: mpfr_subtraction_mp_real 882 TYPE(mpfr_type),INTENT(IN) :: a1 883 REAL(dp), INTENT(IN) :: a2 884 885 TYPE(mpfr_type) :: a2_mp 886 887 CALL initialize(a2_mp) 888 CALL set_value(a2_mp,a2) 889 mpfr_subtraction_mp_real = mpfr_subtraction_mp_mp(a1,a2_mp) 890 CALL mpfr_clear(a2_mp) 891 END FUNCTION mpfr_subtraction_mp_real 892 893 FUNCTION mpfr_subtraction_int_mp(a1,a2) 894 TYPE(mpfr_type) :: mpfr_subtraction_int_mp 895 INTEGER, INTENT(IN) :: a1 896 TYPE(mpfr_type),INTENT(IN) :: a2 897 898 REAL(dp) :: a1_real 899 TYPE(mpfr_type) :: a1_mp 900 901 a1_real = REAL(a1,dp) 902 CALL initialize(a1_mp) 903 CALL set_value(a1_mp,a1_real) 904 mpfr_subtraction_int_mp = mpfr_subtraction_mp_mp(a1_mp,a2) 905 CALL mpfr_clear(a1_mp) 906 END FUNCTION mpfr_subtraction_int_mp 907 908 FUNCTION mpfr_subtraction_mp_int(a1,a2) 909 TYPE(mpfr_type) :: mpfr_subtraction_mp_int 910 TYPE(mpfr_type),INTENT(IN) :: a1 911 INTEGER, INTENT(IN) :: a2 912 913 REAL(dp) :: a2_real 914 TYPE(mpfr_type) :: a2_mp 915 916 a2_real = REAL(a2,dp) 917 CALL initialize(a2_mp) 918 CALL set_value(a2_mp,a2_real) 919 mpfr_subtraction_mp_int = mpfr_subtraction_mp_mp(a1,a2_mp) 920 CALL mpfr_clear(a2_mp) 921 END FUNCTION mpfr_subtraction_mp_int 922 923 FUNCTION mpfr_multiplication_mp_mp(a1,a2) 924 TYPE(mpfr_type) :: mpfr_multiplication_mp_mp 925 TYPE(mpfr_type),INTENT(IN) :: a1,a2 926 927 INTEGER :: retval 928 929 CALL initialize(mpfr_multiplication_mp_mp) 930 retval = mpfr_mul(mpfr_multiplication_mp_mp,a1,a2,GMP_RNDN) 931 END FUNCTION mpfr_multiplication_mp_mp 932 933 FUNCTION mpfr_multiplication_real_mp(a1,a2) 934 TYPE(mpfr_type) :: mpfr_multiplication_real_mp 935 REAL(dp), INTENT(IN) :: a1 936 TYPE(mpfr_type),INTENT(IN) :: a2 937 938 INTEGER :: retval 939 TYPE(mpfr_type) :: a1_mp 940 941 CALL initialize(a1_mp) 942 CALL set_value(a1_mp,a1) 943 mpfr_multiplication_real_mp = mpfr_multiplication_mp_mp(a1_mp,a2) 944 CALL mpfr_clear(a1_mp) 945 END FUNCTION mpfr_multiplication_real_mp 946 947 FUNCTION mpfr_multiplication_mp_real(a1,a2) 948 TYPE(mpfr_type) :: mpfr_multiplication_mp_real 949 TYPE(mpfr_type),INTENT(IN) :: a1 950 REAL(dp), INTENT(IN) :: a2 951 952 mpfr_multiplication_mp_real = mpfr_multiplication_real_mp(a2,a1) 953 END FUNCTION mpfr_multiplication_mp_real 954 955 FUNCTION mpfr_multiplication_int_mp(a1,a2) 956 TYPE(mpfr_type) :: mpfr_multiplication_int_mp 957 INTEGER, INTENT(IN) :: a1 958 TYPE(mpfr_type),INTENT(IN) :: a2 959 960 INTEGER :: retval 961 TYPE(mpfr_type) :: a1_mp 962 REAL(dp) :: a1_real 963 964 a1_real = REAL(a1,dp) 965 CALL initialize(a1_mp) 966 CALL set_value(a1_mp,a1_real) 967 mpfr_multiplication_int_mp = mpfr_multiplication_mp_mp(a1_mp,a2) 968 CALL mpfr_clear(a1_mp) 969 END FUNCTION mpfr_multiplication_int_mp 970 971 FUNCTION mpfr_multiplication_mp_int(a1,a2) 972 TYPE(mpfr_type) :: mpfr_multiplication_mp_int 973 TYPE(mpfr_type),INTENT(IN) :: a1 974 INTEGER, INTENT(IN) :: a2 975 976 INTEGER :: retval 977 978 mpfr_multiplication_mp_int = mpfr_multiplication_int_mp(a2,a1) 979 END FUNCTION mpfr_multiplication_mp_int 980 981 FUNCTION mpfr_division_mp_mp(a1,a2) 982 TYPE(mpfr_type) :: mpfr_division_mp_mp 983 TYPE(mpfr_type),INTENT(IN) :: a1,a2 984 985 INTEGER :: retval 986 987 CALL initialize(mpfr_division_mp_mp) 988 retval = mpfr_div(mpfr_division_mp_mp,a1,a2,GMP_RNDN) 989 END FUNCTION mpfr_division_mp_mp 990 991 FUNCTION mpfr_division_real_mp(a1,a2) 992 TYPE(mpfr_type) :: mpfr_division_real_mp 993 REAL(dp), INTENT(IN) :: a1 994 TYPE(mpfr_type),INTENT(IN) :: a2 995 996 TYPE(mpfr_type) :: a1_mp 997 998 CALL initialize(a1_mp) 999 CALL set_value(a1_mp,a1) 1000 mpfr_division_real_mp = mpfr_division_mp_mp(a1_mp,a2) 1001 CALL mpfr_clear(a1_mp) 1002 END FUNCTION mpfr_division_real_mp 1003 1004 FUNCTION mpfr_division_mp_real(a1,a2) 1005 TYPE(mpfr_type) :: mpfr_division_mp_real 1006 TYPE(mpfr_type),INTENT(IN) :: a1 1007 REAL(dp), INTENT(IN) :: a2 1008 1009 TYPE(mpfr_type) :: a2_mp 1010 CALL initialize(a2_mp) 1011 CALL set_value(a2_mp,a2) 1012 mpfr_division_mp_real = mpfr_division_mp_mp(a1,a2_mp) 1013 CALL mpfr_clear(a2_mp) 1014 END FUNCTION mpfr_division_mp_real 1015 1016 FUNCTION mpfr_division_int_mp(a1,a2) 1017 TYPE(mpfr_type) :: mpfr_division_int_mp 1018 INTEGER, INTENT(IN) :: a1 1019 TYPE(mpfr_type),INTENT(IN) :: a2 1020 1021 TYPE(mpfr_type) :: a1_mp 1022 REAL(dp) :: a1_real 1023 1024 a1_real = REAL(a1,dp) 1025 CALL initialize(a1_mp) 1026 CALL set_value(a1_mp,a1_real) 1027 mpfr_division_int_mp = mpfr_division_mp_mp(a1_mp,a2) 1028 CALL mpfr_clear(a1_mp) 1029 END FUNCTION mpfr_division_int_mp 1030 1031 FUNCTION mpfr_division_mp_int(a1,a2) 1032 TYPE(mpfr_type) :: mpfr_division_mp_int 1033 TYPE(mpfr_type),INTENT(IN) :: a1 1034 INTEGER, INTENT(IN) :: a2 1035 1036 TYPE(mpfr_type) :: a2_mp 1037 REAL(dp) :: a2_real 1038 1039 a2_real = REAL(a2,dp) 1040 CALL initialize(a2_mp) 1041 CALL set_value(a2_mp,a2_real) 1042 mpfr_division_mp_int = mpfr_division_mp_mp(a1,a2_mp) 1043 CALL mpfr_clear(a2_mp) 1044 END FUNCTION mpfr_division_mp_int 1045 1046 FUNCTION mpfr_power_mp_mp(a1,a2) 1047 TYPE(mpfr_type) :: mpfr_power_mp_mp 1048 TYPE(mpfr_type),INTENT(IN) :: a1,a2 1049 1050 INTEGER :: retval 1051 1052 CALL initialize(mpfr_power_mp_mp) 1053 retval = mpfr_pow(mpfr_power_mp_mp,a1,a2,GMP_RNDN) 1054 END FUNCTION mpfr_power_mp_mp 1055 1056 FUNCTION mpfr_power_real_mp(a1,a2) 1057 TYPE(mpfr_type) :: mpfr_power_real_mp 1058 REAL(dp), INTENT(IN) :: a1 1059 TYPE(mpfr_type),INTENT(IN) :: a2 1060 1061 TYPE(mpfr_type) :: a1_mp 1062 1063 CALL initialize(a1_mp) 1064 CALL set_value(a1_mp,a1) 1065 mpfr_power_real_mp = mpfr_power_mp_mp(a1_mp,a2) 1066 CALL mpfr_clear(a1_mp) 1067 END FUNCTION mpfr_power_real_mp 1068 1069 FUNCTION mpfr_power_mp_real(a1,a2) 1070 TYPE(mpfr_type) :: mpfr_power_mp_real 1071 TYPE(mpfr_type),INTENT(IN) :: a1 1072 REAL(dp), INTENT(IN) :: a2 1073 1074 TYPE(mpfr_type) :: a2_mp 1075 1076 CALL initialize(a2_mp) 1077 CALL set_value(a2_mp,a2) 1078 mpfr_power_mp_real = mpfr_power_mp_mp(a1,a2_mp) 1079 CALL mpfr_clear(a2_mp) 1080 END FUNCTION mpfr_power_mp_real 1081 1082 FUNCTION mpfr_power_mp_int(a1,a2) 1083 TYPE(mpfr_type) :: mpfr_power_mp_int 1084 TYPE(mpfr_type),INTENT(IN) :: a1 1085 INTEGER, INTENT(IN) :: a2 1086 1087 REAL(dp) :: a2_real 1088 TYPE(mpfr_type) :: a2_mp 1089 1090 a2_real = REAL(a2,dp) 1091 CALL initialize(a2_mp) 1092 CALL set_value(a2_mp,a2_real) 1093 mpfr_power_mp_int = mpfr_power_mp_mp(a1,a2_mp) 1094 CALL mpfr_clear(a2_mp) 1095 END FUNCTION mpfr_power_mp_int 1096 1097 FUNCTION mpfr_power_int_mp(a1,a2) 1098 TYPE(mpfr_type) :: mpfr_power_int_mp 1099 INTEGER, INTENT(IN) :: a1 1100 TYPE(mpfr_type),INTENT(IN) :: a2 1101 1102 REAL(dp) :: a1_real 1103 TYPE(mpfr_type) :: a1_mp 1104 1105 a1_real = REAL(a1,dp) 1106 CALL initialize(a1_mp) 1107 CALL set_value(a1_mp,a1_real) 1108 mpfr_power_int_mp = mpfr_power_mp_mp(a1_mp,a2) 1109 CALL mpfr_clear(a1_mp) 1110 END FUNCTION mpfr_power_int_mp 1111 1112 FUNCTION mpfr_lt_mp_mp(a1,a2) 1113 LOGICAL :: mpfr_lt_mp_mp 1114 TYPE(mpfr_type),INTENT(IN) :: a1,a2 1115 1116 INTEGER :: comp 1117 1118 comp = mpfr_cmp(a1,a2) 1119 IF( comp < 0) THEN 1120 mpfr_lt_mp_mp = .TRUE. 1121 ELSE IF(comp>=0) THEN 1122 mpfr_lt_mp_mp = .FALSE. 1123 END IF 1124 END FUNCTION mpfr_lt_mp_mp 1125 1126 FUNCTION mpfr_lt_mp_real(a1,a2) 1127 LOGICAL :: mpfr_lt_mp_real 1128 TYPE(mpfr_type),INTENT(IN) :: a1 1129 REAL(dp), INTENT(IN) :: a2 1130 1131 INTEGER :: comp 1132 TYPE(mpfr_type) :: a2_mp 1133 1134 CALL initialize(a2_mp) 1135 CALL set_value(a2_mp,a2) 1136 comp = mpfr_cmp(a1,a2_mp) 1137 IF( comp < 0) THEN 1138 mpfr_lt_mp_real = .TRUE. 1139 ELSE IF(comp>=0) THEN 1140 mpfr_lt_mp_real = .FALSE. 1141 END IF 1142 CALL mpfr_clear(a2_mp) 1143 END FUNCTION mpfr_lt_mp_real 1144 1145 FUNCTION mpfr_lt_real_mp(a1,a2) 1146 LOGICAL :: mpfr_lt_real_mp 1147 REAL(dp), INTENT(IN) :: a1 1148 TYPE(mpfr_type),INTENT(IN) :: a2 1149 1150 INTEGER :: comp 1151 TYPE(mpfr_type) :: a1_mp 1152 1153 CALL initialize(a1_mp) 1154 CALL set_value(a1_mp,a1) 1155 comp = mpfr_cmp(a1_mp,a2) 1156 IF( comp < 0) THEN 1157 mpfr_lt_real_mp = .TRUE. 1158 ELSE IF(comp>=0) THEN 1159 mpfr_lt_real_mp = .FALSE. 1160 END IF 1161 CALL mpfr_clear(a1_mp) 1162 END FUNCTION mpfr_lt_real_mp 1163 1164 FUNCTION mpfr_lt_mp_int(a1,a2) 1165 LOGICAL :: mpfr_lt_mp_int 1166 TYPE(mpfr_type),INTENT(IN) :: a1 1167 INTEGER, INTENT(IN) :: a2 1168 1169 INTEGER :: comp 1170 TYPE(mpfr_type) :: a2_mp 1171 REAL(dp) :: a2_real 1172 1173 a2_real = REAL(a2,dp) 1174 CALL initialize(a2_mp) 1175 CALL set_value(a2_mp,a2_real) 1176 comp = mpfr_cmp(a1,a2_mp) 1177 IF( comp < 0) THEN 1178 mpfr_lt_mp_int = .TRUE. 1179 ELSE IF(comp>=0) THEN 1180 mpfr_lt_mp_int = .FALSE. 1181 END IF 1182 CALL mpfr_clear(a2_mp) 1183 END FUNCTION mpfr_lt_mp_int 1184 1185 FUNCTION mpfr_lt_int_mp(a1,a2) 1186 LOGICAL :: mpfr_lt_int_mp 1187 INTEGER, INTENT(IN) :: a1 1188 TYPE(mpfr_type),INTENT(IN) :: a2 1189 1190 INTEGER :: comp 1191 TYPE(mpfr_type) :: a1_mp 1192 REAL(dp) :: a1_real 1193 1194 a1_real = REAL(a1,dp) 1195 CALL initialize(a1_mp) 1196 CALL set_value(a1_mp,a1_real) 1197 comp = mpfr_cmp(a1_mp,a2) 1198 IF( comp < 0) THEN 1199 mpfr_lt_int_mp = .TRUE. 1200 ELSE IF(comp>=0) THEN 1201 mpfr_lt_int_mp = .FALSE. 1202 END IF 1203 CALL mpfr_clear(a1_mp) 1204 END FUNCTION mpfr_lt_int_mp 1205 1206 FUNCTION mpfr_gt_mp_mp(a1,a2) 1207 LOGICAL :: mpfr_gt_mp_mp 1208 TYPE(mpfr_type),INTENT(IN) :: a1,a2 1209 1210 INTEGER :: comp 1211 1212 comp = mpfr_cmp(a1,a2) 1213 IF( comp > 0) THEN 1214 mpfr_gt_mp_mp = .TRUE. 1215 ELSE IF(comp<=0) THEN 1216 mpfr_gt_mp_mp = .FALSE. 1217 END IF 1218 END FUNCTION mpfr_gt_mp_mp 1219 1220 FUNCTION mpfr_gt_mp_real(a1,a2) 1221 LOGICAL :: mpfr_gt_mp_real 1222 TYPE(mpfr_type),INTENT(IN) :: a1 1223 REAL(dp), INTENT(IN) :: a2 1224 1225 INTEGER :: comp 1226 TYPE(mpfr_type) :: a2_mp 1227 1228 CALL initialize(a2_mp) 1229 CALL set_value(a2_mp,a2) 1230 comp = mpfr_cmp(a1,a2_mp) 1231 IF( comp > 0) THEN 1232 mpfr_gt_mp_real = .TRUE. 1233 ELSE IF(comp<=0) THEN 1234 mpfr_gt_mp_real = .FALSE. 1235 END IF 1236 CALL mpfr_clear(a2_mp) 1237 END FUNCTION mpfr_gt_mp_real 1238 1239 FUNCTION mpfr_gt_real_mp(a1,a2) 1240 LOGICAL :: mpfr_gt_real_mp 1241 REAL(dp), INTENT(IN) :: a1 1242 TYPE(mpfr_type),INTENT(IN) :: a2 1243 1244 INTEGER :: comp 1245 TYPE(mpfr_type) :: a1_mp 1246 1247 CALL initialize(a1_mp) 1248 CALL set_value(a1_mp,a1) 1249 comp = mpfr_cmp(a1_mp,a2) 1250 IF( comp > 0) THEN 1251 mpfr_gt_real_mp = .TRUE. 1252 ELSE IF(comp<=0) THEN 1253 mpfr_gt_real_mp = .FALSE. 1254 END IF 1255 CALL mpfr_clear(a1_mp) 1256 END FUNCTION mpfr_gt_real_mp 1257 1258 FUNCTION mpfr_gt_mp_int(a1,a2) 1259 LOGICAL :: mpfr_gt_mp_int 1260 TYPE(mpfr_type),INTENT(IN) :: a1 1261 INTEGER, INTENT(IN) :: a2 1262 1263 INTEGER :: comp 1264 TYPE(mpfr_type) :: a2_mp 1265 REAL(dp) :: a2_real 1266 1267 a2_real = REAL(a2,dp) 1268 CALL initialize(a2_mp) 1269 CALL set_value(a2_mp,a2_real) 1270 comp = mpfr_cmp(a1,a2_mp) 1271 IF( comp > 0) THEN 1272 mpfr_gt_mp_int = .TRUE. 1273 ELSE IF(comp<=0) THEN 1274 mpfr_gt_mp_int = .FALSE. 1275 END IF 1276 CALL mpfr_clear(a2_mp) 1277 END FUNCTION mpfr_gt_mp_int 1278 1279 FUNCTION mpfr_gt_int_mp(a1,a2) 1280 LOGICAL :: mpfr_gt_int_mp 1281 INTEGER, INTENT(IN) :: a1 1282 TYPE(mpfr_type),INTENT(IN) :: a2 1283 1284 INTEGER :: comp 1285 TYPE(mpfr_type) :: a1_mp 1286 REAL(dp) :: a1_real 1287 1288 a1_real = REAL(a1,dp) 1289 CALL initialize(a1_mp) 1290 CALL set_value(a1_mp,a1_real) 1291 comp = mpfr_cmp(a1_mp,a2) 1292 IF( comp > 0) THEN 1293 mpfr_gt_int_mp = .TRUE. 1294 ELSE IF(comp<=0) THEN 1295 mpfr_gt_int_mp = .FALSE. 1296 END IF 1297 CALL mpfr_clear(a1_mp) 1298 END FUNCTION mpfr_gt_int_mp 1299 1300 FUNCTION mpfr_lte_mp_mp(a1,a2) 1301 LOGICAL :: mpfr_lte_mp_mp 1302 TYPE(mpfr_type),INTENT(IN) :: a1,a2 1303 1304 INTEGER :: comp 1305 1306 comp = mpfr_cmp(a1,a2) 1307 IF( comp <= 0) THEN 1308 mpfr_lte_mp_mp = .TRUE. 1309 ELSE IF(comp>0) THEN 1310 mpfr_lte_mp_mp = .FALSE. 1311 END IF 1312 END FUNCTION mpfr_lte_mp_mp 1313 1314 FUNCTION mpfr_lte_mp_real(a1,a2) 1315 LOGICAL :: mpfr_lte_mp_real 1316 TYPE(mpfr_type),INTENT(IN) :: a1 1317 REAL(dp), INTENT(IN) :: a2 1318 1319 INTEGER :: comp 1320 TYPE(mpfr_type) :: a2_mp 1321 1322 CALL initialize(a2_mp) 1323 CALL set_value(a2_mp,a2) 1324 comp = mpfr_cmp(a1,a2_mp) 1325 IF( comp <= 0) THEN 1326 mpfr_lte_mp_real = .TRUE. 1327 ELSE IF(comp>0) THEN 1328 mpfr_lte_mp_real = .FALSE. 1329 END IF 1330 CALL mpfr_clear(a2_mp) 1331 END FUNCTION mpfr_lte_mp_real 1332 1333 FUNCTION mpfr_lte_real_mp(a1,a2) 1334 LOGICAL :: mpfr_lte_real_mp 1335 REAL(dp), INTENT(IN) :: a1 1336 TYPE(mpfr_type),INTENT(IN) :: a2 1337 1338 INTEGER :: comp 1339 TYPE(mpfr_type) :: a1_mp 1340 1341 CALL initialize(a1_mp) 1342 CALL set_value(a1_mp,a1) 1343 comp = mpfr_cmp(a1_mp,a2) 1344 IF( comp <= 0) THEN 1345 mpfr_lte_real_mp = .TRUE. 1346 ELSE IF(comp>0) THEN 1347 mpfr_lte_real_mp = .FALSE. 1348 END IF 1349 CALL mpfr_clear(a1_mp) 1350 END FUNCTION mpfr_lte_real_mp 1351 1352 FUNCTION mpfr_lte_mp_int(a1,a2) 1353 LOGICAL :: mpfr_lte_mp_int 1354 TYPE(mpfr_type),INTENT(IN) :: a1 1355 INTEGER, INTENT(IN) :: a2 1356 1357 INTEGER :: comp 1358 TYPE(mpfr_type) :: a2_mp 1359 REAL(dp) :: a2_real 1360 1361 a2_real = REAL(a2,dp) 1362 CALL initialize(a2_mp) 1363 CALL set_value(a2_mp,a2_real) 1364 comp = mpfr_cmp(a1,a2_mp) 1365 IF( comp <= 0) THEN 1366 mpfr_lte_mp_int = .TRUE. 1367 ELSE IF(comp>0) THEN 1368 mpfr_lte_mp_int = .FALSE. 1369 END IF 1370 CALL mpfr_clear(a2_mp) 1371 END FUNCTION mpfr_lte_mp_int 1372 1373 FUNCTION mpfr_lte_int_mp(a1,a2) 1374 LOGICAL :: mpfr_lte_int_mp 1375 INTEGER, INTENT(IN) :: a1 1376 TYPE(mpfr_type),INTENT(IN) :: a2 1377 1378 INTEGER :: comp 1379 TYPE(mpfr_type) :: a1_mp 1380 REAL(dp) :: a1_real 1381 1382 a1_real = REAL(a1,dp) 1383 CALL initialize(a1_mp) 1384 CALL set_value(a1_mp,a1_real) 1385 comp = mpfr_cmp(a1_mp,a2) 1386 IF( comp <= 0) THEN 1387 mpfr_lte_int_mp = .TRUE. 1388 ELSE IF(comp>0) THEN 1389 mpfr_lte_int_mp = .FALSE. 1390 END IF 1391 CALL mpfr_clear(a1_mp) 1392 END FUNCTION mpfr_lte_int_mp 1393 1394 FUNCTION mpfr_gte_mp_mp(a1,a2) 1395 LOGICAL :: mpfr_gte_mp_mp 1396 TYPE(mpfr_type),INTENT(IN) :: a1,a2 1397 1398 INTEGER :: comp 1399 1400 comp = mpfr_cmp(a1,a2) 1401 IF( comp >= 0) THEN 1402 mpfr_gte_mp_mp = .TRUE. 1403 ELSE IF(comp<0) THEN 1404 mpfr_gte_mp_mp = .FALSE. 1405 END IF 1406 END FUNCTION mpfr_gte_mp_mp 1407 1408 FUNCTION mpfr_gte_mp_real(a1,a2) 1409 LOGICAL :: mpfr_gte_mp_real 1410 TYPE(mpfr_type),INTENT(IN) :: a1 1411 REAL(dp), INTENT(IN) :: a2 1412 1413 INTEGER :: comp 1414 TYPE(mpfr_type) :: a2_mp 1415 1416 CALL initialize(a2_mp) 1417 CALL set_value(a2_mp,a2) 1418 comp = mpfr_cmp(a1,a2_mp) 1419 IF( comp >= 0) THEN 1420 mpfr_gte_mp_real = .TRUE. 1421 ELSE IF(comp>0) THEN 1422 mpfr_gte_mp_real = .FALSE. 1423 END IF 1424 CALL mpfr_clear(a2_mp) 1425 END FUNCTION mpfr_gte_mp_real 1426 1427 FUNCTION mpfr_gte_real_mp(a1,a2) 1428 LOGICAL :: mpfr_gte_real_mp 1429 REAL(dp), INTENT(IN) :: a1 1430 TYPE(mpfr_type),INTENT(IN) :: a2 1431 1432 INTEGER :: comp 1433 TYPE(mpfr_type) :: a1_mp 1434 1435 CALL initialize(a1_mp) 1436 CALL set_value(a1_mp,a1) 1437 comp = mpfr_cmp(a1_mp,a2) 1438 IF( comp >= 0) THEN 1439 mpfr_gte_real_mp = .TRUE. 1440 ELSE IF(comp<0) THEN 1441 mpfr_gte_real_mp = .FALSE. 1442 END IF 1443 CALL mpfr_clear(a1_mp) 1444 END FUNCTION mpfr_gte_real_mp 1445 1446 FUNCTION mpfr_gte_mp_int(a1,a2) 1447 LOGICAL :: mpfr_gte_mp_int 1448 TYPE(mpfr_type),INTENT(IN) :: a1 1449 INTEGER, INTENT(IN) :: a2 1450 1451 INTEGER :: comp 1452 TYPE(mpfr_type) :: a2_mp 1453 REAL(dp) :: a2_real 1454 1455 a2_real = REAL(a2,dp) 1456 CALL initialize(a2_mp) 1457 CALL set_value(a2_mp,a2_real) 1458 comp = mpfr_cmp(a1,a2_mp) 1459 IF( comp >= 0) THEN 1460 mpfr_gte_mp_int = .TRUE. 1461 ELSE IF(comp<0) THEN 1462 mpfr_gte_mp_int = .FALSE. 1463 END IF 1464 CALL mpfr_clear(a2_mp) 1465 END FUNCTION mpfr_gte_mp_int 1466 1467 FUNCTION mpfr_gte_int_mp(a1,a2) 1468 LOGICAL :: mpfr_gte_int_mp 1469 INTEGER, INTENT(IN) :: a1 1470 TYPE(mpfr_type),INTENT(IN) :: a2 1471 1472 INTEGER :: comp 1473 TYPE(mpfr_type) :: a1_mp 1474 REAL(dp) :: a1_real 1475 1476 a1_real = REAL(a1,dp) 1477 CALL initialize(a1_mp) 1478 CALL set_value(a1_mp,a1_real) 1479 comp = mpfr_cmp(a1_mp,a2) 1480 IF( comp >= 0) THEN 1481 mpfr_gte_int_mp = .TRUE. 1482 ELSE IF(comp<0) THEN 1483 mpfr_gte_int_mp = .FALSE. 1484 END IF 1485 CALL mpfr_clear(a1_mp) 1486 END FUNCTION mpfr_gte_int_mp 1487 1488 FUNCTION mpfr_eq_mp_mp(a1,a2) 1489 LOGICAL :: mpfr_eq_mp_mp 1490 TYPE(mpfr_type),INTENT(IN) :: a1,a2 1491 1492 INTEGER :: comp 1493 1494 comp = mpfr_cmp(a1,a2) 1495 IF( comp == 0) THEN 1496 mpfr_eq_mp_mp = .TRUE. 1497 ELSE 1498 mpfr_eq_mp_mp = .FALSE. 1499 END IF 1500 END FUNCTION mpfr_eq_mp_mp 1501 1502 FUNCTION mpfr_eq_mp_real(a1,a2) 1503 LOGICAL :: mpfr_eq_mp_real 1504 TYPE(mpfr_type),INTENT(IN) :: a1 1505 REAL(dp), INTENT(IN) :: a2 1506 1507 INTEGER :: comp 1508 TYPE(mpfr_type) :: a2_mp 1509 1510 CALL initialize(a2_mp) 1511 CALL set_value(a2_mp,a2) 1512 comp = mpfr_cmp(a1,a2_mp) 1513 IF( comp == 0) THEN 1514 mpfr_eq_mp_real = .TRUE. 1515 ELSE 1516 mpfr_eq_mp_real = .FALSE. 1517 END IF 1518 CALL mpfr_clear(a2_mp) 1519 END FUNCTION mpfr_eq_mp_real 1520 1521 FUNCTION mpfr_eq_real_mp(a1,a2) 1522 LOGICAL :: mpfr_eq_real_mp 1523 REAL(dp), INTENT(IN) :: a1 1524 TYPE(mpfr_type),INTENT(IN) :: a2 1525 1526 INTEGER :: comp 1527 TYPE(mpfr_type) :: a1_mp 1528 1529 CALL initialize(a1_mp) 1530 CALL set_value(a1_mp,a1) 1531 comp = mpfr_cmp(a1_mp,a2) 1532 IF( comp == 0) THEN 1533 mpfr_eq_real_mp = .TRUE. 1534 ELSE 1535 mpfr_eq_real_mp = .FALSE. 1536 END IF 1537 CALL mpfr_clear(a1_mp) 1538 END FUNCTION mpfr_eq_real_mp 1539 1540 FUNCTION mpfr_eq_mp_int(a1,a2) 1541 LOGICAL :: mpfr_eq_mp_int 1542 TYPE(mpfr_type),INTENT(IN) :: a1 1543 INTEGER, INTENT(IN) :: a2 1544 1545 INTEGER :: comp 1546 TYPE(mpfr_type) :: a2_mp 1547 REAL(dp) :: a2_real 1548 1549 a2_real = REAL(a2,dp) 1550 CALL initialize(a2_mp) 1551 CALL set_value(a2_mp,a2_real) 1552 comp = mpfr_cmp(a1,a2_mp) 1553 IF( comp == 0) THEN 1554 mpfr_eq_mp_int = .TRUE. 1555 ELSE 1556 mpfr_eq_mp_int = .FALSE. 1557 END IF 1558 CALL mpfr_clear(a2_mp) 1559 END FUNCTION mpfr_eq_mp_int 1560 1561 FUNCTION mpfr_eq_int_mp(a1,a2) 1562 LOGICAL :: mpfr_eq_int_mp 1563 INTEGER, INTENT(IN) :: a1 1564 TYPE(mpfr_type),INTENT(IN) :: a2 1565 1566 INTEGER :: comp 1567 TYPE(mpfr_type) :: a1_mp 1568 REAL(dp) :: a1_real 1569 1570 a1_real = REAL(a1,dp) 1571 CALL initialize(a1_mp) 1572 CALL set_value(a1_mp,a1_real) 1573 comp = mpfr_cmp(a1_mp,a2) 1574 IF( comp == 0) THEN 1575 mpfr_eq_int_mp = .TRUE. 1576 ELSE 1577 mpfr_eq_int_mp = .FALSE. 1578 END IF 1579 CALL mpfr_clear(a1_mp) 1580 END FUNCTION mpfr_eq_int_mp 1581 1582 FUNCTION mpfr_neq_mp_mp(a1,a2) 1583 LOGICAL :: mpfr_neq_mp_mp 1584 TYPE(mpfr_type),INTENT(IN) :: a1,a2 1585 1586 INTEGER :: comp 1587 1588 comp = mpfr_cmp(a1,a2) 1589 IF( comp /= 0) THEN 1590 mpfr_neq_mp_mp = .TRUE. 1591 ELSE 1592 mpfr_neq_mp_mp = .FALSE. 1593 END IF 1594 END FUNCTION mpfr_neq_mp_mp 1595 1596 FUNCTION mpfr_neq_mp_real(a1,a2) 1597 LOGICAL :: mpfr_neq_mp_real 1598 TYPE(mpfr_type),INTENT(IN) :: a1 1599 REAL(dp), INTENT(IN) :: a2 1600 1601 INTEGER :: comp 1602 TYPE(mpfr_type) :: a2_mp 1603 1604 CALL initialize(a2_mp) 1605 CALL set_value(a2_mp,a2) 1606 comp = mpfr_cmp(a1,a2_mp) 1607 IF( comp /= 0) THEN 1608 mpfr_neq_mp_real = .TRUE. 1609 ELSE 1610 mpfr_neq_mp_real = .FALSE. 1611 END IF 1612 CALL mpfr_clear(a2_mp) 1613 END FUNCTION mpfr_neq_mp_real 1614 1615 FUNCTION mpfr_neq_real_mp(a1,a2) 1616 LOGICAL :: mpfr_neq_real_mp 1617 REAL(dp), INTENT(IN) :: a1 1618 TYPE(mpfr_type),INTENT(IN) :: a2 1619 1620 INTEGER :: comp 1621 TYPE(mpfr_type) :: a1_mp 1622 1623 CALL initialize(a1_mp) 1624 CALL set_value(a1_mp,a1) 1625 comp = mpfr_cmp(a1_mp,a2) 1626 IF( comp /= 0) THEN 1627 mpfr_neq_real_mp = .TRUE. 1628 ELSE 1629 mpfr_neq_real_mp = .FALSE. 1630 END IF 1631 CALL mpfr_clear(a1_mp) 1632 END FUNCTION mpfr_neq_real_mp 1633 1634 FUNCTION mpfr_neq_mp_int(a1,a2) 1635 LOGICAL :: mpfr_neq_mp_int 1636 TYPE(mpfr_type),INTENT(IN) :: a1 1637 INTEGER, INTENT(IN) :: a2 1638 1639 INTEGER :: comp 1640 TYPE(mpfr_type) :: a2_mp 1641 REAL(dp) :: a2_real 1642 1643 a2_real = REAL(a2,dp) 1644 CALL initialize(a2_mp) 1645 CALL set_value(a2_mp,a2_real) 1646 comp = mpfr_cmp(a1,a2_mp) 1647 IF( comp /= 0) THEN 1648 mpfr_neq_mp_int = .TRUE. 1649 ELSE 1650 mpfr_neq_mp_int = .FALSE. 1651 END IF 1652 CALL mpfr_clear(a2_mp) 1653 END FUNCTION mpfr_neq_mp_int 1654 1655 FUNCTION mpfr_neq_int_mp(a1,a2) 1656 LOGICAL :: mpfr_neq_int_mp 1657 INTEGER, INTENT(IN) :: a1 1658 TYPE(mpfr_type),INTENT(IN) :: a2 1659 1660 INTEGER :: comp 1661 TYPE(mpfr_type) :: a1_mp 1662 REAL(dp) :: a1_real 1663 1664 a1_real = REAL(a1,dp) 1665 CALL initialize(a1_mp) 1666 CALL set_value(a1_mp,a1_real) 1667 comp = mpfr_cmp(a1_mp,a2) 1668 IF( comp /= 0) THEN 1669 mpfr_neq_int_mp = .TRUE. 1670 ELSE 1671 mpfr_neq_int_mp = .FALSE. 1672 END IF 1673 CALL mpfr_clear(a1_mp) 1674 END FUNCTION mpfr_neq_int_mp 1675 1676 FUNCTION log_mp(op) 1677 TYPE(mpfr_type) :: log_mp 1678 TYPE(mpfr_type) :: op 1679 1680 INTEGER :: retval 1681 1682 CALL initialize(log_mp) 1683 retval = mpfr_log(log_mp,op,GMP_RNDN) 1684 END FUNCTION log_mp 1685 1686 FUNCTION log2_mp(op) 1687 TYPE(mpfr_type) :: log2_mp 1688 TYPE(mpfr_type) :: op 1689 1690 INTEGER :: retval 1691 1692 CALL initialize(log2_mp) 1693 retval = mpfr_log2(log2_mp,op,GMP_RNDN) 1694 END FUNCTION log2_mp 1695 1696 FUNCTION log10_mp(op) 1697 TYPE(mpfr_type) :: log10_mp 1698 TYPE(mpfr_type) :: op 1699 1700 INTEGER :: retval 1701 1702 CALL initialize(log10_mp) 1703 retval = mpfr_log10(log10_mp,op,GMP_RNDN) 1704 END FUNCTION log10_mp 1705 1706 FUNCTION exp_mp(op) 1707 TYPE(mpfr_type) :: exp_mp 1708 TYPE(mpfr_type) :: op 1709 1710 INTEGER :: retval 1711 1712 CALL initialize(exp_mp) 1713 retval = mpfr_exp(exp_mp,op,GMP_RNDN) 1714 END FUNCTION exp_mp 1715 1716 FUNCTION exp2_mp(op) 1717 TYPE(mpfr_type) :: exp2_mp 1718 TYPE(mpfr_type) :: op 1719 1720 INTEGER :: retval 1721 1722 CALL initialize(exp2_mp) 1723 retval = mpfr_exp2(exp2_mp,op,GMP_RNDN) 1724 END FUNCTION exp2_mp 1725 1726 FUNCTION exp10_mp(op) 1727 TYPE(mpfr_type) :: exp10_mp 1728 TYPE(mpfr_type) :: op 1729 1730 INTEGER :: retval 1731 1732 CALL initialize(exp10_mp) 1733 retval = mpfr_exp10(exp10_mp,op,GMP_RNDN) 1734 END FUNCTION exp10_mp 1735 1736 FUNCTION sin_mp(op) 1737 TYPE(mpfr_type) :: sin_mp 1738 TYPE(mpfr_type) :: op 1739 1740 INTEGER :: retval 1741 1742 CALL initialize(sin_mp) 1743 retval = mpfr_sin(sin_mp,op,GMP_RNDN) 1744 END FUNCTION sin_mp 1745 1746 FUNCTION cos_mp(op) 1747 TYPE(mpfr_type) :: cos_mp 1748 TYPE(mpfr_type) :: op 1749 1750 INTEGER :: retval 1751 1752 CALL initialize(cos_mp) 1753 retval = mpfr_cos(cos_mp,op,GMP_RNDN) 1754 END FUNCTION cos_mp 1755 1756 FUNCTION tan_mp(op) 1757 TYPE(mpfr_type) :: tan_mp 1758 TYPE(mpfr_type) :: op 1759 1760 INTEGER :: retval 1761 1762 CALL initialize(tan_mp) 1763 retval = mpfr_tan(tan_mp,op,GMP_RNDN) 1764 END FUNCTION tan_mp 1765 1766 FUNCTION sec_mp(op) 1767 TYPE(mpfr_type) :: sec_mp 1768 TYPE(mpfr_type) :: op 1769 1770 INTEGER :: retval 1771 1772 CALL initialize(sec_mp) 1773 retval = mpfr_sec(sec_mp,op,GMP_RNDN) 1774 END FUNCTION sec_mp 1775 1776 FUNCTION csc_mp(op) 1777 TYPE(mpfr_type) :: csc_mp 1778 TYPE(mpfr_type) :: op 1779 1780 INTEGER :: retval 1781 1782 CALL initialize(csc_mp) 1783 retval = mpfr_csc(csc_mp,op,GMP_RNDN) 1784 END FUNCTION csc_mp 1785 1786 FUNCTION cot_mp(op) 1787 TYPE(mpfr_type) :: cot_mp 1788 TYPE(mpfr_type) :: op 1789 1790 INTEGER :: retval 1791 1792 CALL initialize(cot_mp) 1793 retval = mpfr_cot(cot_mp,op,GMP_RNDN) 1794 END FUNCTION cot_mp 1795 1796 FUNCTION acos_mp(op) 1797 TYPE(mpfr_type) :: acos_mp 1798 TYPE(mpfr_type) :: op 1799 1800 INTEGER :: retval 1801 1802 CALL initialize(acos_mp) 1803 retval = mpfr_acos(acos_mp,op,GMP_RNDN) 1804 END FUNCTION acos_mp 1805 1806 FUNCTION asin_mp(op) 1807 TYPE(mpfr_type) :: asin_mp 1808 TYPE(mpfr_type) :: op 1809 1810 INTEGER :: retval 1811 1812 CALL initialize(asin_mp) 1813 retval = mpfr_asin(asin_mp,op,GMP_RNDN) 1814 END FUNCTION asin_mp 1815 1816 FUNCTION atan_mp(op) 1817 TYPE(mpfr_type) :: atan_mp 1818 TYPE(mpfr_type) :: op 1819 1820 INTEGER :: retval 1821 1822 CALL initialize(atan_mp) 1823 retval = mpfr_atan(atan_mp,op,GMP_RNDN) 1824 END FUNCTION atan_mp 1825 1826 FUNCTION atan2_mp(x,y) 1827 TYPE(mpfr_type) :: atan2_mp 1828 TYPE(mpfr_type) :: x,y 1829 1830 INTEGER :: retval 1831 1832 CALL initialize(atan2_mp) 1833 retval = mpfr_atan2(atan2_mp,x,y,GMP_RNDN) 1834 END FUNCTION atan2_mp 1835 1836 FUNCTION cosh_mp(op) 1837 TYPE(mpfr_type) :: cosh_mp 1838 TYPE(mpfr_type) :: op 1839 1840 INTEGER :: retval 1841 1842 CALL initialize(cosh_mp) 1843 retval = mpfr_cosh(cosh_mp,op,GMP_RNDN) 1844 END FUNCTION cosh_mp 1845 1846 FUNCTION sinh_mp(op) 1847 TYPE(mpfr_type) :: sinh_mp 1848 TYPE(mpfr_type) :: op 1849 1850 INTEGER :: retval 1851 1852 CALL initialize(sinh_mp) 1853 retval = mpfr_sinh(sinh_mp,op,GMP_RNDN) 1854 END FUNCTION sinh_mp 1855 1856 FUNCTION tanh_mp(op) 1857 TYPE(mpfr_type) :: tanh_mp 1858 TYPE(mpfr_type) :: op 1859 1860 INTEGER :: retval 1861 1862 CALL initialize(tanh_mp) 1863 retval = mpfr_tanh(tanh_mp,op,GMP_RNDN) 1864 END FUNCTION tanh_mp 1865 1866 FUNCTION sech_mp(op) 1867 TYPE(mpfr_type) :: sech_mp 1868 TYPE(mpfr_type) :: op 1869 1870 INTEGER :: retval 1871 1872 CALL initialize(sech_mp) 1873 retval = mpfr_sech(sech_mp,op,GMP_RNDN) 1874 END FUNCTION sech_mp 1875 1876 FUNCTION csch_mp(op) 1877 TYPE(mpfr_type) :: csch_mp 1878 TYPE(mpfr_type) :: op 1879 1880 INTEGER :: retval 1881 1882 CALL initialize(csch_mp) 1883 retval = mpfr_csch(csch_mp,op,GMP_RNDN) 1884 END FUNCTION csch_mp 1885 1886 FUNCTION coth_mp(op) 1887 TYPE(mpfr_type) :: coth_mp 1888 TYPE(mpfr_type) :: op 1889 1890 INTEGER :: retval 1891 1892 CALL initialize(coth_mp) 1893 retval = mpfr_coth(coth_mp,op,GMP_RNDN) 1894 END FUNCTION coth_mp 1895 1896 FUNCTION acosh_mp(op) 1897 TYPE(mpfr_type) :: acosh_mp 1898 TYPE(mpfr_type) :: op 1899 1900 INTEGER :: retval 1901 1902 CALL initialize(acosh_mp) 1903 retval = mpfr_acosh(acosh_mp,op,GMP_RNDN) 1904 END FUNCTION acosh_mp 1905 1906 FUNCTION asinh_mp(op) 1907 TYPE(mpfr_type) :: asinh_mp 1908 TYPE(mpfr_type) :: op 1909 1910 INTEGER :: retval 1911 1912 CALL initialize(asinh_mp) 1913 retval = mpfr_asinh(asinh_mp,op,GMP_RNDN) 1914 END FUNCTION asinh_mp 1915 1916 FUNCTION atanh_mp(op) 1917 TYPE(mpfr_type) :: atanh_mp 1918 TYPE(mpfr_type) :: op 1919 1920 INTEGER :: retval 1921 1922 CALL initialize(atanh_mp) 1923 retval = mpfr_atanh(atanh_mp,op,GMP_RNDN) 1924 END FUNCTION atanh_mp 1925 1926 FUNCTION ei_mp(op) 1927 TYPE(mpfr_type) :: ei_mp 1928 TYPE(mpfr_type) :: op 1929 1930 INTEGER :: retval 1931 1932 CALL initialize(ei_mp) 1933 retval = mpfr_eint(ei_mp,op,GMP_RNDN) 1934 END FUNCTION ei_mp 1935 1936 FUNCTION gamma_mp(op) 1937 TYPE(mpfr_type) :: gamma_mp 1938 TYPE(mpfr_type) :: op 1939 1940 INTEGER :: retval 1941 1942 CALL initialize(gamma_mp) 1943 retval = mpfr_gamma(gamma_mp,op,GMP_RNDN) 1944 END FUNCTION gamma_mp 1945 1946 FUNCTION lngamma_mp(op) 1947 TYPE(mpfr_type) :: lngamma_mp 1948 TYPE(mpfr_type) :: op 1949 1950 INTEGER :: retval 1951 1952 CALL initialize(lngamma_mp) 1953 retval = mpfr_lngamma(lngamma_mp,op,GMP_RNDN) 1954 END FUNCTION lngamma_mp 1955 1956 FUNCTION erf_mp(op) 1957 TYPE(mpfr_type) :: erf_mp 1958 TYPE(mpfr_type) :: op 1959 1960 INTEGER :: retval 1961 1962 CALL initialize(erf_mp) 1963 retval = mpfr_erf(erf_mp,op,GMP_RNDN) 1964 END FUNCTION erf_mp 1965 1966 FUNCTION erfc_mp(op) 1967 TYPE(mpfr_type) :: erfc_mp 1968 TYPE(mpfr_type) :: op 1969 1970 INTEGER :: retval 1971 1972 CALL initialize(erfc_mp) 1973 retval = mpfr_erfc(erfc_mp,op,GMP_RNDN) 1974 END FUNCTION erfc_mp 1975 1976 FUNCTION bessel_j0_mp(op) 1977 TYPE(mpfr_type) :: bessel_j0_mp 1978 TYPE(mpfr_type) :: op 1979 1980 INTEGER :: retval 1981 1982 CALL initialize(bessel_j0_mp) 1983 retval = mpfr_bessel_j0(bessel_j0_mp,op,GMP_RNDN) 1984 END FUNCTION bessel_j0_mp 1985 1986 FUNCTION bessel_j1_mp(op) 1987 TYPE(mpfr_type) :: bessel_j1_mp 1988 TYPE(mpfr_type) :: op 1989 1990 INTEGER :: retval 1991 1992 CALL initialize(bessel_j1_mp) 1993 retval = mpfr_bessel_j1(bessel_j1_mp,op,GMP_RNDN) 1994 END FUNCTION bessel_j1_mp 1995 1996 FUNCTION bessel_y0_mp(op) 1997 TYPE(mpfr_type) :: bessel_y0_mp 1998 TYPE(mpfr_type) :: op 1999 2000 INTEGER :: retval 2001 2002 CALL initialize(bessel_y0_mp) 2003 retval = mpfr_bessel_y0(bessel_y0_mp,op,GMP_RNDN) 2004 END FUNCTION bessel_y0_mp 2005 2006 FUNCTION bessel_y1_mp(op) 2007 TYPE(mpfr_type) :: bessel_y1_mp 2008 TYPE(mpfr_type) :: op 2009 2010 INTEGER :: retval 2011 2012 CALL initialize(bessel_y1_mp) 2013 retval = mpfr_bessel_y1(bessel_y1_mp,op,GMP_RNDN) 2014 END FUNCTION bessel_y1_mp 2015 2016 FUNCTION get_pi() 2017 TYPE(mpfr_type) :: get_pi 2018 2019 INTEGER :: retval 2020 2021 CALL initialize(get_pi) 2022 retval = mpfr_const_pi(get_pi,GMP_RNDN) 2023 END FUNCTION get_pi 2024 2025 FUNCTION get_e() 2026 TYPE(mpfr_type) :: get_e 2027 2028 INTEGER :: retval 2029 2030 CALL initialize(get_e) 2031 retval = mpfr_const_euler(get_e,GMP_RNDN) 2032 END FUNCTION get_e 2033 2034 FUNCTION get_log2() 2035 TYPE(mpfr_type) :: get_log2 2036 2037 INTEGER :: retval 2038 2039 CALL initialize(get_log2) 2040 retval = mpfr_const_log2(get_log2,GMP_RNDN) 2041 END FUNCTION get_log2 2042 2043 FUNCTION sqrt_mp(op) 2044 TYPE(mpfr_type) :: sqrt_mp 2045 TYPE(mpfr_type) :: op 2046 2047 INTEGER :: retval 2048 2049 CALL initialize(sqrt_mp) 2050 retval = mpfr_sqrt(sqrt_mp,op,GMP_RNDN) 2051 END FUNCTION sqrt_mp 2052 2053END MODULE mpfr_ops 2054