Changeset 1853 for palm/trunk/SOURCE

Timestamp:

Apr 11, 2016 9:00:35 AM (9 years ago)

Author:

maronga

Message:

bugfix: radiation_scheme = constant caused model crash when used in combination with land surface model

Location:

palm/trunk/SOURCE

Files:

• flow_statistics.f90 (modified) (2 diffs)
• radiation_model_mod.f90 (modified) (9 diffs)
• time_integration.f90 (modified) (3 diffs)

palm/trunk/SOURCE/flow_statistics.f90

@@ -19 +19 @@
 ! Current revisions:
 ! -----------------
-!
+! Adjusted for use with radiation_scheme = constant
 !
 ! Former revisions:
@@ -798 +798 @@
              ENDIF
 
-             IF ( radiation )  THEN
+             IF ( radiation  .AND.  radiation_scheme /= 'constant' )  THEN
                 sums_l(nzb,101,tn)  = sums_l(nzb,101,tn)  + rad_net(j,i)
                 sums_l(nzb,102,tn)  = sums_l(nzb,102,tn)  + rad_lw_in(nzb,j,i)

palm/trunk/SOURCE/radiation_model_mod.f90

@@ -19 +19 @@
 ! Current revisions:
 ! -----------------
-!
+! Added routine for radiation_scheme = constant.
 !  
 ! Former revisions:
@@ -374 +374 @@
        MODULE PROCEDURE radiation_clearsky
     END INTERFACE radiation_clearsky
-  
+ 
+    INTERFACE radiation_constant
+       MODULE PROCEDURE radiation_constant
+    END INTERFACE radiation_constant
+ 
     INTERFACE radiation_header
        MODULE PROCEDURE radiation_header
@@ -403 +407 @@
 !-- Public functions
     PUBLIC radiation_check_data_output, radiation_check_data_output_pr,        &
-           radiation_check_parameters, radiation_clearsky, radiation_header,   &
-           radiation_init, radiation_parin, radiation_rrtmg, radiation_tendency
+           radiation_check_parameters, radiation_clearsky, radiation_constant, &
+           radiation_header, radiation_init, radiation_parin, radiation_rrtmg, &
+           radiation_tendency
     
 !
@@ -757 +762 @@
        IF ( radiation_scheme == 'constant' )  THEN
           rad_net = net_radiation
-          radiation = .FALSE.
+!          radiation = .FALSE.
 !
 !--    Calculate orbital constants
@@ -769 +774 @@
 
 
+       IF ( radiation_scheme == 'constant' )  THEN
+
+          IF ( .NOT. ALLOCATED ( rad_lw_out ) )  THEN
+             ALLOCATE ( rad_lw_out(0:0,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+
+       ENDIF
+
        IF ( radiation_scheme == 'clear-sky' )  THEN
 
@@ -789 +802 @@
           IF ( .NOT. ALLOCATED ( rad_lw_in ) )  THEN
              ALLOCATE ( rad_lw_in(0:0,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( .NOT. ALLOCATED ( rad_lw_out ) )  THEN
-             ALLOCATE ( rad_lw_out(0:0,nysg:nyng,nxlg:nxrg) )
           ENDIF
 
@@ -989 +999 @@
 !--    Calculate radiative fluxes at model start
        IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-          IF ( radiation_scheme == 'clear-sky' )  THEN
-             CALL radiation_clearsky
-          ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
-             CALL radiation_rrtmg
-          ENDIF
+
+          SELECT CASE ( radiation_scheme )
+             CASE ( 'rrtmg' )
+                CALL radiation_rrtmg
+             CASE ( 'clear-sky' )
+                CALL radiation_clearsky
+             CASE ( 'constant' )
+                CALL radiation_constant
+             CASE DEFAULT
+          END SELECT
+
        ENDIF
 
@@ -1008 +1024 @@
     SUBROUTINE radiation_clearsky
 
-       USE indices,                                                            &
-           ONLY:  nbgp
 
        IMPLICIT NONE
@@ -1057 +1071 @@
     END SUBROUTINE radiation_clearsky
 
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> This scheme keeps the prescribed net radiation constant during the run
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_constant
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) :: i, j, k   !< loop indices
+       REAL(wp)     :: exn,   &  !< Exner functions at surface
+                       pt1       !< potential temperature at first grid level
+
+!
+!--    Calculate value of the Exner function
+       exn = (surface_pressure / 1000.0_wp )**0.286_wp
+!
+!--    Prescribe net radiation and estimate a longwave outgoing radiative
+!--    flux (needed in land surface model)
+       DO i = nxlg, nxrg
+          DO j = nysg, nyng
+             k = nzb_s_inner(j,i)
+
+             rad_net(j,i)      = net_radiation
+             rad_lw_out(0,j,i) = emissivity * sigma_sb * (pt(k,j,i) * exn)**4
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE radiation_constant
 
 !------------------------------------------------------------------------------!

palm/trunk/SOURCE/time_integration.f90

@@ -19 +19 @@
 ! Current revisions:
 ! ------------------
-!
+! Adjusted for use with radiation_scheme = constant
 !
 ! Former revisions:
@@ -295 +295 @@
     USE radiation_model_mod,                                                   &
         ONLY: dt_radiation, force_radiation_call, radiation,                   &
-              radiation_clearsky, radiation_rrtmg, radiation_scheme,           &
-              skip_time_do_radiation, time_radiation
+              radiation_clearsky, radiation_constant, radiation_rrtmg,         &
+              radiation_scheme, skip_time_do_radiation, time_radiation
 
     USE spectra_mod,                                                           &
@@ -863 +863 @@
                 ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
                    CALL radiation_rrtmg
+                ELSE
+                   CALL radiation_constant
                 ENDIF