Ignore:
Timestamp:
01/26/15 14:39:26 (9 years ago)
Author:
rlacroix
Message:

Revised calendar functionalities:

  • the calendar is now configured from a specific calendar child node of the context in the XML configuration file. Example: <calendar type="Gregorian" start_date="2012-03-01 15:00:00" time_origin="2012-02-29 15:00:00" timestep="1h" />
  • the calendar type should now be configured when defining the start time and/or the time origin.
  • the start time and the time origin are now optional, 0000-01-01 00:00:00 will be used by default. It is also possible to define them partially. For example, 2015 and 2014-12 are valid dates corresponding respectively to 2015-01-01 00:00:00 and 2014-12-01 00:00:00.
  • an optional duration offset can be added to the start date and time origin. For example, it's possible to define the date 2015-01-12 12:00:00 as 2015-01-11 + 36h or 2015-01-11 12:00:00 + 1d. The duration format is the same as the time step. Being that the date is optional, it is possible to only use a duration (for example + 42s is the same as 0000-01-01 00:00:00 + 42s). An error will be raised if a duration based on the time step is used before the time step was configured. For example, the following would cause an error: <calendar type="Gregorian" start_date="+ 1ts" /> but <calendar type="Gregorian" start_date="+ 1ts" timestep="0.5h" /> would not.
  • new Fortran interface to define the calendar:
    • xios_define_calendar(type[, timestep, start_date, time_origin]) will create a calendar when none had previously been defined. Only the type argument is mandatory, the rest is optional. Calendar operations on dates and durations are possible as soon as the calendar is created (either using this procedure or directly from the XML configuration file).
    • the following getter and setter procedures are available: xios_set_timestep, xios_set_start_date, xios_set_time_origin, xios_get_calendar_type, xios_get_timestep, xios_get_start_date, xios_get_time_origin.
  • new Fortran interface to interact with the calendar: xios_update_calendar, xios_get_current_date, xios_get_year_length_in_seconds, xios_get_day_length_in_seconds.
  • new Fortran interface for date conversion: xios_date_get_second_of_year, xios_date_get_day_of_year, xios_date_get_fraction_of_year, xios_date_get_second_of_day, xios_date_get_fraction_of_day.
  • two new placeholders are available to format the file name when splitting the output (split_freq_format attribute):
    • %S the number of seconds since the time origin
    • %D the integral number of days since the time origin
File:
1 edited

Legend:

