Changeset 4898
- Timestamp:
- Mar 4, 2021 3:49:52 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r4896 r4898 27 27 ! ----------------- 28 28 ! $Id$ 29 ! MPI-IO for sky view factors implemented 30 ! 31 ! 4896 2021-03-03 16:10:18Z raasch 29 32 ! typo in file appendix removed 30 33 ! … … 477 480 pt_surface, & 478 481 read_svf, & 482 restart_data_format_input, & 479 483 restart_data_format_output, & 480 484 rho_surface, & … … 506 510 nxr, & 507 511 nxrg, & 512 nx_on_file, & 508 513 ny, & 509 514 nyn, & … … 511 516 nys, & 512 517 nysg, & 518 ny_on_file, & 513 519 nzb, & 514 520 nzt, & … … 595 601 ONLY: rd_mpi_io_check_array, & 596 602 rrd_mpi_io, & 597 wrd_mpi_io 603 wrd_mpi_io, & 604 rd_mpi_io_open, & 605 rd_mpi_io_surface_filetypes, & 606 rrd_mpi_io_surface, & 607 wrd_mpi_io_surface, & 608 rd_mpi_io_close, & 609 tgh 598 610 599 611 USE statistics, & … … 3424 3436 3425 3437 ! 3426 !-- Find all discretized apparent solar positions for radiation interaction. 3427 IF ( radiation_interactions ) CALL radiation_presimulate_solar_pos 3428 3429 ! 3430 !-- If required, read or calculate and write out the SVF 3431 IF ( radiation_interactions .AND. read_svf ) THEN 3432 ! 3433 !-- Read sky-view factors and further required data from file 3434 CALL radiation_read_svf() 3435 3436 ELSEIF ( radiation_interactions .AND. .NOT. read_svf ) THEN 3437 ! 3438 !-- Calculate SFV and CSF 3439 CALL radiation_calc_svf() 3438 !-- If required, read or calculate and write out the SVF. 3439 IF ( radiation_interactions ) THEN 3440 3441 ! 3442 !-- Find all discretized apparent solar positions for radiation interaction. 3443 CALL radiation_presimulate_solar_pos 3444 3445 IF ( read_svf ) THEN 3446 ! 3447 !-- Read sky-view factors and further required data from file 3448 CALL radiation_read_svf() 3449 3450 ELSE 3451 ! 3452 !-- Calculate svf and csf. 3453 CALL radiation_calc_svf() 3454 ENDIF 3455 3456 IF ( write_svf ) THEN 3457 ! 3458 !-- Write svf, csf svfsurf and csfsurf data to file. 3459 CALL radiation_write_svf() 3460 ENDIF 3461 3462 ! 3463 !-- Adjust radiative fluxes. 3464 !-- In case of urban and land surfaces, also call an initial interaction. 3465 CALL radiation_interaction 3466 3440 3467 ENDIF 3441 3468 3442 IF ( radiation_interactions .AND. write_svf ) THEN3443 !3444 !-- Write svf, csf svfsurf and csfsurf data to file3445 CALL radiation_write_svf()3446 ENDIF3447 3448 !3449 !-- Adjust radiative fluxes. In case of urban and land surfaces, also call an initial interaction.3450 IF ( radiation_interactions ) THEN3451 CALL radiation_interaction3452 ENDIF3453 3454 3469 IF ( debug_output ) CALL debug_message( 'radiation_init', 'end' ) 3455 3456 RETURN ! @Todo: remove, I don't see what we need this for here3457 3470 3458 3471 END SUBROUTINE radiation_init … … 9450 9463 CHARACTER(rad_version_len) :: rad_version_field !< 9451 9464 9465 CHARACTER(LEN=64) :: rad_version_in !< rad version on file 9466 9452 9467 INTEGER(iwp) :: i !< 9468 INTEGER(iwp) :: ncsfl_tot !< 9453 9469 INTEGER(iwp) :: ndsidir_from_file = 0 !< 9470 INTEGER(iwp) :: ndsidir_tot !< 9454 9471 INTEGER(iwp) :: npcbl_from_file = 0 !< 9472 INTEGER(iwp) :: npcbl_tot !< 9455 9473 INTEGER(iwp) :: nsurfl_from_file = 0 !< 9474 INTEGER(iwp) :: nsurfl_tot !< 9475 INTEGER(iwp) :: nsvfl_tot !< total (sum across all PEs) counter for the different IO variables 9456 9476 INTEGER(iwp) :: nmrtbl_from_file = 0 !< 9457 9458 9459 CALL location_message( 'reading view factors for radiation interaction', 'start' ) 9460 9461 DO i = 0, io_blocks-1 9462 IF ( i == io_group ) THEN 9463 9464 ! 9465 !-- numprocs_previous_run is only known in case of reading restart data. If a new initial run 9466 !-- which reads svf data is started the following query will be skipped. 9467 IF ( initializing_actions == 'read_restart_data' ) THEN 9468 9469 IF ( numprocs_previous_run /= numprocs ) THEN 9470 WRITE( message_string, * ) 'A different number of processors between the run ', & 9471 'that has written the svf data and the one that ', & 9472 'will read it is not allowed' 9473 CALL message( 'check_open', 'PA0491', 1, 2, 0, 6, 0 ) 9477 INTEGER(iwp) :: nmrtbl_tot !< 9478 INTEGER(iwp) :: nmrtf_tot !< 9479 9480 INTEGER(iwp), DIMENSION(4) :: global_sum !< 9481 INTEGER(iwp), DIMENSION(4) :: local_sum !< variables to compute total counter 9482 9483 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: global_end !< global end index 9484 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: global_start !< global start index 9485 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: end_index !< local end index 9486 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index !< local start index 9487 9488 LOGICAL :: data_to_read !< flag indicating if data is available for current variable 9489 9490 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: tmp !< 9491 9492 9493 IF ( TRIM( restart_data_format_input ) == 'fortran_binary' ) THEN 9494 9495 CALL location_message( 'reading sky view factors for radiation interaction ' // & 9496 '(Fortran binary format)', 'start' ) 9497 9498 DO i = 0, io_blocks-1 9499 IF ( i == io_group ) THEN 9500 9501 ! 9502 !-- numprocs_previous_run is only known in case of reading restart data. If a new initial 9503 !-- run which reads svf data is started the following query will be skipped. 9504 IF ( initializing_actions == 'read_restart_data' ) THEN 9505 9506 IF ( numprocs_previous_run /= numprocs ) THEN 9507 WRITE( message_string, * ) 'A different number of processors between the run ', & 9508 'that has written the svf data and the one that ', & 9509 'will read it is not allowed' 9510 CALL message( 'check_open', 'PA0491', 1, 2, 0, 6, 0 ) 9511 ENDIF 9512 9474 9513 ENDIF 9475 9514 9515 ! 9516 !-- Open binary file 9517 CALL check_open( 88 ) 9518 9519 ! 9520 !-- Read and check version 9521 READ ( 88 ) rad_version_field 9522 IF ( TRIM( rad_version_field ) /= TRIM( rad_version ) ) THEN 9523 WRITE( message_string, * ) 'Version of binary SVF file "', & 9524 TRIM( rad_version_field ), '" does not match ', & 9525 'the version of model "', TRIM( rad_version ), '"' 9526 CALL message( 'radiation_read_svf', 'PA0482', 1, 2, 0, 6, 0 ) 9527 ENDIF 9528 9529 ! 9530 !-- Read nsvfl, ncsfl, nsurfl, nmrtf 9531 READ ( 88 ) nsvfl, ncsfl, nsurfl_from_file, npcbl_from_file, ndsidir_from_file, & 9532 nmrtbl_from_file, nmrtf 9533 9534 IF ( nsvfl < 0 .OR. ncsfl < 0 ) THEN 9535 WRITE( message_string, * ) 'Wrong number of SVF or CSF' 9536 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 ) 9537 ELSE 9538 WRITE(debug_string,*) 'Number of SVF, CSF, and nsurfl to read', nsvfl, ncsfl, & 9539 nsurfl_from_file 9540 IF ( debug_output ) CALL debug_message( debug_string, 'info' ) 9541 ENDIF 9542 9543 IF ( nsurfl_from_file /= nsurfl ) THEN 9544 WRITE( message_string, * ) 'nsurfl from SVF file does not match calculated ', & 9545 'nsurfl from radiation_interaction_init' 9546 CALL message( 'radiation_read_svf', 'PA0490', 1, 2, 0, 6, 0 ) 9547 ENDIF 9548 9549 IF ( npcbl_from_file /= npcbl ) THEN 9550 WRITE( message_string, * ) 'npcbl from SVF file does not match calculated npcbl', & 9551 ' from radiation_interaction_init' 9552 CALL message( 'radiation_read_svf', 'PA0493', 1, 2, 0, 6, 0 ) 9553 ENDIF 9554 9555 IF ( ndsidir_from_file /= ndsidir ) THEN 9556 WRITE( message_string, * ) 'ndsidir from SVF file does not match calculated ', & 9557 'ndsidir from radiation_presimulate_solar_pos' 9558 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 ) 9559 ENDIF 9560 9561 IF ( nmrtbl_from_file /= nmrtbl ) THEN 9562 WRITE( message_string, * ) 'nmrtbl from SVF file does not match calculated ', & 9563 'nmrtbl from radiation_interaction_init' 9564 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 ) 9565 ELSE 9566 WRITE( debug_string, * ) 'Number of nmrtf to read ', nmrtf 9567 IF ( debug_output ) CALL debug_message( debug_string, 'info' ) 9568 ENDIF 9569 9570 ! 9571 !-- Arrays skyvf, skyvft, dsitrans and dsitransc are allready allocated in 9572 !-- radiation_interaction_init and radiation_presimulate_solar_pos 9573 IF ( nsurfl > 0 ) THEN 9574 READ( 88 ) skyvf 9575 READ( 88 ) skyvft 9576 READ( 88 ) dsitrans 9577 ENDIF 9578 9579 IF ( plant_canopy .AND. npcbl > 0 ) THEN 9580 READ( 88 ) dsitransc 9581 ENDIF 9582 9583 ! 9584 !-- The allocation of svf, svfsurf, csf, csfsurf, mrtf, mrtft, and mrtfsurf happens in 9585 !-- routine radiation_calc_svf which is not called if the program enters 9586 !-- radiation_read_svf. Therefore these arrays have to be allocated in the following. 9587 IF ( nsvfl > 0 ) THEN 9588 ALLOCATE( svf(ndsvf,nsvfl) ) 9589 ALLOCATE( svfsurf(idsvf,nsvfl) ) 9590 READ( 88 ) svf 9591 READ( 88 ) svfsurf 9592 ENDIF 9593 9594 IF ( plant_canopy .AND. ncsfl > 0 ) THEN 9595 ALLOCATE( csf(ndcsf,ncsfl) ) 9596 ALLOCATE( csfsurf(idcsf,ncsfl) ) 9597 READ( 88 ) csf 9598 READ( 88 ) csfsurf 9599 ENDIF 9600 9601 IF ( nmrtbl > 0 ) THEN 9602 READ( 88 ) mrtsky 9603 READ( 88 ) mrtskyt 9604 READ( 88 ) mrtdsit 9605 ENDIF 9606 9607 IF ( nmrtf > 0 ) THEN 9608 ALLOCATE( mrtf(nmrtf) ) 9609 ALLOCATE( mrtft(nmrtf) ) 9610 ALLOCATE( mrtfsurf(2,nmrtf) ) 9611 READ( 88 ) mrtf 9612 READ( 88 ) mrtft 9613 READ( 88 ) mrtfsurf 9614 ENDIF 9615 9616 ! 9617 !-- Close binary file 9618 CALL close_file( 88 ) 9619 9476 9620 ENDIF 9477 9478 ! 9479 !-- Open binary file 9480 CALL check_open( 88 ) 9481 9482 ! 9483 !-- Read and check version 9484 READ ( 88 ) rad_version_field 9485 IF ( TRIM( rad_version_field ) /= TRIM( rad_version ) ) THEN 9486 WRITE( message_string, * ) 'Version of binary SVF file "', & 9487 TRIM( rad_version_field ), '" does not match ', & 9488 'the version of model "', TRIM( rad_version ), '"' 9489 CALL message( 'radiation_read_svf', 'PA0482', 1, 2, 0, 6, 0 ) 9621 #if defined( __parallel ) 9622 CALL MPI_BARRIER( comm2d, ierr ) 9623 #endif 9624 ENDDO 9625 9626 CALL location_message( 'reading sky view factors for radiation interaction ' // & 9627 '(Fortran binary format)', 'finished' ) 9628 9629 9630 ELSEIF ( restart_data_format_input(1:3) == 'mpi' ) THEN 9631 9632 ! 9633 !-- In case of MPI-IO data is treated like surface data and the respective routines from 9634 !-- restart_data_mpi_io_mod are used for reading. Contrary to restart data, the virtual processor 9635 !-- grid can not be changed between writing and reading svf data. 9636 CALL location_message( 'reading sky view factors for radiation interaction ' // & 9637 '(MPI-IO format)', 'start' ) 9638 ! 9639 !-- Open MPI-IO svf file for reading the global data. 9640 CALL rd_mpi_io_open( 'READ', 'SVFIN' // TRIM( coupling_char ), & 9641 open_for_global_io_only = .TRUE. ) 9642 ! 9643 !-- Check general header. 9644 IF ( tgh%pes_along_x /= npex .OR. tgh%pes_along_y /= npey ) THEN 9645 ! 9646 !-- Force re-calculation of svfs. 9647 read_svf = .FALSE. 9648 WRITE( message_string, '(A,I7,A,I7,A,I7,A,I7,A)' ) & 9649 'virtual PE grid has changed between previous and current run &npex_prev = ', & 9650 tgh%pes_along_x, ' npey_prev = ', tgh%pes_along_y, ' npex_new = ', npex, & 9651 ' npey_new = ', npey, '&svf wil be re-calculated' 9652 CALL message( 'radiation_read_svf', 'PA0517', 0, 0, 0, 6, 0 ) 9653 RETURN 9654 ENDIF 9655 ! 9656 !-- Read global variables 9657 CALL rrd_mpi_io( 'rad_version', rad_version_in ) 9658 CALL rrd_mpi_io( 'nsvfl', nsvfl_tot ) 9659 CALL rrd_mpi_io( 'ncsfl', ncsfl_tot ) 9660 CALL rrd_mpi_io( 'nsurfl', nsurfl_from_file ) 9661 CALL rrd_mpi_io( 'npcbl', npcbl_from_file ) 9662 CALL rrd_mpi_io( 'ndsidir', ndsidir_from_file ) 9663 CALL rrd_mpi_io( 'nmrtbl', nmrtbl_from_file ) 9664 CALL rrd_mpi_io( 'nmrtf', nmrtf_tot ) 9665 9666 CALL rd_mpi_io_close 9667 ! 9668 !-- Compute global values of local counters. 9669 local_sum(1) = nsurfl 9670 local_sum(2) = npcbl 9671 local_sum(3) = ndsidir 9672 local_sum(4) = nmrtbl 9673 #if defined( __parallel ) 9674 CALL MPI_ALLREDUCE( local_sum, global_sum, SIZE(local_sum), MPI_INTEGER, MPI_SUM, comm2d, & 9675 ierr) 9676 #else 9677 global_sum = local_sum 9678 #endif 9679 nsurfl_tot = global_sum(1) 9680 npcbl_tot = global_sum(2) 9681 ndsidir_tot = global_sum(3) 9682 nmrtbl_tot = global_sum(4) 9683 ! 9684 !-- Check for errors. 9685 nx_on_file = tgh%total_nx-1 9686 ny_on_file = tgh%total_ny-1 9687 9688 IF ( nx_on_file /= nx .OR. ny_on_file /= ny ) THEN 9689 WRITE( message_string, '(A,4(A,I7))' ) & 9690 'total number of grid points along x and y in file SVFIN do not match current run', & 9691 '&nx_on_file = ', nx_on_file, ' ny_on_file = ', ny_on_file, ' nx = ', nx, ' ny = ', & 9692 ny 9693 CALL message( 'radiation_read_svf', 'PA0518', 1, 2, 0, 6, 0 ) 9694 ENDIF 9695 9696 IF ( TRIM( rad_version_in ) /= TRIM( rad_version ) ) THEN 9697 WRITE( message_string, * ) 'Version of binary SVF file "', TRIM( rad_version_field ), & 9698 '" does not match the version of model "', & 9699 TRIM( rad_version ), '"' 9700 CALL message( 'radiation_read_svf', 'PA0482', 1, 2, 0, 6, 0 ) 9701 ENDIF 9702 9703 IF ( nsvfl_tot < 0 .OR. ncsfl_tot < 0 ) THEN 9704 WRITE( message_string, * ) 'Wrong number of SVF or CSF' 9705 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 ) 9706 ELSE 9707 WRITE(debug_string,*) 'Number of SVF, CSF, and nsurfl to read', nsvfl_tot, ncsfl_tot, & 9708 nsurfl_tot 9709 IF ( debug_output ) CALL debug_message( debug_string, 'info' ) 9710 ENDIF 9711 9712 IF ( nsurfl_from_file /= nsurfl_tot ) THEN 9713 WRITE( message_string, * ) 'nsurfl from SVF file does not match calculated ', & 9714 'nsurfl from radiation_interaction_init' 9715 CALL message( 'radiation_read_svf', 'PA0490', 1, 2, 0, 6, 0 ) 9716 ENDIF 9717 9718 IF ( npcbl_from_file /= npcbl_tot ) THEN 9719 WRITE( message_string, * ) 'npcbl from SVF file does not match calculated npcbl ', & 9720 'from radiation_interaction_init' 9721 CALL message( 'radiation_read_svf', 'PA0493', 1, 2, 0, 6, 0 ) 9722 ENDIF 9723 9724 IF ( ndsidir_from_file /= ndsidir_tot ) THEN 9725 WRITE( message_string, * ) 'ndsidir from SVF file does not match calculated ', & 9726 'ndsidir from radiation_presimulate_solar_pos' 9727 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 ) 9728 ENDIF 9729 9730 IF ( nmrtbl_from_file /= nmrtbl_tot ) THEN 9731 WRITE( message_string, * ) 'nmrtbl from SVF file does not match calculated nmrtbl ', & 9732 'from radiation_interaction_init' 9733 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 ) 9734 ELSE 9735 WRITE( debug_string, * ) 'Number of nmrtf to read ', nmrtf_tot 9736 IF ( debug_output ) CALL debug_message( debug_string, 'info' ) 9737 ENDIF 9738 9739 ! 9740 !-- Open MPI-IO SVF file for read local data. 9741 CALL rd_mpi_io_open( 'READ', 'SVFIN' // TRIM( coupling_char ) ) 9742 9743 IF ( nsurfl_tot > 0 ) THEN 9744 ! 9745 !-- Read global indices. 9746 CALL rrd_mpi_io( 'nsurfl_global_start', global_start ) 9747 CALL rrd_mpi_io( 'nsurfl_global_end', global_end ) 9748 ! 9749 !-- Set file types of variables and compute local indices. 9750 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start, & 9751 global_end ) 9752 nsurfl = end_index(nyn,nxr) 9753 9754 IF ( data_to_read ) THEN 9755 9756 CALL rrd_mpi_io_surface( 'skyvf', skyvf ) 9757 CALL rrd_mpi_io_surface( 'skyvft', skyvft ) 9758 ! 9759 !-- To avoid another overlay of rrd_mpi_io_surface, dsitrans is read as REAL tmp array. 9760 !-- The order of dimensions of dsitrans is different to the order expected by 9761 !-- rrd_mpi_io_surface. Therefor a tranpose of tmp is required. 9762 ALLOCATE( tmp(SIZE(dsitrans,2),SIZE(dsitrans,1)) ) 9763 CALL rrd_mpi_io_surface( 'dsitrans', tmp ) 9764 dsitrans = TRANSPOSE( tmp ) 9765 DEALLOCATE( tmp ) 9766 9490 9767 ENDIF 9491 9768 9492 ! 9493 !-- Read nsvfl, ncsfl, nsurfl, nmrtf 9494 READ ( 88 ) nsvfl, ncsfl, nsurfl_from_file, npcbl_from_file, ndsidir_from_file, & 9495 nmrtbl_from_file, nmrtf 9496 9497 IF ( nsvfl < 0 .OR. ncsfl < 0 ) THEN 9498 WRITE( message_string, * ) 'Wrong number of SVF or CSF' 9499 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 ) 9500 ELSE 9501 WRITE(debug_string,*) 'Number of SVF, CSF, and nsurfl to read', nsvfl, ncsfl, & 9502 nsurfl_from_file 9503 IF ( debug_output ) CALL debug_message( debug_string, 'info' ) 9769 ENDIF 9770 9771 IF ( npcbl_tot > 0 ) THEN 9772 9773 CALL rrd_mpi_io( 'npcbl_global_start', global_start ) 9774 CALL rrd_mpi_io( 'npcbl_global_end', global_end ) 9775 9776 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start, & 9777 global_end ) 9778 npcbl = end_index(nyn,nxr) 9779 9780 IF ( data_to_read ) THEN 9781 9782 ALLOCATE( tmp(SIZE(dsitransc,2),SIZE(dsitransc,1)) ) 9783 CALL rrd_mpi_io_surface( 'dsitransc', tmp ) 9784 dsitransc = TRANSPOSE( tmp ) 9785 DEALLOCATE( tmp ) 9786 9504 9787 ENDIF 9505 9788 9506 IF ( nsurfl_from_file /= nsurfl ) THEN 9507 WRITE( message_string, * ) 'nsurfl from SVF file does not match calculated ', & 9508 'nsurfl from radiation_interaction_init' 9509 CALL message( 'radiation_read_svf', 'PA0490', 1, 2, 0, 6, 0 ) 9789 ENDIF 9790 9791 IF ( nsvfl_tot > 0 ) THEN 9792 9793 CALL rrd_mpi_io( 'nsvfl_global_start', global_start ) 9794 CALL rrd_mpi_io( 'nsvfl_global_end', global_end ) 9795 9796 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start, & 9797 global_end ) 9798 nsvfl = end_index(nyn,nxr) 9799 9800 IF ( .NOT. ALLOCATED( svf ) ) ALLOCATE( svf(ndsvf,nsvfl) ) 9801 IF ( .NOT. ALLOCATED( svfsurf ) ) ALLOCATE( svfsurf(idsvf,nsvfl) ) 9802 9803 IF ( data_to_read ) THEN 9804 9805 CALL rrd_mpi_io_surface( 'svf', svf ) 9806 ALLOCATE( tmp(SIZE(svfsurf,1),SIZE(svfsurf,2)) ) 9807 CALL rrd_mpi_io_surface( 'svfsurf', tmp ) 9808 svfsurf = tmp 9809 DEALLOCATE( tmp ) 9810 9510 9811 ENDIF 9511 9812 9512 IF ( npcbl_from_file /= npcbl ) THEN 9513 WRITE( message_string, * ) 'npcbl from SVF file does not match calculated npcbl ', & 9514 'from radiation_interaction_init' 9515 CALL message( 'radiation_read_svf', 'PA0493', 1, 2, 0, 6, 0 ) 9813 ENDIF 9814 9815 IF ( plant_canopy ) THEN 9816 9817 IF ( ncsfl_tot > 0 ) THEN 9818 9819 CALL rrd_mpi_io( 'ncsfl_global_start', global_start ) 9820 CALL rrd_mpi_io( 'ncsfl_global_end', global_end ) 9821 9822 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start, & 9823 global_end ) 9824 ncsfl = end_index(nyn,nxr) 9825 9826 IF ( .NOT. ALLOCATED( csf ) ) ALLOCATE( csf(ndcsf,ncsfl) ) 9827 IF ( .NOT. ALLOCATED( csfsurf ) ) ALLOCATE( csfsurf(idcsf,ncsfl) ) 9828 9829 IF ( data_to_read ) THEN 9830 9831 CALL rrd_mpi_io_surface( 'csf', csf ) 9832 ALLOCATE( tmp(SIZE(csfsurf,1),SIZE(csfsurf,2)) ) 9833 CALL rrd_mpi_io_surface( 'csfsurf', tmp ) 9834 csfsurf = tmp 9835 DEALLOCATE( tmp ) 9836 9837 ENDIF 9838 9516 9839 ENDIF 9517 9840 9518 IF ( ndsidir_from_file /= ndsidir ) THEN 9519 WRITE( message_string, * ) 'ndsidir from SVF file does not match calculated ', & 9520 'ndsidir from radiation_presimulate_solar_pos' 9521 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 ) 9841 ENDIF 9842 9843 IF ( nmrtbl_tot > 0 ) THEN 9844 9845 CALL rrd_mpi_io( 'nmrtbl_global_start', global_start ) 9846 CALL rrd_mpi_io( 'nmrtbl_global_end', global_end ) 9847 9848 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start, & 9849 global_end ) 9850 nmrtbl = end_index(nyn,nxr) 9851 9852 IF ( data_to_read ) THEN 9853 9854 CALL rrd_mpi_io_surface( 'mrtsky', mrtsky ) 9855 CALL rrd_mpi_io_surface( 'mrtskyt', mrtskyt ) 9856 ALLOCATE( tmp(SIZE(mrtdsit,2),SIZE(mrtdsit,1)) ) 9857 CALL rrd_mpi_io_surface( 'mrtdsit', tmp ) 9858 mrtdsit = TRANSPOSE( tmp ) 9859 DEALLOCATE( tmp ) 9860 9522 9861 ENDIF 9523 IF ( nmrtbl_from_file /= nmrtbl ) THEN 9524 WRITE( message_string, * ) 'nmrtbl from SVF file does not match calculated nmrtbl ', & 9525 'from radiation_interaction_init' 9526 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 ) 9527 ELSE 9528 WRITE( debug_string, * ) 'Number of nmrtf to read ', nmrtf 9529 IF ( debug_output ) CALL debug_message( debug_string, 'info' ) 9862 9863 ENDIF 9864 9865 IF ( nmrtf_tot > 0 ) THEN 9866 9867 CALL rrd_mpi_io( 'nmrtf_global_start', global_start ) 9868 CALL rrd_mpi_io( 'nmrtf_global_end', global_end ) 9869 9870 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_read, global_start, & 9871 global_end ) 9872 nmrtf = end_index(nyn,nxr) 9873 9874 IF ( .NOT. ALLOCATED( mrtf ) ) ALLOCATE( mrtf(nmrtf) ) 9875 IF ( .NOT. ALLOCATED( mrtft ) ) ALLOCATE( mrtft(nmrtf) ) 9876 IF ( .NOT. ALLOCATED( mrtfsurf ) ) ALLOCATE( mrtfsurf(2,nmrtf) ) 9877 9878 IF ( data_to_read ) THEN 9879 9880 CALL rrd_mpi_io_surface( 'mrtf', mrtf ) 9881 CALL rrd_mpi_io_surface( 'mrtft', mrtft ) 9882 ALLOCATE( tmp(SIZE(mrtfsurf,1),SIZE(mrtfsurf,2)) ) 9883 CALL rrd_mpi_io_surface( 'mrtfsurf', tmp ) 9884 mrtfsurf = tmp 9885 DEALLOCATE( tmp ) 9886 9530 9887 ENDIF 9531 9888 9532 ! 9533 !-- Arrays skyvf, skyvft, dsitrans and dsitransc are allready allocated in 9534 !-- radiation_interaction_init and radiation_presimulate_solar_pos 9535 IF ( nsurfl > 0 ) THEN 9536 READ( 88 ) skyvf 9537 READ( 88 ) skyvft 9538 READ( 88 ) dsitrans 9539 ENDIF 9540 9541 IF ( plant_canopy .AND. npcbl > 0 ) THEN 9542 READ( 88 ) dsitransc 9543 ENDIF 9544 9545 ! 9546 !-- The allocation of svf, svfsurf, csf, csfsurf, mrtf, mrtft, and mrtfsurf happens in 9547 !-- routine radiation_calc_svf which is not called if the program enters radiation_read_svf. 9548 !-- Therefore these arrays have to be allocated in the following. 9549 IF ( nsvfl > 0 ) THEN 9550 ALLOCATE( svf(ndsvf,nsvfl) ) 9551 ALLOCATE( svfsurf(idsvf,nsvfl) ) 9552 READ( 88 ) svf 9553 READ( 88 ) svfsurf 9554 ENDIF 9555 9556 IF ( plant_canopy .AND. ncsfl > 0 ) THEN 9557 ALLOCATE( csf(ndcsf,ncsfl) ) 9558 ALLOCATE( csfsurf(idcsf,ncsfl) ) 9559 READ( 88 ) csf 9560 READ( 88 ) csfsurf 9561 ENDIF 9562 9563 IF ( nmrtbl > 0 ) THEN 9564 READ( 88 ) mrtsky 9565 READ( 88 ) mrtskyt 9566 READ( 88 ) mrtdsit 9567 ENDIF 9568 9569 IF ( nmrtf > 0 ) THEN 9570 ALLOCATE( mrtf(nmrtf) ) 9571 ALLOCATE( mrtft(nmrtf) ) 9572 ALLOCATE( mrtfsurf(2,nmrtf) ) 9573 READ( 88 ) mrtf 9574 READ( 88 ) mrtft 9575 READ( 88 ) mrtfsurf 9576 ENDIF 9577 9578 ! 9579 !-- Close binary file 9580 CALL close_file( 88 ) 9581 9582 ENDIF 9583 #if defined( __parallel ) 9584 CALL MPI_BARRIER( comm2d, ierr ) 9585 #endif 9586 ENDDO 9587 9588 CALL location_message( 'reading view factors for radiation interaction', 'finished' ) 9589 9889 ENDIF 9890 9891 CALL rd_mpi_io_close 9892 9893 CALL location_message( 'reading sky view factors for radiation interaction ' // & 9894 '(MPI-IO format)', 'finished' ) 9895 9896 ENDIF 9590 9897 9591 9898 END SUBROUTINE radiation_read_svf … … 9604 9911 IMPLICIT NONE 9605 9912 9606 INTEGER(iwp) :: i !< 9607 9608 9609 CALL location_message( 'writing view factors for radiation interaction', 'start' ) 9610 9611 DO i = 0, io_blocks-1 9612 IF ( i == io_group ) THEN 9613 ! 9614 !-- Open binary file 9615 CALL check_open( 89 ) 9616 9617 WRITE( 89 ) rad_version 9618 WRITE( 89 ) nsvfl, ncsfl, nsurfl, npcbl, ndsidir, nmrtbl, nmrtf 9619 IF ( nsurfl > 0 ) THEN 9620 WRITE( 89 ) skyvf 9621 WRITE( 89 ) skyvft 9622 WRITE( 89 ) dsitrans 9913 INTEGER(iwp), PARAMETER :: max_i4_value = 2147483647 !< maximum positive INTEGER(4) value, 2**31 - 1 9914 9915 INTEGER(iwp) :: i !< 9916 INTEGER(iwp) :: ic !< 9917 INTEGER(iwp) :: ierr !< 9918 INTEGER(iwp) :: ind !< 9919 INTEGER(iwp) :: ipcgb !< 9920 INTEGER(iwp) :: isurf !< 9921 INTEGER(iwp) :: j !< 9922 INTEGER(iwp) :: jc !< 9923 INTEGER(iwp) :: ncsfl_tot !< 9924 INTEGER(iwp) :: ndsidir_tot !< 9925 INTEGER(iwp) :: nmrtbl_tot !< 9926 INTEGER(iwp) :: nmrtf_tot !< 9927 INTEGER(iwp) :: npcbl_tot !< 9928 INTEGER(iwp) :: nsurfl_tot !< 9929 INTEGER(iwp) :: nsvfl_tot !< total (sum over all PEs) counter for the different IO variables 9930 9931 INTEGER(idp), DIMENSION(7) :: local_sum !< variables to compute total counter 9932 INTEGER(idp), DIMENSION(7) :: global_sum !< INTEGER(idp) to allow check, if total number of values > 2G 9933 9934 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: end_index !< local end index 9935 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: global_end !< global end index 9936 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: global_start !< global start index 9937 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: lo_no !< local number of values 9938 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index !< local start index 9939 9940 LOGICAL :: data_to_write !< flag indicating if data is available for writing 9941 9942 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: tmp !< 9943 9944 9945 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 9946 9947 CALL location_message( 'writing sky view factors for radiation interaction ' // & 9948 '(Fortran binary format)', 'start' ) 9949 9950 DO i = 0, io_blocks-1 9951 IF ( i == io_group ) THEN 9952 ! 9953 !-- Open binary file 9954 CALL check_open( 89 ) 9955 9956 WRITE( 89 ) rad_version 9957 WRITE( 89 ) nsvfl, ncsfl, nsurfl, npcbl, ndsidir, nmrtbl, nmrtf 9958 IF ( nsurfl > 0 ) THEN 9959 WRITE( 89 ) skyvf 9960 WRITE( 89 ) skyvft 9961 WRITE( 89 ) dsitrans 9962 ENDIF 9963 IF ( npcbl > 0 ) THEN 9964 WRITE( 89 ) dsitransc 9965 ENDIF 9966 IF ( nsvfl > 0 ) THEN 9967 WRITE( 89 ) svf 9968 WRITE( 89 ) svfsurf 9969 ENDIF 9970 IF ( plant_canopy .AND. ncsfl > 0 ) THEN 9971 WRITE( 89 ) csf 9972 WRITE( 89 ) csfsurf 9973 ENDIF 9974 IF ( nmrtbl > 0 ) THEN 9975 WRITE( 89 ) mrtsky 9976 WRITE( 89 ) mrtskyt 9977 WRITE( 89 ) mrtdsit 9978 ENDIF 9979 IF ( nmrtf > 0 ) THEN 9980 WRITE( 89 ) mrtf 9981 WRITE( 89 ) mrtft 9982 WRITE( 89 ) mrtfsurf 9983 ENDIF 9984 ! 9985 !-- Close binary file 9986 CALL close_file( 89 ) 9987 9623 9988 ENDIF 9624 IF ( npcbl > 0 ) THEN 9625 WRITE( 89 ) dsitransc 9989 #if defined( __parallel ) 9990 CALL MPI_BARRIER( comm2d, ierr ) 9991 #endif 9992 ENDDO 9993 9994 CALL location_message( 'writing sky view factors for radiation interaction ' // & 9995 '(Fortran binary format)', 'fnished' ) 9996 9997 ELSEIF ( restart_data_format_output(1:3) == 'mpi' ) THEN 9998 ! 9999 !-- Sky view factor data is treated like surface data and the respective routines from 10000 !-- restart_data_mpi_io_mod are used for writing. In contrary to restart data, the virtual 10001 !-- processor grid can not be changed between writing and reading svf data. 10002 CALL location_message( 'writing sky view factors for radiation interaction ' // & 10003 '(MPI-IO format)', 'start' ) 10004 10005 ! 10006 !-- Open MPI-IO svf file 10007 CALL rd_mpi_io_open( 'write', 'SVFOUT' // TRIM( coupling_char ) ) 10008 ! 10009 !-- Write global variables. 10010 CALL wrd_mpi_io( 'rad_version', rad_version ) 10011 ! 10012 !-- Sum local number of skyview factor values on all PEs. 10013 local_sum(1) = nsvfl 10014 local_sum(2) = ncsfl 10015 local_sum(3) = nsurfl 10016 local_sum(4) = npcbl 10017 local_sum(5) = ndsidir 10018 local_sum(6) = nmrtbl 10019 local_sum(7) = nmrtf 10020 #if defined( __parallel ) 10021 CALL MPI_ALLREDUCE( local_sum, global_sum, SIZE( local_sum ), MPI_INTEGER8, MPI_SUM, & 10022 comm2d, ierr) 10023 #else 10024 global_sum = local_sum 10025 #endif 10026 ! 10027 !-- Check, if total number of respective skyview values do not exceed 2**31-1 10028 DO i = 1, 7 10029 IF ( global_sum(i) > max_i4_value ) THEN 10030 WRITE( message_string, '(A,I1,A)' ) 'number of sky view factor values (', i, & 10031 ') > 2**31-1' 10032 CALL message( 'radiation_write_svf', 'PA0733', 1, 2, 0, 6, 0 ) 9626 10033 ENDIF 9627 IF ( nsvfl > 0 ) THEN 9628 WRITE( 89 ) svf 9629 WRITE( 89 ) svfsurf 10034 ENDDO 10035 10036 nsvfl_tot = global_sum(1) 10037 ncsfl_tot = global_sum(2) 10038 nsurfl_tot = global_sum(3) 10039 npcbl_tot = global_sum(4) 10040 ndsidir_tot = global_sum(5) 10041 nmrtbl_tot = global_sum(6) 10042 nmrtf_tot = global_sum(7) 10043 ! 10044 !-- Write total counters in header section of MPI-IO file. 10045 CALL wrd_mpi_io( 'nsvfl', nsvfl_tot ) 10046 CALL wrd_mpi_io( 'ncsfl', ncsfl_tot ) 10047 CALL wrd_mpi_io( 'nsurfl', nsurfl_tot ) 10048 CALL wrd_mpi_io( 'npcbl', npcbl_tot ) 10049 CALL wrd_mpi_io( 'ndsidir', ndsidir_tot ) 10050 CALL wrd_mpi_io( 'nmrtbl', nmrtbl_tot ) 10051 CALL wrd_mpi_io( 'nmrtf', nmrtf_tot ) 10052 ! 10053 !-- Write local data. 10054 !-- All svf values are treated as surface values and use the respective routines from 10055 !-- restart_data_mpi_io_mod. 10056 IF ( nsurfl > 0 ) THEN 10057 10058 lo_no = 0 10059 ! 10060 !-- Count surface values on individual grid cells 10061 DO isurf = 1, nsurfl 10062 jc = surfl(iy, isurf) 10063 ic = surfl(ix, isurf) 10064 lo_no(jc,ic) = lo_no(jc,ic) + 1 10065 ENDDO 10066 ! 10067 !-- Create local index array similar to surface routines. 10068 ind = 1 10069 DO i = nxl, nxr 10070 DO j = nys, nyn 10071 start_index(j,i) = ind 10072 end_index(j,i) = start_index(j,i) + lo_no(j,i) - 1 10073 ind = ind + lo_no(j,i) 10074 ENDDO 10075 ENDDO 10076 10077 ELSE 10078 10079 start_index = 1 10080 end_index = 0 10081 10082 ENDIF 10083 ! 10084 !-- Each PE has to call the next block, therefore nsurfl_tot is used. 10085 !-- This is required to use MPI_FILE_WRITE_All for writing. 10086 IF ( nsurfl_tot > 0 ) THEN 10087 ! 10088 !-- Set file types of variables for this block and compute global indices. 10089 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start, & 10090 global_end ) 10091 10092 CALL wrd_mpi_io( 'nsurfl_global_start', global_start ) 10093 CALL wrd_mpi_io( 'nsurfl_global_end', global_end ) 10094 10095 IF ( data_to_write ) THEN 10096 10097 CALL wrd_mpi_io_surface( 'skyvf', skyvf ) 10098 CALL wrd_mpi_io_surface( 'skyvft', skyvft ) 10099 ! 10100 !-- To avoid another overlay of rrd_mpi_io_surface, dsitrans is written as REAL tmp array. 10101 !-- The order of dimensions of dsitrans is different to the order expected by 10102 !-- rrd_mpi_io_surface. Therefor a tranpose of tmp is required. 10103 ALLOCATE( tmp(SIZE(dsitrans,2),SIZE(dsitrans,1)) ) 10104 tmp = TRANSPOSE( dsitrans ) 10105 CALL wrd_mpi_io_surface( 'dsitrans', tmp ) 10106 DEALLOCATE( tmp ) 10107 9630 10108 ENDIF 9631 IF ( plant_canopy .AND. ncsfl > 0 ) THEN 9632 WRITE( 89 ) csf 9633 WRITE( 89 ) csfsurf 10109 10110 ENDIF 10111 10112 IF ( npcbl > 0 ) THEN 10113 10114 lo_no = 0 10115 DO isurf = 1, npcbl 10116 jc = pcbl(iy,isurf) 10117 ic = pcbl(ix,isurf) 10118 lo_no(jc,ic) = lo_no(jc,ic) + 1 10119 ENDDO 10120 10121 ind = 1 10122 DO i = nxl, nxr 10123 DO j = nys, nyn 10124 start_index(j,i) = ind 10125 end_index(j,i) = start_index(j,i) + lo_no(j,i) - 1 10126 ind = ind+lo_no(j,i) 10127 ENDDO 10128 ENDDO 10129 10130 ELSE 10131 10132 start_index = 1 10133 end_index = 0 10134 10135 ENDIF 10136 10137 IF ( npcbl_tot > 0 ) THEN 10138 10139 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start, & 10140 global_end ) 10141 CALL wrd_mpi_io( 'npcbl_global_start', global_start ) 10142 CALL wrd_mpi_io( 'npcbl_global_end', global_end ) 10143 10144 IF ( data_to_write ) THEN 10145 10146 ALLOCATE( tmp(SIZE(dsitransc,2),SIZE(dsitransc,1)) ) 10147 tmp = TRANSPOSE( dsitransc ) 10148 CALL wrd_mpi_io_surface( 'dsitransc', tmp ) 10149 DEALLOCATE( tmp ) 9634 10150 ENDIF 9635 IF ( nmrtbl > 0 ) THEN 9636 WRITE( 89 ) mrtsky 9637 WRITE( 89 ) mrtskyt 9638 WRITE( 89 ) mrtdsit 10151 ENDIF 10152 10153 IF ( nsvfl > 0 ) THEN 10154 10155 lo_no = 0 10156 DO j = 1, SIZE( svfsurf, 2 ) 10157 isurf = svfsurf(1,j) 10158 jc = surfl(iy,isurf) 10159 ic = surfl(ix,isurf) 10160 lo_no(jc,ic) = lo_no(jc,ic) + 1 10161 ENDDO 10162 10163 ind = 1 10164 DO i = nxl, nxr 10165 DO j = nys, nyn 10166 start_index(j,i) = ind 10167 end_index(j,i) = start_index(j,i) + lo_no(j,i) - 1 10168 ind = ind+lo_no(j,i) 10169 ENDDO 10170 ENDDO 10171 10172 ELSE 10173 10174 start_index = 1 10175 end_index = 0 10176 ENDIF 10177 10178 IF ( nsvfl_tot > 0 ) THEN 10179 10180 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start, & 10181 global_end ) 10182 CALL wrd_mpi_io( 'nsvfl_global_start', global_start ) 10183 CALL wrd_mpi_io( 'nsvfl_global_end', global_end ) 10184 10185 IF ( data_to_write ) THEN 10186 10187 CALL wrd_mpi_io_surface( 'svf', svf ) 10188 ALLOCATE( tmp(SIZE(svfsurf,1),SIZE(svfsurf,2)) ) 10189 tmp(:,:) = svfsurf(:,:) 10190 CALL wrd_mpi_io_surface( 'svfsurf', tmp ) 10191 DEALLOCATE( tmp ) 10192 9639 10193 ENDIF 9640 IF ( nmrtf > 0 ) THEN 9641 WRITE( 89 ) mrtf 9642 WRITE( 89 ) mrtft 9643 WRITE( 89 ) mrtfsurf 10194 10195 ENDIF 10196 10197 IF ( plant_canopy ) THEN 10198 10199 lo_no = 0 10200 IF ( ncsfl > 0 ) THEN 10201 10202 DO j = 1, ncsfl 10203 ipcgb = csfsurf(1, j) 10204 jc = pcbl(iy,ipcgb) 10205 ic = pcbl(ix,ipcgb) 10206 lo_no(jc,ic) = lo_no(jc,ic) + 1 10207 ENDDO 10208 10209 ind = 1 10210 DO i = nxl, nxr 10211 DO j = nys, nyn 10212 start_index(j,i) = ind 10213 end_index(j,i) = start_index(j,i) + lo_no(j,i) - 1 10214 ind = ind+lo_no(j,i) 10215 ENDDO 10216 ENDDO 10217 10218 ELSE 10219 10220 start_index = 1 10221 end_index = -1 10222 9644 10223 ENDIF 9645 ! 9646 !-- Close binary file 9647 CALL close_file( 89 ) 9648 9649 ENDIF 9650 #if defined( __parallel ) 9651 CALL MPI_BARRIER( comm2d, ierr ) 9652 #endif 9653 ENDDO 9654 9655 CALL location_message( 'writing view factors for radiation interaction', 'finished' ) 9656 10224 10225 IF ( ncsfl_tot > 0 ) THEN 10226 10227 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start,& 10228 global_end ) 10229 CALL wrd_mpi_io( 'ncsfl_global_start', global_start ) 10230 CALL wrd_mpi_io( 'ncsfl_global_end', global_end ) 10231 10232 IF ( data_to_write ) THEN 10233 10234 IF ( ALLOCATED( csf ) ) THEN 10235 CALL wrd_mpi_io_surface( 'csf', csf ) 10236 ELSE 10237 ALLOCATE( tmp(ndcsf,0) ) 10238 CALL wrd_mpi_io_surface( 'csf', tmp ) 10239 DEALLOCATE( tmp ) 10240 ENDIF 10241 10242 IF ( ALLOCATED( csfsurf ) ) THEN 10243 ALLOCATE( tmp(SIZE(csfsurf,1),SIZE(csfsurf,2)) ) 10244 tmp(:,:) = csfsurf(:,:) 10245 CALL wrd_mpi_io_surface( 'csfsurf', tmp ) 10246 DEALLOCATE( tmp ) 10247 ELSE 10248 ALLOCATE( tmp(idcsf,ncsfl) ) 10249 CALL wrd_mpi_io_surface( 'csfsurf', tmp ) 10250 DEALLOCATE( tmp ) 10251 ENDIF 10252 10253 ENDIF 10254 10255 ENDIF 10256 10257 ENDIF 10258 10259 IF ( nmrtbl > 0 ) THEN 10260 10261 lo_no = 0 10262 DO j = 1, nmrtbl 10263 jc = mrtbl(iy,j) 10264 ic = mrtbl(ix,j) 10265 lo_no(jc,ic) = lo_no(jc,ic) + 1 10266 ENDDO 10267 10268 ind = 1 10269 DO i = nxl, nxr 10270 DO j = nys, nyn 10271 start_index(j,i) = ind 10272 end_index(j,i) = start_index(j,i) + lo_no(j,i) - 1 10273 ind = ind+lo_no(j,i) 10274 ENDDO 10275 ENDDO 10276 10277 ELSE 10278 10279 start_index = 1 10280 end_index = 0 10281 ENDIF 10282 10283 IF ( nmrtbl_tot > 0 ) THEN 10284 10285 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start, & 10286 global_end ) 10287 CALL wrd_mpi_io( 'nmrtbl_global_start', global_start ) 10288 CALL wrd_mpi_io( 'nmrtbl_global_end', global_end ) 10289 10290 IF ( data_to_write ) THEN 10291 10292 CALL wrd_mpi_io_surface( 'mrtsky', mrtsky ) 10293 CALL wrd_mpi_io_surface( 'mrtskyt', mrtskyt ) 10294 ALLOCATE( tmp(SIZE(mrtdsit,2),SIZE(mrtdsit,1)) ) 10295 tmp = TRANSPOSE( mrtdsit ) 10296 CALL wrd_mpi_io_surface( 'mrtdsit', tmp ) 10297 DEALLOCATE( tmp ) 10298 10299 ENDIF 10300 10301 ENDIF 10302 10303 IF ( nmrtf > 0 ) THEN 10304 10305 lo_no = 0 10306 DO j = 1, nmrtf 10307 isurf = mrtfsurf(1,j) 10308 jc = surfl(iy,isurf) 10309 ic = surfl(ix,isurf) 10310 lo_no(jc,ic) = lo_no(jc,ic) + 1 10311 ENDDO 10312 10313 ind = 1 10314 DO i = nxl, nxr 10315 DO j = nys, nyn 10316 start_index(j,i) = ind 10317 end_index(j,i) = start_index(j,i) + lo_no(j,i) - 1 10318 ind = ind+lo_no(j,i) 10319 ENDDO 10320 ENDDO 10321 10322 ELSE 10323 start_index = 1 10324 end_index = 0 10325 ENDIF 10326 10327 IF ( nmrtf_tot > 0 ) THEN 10328 10329 CALL rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start, & 10330 global_end) 10331 CALL wrd_mpi_io( 'nmrtf_global_start', global_start ) 10332 CALL wrd_mpi_io( 'nmrtf_global_end', global_end ) 10333 10334 IF ( data_to_write ) THEN 10335 10336 CALL wrd_mpi_io_surface ( 'mrtf', mrtf ) 10337 CALL wrd_mpi_io_surface ( 'mrtft', mrtft ) 10338 10339 ALLOCATE( tmp(SIZE(mrtfsurf,1),SIZE(mrtfsurf,2)) ) 10340 tmp = mrtfsurf 10341 CALL wrd_mpi_io_surface( 'mrtfsurf', tmp ) 10342 DEALLOCATE( tmp ) 10343 10344 ENDIF 10345 10346 ENDIF 10347 10348 CALL rd_mpi_io_close 10349 10350 CALL location_message( 'writing sky view factors for radiation interaction ' // & 10351 '(MPI-IO format)', 'finished' ) 10352 ENDIF 9657 10353 9658 10354 END SUBROUTINE radiation_write_svf
Note: See TracChangeset
for help on using the changeset viewer.
