Changeset 1353 for palm/trunk/SOURCE/init_dvrp.f90

Timestamp:

Apr 8, 2014 3:21:23 PM (10 years ago)

Author:

heinze

Message:

REAL constants provided with KIND-attribute

File:

• palm/trunk/SOURCE/init_dvrp.f90 (modified) (15 diffs)

palm/trunk/SOURCE/init_dvrp.f90

@@ -20 +20 @@
 ! Current revisions:
 ! -----------------
-!
+! REAL constants provided with KIND-attribute 
 !
 ! Former revisions:
@@ -131 +131 @@
 !
 !-- Set clipping to default (total domain), if not set by user
-    IF ( clip_dvrp_l == 9999999.9 )  clip_dvrp_l = 0.0
-    IF ( clip_dvrp_r == 9999999.9 )  clip_dvrp_r = ( nx + 1 ) * dx
-    IF ( clip_dvrp_s == 9999999.9 )  clip_dvrp_s = 0.0
-    IF ( clip_dvrp_n == 9999999.9 )  clip_dvrp_n = ( ny + 1 ) * dy
+    IF ( clip_dvrp_l == 9999999.9_wp )  clip_dvrp_l = 0.0_wp
+    IF ( clip_dvrp_r == 9999999.9_wp )  clip_dvrp_r = ( nx + 1 ) * dx
+    IF ( clip_dvrp_s == 9999999.9_wp )  clip_dvrp_s = 0.0_wp
+    IF ( clip_dvrp_n == 9999999.9_wp )  clip_dvrp_n = ( ny + 1 ) * dy
 
 !
@@ -256 +256 @@
 !
 !--       Compute center of domain and distance of camera from center
-          center(1) = ( clip_dvrp_l + clip_dvrp_r ) * 0.5 * superelevation_x
-          center(2) = ( clip_dvrp_s + clip_dvrp_n ) * 0.5 * superelevation_y
-          center(3) = ( zu(nz_do3d) - zu(nzb) ) * 0.5 * superelevation
-          distance  = 1.5 * MAX( (clip_dvrp_r-clip_dvrp_l) * superelevation_x, &
-                                 (clip_dvrp_n-clip_dvrp_s) * superelevation_y, &
-                                 ( zu(nz_do3d) - zu(nzb) ) * superelevation )
+          center(1) = ( clip_dvrp_l + clip_dvrp_r ) * 0.5_wp * superelevation_x
+          center(2) = ( clip_dvrp_s + clip_dvrp_n ) * 0.5_wp * superelevation_y
+          center(3) = ( zu(nz_do3d) - zu(nzb) ) * 0.5_wp * superelevation
+          distance  = 1.5_wp * MAX(                                            &
+                           (clip_dvrp_r-clip_dvrp_l) * superelevation_x,       &
+                           (clip_dvrp_n-clip_dvrp_s) * superelevation_y,       &
+                                ( zu(nz_do3d) - zu(nzb) ) * superelevation          &
+                                       )
 
 !
@@ -302 +304 @@
 !
 !--       Define bounding box material and create a bounding box
-          tmp_r = 0.5;  tmp_g = 0.5;  tmp_b = 0.5;  tmp_t = 0.0
+          tmp_r = 0.5_wp;  tmp_g = 0.5_wp;  tmp_b = 0.5_wp;  tmp_t = 0.0_wp
           CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
 
-          tmp_1 = 0.01;
+          tmp_1 = 0.01_wp;
           tmp_2 = clip_dvrp_l * superelevation_x
           tmp_3 = clip_dvrp_s * superelevation_y
-          tmp_4 = 0.0
+          tmp_4 = 0.0_wp
           tmp_5 = (clip_dvrp_r+dx) * superelevation_x
           tmp_6 = (clip_dvrp_n+dy) * superelevation_y
@@ -386 +388 @@
              tmp_g = topography_color(2)
              tmp_b = topography_color(3)
-             tmp_t = 0.0
+             tmp_t = 0.0_wp
              CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
 
@@ -393 +395 @@
              ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1, &
                                 nzb:nz_do3d) )
