Changeset 1346 for palm/trunk/SOURCE
- Timestamp:
- Mar 27, 2014 1:18:20 PM (11 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 8 edited
-
advec_s_bc.f90 (modified) (34 diffs)
-
data_output_dvrp.f90 (modified) (1 diff)
-
inflow_turbulence.f90 (modified) (1 diff)
-
init_1d_model.f90 (modified) (3 diffs)
-
init_advec.f90 (modified) (2 diffs)
-
lpm_collision_kernels.f90 (modified) (2 diffs)
-
lpm_droplet_condensation.f90 (modified) (2 diffs)
-
microphysics.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_s_bc.f90
r1321 r1346 303 303 DO i = nxl, nxr 304 304 DO k = nzb+1, nzt 305 cip = MAX( 0.0 , ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )306 cim = -MIN( 0.0 , ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )305 cip = MAX( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx ) 306 cim = -MIN( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx ) 307 307 cipf = 1.0 - 2.0 * cip 308 308 cimf = 1.0 - 2.0 * cim … … 313 313 - a1(k,i+1) * f8 * ( 1.0 - cimf*cimf ) & 314 314 + a2(k,i+1) * f24 * ( 1.0 - cimf*cimf*cimf ) 315 ip = MAX( ip, 0.0 )316 im = MAX( im, 0.0 )317 ippb(k,i) = ip * MIN( 1.0 , sk_p(k,j,i) / (ip+im+1E-15) )318 impb(k,i) = im * MIN( 1.0 , sk_p(k,j,i+1) / (ip+im+1E-15) )319 320 cip = MAX( 0.0 , ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )321 cim = -MIN( 0.0 , ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )315 ip = MAX( ip, 0.0_wp ) 316 im = MAX( im, 0.0_wp ) 317 ippb(k,i) = ip * MIN( 1.0_wp, sk_p(k,j,i) / (ip+im+1E-15) ) 318 impb(k,i) = im * MIN( 1.0_wp, sk_p(k,j,i+1) / (ip+im+1E-15) ) 319 320 cip = MAX( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx ) 321 cim = -MIN( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx ) 322 322 cipf = 1.0 - 2.0 * cip 323 323 cimf = 1.0 - 2.0 * cim … … 328 328 - a1(k,i) * f8 * ( 1.0 - cimf*cimf ) & 329 329 + a2(k,i) * f24 * ( 1.0 - cimf*cimf*cimf ) 330 ip = MAX( ip, 0.0 )331 im = MAX( im, 0.0 )332 ipmb(k,i) = ip * MIN( 1.0 , sk_p(k,j,i-1) / (ip+im+1E-15) )333 immb(k,i) = im * MIN( 1.0 , sk_p(k,j,i) / (ip+im+1E-15) )330 ip = MAX( ip, 0.0_wp ) 331 im = MAX( im, 0.0_wp ) 332 ipmb(k,i) = ip * MIN( 1.0_wp, sk_p(k,j,i-1) / (ip+im+1E-15) ) 333 immb(k,i) = im * MIN( 1.0_wp, sk_p(k,j,i) / (ip+im+1E-15) ) 334 334 ENDDO 335 335 ENDDO … … 358 358 DO k = nzb+1, nzt 359 359 m2 = 2.0 * ABS( a1(k,i) - a12(k,i) ) / & 360 MAX( ABS( a1(k,i) + a12(k,i) ), 1E-35 )360 MAX( ABS( a1(k,i) + a12(k,i) ), 1E-35_wp ) 361 361 IF ( ABS( a1(k,i) + a12(k,i) ) < fmax(2) ) m2 = 0.0 362 362 363 363 m3 = 2.0 * ABS( a2(k,i) - a22(k,i) ) / & 364 MAX( ABS( a2(k,i) + a22(k,i) ), 1E-35 )364 MAX( ABS( a2(k,i) + a22(k,i) ), 1E-35_wp ) 365 365 IF ( ABS( a2(k,i) + a22(k,i) ) < fmax(1) ) m3 = 0.0 366 366 … … 389 389 IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9 390 390 sterm = ( sk_p(k,j,i) - sk_p(k,j,i-1) ) / snenn 391 sterm = MIN( sterm, 0.9999 )392 sterm = MAX( sterm, 0.0001 )391 sterm = MIN( sterm, 0.9999_wp ) 392 sterm = MAX( sterm, 0.0001_wp ) 393 393 394 394 ix = INT( sterm * 1000 ) + 1 395 395 396 cip = MAX( 0.0 , ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )396 cip = MAX( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx ) 397 397 398 398 ippe(k,i) = sk_p(k,j,i-1) * cip + snenn * ( & … … 407 407 IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9 408 408 sterm = ( sk_p(k,j,i) - sk_p(k,j,i+1) ) / snenn 409 sterm = MIN( sterm, 0.9999 )410 sterm = MAX( sterm, 0.0001 )409 sterm = MIN( sterm, 0.9999_wp ) 410 sterm = MAX( sterm, 0.0001_wp ) 411 411 412 412 ix = INT( sterm * 1000 ) + 1 413 413 414 cim = -MIN( 0.0 , ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )414 cim = -MIN( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx ) 415 415 416 416 imme(k,i) = sk_p(k,j,i+1) * cim + snenn * ( & … … 428 428 IF ( ABS( snenn ) .LT. 1E-9 ) snenn = 1E-9 429 429 sterm = ( sk_p(k,j,i+1) - sk_p(k,j,i+2) ) / snenn 430 sterm = MIN( sterm, 0.9999 )431 sterm = MAX( sterm, 0.0001 )430 sterm = MIN( sterm, 0.9999_wp ) 431 sterm = MAX( sterm, 0.0001_wp ) 432 432 433 433 ix = INT( sterm * 1000 ) + 1 434 434 435 cim = -MIN( 0.0 , ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )435 cim = -MIN( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx ) 436 436 437 437 impe(k,i) = sk_p(k,j,i+2) * cim + snenn * ( & … … 440 440 ) & 441 441 ) 442 IF ( sterm == 0.0001 ) impe(k,i) = sk_p(k,j,i+1) * cim443 IF ( sterm == 0.9999 ) impe(k,i) = sk_p(k,j,i+1) * cim442 IF ( sterm == 0.0001_wp ) impe(k,i) = sk_p(k,j,i+1) * cim 443 IF ( sterm == 0.9999_wp ) impe(k,i) = sk_p(k,j,i+1) * cim 444 444 ENDIF 445 445 … … 449 449 IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9 450 450 sterm = ( sk_p(k,j,i-1) - sk_p(k,j,i-2) ) / snenn 451 sterm = MIN( sterm, 0.9999 )452 sterm = MAX( sterm, 0.0001 )451 sterm = MIN( sterm, 0.9999_wp ) 452 sterm = MAX( sterm, 0.0001_wp ) 453 453 454 454 ix = INT( sterm * 1000 ) + 1 455 455 456 cip = MAX( 0.0 , ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )456 cip = MAX( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx ) 457 457 458 458 ipme(k,i) = sk_p(k,j,i-2) * cip + snenn * ( & 459 459 aex(ix) * cip + bex(ix) / dex(ix) * ( & 460 eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cip ) ) &460 eex(ix) - EXP( dex(ix)*0.5 * ( 1.0_wp - 2.0 * cip ) ) & 461 461 ) & 462 462 ) 463 IF ( sterm == 0.0001 ) ipme(k,i) = sk_p(k,j,i-1) * cip464 IF ( sterm == 0.9999 ) ipme(k,i) = sk_p(k,j,i-1) * cip463 IF ( sterm == 0.0001_wp ) ipme(k,i) = sk_p(k,j,i-1) * cip 464 IF ( sterm == 0.9999_wp ) ipme(k,i) = sk_p(k,j,i-1) * cip 465 465 ENDIF 466 466 … … 473 473 DO i = nxl, nxr 474 474 DO k = nzb+1, nzt 475 fplus = ( 1.0 - sw(k,i) ) * ippb(k,i) + sw(k,i) * ippe(k,i) &476 - ( 1.0 - sw(k,i+1) ) * impb(k,i) - sw(k,i+1) * impe(k,i)477 fminus = ( 1.0 - sw(k,i-1) ) * ipmb(k,i) + sw(k,i-1) * ipme(k,i) &478 - ( 1.0 - sw(k,i) ) * immb(k,i) - sw(k,i) * imme(k,i)475 fplus = ( 1.0_wp - sw(k,i) ) * ippb(k,i) + sw(k,i) * ippe(k,i) & 476 - ( 1.0_wp - sw(k,i+1) ) * impb(k,i) - sw(k,i+1) * impe(k,i) 477 fminus = ( 1.0_wp - sw(k,i-1) ) * ipmb(k,i) + sw(k,i-1) * ipme(k,i) & 478 - ( 1.0_wp - sw(k,i) ) * immb(k,i) - sw(k,i) * imme(k,i) 479 479 tendcy = fplus - fminus 480 480 ! 481 481 !-- Removed in order to optimize speed 482 ! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )483 ! IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 ) tendcy = 0.0482 ! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp ) 483 ! IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp ) tendcy = 0.0 484 484 ! 485 485 !-- Density correction because of possible remaining divergences 486 486 d_new = d(k,j,i) - ( u(k,j,i+1) - u(k,j,i) ) * dt_3d * ddx 487 sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) / &488 ( 1.0 + d_new )487 sk_p(k,j,i) = ( ( 1.0_wp + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) / & 488 ( 1.0_wp + d_new ) 489 489 d(k,j,i) = d_new 490 490 ENDDO … … 595 595 DO j = nys, nyn 596 596 DO k = nzb+1, nzt 597 cip = MAX( 0.0 , ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )598 cim = -MIN( 0.0 , ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )597 cip = MAX( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy ) 598 cim = -MIN( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy ) 599 599 cipf = 1.0 - 2.0 * cip 600 600 cimf = 1.0 - 2.0 * cim … … 605 605 - a1(k,j+1) * f8 * ( 1.0 - cimf*cimf ) & 606 606 + a2(k,j+1) * f24 * ( 1.0 - cimf*cimf*cimf ) 607 ip = MAX( ip, 0.0 )608 im = MAX( im, 0.0 )609 ippb(k,j) = ip * MIN( 1.0 , sk_p(k,j,i) / (ip+im+1E-15) )610 impb(k,j) = im * MIN( 1.0 , sk_p(k,j+1,i) / (ip+im+1E-15) )611 612 cip = MAX( 0.0 , ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )613 cim = -MIN( 0.0 , ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )607 ip = MAX( ip, 0.0_wp ) 608 im = MAX( im, 0.0_wp ) 609 ippb(k,j) = ip * MIN( 1.0_wp, sk_p(k,j,i) / (ip+im+1E-15) ) 610 impb(k,j) = im * MIN( 1.0_wp, sk_p(k,j+1,i) / (ip+im+1E-15) ) 611 612 cip = MAX( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy ) 613 cim = -MIN( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy ) 614 614 cipf = 1.0 - 2.0 * cip 615 615 cimf = 1.0 - 2.0 * cim … … 620 620 - a1(k,j) * f8 * ( 1.0 - cimf*cimf ) & 621 621 + a2(k,j) * f24 * ( 1.0 - cimf*cimf*cimf ) 622 ip = MAX( ip, 0.0 )623 im = MAX( im, 0.0 )624 ipmb(k,j) = ip * MIN( 1.0 , sk_p(k,j-1,i) / (ip+im+1E-15) )625 immb(k,j) = im * MIN( 1.0 , sk_p(k,j,i) / (ip+im+1E-15) )622 ip = MAX( ip, 0.0_wp ) 623 im = MAX( im, 0.0_wp ) 624 ipmb(k,j) = ip * MIN( 1.0_wp, sk_p(k,j-1,i) / (ip+im+1E-15) ) 625 immb(k,j) = im * MIN( 1.0_wp, sk_p(k,j,i) / (ip+im+1E-15) ) 626 626 ENDDO 627 627 ENDDO … … 650 650 DO k = nzb+1, nzt 651 651 m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) / & 652 MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 )652 MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35_wp ) 653 653 IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) ) m2 = 0.0 654 654 655 655 m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / & 656 MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 )656 MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35_wp ) 657 657 IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) ) m3 = 0.0 658 658 … … 681 681 IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9 682 682 sterm = ( sk_p(k,j,i) - sk_p(k,j-1,i) ) / snenn 683 sterm = MIN( sterm, 0.9999 )684 sterm = MAX( sterm, 0.0001 )683 sterm = MIN( sterm, 0.9999_wp ) 684 sterm = MAX( sterm, 0.0001_wp ) 685 685 686 686 ix = INT( sterm * 1000 ) + 1 687 687 688 cip = MAX( 0.0 , ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )688 cip = MAX( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy ) 689 689 690 690 ippe(k,j) = sk_p(k,j-1,i) * cip + snenn * ( & … … 693 693 ) & 694 694 ) 695 IF ( sterm == 0.0001 ) ippe(k,j) = sk_p(k,j,i) * cip696 IF ( sterm == 0.9999 ) ippe(k,j) = sk_p(k,j,i) * cip695 IF ( sterm == 0.0001_wp ) ippe(k,j) = sk_p(k,j,i) * cip 696 IF ( sterm == 0.9999_wp ) ippe(k,j) = sk_p(k,j,i) * cip 697 697 698 698 snenn = sk_p(k,j-1,i) - sk_p(k,j+1,i) 699 IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9699 IF ( ABS( snenn ) < 1E-9_wp ) snenn = 1E-9 700 700 sterm = ( sk_p(k,j,i) - sk_p(k,j+1,i) ) / snenn 701 sterm = MIN( sterm, 0.9999 )702 sterm = MAX( sterm, 0.0001 )701 sterm = MIN( sterm, 0.9999_wp ) 702 sterm = MAX( sterm, 0.0001_wp ) 703 703 704 704 ix = INT( sterm * 1000 ) + 1 705 705 706 cim = -MIN( 0.0 , ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )706 cim = -MIN( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy ) 707 707 708 708 imme(k,j) = sk_p(k,j+1,i) * cim + snenn * ( & … … 711 711 ) & 712 712 ) 713 IF ( sterm == 0.0001 ) imme(k,j) = sk_p(k,j,i) * cim714 IF ( sterm == 0.9999 ) imme(k,j) = sk_p(k,j,i) * cim713 IF ( sterm == 0.0001_wp ) imme(k,j) = sk_p(k,j,i) * cim 714 IF ( sterm == 0.9999_wp ) imme(k,j) = sk_p(k,j,i) * cim 715 715 ENDIF 716 716 … … 720 720 IF ( ABS( snenn ) .LT. 1E-9 ) snenn = 1E-9 721 721 sterm = ( sk_p(k,j+1,i) - sk_p(k,j+2,i) ) / snenn 722 sterm = MIN( sterm, 0.9999 )723 sterm = MAX( sterm, 0.0001 )722 sterm = MIN( sterm, 0.9999_wp ) 723 sterm = MAX( sterm, 0.0001_wp ) 724 724 725 725 ix = INT( sterm * 1000 ) + 1 726 726 727 cim = -MIN( 0.0 , ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )727 cim = -MIN( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy ) 728 728 729 729 impe(k,j) = sk_p(k,j+2,i) * cim + snenn * ( & … … 732 732 ) & 733 733 ) 734 IF ( sterm == 0.0001 ) impe(k,j) = sk_p(k,j+1,i) * cim735 IF ( sterm == 0.9999 ) impe(k,j) = sk_p(k,j+1,i) * cim734 IF ( sterm == 0.0001_wp ) impe(k,j) = sk_p(k,j+1,i) * cim 735 IF ( sterm == 0.9999_wp ) impe(k,j) = sk_p(k,j+1,i) * cim 736 736 ENDIF 737 737 … … 739 739 IF ( sw(k,j-1) == 1.0 ) THEN 740 740 snenn = sk_p(k,j,i) - sk_p(k,j-2,i) 741 IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9741 IF ( ABS( snenn ) < 1E-9_wp ) snenn = 1E-9 742 742 sterm = ( sk_p(k,j-1,i) - sk_p(k,j-2,i) ) / snenn 743 sterm = MIN( sterm, 0.9999 )744 sterm = MAX( sterm, 0.0001 )743 sterm = MIN( sterm, 0.9999_wp ) 744 sterm = MAX( sterm, 0.0001_wp ) 745 745 746 746 ix = INT( sterm * 1000 ) + 1 747 747 748 cip = MAX( 0.0 , ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )748 cip = MAX( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy ) 749 749 750 750 ipme(k,j) = sk_p(k,j-2,i) * cip + snenn * ( & … … 753 753 ) & 754 754 ) 755 IF ( sterm == 0.0001 ) ipme(k,j) = sk_p(k,j-1,i) * cip756 IF ( sterm == 0.9999 ) ipme(k,j) = sk_p(k,j-1,i) * cip755 IF ( sterm == 0.0001_wp ) ipme(k,j) = sk_p(k,j-1,i) * cip 756 IF ( sterm == 0.9999_wp ) ipme(k,j) = sk_p(k,j-1,i) * cip 757 757 ENDIF 758 758 … … 772 772 ! 773 773 !-- Removed in order to optimise speed 774 ! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )775 ! IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 ) tendcy = 0.0774 ! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp ) 775 ! IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp ) tendcy = 0.0 776 776 ! 777 777 !-- Density correction because of possible remaining divergences … … 996 996 DO j = nys, nyn 997 997 DO k = nzb+1, nzt 998 cip = MAX( 0.0 , w(k,j,i) * dt_3d * ddzw(k) )999 cim = -MIN( 0.0 , w(k,j,i) * dt_3d * ddzw(k) )998 cip = MAX( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) ) 999 cim = -MIN( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) ) 1000 1000 cipf = 1.0 - 2.0 * cip 1001 1001 cimf = 1.0 - 2.0 * cim … … 1006 1006 - a1(k+1,j) * f8 * ( 1.0 - cimf*cimf ) & 1007 1007 + a2(k+1,j) * f24 * ( 1.0 - cimf*cimf*cimf ) 1008 ip = MAX( ip, 0.0 )1009 im = MAX( im, 0.0 )1010 ippb(k,j) = ip * MIN( 1.0 , sk_p(k,j,i) / (ip+im+1E-15) )1011 impb(k,j) = im * MIN( 1.0 , sk_p(k+1,j,i) / (ip+im+1E-15) )1012 1013 cip = MAX( 0.0 , w(k-1,j,i) * dt_3d * ddzw(k) )1014 cim = -MIN( 0.0 , w(k-1,j,i) * dt_3d * ddzw(k) )1008 ip = MAX( ip, 0.0_wp ) 1009 im = MAX( im, 0.0_wp ) 1010 ippb(k,j) = ip * MIN( 1.0_wp, sk_p(k,j,i) / (ip+im+1E-15) ) 1011 impb(k,j) = im * MIN( 1.0_wp, sk_p(k+1,j,i) / (ip+im+1E-15) ) 1012 1013 cip = MAX( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) ) 1014 cim = -MIN( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) ) 1015 1015 cipf = 1.0 - 2.0 * cip 1016 1016 cimf = 1.0 - 2.0 * cim … … 1021 1021 - a1(k,j) * f8 * ( 1.0 - cimf*cimf ) & 1022 1022 + a2(k,j) * f24 * ( 1.0 - cimf*cimf*cimf ) 1023 ip = MAX( ip, 0.0 )1024 im = MAX( im, 0.0 )1025 ipmb(k,j) = ip * MIN( 1.0 , sk_p(k-1,j,i) / (ip+im+1E-15) )1026 immb(k,j) = im * MIN( 1.0 , sk_p(k,j,i) / (ip+im+1E-15) )1023 ip = MAX( ip, 0.0_wp ) 1024 im = MAX( im, 0.0_wp ) 1025 ipmb(k,j) = ip * MIN( 1.0_wp, sk_p(k-1,j,i) / (ip+im+1E-15) ) 1026 immb(k,j) = im * MIN( 1.0_wp, sk_p(k,j,i) / (ip+im+1E-15) ) 1027 1027 ENDDO 1028 1028 ENDDO … … 1051 1051 DO k = nzb, nzt+1 1052 1052 m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) / & 1053 MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 )1053 MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35_wp ) 1054 1054 IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) ) m2 = 0.0 1055 1055 1056 1056 m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / & 1057 MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 )1057 MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35_wp ) 1058 1058 IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) ) m3 = 0.0 1059 1059 … … 1080 1080 IF ( sw(k,j) == 1.0 ) THEN 1081 1081 snenn = sk_p(k+1,j,i) - sk_p(k-1,j,i) 1082 IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-91082 IF ( ABS( snenn ) < 1E-9_wp ) snenn = 1E-9 1083 1083 sterm = ( sk_p(k,j,i) - sk_p(k-1,j,i) ) / snenn 1084 sterm = MIN( sterm, 0.9999 )1085 sterm = MAX( sterm, 0.0001 )1084 sterm = MIN( sterm, 0.9999_wp ) 1085 sterm = MAX( sterm, 0.0001_wp ) 1086 1086 1087 1087 ix = INT( sterm * 1000 ) + 1 1088 1088 1089 cip = MAX( 0.0 , w(k,j,i) * dt_3d * ddzw(k) )1089 cip = MAX( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) ) 1090 1090 1091 1091 ippe(k,j) = sk_p(k-1,j,i) * cip + snenn * ( & … … 1100 1100 IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9 1101 1101 sterm = ( sk_p(k,j,i) - sk_p(k+1,j,i) ) / snenn 1102 sterm = MIN( sterm, 0.9999 )1103 sterm = MAX( sterm, 0.0001 )1102 sterm = MIN( sterm, 0.9999_wp ) 1103 sterm = MAX( sterm, 0.0001_wp ) 1104 1104 1105 1105 ix = INT( sterm * 1000 ) + 1 1106 1106 1107 cim = -MIN( 0.0 , w(k-1,j,i) * dt_3d * ddzw(k) )1107 cim = -MIN( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) ) 1108 1108 1109 1109 imme(k,j) = sk_p(k+1,j,i) * cim + snenn * ( & … … 1112 1112 ) & 1113 1113 ) 1114 IF ( sterm == 0.0001 ) imme(k,j) = sk_p(k,j,i) * cim1115 IF ( sterm == 0.9999 ) imme(k,j) = sk_p(k,j,i) * cim1114 IF ( sterm == 0.0001_wp ) imme(k,j) = sk_p(k,j,i) * cim 1115 IF ( sterm == 0.9999_wp ) imme(k,j) = sk_p(k,j,i) * cim 1116 1116 ENDIF 1117 1117 … … 1121 1121 IF ( ABS( snenn ) .LT. 1E-9 ) snenn = 1E-9 1122 1122 sterm = ( sk_p(k+1,j,i) - sk_p(k+2,j,i) ) / snenn 1123 sterm = MIN( sterm, 0.9999 )1124 sterm = MAX( sterm, 0.0001 )1123 sterm = MIN( sterm, 0.9999_wp ) 1124 sterm = MAX( sterm, 0.0001_wp ) 1125 1125 1126 1126 ix = INT( sterm * 1000 ) + 1 1127 1127 1128 cim = -MIN( 0.0 , w(k,j,i) * dt_3d * ddzw(k) )1128 cim = -MIN( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) ) 1129 1129 1130 1130 impe(k,j) = sk_p(k+2,j,i) * cim + snenn * ( & … … 1133 1133 ) & 1134 1134 ) 1135 IF ( sterm == 0.0001 ) impe(k,j) = sk_p(k+1,j,i) * cim1136 IF ( sterm == 0.9999 ) impe(k,j) = sk_p(k+1,j,i) * cim1135 IF ( sterm == 0.0001_wp ) impe(k,j) = sk_p(k+1,j,i) * cim 1136 IF ( sterm == 0.9999_wp ) impe(k,j) = sk_p(k+1,j,i) * cim 1137 1137 ENDIF 1138 1138 … … 1140 1140 IF ( sw(k-1,j) == 1.0 ) THEN 1141 1141 snenn = sk_p(k,j,i) - sk_p(k-2,j,i) 1142 IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-91142 IF ( ABS( snenn ) < 1E-9_wp ) snenn = 1E-9 1143 1143 sterm = ( sk_p(k-1,j,i) - sk_p(k-2,j,i) ) / snenn 1144 sterm = MIN( sterm, 0.9999 )1145 sterm = MAX( sterm, 0.0001 )1144 sterm = MIN( sterm, 0.9999_wp ) 1145 sterm = MAX( sterm, 0.0001_wp ) 1146 1146 1147 1147 ix = INT( sterm * 1000 ) + 1 1148 1148 1149 cip = MAX( 0.0 , w(k-1,j,i) * dt_3d * ddzw(k) )1149 cip = MAX( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) ) 1150 1150 1151 1151 ipme(k,j) = sk_p(k-2,j,i) * cip + snenn * ( & … … 1154 1154 ) & 1155 1155 ) 1156 IF ( sterm == 0.0001 ) ipme(k,j) = sk_p(k-1,j,i) * cip1157 IF ( sterm == 0.9999 ) ipme(k,j) = sk_p(k-1,j,i) * cip1156 IF ( sterm == 0.0001_wp ) ipme(k,j) = sk_p(k-1,j,i) * cip 1157 IF ( sterm == 0.9999_wp ) ipme(k,j) = sk_p(k-1,j,i) * cip 1158 1158 ENDIF 1159 1159 … … 1173 1173 ! 1174 1174 !-- Removed in order to optimise speed 1175 ! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )1176 ! IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 ) tendcy = 0.01175 ! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp ) 1176 ! IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp ) tendcy = 0.0 1177 1177 ! 1178 1178 !-- Density correction because of possible remaining divergences -
palm/trunk/SOURCE/data_output_dvrp.f90
r1321 r1346 71 71 slicer_range_limits_dvrp(1,islice_dvrp) ) 72 72 73 scale = MODULO( 180.0 + 180.0 * scale, 360.0 )73 scale = MODULO( 180.0 + 180.0 * scale, 360.0_wp ) 74 74 75 75 color = (/ scale, 0.5_wp, 1.0_wp, 0.0_wp /) -
palm/trunk/SOURCE/inflow_turbulence.f90
r1321 r1346 214 214 e(k,j,-nbgp:-1) = mean_inflow_profiles(k,5) + & 215 215 inflow_dist(k,j,5,1:nbgp) * inflow_damping_factor(k) 216 e(k,j,-nbgp:-1) = MAX( e(k,j,-nbgp:-1), 0.0 )216 e(k,j,-nbgp:-1) = MAX( e(k,j,-nbgp:-1), 0.0_wp ) 217 217 218 218 ENDDO -
palm/trunk/SOURCE/init_1d_model.f90
r1323 r1346 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Bugfix: REAL constants provided with KIND-attribute especially in call of 23 ! intrinsic function like MAX, MIN, SIGN 23 24 ! 24 25 ! Former revisions: … … 675 676 DO k = damp_level_ind_1d+1, nzt+1 676 677 km1d(k) = 1.1 * km1d(k-1) 677 km1d(k) = MIN( km1d(k), 10.0 )678 km1d(k) = MIN( km1d(k), 10.0_wp ) 678 679 ENDDO 679 680 … … 784 785 uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 ) 785 786 IF ( ABS( v1d(nzb+1) ) .LT. 1.0E-5 ) THEN 786 alpha = ACOS( SIGN( 1.0 , u1d(nzb+1) ) )787 alpha = ACOS( SIGN( 1.0_wp , u1d(nzb+1) ) ) 787 788 ELSE 788 789 alpha = ACOS( u1d(nzb+1) / uv_total ) -
palm/trunk/SOURCE/init_advec.f90
r1323 r1346 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Bugfix: REAL constants provided with KIND-attribute especially in call of 23 ! intrinsic function like MAX, MIN, SIGN 23 24 ! 24 25 ! Former revisions: … … 111 112 ENDDO 112 113 113 IF ( sterm < 0.5 ) dn = MAX( 2.95E-2 , dn )114 IF ( sterm > 0.5 ) dn = MIN( -2.95E-2 , dn )114 IF ( sterm < 0.5 ) dn = MAX( 2.95E-2_wp, dn ) 115 IF ( sterm > 0.5 ) dn = MIN( -2.95E-2_wp, dn ) 115 116 ex1 = EXP( -dn ) 116 117 ex2 = EXP( dn ) - ex1 -
palm/trunk/SOURCE/lpm_collision_kernels.f90
r1323 r1346 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Bugfix: REAL constants provided with KIND-attribute especially in call of 23 ! intrinsic function like MAX, MIN, SIGN 23 24 ! 24 25 ! Former revisions: … … 840 841 qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) ) 841 842 ek = ( 1.0 - qq ) * ecoll(15,iq-1) + qq * ecoll(15,iq) 842 ec(j,i) = MIN( ek, 1.0 )843 ec(j,i) = MIN( ek, 1.0_wp ) 843 844 ENDIF 844 845 -
palm/trunk/SOURCE/lpm_droplet_condensation.f90
r1323 r1346 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Bugfix: REAL constants provided with KIND-attribute especially in call of 23 ! intrinsic function like MAX, MIN, SIGN 23 24 ! 24 25 ! Former revisions: … … 447 448 !-- Radius should not fall below 1E-8 because Rosenbrock method may 448 449 !-- lead to errors otherwise 449 new_r = MAX( new_r, 1.0E-8 )450 new_r = MAX( new_r, 1.0E-8_wp ) 450 451 ! 451 452 !-- Check if calculated droplet radius change is reasonable since in -
palm/trunk/SOURCE/microphysics.f90
r1335 r1346 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Bugfix: REAL constants provided with KIND-attribute especially in call of 23 ! intrinsic function like MAX, MIN, SIGN 23 24 ! 24 25 ! Former revisions: … … 988 989 d_max = MAX( qr_1d(k+1), qr_1d(k), qr_1d(k-1) ) - qr_1d(k) 989 990 990 qr_slope(k) = SIGN(1.0 , d_mean) * MIN ( 2.0 * d_min, 2.0 * d_max, &991 qr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0 * d_min, 2.0 * d_max, & 991 992 ABS( d_mean ) ) 992 993 … … 995 996 d_max = MAX( nr_1d(k+1), nr_1d(k), nr_1d(k-1) ) - nr_1d(k) 996 997 997 nr_slope(k) = SIGN(1.0 , d_mean) * MIN ( 2.0 * d_min, 2.0 * d_max, &998 nr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0 * d_min, 2.0 * d_max, & 998 999 ABS( d_mean ) ) 999 1000 ENDDO … … 1017 1018 z_run = 0.0 ! height above z(k) 1018 1019 k_run = k 1019 c_run = MIN( 1.0 , c_nr(k) )1020 c_run = MIN( 1.0_wp, c_nr(k) ) 1020 1021 DO WHILE ( c_run > 0.0 .AND. k_run <= nzt ) 1021 1022 flux = flux + hyrho(k_run) * & … … 1024 1025 z_run = z_run + dzu(k_run) 1025 1026 k_run = k_run + 1 1026 c_run = MIN( 1.0 , c_nr(k_run) - z_run * ddzu(k_run) )1027 c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) ) 1027 1028 ENDDO 1028 1029 ! … … 1041 1042 z_run = 0.0 ! height above z(k) 1042 1043 k_run = k 1043 c_run = MIN( 1.0 , c_qr(k) )1044 c_run = MIN( 1.0_wp, c_qr(k) ) 1044 1045 1045 1046 DO WHILE ( c_run > 0.0 .AND. k_run <= nzt-1 ) … … 1050 1051 z_run = z_run + dzu(k_run) 1051 1052 k_run = k_run + 1 1052 c_run = MIN( 1.0 , c_qr(k_run) - z_run * ddzu(k_run) )1053 c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) ) 1053 1054 1054 1055 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
