Changeset 40 for XMLIO_SERVER


Ignore:
Timestamp:
09/17/09 10:02:37 (15 years ago)
Author:
ymipsl
Message:
  • Les attributs XML peuvent désormais être passer dynamiquement à travers l'interface du server IO.
  • ajout d'un attribut name_suffix pour les fichiers

YM

Location:
XMLIO_SERVER/trunk/src
Files:
9 added
14 edited

Legend:

Unmodified
Added
Removed

  • XMLIO_SERVER/trunk/src/IOSERVER/mod_event_client.f90

    r32 r40  
    287287 
    288288   
     289  SUBROUTINE event__set_attribut(id,attrib) 
     290  USE iomanager 
     291  USE mod_attribut 
     292  IMPLICIT NONE 
     293    CHARACTER(LEN=*),INTENT(IN) :: id 
     294    TYPE(attribut),INTENT(IN)   :: attrib 
     295  
     296    IF (using_server) THEN 
     297      CALL create_request(event_id_set_attribut) 
     298      CALL pack(len(id)) 
     299      CALL pack(id) 
     300      CALL pack(attrib) 
     301      CALL Finalize_request 
     302    ELSE 
     303      CALL iom__set_attribut(id,attrib) 
     304    ENDIF 
     305  
     306  END SUBROUTINE event__set_attribut   
     307 
    289308  SUBROUTINE event__stop_ioserver 
    290309  USE iomanager 

  • XMLIO_SERVER/trunk/src/IOSERVER/mod_event_parameters.f90

    r26 r40  
    1616  INTEGER, PARAMETER :: event_id_set_grid_type_lmdz    = 114 
    1717  INTEGER, PARAMETER :: event_id_write_field1d         = 115 
     18  INTEGER, PARAMETER :: event_id_set_attribut          = 116 
    1819  INTEGER, PARAMETER :: event_id_stop_ioserver         = 999 
    1920END MODULE mod_event_parameters 

  • XMLIO_SERVER/trunk/src/IOSERVER/mod_event_server.f90

    r26 r40  
    6464      CASE (event_id_write_Field3d) 
    6565        CALL event__write_Field3d 
     66 
     67      CASE (event_id_set_attribut) 
     68        CALL event__set_attribut 
    6669 
    6770      CASE (event_id_stop_ioserver) 
    … …  
    414417     
    415418  END SUBROUTINE event__close_io_definition 
    416      
    417      
     419   
     420  SUBROUTINE event__set_attribut 
     421   USE mod_attribut 
     422   IMPLICIT NONE 
     423     TYPE(attribut) :: attrib 
     424     INTEGER        :: len_id 
     425      
     426     CALL unpack(len_id) 
     427     CALL sub_internal 
     428   CONTAINS 
     429       
     430     SUBROUTINE sub_internal 
     431       CHARACTER(LEN=len_id) :: id 
     432        
     433       CALL unpack(id) 
     434       CALL unpack(attrib) 
     435       CALL iom__set_attribut(id,attrib) 
     436       CALL attr_deallocate(attrib) 
     437     END SUBROUTINE sub_internal 
     438  END SUBROUTINE event__set_attribut     
     439 
    418440END MODULE mod_event_server    

  • XMLIO_SERVER/trunk/src/IOSERVER/mod_interface_ioipsl.f90

    r32 r40  
    5050    INTEGER :: i,j 
    5151    CHARACTER(LEN=20) :: direction 
    52       
     52    CHARACTER(LEN=255) :: full_name 
    5353    CALL xmlio__close_definition  
    5454     
    … …  
    7070      IF (pt_zoom%ni_loc*pt_zoom%nj_loc > 0) THEN 
    7171         
     72        full_name=TRIM(pt_file%name) 
     73        IF (pt_file%has_name_suffix) full_name=TRIM(full_name)//TRIM(pt_file%name_suffix)  
    7274        IF ( (pt_zoom%ni_loc == pt_zoom%ni_glo) .AND. (pt_zoom%nj_loc == pt_zoom%nj_glo) ) THEN  
    7375 
    74           CALL histbeg(TRIM(pt_file%name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat, &  
     76          CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat, &  
    7577                     pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,         & 
    7678                     initial_timestep, initial_date, timestep_value,                               & 
    … …  
    7981 
    8082          CALL set_ioipsl_domain_id(pt_grid,nb_server,server_rank,ioipsl_domain_id) 
    81           CALL histbeg(TRIM(pt_file%name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat,  & 
     83          CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat,  & 
    8284                     pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,          & 
    8385                     initial_timestep, initial_date, timestep_value,                                & 

  • XMLIO_SERVER/trunk/src/IOSERVER/mod_iomanager.f90

    r26 r40  
    383383     
    384384  END SUBROUTINE iom__Finalize 
    385   
     385 
     386 
     387  SUBROUTINE iom__set_attribut(id,attrib) 
     388  USE mod_attribut 
     389  USE mod_object 
     390  USE mod_field 
     391  USE mod_file 
     392  USE mod_axis 
     393  USE mod_grid 
     394  USE mod_zoom 
     395  IMPLICIT NONE 
     396    CHARACTER(LEN=*) :: id 
     397    TYPE(attribut)   :: attrib   
     398 
     399    IF (current_rank==nb_client) THEN 
     400     
     401      SELECT CASE(attrib%object) 
     402        CASE(field_object) 
     403          CALL field__set_attribut(id,attrib) 
     404        CASE(file_object) 
     405          CALL file__set_attribut(id,attrib) 
     406        CASE(axis_object) 
     407          CALL axis__set_attribut(id,attrib) 
     408        CASE(grid_object) 
     409          CALL grid__set_attribut(id,attrib) 
     410        CASE(zoom_object) 
     411          CALL zoom__set_attribut(id,attrib) 
     412      END SELECT 
     413    ENDIF 
     414     
     415  END SUBROUTINE iom__set_attribut 
     416    
    386417END MODULE iomanager  
    387418  

  • XMLIO_SERVER/trunk/src/IOSERVER/mod_pack.f90

    r8 r40  
    99                       pack_i,pack_i1,pack_i2,pack_i3,pack_i4,                 & 
    1010                       pack_l,pack_l1,pack_l2,pack_l3,pack_l4,                 & 
    11                        pack_c,pack_c1,pack_c2,pack_c3,pack_c4 
     11                       pack_c,pack_c1,pack_c2,pack_c3,pack_c4,                 & 
     12                       pack_attr 
    1213    END INTERFACE pack 
    1314 
    … …  
    1617                       unpack_i,unpack_i1,unpack_i2,unpack_i3,unpack_i4,       & 
    1718                       unpack_l,unpack_l1,unpack_l2,unpack_l3,unpack_l4,       & 
    18                        unpack_c,unpack_c1,unpack_c2,unpack_c3,unpack_c4 
     19                       unpack_c,unpack_c1,unpack_c2,unpack_c3,unpack_c4,       & 
     20                       unpack_attr 
    1921    END INTERFACE unpack 
    2022 
    … …  
    466468     END SUBROUTINE unpack_field4 
    467469       
     470     SUBROUTINE pack_attr(attrib) 
     471     USE mod_attribut 
     472     USE mod_stdtype 
     473     IMPLICIT NONE 
     474       TYPE(attribut) :: attrib 
     475 
     476       CALL pack(attrib%object) 
     477       CALL pack(attrib%name) 
     478       CALL pack(attrib%type) 
     479       CALL pack(attrib%dim) 
     480       CALL pack(attrib%ndim) 
     481       CALL pack(attrib%string_len) 
     482               
     483       SELECT CASE(attrib%type) 
     484         CASE (integer0) 
     485           CALL pack(attrib%integer0_ptr) 
     486         CASE (integer1) 
     487           CALL pack(attrib%integer1_ptr) 
     488         CASE (integer2) 
     489           CALL pack(attrib%integer2_ptr) 
     490         CASE (real0) 
     491           CALL pack(attrib%real0_ptr) 
     492         CASE (real1) 
     493           CALL pack(attrib%real1_ptr) 
     494         CASE (real2) 
     495           CALL pack(attrib%real2_ptr) 
     496         CASE (logical0) 
     497           CALL pack(attrib%logical0_ptr) 
     498         CASE (logical1) 
     499           CALL pack(attrib%logical1_ptr) 
     500         CASE (logical2) 
     501           CALL pack(attrib%logical2_ptr) 
     502         CASE (string0) 
     503           CALL pack_string0(attrib%string0_ptr) 
     504         CASE (string1) 
     505           CALL pack_string1(attrib%string1_ptr) 
     506         CASE (string2) 
     507           CALL pack(attrib%string2_ptr) 
     508       END SELECT 
     509 
     510     CONTAINS 
     511 
     512       SUBROUTINE pack_string0(str) 
     513         CHARACTER(LEN=attrib%string_len) ::str 
     514           CALL pack(str) 
     515       END SUBROUTINE 
     516 
     517       SUBROUTINE pack_string1(str) 
     518         CHARACTER(LEN=attrib%string_len) ::str(:) 
     519           CALL pack(str) 
     520       END SUBROUTINE 
     521        
     522       SUBROUTINE pack_string2(str) 
     523         CHARACTER(LEN=attrib%string_len) ::str(:,:) 
     524           CALL pack(str) 
     525       END SUBROUTINE 
     526 
     527     END SUBROUTINE pack_attr   
     528 
     529     SUBROUTINE unpack_attr(attrib) 
     530     USE mod_attribut 
     531     USE mod_stdtype 
     532     IMPLICIT NONE 
     533       TYPE(attribut) :: attrib 
     534 
     535       CALL unpack(attrib%object) 
     536       CALL unpack(attrib%name) 
     537       CALL unpack(attrib%type) 
     538       CALL unpack(attrib%dim) 
     539       CALL unpack(attrib%ndim) 
     540       CALL unpack(attrib%string_len) 
     541               
     542       SELECT CASE(attrib%type) 
     543         CASE (integer0) 
     544           ALLOCATE(attrib%integer0_ptr) 
     545           CALL unpack(attrib%integer0_ptr) 
     546         CASE (integer1) 
     547           ALLOCATE(attrib%integer1_ptr(attrib%dim(1))) 
     548           CALL unpack(attrib%integer1_ptr) 
     549         CASE (integer2) 
     550           ALLOCATE(attrib%integer2_ptr(attrib%dim(1),attrib%dim(2))) 
     551           CALL unpack(attrib%integer2_ptr) 
     552         CASE (real0) 
     553           ALLOCATE(attrib%real0_ptr) 
     554           CALL unpack(attrib%real0_ptr) 
     555         CASE (real1) 
     556           ALLOCATE(attrib%real1_ptr(attrib%dim(1))) 
     557           CALL unpack(attrib%real1_ptr) 
     558         CASE (real2) 
     559           ALLOCATE(attrib%real2_ptr(attrib%dim(1),attrib%dim(2))) 
     560         CASE (logical0) 
     561           ALLOCATE(attrib%logical0_ptr) 
     562           CALL unpack(attrib%logical0_ptr) 
     563         CASE (logical1) 
     564           ALLOCATE(attrib%logical1_ptr(attrib%dim(1))) 
     565           CALL unpack(attrib%logical1_ptr) 
     566         CASE (logical2) 
     567           ALLOCATE(attrib%logical2_ptr(attrib%dim(1),attrib%dim(2))) 
     568           CALL unpack(attrib%logical2_ptr) 
     569         CASE (string0) 
     570           ALLOCATE(attrib%string0_ptr) 
     571           CALL unpack_string0 
     572         CASE (string1) 
     573           ALLOCATE(attrib%string1_ptr(attrib%dim(1))) 
     574           CALL unpack_string1 
     575         CASE (string2) 
     576           ALLOCATE(attrib%string2_ptr(attrib%dim(1),attrib%dim(2))) 
     577           CALL unpack_string2 
     578       END SELECT 
     579 
     580     CONTAINS 
     581 
     582       SUBROUTINE unpack_string0 
     583         CHARACTER(LEN=attrib%string_len) ::str 
     584           CALL unpack(str) 
     585           attrib%string0_ptr=str 
     586       END SUBROUTINE 
     587 
     588       SUBROUTINE unpack_string1 
     589         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1)) 
     590           CALL unpack(str) 
     591           attrib%string1_ptr=str 
     592       END SUBROUTINE 
     593        
     594       SUBROUTINE unpack_string2 
     595         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1),attrib%dim(2)) 
     596           CALL unpack(str) 
     597           attrib%string2_ptr=str 
     598       END SUBROUTINE 
     599 
     600     END SUBROUTINE unpack_attr               
     601 
     602      
    468603  END MODULE mod_pack 

  • XMLIO_SERVER/trunk/src/IOSERVER/server.f90

    r26 r40  
    88  USE mod_interface_ioipsl 
    99  USE mod_ioserver_namelist 
     10   
    1011  IMPLICIT NONE 
    1112  INCLUDE 'mpif.h' 

  • XMLIO_SERVER/trunk/src/XMLIO/mod_axis.f90

    r29 r40  
    137137  END SUBROUTINE axis__set 
    138138 
     139  SUBROUTINE axis__set_attribut(id,attrib) 
     140  USE mod_attribut 
     141  USE mod_axis_attribut 
     142  USE error_msg 
     143  IMPLICIT NONE 
     144    CHARACTER(LEN=*),INTENT(IN) :: id 
     145    TYPE(attribut),INTENT(IN) :: attrib 
     146 
     147    TYPE(axis),POINTER              :: Pt_axis 
     148    INTEGER                         :: Pos 
     149    LOGICAL                         :: success 
     150     
     151    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     152    IF (success) THEN 
     153      Pt_axis=>axis_ids%at(Pos)%Pt 
     154    ELSE 
     155      WRITE(message,*) 'axis id :',id,'is undefined' 
     156      CALL error('mod_axis::axis__set_attribut') 
     157    ENDIF   
     158     
     159    SELECT CASE(attrib%name) 
     160      CASE (axis__name) 
     161        IF (attrib%type==string0) CALL  axis__set(pt_axis,name=attrib%string0_ptr) ; RETURN 
     162      CASE (axis__description) 
     163        IF (attrib%type==string0) CALL  axis__set(pt_axis,description=attrib%string0_ptr) ; RETURN 
     164      CASE (axis__unit) 
     165        IF (attrib%type==string0) CALL  axis__set(pt_axis,unit=attrib%string0_ptr) ; RETURN 
     166      CASE (axis__size) 
     167        IF (attrib%type==integer0) CALL  axis__set(pt_axis,a_size=attrib%integer0_ptr) ; RETURN 
     168      CASE (axis__values) 
     169        IF (attrib%type==real1) CALL  axis__set(pt_axis,values=attrib%real1_ptr) ; RETURN 
     170      CASE (axis__positive) 
     171        IF (attrib%type==logical0) CALL  axis__set(pt_axis,positive=attrib%logical0_ptr) ; RETURN 
     172       END SELECT 
     173 
     174     WRITE(message,*) 'axis id ',id,' : Attribute type is incompatible with the provided value' 
     175     CALL error('mod_axis::axis__set_attribut') 
     176     
     177  END SUBROUTINE axis__set_attribut 
     178   
    139179  SUBROUTINE axis__print(pt_axis) 
    140180  IMPLICIT NONE 

  • XMLIO_SERVER/trunk/src/XMLIO/mod_field.f90

    r35 r40  
    206206  END SUBROUTINE field__set 
    207207 
     208  SUBROUTINE field__set_attribut(id,attrib) 
     209  USE mod_attribut 
     210  USE mod_field_attribut 
     211  USE error_msg 
     212  IMPLICIT NONE 
     213    CHARACTER(LEN=*),INTENT(IN) :: id 
     214    TYPE(attribut),INTENT(IN) :: attrib 
     215 
     216    TYPE(field),POINTER             :: Pt_field 
     217    INTEGER                         :: Pos 
     218    LOGICAL                         :: success 
     219     
     220    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     221    IF (success) THEN 
     222      Pt_field=>field_ids%at(Pos)%Pt 
     223    ELSE 
     224      WRITE(message,*) 'Field id :',id,'is undefined' 
     225      CALL error('mod_field::field__set_attribut') 
     226    ENDIF   
     227     
     228    SELECT CASE(attrib%name) 
     229      CASE (field__name) 
     230        IF (attrib%type==string0) CALL  field__set(pt_field,name=attrib%string0_ptr) ; RETURN 
     231      CASE (field__field_ref) 
     232        IF (attrib%type==string0) CALL  field__set(pt_field,ref=attrib%string0_ptr) ; RETURN 
     233      CASE (field__description) 
     234        IF (attrib%type==string0) CALL  field__set(pt_field,description=attrib%string0_ptr) ; RETURN 
     235      CASE (field__unit) 
     236        IF (attrib%type==string0) CALL  field__set(pt_field,unit=attrib%string0_ptr) ; RETURN 
     237      CASE (field__operation) 
     238        IF (attrib%type==string0) CALL  field__set(pt_field,operation=attrib%string0_ptr) ; RETURN 
     239      CASE (field__freq_op) 
     240        IF (attrib%type==integer0) CALL  field__set(pt_field,freq_op=attrib%integer0_ptr) ; RETURN 
     241      CASE (field__axis_ref) 
     242        IF (attrib%type==string0) CALL  field__set(pt_field,axis_ref=attrib%string0_ptr) ; RETURN 
     243      CASE (field__grid_ref) 
     244        IF (attrib%type==string0) CALL  field__set(pt_field,grid_ref=attrib%string0_ptr) ; RETURN 
     245      CASE (field__zoom_ref) 
     246        IF (attrib%type==string0) CALL  field__set(pt_field,zoom_ref=attrib%string0_ptr) ; RETURN 
     247      CASE (field__prec) 
     248        IF (attrib%type==integer0) CALL  field__set(pt_field,prec=attrib%integer0_ptr) ; RETURN 
     249      CASE (field__level) 
     250        IF (attrib%type==integer0) CALL  field__set(pt_field,level=attrib%integer0_ptr) ; RETURN 
     251      CASE (field__enabled) 
     252        IF (attrib%type==logical0) CALL  field__set(pt_field,enabled=attrib%logical0_ptr) ; RETURN 
     253     END SELECT 
     254 
     255     WRITE(message,*) 'field id ',id,' : Attribute type is incompatible with the provided value' 
     256     CALL error('mod_field::field__set_attribut') 
     257     
     258  END SUBROUTINE field__set_attribut     
    208259 
    209260  SUBROUTINE field__print(pt_field) 

  • XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90

    r26 r40  
    1010    CHARACTER(len=str_len)           :: name 
    1111    LOGICAL                          :: has_name 
     12    CHARACTER(len=str_len)           :: name_suffix 
     13    LOGICAL                          :: has_name_suffix 
    1214    CHARACTER(len=str_len)           :: description 
    1315    LOGICAL                          :: has_description 
    … …  
    7981   pt_file%has_id           = .FALSE. 
    8082   pt_file%has_name         = .FALSE. 
     83   pt_file%has_name_suffix  = .FALSE. 
    8184   pt_file%has_description  = .FALSE. 
    8285   pt_file%has_output_freq  = .FALSE. 
    … …  
    9396  END SUBROUTINE file__new 
    9497 
    95   SUBROUTINE file__set(pt_file, name, description, output_freq, output_level,enabled) 
     98  SUBROUTINE file__set(pt_file, name, name_suffix, description, output_freq, output_level,enabled) 
    9699  IMPLICIT NONE 
    97100    TYPE(file), POINTER         :: pt_file 
    98101    CHARACTER(len=*)  ,OPTIONAL :: name 
     102    CHARACTER(len=*)  ,OPTIONAL :: name_suffix 
    99103    CHARACTER(len=*)  ,OPTIONAL :: description 
    100104    INTEGER           ,OPTIONAL :: output_freq 
    … …  
    107111    ENDIF 
    108112 
     113    IF (PRESENT(name_suffix)) THEN 
     114        pt_file%name_suffix=TRIM(ADJUSTL(name_suffix)) 
     115        pt_file%has_name_suffix = .TRUE. 
     116    ENDIF 
     117 
    109118    IF (PRESENT(description)) THEN 
    110119        pt_file%description=TRIM(ADJUSTL(description)) 
    … …  
    129138  END SUBROUTINE file__set 
    130139 
     140  SUBROUTINE file__set_attribut(id,attrib) 
     141  USE mod_attribut 
     142  USE mod_file_attribut 
     143  USE error_msg 
     144  IMPLICIT NONE 
     145    CHARACTER(LEN=*),INTENT(IN) :: id 
     146    TYPE(attribut),INTENT(IN) :: attrib 
     147 
     148    TYPE(file),POINTER              :: Pt_file 
     149    INTEGER                         :: Pos 
     150    LOGICAL                         :: success 
     151     
     152    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     153    IF (success) THEN 
     154      Pt_file=>file_ids%at(Pos)%Pt 
     155    ELSE 
     156      WRITE(message,*) 'File id :',id,'is undefined' 
     157      CALL error('mod_file::file__set_attribut') 
     158    ENDIF   
     159     
     160    SELECT CASE(attrib%name) 
     161      CASE (file__name) 
     162        IF (attrib%type==string0) CALL  file__set(pt_file,name=attrib%string0_ptr) ; RETURN 
     163      CASE (file__name_suffix) 
     164        IF (attrib%type==string0) CALL  file__set(pt_file,name_suffix=attrib%string0_ptr) ; RETURN 
     165      CASE (file__description) 
     166        IF (attrib%type==string0) CALL  file__set(pt_file,description=attrib%string0_ptr) ; RETURN 
     167      CASE (file__output_freq) 
     168        IF (attrib%type==integer0) CALL  file__set(pt_file,output_freq=attrib%integer0_ptr) ; RETURN 
     169      CASE (file__output_level) 
     170        IF (attrib%type==integer0) CALL  file__set(pt_file,output_level=attrib%integer0_ptr) ; RETURN 
     171      CASE (file__enabled) 
     172        IF (attrib%type==logical0) CALL  file__set(pt_file,enabled=attrib%logical0_ptr) ; RETURN 
     173     END SELECT 
     174 
     175     WRITE(message,*) 'file id ',id,' : Attribute type is incompatible with the provided value' 
     176     CALL error('mod_file::file__set_attribut') 
     177     
     178  END SUBROUTINE file__set_attribut 
     179   
     180      
    131181  SUBROUTINE file__get_field_list(pt_file,pt_field_list) 
    132182  IMPLICIT NONE 
    … …  
    153203    ELSE 
    154204      PRINT *,"name undefined" 
     205    ENDIF 
     206 
     207    IF (pt_file%has_name_suffix) THEN 
     208      PRINT *,"name_suffix = ",TRIM(pt_file%name_suffix) 
     209    ELSE 
     210      PRINT *,"name_suffix undefined" 
    155211    ENDIF 
    156212     
    … …  
    199255    ELSE 
    200256        pt_file_out%has_name=.FALSE. 
     257    ENDIF 
     258 
     259    IF (pt_file_in%has_name_suffix) THEN 
     260        pt_file_out%name_suffix=pt_file_in%name_suffix 
     261        pt_file_out%has_name_suffix=.TRUE. 
     262    ELSE IF ( pt_file_default%has_name_suffix) THEN 
     263        pt_file_out%name_suffix=pt_file_default%name_suffix 
     264        pt_file_out%has_name_suffix=.TRUE. 
     265    ELSE 
     266        pt_file_out%has_name_suffix=.FALSE. 
    201267    ENDIF 
    202268         

  • XMLIO_SERVER/trunk/src/XMLIO/mod_grid.f90

    r29 r40  
    120120  END SUBROUTINE grid__set 
    121121 
     122 
     123  SUBROUTINE grid__set_attribut(id,attrib) 
     124  USE mod_attribut 
     125  USE mod_grid_attribut 
     126  USE error_msg 
     127  IMPLICIT NONE 
     128    CHARACTER(LEN=*),INTENT(IN) :: id 
     129    TYPE(attribut),INTENT(IN) :: attrib 
     130 
     131    TYPE(grid),POINTER              :: Pt_grid 
     132    INTEGER                         :: Pos 
     133    LOGICAL                         :: success 
     134     
     135    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     136    IF (success) THEN 
     137      Pt_grid=>grid_ids%at(Pos)%Pt 
     138    ELSE 
     139      WRITE(message,*) 'grid id :',id,'is undefined' 
     140      CALL error('mod_grid::grid__set_attribut') 
     141    ENDIF   
     142     
     143    SELECT CASE(attrib%name) 
     144      CASE (grid__name) 
     145        IF (attrib%type==string0) CALL  grid__set(pt_grid,name=attrib%string0_ptr) ; RETURN 
     146      CASE (grid__description) 
     147        IF (attrib%type==string0) CALL  grid__set(pt_grid,description=attrib%string0_ptr) ; RETURN 
     148     END SELECT 
     149 
     150     WRITE(message,*) 'grid id ',id,' : Attribute type is incompatible with the provided value' 
     151     CALL error('mod_grid::grid__set_attribut') 
     152     
     153  END SUBROUTINE grid__set_attribut 
     154   
    122155  SUBROUTINE grid__set_dimension(pt_grid, ni, nj) 
    123156  IMPLICIT NONE 

  • XMLIO_SERVER/trunk/src/XMLIO/mod_parse_xml.f90

    r29 r40  
    750750    ENDIF 
    751751 
     752    IF (is_attribute_exist(node,"name_suffix")) THEN 
     753      value =  getAttribute(node,"name_suffix") 
     754      CALL file__set(pt_file,name_suffix=TRIM(value)) 
     755    ENDIF 
     756 
    752757    IF (is_attribute_exist(node,"description")) THEN 
    753758      value =  getAttribute(node,"description") 

  • XMLIO_SERVER/trunk/src/XMLIO/mod_zoom.f90

    r29 r40  
    120120   END SUBROUTINE zoom__set    
    121121 
     122 SUBROUTINE zoom__set_attribut(id,attrib) 
     123  USE mod_attribut 
     124  USE mod_zoom_attribut 
     125  USE error_msg 
     126  IMPLICIT NONE 
     127    CHARACTER(LEN=*),INTENT(IN) :: id 
     128    TYPE(attribut),INTENT(IN) :: attrib 
     129 
     130    TYPE(zoom),POINTER             :: Pt_zoom 
     131    INTEGER                         :: Pos 
     132    LOGICAL                         :: success 
     133     
     134    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     135    IF (success) THEN 
     136      Pt_zoom=>zoom_ids%at(Pos)%Pt 
     137    ELSE 
     138      WRITE(message,*) 'zoom id :',id,'is undefined' 
     139      CALL error('mod_zoom::zoom__set_attribut') 
     140    ENDIF   
     141     
     142    SELECT CASE(attrib%name) 
     143      CASE (zoom__name) 
     144        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,name=attrib%string0_ptr) ; RETURN 
     145      CASE (zoom__description) 
     146        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,description=attrib%string0_ptr) ; RETURN 
     147      CASE (zoom__ni) 
     148        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ni_glo=attrib%integer0_ptr) ; RETURN 
     149      CASE (zoom__nj) 
     150        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,nj_glo=attrib%integer0_ptr) ; RETURN 
     151      CASE (zoom__ibegin) 
     152        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ibegin_glo=attrib%integer0_ptr) ; RETURN 
     153      CASE (zoom__jbegin) 
     154        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,jbegin_glo=attrib%integer0_ptr) ; RETURN 
     155     END SELECT 
     156 
     157     WRITE(message,*) 'zoom id ',id,' : Attribute type is incompatible with the provided value' 
     158     CALL error('mod_zoom::zoom__set_attribut') 
     159     
     160  END SUBROUTINE zoom__set_attribut 
    122161 
    123162  SUBROUTINE zoom__get(Id,pt_zoom) 

  • XMLIO_SERVER/trunk/src/XMLIO/string_function.f90

    r8 r40  
    66CONTAINS 
    77 
     8  FUNCTION stdstr(string) 
     9  USE mod_xmlio_parameters 
     10  IMPLICIT NONE 
     11    CHARACTER(LEN=*),INTENT(IN) :: string 
     12    CHARACTER(LEN=str_len) :: stdstr 
     13     
     14    stdstr=string 
     15  END FUNCTION stdstr 
     16     
     17   
    818  FUNCTION Hash(Str) 
    919  IMPLICIT NONE   
Note: See TracChangeset for help on using the changeset viewer.