-             local_pf = 0.0
+             local_pf = 0.0_wp
              IF ( dvrp_overlap )  THEN
                 DO  i = nxl_dvrp, nxr_dvrp+1
                    DO  j = nys_dvrp, nyn_dvrp+1
                       IF ( nzb_s_inner(j,i) > 0 )  THEN
-                         local_pf(i,j,nzb:nzb_s_inner(j,i)) = 1.0
+                         local_pf(i,j,nzb:nzb_s_inner(j,i)) = 1.0_wp
                       ENDIF
                    ENDDO
@@ -407 +409 @@
                              cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
 
-             tmp_th = 1.0
+             tmp_th = 1.0_wp
              CALL DVRP_THRESHOLD( m-1, tmp_th )
 
@@ -428 +430 @@
 !--             ATTENTION: A seperate procedure for setting cluster_alpha will
 !--                        be in the next version of libDVRP (Feb 09)
-                cluster_alpha = 38.0
+                cluster_alpha = 38.0_wp
                 CALL DVRP_THRESHOLD( -(m-1)-1, cluster_alpha )
 
@@ -512 +514 @@
           tmp_g = groundplate_color(2)
           tmp_b = groundplate_color(3)
-          tmp_t = 0.0
+          tmp_t = 0.0_wp
           CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
 
@@ -519 +521 @@
           ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1, &
                              nzb:nz_do3d) )
-          local_pf = 0.0
-          IF (dvrp_overlap )  local_pf(:,:,0) = 1.0
+          local_pf = 0.0_wp
+          IF (dvrp_overlap )  local_pf(:,:,0) = 1.0_wp
 
           CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
                           cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
-          tmp_th = 1.0
+          tmp_th = 1.0_wp
           CALL DVRP_THRESHOLD( m-1, tmp_th )
 
@@ -543 +545 @@
 !--       ATTENTION: A seperate procedure for setting cluster_alpha will be in
 !--                  the next version of libDVRP (Feb 09)
-          cluster_alpha = 38.0
+          cluster_alpha = 38.0_wp
           CALL DVRP_THRESHOLD( -(m-1)-1, cluster_alpha )
 
@@ -581 +583 @@
 
                 IF ( do3d(0,vn)(1:1) == 'w' )  THEN
-                   steering_dvrp(pn)%min  = -4.0
-                   steering_dvrp(pn)%max  =  5.0
+                   steering_dvrp(pn)%min  = -4.0_wp
+                   steering_dvrp(pn)%max  =  5.0_wp
                 ELSE
-                   steering_dvrp(pn)%min  = 288.0
-                   steering_dvrp(pn)%max  = 292.0
+                   steering_dvrp(pn)%min  = 288.0_wp
+                   steering_dvrp(pn)%max  = 292.0_wp
                 ENDIF
 
@@ -690 +692 @@
        IF ( mode_dvrp(m) == 'pathlines' )  THEN
 
-          tmp_x1 = 0.0;  tmp_y1 = 0.0;  tmp_z1 = 0.0
-          tmp_x2 = 1.0;  tmp_y2 = 1.0;  tmp_z2 = 0.3
+          tmp_x1 = 0.0_wp;  tmp_y1 = 0.0_wp;  tmp_z1 = 0.0_wp
+          tmp_x2 = 1.0_wp;  tmp_y2 = 1.0_wp;  tmp_z2 = 0.3_wp
           CALL DVRP_CUBIC_SEEDING( m-1, tmp_x1, tmp_y1, tmp_z1, tmp_x2, tmp_y2,&
                                    tmp_z2, pathlines_linecount, 2, 0 )
@@ -703 +705 @@
 !--       Set pathline length
           CALL DVRP_PATHLINES_SETMAXHISTORY( m-1, pathlines_maxhistory )
-          CALL DVRP_PATHLINES_SETFADING( m-1, 1, 0.0 )
+          CALL DVRP_PATHLINES_SETFADING( m-1, 1, 0.0_wp )
 
           CALL DVRP_INIT_PATHLINES( m-1, 0 )
@@ -823 +825 @@
 !
 !-- If required, close dvrp-software and logging of dvrp-calls
-    IF ( dt_dvrp /= 9999999.9 )  THEN
+    IF ( dt_dvrp /= 9999999.9_wp )  THEN
        m = 1
        DO WHILE ( mode_dvrp(m) /= ' ' )