Ignore:
Timestamp:
Apr 12, 2019 8:47:41 AM (5 years ago)
Author:
schwenkel
Message:

bugfix for chemistry_model_mod via introducing module_interface_exchange_horiz

File:
1 edited

Legend:

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

    r3885 r3887  
    2525! -----------------
    2626! $Id$
     27! Added bcm_exchange_horiz which is called after non_transport_physics
     28!
     29! 3885 2019-04-11 11:29:34Z kanani
    2730! Changes related to global restructuring of location messages and introduction
    2831! of additional debug messages
     
    260263
    261264    USE indices,                                                               &
    262         ONLY:  nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt,           &
     265        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt,     &
    263266               wall_flags_0
    264267
     
    369372           bcm_actions, &
    370373           bcm_non_transport_physics, &
     374           bcm_exchange_horiz, &
    371375           bcm_prognostic_equations, &
    372376           bcm_3d_data_averaging, &
     
    432436       MODULE PROCEDURE bcm_non_transport_physics_ij
    433437    END INTERFACE bcm_non_transport_physics
     438
     439    INTERFACE bcm_exchange_horiz
     440       MODULE PROCEDURE bcm_exchange_horiz
     441    END INTERFACE bcm_exchange_horiz   
    434442
    435443    INTERFACE bcm_prognostic_equations
     
    13121320
    13131321    END SUBROUTINE bcm_non_transport_physics_ij
     1322   
     1323   
     1324!------------------------------------------------------------------------------!
     1325! Description:
     1326! ------------
     1327!> Control of microphysics for all grid points
     1328!------------------------------------------------------------------------------!
     1329    SUBROUTINE bcm_exchange_horiz
     1330
     1331
     1332       IF ( .NOT. microphysics_sat_adjust  .AND.                                &
     1333            ( intermediate_timestep_count == 1  .OR.                            &
     1334              call_microphysics_at_all_substeps ) )                             &
     1335       THEN
     1336          IF ( microphysics_morrison )  THEN
     1337             CALL exchange_horiz( nc, nbgp )
     1338             CALL exchange_horiz( qc, nbgp )         
     1339          ENDIF
     1340          IF ( microphysics_seifert ) THEN
     1341             CALL exchange_horiz( qr, nbgp )
     1342             CALL exchange_horiz( nr, nbgp )
     1343          ENDIF
     1344          CALL exchange_horiz( q, nbgp )
     1345          CALL exchange_horiz( pt, nbgp )         
     1346       ENDIF
     1347
     1348
     1349    END SUBROUTINE bcm_exchange_horiz
     1350   
    13141351
    13151352
     
    28982935       CALL cpu_log( log_point_s(50), 'adjust_cloud', 'start' )
    28992936
    2900        DO  i = nxlg, nxrg
    2901           DO  j = nysg, nyng
     2937       DO  i = nxl, nxr
     2938          DO  j = nys, nyn
    29022939             DO  k = nzb+1, nzt
    29032940!
     
    30203057       CALL cpu_log( log_point_s(65), 'activation', 'start' )
    30213058
    3022        DO  i = nxlg, nxrg
    3023           DO  j = nysg, nyng
     3059       DO  i = nxl, nxr
     3060          DO  j = nys, nyn
    30243061             DO  k = nzb+1, nzt
    30253062!
     
    32213258       CALL cpu_log( log_point_s(66), 'condensation', 'start' )
    32223259
    3223        DO  i = nxlg, nxrg
    3224           DO  j = nysg, nyng
     3260       DO  i = nxl, nxr
     3261          DO  j = nys, nyn
    32253262             DO  k = nzb+1, nzt
    32263263!
     
    33813418       CALL cpu_log( log_point_s(47), 'autoconversion', 'start' )
    33823419
    3383        DO  i = nxlg, nxrg
    3384           DO  j = nysg, nyng
     3420       DO  i = nxl, nxr
     3421          DO  j = nys, nyn
    33853422             DO  k = nzb+1, nzt
    33863423!
     
    36153652       REAL(wp)    ::  flag        !< flag to mask topography grid points
    36163653
    3617        DO  i = nxlg, nxrg
    3618           DO  j = nysg, nyng
     3654       DO  i = nxl, nxr
     3655          DO  j = nys, nyn
    36193656!
    36203657!--          Determine vertical index of topography top
     
    37163753       CALL cpu_log( log_point_s(56), 'accretion', 'start' )
    37173754
    3718        DO  i = nxlg, nxrg
    3719           DO  j = nysg, nyng
     3755       DO  i = nxl, nxr
     3756          DO  j = nys, nyn
    37203757             DO  k = nzb+1, nzt
    37213758!
     
    38773914       CALL cpu_log( log_point_s(57), 'selfcollection', 'start' )
    38783915
    3879        DO  i = nxlg, nxrg
    3880           DO  j = nysg, nyng
     3916       DO  i = nxl, nxr
     3917          DO  j = nys, nyn
    38813918             DO  k = nzb+1, nzt
    38823919!
     
    39944031       CALL cpu_log( log_point_s(58), 'evaporation', 'start' )
    39954032
    3996        DO  i = nxlg, nxrg
    3997           DO  j = nysg, nyng
     4033       DO  i = nxl, nxr
     4034          DO  j = nys, nyn
    39984035             DO  k = nzb+1, nzt
    39994036!
     
    42304267       sed_nc(nzt+1) = 0.0_wp
    42314268
    4232        DO  i = nxlg, nxrg
    4233           DO  j = nysg, nyng
     4269       DO  i = nxl, nxr
     4270          DO  j = nys, nyn
    42344271             DO  k = nzt, nzb+1, -1
    42354272!
     
    44304467!
    44314468!--    Compute velocities
    4432        DO  i = nxlg, nxrg
    4433           DO  j = nysg, nyng
     4469       DO  i = nxl, nxr
     4470          DO  j = nys, nyn
    44344471             DO  k = nzb+1, nzt
    44354472!
Note: See TracChangeset for help on using the changeset viewer.