Ignore:
Timestamp:
Apr 8, 2019 4:53:48 PM (5 years ago)
Author:
knoop
Message:

Implemented non_transport_physics module interfaces

File:
1 edited

Legend:

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

    r3873 r3874  
    147147               bcm_header,                                                     &
    148148               bcm_actions,                                                    &
     149               bcm_non_transport_physics,                                      &
    149150               bcm_prognostic_equations,                                       &
    150151               bcm_swap_timelevel,                                             &
     
    382383       module_interface_header,                                                &
    383384       module_interface_actions,                                               &
     385       module_interface_non_transport_physics,                                 &
    384386       module_interface_prognostic_equations,                                  &
    385387       module_interface_swap_timelevel,                                        &
     
    443445       MODULE PROCEDURE module_interface_actions_ij
    444446    END INTERFACE module_interface_actions
     447
     448    INTERFACE module_interface_non_transport_physics
     449       MODULE PROCEDURE module_interface_non_transport_physics
     450       MODULE PROCEDURE module_interface_non_transport_physics_ij
     451    END INTERFACE module_interface_non_transport_physics
    445452
    446453    INTERFACE module_interface_prognostic_equations
     
    872879! Description:
    873880! ------------
    874 !> Perform module-specific actions while in time-integration (cache-optimized)
     881!> Perform module-specific actions while in time-integration (vector-optimized)
    875882!------------------------------------------------------------------------------!
    876883 SUBROUTINE module_interface_actions( location )
     
    893900! Description:
    894901! ------------
    895 !> Perform module-specific actions while in time-integration (vector-optimized)
     902!> Perform module-specific actions while in time-integration (cache-optimized)
    896903!------------------------------------------------------------------------------!
    897904 SUBROUTINE module_interface_actions_ij( i, j, location )
     
    916923! Description:
    917924! ------------
     925!> Compute module-specific prognostic_equations (vector-optimized)
     926!------------------------------------------------------------------------------!
     927 SUBROUTINE module_interface_non_transport_physics()
     928
     929
     930    IF ( bulk_cloud_model    )  CALL bcm_non_transport_physics()
     931
     932
     933 END SUBROUTINE module_interface_non_transport_physics
     934
     935
     936!------------------------------------------------------------------------------!
     937! Description:
     938! ------------
    918939!> Compute module-specific prognostic_equations (cache-optimized)
     940!------------------------------------------------------------------------------!
     941 SUBROUTINE module_interface_non_transport_physics_ij( i, j )
     942
     943
     944    INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
     945    INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
     946
     947
     948    IF ( bulk_cloud_model    )  CALL bcm_non_transport_physics( i, j )
     949
     950
     951 END SUBROUTINE module_interface_non_transport_physics_ij
     952
     953
     954!------------------------------------------------------------------------------!
     955! Description:
     956! ------------
     957!> Compute module-specific prognostic_equations (vector-optimized)
    919958!------------------------------------------------------------------------------!
    920959 SUBROUTINE module_interface_prognostic_equations()
     
    933972! Description:
    934973! ------------
    935 !> Compute module-specific prognostic_equations (vector-optimized)
     974!> Compute module-specific prognostic_equations (cache-optimized)
    936975!------------------------------------------------------------------------------!
    937976 SUBROUTINE module_interface_prognostic_equations_ij( i, j, i_omp_start, tn )
Note: See TracChangeset for help on using the changeset viewer.