Unmodified
Added
Removed
  • XIOS/trunk/src/test/test_unstruct_complete.f90

    r537 r549  
    88  INTEGER :: mpi_size 
    99  INTEGER :: ierr 
    10    
     10 
    1111  CHARACTER(len=*),PARAMETER :: id="client" 
    1212  INTEGER :: comm 
    1313  TYPE(xios_duration) :: dtime 
    1414  TYPE(xios_context) :: ctx_hdl 
    15   INTEGER, PARAMETER :: nlon=60  
     15  INTEGER, PARAMETER :: nlon=60 
    1616  INTEGER, PARAMETER :: nlat=30 
    1717  INTEGER,PARAMETER :: ni_glo=100 
    18   INTEGER,PARAMETER :: nj_glo=100  
    19   INTEGER,PARAMETER :: llm=5  
     18  INTEGER,PARAMETER :: nj_glo=100 
     19  INTEGER,PARAMETER :: llm=5 
    2020  DOUBLE PRECISION  :: lval(llm)=1 
    2121  TYPE(xios_field) :: field_hdl 
     
    2323  TYPE(xios_file) :: file_hdl 
    2424  LOGICAL :: ok 
    25    
     25 
    2626  DOUBLE PRECISION,ALLOCATABLE :: lon_glo(:),lat_glo(:) 
    2727  DOUBLE PRECISION,ALLOCATABLE :: bounds_lon_glo(:,:),bounds_lat_glo(:,:) 
     
    4242  INTEGER,ALLOCATABLE :: data_i_index(:) 
    4343  DOUBLE PRECISION,ALLOCATABLE :: field_A_compressed(:,:) 
    44    
     44 
    4545  CALL xios_initialize(id,return_comm=comm) 
    4646  CALL MPI_COMM_RANK(comm,mpi_rank,ierr) 
    4747  CALL MPI_COMM_SIZE(comm,mpi_size,ierr) 
    48    
     48 
    4949  CALL init_wait 
    50    
     50 
    5151  ncell_glo=0 
    5252  DO j=1,nlat 
     
    5555    ncell_glo=ncell_glo+n 
    5656  ENDDO 
    57    
     57 
    5858  ALLOCATE(lon_glo(ncell_glo)) 
    5959  ALLOCATE(lat_glo(ncell_glo)) 
     
    6363  ALLOCATE(field_A_glo(ncell_glo,llm)) 
    6464  ALLOCATE(mask_glo(ncell_glo)) 
    65     
     65 
    6666  ind=0 
    6767  DO j=1,nlat 
     
    7070    if (j==nlat) PRINT*,"--- ",n 
    7171    IF (n<8) n=8 
    72      
     72 
    7373    DO i=1,n 
    7474      ind=ind+1 
     
    7676      ilon=i-0.5 
    7777      ilat=j-0.5 
    78        
     78 
    7979      lat_glo(ind)= 90-(ilat*180./nlat) 
    8080      lon_glo(ind)= (ilon*360./n) 
    81        
    82   
     81 
     82 
    8383      bounds_lat_glo(1,ind)= 90-((ilat-0.5)*180./nlat) 
    8484      bounds_lon_glo(1,ind)=((ilon-0.5)*360./n) 
    85        
     85 
    8686      bounds_lat_glo(2,ind)= 90-((ilat-0.5)*180./nlat) 
    87       bounds_lon_glo(2,ind)=((ilon+0.5)*360./n)  
    88            
     87      bounds_lon_glo(2,ind)=((ilon+0.5)*360./n) 
     88 
    8989      bounds_lat_glo(3,ind)= 90-((ilat+0.5)*180./nlat) 
    90       bounds_lon_glo(3,ind)=((ilon+0.5)*360./n)      
     90      bounds_lon_glo(3,ind)=((ilon+0.5)*360./n) 
    9191 
    9292      bounds_lat_glo(4,ind)= 90-((ilat+0.5)*180./nlat) 
    9393      bounds_lon_glo(4,ind)=((ilon-0.5)*360./n) 
    94        
     94 
    9595    ENDDO 
    9696  ENDDO 
     
    9999  rank=(mpi_size-1)/2 
    100100  ncell_x=sqrt(ncell_glo*1./mpi_size) 
    101    
     101 
    102102  j1=nlat/2 
    103103  DO WHILE(rank>=0) 
     
    106106    n=NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon) 
    107107    np = MIN(n/ncell_x,rank+1) ; 
    108     if (j2==1) np=rank+1  
    109      
     108    if (j2==1) np=rank+1 
     109 
    110110    PRINT *,"domain ",j2,j1,rank,np ; 
    111     DO j=j2,j1   
     111    DO j=j2,j1 
    112112      n=NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon) 
    113113      IF (n<8) n=8 
    114114      DO i=1,n 
    115115        ind=list_ind(i,j) 
    116         IF ( (i-1) < MOD(n,np)*(n/np+1)) THEN  
     116        IF ( (i-1) < MOD(n,np)*(n/np+1)) THEN 
    117117          i_index_glo(ind) = rank - (i-1)/(n/np+1) 
    118         ELSE  
     118        ELSE 
    119119          i_index_glo(ind) = rank-(MOD(n,np)+ (i-1-MOD(n,np)*(n/np+1))/(n/np)) 
    120120        ENDIF 
     
    124124    j1=j2-1 
    125125  ENDDO 
    126          
     126 
    127127  rank=(mpi_size-1)/2+1 
    128128  ncell_x=sqrt(ncell_glo*1./mpi_size) 
    129    
     129 
    130130  j1=nlat/2+1 
    131131  DO WHILE(rank<=mpi_size-1) 
     
    134134    n=NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon) 
    135135    np = MIN(n/ncell_x,mpi_size-rank) ; 
    136     if (j2==nlat) np=mpi_size-rank  
    137      
     136    if (j2==nlat) np=mpi_size-rank 
     137 
    138138    PRINT *,"domain ",j2,j1,rank,np ; 
    139     DO j=j1,j2   
     139    DO j=j1,j2 
    140140      n=NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon) 
    141141      IF (n<8) n=8 
    142142      DO i=1,n 
    143143        ind=list_ind(i,j) 
    144         IF ( (i-1) < MOD(n,np)*(n/np+1)) THEN  
     144        IF ( (i-1) < MOD(n,np)*(n/np+1)) THEN 
    145145          i_index_glo(ind) = rank + (i-1)/(n/np+1) 
    146         ELSE  
     146        ELSE 
    147147          i_index_glo(ind) = rank+(MOD(n,np)+ (i-1-MOD(n,np)*(n/np+1))/(n/np)) 
    148148        ENDIF 
     
    152152    j1=j2+1 
    153153  ENDDO 
    154      
     154 
    155155  ncell=0 
    156156  DO ind=1,ncell_glo 
     
    183183    ENDIF 
    184184  ENDDO 
    185    
     185 
    186186  ALLOCATE(field_A_compressed(data_n_index,llm)) 
    187187  ALLOCATE(data_i_index(data_n_index)) 
     
    194194    ENDIF 
    195195  ENDDO 
    196        
    197    
    198    
     196 
    199197  CALL xios_context_initialize("surface",comm) 
    200198  CALL xios_get_handle("surface",ctx_hdl) 
    201199  CALL xios_set_current_context(ctx_hdl) 
    202    
     200 
     201  CALL xios_define_calendar(type="Julian", & 
     202                            start_date=xios_date(2012, 03, 01, 15, 00, 00), & 
     203                            time_origin=xios_date(2012, 02, 29, 15, 00, 00)) 
     204 
    203205  CALL xios_set_axis_attr("axis_srf",size=llm ,value=lval) ; 
    204206  CALL xios_set_domain_attr("domain_srf",ni_glo=ncell_glo, ni=ncell, ibegin=1, i_index=RESHAPE(i_index,(/ncell,1/) )) 
     
    206208  CALL xios_set_domain_attr("domain_srf",lonvalue=lon,latvalue=lat) 
    207209  CALL xios_set_domain_attr("domain_srf", nvertex=4, bounds_lon=bounds_lon, bounds_lat=bounds_lat ) 
    208      
    209   
     210 
     211 
    210212  dtime%second=3600 
    211213  CALL xios_set_context_attr("surface", timestep=dtime) 
    212214  CALL xios_close_context_definition() 
    213      
     215 
    214216   DO ts=1,24*10 
    215217     CALL xios_update_calendar(ts) 
    216218     CALL xios_send_field("field_A_srf",field_A_compressed) 
    217219    ENDDO 
    218    
     220 
    219221    CALL xios_context_finalize() 
    220222    CALL xios_finalize() 
    221    
     223 
    222224  END PROGRAM test_unstruct_complete 
    223225 
    224226 
    225    
    226  
    227    
     227 
     228 
     229 
Note: See TracChangeset for help on using the changeset viewer.