Changeset 1320 for palm/trunk/SOURCE/plant_canopy_model.f90

Timestamp:

Mar 20, 2014 8:40:49 AM (10 years ago)

Author:

raasch

Message:

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

File:

• palm/trunk/SOURCE/plant_canopy_model.f90 (modified) (10 diffs)

palm/trunk/SOURCE/plant_canopy_model.f90

@@ -20 +20 @@
 ! Current revisions:
 ! -----------------
-! 
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! old module precision_kind is removed,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
 !
 ! Former revisions:
@@ -28 +34 @@
 ! 1036 2012-10-22 13:43:42Z raasch
 ! code put under GPL (PALM 3.9)
-!
-! 257 2009-03-11 15:17:42Z heinze
-! Output of messages replaced by message handling routine.
-! Bugfix: remove IF statement in plant_canopy_model_ij
-!
-! 153 2008-03-19 09:41:30Z steinfeld
-! heat sources within the forest canopy are added, which represent the
-! rate of heat input into the air from the forest leaves, evaluation of sinks
-! and sources for scalar concentration due to canopy elements
 !
 ! 138 2007-11-28 10:03:58Z letzel
@@ -63 +60 @@
     SUBROUTINE plant_canopy_model( component )
 
-       USE arrays_3d
-       USE control_parameters
-       USE indices
-       USE pegrid
+       USE arrays_3d,                                                          &
+           ONLY:  canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w,   &
+                  q, sec, sls, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  pch_index, message_string
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner,    &
+                  nzb_v_inner, nzb_w_inner
+
+       USE kinds
 
        IMPLICIT NONE
 
-       INTEGER ::  component, i, j, k
+       INTEGER(iwp) ::  component  !:
+       INTEGER(iwp) ::  i          !:
+       INTEGER(iwp) ::  j          !:
+       INTEGER(iwp) ::  k          !:
  
 !
@@ -154 +162 @@
                 DO  j = nys, nyn
                    DO  k = nzb_s_inner(j,i)+1, pch_index
-                      tend(k,j,i) = tend(k,j,i) +                     &
+                      tend(k,j,i) = tend(k,j,i) +                   &
                                     ( canopy_heat_flux(k,j,i) -     &
                                       canopy_heat_flux(k-1,j,i) ) / &
@@ -221 +229 @@
     SUBROUTINE plant_canopy_model_ij( i, j, component )
 
-       USE arrays_3d
-       USE control_parameters
-       USE indices
-       USE pegrid
+       USE arrays_3d,                                                          &
+           ONLY:  canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w,   &
+                  q, sec, sls, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  pch_index, message_string
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner,    &
+                  nzb_v_inner, nzb_w_inner
+
+       USE kinds
 
        IMPLICIT NONE
 
-       INTEGER ::  component, i, j, k
-
-!
-!--    Compute drag for the three velocity components 
+       INTEGER(iwp) ::  component  !:
+       INTEGER(iwp) ::  i          !:
+       INTEGER(iwp) ::  j          !:
+       INTEGER(iwp) ::  k          !:
+
+!
+!--    Compute drag for the three velocity components
        SELECT CASE ( component )
 
@@ -238 +257 @@
        CASE ( 1 )
           DO  k = nzb_u_inner(j,i)+1, pch_index
-             tend(k,j,i) = tend(k,j,i) -                  &
+             tend(k,j,i) = tend(k,j,i) -                     &
                               cdc(k,j,i) * lad_u(k,j,i) *    &   
                               SQRT(     u(k,j,i)**2 +        &
@@ -258 +277 @@
        CASE ( 2 )
           DO  k = nzb_v_inner(j,i)+1, pch_index
-             tend(k,j,i) = tend(k,j,i) -                  &
+             tend(k,j,i) = tend(k,j,i) -                     &
                               cdc(k,j,i) * lad_v(k,j,i) *    &
                               SQRT( ( ( u(k,j-1,i)   +       &
@@ -278 +297 @@
        CASE ( 3 )
           DO  k = nzb_w_inner(j,i)+1, pch_index
-             tend(k,j,i) = tend(k,j,i) -                  &
+             tend(k,j,i) = tend(k,j,i) -                     &
                               cdc(k,j,i) * lad_w(k,j,i) *    & 
                               SQRT( ( ( u(k,j,i)    +        &  
@@ -299 +318 @@
           CASE ( 4 )
              DO  k = nzb_s_inner(j,i)+1, pch_index
-                tend(k,j,i) = tend(k,j,i) +                     &
+                tend(k,j,i) = tend(k,j,i) +                   &
                               ( canopy_heat_flux(k,j,i) -     &
                                 canopy_heat_flux(k-1,j,i) ) / &
@@ -328 +347 @@
        CASE ( 6 )
           DO  k = nzb_s_inner(j,i)+1, pch_index   
-             tend(k,j,i) = tend(k,j,i) -                     &
+             tend(k,j,i) = tend(k,j,i) -                        &
                               2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
                               SQRT( ( ( u(k,j,i)           +    &