Ignore:
Timestamp:
10/30/09 16:29:39 (12 years ago)
Author:
ymipsl
Message:

Correction bug sur les ids des file_group
+ possibilité de fixer les attributs des groupes à partir de l'ioserver

File:
1 edited

Legend:

Unmodified
Added
Removed
  • XMLIO_SERVER/trunk/src/XMLIO/mod_file_group.f90

    r41 r42  
    1818  TYPE(sorted_list),POINTER,PRIVATE,SAVE     :: Ids  
    1919 
     20  INTERFACE file_group__set_attribut 
     21    MODULE PROCEDURE file_group__set_attribut_id,file_group__set_attribut_pt 
     22  END INTERFACE 
     23 
    2024CONTAINS 
    2125 
     
    5761     
    5862  END SUBROUTINE file_group__get 
    59      
     63 
     64  SUBROUTINE file_group__set_attribut_id(id,attrib,Ok) 
     65  USE mod_attribut 
     66  USE error_msg 
     67  IMPLICIT NONE 
     68    CHARACTER(LEN=*),INTENT(IN) :: id 
     69    TYPE(attribut),INTENT(IN) :: attrib 
     70    LOGICAL,OPTIONAL,INTENT(out)  :: Ok 
     71     
     72    TYPE(file_group),POINTER             :: Pt_fg 
     73    INTEGER                         :: Pos 
     74    LOGICAL                         :: success 
     75     
     76    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     77    IF (success) THEN 
     78      Pt_fg=>file_group_ids%at(Pos)%Pt 
     79      CALL file_group__set_attribut(Pt_fg,attrib) 
     80      IF (PRESENT(OK)) ok=.TRUE. 
     81    ELSE 
     82      IF (.NOT.PRESENT(OK)) THEN 
     83        WRITE(message,*) 'file group id :',id,' is undefined' 
     84        CALL error('mod_file_group::file_group__set_attribut') 
     85      ELSE 
     86        OK=.FALSE. 
     87      ENDIF 
     88    ENDIF  
     89     
     90  END SUBROUTINE file_group__set_attribut_id 
     91   
     92  SUBROUTINE file_group__set_attribut_pt(pt_fg,attrib) 
     93  USE mod_attribut 
     94  USE mod_object 
     95  IMPLICIT NONE 
     96    TYPE(file_group),POINTER :: Pt_fg 
     97    TYPE(attribut),INTENT(IN) :: attrib 
     98      
     99    IF (attrib%object==file_object) THEN 
     100      CALL file__set_attribut(Pt_fg%default_attribut,attrib) 
     101    ENDIF 
     102     
     103  END SUBROUTINE file_group__set_attribut_pt 
     104   
     105       
    60106  RECURSIVE SUBROUTINE file_group__new(Pt_fg,Id) 
    61107  USE string_function 
     
    89135    TYPE(file_group),POINTER             :: Pt_fg 
    90136    TYPE(file_group),POINTER             :: Pt_fg_out 
    91     CHARACTER(LEN=str_len),OPTIONAL      :: Id 
     137    CHARACTER(LEN=*),OPTIONAL      :: Id 
    92138     
    93139    CALL vector_file_group__get_new(Pt_fg%groups,Pt_fg_out) 
Note: See TracChangeset for help on using the changeset viewer.