Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
Mar 27, 2014 1:18:20 PM (11 years ago)
Author:
heinze
Message:

Bugfix: REAL constants provided with KIND-attribute especially in call of intrinsic function like MAX, MIN, SIGN

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/advec_s_bc.f90

    r1321 r1346  
    303303       DO  i = nxl, nxr
    304304          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 )
    307307             cipf = 1.0 - 2.0 * cip
    308308             cimf = 1.0 - 2.0 * cim
    … …  
    313313                    - a1(k,i+1) * f8  * ( 1.0 - cimf*cimf )                    &
    314314                    + 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 )
    322322             cipf = 1.0 - 2.0 * cip
    323323             cimf = 1.0 - 2.0 * cim
    … …  
    328328                    - a1(k,i)   * f8  * ( 1.0 - cimf*cimf )                    &
    329329                    + 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) )
    334334          ENDDO
    335335       ENDDO
    … …  
    358358          DO  k = nzb+1, nzt
    359359             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 )
    361361             IF ( ABS( a1(k,i) + a12(k,i) ) < fmax(2) )  m2 = 0.0
    362362
    363363             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 )
    365365             IF ( ABS( a2(k,i) + a22(k,i) ) < fmax(1) )  m3 = 0.0
    366366
    … …  
    389389                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
    390390                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 )
    393393
    394394                ix = INT( sterm * 1000 ) + 1
    395395
    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 )
    397397
    398398                ippe(k,i) = sk_p(k,j,i-1) * cip + snenn * (                    &
    … …  
    407407                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
    408408                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 )
    411411
    412412                ix = INT( sterm * 1000 ) + 1
    413413
    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 )
    415415
    416416                imme(k,i) = sk_p(k,j,i+1) * cim + snenn * (                    &
    … …  
    428428                IF ( ABS( snenn ) .LT. 1E-9 )  snenn = 1E-9
    429429                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 )
    432432
    433433                ix = INT( sterm * 1000 ) + 1
    434434
    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 )
    436436
    437437                impe(k,i) = sk_p(k,j,i+2) * cim + snenn * (                    &
    … …  
    440440                                                                )              &
    441441                                                          )
    442                 IF ( sterm == 0.0001 )  impe(k,i) = sk_p(k,j,i+1) * cim
    443                 IF ( sterm == 0.9999 )  impe(k,i) = sk_p(k,j,i+1) * cim
     442                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
    444444             ENDIF
    445445
    … …  
    449449                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
    450450                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 )
    453453
    454454                ix = INT( sterm * 1000 ) + 1
    455455
    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 )
    457457
    458458                ipme(k,i) = sk_p(k,j,i-2) * cip + snenn * (                    &
    459459                            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 ) ) &
    461461                                                                )              &
    462462                                                          )
    463                 IF ( sterm == 0.0001 )  ipme(k,i) = sk_p(k,j,i-1) * cip
    464                 IF ( sterm == 0.9999 )  ipme(k,i) = sk_p(k,j,i-1) * cip
     463                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
    465465             ENDIF
    466466
    … …  
    473473       DO  i = nxl, nxr
    474474          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)
    479479             tendcy = fplus - fminus
    480480!
    481481!--           Removed in order to optimize speed
    482 !             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
    483 !             IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 )  tendcy = 0.0
     482!             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp )
     483!             IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp )  tendcy = 0.0
    484484!
    485485!--          Density correction because of possible remaining divergences
    486486             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 )
    489489             d(k,j,i)  = d_new
    490490          ENDDO
    … …  
    595595       DO  j = nys, nyn
    596596          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 )
    599599             cipf = 1.0 - 2.0 * cip
    600600             cimf = 1.0 - 2.0 * cim
    … …  
    605605                    - a1(k,j+1) * f8  * ( 1.0 - cimf*cimf )                    &
    606606                    + 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 )
    614614             cipf = 1.0 - 2.0 * cip
    615615             cimf = 1.0 - 2.0 * cim
    … …  
    620620                    - a1(k,j)   * f8  * ( 1.0 - cimf*cimf )                    &
    621621                    + 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) )
    626626          ENDDO
    627627       ENDDO
    … …  
    650650          DO  k = nzb+1, nzt
    651651             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 )
    653653             IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0
    654654
    655655             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 )
    657657             IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0
    658658
    … …  
    681681                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
    682682                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 )
    685685
    686686                ix = INT( sterm * 1000 ) + 1
    687687
    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 )
    689689
    690690                ippe(k,j) = sk_p(k,j-1,i) * cip + snenn * (                    &
    … …  
    693693                                                                )              &
    694694                                                          )
    695                 IF ( sterm == 0.0001 )  ippe(k,j) = sk_p(k,j,i) * cip
    696                 IF ( sterm == 0.9999 )  ippe(k,j) = sk_p(k,j,i) * cip
     695                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
    697697
    698698                snenn = sk_p(k,j-1,i) - sk_p(k,j+1,i)
    699                 IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
     699                IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9
    700700                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 )
    703703
    704704                ix = INT( sterm * 1000 ) + 1
    705705
    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 )
    707707
    708708                imme(k,j) = sk_p(k,j+1,i) * cim + snenn * (                    &
    … …  
    711711                                                                )              &
    712712                                                          )
    713                 IF ( sterm == 0.0001 )  imme(k,j) = sk_p(k,j,i) * cim
    714                 IF ( sterm == 0.9999 )  imme(k,j) = sk_p(k,j,i) * cim
     713                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
    715715             ENDIF
    716716
    … …  
    720720                IF ( ABS( snenn ) .LT. 1E-9 )  snenn = 1E-9
    721721                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 )
    724724
    725725                ix = INT( sterm * 1000 ) + 1
    726726
    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 )
    728728
    729729                impe(k,j) = sk_p(k,j+2,i) * cim + snenn * (                    &
    … …  
    732732                                                                )              &
    733733                                                          )
    734                 IF ( sterm == 0.0001 )  impe(k,j) = sk_p(k,j+1,i) * cim
    735                 IF ( sterm == 0.9999 )  impe(k,j) = sk_p(k,j+1,i) * cim
     734                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
    736736             ENDIF
    737737
    … …  
    739739             IF ( sw(k,j-1) == 1.0 )  THEN
    740740                snenn = sk_p(k,j,i) - sk_p(k,j-2,i)
    741                 IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
     741                IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9
    742742                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 )
    745745
    746746                ix = INT( sterm * 1000 ) + 1
    747747
    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 )
    749749
    750750                ipme(k,j) = sk_p(k,j-2,i) * cip + snenn * (                    &
    … …  
    753753                                                                )              &
    754754                                                          )
    755                 IF ( sterm == 0.0001 )  ipme(k,j) = sk_p(k,j-1,i) * cip
    756                 IF ( sterm == 0.9999 )  ipme(k,j) = sk_p(k,j-1,i) * cip
     755                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
    757757             ENDIF
    758758
    … …  
    772772!
    773773!--           Removed in order to optimise speed
    774 !             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
    775 !             IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 )  tendcy = 0.0
     774!             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp )
     775!             IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp )  tendcy = 0.0
    776776!
    777777!--          Density correction because of possible remaining divergences
    … …  
    996996       DO  j = nys, nyn
    997997          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) )
    10001000             cipf = 1.0 - 2.0 * cip
    10011001             cimf = 1.0 - 2.0 * cim
    … …  
    10061006                    - a1(k+1,j) * f8  * ( 1.0 - cimf*cimf )                    &
    10071007                    + 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) )
    10151015             cipf = 1.0 - 2.0 * cip
    10161016             cimf = 1.0 - 2.0 * cim
    … …  
    10211021                    - a1(k,j)   * f8  * ( 1.0 - cimf*cimf )                    &
    10221022                    + 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) )
    10271027          ENDDO
    10281028       ENDDO
    … …  
    10511051          DO  k = nzb, nzt+1
    10521052             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 )
    10541054             IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0
    10551055
    10561056             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 )
    10581058             IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0
    10591059
    … …  
    10801080             IF ( sw(k,j) == 1.0 )  THEN
    10811081                snenn = sk_p(k+1,j,i) - sk_p(k-1,j,i)
    1082                 IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
     1082                IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9
    10831083                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 )
    10861086
    10871087                ix = INT( sterm * 1000 ) + 1
    10881088
    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) )
    10901090
    10911091                ippe(k,j) = sk_p(k-1,j,i) * cip + snenn * (                    &
    … …  
    11001100                IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
    11011101                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 )
    11041104
    11051105                ix = INT( sterm * 1000 ) + 1
    11061106
    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) )
    11081108
    11091109                imme(k,j) = sk_p(k+1,j,i) * cim + snenn * (                    &
    … …  
    11121112                                                                )              &
    11131113                                                          )
    1114                 IF ( sterm == 0.0001 )  imme(k,j) = sk_p(k,j,i) * cim
    1115                 IF ( sterm == 0.9999 )  imme(k,j) = sk_p(k,j,i) * cim
     1114                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
    11161116             ENDIF
    11171117
    … …  
    11211121                IF ( ABS( snenn ) .LT. 1E-9 )  snenn = 1E-9
    11221122                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 )
    11251125
    11261126                ix = INT( sterm * 1000 ) + 1
    11271127
    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) )
    11291129
    11301130                impe(k,j) = sk_p(k+2,j,i) * cim + snenn * (                    &
    … …  
    11331133                                                                )              &
    11341134                                                          )
    1135                 IF ( sterm == 0.0001 )  impe(k,j) = sk_p(k+1,j,i) * cim
    1136                 IF ( sterm == 0.9999 )  impe(k,j) = sk_p(k+1,j,i) * cim
     1135                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
    11371137             ENDIF
    11381138
    … …  
    11401140             IF ( sw(k-1,j) == 1.0 )  THEN
    11411141                snenn = sk_p(k,j,i) - sk_p(k-2,j,i)
    1142                 IF ( ABS( snenn ) < 1E-9 )  snenn = 1E-9
     1142                IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9
    11431143                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 )
    11461146
    11471147                ix = INT( sterm * 1000 ) + 1
    11481148
    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) )
    11501150
    11511151                ipme(k,j) = sk_p(k-2,j,i) * cip + snenn * (                    &
    … …  
    11541154                                                                )              &
    11551155                                                          )
    1156                 IF ( sterm == 0.0001 )  ipme(k,j) = sk_p(k-1,j,i) * cip
    1157                 IF ( sterm == 0.9999 )  ipme(k,j) = sk_p(k-1,j,i) * cip
     1156                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
    11581158             ENDIF
    11591159
    … …  
    11731173!
    11741174!--           Removed in order to optimise speed
    1175 !             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
    1176 !             IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 )  tendcy = 0.0
     1175!             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp )
     1176!             IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp )  tendcy = 0.0
    11771177!
    11781178!--          Density correction because of possible remaining divergences
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |