Ignore:
Timestamp:
May 6, 2019 12:11:55 PM (5 years ago)
Author:
gronemeier
Message:

set origin_time and starting point of time coordinate according to day_of_year_init and time_utc_init

File:
1 edited

Legend:

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

    r3942 r3953  
    2525! -----------------
    2626! $Id$
     27! bugfix: set origin_time and starting point of time coordinate according to
     28!         day_of_year_init and time_utc_init
     29!
     30! 3942 2019-04-30 13:08:30Z kanani
    2731! Add specifier to netcdf_handle_error to simplify identification of attribute
    2832! causing the error
     
    492496    CHARACTER(LEN=20), DIMENSION(11) ::  netcdf_precision = ' '
    493497    CHARACTER(LEN=40) ::  netcdf_data_format_string
     498    CHARACTER(LEN=23) ::  origin_time_string  !< string containing date and time of origin
    494499
    495500    INTEGER(iwp) ::  id_dim_agtnum, id_dim_time_agt,                           &
     
    681686               skip_time_do3d, topography, num_leg, num_var_fl,                &
    682687               urban_surface
     688
     689    USE date_and_time_mod,                                                     &
     690       ONLY:   day_of_year_init, time_utc_init
    683691
    684692    USE grid_variables,                                                        &
     
    902910
    903911    ENDIF
    904 
     912!
     913!-- Compose date-time string for origin_time
     914    origin_time_string = date_time_string( day_of_year_init, time_utc_init )
    905915!
    906916!-- Convert coord_ref_sys into vector (used for lat/lon calculation)
     
    962972                                  (/ id_dim_time_mask(mid,av) /), 'time',      &
    963973                                  NF90_DOUBLE, id_var_time_mask(mid,av),       &
    964                                  'seconds since '//TRIM(init_model%origin_time), 'time', 468, 469, 000 )
     974                                 'seconds since '//origin_time_string, 'time', 468, 469, 000 )
    965975          CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), 'standard_name', 'time', 000)
    966976          CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), 'axis', 'T', 000)
     
    17451755          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_time_3d(av) /),     &
    17461756                                  'time', NF90_DOUBLE, id_var_time_3d(av),     &
    1747                                   'seconds since '//TRIM(init_model%origin_time), 'time', 65, 66, 00 )
     1757                                  'seconds since '//origin_time_string, 'time', 65, 66, 00 )
    17481758          CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'standard_name', 'time', 000)
    17491759          CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'axis', 'T', 000)
     
    25512561
    25522562          CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), 'time',   &
    2553                                   NF90_REAL4, id_var_time_agt, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
     2563                                  NF90_REAL4, id_var_time_agt, 'seconds since '//origin_time_string, 'time',  &
    25542564                                  332, 333, 000 )
    25552565          CALL netcdf_create_att( id_set_agt, id_var_time_agt, 'standard_name', 'time', 000)
     
    26892699          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_time_xy(av) /),     &
    26902700                                  'time', NF90_DOUBLE, id_var_time_xy(av),     &
    2691                                   'seconds since '//TRIM(init_model%origin_time), 'time', 100, 101, 000 )
     2701                                  'seconds since '//origin_time_string, 'time', 100, 101, 000 )
    26922702          CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'standard_name', 'time', 000)
    26932703          CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'axis', 'T', 000)
     
    36433653          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_time_xz(av) /),     &
    36443654                                  'time', NF90_DOUBLE, id_var_time_xz(av),     &
    3645                                   'seconds since '//TRIM(init_model%origin_time), 'time', 143, 144, 000 )
     3655                                  'seconds since '//origin_time_string, 'time', 143, 144, 000 )
    36463656          CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'standard_name', 'time', 000)
    36473657          CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'axis', 'T', 000)
     
    45014511          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_time_yz(av) /),     &
    45024512                                  'time', NF90_DOUBLE, id_var_time_yz(av),     &
    4503                                   'seconds since '//TRIM(init_model%origin_time), 'time', 182, 183, 000 )
     4513                                  'seconds since '//origin_time_string, 'time', 182, 183, 000 )
    45044514          CALL netcdf_create_att( id_set_yz(av), id_var_time_yz(av), 'standard_name', 'time', 000)
    45054515          CALL netcdf_create_att( id_set_yz(av), id_var_time_yz(av), 'axis', 'T', 000)
     
    54825492                                  id_dim_time_pr, 220 )
    54835493          CALL netcdf_create_var( id_set_pr, (/ id_dim_time_pr /), 'time',     &
    5484                                   NF90_DOUBLE, id_var_time_pr, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
     5494                                  NF90_DOUBLE, id_var_time_pr, 'seconds since '//origin_time_string, 'time',  &
    54855495                                  221, 222, 000 )
    54865496          CALL netcdf_create_att( id_set_pr, id_var_time_pr, 'standard_name', 'time', 000)
     
    57355745                                  id_dim_time_ts, 250 )
    57365746          CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), 'time',     &
    5737                                   NF90_DOUBLE, id_var_time_ts, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
     5747                                  NF90_DOUBLE, id_var_time_ts, 'seconds since '//origin_time_string, 'time',  &
    57385748                                  251, 252, 000 )
    57395749          CALL netcdf_create_att( id_set_ts, id_var_time_ts, 'standard_name', 'time', 000)
     
    59325942                                  id_dim_time_sp, 270 )
    59335943          CALL netcdf_create_var( id_set_sp, (/ id_dim_time_sp /), 'time',     &
    5934                                   NF90_DOUBLE, id_var_time_sp, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
     5944                                  NF90_DOUBLE, id_var_time_sp, 'seconds since '//origin_time_string, 'time',  &
    59355945                                  271, 272, 000 )
    59365946          CALL netcdf_create_att( id_set_sp, id_var_time_sp, 'standard_name', 'time', 000)
     
    64256435                                  id_dim_time_pts, 397 )
    64266436          CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /), 'time',   &
    6427                                   NF90_DOUBLE, id_var_time_pts, 'seconds since '//TRIM(init_model%origin_time), 'time', &
     6437                                  NF90_DOUBLE, id_var_time_pts, 'seconds since '//origin_time_string, 'time', &
    64286438                                  398, 399, 000 )
    64296439          CALL netcdf_create_att( id_set_pts, id_var_time_pts, 'standard_name', 'time', 000)
     
    66236633                                  id_dim_time_fl, 250 )
    66246634          CALL netcdf_create_var( id_set_fl, (/ id_dim_time_fl /), 'time',     &
    6625                                   NF90_DOUBLE, id_var_time_fl, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
     6635                                  NF90_DOUBLE, id_var_time_fl, 'seconds since '//origin_time_string, 'time',  &
    66266636                                  251, 252, 000 )
    66276637          CALL netcdf_create_att( id_set_fl, id_var_time_fl, 'standard_name', 'time', 000)
     
    71157125    CALL netcdf_handle_error( 'netcdf_create_global_atts 5', error_no )
    71167126
    7117     nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_time', init_model%origin_time )
     7127    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_time', origin_time_string )
    71187128    CALL netcdf_handle_error( 'netcdf_create_global_atts 6', error_no )
    71197129    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_lat', init_model%latitude )
     
    74577467 END SUBROUTINE convert_utm_to_geographic
    74587468
     7469 !------------------------------------------------------------------------------!
     7470 ! Description:
     7471 ! ------------
     7472 !> Compose string containing date and time of format 'YYYY-MM-DD hh:mm:ss ZZZ'
     7473 !> from day_of_year and second_of_day.
     7474 !------------------------------------------------------------------------------!
     7475 FUNCTION date_time_string( day_of_year, second_of_day )
     7476
     7477    IMPLICIT NONE
     7478
     7479    CHARACTER(LEN=1) ::  plus_minus  !< either '+' or '-'
     7480
     7481    CHARACTER(LEN=23) ::  date_time_string  !< string containing date and time
     7482
     7483    INTEGER(iwp) ::  day          !< day of month
     7484    INTEGER(iwp) ::  err          !< error code
     7485    INTEGER(iwp) ::  i            !< loop index
     7486    INTEGER(iwp) ::  hour         !< hour of the day
     7487    INTEGER(iwp) ::  minute       !< minute of the hour
     7488    INTEGER(iwp) ::  month        !< month of year
     7489    INTEGER(iwp) ::  year = 2019  !< year (no leap year)
     7490    INTEGER(iwp) ::  zone = 0     !< time zone
     7491
     7492    INTEGER(iwp), INTENT(IN) ::  day_of_year  !< day of year to start with
     7493
     7494    INTEGER, DIMENSION(12) :: days_per_month = &  !< total number of days for
     7495    (/31,28,31,30,31,30,31,31,30,31,30,31/)       !< each month (no leap year)
     7496
     7497    REAL(wp) ::  second  !< second of the minute
     7498
     7499    REAL(wp), INTENT(IN) ::  second_of_day  !< second of the day
     7500
     7501
     7502    err = 0_iwp
     7503!
     7504!-- Check day_of_year
     7505    IF ( day_of_year < 1_iwp .OR. day_of_year > SUM(days_per_month) )  THEN
     7506       err = err + 1_iwp
     7507    ENDIF
     7508!
     7509!-- Check second_of_day
     7510    IF ( second_of_day < 0.0_wp  .OR.  second_of_day > 86400.0_wp )  THEN
     7511       err = err + 2_iwp
     7512    ENDIF
     7513!
     7514!-- Execute only if given values are valid
     7515    IF ( err == 0_iwp )  THEN
     7516
     7517       day = day_of_year
     7518       month = 0_iwp
     7519
     7520       DO  i = 1, 12
     7521          day = day - days_per_month(i)
     7522          IF ( day < 0 )  THEN
     7523             day = day + days_per_month(i)
     7524             month = i
     7525             EXIT
     7526          ENDIF
     7527       ENDDO
     7528
     7529       hour = INT( second_of_day / 3600.0_wp, KIND=iwp )
     7530
     7531       second = second_of_day - 3600.0_wp * REAL( hour, KIND=wp )
     7532
     7533       minute =  INT( second / 60.0_wp, KIND=iwp )
     7534       
     7535       second = second - 60.0_wp * REAL( minute, KIND=wp )
     7536
     7537       IF ( zone < 0_iwp )  THEN
     7538          plus_minus = '-'
     7539       ELSE
     7540          plus_minus = '+'
     7541       ENDIF
     7542
     7543       WRITE( date_time_string, 100 )                               &
     7544          year, month, day, hour, minute, INT( second, KIND=iwp ),  &
     7545          plus_minus, zone
     7546
     7547    ELSE
     7548!
     7549!--   Return empty string if input is invalid
     7550      date_time_string = REPEAT( " ", LEN(date_time_string) )
     7551
     7552    ENDIF
     7553
     7554 100 FORMAT (I4,'-',I2.2,'-',I2.2,1X,I2.2,':',I2.2,':',I2.2,X,A1,I2.2)
     7555
     7556 END FUNCTION date_time_string
     7557
    74597558 END MODULE netcdf_interface
Note: See TracChangeset for help on using the changeset viewer.