Changeset 3933


Ignore:
Timestamp:
Apr 25, 2019 12:33:20 PM (5 years ago)
Author:
kanani
Message:

Bugfixes and clean-up for output quantity theta_2m*

Location:
palm/trunk/SOURCE
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/average_3d_data.f90

    r3773 r3933  
    2525! -----------------
    2626! $Id$
     27! Bugfix in CASE theta_2m*, removal of redundant code
     28!
     29! 3773 2019-03-01 08:56:57Z maronga
    2730! Added output of theta_2m*_xy_av
    2831!
     
    440443
    441444         CASE ( 'theta_2m*' )
    442              IF ( ALLOCATED( tsurf_av ) ) THEN
     445             IF ( ALLOCATED( pt_2m_av ) ) THEN
    443446                DO  i = nxlg, nxrg
    444447                   DO  j = nysg, nyng
     
    448451                CALL exchange_horiz_2d( pt_2m_av, nbgp )
    449452             ENDIF
    450              
     453
    451454          CASE ( 't*' )
    452455             IF ( ALLOCATED( ts_av ) ) THEN
     
    512515             ENDIF
    513516
    514           CASE ( 'theta_2m' )
    515              IF ( ALLOCATED( pt_2m_av ) ) THEN
    516                 DO  i = nxlg, nxrg
    517                    DO  j = nysg, nyng
    518                       pt_2m_av(j,i) = pt_2m_av(j,i) / REAL( average_count_3d, KIND=wp )
    519                    ENDDO
    520                 ENDDO
    521                 CALL exchange_horiz_2d( pt_2m_av, nbgp )
    522              ENDIF
    523              
    524517          CASE ( 'w' )
    525518             IF ( ALLOCATED( w_av ) ) THEN
  • palm/trunk/SOURCE/check_parameters.f90

    r3885 r3933  
    2525! -----------------
    2626! $Id$
     27! Alphabetical resorting in CASE, condense settings for theta_2m* into one IF clause
     28!
     29! 3885 2019-04-11 11:29:34Z kanani
    2730! Changes related to global restructuring of location messages and introduction
    2831! of additional debug messages
     
    30773080             CONTINUE
    30783081
    3079           CASE ( 'ghf*', 'lwp*', 'ol*', 'qsws*', 'r_a*', 'theta_2m*',          &
    3080                  'shf*', 'ssws*', 't*', 'tsurf*', 'us*', 'z0*', 'z0h*', 'z0q*' )
     3082          CASE ( 'ghf*', 'lwp*', 'ol*', 'qsws*', 'r_a*',                       &
     3083                 'shf*', 'ssws*', 't*', 'theta_2m*', 'tsurf*', 'us*',          &
     3084                 'z0*', 'z0h*', 'z0q*' )
    30813085             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
    30823086                message_string = 'illegal value for data_output: "' //         &
     
    31173121                CALL message( 'check_parameters', 'PA0361', 1, 2, 0, 6, 0 )
    31183122             ENDIF
    3119 
    3120            
    31213123!
    31223124!--          Activate calculation of 2m temperature if output is requested
    31233125             IF ( TRIM( var ) == 'theta_2m*' )  THEN
    31243126                do_output_at_2m = .TRUE.
    3125              ENDIF             
    3126 
     3127                unit = 'K'
     3128             ENDIF
    31273129
    31283130             IF ( TRIM( var ) == 'ghf*'   )  unit = 'W/m2'
    31293131             IF ( TRIM( var ) == 'lwp*'   )  unit = 'kg/m2'
    31303132             IF ( TRIM( var ) == 'ol*'    )  unit = 'm'
    3131              IF ( TRIM( var ) == 'theta_2m*' )  unit = 'K'           
    31323133             IF ( TRIM( var ) == 'qsws*'  )  unit = 'kgm/kgs'
    3133              IF ( TRIM( var ) == 'r_a*'   )  unit = 's/m'     
     3134             IF ( TRIM( var ) == 'r_a*'   )  unit = 's/m'
    31343135             IF ( TRIM( var ) == 'shf*'   )  unit = 'K*m/s'
    31353136             IF ( TRIM( var ) == 'ssws*'  )  unit = 'kg/m2*s'
    31363137             IF ( TRIM( var ) == 't*'     )  unit = 'K'
    3137              IF ( TRIM( var ) == 'tsurf*' )  unit = 'K' 
     3138             IF ( TRIM( var ) == 'tsurf*' )  unit = 'K'
    31383139             IF ( TRIM( var ) == 'us*'    )  unit = 'm/s'
    31393140             IF ( TRIM( var ) == 'z0*'    )  unit = 'm'
  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r3885 r3933  
    2525! -----------------
    2626! $Id$
     27! Remove unused subroutine and allocation of pt_2m, this is done in surface_mod
     28! now (surfaces%pt_2m)
     29!
     30!
    2731! Changes related to global restructuring of location messages and introduction
    2832! of additional debug messages
     
    10171021!-- Public functions
    10181022    PUBLIC lsm_boundary_condition, lsm_check_data_output,                      &
    1019            lsm_check_data_output_pr, lsm_calc_pt_near_surface,                 &
     1023           lsm_check_data_output_pr,                                           &
    10201024           lsm_check_parameters, lsm_define_netcdf_grid, lsm_3d_data_averaging,&
    10211025           lsm_data_output_2d, lsm_data_output_3d, lsm_energy_balance,         &
     
    10381042    END INTERFACE lsm_boundary_condition
    10391043
    1040     INTERFACE lsm_calc_pt_near_surface
    1041        MODULE PROCEDURE lsm_calc_pt_near_surface
    1042     END INTERFACE lsm_calc_pt_near_surface
    1043    
    10441044    INTERFACE lsm_check_data_output
    10451045       MODULE PROCEDURE lsm_check_data_output
     
    50575057       ALLOCATE ( surf_lsm_h%r_s(1:surf_lsm_h%ns)                 )
    50585058       ALLOCATE ( surf_lsm_h%r_canopy_min(1:surf_lsm_h%ns)        )
    5059        ALLOCATE ( surf_lsm_h%pt_2m(1:surf_lsm_h%ns)               )
    50605059       ALLOCATE ( surf_lsm_h%vegetation_surface(1:surf_lsm_h%ns)  )
    50615060       ALLOCATE ( surf_lsm_h%water_surface(1:surf_lsm_h%ns)       )
     
    73227321    END SUBROUTINE calc_z0_water_surface
    73237322
    7324    
    7325 !------------------------------------------------------------------------------!
    7326 ! Description:
    7327 ! ------------
    7328 !> Calculates 2m temperature for data output at coarse resolution
    7329 !------------------------------------------------------------------------------!
    7330     SUBROUTINE lsm_calc_pt_near_surface
    7331 
    7332        IMPLICIT NONE
    7333 
    7334        INTEGER(iwp)                          :: i, j, k, m   !< running indices
    7335 
    7336 
    7337        DO  m = 1, surf_lsm_h%ns
    7338 
    7339           i = surf_lsm_h%i(m)
    7340           j = surf_lsm_h%j(m)
    7341           k = surf_lsm_h%k(m)
    7342 
    7343           surf_lsm_h%pt_2m(m) = surf_lsm_h%pt_surface(m) + surf_lsm_h%ts(m) / kappa &
    7344                              * ( log( 2.0_wp /  surf_lsm_h%z0h(m) )                 &
    7345                                - psi_h( 2.0_wp / surf_lsm_h%ol(m) )                 &
    7346                                + psi_h( surf_lsm_h%z0h(m) / surf_lsm_h%ol(m) ) )
    7347 
    7348        ENDDO
    7349 
    7350     END SUBROUTINE lsm_calc_pt_near_surface
    7351 
    7352    
    7353    
    73547323!
    73557324!-- Integrated stability function for heat and moisture
  • palm/trunk/SOURCE/sum_up_3d_data.f90

    r3773 r3933  
    2525! -----------------
    2626! $Id$
     27! Formatting
     28!
     29! 3773 2019-03-01 08:56:57Z maronga
    2730! Added output of theta_2m*_xy_av
    2831!
     
    940943                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
    941944                         m = surf_lsm_h%end_index(j,i)
    942                         pt_2m_av(j,i) = pt_2m_av(j,i) +                       &
     945                         pt_2m_av(j,i) = pt_2m_av(j,i) +                       &
    943946                                         surf_lsm_h%pt_2m(m)
    944947                      ELSEIF ( match_usm )  THEN
  • palm/trunk/SOURCE/surface_mod.f90

    r3833 r3933  
    2626! -----------------
    2727! $Id$
     28! Add (de)allocation of pt_2m,
     29! bugfix: initialize pt_2m
     30!
     31! 3833 2019-03-28 15:04:04Z forkel
    2832! added USE chem_gasphase_mod (chem_modules will not transport nvar and nspec anymore)
    2933!
     
    13211325!--    Salinity surface flux
    13221326       IF ( ocean_mode )  DEALLOCATE ( surfaces%sasws )
     1327!
     1328!--    2-m potential temperature (for output quantity theta_2m*)
     1329       IF ( do_output_at_2m )  DEALLOCATE ( surfaces%pt_2m )
    13231330
    13241331    END SUBROUTINE deallocate_surface_attributes_h
     
    14491456!--    Salinity surface flux
    14501457       IF ( ocean_mode )  ALLOCATE ( surfaces%sasws(1:surfaces%ns) )
     1458!
     1459!--    2-m potential temperature (for output quantity theta_2m*)
     1460       IF ( do_output_at_2m )  THEN
     1461          ALLOCATE ( surfaces%pt_2m(1:surfaces%ns) )
     1462          surfaces%pt_2m = -9999.0_wp  !< output array (for theta_2m*) must be initialized here,
     1463                                       !< otherwise simulation crash at do2d_at_begin with spinup=.F.
     1464       ENDIF
    14511465
    14521466    END SUBROUTINE allocate_surface_attributes_h
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r3921 r3933  
    2828! -----------------
    2929! $Id$
     30! Remove allocation of pt_2m, this is done in surface_mod now (surfaces%pt_2m)
     31!
     32! 3921 2019-04-18 14:21:10Z suehring
    3033! Undo accidentally commented initialization 
    3134!
     
    11601163        ALLOCATE ( surf_usm_h%qsws_eb(1:surf_usm_h%ns)          )
    11611164        ALLOCATE ( surf_usm_h%pt_10cm(1:surf_usm_h%ns)          )
    1162         ALLOCATE ( surf_usm_h%pt_2m(1:surf_usm_h%ns)            )
    11631165
    11641166!
Note: See TracChangeset for help on using the changeset viewer.