Changeset 3016 for palm/trunk/SOURCE


Ignore:
Timestamp:
May 9, 2018 10:53:37 AM (7 years ago)
Author:
Giersch
Message:

Dollar sign added before Id; Revised structure of reading svf data according to PALM coding standard: svf_code_field/len and fsvf removed, error messages PA0493 and PA0494 added, allocation status of output arrays checked

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

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

    r3013 r3016  
    2424! Former revisions:
    2525! -----------------
    26 ! Id: pres.f90 2696 2017-12-14 17:12:51Z kanani $
     26! $Id$
     27! Dollar sign added before Id
     28!
     29! 2696 2017-12-14 17:12:51Z kanani
    2730! To avoid jumps while plotting w-profiles w level nzt+1 is set to w level nzt
    2831! after velocity modifications through the pressure solver were carried out
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r3014 r3016  
    2828! -----------------
    2929! $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
    3035! Introduced plant canopy height similar to urban canopy height to limit
    3136! the memory requirement to allocate lad.
     
    728733    INTEGER(iwp)                                   ::  nrefsteps = 0                      !< number of reflection steps to perform
    729734    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 file
    731     CHARACTER(svf_code_len), PARAMETER             ::  svf_code = '*** end svf ***'       !< code for verification of the end of svf file
    732735    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 files
     736    CHARACTER(rad_version_len), PARAMETER          ::  rad_version = 'RAD v. 1.1'         !< identification of version of binary svf and restart files
    734737    INTEGER(iwp)                                   ::  raytrace_discrete_elevs = 40       !< number of discretization steps for elevation (nadir to zenith)
    735738    INTEGER(iwp)                                   ::  raytrace_discrete_azims = 80       !< number of discretization steps for azimuth (out of 360 degrees)
     
    67536756    SUBROUTINE radiation_read_svf
    67546757
    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
    67886786             
    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
    68126800             
    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 )
    68316873               
    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
    68416875#if defined( __parallel )
    6842            CALL MPI_BARRIER( comm2d, ierr )
     6876          CALL MPI_BARRIER( comm2d, ierr )
    68436877#endif
    6844         ENDDO
     6878       ENDDO
    68456879
    68466880    END SUBROUTINE radiation_read_svf
     
    68556889    SUBROUTINE radiation_write_svf
    68566890
    6857         IMPLICIT NONE
    6858         INTEGER(iwp)        :: fsvf = 89
    6859         INTEGER(iwp)        :: i
    6860 
    6861         DO  i = 0, io_blocks-1
    6862             IF ( i == io_group )  THEN
     6891       IMPLICIT NONE
     6892       
     6893       INTEGER(iwp)        :: i
     6894
     6895       DO  i = 0, io_blocks-1
     6896          IF ( i == io_group )  THEN
    68636897!
    68646898!--          Open binary file
    6865              CALL check_open( fsvf )
    6866 
    6867                 WRITE ( fsvf )  rad_version
    6868                 WRITE ( fsvf )  nsvfl, ncsfl, nsurfl, npcbl, ndsidir
    6869                 IF ( nsurfl > 0 ) THEN
    6870                    WRITE ( fsvf )  skyvf
    6871                    WRITE ( fsvf )  skyvft
    6872                    WRITE ( fsvf )  dsitrans
    6873                 ENDIF
    6874                 IF ( npcbl > 0 ) THEN
    6875                    WRITE ( fsvf )  dsitransc
    6876                 ENDIF
    6877                 IF ( nsvfl > 0 ) THEN
    6878                    WRITE ( fsvf )  svf
    6879                    WRITE ( fsvf )  svfsurf
    6880                 ENDIF
    6881                 IF ( plant_canopy  .AND.  ncsfl > 0 )  THEN
    6882                     WRITE ( fsvf )  csf
    6883                     WRITE ( fsvf )  csfsurf
    6884                 ENDIF
    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
    68866920!
    68876921!--          Close binary file                 
    6888              CALL close_file( fsvf )
     6922             CALL close_file( 89 )
    68896923
    68906924          ENDIF
    68916925#if defined( __parallel )
    6892                 CALL MPI_BARRIER( comm2d, ierr )
     6926          CALL MPI_BARRIER( comm2d, ierr )
    68936927#endif
    6894         ENDDO
     6928       ENDDO
    68956929    END SUBROUTINE radiation_write_svf
    68966930
Note: See TracChangeset for help on using the changeset viewer.