SUBROUTINE init_dvrp !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! introduce prefix_chr to ensure unique dvrp_file path ! TEST: print* statements ! ToDo: checking of mode_dvrp for legal values is not correct ! ! Former revisions: ! ----------------- ! $Id: init_dvrp.f90 155 2008-03-28 10:56:30Z letzel $ ! ! 130 2007-11-13 14:08:40Z letzel ! allow two instead of one digit to specify isosurface and slicer variables ! Test output of isosurface on camera file ! ! 82 2007-04-16 15:40:52Z raasch ! Preprocessor strings for different linux clusters changed to "lc", ! routine local_flush is used for buffer flushing ! ! 17 2007-02-19 01:57:39Z raasch ! dvrp_output_local activated for all streams ! ! 13 2007-02-14 12:15:07Z raasch ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.12 2006/02/23 12:30:22 raasch ! ebene renamed section, pl.. replaced by do.., ! ! Revision 1.1 2000/04/27 06:24:39 raasch ! Initial revision ! ! ! Description: ! ------------ ! Initializing actions needed when using dvrp-software !------------------------------------------------------------------------------! #if defined( __dvrp_graphics ) USE arrays_3d USE DVRP USE dvrp_variables USE grid_variables USE indices USE pegrid USE control_parameters IMPLICIT NONE CHARACTER (LEN=2) :: section_chr CHARACTER (LEN=3) :: prefix_chr CHARACTER (LEN=80) :: dvrp_file_local INTEGER :: i, j, k, l, m, pn, tv, vn LOGICAL :: allocated REAL :: center(3), distance REAL, DIMENSION(:,:,:), ALLOCATABLE :: local_pf TYPE(CSTRING), SAVE :: dvrp_directory_c, dvrp_file_c, & dvrp_file_local_c,dvrp_host_c, & dvrp_password_c, dvrp_username_c, name_c ! !-- Set the maximum time the program can be suspended on user request (by !-- dvrp steering). This variable is defined in module DVRP. DVRP_MAX_SUSPEND_TIME = 7200 ! !-- Allocate array holding the names and limits of the steering variables !-- (must have the same number of elements as array mode_dvrp!) ALLOCATE( steering_dvrp(10) ) ! !-- Check, if output parameters are given and/or allowed !-- and set default-values, where necessary IF ( dvrp_username == ' ' ) THEN IF ( myid == 0 ) THEN PRINT*, '+++ init_dvrp: dvrp_username is undefined' CALL local_stop ENDIF ENDIF IF ( dvrp_output /= 'ftp' .AND. dvrp_output /= 'rtsp' .AND. & dvrp_output /= 'local' ) THEN IF ( myid == 0 ) THEN PRINT*, '+++ init_dvrp: dvrp_output="', dvrp_output, '" not allowed' CALL local_stop ENDIF ENDIF IF ( dvrp_directory == 'default' ) THEN dvrp_directory = TRIM( dvrp_username ) // '/' // TRIM( run_identifier ) ENDIF IF ( dvrp_output /= 'local' ) THEN IF ( dvrp_file /= 'default' .AND. dvrp_file /= '/dev/null' ) THEN IF ( myid == 0 ) THEN PRINT*, '+++ init_dvrp: dvrp_file="', dvrp_file, '" not allowed' CALL local_stop ENDIF ENDIF ENDIF ! !-- Strings are assigned to strings of special type which have a CHAR( 0 ) !-- (C end-of-character symbol) at their end. This is needed when strings are !-- passed to C routines. dvrp_directory_c = dvrp_directory dvrp_file_c = dvrp_file dvrp_host_c = dvrp_host dvrp_password_c = dvrp_password dvrp_username_c = dvrp_username ! !-- Loop over all output modes choosed m = 1 allocated = .FALSE. DO WHILE ( mode_dvrp(m) /= ' ' ) ! !-- Check, if mode is allowed IF ( mode_dvrp(m)(1:10) /= 'isosurface' .AND. & mode_dvrp(m)(1:6) /= 'slicer' .AND. & mode_dvrp(m)(1:9) /= 'particles' ) THEN IF ( myid == 0 ) THEN PRINT*, '+++ init_dvrp: mode_dvrp="', mode_dvrp, '" not allowed' ENDIF CALL local_stop ENDIF ! !-- Determine prefix for dvrp_file WRITE ( prefix_chr, '(I2.2,''_'')' ) m ! !-- Camera position must be computed and written on file when no dvrp-output !-- has been generated so far (in former runs) ! IF ( dvrp_filecount == 0 ) THEN ! !-- Compute center of domain and distance of camera from center center(1) = ( nx + 1.0 ) * dx * 0.5 * superelevation_x center(2) = ( ny + 1.0 ) * dy * 0.5 * superelevation_y center(3) = ( zu(nz_do3d) - zu(nzb) ) * 0.5 * superelevation distance = 1.5 * MAX( ( nx + 1.0 ) * dx * superelevation_x, & ( ny + 1.0 ) * dy * superelevation_y, & ( zu(nz_do3d) - zu(nzb) ) * superelevation ) ! !-- Write camera position on file CALL DVRP_INIT( m-1, 0 ) ! !-- Create filename for camera IF ( dvrp_output == 'rtsp' ) THEN WRITE ( 9, * ) '*** vor dvrp_output_rtsp' CALL local_flush( 9 ) dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '/camera.dvr' dvrp_file_c = dvrp_file CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, & dvrp_password_c, dvrp_directory_c, & dvrp_file_c ) WRITE ( 9, * ) '*** nach dvrp_output_rtsp' CALL local_flush( 9 ) ELSEIF ( dvrp_output == 'ftp' ) THEN dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '.camera.dvr' dvrp_file_c = dvrp_file ! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, & ! dvrp_password_c, dvrp_directory_c, & ! dvrp_file_c ) ELSE IF ( dvrp_file(1:9) /= '/dev/null' ) THEN dvrp_file_local = prefix_chr // TRIM( mode_dvrp(m) ) & // '.camera.dvr' dvrp_file_local_c = dvrp_file_local ELSE dvrp_file_local_c = dvrp_file_c ENDIF CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c ) ENDIF CALL DVRP_CAMERA( m-1, center, distance ) WRITE ( 9, * ) '*** #1' CALL local_flush( 9 ) ! !-- Define bounding box material and create a bounding box CALL DVRP_MATERIAL_RGB( m-1, 1, 0.5, 0.5, 0.5, 0.0 ) CALL DVRP_BOUNDINGBOX( m-1, 1, 0.01, 0.0, 0.0, 0.0, & (nx+1) * dx * superelevation_x, & (ny+1) * dy * superelevation_y, & zu(nz_do3d) * superelevation ) CALL DVRP_VISUALIZE( m-1, 0, 0 ) CALL DVRP_EXIT( m-1 ) WRITE ( 9, * ) '*** #2' CALL local_flush( 9 ) ! !-- Write topography isosurface on file CALL DVRP_INIT( m-1, 0 ) ! !-- Create filename for buildings IF ( dvrp_output == 'rtsp' ) THEN dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) & // '/buildings.dvr' dvrp_file_c = dvrp_file CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, & dvrp_password_c, dvrp_directory_c, & dvrp_file_c ) WRITE ( 9, * ) '*** #3' CALL local_flush( 9 ) ELSEIF ( dvrp_output == 'ftp' ) THEN dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) & // '.buildings.dvr' dvrp_file_c = dvrp_file ! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, & ! dvrp_password_c, dvrp_directory_c, & ! dvrp_file_c ) ELSE IF ( dvrp_file(1:9) /= '/dev/null' ) THEN dvrp_file_local = prefix_chr // TRIM( mode_dvrp(m) ) & // '.buildings.dvr' dvrp_file_local_c = dvrp_file_local ELSE dvrp_file_local_c = dvrp_file_c ENDIF CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c ) ENDIF ! !-- Determine local gridpoint coordinates IF ( .NOT. allocated ) THEN ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), & zcoor_dvrp(nzb:nz_do3d) ) allocated = .TRUE. DO i = nxl, nxr+1 xcoor_dvrp(i) = i * dx * superelevation_x ENDDO DO j = nys, nyn+1 ycoor_dvrp(j) = j * dy * superelevation_y ENDDO zcoor_dvrp = zu(nzb:nz_do3d) * superelevation nx_dvrp = nxr+1 - nxl + 1 ny_dvrp = nyn+1 - nys + 1 nz_dvrp = nz_do3d - nzb + 1 ENDIF ! !-- Define the grid used by dvrp CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, & ycoor_dvrp, zcoor_dvrp ) CALL DVRP_MATERIAL_RGB( m-1, 1, 0.8, 0.7, 0.6, 0.0 ) WRITE ( 9, * ) '*** #4' CALL local_flush( 9 ) ! !-- Compute and plot isosurface in dvr-format ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) ) local_pf = 0.0 DO i = nxl, nxr+1 DO j = nys, nyn+1 IF ( nzb_s_inner(j,i) > 0 ) THEN local_pf(i,j,nzb:nzb_s_inner(j,i)) = 1.0 ENDIF ENDDO ENDDO WRITE ( 9, * ) '*** #4.1' CALL local_flush( 9 ) CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, & cyclic_dvrp, cyclic_dvrp, cyclic_dvrp ) WRITE ( 9, * ) '*** #4.2' CALL local_flush( 9 ) CALL DVRP_THRESHOLD( m-1, 1.0 ) WRITE ( 9, * ) '*** #4.3' CALL local_flush( 9 ) CALL DVRP_VISUALIZE( m-1, 1, 0 ) WRITE ( 9, * ) '*** #4.4' CALL local_flush( 9 ) DEALLOCATE( local_pf ) CALL DVRP_EXIT( m-1 ) WRITE ( 9, * ) '*** #5' CALL local_flush( 9 ) ! !-- Write the surface isosurface on file CALL DVRP_INIT( m-1, 0 ) ! !-- Create filename for surface IF ( dvrp_output == 'rtsp' ) THEN dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '/surface.dvr' dvrp_file_c = dvrp_file CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, & dvrp_password_c, dvrp_directory_c, & dvrp_file_c ) WRITE ( 9, * ) '*** #6' CALL local_flush( 9 ) ELSEIF ( dvrp_output == 'ftp' ) THEN dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '.surface.dvr' dvrp_file_c = dvrp_file ! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, & ! dvrp_password_c, dvrp_directory_c, & ! dvrp_file_c ) ELSE IF ( dvrp_file(1:9) /= '/dev/null' ) THEN dvrp_file_local = prefix_chr // TRIM( mode_dvrp(m) ) & // '.surface.dvr' dvrp_file_local_c = dvrp_file_local ELSE dvrp_file_local_c = dvrp_file_c ENDIF CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c ) ENDIF ! !-- Determine local gridpoint coordinates IF ( .NOT. allocated ) THEN ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), & zcoor_dvrp(nzb:nz_do3d) ) allocated = .TRUE. DO i = nxl, nxr+1 xcoor_dvrp(i) = i * dx * superelevation_x ENDDO DO j = nys, nyn+1 ycoor_dvrp(j) = j * dy * superelevation_y ENDDO zcoor_dvrp = zu(nzb:nz_do3d) * superelevation nx_dvrp = nxr+1 - nxl + 1 ny_dvrp = nyn+1 - nys + 1 nz_dvrp = nz_do3d - nzb + 1 ENDIF ! !-- Define the grid used by dvrp CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, & ycoor_dvrp, zcoor_dvrp ) CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.6, 0.0, 0.0 ) WRITE ( 9, * ) '*** #7' CALL local_flush( 9 ) ! !-- Compute and plot isosurface in dvr-format ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) ) local_pf = 0.0 local_pf(:,:,0) = 1.0 CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, & cyclic_dvrp, cyclic_dvrp, cyclic_dvrp ) CALL DVRP_THRESHOLD( m-1, 1.0 ) CALL DVRP_VISUALIZE( m-1, 1, 0 ) DEALLOCATE( local_pf ) CALL DVRP_EXIT( m-1 ) WRITE ( 9, * ) '*** #8' CALL local_flush( 9 ) ! ENDIF ! !-- Initialize dvrp for all dvrp-calls during the run CALL DVRP_INIT( m-1, 0 ) ! !-- Preliminary definition of filename for dvrp-output IF ( dvrp_output == 'rtsp' ) THEN ! !-- First initialize parameters for possible interactive steering. !-- Every parameter has to be passed to the respective stream. pn = 1 ! !-- Initialize threshold counter needed for initialization of the !-- isosurface steering variables tv = 0 DO WHILE ( mode_dvrp(pn) /= ' ' ) IF ( mode_dvrp(pn)(1:10) == 'isosurface' ) THEN READ ( mode_dvrp(pn), '(10X,I2)' ) vn steering_dvrp(pn)%name = do3d(0,vn) tv = tv + 1 IF ( do3d(0,vn)(1:1) == 'w' ) THEN steering_dvrp(pn)%min = -4.0 steering_dvrp(pn)%max = 5.0 ELSE steering_dvrp(pn)%min = 288.0 steering_dvrp(pn)%max = 292.0 ENDIF name_c = TRIM( do3d(0,vn) ) WRITE ( 9, * ) '*** #9' CALL local_flush( 9 ) CALL DVRP_STEERING_INIT( m-1, name_c, steering_dvrp(pn)%min, & steering_dvrp(pn)%max, threshold(tv) ) WRITE ( 9, * ) '*** #10' CALL local_flush( 9 ) ELSEIF ( mode_dvrp(pn)(1:6) == 'slicer' ) THEN READ ( mode_dvrp(pn), '(6X,I2)' ) vn steering_dvrp(pn)%name = do2d(0,vn) name_c = TRIM( do2d(0,vn) ) l = MAX( 2, LEN_TRIM( do2d(0,vn) ) ) section_chr = do2d(0,vn)(l-1:l) SELECT CASE ( section_chr ) CASE ( 'xy' ) steering_dvrp(pn)%imin = 0 steering_dvrp(pn)%imax = nz_do3d slicer_position_dvrp(pn) = section(1,1) CALL DVRP_STEERING_INIT( m-1, name_c, & steering_dvrp(pn)%imin, & steering_dvrp(pn)%imax, & slicer_position_dvrp(pn) ) CASE ( 'xz' ) steering_dvrp(pn)%imin = 0 steering_dvrp(pn)%imax = ny slicer_position_dvrp(pn) = section(1,2) CALL DVRP_STEERING_INIT( m-1, name_c, & steering_dvrp(pn)%imin, & steering_dvrp(pn)%imax, & slicer_position_dvrp(pn) ) CASE ( 'yz' ) steering_dvrp(pn)%imin = 0 steering_dvrp(pn)%imax = nx slicer_position_dvrp(pn) = section(1,3) CALL DVRP_STEERING_INIT( m-1, name_c, & steering_dvrp(pn)%imin, & steering_dvrp(pn)%imax, & slicer_position_dvrp(pn) ) END SELECT ENDIF pn = pn + 1 ENDDO WRITE ( 9, * ) '*** #11' CALL local_flush( 9 ) dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '/*****.dvr' dvrp_file_c = dvrp_file CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, & dvrp_password_c, dvrp_directory_c, & dvrp_file_c ) WRITE ( 9, * ) '*** #12' CALL local_flush( 9 ) ELSEIF ( dvrp_output == 'ftp' ) THEN dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '.%05d.dvr' dvrp_file_c = dvrp_file ! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, & ! dvrp_password_c, dvrp_directory_c, dvrp_file_c ) ELSE IF ( dvrp_file(1:9) /= '/dev/null' ) THEN dvrp_file_local = prefix_chr // TRIM( mode_dvrp(m) ) & // '_%05d.dvr' dvrp_file_local_c = dvrp_file_local ELSE dvrp_file_local_c = dvrp_file_c ENDIF CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c ) ENDIF ! dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '.%05d.dvr' & ! // CHAR( 0 ) ! dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '/*****.dvr' & ! // CHAR( 0 ) ! dvrp_file = '/dev/null' // CHAR( 0 ) ! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host, dvrp_username, dvrp_password, & ! dvrp_directory, dvrp_file ) ! CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host, dvrp_username, dvrp_password, & ! dvrp_directory, dvrp_file ) ! CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file ) ! !-- Determine local gridpoint coordinates IF ( .NOT. allocated ) THEN ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), & zcoor_dvrp(nzb:nz_do3d) ) allocated = .TRUE. DO i = nxl, nxr+1 xcoor_dvrp(i) = i * dx * superelevation_x ENDDO DO j = nys, nyn+1 ycoor_dvrp(j) = j * dy * superelevation_y ENDDO zcoor_dvrp = zu(nzb:nz_do3d) * superelevation nx_dvrp = nxr+1 - nxl + 1 ny_dvrp = nyn+1 - nys + 1 nz_dvrp = nz_do3d - nzb + 1 ENDIF ! !-- Define the grid used by dvrp WRITE ( 9, * ) '*** #13' CALL local_flush( 9 ) CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, ycoor_dvrp, & zcoor_dvrp ) WRITE ( 9, * ) '*** #14' CALL local_flush( 9 ) m = m + 1 ENDDO #endif END SUBROUTINE init_dvrp SUBROUTINE init_dvrp_logging !------------------------------------------------------------------------------! ! Description: ! ------------ ! Initializes logging events for time measurement with dvrp software ! and splits one PE from the global communicator in case that dvrp output ! shall be done by one single PE. !------------------------------------------------------------------------------! #if defined( __dvrp_graphics ) USE dvrp_variables USE pegrid IMPLICIT NONE CHARACTER (LEN=4) :: chr INTEGER :: idummy ! !-- Initialize logging of calls by DVRP graphic software WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_INIT' CALL local_flush( 9 ) CALL DVRP_LOG_INIT( 'DVRP_LOG' // CHAR( 0 ), 0 ) WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_INIT' CALL local_flush( 9 ) ! !-- User-defined logging events: #1 (total time needed by PALM) WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_SYMBOL' CALL local_flush( 9 ) CALL DVRP_LOG_SYMBOL( 1, 'PALM_total' // CHAR( 0 ) ) WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_SYMBOL' CALL local_flush( 9 ) CALL DVRP_LOG_SYMBOL( 2, 'PALM_timestep' // CHAR( 0 ) ) WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_EVENT' CALL local_flush( 9 ) CALL DVRP_LOG_EVENT( 1, 1 ) WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_EVENT' CALL local_flush( 9 ) #if defined( __parallel ) ! !-- Find out, if dvrp output shall be done by a dedicated PE CALL local_getenv( 'use_seperate_pe_for_dvrp_output', 31, chr, idummy ) IF ( chr == 'true' ) THEN use_seperate_pe_for_dvrp_output = .TRUE. WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_SPLIT' CALL local_flush( 9 ) CALL DVRP_SPLIT( MPI_COMM_WORLD, comm_palm ) WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_SPLIT' CALL local_flush( 9 ) CALL MPI_COMM_SIZE( comm_palm, numprocs, ierr ) ENDIF #endif #endif END SUBROUTINE init_dvrp_logging SUBROUTINE close_dvrp !------------------------------------------------------------------------------! ! Description: ! ------------ ! Exit of dvrp software and finish dvrp logging !------------------------------------------------------------------------------! #if defined( __dvrp_graphics ) USE control_parameters USE dvrp USE dvrp_variables INTEGER :: m ! !-- If required, close dvrp-software and logging of dvrp-calls IF ( dt_dvrp /= 9999999.9 ) THEN m = 1 DO WHILE ( mode_dvrp(m) /= ' ' ) CALL DVRP_EXIT( m-1 ) m = m + 1 ENDDO CALL DVRP_LOG_EVENT( -1, 1 ) ! Logging of total cpu-time used by PALM IF ( use_seperate_pe_for_dvrp_output ) THEN CALL DVRP_SPLIT_EXIT( 1 ) ! Argument 0: reduced output ELSE CALL DVRP_LOG_EXIT( 1 ) ! Argument 0: reduced output ENDIF ENDIF #endif END SUBROUTINE close_dvrp