Ignore:
Timestamp:
Aug 21, 2017 2:59:59 PM (7 years ago)
Author:
kanani
Message:

Vertical nesting implemented (SadiqHuq?)

File:
1 edited

Legend:

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

    r2320 r2365  
    2525! -----------------
    2626! $Id$
     27! Vertical grid nesting implemented (SadiqHuq)
     28!
     29! 2320 2017-07-21 12:47:43Z suehring
    2730! Set bottom boundary conditions after nesting interpolation and anterpolation
    2831!
     
    399402        ONLY:  wind_turbine, wtm_forces
    400403
     404    USE vertical_nesting_mod,                                                  &
     405        ONLY:  vnested, vnest_anterpolate, vnest_anterpolate_e,                &
     406               vnest_boundary_conds, vnest_boundary_conds_khkm,                &
     407               vnest_deallocate, vnest_init, vnest_init_fine,                  &
     408               vnest_start_time
     409
    401410    IMPLICIT NONE
    402411
     
    429438!-- Data exchange between coupled models in case that a call has been omitted
    430439!-- at the end of the previous run of a job chain.
    431     IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled )  THEN
     440    IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled .AND. .NOT. vnested)  THEN
    432441!
    433442!--    In case of model termination initiated by the local model the coupler
     
    458467       CALL cpu_log( log_point_s(10), 'timesteps', 'start' )
    459468!
     469!--    Vertical nesting: initialize fine grid
     470       IF ( vnested ) THEN
     471          IF ( .NOT. vnest_init  .AND.  simulated_time >= vnest_start_time )  THEN
     472             CALL cpu_log( log_point(80), 'vnest_init', 'start' )
     473             CALL vnest_init_fine
     474             vnest_init = .TRUE.
     475             CALL cpu_log( log_point(80), 'vnest_init', 'stop' )
     476          ENDIF
     477       ENDIF
     478!
    460479!--    Determine ug, vg and w_subs in dependence on data from external file
    461480!--    LSF_DATA
     
    624643!--       Swap the time levels in preparation for the next time step.
    625644          CALL swap_timelevel
     645
     646!
     647!--       Vertical nesting: Interpolate fine grid data to the coarse grid
     648          IF ( vnest_init ) THEN
     649             CALL cpu_log( log_point(81), 'vnest_anterpolate', 'start' )
     650             CALL vnest_anterpolate
     651             CALL cpu_log( log_point(81), 'vnest_anterpolate', 'stop' )
     652          ENDIF
    626653
    627654          IF ( nested_run )  THEN
     
    736763          IF ( intermediate_timestep_count == 1  .OR. &
    737764                call_psolver_at_all_substeps )  THEN
    738              CALL pres
     765
     766             IF (  vnest_init ) THEN
     767!
     768!--             Compute pressure in the CG, interpolate top boundary conditions
     769!--             to the FG and then compute pressure in the FG
     770                IF ( coupling_mode == 'vnested_crse' )  CALL pres
     771
     772                CALL cpu_log( log_point(82), 'vnest_bc', 'start' )
     773                CALL vnest_boundary_conds
     774                CALL cpu_log( log_point(82), 'vnest_bc', 'stop' )
     775 
     776                IF ( coupling_mode == 'vnested_fine' )  CALL pres
     777
     778!--             Anterpolate TKE, satisfy Germano Identity
     779                CALL cpu_log( log_point(83), 'vnest_anter_e', 'start' )
     780                CALL vnest_anterpolate_e
     781                CALL cpu_log( log_point(83), 'vnest_anter_e', 'stop' )
     782
     783             ELSE
     784
     785                CALL pres
     786
     787             ENDIF
     788
    739789          ENDIF
    740790
     
    910960!
    911961!--    Data exchange between coupled models
    912        IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled )  THEN
     962       IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled                   &
     963                                          .AND. .NOT. vnested )  THEN
    913964          time_coupling = time_coupling + dt_3d
    914965
     
    11541205    ENDDO   ! time loop
    11551206
     1207!-- Vertical nesting: Deallocate variables initialized for vertical nesting   
     1208    IF ( vnest_init )  CALL vnest_deallocate
     1209
    11561210    IF ( myid == 0 )  CALL finish_progress_bar
    11571211
Note: See TracChangeset for help on using the changeset viewer.