Changeset 3016 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- May 9, 2018 10:53:37 AM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r3014 r3016 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Revised structure of reading svf data according to PALM coding standard: 31 ! svf_code_field/len and fsvf removed, error messages PA0493 and PA0494 added, 32 ! allocation status of output arrays checked. 33 ! 34 ! 3014 2018-05-09 08:42:38Z maronga 30 35 ! Introduced plant canopy height similar to urban canopy height to limit 31 36 ! the memory requirement to allocate lad. … … 728 733 INTEGER(iwp) :: nrefsteps = 0 !< number of reflection steps to perform 729 734 REAL(wp), PARAMETER :: ext_coef = 0.6_wp !< extinction coefficient (a.k.a. alpha) 730 INTEGER(iwp), PARAMETER :: svf_code_len = 15 !< length of code for verification of the end of svf file731 CHARACTER(svf_code_len), PARAMETER :: svf_code = '*** end svf ***' !< code for verification of the end of svf file732 735 INTEGER(iwp), PARAMETER :: rad_version_len = 10 !< length of identification string of rad version 733 CHARACTER(rad_version_len), PARAMETER :: rad_version = 'RAD v. 1. 0' !< identification of version of binary svf and restart files736 CHARACTER(rad_version_len), PARAMETER :: rad_version = 'RAD v. 1.1' !< identification of version of binary svf and restart files 734 737 INTEGER(iwp) :: raytrace_discrete_elevs = 40 !< number of discretization steps for elevation (nadir to zenith) 735 738 INTEGER(iwp) :: raytrace_discrete_azims = 80 !< number of discretization steps for azimuth (out of 360 degrees) … … 6753 6756 SUBROUTINE radiation_read_svf 6754 6757 6755 IMPLICIT NONE 6756 INTEGER(iwp) :: fsvf = 88 6757 INTEGER(iwp) :: i 6758 INTEGER(iwp) :: nsurfl_from_file = 0 6759 CHARACTER(rad_version_len) :: rad_version_field 6760 CHARACTER(svf_code_len) :: svf_code_field 6761 6762 DO i = 0, io_blocks-1 6763 IF ( i == io_group ) THEN 6764 6765 IF ( initializing_actions == 'read_restart_data' ) THEN 6766 6767 IF ( numprocs_previous_run /= numprocs ) THEN 6768 WRITE( message_string, * ) 'A different number of processors', & 6769 ' between the run that has written', & 6770 ' the svf data and the one that will', & 6771 ' read it is not allowed' 6772 CALL message( 'check_open', 'PA0491', 1, 2, 0, 6, 0 ) 6773 ENDIF 6774 6775 ENDIF 6776 ! 6777 !-- Open binary file 6778 CALL check_open( fsvf ) 6779 6780 !-- read and check version 6781 READ ( fsvf ) rad_version_field 6782 IF ( TRIM(rad_version_field) /= TRIM(rad_version) ) THEN 6783 WRITE( message_string, * ) 'Version of binary SVF file "', & 6784 TRIM(rad_version_field), '" does not match ', & 6785 'the version of model "', TRIM(rad_version), '"' 6786 CALL message( 'radiation_read_svf', 'PA0482', 1, 2, 0, 6, 0 ) 6787 ENDIF 6758 IMPLICIT NONE 6759 6760 CHARACTER(rad_version_len) :: rad_version_field 6761 6762 INTEGER(iwp) :: i 6763 INTEGER(iwp) :: ndsidir_from_file = 0 6764 INTEGER(iwp) :: npcbl_from_file = 0 6765 INTEGER(iwp) :: nsurfl_from_file = 0 6766 6767 DO i = 0, io_blocks-1 6768 IF ( i == io_group ) THEN 6769 6770 ! 6771 !-- numprocs_previous_run is only known in case of reading restart 6772 !-- data. If a new initial run which reads svf data is started the 6773 !-- following query will be skipped 6774 IF ( initializing_actions == 'read_restart_data' ) THEN 6775 6776 IF ( numprocs_previous_run /= numprocs ) THEN 6777 WRITE( message_string, * ) 'A different number of ', & 6778 'processors between the run ', & 6779 'that has written the svf data ',& 6780 'and the one that will read it ',& 6781 'is not allowed' 6782 CALL message( 'check_open', 'PA0491', 1, 2, 0, 6, 0 ) 6783 ENDIF 6784 6785 ENDIF 6788 6786 6789 !-- read nsvfl, ncsfl 6790 READ ( fsvf ) nsvfl, ncsfl, nsurfl_from_file, npcbl, ndsidir 6791 IF ( nsvfl < 0 .OR. ncsfl < 0 ) THEN 6792 WRITE( message_string, * ) 'Wrong number of SVF or CSF' 6793 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 ) 6794 ELSE 6795 WRITE(message_string,*) ' Number of SVF, CSF, and nsurfl to read '& 6796 , nsvfl, ncsfl, nsurfl 6797 CALL location_message( message_string, .TRUE. ) 6798 ENDIF 6799 IF ( nsurfl_from_file /= nsurfl ) THEN 6800 WRITE( message_string, * ) 'nsurfl from SVF file does not ', & 6801 'match calculated nsurfl from ', & 6802 'radiation_interaction_init' 6803 CALL message( 'radiation_read_svf', 'PA0490', 1, 2, 0, 6, 0 ) 6804 ENDIF 6805 IF ( nsurfl > 0 ) THEN 6806 IF ( .NOT. ALLOCATED( skyvf ) ) ALLOCATE( skyvf(nsurfl) ) 6807 IF ( .NOT. ALLOCATED( skyvft ) ) ALLOCATE( skyvft(nsurfl) ) 6808 READ(fsvf) skyvf 6809 READ(fsvf) skyvft 6810 READ(fsvf) dsitrans 6811 ENDIF 6787 ! 6788 !-- Open binary file 6789 CALL check_open( 88 ) 6790 6791 ! 6792 !-- read and check version 6793 READ ( 88 ) rad_version_field 6794 IF ( TRIM(rad_version_field) /= TRIM(rad_version) ) THEN 6795 WRITE( message_string, * ) 'Version of binary SVF file "', & 6796 TRIM(rad_version_field), '" does not match ', & 6797 'the version of model "', TRIM(rad_version), '"' 6798 CALL message( 'radiation_read_svf', 'PA0482', 1, 2, 0, 6, 0 ) 6799 ENDIF 6812 6800 6813 IF ( plant_canopy .AND. npcbl > 0 ) THEN 6814 READ ( fsvf ) dsitransc 6815 ENDIF 6816 6817 IF ( nsvfl > 0 ) THEN 6818 IF ( .NOT. ALLOCATED( svf ) ) ALLOCATE( svf(ndsvf,nsvfl) ) 6819 IF ( .NOT. ALLOCATED( svfsurf ) ) ALLOCATE( svfsurf(idsvf,nsvfl) ) 6820 READ(fsvf) svf 6821 READ(fsvf) svfsurf 6822 ENDIF 6823 6824 IF ( plant_canopy .AND. ncsfl > 0 ) THEN 6825 IF ( .NOT. ALLOCATED( csf ) ) ALLOCATE( csf(ndcsf,ncsfl) ) 6826 IF ( .NOT. ALLOCATED( csfsurf ) ) ALLOCATE( csfsurf(idcsf,ncsfl) ) 6827 READ(fsvf) csf 6828 READ(fsvf) csfsurf 6829 ENDIF 6830 READ ( fsvf ) svf_code_field 6801 ! 6802 !-- read nsvfl, ncsfl, nsurfl 6803 READ ( 88 ) nsvfl, ncsfl, nsurfl_from_file, npcbl_from_file, & 6804 ndsidir_from_file 6805 6806 IF ( nsvfl < 0 .OR. ncsfl < 0 ) THEN 6807 WRITE( message_string, * ) 'Wrong number of SVF or CSF' 6808 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 ) 6809 ELSE 6810 WRITE(message_string,*) ' Number of SVF, CSF, and nsurfl ',& 6811 'to read', nsvfl, ncsfl, & 6812 nsurfl_from_file 6813 CALL location_message( message_string, .TRUE. ) 6814 ENDIF 6815 6816 IF ( nsurfl_from_file /= nsurfl ) THEN 6817 WRITE( message_string, * ) 'nsurfl from SVF file does not ', & 6818 'match calculated nsurfl from ', & 6819 'radiation_interaction_init' 6820 CALL message( 'radiation_read_svf', 'PA0490', 1, 2, 0, 6, 0 ) 6821 ENDIF 6822 6823 IF ( npcbl_from_file /= npcbl ) THEN 6824 WRITE( message_string, * ) 'npcbl from SVF file does not ', & 6825 'match calculated npcbl from ', & 6826 'radiation_interaction_init' 6827 CALL message( 'radiation_read_svf', 'PA0493', 1, 2, 0, 6, 0 ) 6828 ENDIF 6829 6830 IF ( ndsidir_from_file /= ndsidir ) THEN 6831 WRITE( message_string, * ) 'ndsidir from SVF file does not ', & 6832 'match calculated ndsidir from ', & 6833 'radiation_presimulate_solar_pos' 6834 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 ) 6835 ENDIF 6836 6837 ! 6838 !-- Arrays skyvf, skyvft, dsitrans and dsitransc are allready 6839 !-- allocated in radiation_interaction_init and 6840 !-- radiation_presimulate_solar_pos 6841 IF ( nsurfl > 0 ) THEN 6842 READ(88) skyvf 6843 READ(88) skyvft 6844 READ(88) dsitrans 6845 ENDIF 6846 6847 IF ( plant_canopy .AND. npcbl > 0 ) THEN 6848 READ ( 88 ) dsitransc 6849 ENDIF 6850 6851 ! 6852 !-- The allocation of svf, svfsurf, csf and csfsurf happens in routine 6853 !-- radiation_calc_svf which is not called if the program enters 6854 !-- radiation_read_svf. Therefore these arrays has to allocate in the 6855 !-- following 6856 IF ( nsvfl > 0 ) THEN 6857 ALLOCATE( svf(ndsvf,nsvfl) ) 6858 ALLOCATE( svfsurf(idsvf,nsvfl) ) 6859 READ(88) svf 6860 READ(88) svfsurf 6861 ENDIF 6862 6863 IF ( plant_canopy .AND. ncsfl > 0 ) THEN 6864 ALLOCATE( csf(ndcsf,ncsfl) ) 6865 ALLOCATE( csfsurf(idcsf,ncsfl) ) 6866 READ(88) csf 6867 READ(88) csfsurf 6868 ENDIF 6869 6870 ! 6871 !-- Close binary file 6872 CALL close_file( 88 ) 6831 6873 6832 IF ( TRIM(svf_code_field) /= TRIM(svf_code) ) THEN 6833 WRITE( message_string, * ) 'Wrong structure of binary svf file' 6834 CALL message( 'radiation_read_svf', 'PA0484', 1, 2, 0, 6, 0 ) 6835 ENDIF 6836 ! 6837 !-- Close binary file 6838 CALL close_file( fsvf ) 6839 6840 ENDIF 6874 ENDIF 6841 6875 #if defined( __parallel ) 6842 6876 CALL MPI_BARRIER( comm2d, ierr ) 6843 6877 #endif 6844 6878 ENDDO 6845 6879 6846 6880 END SUBROUTINE radiation_read_svf … … 6855 6889 SUBROUTINE radiation_write_svf 6856 6890 6857 6858 INTEGER(iwp) :: fsvf = 896859 6860 6861 6862 6891 IMPLICIT NONE 6892 6893 INTEGER(iwp) :: i 6894 6895 DO i = 0, io_blocks-1 6896 IF ( i == io_group ) THEN 6863 6897 ! 6864 6898 !-- Open binary file 6865 CALL check_open( fsvf)6866 6867 WRITE ( fsvf) rad_version6868 WRITE ( fsvf) nsvfl, ncsfl, nsurfl, npcbl, ndsidir6869 6870 WRITE ( fsvf) skyvf6871 WRITE ( fsvf) skyvft6872 WRITE ( fsvf) dsitrans6873 6874 6875 WRITE ( fsvf) dsitransc6876 6877 6878 WRITE ( fsvf) svf6879 WRITE ( fsvf) svfsurf6880 6881 6882 WRITE ( fsvf) csf6883 WRITE ( fsvf) csfsurf6884 6885 WRITE ( fsvf ) TRIM(svf_code) 6899 CALL check_open( 89 ) 6900 6901 WRITE ( 89 ) rad_version 6902 WRITE ( 89 ) nsvfl, ncsfl, nsurfl, npcbl, ndsidir 6903 IF ( nsurfl > 0 ) THEN 6904 WRITE ( 89 ) skyvf 6905 WRITE ( 89 ) skyvft 6906 WRITE ( 89 ) dsitrans 6907 ENDIF 6908 IF ( npcbl > 0 ) THEN 6909 WRITE ( 89 ) dsitransc 6910 ENDIF 6911 IF ( nsvfl > 0 ) THEN 6912 WRITE ( 89 ) svf 6913 WRITE ( 89 ) svfsurf 6914 ENDIF 6915 IF ( plant_canopy .AND. ncsfl > 0 ) THEN 6916 WRITE ( 89 ) csf 6917 WRITE ( 89 ) csfsurf 6918 ENDIF 6919 6886 6920 ! 6887 6921 !-- Close binary file 6888 CALL close_file( fsvf)6922 CALL close_file( 89 ) 6889 6923 6890 6924 ENDIF 6891 6925 #if defined( __parallel ) 6892 6926 CALL MPI_BARRIER( comm2d, ierr ) 6893 6927 #endif 6894 6928 ENDDO 6895 6929 END SUBROUTINE radiation_write_svf 6896 6930
Note: See TracChangeset
for help on using the changeset viewer.
