Ignore:
Timestamp:
May 19, 2020 3:45:12 PM (4 years ago)
Author:
raasch
Message:

files re-formatted to follow the PALM coding standard, redundant if statement removed

File:
1 edited

Legend:

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

    r4535 r4542  
    2727! -----------------
    2828! $Id$
     29! redundant if statement removed
     30!
     31! 4535 2020-05-15 12:07:23Z raasch
    2932! bugfix for restart data format query
    3033!
     
    30623065
    30633066
    3064     CHARACTER (LEN=20) :: spc_name_av !<   
    3065 
    30663067    INTEGER(iwp) ::  lsp             !<
    30673068    INTEGER(iwp) ::  k               !<
     
    30873088
    30883089
    3089     IF ( ALLOCATED( chem_species ) )  THEN
    3090 
    3091        DO  lsp = 1, nspec
    3092 
    3093           !< for time-averaged chemical conc.
    3094           spc_name_av  =  TRIM( chem_species(lsp)%name )//'_av'
    3095 
    3096           IF ( restart_string(1:length) == TRIM( chem_species(lsp)%name) )    &
    3097              THEN
    3098              !< read data into tmp_3d
    3099              IF ( k == 1 )  READ ( 13 )  tmp_3d 
    3100              !< fill ..%conc in the restart run   
    3101              chem_species(lsp)%conc(:,nysc-nbgp:nync+nbgp,                    &
    3102                   nxlc-nbgp:nxrc+nbgp) =                  &
    3103                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    3104              found = .TRUE.
    3105           ELSEIF (restart_string(1:length) == spc_name_av )  THEN
    3106              IF ( k == 1 )  READ ( 13 )  tmp_3d
    3107              chem_species(lsp)%conc_av(:,nysc-nbgp:nync+nbgp,                 &
    3108                   nxlc-nbgp:nxrc+nbgp) =               &
    3109                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    3110              found = .TRUE.
    3111           ENDIF
    3112 
    3113        ENDDO
    3114 
    3115     ENDIF
     3090    DO  lsp = 1, nspec
     3091
     3092       IF ( restart_string(1:length) == TRIM( chem_species(lsp)%name) )  THEN
     3093
     3094          IF ( k == 1 )  READ ( 13 )  tmp_3d
     3095          chem_species(lsp)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                      &
     3096                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
     3097          found = .TRUE.
     3098
     3099       ELSEIF (restart_string(1:length) == TRIM( chem_species(lsp)%name ) // '_av' )  THEN
     3100
     3101          IF ( k == 1 )  READ ( 13 )  tmp_3d
     3102          chem_species(lsp)%conc_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                   &
     3103                                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
     3104          found = .TRUE.
     3105
     3106       ENDIF
     3107
     3108    ENDDO
    31163109
    31173110
     
    31283121    IMPLICIT NONE
    31293122
    3130     INTEGER(iwp) ::  lsp !<
    3131 
    3132     IF ( ALLOCATED( chem_species ) )  THEN
    3133 
    3134        DO  lsp = 1, nspec
    3135 
    3136           CALL rrd_mpi_io( TRIM( chem_species(lsp)%name ), chem_species(lsp)%conc )
    3137           CALL rrd_mpi_io( TRIM( chem_species(lsp)%name )//'_av', chem_species(lsp)%conc_av )
    3138 
    3139        ENDDO
    3140 
    3141     ENDIF
     3123    INTEGER(iwp) ::  lsp  !<
     3124
     3125
     3126    DO  lsp = 1, nspec
     3127
     3128       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 )
     3130
     3131    ENDDO
    31423132
    31433133 END SUBROUTINE chem_rrd_local_mpi
Note: See TracChangeset for help on using the changeset viewer.