Ignore:
Timestamp:
Feb 12, 2019 9:52:40 AM (5 years ago)
Author:
dom_dwd_user
Message:

biometeorology_mod.f90:
(N) Fixed auto-setting of thermal index calculation flags by output as
originally proposed by resler.
(C) removed bio_pet and outher configuration variables.
(C) Updated namelist.
(B) Forcing initialization of tmrt_av_grid to avoid mysterious mrt
values at i==0, j==0

module_interface_mod.f90:
(C) Receiving parameter j (averaging 0==.F./1==.T.) in
module_interface_check_data_output from check_parameters.f90.
(C) Passing j to bio_check_parameters.

check_parameters.f90:
(C) Passing j to module_interface_check_data_output

File:
1 edited

Legend:

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

    r3731 r3735  
    2020! Current revisions:
    2121! -----------------
    22 ! Add required restart data for surface output module
     22!
    2323!
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
     27! Accepting variable j from check_parameters and passing it to
     28! bio_check_data_output
     29! Add required restart data for surface output module
     30!
     31! 3731 2019-02-11 13:06:27Z suehring
    2732! Add check_parameters routine for virtual measurements
    2833!
     
    592597!> Check module-specific 2D and 3D data output
    593598!------------------------------------------------------------------------------!
    594 SUBROUTINE module_interface_check_data_output( variable, unit, i, ilen, k )
     599SUBROUTINE module_interface_check_data_output( variable, unit, i, j, ilen, k )
    595600
    596601
     
    599604
    600605   INTEGER(iwp),      INTENT(IN)    :: i         !< ToDo: remove dummy argument, instead pass string from data_output
     606   INTEGER(iwp),      INTENT(IN)    :: j         !< average quantity? 0 = no, 1 = yes
    601607   INTEGER(iwp),      INTENT(IN)    :: ilen      !< ToDo: remove dummy argument, instead pass string from data_output
    602608   INTEGER(iwp),      INTENT(IN)    :: k         !< ToDo: remove dummy argument, instead pass string from data_output
    603609
    604610   IF ( unit == 'illegal'  .AND.  biometeorology )  THEN
    605       CALL bio_check_data_output( variable, unit, i, ilen, k )
     611      CALL bio_check_data_output( variable, unit, i, j, ilen, k )
    606612   ENDIF
    607613
Note: See TracChangeset for help on using the changeset viewer.