Changeset 4544 for palm/trunk


Ignore:
Timestamp:
May 21, 2020 2:43:05 PM (4 years ago)
Author:
raasch
Message:

conc_av changed from pointer to allocatable array, array spec_conc_av removed

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

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

    r4511 r4544  
    2727! -----------------
    2828! $Id$
     29! conc_av changed from pointer to allocatable array
     30!
     31! 4511 2020-04-30 12:20:40Z raasch
    2932! new variables for explicit settings of lateral boundary conditions introduced
    3033!
     
    231234       CHARACTER(LEN=15)                            ::  unit         !< unit (ppm for gases, kg m^-3 for aerosol tracers)
    232235       REAL(kind=wp), POINTER, DIMENSION(:,:,:)     ::  conc         !< concentrations of trace gases
    233        REAL(kind=wp), POINTER, DIMENSION(:,:,:)    ::  conc_av      !< averaged concentrations
     236       REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) ::  conc_av      !< averaged concentrations
    234237       REAL(kind=wp), POINTER, DIMENSION(:,:,:)     ::  conc_p       !< conc at prognostic time level
    235238       REAL(kind=wp), POINTER, DIMENSION(:,:,:)     ::  tconc_m      !< weighted tendency of conc for previous sub-timestep (Runge-Kutta)
  • palm/trunk/SOURCE/chemistry_model_mod.f90

    r4542 r4544  
    2727! -----------------
    2828! $Id$
     29! conc_av changed from pointer to allocatable array, array spec_conc_av removed
     30!
     31! 4542 2020-05-19 15:45:12Z raasch
    2932! redundant if statement removed
    3033!
     
    341344
    342345    USE restart_data_mpi_io_mod,                                                                   &
    343         ONLY:  rrd_mpi_io, wrd_mpi_io
     346        ONLY:  rrd_mpi_io, rd_mpi_io_check_array, wrd_mpi_io
    344347
    345348    USE statistics
     
    356359    REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  spec_conc_2  !< pointer for swapping of timelevels for conc
    357360    REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  spec_conc_3  !< pointer for swapping of timelevels for conc
    358     REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  spec_conc_av !< averaged concentrations of chemical species       
    359361    REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET ::  freq_1       !< pointer for phtolysis frequncies
    360362                                                                            !< (only 1 timelevel required)
     
    646648             IF ( TRIM( variable(1:3) ) == 'kc_' .AND. &
    647649                  TRIM( variable(4:) ) == TRIM( chem_species(lsp)%name ) )  THEN
    648                 chem_species(lsp)%conc_av = 0.0_wp
     650                IF ( .NOT. ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
     651                   ALLOCATE( chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     652                   chem_species(lsp)%conc_av = 0.0_wp
     653                ENDIF
    649654             ENDIF
    650655          ENDDO
     
    19511956    ALLOCATE( spec_conc_2 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
    19521957    ALLOCATE( spec_conc_3 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
    1953     ALLOCATE( spec_conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
    19541958    ALLOCATE( phot_frequen(nphot) )
    19551959    ALLOCATE( freq_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nphot) )
     
    19601964    spec_conc_2 (:,:,:,:) = 0.0_wp
    19611965    spec_conc_3 (:,:,:,:) = 0.0_wp
    1962     spec_conc_av(:,:,:,:) = 0.0_wp
    19631966
    19641967
     
    19691972       chem_species(lsp)%conc_p (nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_2 (:,:,:,lsp)
    19701973       chem_species(lsp)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_3 (:,:,:,lsp)
    1971        chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_av(:,:,:,lsp)     
    19721974
    19731975       ALLOCATE (chem_species(lsp)%cssws_av(nysg:nyng,nxlg:nxrg))                   
     
    30993101       ELSEIF (restart_string(1:length) == TRIM( chem_species(lsp)%name ) // '_av' )  THEN
    31003102
     3103          IF ( .NOT. ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
     3104             ALLOCATE( chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ) )
     3105          ENDIF
    31013106          IF ( k == 1 )  READ ( 13 )  tmp_3d
    31023107          chem_species(lsp)%conc_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                   &
     
    31233128    INTEGER(iwp) ::  lsp  !<
    31243129
     3130    LOGICAL      ::  array_found  !<
     3131
    31253132
    31263133    DO  lsp = 1, nspec
    31273134
    31283135       CALL rrd_mpi_io( TRIM( chem_species(lsp)%name ), chem_species(lsp)%conc )
    3129        CALL rrd_mpi_io( TRIM( chem_species(lsp)%name )//'_av', chem_species(lsp)%conc_av )
     3136
     3137       CALL rd_mpi_io_check_array( TRIM( chem_species(lsp)%name )//'_av' , found = array_found )
     3138       IF ( array_found )  THEN
     3139          IF ( .NOT. ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
     3140             ALLOCATE( chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     3141          ENDIF
     3142          CALL rrd_mpi_io( TRIM( chem_species(lsp)%name )//'_av', chem_species(lsp)%conc_av )
     3143       ENDIF
    31303144
    31313145    ENDDO
     
    32393253          CALL wrd_write_string( TRIM( chem_species(lsp)%name ) )
    32403254          WRITE ( 14 )  chem_species(lsp)%conc
    3241           CALL wrd_write_string( TRIM( chem_species(lsp)%name )//'_av' )
    3242           WRITE ( 14 )  chem_species(lsp)%conc_av
     3255          IF ( ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
     3256             CALL wrd_write_string( TRIM( chem_species(lsp)%name )//'_av' )
     3257             WRITE ( 14 )  chem_species(lsp)%conc_av
     3258          ENDIF
    32433259       ENDDO
    32443260
     
    32473263       DO  lsp = 1, nspec
    32483264          CALL wrd_mpi_io( TRIM( chem_species(lsp)%name ), chem_species(lsp)%conc )
    3249           CALL wrd_mpi_io( TRIM( chem_species(lsp)%name ) // '_av', chem_species(lsp)%conc_av )
     3265          IF ( ALLOCATED( chem_species(lsp)%conc_av ) )  THEN
     3266             CALL wrd_mpi_io( TRIM( chem_species(lsp)%name ) // '_av', chem_species(lsp)%conc_av )
     3267          ENDIF
    32503268       ENDDO
    32513269
Note: See TracChangeset for help on using the changeset viewer.