Ignore:
Timestamp:
Oct 14, 2011 6:39:12 AM (12 years ago)
Author:
raasch
Message:

New:
---

Flow field initialization with given (e.g. measured) profiles. Profile data
for u-,v-velocity components + respective heights are given with new
inipar-parameters u_profile, v_profile, and uv_heights. Final profiles are
calculated from these given profiles by linear interpolation.
(check_parameters, header, init_3d_model, modules, parin)

Changed:


ug,vg replaced by u_init,v_init as the Dirichlet top boundary condition
(boundary_conds)

dirichlet_0 conditions moved from init_3d_model to
check_parameters (check_parameters, init_3d_model)

Errors:


bugfix: dirichlet_0 conditions moved from init_3d_model to
check_parameters (check_parameters, init_3d_model)

File:
1 edited

Legend:

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

    r760 r767  
    77! Current revisions:
    88! ------------------
    9 !
     9! adjustments for prescribed u,v-profiles
     10! bugfix: dirichlet_0 conditions for ug/vg moved to check_parameters
    1011!
    1112! Former revisions:
     
    694695!--    Apply channel flow boundary condition
    695696       IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
    696 
    697697          u(nzt+1,:,:) = 0.0
    698698          v(nzt+1,:,:) = 0.0
    699 
    700 !--       For the Dirichlet condition to be correctly applied at the top, set
    701 !--       ug and vg to zero there
    702           ug(nzt+1)    = 0.0
    703           vg(nzt+1)    = 0.0
    704 
    705699       ENDIF
    706700
     
    937931    THEN
    938932!
    939 !--    When reading data for cyclic fill of 3D prerun data, first read
    940 !--    some of the global variables from restart file
     933!--    When reading data for cyclic fill of 3D prerun data files, read
     934!--    some of the global variables from the restart file which are required
     935!--    for initializing the inflow
    941936       IF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
    942937
     
    951946          ENDDO
    952947
    953 !
    954 !--       Initialization of the turbulence recycling method
    955           IF ( turbulent_inflow )  THEN
    956 !
    957 !--          Store temporally and horizontally averaged vertical profiles to be
    958 !--          used as mean inflow profiles
    959              ALLOCATE( mean_inflow_profiles(nzb:nzt+1,5) )
    960 
    961              mean_inflow_profiles(:,1) = hom_sum(:,1,0)    ! u
    962              mean_inflow_profiles(:,2) = hom_sum(:,2,0)    ! v
    963              mean_inflow_profiles(:,4) = hom_sum(:,4,0)    ! pt
    964              mean_inflow_profiles(:,5) = hom_sum(:,8,0)    ! e
    965 
    966 !
    967 !--          Use these mean profiles for the inflow (provided that Dirichlet
    968 !--          conditions are used)
    969              IF ( inflow_l )  THEN
    970                 DO  j = nysg, nyng
    971                    DO  k = nzb, nzt+1
    972                       u(k,j,nxlg:-1)  = mean_inflow_profiles(k,1)
    973                       v(k,j,nxlg:-1)  = mean_inflow_profiles(k,2)
    974                       w(k,j,nxlg:-1)  = 0.0
    975                       pt(k,j,nxlg:-1) = mean_inflow_profiles(k,4)
    976                       e(k,j,nxlg:-1)  = mean_inflow_profiles(k,5)
    977                    ENDDO
    978                 ENDDO
    979              ENDIF
    980 
    981 !
    982 !--          Calculate the damping factors to be used at the inflow. For a
    983 !--          turbulent inflow the turbulent fluctuations have to be limited
    984 !--          vertically because otherwise the turbulent inflow layer will grow
    985 !--          in time.
    986              IF ( inflow_damping_height == 9999999.9 )  THEN
    987 !
    988 !--             Default: use the inversion height calculated by the prerun; if
    989 !--             this is zero, inflow_damping_height must be explicitly
    990 !--             specified.
    991                 IF ( hom_sum(nzb+6,pr_palm,0) /= 0.0 )  THEN
    992                    inflow_damping_height = hom_sum(nzb+6,pr_palm,0)
    993                 ELSE
    994                    WRITE( message_string, * ) 'inflow_damping_height must be ',&
    995                         'explicitly specified because&the inversion height ', &
    996                         'calculated by the prerun is zero.'
    997                    CALL message( 'init_3d_model', 'PA0318', 1, 2, 0, 6, 0 )
    998                 ENDIF
    999 
    1000              ENDIF
    1001 
    1002              IF ( inflow_damping_width == 9999999.9 )  THEN
    1003 !
    1004 !--             Default for the transition range: one tenth of the undamped
    1005 !--             layer
    1006                 inflow_damping_width = 0.1 * inflow_damping_height
    1007 
    1008              ENDIF
    1009 
    1010              ALLOCATE( inflow_damping_factor(nzb:nzt+1) )
    1011 
    1012              DO  k = nzb, nzt+1
    1013 
    1014                 IF ( zu(k) <= inflow_damping_height )  THEN
    1015                    inflow_damping_factor(k) = 1.0
    1016                 ELSEIF ( zu(k) <= inflow_damping_height +  &
    1017                                   inflow_damping_width )  THEN
    1018                    inflow_damping_factor(k) = 1.0 -                            &
    1019                                            ( zu(k) - inflow_damping_height ) / &
    1020                                            inflow_damping_width
    1021                 ELSE
    1022                    inflow_damping_factor(k) = 0.0
    1023                 ENDIF
    1024 
    1025              ENDDO
    1026           ENDIF
    1027 
    1028948       ENDIF
    1029949
     
    1038958#endif
    1039959       ENDDO
     960
     961!
     962!--    Initialization of the turbulence recycling method
     963       IF ( TRIM( initializing_actions ) == 'cyclic_fill'  .AND.  &
     964            turbulent_inflow )  THEN
     965!
     966!--       First store the profiles to be used at the inflow.
     967!--       These profiles are the (temporally) and horizontally averaged vertical
     968!--       profiles from the prerun. Alternatively, prescribed profiles
     969!--       for u,v-components can be used.
     970          ALLOCATE( mean_inflow_profiles(nzb:nzt+1,5) )
     971
     972          IF ( use_prescribed_profile_data )  THEN
     973             mean_inflow_profiles(:,1) = u_init            ! u
     974             mean_inflow_profiles(:,2) = v_init            ! v
     975          ELSE
     976             mean_inflow_profiles(:,1) = hom_sum(:,1,0)    ! u
     977             mean_inflow_profiles(:,2) = hom_sum(:,2,0)    ! v
     978          ENDIF
     979          mean_inflow_profiles(:,4) = hom_sum(:,4,0)       ! pt
     980          mean_inflow_profiles(:,5) = hom_sum(:,8,0)       ! e
     981
     982!
     983!--       If necessary, adjust the horizontal flow field to the prescribed
     984!--       profiles
     985          IF ( use_prescribed_profile_data )  THEN
     986             DO  i = nxlg, nxrg
     987                DO  j = nysg, nyng
     988                   DO  k = nzb, nzt+1
     989                      u(k,j,i) = u(k,j,i) - hom_sum(k,1,0) + u_init(k)
     990                      v(k,j,i) = v(k,j,i) - hom_sum(k,2,0) + v_init(k)
     991                   ENDDO
     992                ENDDO
     993             ENDDO
     994          ENDIF
     995
     996!
     997!--       Use these mean profiles at the inflow (provided that Dirichlet
     998!--       conditions are used)
     999          IF ( inflow_l )  THEN
     1000             DO  j = nysg, nyng
     1001                DO  k = nzb, nzt+1
     1002                   u(k,j,nxlg:-1)  = mean_inflow_profiles(k,1)
     1003                   v(k,j,nxlg:-1)  = mean_inflow_profiles(k,2)
     1004                   w(k,j,nxlg:-1)  = 0.0
     1005                   pt(k,j,nxlg:-1) = mean_inflow_profiles(k,4)
     1006                   e(k,j,nxlg:-1)  = mean_inflow_profiles(k,5)
     1007                ENDDO
     1008             ENDDO
     1009          ENDIF
     1010
     1011!
     1012!--       Calculate the damping factors to be used at the inflow. For a
     1013!--       turbulent inflow the turbulent fluctuations have to be limited
     1014!--       vertically because otherwise the turbulent inflow layer will grow
     1015!--       in time.
     1016          IF ( inflow_damping_height == 9999999.9 )  THEN
     1017!
     1018!--          Default: use the inversion height calculated by the prerun; if
     1019!--          this is zero, inflow_damping_height must be explicitly
     1020!--          specified.
     1021             IF ( hom_sum(nzb+6,pr_palm,0) /= 0.0 )  THEN
     1022                inflow_damping_height = hom_sum(nzb+6,pr_palm,0)
     1023             ELSE
     1024                WRITE( message_string, * ) 'inflow_damping_height must be ',&
     1025                     'explicitly specified because&the inversion height ', &
     1026                     'calculated by the prerun is zero.'
     1027                CALL message( 'init_3d_model', 'PA0318', 1, 2, 0, 6, 0 )
     1028             ENDIF
     1029
     1030          ENDIF
     1031
     1032          IF ( inflow_damping_width == 9999999.9 )  THEN
     1033!
     1034!--          Default for the transition range: one tenth of the undamped
     1035!--          layer
     1036             inflow_damping_width = 0.1 * inflow_damping_height
     1037
     1038          ENDIF
     1039
     1040          ALLOCATE( inflow_damping_factor(nzb:nzt+1) )
     1041
     1042          DO  k = nzb, nzt+1
     1043
     1044             IF ( zu(k) <= inflow_damping_height )  THEN
     1045                inflow_damping_factor(k) = 1.0
     1046             ELSEIF ( zu(k) <= inflow_damping_height +  &
     1047                               inflow_damping_width )  THEN
     1048                inflow_damping_factor(k) = 1.0 -                            &
     1049                                        ( zu(k) - inflow_damping_height ) / &
     1050                                        inflow_damping_width
     1051             ELSE
     1052                inflow_damping_factor(k) = 0.0
     1053             ENDIF
     1054
     1055          ENDDO
     1056
     1057       ENDIF
    10401058
    10411059!
     
    11461164    IF ( conserve_volume_flow )  THEN
    11471165
    1148        IF  ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
     1166       IF ( use_prescribed_profile_data )  THEN
     1167
     1168          volume_flow_initial_l = 0.0
     1169          volume_flow_area_l    = 0.0
     1170
     1171          IF ( nxr == nx )  THEN
     1172             DO  j = nys, nyn
     1173                DO  k = nzb_2d(j,nx)+1, nzt
     1174                   volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
     1175                                              u_init(k) * dzw(k)
     1176                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)
     1177                ENDDO
     1178             ENDDO
     1179          ENDIF
     1180         
     1181          IF ( nyn == ny )  THEN
     1182             DO  i = nxl, nxr
     1183                DO  k = nzb_2d(ny,i)+1, nzt 
     1184                   volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
     1185                                              v_init(k) * dzw(k)
     1186                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)
     1187                ENDDO
     1188             ENDDO
     1189          ENDIF
     1190
     1191#if defined( __parallel )
     1192          CALL MPI_ALLREDUCE( volume_flow_initial_l(1), volume_flow_initial(1),&
     1193                              2, MPI_REAL, MPI_SUM, comm2d, ierr )
     1194          CALL MPI_ALLREDUCE( volume_flow_area_l(1), volume_flow_area(1),      &
     1195                              2, MPI_REAL, MPI_SUM, comm2d, ierr )
     1196
     1197#else
     1198          volume_flow_initial = volume_flow_initial_l
     1199          volume_flow_area    = volume_flow_area_l
     1200#endif 
     1201
     1202       ELSEIF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
    11491203
    11501204          volume_flow_initial_l = 0.0
Note: See TracChangeset for help on using the changeset viewer.