Ignore:
Timestamp:
Mar 20, 2014 8:40:49 AM (10 years ago)
Author:
raasch
Message:

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

File:
1 edited

Legend:

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

    r1319 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
     
    4146! 1003 2012-09-14 14:35:53Z raasch
    4247! adjustment of array tend for cases with unequal subdomain sizes removed
    43 !
    44 ! 707 2011-03-29 11:39:40Z raasch
    45 ! bc_lr/ns replaced by bc_lr/ns_cyc
    46 !
    47 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    48 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng for allocation
    49 ! of tend
    50 !
    51 ! 274 2009-03-26 15:11:21Z heinze
    52 ! Output of messages replaced by message handling routine
    53 !
    54 ! 225 2009-01-26 14:44:20Z raasch
    55 ! Bugfix: array d is reallocated in case that multigrid is used
    56 !
    57 ! 192 2008-08-27 16:51:49Z letzel
    58 ! bugfix in calc_spectra_x: exponent = 1.0 / ( ny + 1.0 )
    59 ! allow 100 spectra levels instead of 10 for consistency with
    60 ! define_netcdf_header
    61 ! user-defined spectra, arguments removed from transpose routines
    62 !
    63 ! February 2007
    64 ! RCS Log replace by Id keyword, revision history cleaned up
    65 !
    66 ! Revision 1.9  2006/04/11 14:56:00  raasch
    67 ! pl_spectra renamed data_output_sp
    6848!
    6949! Revision 1.1  2001/01/05 15:08:07  raasch
     
    8161
    8262#if defined( __spectra )
    83     USE arrays_3d
    84     USE control_parameters
    85     USE cpulog
    86     USE fft_xy
    87     USE indices
     63    USE arrays_3d,                                                             &
     64        ONLY:  d, tend
     65
     66    USE control_parameters,                                                    &
     67        ONLY:  average_count_sp, bc_lr_cyc, bc_ns_cyc, message_string, psolver
     68
     69    USE cpulog,                                                                &
     70        ONLY:  cpu_log, log_point
     71
     72    USE fft_xy,                                                                &
     73        ONLY:  fft_init
     74
     75    USE indices,                                                               &
     76        ONLY:  nxl, nxr, nyn, nys, nzb, nzt, nzt_x, nzt_yd
     77
     78    USE kinds
     79
    8880    USE pegrid
    89     USE spectrum
     81
     82    USE spectrum,                                                              &
     83        ONLY:  data_output_sp, spectra_direction
     84
    9085
    9186    IMPLICIT NONE
    9287
    93     INTEGER ::  m, pr
     88    INTEGER(iwp) ::  m  !:
     89    INTEGER(iwp) ::  pr !:
    9490
    9591
     
    163159          CALL calc_spectra_y( d, pr, m )
    164160#else
    165           message_string = 'sorry, calculation of spectra in non parallel' // &
     161          message_string = 'sorry, calculation of spectra in non parallel' //  &
    166162                           'mode& is still not realized'
    167163          CALL message( 'calc_spectra', 'PA0161', 1, 2, 0, 6, 0 )
     
    189185 SUBROUTINE preprocess_spectra( m, pr )
    190186
    191     USE arrays_3d
    192     USE indices
     187    USE arrays_3d,                                                             &
     188        ONLY:  d, pt, q, u, v, w
     189
     190    USE indices,                                                               &
     191        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
     192
     193    USE kinds
     194
    193195    USE pegrid
    194     USE spectrum
    195     USE statistics
     196
     197    USE spectrum,                                                              &
     198        ONLY:  data_output_sp
     199
     200    USE statistics,                                                            &
     201        ONLY:  sums
     202
    196203
    197204    IMPLICIT NONE
    198205
    199     INTEGER :: i, j, k, m, pr
     206    INTEGER(iwp) :: i  !:
     207    INTEGER(iwp) :: j  !:
     208    INTEGER(iwp) :: k  !:
     209    INTEGER(iwp) :: m  !:
     210    INTEGER(iwp) :: pr !:
    200211
    201212    SELECT CASE ( TRIM( data_output_sp(m) ) )
     
    247258 SUBROUTINE calc_spectra_x( ddd, pr, m )
    248259
    249     USE arrays_3d
    250     USE constants
    251     USE control_parameters
    252     USE fft_xy
    253     USE grid_variables
    254     USE indices
     260    USE arrays_3d,                                                             &
     261        ONLY: 
     262
     263    USE control_parameters,                                                    &
     264        ONLY:  fft_method
     265
     266    USE fft_xy,                                                                &
     267        ONLY:  fft_x_1d
     268
     269    USE grid_variables,                                                        &
     270        ONLY:  dx
     271
     272    USE indices,                                                               &
     273        ONLY:  nx, ny, nyn_x, nys_x, nzb_x, nzt_x
     274
     275    USE kinds
     276
    255277    USE pegrid
    256     USE spectrum
    257     USE statistics
     278
     279    USE spectrum,                                                              &
     280        ONLY:  comp_spectra_level, n_sp_x
     281
     282    USE statistics,                                                            &
     283        ONLY:  spectrum_x
     284
    258285    USE transpose_indices
    259286
     287
    260288    IMPLICIT NONE
    261289
    262     INTEGER                    ::  i, ishape(1), j, k, m, n, pr
    263 
    264     REAL                       ::  fac, exponent
    265     REAL, DIMENSION(0:nx)      ::  work
    266     REAL, DIMENSION(0:nx/2)    ::  sums_spectra_l
    267     REAL, DIMENSION(0:nx/2,100)::  sums_spectra
    268 
    269     REAL, DIMENSION(0:nx,nys_x:nyn_x,nzb_x:nzt_x) ::  ddd
     290    INTEGER(iwp) ::  i         !:
     291    INTEGER(iwp) ::  ishape(1) !:
     292    INTEGER(iwp) ::  j         !:
     293    INTEGER(iwp) ::  k         !:
     294    INTEGER(iwp) ::  m         !:
     295    INTEGER(iwp) ::  n         !:
     296    INTEGER(iwp) ::  pr        !:
     297
     298    REAL(wp) ::  fac      !:
     299    REAL(wp) ::  exponent !:
     300   
     301    REAL(wp), DIMENSION(0:nx) ::  work !:
     302   
     303    REAL(wp), DIMENSION(0:nx/2) ::  sums_spectra_l !:
     304   
     305    REAL(wp), DIMENSION(0:nx/2,100) ::  sums_spectra !:
     306   
     307    REAL(wp), DIMENSION(0:nx,nys_x:nyn_x,nzb_x:nzt_x) ::  ddd !:
    270308
    271309!
     
    320358#if defined( __parallel )   
    321359       CALL MPI_BARRIER( comm2d, ierr )  ! Necessary?
    322        CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), nx/2+1, &
     360       CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), nx/2+1,          &
    323361                        MPI_REAL, MPI_PROD, 0, comm2d, ierr )
    324362#else
     
    357395 SUBROUTINE calc_spectra_y( ddd, pr, m )
    358396
    359     USE arrays_3d
    360     USE constants
    361     USE control_parameters
    362     USE fft_xy
    363     USE grid_variables
    364     USE indices
     397    USE arrays_3d,                                                             &
     398        ONLY: 
     399
     400    USE control_parameters,                                                    &
     401        ONLY:  fft_method
     402
     403    USE fft_xy,                                                                &
     404        ONLY:  fft_y_1d
     405
     406    USE grid_variables,                                                        &
     407        ONLY:  dy
     408
     409    USE indices,                                                               &
     410        ONLY:  nx, ny, nxl_yd, nxr_yd, nzb_yd, nzt_yd
     411
     412    USE kinds
     413
    365414    USE pegrid
    366     USE spectrum
    367     USE statistics
     415
     416    USE spectrum,                                                              &
     417        ONLY:  comp_spectra_level, n_sp_y
     418
     419    USE statistics,                                                            &
     420        ONLY:  spectrum_y
     421
    368422    USE transpose_indices
    369423
     424
    370425    IMPLICIT NONE
    371426
    372     INTEGER :: i, j, jshape(1), k, m, n, pr
    373 
    374     REAL                       ::  fac, exponent
    375     REAL, DIMENSION(0:ny)      ::  work
    376     REAL, DIMENSION(0:ny/2)    ::  sums_spectra_l
    377     REAL, DIMENSION(0:ny/2,100)::  sums_spectra
    378 
    379     REAL, DIMENSION(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) :: ddd
     427    INTEGER(iwp) ::  i         !:
     428    INTEGER(iwp) ::  j         !:
     429    INTEGER(iwp) ::  jshape(1) !:
     430    INTEGER(iwp) ::  k         !:
     431    INTEGER(iwp) ::  m         !:
     432    INTEGER(iwp) ::  n         !:
     433    INTEGER(iwp) ::  pr        !:
     434
     435    REAL(wp) ::  fac      !:
     436    REAL(wp) ::  exponent !:
     437   
     438    REAL(wp), DIMENSION(0:ny) ::  work !:
     439   
     440    REAL(wp), DIMENSION(0:ny/2) ::  sums_spectra_l !:
     441   
     442    REAL(wp), DIMENSION(0:ny/2,100) ::  sums_spectra !:
     443   
     444    REAL(wp), DIMENSION(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) :: ddd !:
    380445
    381446
     
    431496#if defined( __parallel )   
    432497       CALL MPI_BARRIER( comm2d, ierr )  ! Necessary?
    433        CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), ny/2+1, &
     498       CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), ny/2+1,          &
    434499                        MPI_REAL, MPI_PROD, 0, comm2d, ierr )
    435500#else
Note: See TracChangeset for help on using the changeset viewer.