Changeset 2906 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Mar 19, 2018 8:56:40 AM (7 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r2894 r2906 25 25 ! ----------------- 26 26 ! $Id$ 27 ! NAMELIST paramter read/write_svf_on_init have been removed, functions 28 ! check_open and close_file are used now for opening/closing files related to 29 ! svf data, adjusted unit number and error numbers 30 ! 31 ! 2894 2018-03-15 09:17:58Z Giersch 27 32 ! Calculations of the index range of the subdomain on file which overlaps with 28 33 ! the current subdomain are already done in read_restart_data_mod … … 650 655 LOGICAL :: energy_balance_surf_h = .TRUE. !< flag parameter indicating wheather the energy balance is calculated for horizontal surfaces 651 656 LOGICAL :: energy_balance_surf_v = .TRUE. !< flag parameter indicating wheather the energy balance is calculated for vertical surfaces 652 LOGICAL :: read_svf_on_init = .FALSE. !< flag parameter indicating wheather SVFs will be read from a file at initialization653 LOGICAL :: write_svf_on_init = .FALSE. !< flag parameter indicating wheather SVFs will be written out to a file654 657 LOGICAL :: mrt_factors = .FALSE. !< whether to generate MRT factor files during init 655 658 INTEGER(iwp) :: nrefsteps = 0 !< number of reflection steps to perform … … 885 888 zenith, calc_zenith, sun_direction, sun_dir_lat, sun_dir_lon, & 886 889 split_diffusion_radiation, & 887 energy_balance_surf_h, energy_balance_surf_v, write_svf_on_init,&888 read_svf_on_init, nrefsteps, mrt_factors, dist_max_svf, nsvfl, svf,&890 energy_balance_surf_h, energy_balance_surf_v, & 891 nrefsteps, mrt_factors, dist_max_svf, nsvfl, svf, & 889 892 svfsurf, surfinsw, surfinlw, surfins, surfinl, surfinswdir, & 890 893 surfinswdif, surfoutsw, surfoutlw, surfinlwdif, rad_sw_in_dir, & … … 2801 2804 energy_balance_surf_h, & 2802 2805 energy_balance_surf_v, & 2803 read_svf_on_init, &2804 2806 nrefsteps, & 2805 write_svf_on_init, &2806 2807 mrt_factors, & 2807 2808 dist_max_svf, & … … 6612 6613 SUBROUTINE radiation_read_svf 6613 6614 6614 IMPLICIT NONE 6615 INTEGER(iwp) :: fsvf = 89 6616 INTEGER(iwp) :: i 6617 CHARACTER(usm_version_len) :: usm_version_field 6618 CHARACTER(svf_code_len) :: svf_code_field 6619 6620 DO i = 0, io_blocks-1 6621 IF ( i == io_group ) THEN 6622 OPEN ( fsvf, FILE='SVFIN'//TRIM(coupling_char)//'/'//myid_char,& 6623 form='unformatted', status='old' ) 6624 6625 !-- read and check version 6626 READ ( fsvf ) usm_version_field 6627 IF ( TRIM(usm_version_field) /= TRIM(usm_version) ) THEN 6628 WRITE( message_string, * ) 'Version of binary SVF file "', & 6629 TRIM(usm_version_field), '" does not match ', & 6630 'the version of model "', TRIM(usm_version), '"' 6631 CALL message( 'radiation_read_svf', 'UI0012', 1, 2, 0, 6, 0 ) 6632 ENDIF 6615 IMPLICIT NONE 6616 INTEGER(iwp) :: fsvf = 88 6617 INTEGER(iwp) :: i 6618 CHARACTER(usm_version_len) :: usm_version_field 6619 CHARACTER(svf_code_len) :: svf_code_field 6620 6621 DO i = 0, io_blocks-1 6622 IF ( i == io_group ) THEN 6623 6624 ! 6625 !-- Open binary file 6626 CALL check_open( fsvf ) 6627 6628 6629 !-- read and check version 6630 READ ( fsvf ) usm_version_field 6631 IF ( TRIM(usm_version_field) /= TRIM(usm_version) ) THEN 6632 WRITE( message_string, * ) 'Version of binary SVF file "', & 6633 TRIM(usm_version_field), '" does not match ', & 6634 'the version of model "', TRIM(usm_version), '"' 6635 CALL message( 'radiation_read_svf', 'PA0482', 1, 2, 0, 6, 0 ) 6636 ENDIF 6633 6637 6634 !-- 6635 6636 6637 6638 CALL message( 'radiation_read_svf', 'UI0012', 1, 2, 0, 6, 0 )6639 6640 6641 6642 6638 !-- read nsvfl, ncsfl 6639 READ ( fsvf ) nsvfl, ncsfl 6640 IF ( nsvfl <= 0 .OR. ncsfl < 0 ) THEN 6641 WRITE( message_string, * ) 'Wrong number of SVF or CSF' 6642 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 ) 6643 ELSE 6644 WRITE(message_string,*) ' Number of SVF and CSF to read', nsvfl, ncsfl 6645 CALL location_message( message_string, .TRUE. ) 6646 ENDIF 6643 6647 6644 ALLOCATE(svf(ndsvf,nsvfl)) 6645 ALLOCATE(svfsurf(idsvf,nsvfl)) 6646 READ(fsvf) svf 6647 READ(fsvf) svfsurf 6648 IF ( plant_canopy ) THEN 6649 ALLOCATE(csf(ndcsf,ncsfl)) 6650 ALLOCATE(csfsurf(idcsf,ncsfl)) 6651 READ(fsvf) csf 6652 READ(fsvf) csfsurf 6653 ENDIF 6654 READ ( fsvf ) svf_code_field 6648 ALLOCATE(svf(ndsvf,nsvfl)) 6649 ALLOCATE(svfsurf(idsvf,nsvfl)) 6650 6651 READ(fsvf) svf 6652 READ(fsvf) svfsurf 6653 6654 IF ( plant_canopy ) THEN 6655 ALLOCATE(csf(ndcsf,ncsfl)) 6656 ALLOCATE(csfsurf(idcsf,ncsfl)) 6657 READ(fsvf) csf 6658 READ(fsvf) csfsurf 6659 ENDIF 6660 6661 READ ( fsvf ) svf_code_field 6662 IF ( TRIM(svf_code_field) /= TRIM(svf_code) ) THEN 6663 WRITE( message_string, * ) 'Wrong structure of binary svf file' 6664 CALL message( 'radiation_read_svf', 'PA0484', 1, 2, 0, 6, 0 ) 6665 ENDIF 6655 6666 6656 IF ( TRIM(svf_code_field) /= TRIM(svf_code) ) THEN 6657 WRITE( message_string, * ) 'Wrong structure of binary svf file' 6658 CALL message( 'radiation_read_svf', 'UI0012', 1, 2, 0, 6, 0 ) 6659 ENDIF 6667 ! 6668 !-- Close binary file 6669 CALL close_file( fsvf ) 6660 6670 6661 CLOSE (fsvf) 6662 6663 ENDIF 6671 ENDIF 6664 6672 #if defined( __parallel ) 6665 6673 CALL MPI_BARRIER( comm2d, ierr ) 6666 6674 #endif 6667 6675 ENDDO 6668 6676 6669 6677 END SUBROUTINE radiation_read_svf … … 6678 6686 SUBROUTINE radiation_write_svf 6679 6687 6680 IMPLICIT NONE 6681 INTEGER(iwp) :: fsvf = 89 6682 INTEGER(iwp) :: i 6683 6684 DO i = 0, io_blocks-1 6685 IF ( i == io_group ) THEN 6686 OPEN ( fsvf, FILE='SVFOUT'//TRIM( coupling_char )//'/'//myid_char, & 6687 form='unformatted', status='new' ) 6688 6689 WRITE ( fsvf ) usm_version 6690 WRITE ( fsvf ) nsvfl, ncsfl 6691 WRITE ( fsvf ) svf 6692 WRITE ( fsvf ) svfsurf 6693 IF ( plant_canopy ) THEN 6694 WRITE ( fsvf ) csf 6695 WRITE ( fsvf ) csfsurf 6696 ENDIF 6697 WRITE ( fsvf ) TRIM(svf_code) 6698 6699 CLOSE (fsvf) 6688 6689 IMPLICIT NONE 6690 6691 INTEGER(iwp) :: fsvf = 89 6692 INTEGER(iwp) :: i 6693 6694 6695 DO i = 0, io_blocks-1 6696 IF ( i == io_group ) THEN 6697 6698 ! 6699 !-- Open binary file 6700 CALL check_open( fsvf ) 6701 6702 WRITE ( fsvf ) usm_version 6703 WRITE ( fsvf ) nsvfl, ncsfl 6704 WRITE ( fsvf ) svf 6705 WRITE ( fsvf ) svfsurf 6706 IF ( plant_canopy ) THEN 6707 WRITE ( fsvf ) csf 6708 WRITE ( fsvf ) csfsurf 6709 ENDIF 6710 WRITE ( fsvf ) TRIM(svf_code) 6711 6712 ! 6713 !-- Close binary file 6714 CALL close_file( fsvf ) 6715 6716 ENDIF 6700 6717 #if defined( __parallel ) 6701 6718 CALL MPI_BARRIER( comm2d, ierr ) 6702 6719 #endif 6703 ENDIF 6704 ENDDO 6720 ENDDO 6705 6721 6706 6722 END SUBROUTINE radiation_write_svf
Note: See TracChangeset
for help on using the changeset viewer.
