Ignore:
Timestamp:
Apr 7, 2016 2:23:03 PM (5 years ago)
Author:
raasch
Message:

spectrum renamed spactra_par and further modularized, POINTER-attributes added in coupler-routines to avoid gfortran error messages

File:
1 edited

Legend:

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

    r1818 r1833  
    1919! Current revisions:
    2020! ------------------
    21 !
     21! spectrum renamed spectra_mod, spectra related variables moved to spectra_mod,
     22! routines data_output_spectra_x/y removed
    2223!
    2324! Former revisions:
     
    7879#if defined( __netcdf )
    7980    USE control_parameters,                                                    &
    80         ONLY:  average_count_sp, averaging_interval_sp, dosp_time_count,       &
    81                message_string, run_description_header,                         &
     81        ONLY:  message_string, run_description_header,                         &
    8282               time_since_reference_point
    8383
     
    9494    USE pegrid
    9595
    96     USE spectrum,                                                              &
    97         ONLY:  comp_spectra_level, data_output_sp, spectra_direction
    98 
    99     USE statistics,                                                            &
    100         ONLY:  spectrum_x, spectrum_y
     96    USE spectra_mod,                                                           &
     97        ONLY:  average_count_sp, averaging_interval_sp, comp_spectra_level,    &
     98               data_output_sp, dosp_time_count, spectra_direction, spectrum_x, &
     99               spectrum_y
    101100
    102101
     
    226225        ONLY:  pi
    227226
    228     USE control_parameters,                                                    &
    229         ONLY:  dosp_time_count
    230 
    231227    USE grid_variables,                                                        &
    232228        ONLY:  dx, dy
     
    243239               netcdf_handle_error
    244240
    245     USE spectrum,                                                              &
    246         ONLY:  n_sp_x, n_sp_y
    247 
    248     USE statistics,                                                            &
    249         ONLY:  spectrum_x, spectrum_y
     241    USE spectra_mod,                                                           &
     242        ONLY:  dosp_time_count, n_sp_x, n_sp_y, spectrum_x, spectrum_y
     243
    250244
    251245    IMPLICIT NONE
     
    302296#endif
    303297 END SUBROUTINE output_spectra_netcdf
    304 
    305 
    306 !------------------------------------------------------------------------------!
    307 ! Description:
    308 ! ------------
    309 !> @todo Missing subroutine description.
    310 !------------------------------------------------------------------------------!
    311  SUBROUTINE data_output_spectra_x( m, cranz, pr, frame_written )
    312 
    313     USE arrays_3d,                                                             &
    314         ONLY:  zu, zw
    315     USE constants,                                                             &
    316         ONLY:  pi
    317 
    318     USE control_parameters,                                                    &
    319         ONLY:  averaging_interval_sp, run_description_header, simulated_time_chr
    320 
    321     USE grid_variables,                                                        &
    322         ONLY:  dx
    323 
    324     USE indices,                                                               &
    325         ONLY:  nx
    326 
    327     USE kinds
    328 
    329     USE pegrid
    330 
    331     USE statistics,                                                            &
    332         ONLY:  spectrum_x
    333 
    334     USE spectrum,                                                              &
    335         ONLY:  comp_spectra_level, header_char, lstyles, klist_x, n_sp_x,      &
    336                plot_spectra_level, utext_char, ytext_char
    337 
    338     IMPLICIT NONE
    339 
    340     CHARACTER (LEN=30) ::  atext !<
    341    
    342     INTEGER(iwp)       ::  i     !<
    343     INTEGER(iwp)       ::  j     !<
    344     INTEGER(iwp)       ::  k     !<
    345     INTEGER(iwp)       ::  m     !<
    346     INTEGER(iwp)       ::  pr    !<
    347    
    348     LOGICAL            ::  frame_written   !<
    349    
    350     REAL(wp)           ::  frequency = 0.0_wp !<
    351 !
    352 !-- Variables needed for PROFIL-namelist
    353     CHARACTER (LEN=80) ::  rtext                !<
    354     CHARACTER (LEN=80) ::  utext                !<
    355     CHARACTER (LEN=80) ::  xtext = 'k in m>->1' !<
    356     CHARACTER (LEN=80) ::  ytext                !<
    357 
    358     INTEGER(iwp)       ::  cranz       !<
    359     INTEGER(iwp)       ::  labforx = 3 !<
    360     INTEGER(iwp)       ::  labfory = 3 !<
    361     INTEGER(iwp)       ::  legpos  = 3 !<
    362     INTEGER(iwp)       ::  timodex = 1 !<
    363    
    364     INTEGER(iwp), DIMENSION(1:100) ::  cucol  = 1      !<
    365     INTEGER(iwp), DIMENSION(1:100) ::  klist  = 999999 !<
    366     INTEGER(iwp), DIMENSION(1:100) ::  lstyle = 0      !<
    367    
    368     LOGICAL ::  datleg = .TRUE. !<
    369     LOGICAL ::  grid = .TRUE.   !<
    370     LOGICAL ::  lclose = .TRUE. !<
    371     LOGICAL ::  rand = .TRUE.   !<
    372     LOGICAL ::  swap = .TRUE.   !<
    373     LOGICAL ::  twoxa = .TRUE.  !<
    374     LOGICAL ::  xlog = .TRUE.   !<
    375     LOGICAL ::  ylog = .TRUE.   !<
    376    
    377     REAL(wp) ::  gwid = 0.1_wp    !<
    378     REAL(wp) ::  rlegfak = 0.7_wp !<
    379     REAL(wp) ::  uxmin            !<
    380     REAL(wp) ::  uxmax            !<
    381     REAL(wp) ::  uymin            !<
    382     REAL(wp) ::  uymax            !<
    383      
    384     REAL(wp), DIMENSION(1:100) ::  lwid = 0.6_wp !<
    385     REAL(wp), DIMENSION(100)   ::  uyma          !<
    386     REAL(wp), DIMENSION(100)   ::  uymi          !<
    387 
    388     NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
    389     NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
    390                        legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
    391                        uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
    392                        ytext
    393 
    394 
    395     rtext = '\0.5 ' // run_description_header
    396 
    397 !
    398 !-- Open parameter- and data-file
    399     CALL check_open( 81 )
    400     CALL check_open( 82 )
    401 
    402 !
    403 !-- Write file header,
    404 !-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
    405 !-- pr serves as an index for output of strings (axis-labels) of the
    406 !-- different quantities u, v, w, pt and q)
    407     DO  k = 1, n_sp_x
    408        IF ( k < 100 )  THEN
    409           IF ( pr == 3 )  THEN
    410              WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
    411                                 INT( zw(comp_spectra_level(k)) ), &
    412                                 simulated_time_chr
    413           ELSE
    414              WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
    415                                 INT( zu(comp_spectra_level(k)) ), &
    416                                 simulated_time_chr
    417           ENDIF
    418        ELSE
    419           IF ( pr == 3 )  THEN
    420              WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
    421                                 INT( zw(comp_spectra_level(k)) ), &
    422                                 simulated_time_chr
    423           ELSE
    424              WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
    425                                 INT( zu(comp_spectra_level(k)) ), &
    426                                 simulated_time_chr
    427           ENDIF
    428        ENDIF
    429     ENDDO
    430 
    431     IF ( .NOT. frame_written )  THEN
    432        WRITE ( 81, RAHMEN )
    433        frame_written = .TRUE.
    434     ENDIF
    435 
    436 !
    437 !-- Write all data and calculate uymi and uyma. They serve to calculate
    438 !-- the CROSS-parameters uymin and uymax
    439     uymi = 999.999_wp; uyma = -999.999_wp
    440     DO  i = 1, nx/2
    441        frequency = 2.0_wp * pi * i / ( dx * ( nx + 1 ) )
    442        WRITE ( 82, 102 )  frequency, ( frequency * spectrum_x(i,k,m), k = 1, &
    443                           n_sp_x )
    444        DO  k = 1, n_sp_x
    445           uymi(k) = MIN( uymi(k), frequency * spectrum_x(i,k,m) )
    446           uyma(k) = MAX( uyma(k), frequency * spectrum_x(i,k,m) )
    447        ENDDO
    448     ENDDO
    449 
    450 !
    451 !-- Determine CROSS-parameters
    452     cucol(1:n_sp_x)  = (/ ( k, k = 1, n_sp_x ) /)
    453     lstyle(1:n_sp_x) = (/ ( lstyles(k), k = 1, n_sp_x ) /)
    454 
    455 !
    456 !-- Calculate klist-values from the available comp_spectra_level values
    457     i = 1; k = 1
    458     DO WHILE ( i <= 100  .AND.  plot_spectra_level(i) /= 999999 )
    459        DO WHILE ( k <= n_sp_x  .AND. &
    460                   plot_spectra_level(i) >= comp_spectra_level(k) )
    461           IF ( plot_spectra_level(i) == comp_spectra_level(k) )  THEN
    462              klist(i) = k + klist_x
    463           ELSE
    464              uymi(k) =  999.999_wp
    465              uyma(k) = -999.999_wp
    466           ENDIF
    467           k = k + 1
    468        ENDDO
    469        i = i + 1
    470     ENDDO
    471     uymi(k:n_sp_x) =  999.999_wp
    472     uyma(k:n_sp_x) = -999.999_wp
    473     utext = 'x'//utext_char( pr )
    474     IF ( averaging_interval_sp /= 0.0_wp ) THEN
    475        WRITE ( atext, 104 )  averaging_interval_sp
    476        utext = TRIM(utext) // ',  ' // TRIM( atext )
    477     ENDIF
    478     uxmin = 0.8_wp * 2.0_wp * pi        / ( dx * ( nx + 1 ) )
    479     uxmax = 1.2_wp * 2.0_wp * pi * nx/2 / ( dx * ( nx + 1 ) )
    480     uymin = 0.8_wp * MIN (  999.999_wp, MINVAL ( uymi ) )
    481     uymax = 1.2_wp * MAX ( -999.999_wp, MAXVAL ( uyma ) )
    482     ytext = ytext_char( pr )
    483 
    484 !
    485 !-- Output of CROSS-parameters
    486     WRITE ( 81, CROSS )
    487 
    488 !
    489 !-- Increase counter by the number of profiles written in the actual block
    490     klist_x = klist_x + n_sp_x
    491 
    492 !
    493 !-- Write end-mark
    494     WRITE ( 82, 103 )
    495 
    496 !
    497 !-- Close parameter- and data-file
    498     CALL close_file( 81 )
    499     CALL close_file( 82 )
    500 
    501 !
    502 !-- Formats
    503 100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
    504 101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
    505 102 FORMAT (E15.7,100(1X,E15.7))
    506 103 FORMAT ('NEXT')
    507 104 FORMAT ('time averaged over',F7.1,' s')
    508 
    509  END SUBROUTINE data_output_spectra_x
    510 
    511 
    512 !------------------------------------------------------------------------------!
    513 ! Description:
    514 ! ------------
    515 !> @todo Missing subroutine description.
    516 !------------------------------------------------------------------------------!
    517  SUBROUTINE data_output_spectra_y( m, cranz, pr, frame_written )
    518 
    519     USE arrays_3d,                                                             &
    520         ONLY:  zu, zw
    521  
    522     USE constants,                                                             &
    523         ONLY:  pi
    524 
    525     USE control_parameters,                                                    &
    526         ONLY:  averaging_interval_sp, run_description_header, simulated_time_chr
    527 
    528     USE grid_variables,                                                        &
    529         ONLY:  dy
    530 
    531     USE indices,                                                               &
    532         ONLY:  ny
    533 
    534     USE kinds
    535 
    536     USE pegrid
    537    
    538     USE statistics,                                                             &
    539         ONLY:  spectrum_y
    540 
    541     USE spectrum,                                                              &
    542         ONLY:  comp_spectra_level, header_char, klist_y, lstyles, n_sp_y,      &
    543                plot_spectra_level, utext_char, ytext_char
    544 
    545     IMPLICIT NONE
    546 
    547    
    548     CHARACTER (LEN=30) ::  atext !<
    549    
    550     INTEGER(iwp)       ::  i     !<
    551     INTEGER(iwp)       ::  j     !<
    552     INTEGER(iwp)       ::  k     !<
    553     INTEGER(iwp)       ::  m     !<
    554     INTEGER(iwp)       ::  pr    !<
    555    
    556     LOGICAL            :: frame_written   !<
    557    
    558     REAL(wp)           :: frequency = 0.0_wp !<
    559 
    560 !
    561 !-- Variables needed for PROFIL-namelist
    562     CHARACTER (LEN=80) ::  rtext                !<
    563     CHARACTER (LEN=80) ::  utext                !<
    564     CHARACTER (LEN=80) ::  xtext = 'k in m>->1' !<
    565     CHARACTER (LEN=80) ::  ytext                !<
    566 
    567     INTEGER(iwp) ::  cranz       !<
    568     INTEGER(iwp) ::  labforx = 3 !<
    569     INTEGER(iwp) ::  labfory = 3 !<
    570     INTEGER(iwp) ::  legpos  = 3 !<
    571     INTEGER(iwp) ::  timodex = 1 !<
    572    
    573     INTEGER(iwp), DIMENSION(1:100) ::  cucol  = 1      !<
    574     INTEGER(iwp), DIMENSION(1:100) ::  klist  = 999999 !<
    575     INTEGER(iwp), DIMENSION(1:100) ::  lstyle = 0      !<
    576    
    577     LOGICAL ::  datleg = .TRUE. !<
    578     LOGICAL ::  grid = .TRUE.   !<
    579     LOGICAL ::  lclose = .TRUE. !<
    580     LOGICAL ::  rand = .TRUE.   !<
    581     LOGICAL ::  swap = .TRUE.   !<
    582     LOGICAL ::  twoxa = .TRUE.  !<
    583     LOGICAL ::  xlog = .TRUE.   !<
    584     LOGICAL ::  ylog = .TRUE.   !<
    585    
    586     REAL(wp) ::  gwid = 0.1_wp     !<
    587     REAL(wp) ::  rlegfak = 0.7_wp  !<
    588     REAL(wp) ::  uxmin             !<
    589     REAL(wp) ::  uxmax             !<
    590     REAL(wp) ::  uymin             !<
    591     REAL(wp) ::  uymax             !<
    592    
    593     REAL(wp), DIMENSION(1:100) ::  lwid = 0.6_wp !<
    594    
    595     REAL(wp), DIMENSION(100)   ::  uyma          !<
    596     REAL(wp), DIMENSION(100)   ::  uymi          !<
    597 
    598     NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
    599     NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
    600                        legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
    601                        uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
    602                        ytext
    603 
    604 
    605     rtext = '\0.5 ' // run_description_header
    606 
    607 !
    608 !-- Open parameter- and data-file
    609     CALL check_open( 83 )
    610     CALL check_open( 84 )
    611 
    612 !
    613 !-- Write file header,
    614 !-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
    615 !-- pr serves as an index for output of strings (axis-labels) of the
    616 !-- different quantities u, v, w, pt and q)
    617     DO  k = 1, n_sp_y
    618        IF ( k < 100 )  THEN
    619           IF ( pr == 3 ) THEN
    620              WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
    621                                 INT( zw(comp_spectra_level(k)) ), &
    622                                 simulated_time_chr
    623           ELSE
    624              WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
    625                                 INT( zu(comp_spectra_level(k)) ), &
    626                                 simulated_time_chr
    627           ENDIF
    628        ELSE
    629           IF ( pr == 3 )  THEN
    630              WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
    631                                 INT( zw(comp_spectra_level(k)) ), &
    632                                 simulated_time_chr
    633           ELSE
    634              WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
    635                                 INT( zu(comp_spectra_level(k)) ), &
    636                                 simulated_time_chr
    637           ENDIF
    638        ENDIF
    639     ENDDO
    640 
    641     IF ( .NOT. frame_written )  THEN
    642        WRITE ( 83, RAHMEN )
    643        frame_written = .TRUE.
    644     ENDIF
    645 
    646 !
    647 !-- Write all data and calculate uymi and uyma. They serve to calculate
    648 !-- the CROSS-parameters uymin and uymax
    649     uymi = 999.999_wp; uyma = -999.999_wp
    650     DO  j = 1, ny/2
    651        frequency = 2.0_wp * pi * j / ( dy * ( ny + 1 ) )
    652        WRITE ( 84, 102 ) frequency, ( frequency * spectrum_y(j,k,m), &
    653                                       k = 1, n_sp_y )
    654        DO k = 1, n_sp_y
    655           uymi(k) = MIN( uymi(k), frequency * spectrum_y(j,k,m) )
    656           uyma(k) = MAX( uyma(k), frequency * spectrum_y(j,k,m) )
    657        ENDDO
    658     ENDDO
    659 
    660 !
    661 !-- Determine CROSS-parameters
    662     cucol(1:n_sp_y)  = (/ ( k, k = 1, n_sp_y ) /)
    663     lstyle(1:n_sp_y) = (/ ( lstyles(k), k = 1, n_sp_y ) /)
    664 
    665 !
    666 !-- Calculate klist-values from the available comp_spectra_level values
    667     j = 1; k = 1
    668     DO WHILE ( j <= 100  .AND.  plot_spectra_level(j) /= 999999 )
    669        DO WHILE ( k <= n_sp_y  .AND. &
    670                   plot_spectra_level(j) >= comp_spectra_level(k) )
    671           IF ( plot_spectra_level(j) == comp_spectra_level(k) )  THEN
    672              klist(j) = k + klist_y
    673           ELSE
    674              uymi(k) =  999.999_wp
    675              uyma(k) = -999.999_wp
    676           ENDIF
    677           k = k + 1
    678        ENDDO
    679        j = j + 1
    680     ENDDO
    681     uymi(k:n_sp_y) =  999.999_wp
    682     uyma(k:n_sp_y) = -999.999_wp
    683     utext = 'y'//utext_char( pr )
    684     IF ( averaging_interval_sp /= 0.0_wp )  THEN
    685        WRITE ( atext, 104 )  averaging_interval_sp
    686        utext = TRIM(utext) // ',  ' // TRIM( atext )
    687     ENDIF
    688     uxmin = 0.8_wp * 2.0_wp * pi        / ( dy * ( ny + 1 ) )
    689     uxmax = 1.2_wp * 2.0_wp * pi * ny/2 / ( dy * ( ny + 1 ) )
    690     uymin = 0.8_wp * MIN (  999.999_wp, MINVAL ( uymi ) )
    691     uymax = 1.2_wp * MAX ( -999.999_wp, MAXVAL ( uyma ) )
    692     ytext = ytext_char( pr )
    693 
    694 !
    695 !-- Output CROSS-parameters
    696     WRITE ( 83, CROSS )
    697 
    698 !
    699 !-- Increase counter by the number of profiles written in the actual block
    700     klist_y = klist_y + n_sp_y
    701 
    702 !
    703 !-- Write end-mark
    704     WRITE ( 84, 103 ) 
    705 
    706 !
    707 !-- Close parameter- and data-file
    708     CALL close_file( 83 )
    709     CALL close_file( 84 )
    710 
    711 !
    712 !-- Formats
    713 100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
    714 101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
    715 102 FORMAT (E15.7,100(1X,E15.7))
    716 103 FORMAT ('NEXT')
    717 104 FORMAT ('time averaged over',F7.1,' s')
    718 
    719  END SUBROUTINE data_output_spectra_y
Note: See TracChangeset for help on using the changeset viewer.