Ignore:
Timestamp:
Jul 1, 2019 2:05:51 PM (5 years ago)
Author:
Giersch
Message:

Bugfix for masked output, compiler warning removed, test case for wind turbine model revised

File:
1 edited

Legend:

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

    r4039 r4069  
    2525! -----------------
    2626! $Id$
     27! Masked output running index mid has been introduced as a local variable to
     28! avoid runtime error (Loop variable has been modified) in time_integration
     29!
     30! 4039 2019-06-18 10:32:41Z suehring
    2731! Modularize diagnostic output
    2832!
     
    156160!> Masked data output in netCDF format for current mask (current value of mid).
    157161!------------------------------------------------------------------------------!
    158  SUBROUTINE data_output_mask( av )
     162 SUBROUTINE data_output_mask( av, mid )
    159163
    160164 
     
    180184               mask_j, mask_k, mask_size, mask_size_l, mask_start_l,           &
    181185               mask_surface,                                                   &
    182                max_masks, message_string, mid, nz_do3d, salsa,                 &
     186               max_masks, message_string, nz_do3d, salsa,                      &
    183187               time_since_reference_point
    184188
     
    229233    INTEGER(iwp) ::  k                       !< loop index
    230234    INTEGER(iwp) ::  kk                      !< vertical index
     235    INTEGER(iwp) ::  mid                     !< masked output running index
    231236    INTEGER(iwp) ::  n                       !< loop index
    232237    INTEGER(iwp) ::  netcdf_data_format_save !< value of netcdf_data_format
     
    686691             IF ( radiation )  THEN
    687692                CALL radiation_data_output_mask(av, domask(mid,av,ivar), found,&
    688                                                 local_pf )
     693                                                local_pf, mid )
    689694             ENDIF
    690695
    691696             IF ( air_chemistry )  THEN
    692697                CALL chem_data_output_mask(av, domask(mid,av,ivar), found,     &
    693                                            local_pf )
     698                                           local_pf, mid )
    694699             ENDIF
    695700!
    696701!--          Check for diagnostic quantities
    697              CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf )
     702             CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf,   &
     703                                   mid)
    698704!
    699705!--          SALSA quantities
    700706             IF (  salsa )  THEN
    701707                CALL salsa_data_output_mask( av, domask(mid,av,ivar), found,   &
    702                                              local_pf )
     708                                             local_pf, mid )
    703709             ENDIF         
    704710!
     
    706712             IF ( .NOT. found )  THEN
    707713                CALL user_data_output_mask(av, domask(mid,av,ivar), found,     &
    708                                            local_pf )
     714                                           local_pf, mid )
    709715             ENDIF
    710716
Note: See TracChangeset for help on using the changeset viewer.