Ignore:
Timestamp:
Nov 13, 2007 2:08:40 PM (16 years ago)
Author:
letzel
Message:

DVRP output modifications:

  • The user can now visualize user-defined quantities using dvrp.

data_output_dvrp calls the new user_interface subroutine
user_data_output_dvrp in case of unknown variables (CASE DEFAULT).

  • Two instead of one digit are allowed to specify isosurface and slicer

variables with the parameter mode_dvrp.

File:
1 edited

Legend:

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

    r114 r130  
    44! Actual revisions:
    55! -----------------
     6! new subroutine user_data_output_dvrp
    67! +argument gls in user_init_grid
    78!
     
    833834
    834835
     836 SUBROUTINE user_data_output_dvrp( output_variable, local_pf )
     837
     838!------------------------------------------------------------------------------!
     839!
     840! Description:
     841! ------------
     842! Execution of user-defined dvrp output
     843!------------------------------------------------------------------------------!
     844
     845    USE control_parameters
     846    USE indices
     847    USE pegrid
     848    USE user
     849
     850    IMPLICIT NONE
     851
     852    CHARACTER (LEN=*) ::  output_variable
     853
     854    INTEGER ::  i, j, k
     855
     856    REAL, DIMENSION(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) ::  local_pf
     857
     858!
     859!-- Here the user-defined DVRP output follows:
     860
     861!
     862!-- Move original array to intermediate array
     863    SELECT CASE ( output_variable )
     864
     865!       CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz',  )
     866!!
     867!!--       Here the user can add user_defined output quantities.
     868!!--       Uncomment and extend the following lines, if necessary.
     869!          DO  i = nxl, nxr+1
     870!             DO  j = nys, nyn+1
     871!                DO  k = nzb, nz_do3d
     872!                   local_pf(i,j,k) = u2(k,j,i)
     873!                ENDDO
     874!             ENDDO
     875!          ENDDO
     876
     877
     878       CASE DEFAULT
     879!
     880!--       The DEFAULT case is reached if output_variable contains a
     881!--       wrong character string that is neither recognized in data_output_dvrp
     882!--       nor here in user_data_output_dvrp.
     883          IF ( myid == 0 )  THEN
     884             PRINT*,'+++ (user_)data_output_dvrp: no output possible for: ', &
     885                  output_variable
     886          ENDIF
     887
     888    END SELECT
     889
     890
     891 END SUBROUTINE user_data_output_dvrp
     892
     893
     894
    835895 SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf )
    836896
Note: See TracChangeset for help on using the changeset viewer.