Changeset 42


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

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

Location:
XMLIO_SERVER/trunk/src
Files:
10 edited

Legend:

Unmodified
Added
Removed

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

    r40 r42  
    389389  USE mod_object 
    390390  USE mod_field 
     391  USE mod_field_group 
    391392  USE mod_file 
     393  USE mod_file_group 
    392394  USE mod_axis 
     395  USE mod_axis_group 
    393396  USE mod_grid 
     397  USE mod_grid_group 
    394398  USE mod_zoom 
    395399  IMPLICIT NONE 
    396400    CHARACTER(LEN=*) :: id 
    397401    TYPE(attribut)   :: attrib   
    398  
     402    LOGICAL          :: success 
    399403    IF (current_rank==nb_client) THEN 
    400404     
    401405      SELECT CASE(attrib%object) 
    402406        CASE(field_object) 
    403           CALL field__set_attribut(id,attrib) 
     407          CALL field_group__set_attribut(id,attrib,success) 
     408          IF (.NOT. success) CALL field__set_attribut(id,attrib)          
    404409        CASE(file_object) 
    405           CALL file__set_attribut(id,attrib) 
     410          CALL file_group__set_attribut(id,attrib,success) 
     411          IF (.NOT. success) CALL file__set_attribut(id,attrib)          
    406412        CASE(axis_object) 
    407           CALL axis__set_attribut(id,attrib) 
     413          CALL axis_group__set_attribut(id,attrib,success) 
     414          IF (.NOT. success) CALL axis__set_attribut(id,attrib)          
    408415        CASE(grid_object) 
    409           CALL grid__set_attribut(id,attrib) 
     416          CALL grid_group__set_attribut(id,attrib,success) 
     417          IF (.NOT. success) CALL grid__set_attribut(id,attrib)          
    410418        CASE(zoom_object) 
    411419          CALL zoom__set_attribut(id,attrib) 

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

    r40 r42  
    2929  TYPE(vector_axis),POINTER,SAVE             :: axis_Ids 
    3030  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids  
     31 
     32  INTERFACE axis__set_attribut 
     33    MODULE PROCEDURE axis__set_attribut_id,axis__set_attribut_pt 
     34  END INTERFACE 
    3135 
    3236CONTAINS 
    … …  
    137141  END SUBROUTINE axis__set 
    138142 
    139   SUBROUTINE axis__set_attribut(id,attrib) 
     143  SUBROUTINE axis__set_attribut_id(id,attrib,ok) 
     144  USE mod_attribut 
     145  USE error_msg 
     146  IMPLICIT NONE 
     147    CHARACTER(LEN=*),INTENT(IN)   :: id 
     148    TYPE(attribut),INTENT(IN)     :: attrib 
     149    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok 
     150     
     151    TYPE(axis),POINTER              :: Pt_axis 
     152    INTEGER                         :: Pos 
     153    LOGICAL                         :: success 
     154     
     155    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     156    IF (success) THEN 
     157      Pt_axis=>axis_ids%at(Pos)%Pt 
     158      CALL axis__set_attribut_pt(Pt_axis,attrib) 
     159      IF (PRESENT(OK)) OK=.TRUE. 
     160    ELSE 
     161      IF (.NOT.PRESENT(OK)) THEN 
     162        WRITE(message,*) 'axis id :',id,'is undefined' 
     163        CALL error('mod_axis::axis__set_attribut') 
     164      ELSE 
     165        OK=.FALSE. 
     166      ENDIF 
     167    ENDIF   
     168   
     169  END SUBROUTINE axis__set_attribut_id 
     170       
     171  SUBROUTINE axis__set_attribut_pt(Pt_axis,attrib) 
    140172  USE mod_attribut 
    141173  USE mod_axis_attribut 
    142174  USE error_msg 
    143175  IMPLICIT NONE 
    144     CHARACTER(LEN=*),INTENT(IN) :: id 
     176    TYPE(axis),POINTER        :: Pt_axis 
    145177    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   
    158178     
    159179    SELECT CASE(attrib%name) 
    … …  
    172192       END SELECT 
    173193 
    174      WRITE(message,*) 'axis id ',id,' : Attribute type is incompatible with the provided value' 
     194     WRITE(message,*) 'axis attribut ',attrib%name,' : type :',attrib%type,' : Attribute type is incompatible with the provided value' 
    175195     CALL error('mod_axis::axis__set_attribut') 
    176196     
    177   END SUBROUTINE axis__set_attribut 
     197  END SUBROUTINE axis__set_attribut_pt 
    178198   
    179199  SUBROUTINE axis__print(pt_axis) 

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

    r26 r42  
    1818  TYPE(sorted_list),POINTER,PRIVATE     :: Ids  
    1919 
     20  INTERFACE axis_group__set_attribut 
     21    MODULE PROCEDURE axis_group__set_attribut_id,axis_group__set_attribut_pt 
     22  END INTERFACE 
     23 
    2024CONTAINS 
    2125 
    … …  
    5761     
    5862  END SUBROUTINE axis_group__get 
    59      
     63 
     64 
     65  SUBROUTINE axis_group__set_attribut_id(id,attrib,Ok) 
     66  USE mod_attribut 
     67  USE error_msg 
     68  IMPLICIT NONE 
     69    CHARACTER(LEN=*),INTENT(IN) :: id 
     70    TYPE(attribut),INTENT(IN) :: attrib 
     71    LOGICAL,OPTIONAL,INTENT(out)  :: Ok 
     72     
     73    TYPE(axis_group),POINTER             :: Pt_ag 
     74    INTEGER                         :: Pos 
     75    LOGICAL                         :: success 
     76     
     77    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     78    IF (success) THEN 
     79      Pt_ag=>axis_group_ids%at(Pos)%Pt 
     80      CALL axis_group__set_attribut(Pt_ag,attrib) 
     81      IF (PRESENT(OK)) ok=.TRUE. 
     82    ELSE 
     83      IF (.NOT.PRESENT(OK)) THEN 
     84        WRITE(message,*) 'axis group id :',id,'is undefined' 
     85        CALL error('mod_axis_group::axis_group__set_attribut') 
     86      ELSE 
     87        OK=.FALSE. 
     88      ENDIF 
     89    ENDIF  
     90     
     91  END SUBROUTINE axis_group__set_attribut_id 
     92   
     93  SUBROUTINE axis_group__set_attribut_pt(pt_ag,attrib) 
     94  USE mod_attribut 
     95  USE mod_object 
     96  IMPLICIT NONE 
     97    TYPE(axis_group),POINTER :: Pt_ag 
     98    TYPE(attribut),INTENT(IN) :: attrib 
     99      
     100    IF (attrib%object==axis_object) THEN 
     101      CALL axis__set_attribut(pt_ag%default_attribut,attrib) 
     102    ENDIF 
     103     
     104  END SUBROUTINE axis_group__set_attribut_pt 
     105       
    60106  RECURSIVE SUBROUTINE axis_group__new(Pt_ag,Id) 
    61107  USE string_function 

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

    r40 r42  
    5050  END TYPE field 
    5151   
     52  INTERFACE field__set_attribut 
     53    MODULE PROCEDURE field__set_attribut_id,field__set_attribut_pt 
     54  END INTERFACE 
     55   
    5256  INCLUDE 'vector_field_def.inc' 
    5357   
    … …  
    206210  END SUBROUTINE field__set 
    207211 
    208   SUBROUTINE field__set_attribut(id,attrib) 
     212  SUBROUTINE field__set_attribut_id(id,attrib,Ok) 
    209213  USE mod_attribut 
    210214  USE mod_field_attribut 
    211215  USE error_msg 
    212216  IMPLICIT NONE 
    213     CHARACTER(LEN=*),INTENT(IN) :: id 
    214     TYPE(attribut),INTENT(IN) :: attrib 
    215  
     217    CHARACTER(LEN=*),INTENT(IN)   :: id 
     218    TYPE(attribut),INTENT(IN)     :: attrib 
     219    LOGICAL,OPTIONAL,INTENT(out)  :: Ok 
     220     
    216221    TYPE(field),POINTER             :: Pt_field 
    217222    INTEGER                         :: Pos 
    … …  
    221226    IF (success) THEN 
    222227      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') 
     228      CALL field__set_attribut(Pt_field,attrib) 
     229      IF (PRESENT(OK)) ok=.TRUE. 
     230    ELSE 
     231      IF (.NOT.PRESENT(OK)) THEN 
     232        WRITE(message,*) 'Field id :',id,'is undefined' 
     233        CALL error('mod_field::field__set_attribut') 
     234      ELSE 
     235        OK=.FALSE. 
     236      ENDIF 
    226237    ENDIF   
    227      
     238  END SUBROUTINE field__set_attribut_id 
     239 
     240     
     241  SUBROUTINE field__set_attribut_pt(pt_field,attrib) 
     242  USE mod_attribut 
     243  USE mod_field_attribut 
     244  USE error_msg 
     245  IMPLICIT NONE 
     246    TYPE(field),POINTER             :: Pt_field 
     247    TYPE(attribut),INTENT(IN) :: attrib 
     248 
    228249    SELECT CASE(attrib%name) 
    229250      CASE (field__name) 
    … …  
    253274     END SELECT 
    254275 
    255      WRITE(message,*) 'field id ',id,' : Attribute type is incompatible with the provided value' 
     276     WRITE(message,*) 'field attribut ',attrib%name,' : type :',attrib%type,' : Attribute type is incompatible with the provided value' 
    256277     CALL error('mod_field::field__set_attribut') 
    257278     
    258   END SUBROUTINE field__set_attribut     
     279  END SUBROUTINE field__set_attribut_pt     
    259280 
    260281  SUBROUTINE field__print(pt_field) 

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

    r29 r42  
    1919  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids  
    2020 
     21  INTERFACE field_group__set_attribut 
     22    MODULE PROCEDURE field_group__set_attribut_id,field_group__set_attribut_pt 
     23  END INTERFACE 
     24 
    2125CONTAINS 
    2226 
    … …  
    5963     
    6064  END SUBROUTINE field_group__get 
    61      
     65 
     66  SUBROUTINE field_group__set_attribut_id(id,attrib,Ok) 
     67  USE mod_attribut 
     68  USE error_msg 
     69  IMPLICIT NONE 
     70    CHARACTER(LEN=*),INTENT(IN) :: id 
     71    TYPE(attribut),INTENT(IN) :: attrib 
     72    LOGICAL,OPTIONAL,INTENT(out)  :: Ok 
     73     
     74    TYPE(field_group),POINTER             :: Pt_fg 
     75    INTEGER                         :: Pos 
     76    LOGICAL                         :: success 
     77     
     78    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     79    IF (success) THEN 
     80      Pt_fg=>field_group_ids%at(Pos)%Pt 
     81      CALL field_group__set_attribut(Pt_fg,attrib) 
     82      IF (PRESENT(OK)) ok=.TRUE. 
     83    ELSE 
     84      IF (.NOT.PRESENT(OK)) THEN 
     85        WRITE(message,*) 'Field group id :',id,'is undefined' 
     86        CALL error('mod_field_group::field_group__set_attribut') 
     87      ELSE 
     88        OK=.FALSE. 
     89      ENDIF 
     90    ENDIF  
     91     
     92  END SUBROUTINE field_group__set_attribut_id 
     93   
     94  SUBROUTINE field_group__set_attribut_pt(pt_fg,attrib) 
     95  USE mod_attribut 
     96  USE mod_object 
     97  IMPLICIT NONE 
     98    TYPE(field_group),POINTER :: Pt_fg 
     99    TYPE(attribut),INTENT(IN) :: attrib 
     100      
     101    IF (attrib%object==field_object) THEN 
     102      CALL field__set_attribut(Pt_fg%default_attribut,attrib) 
     103    ENDIF 
     104     
     105  END SUBROUTINE field_group__set_attribut_pt 
     106     
     107       
    62108  RECURSIVE SUBROUTINE field_group__new(Pt_fg,Id) 
    63109  USE string_function 

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

    r40 r42  
    2929  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids  
    3030 
     31  INTERFACE file__set_attribut 
     32    MODULE PROCEDURE file__set_attribut_id,file__set_attribut_pt 
     33  END INTERFACE 
     34 
    3135CONTAINS 
    3236  INCLUDE 'vector_file_contains.inc' 
    … …  
    138142  END SUBROUTINE file__set 
    139143 
    140   SUBROUTINE file__set_attribut(id,attrib) 
     144  SUBROUTINE file__set_attribut_id(id,attrib,ok) 
     145  USE mod_attribut 
     146  USE error_msg 
     147  IMPLICIT NONE 
     148    CHARACTER(LEN=*),INTENT(IN)   :: id 
     149    TYPE(attribut),INTENT(IN)     :: attrib 
     150    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok 
     151     
     152    TYPE(file),POINTER              :: Pt_file 
     153    INTEGER                         :: Pos 
     154    LOGICAL                         :: success 
     155     
     156    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     157    IF (success) THEN 
     158      Pt_file=>file_ids%at(Pos)%Pt 
     159      CALL file__set_attribut_pt(Pt_file,attrib) 
     160      IF (PRESENT(OK)) OK=.TRUE. 
     161    ELSE 
     162      IF (.NOT.PRESENT(OK)) THEN 
     163        WRITE(message,*) 'File id : ',id,' is undefined' 
     164        CALL error('mod_file::file__set_attribut') 
     165      ELSE 
     166        OK=.FALSE. 
     167      ENDIF 
     168    ENDIF   
     169   
     170  END SUBROUTINE file__set_attribut_id 
     171       
     172  SUBROUTINE file__set_attribut_pt(Pt_file,attrib) 
    141173  USE mod_attribut 
    142174  USE mod_file_attribut 
    143175  USE error_msg 
    144176  IMPLICIT NONE 
    145     CHARACTER(LEN=*),INTENT(IN) :: id 
     177    TYPE(file),POINTER        :: Pt_file 
    146178    TYPE(attribut),INTENT(IN) :: attrib 
    147179 
    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   
    159180     
    160181    SELECT CASE(attrib%name) 
    … …  
    173194     END SELECT 
    174195 
    175      WRITE(message,*) 'file id ',id,' : Attribute type is incompatible with the provided value' 
     196     WRITE(message,*) 'file attribut ',attrib%name,' : type : ',attrib%type,' : Attribute type is incompatible with the provided value' 
    176197     CALL error('mod_file::file__set_attribut') 
    177198     
    178   END SUBROUTINE file__set_attribut 
     199  END SUBROUTINE file__set_attribut_pt 
    179200   
    180201      

  • 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) 

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

    r40 r42  
    3030  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids  
    3131 
     32  INTERFACE grid__set_attribut 
     33    MODULE PROCEDURE grid__set_attribut_id,grid__set_attribut_pt 
     34  END INTERFACE 
     35 
    3236CONTAINS 
    3337  INCLUDE 'vector_grid_contains.inc' 
    … …  
    121125 
    122126 
    123   SUBROUTINE grid__set_attribut(id,attrib) 
     127  SUBROUTINE grid__set_attribut_id(id,attrib,ok) 
     128  USE mod_attribut 
     129  USE error_msg 
     130  IMPLICIT NONE 
     131    CHARACTER(LEN=*),INTENT(IN)   :: id 
     132    TYPE(attribut),INTENT(IN)     :: attrib 
     133    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok 
     134     
     135    TYPE(grid),POINTER              :: Pt_grid 
     136    INTEGER                         :: Pos 
     137    LOGICAL                         :: success 
     138     
     139    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     140    IF (success) THEN 
     141      Pt_grid=>grid_ids%at(Pos)%Pt 
     142      CALL grid__set_attribut_pt(Pt_grid,attrib) 
     143      IF (PRESENT(OK)) OK=.TRUE. 
     144    ELSE 
     145      IF (.NOT.PRESENT(OK)) THEN 
     146        WRITE(message,*) 'grid id :',id,'is undefined' 
     147        CALL error('mod_grid::grid__set_attribut') 
     148      ELSE 
     149        OK=.FALSE. 
     150      ENDIF 
     151    ENDIF   
     152   
     153  END SUBROUTINE grid__set_attribut_id 
     154       
     155  SUBROUTINE grid__set_attribut_pt(Pt_grid,attrib) 
    124156  USE mod_attribut 
    125157  USE mod_grid_attribut 
    126158  USE error_msg 
    127159  IMPLICIT NONE 
    128     CHARACTER(LEN=*),INTENT(IN) :: id 
     160    TYPE(grid),POINTER        :: Pt_grid 
    129161    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   
    142162     
    143163    SELECT CASE(attrib%name) 
    … …  
    148168     END SELECT 
    149169 
    150      WRITE(message,*) 'grid id ',id,' : Attribute type is incompatible with the provided value' 
     170     WRITE(message,*) 'grid attribut ',attrib%name,' : type :',attrib%type,' : Attribute type is incompatible with the provided value' 
    151171     CALL error('mod_grid::grid__set_attribut') 
    152172     
    153   END SUBROUTINE grid__set_attribut 
     173  END SUBROUTINE grid__set_attribut_pt 
    154174   
    155175  SUBROUTINE grid__set_dimension(pt_grid, ni, nj) 

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

    r26 r42  
    1818  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids  
    1919 
     20  INTERFACE grid_group__set_attribut 
     21    MODULE PROCEDURE grid_group__set_attribut_id,grid_group__set_attribut_pt 
     22  END INTERFACE 
     23 
    2024CONTAINS 
    2125 
    … …  
    5761     
    5862  END SUBROUTINE grid_group__get 
    59      
     63 
     64 
     65  SUBROUTINE grid_group__set_attribut_id(id,attrib,Ok) 
     66  USE mod_attribut 
     67  USE error_msg 
     68  IMPLICIT NONE 
     69    CHARACTER(LEN=*),INTENT(IN) :: id 
     70    TYPE(attribut),INTENT(IN) :: attrib 
     71    LOGICAL,OPTIONAL,INTENT(out)  :: Ok 
     72     
     73    TYPE(grid_group),POINTER             :: Pt_gg 
     74    INTEGER                         :: Pos 
     75    LOGICAL                         :: success 
     76     
     77    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     78    IF (success) THEN 
     79      Pt_gg=>grid_group_ids%at(Pos)%Pt 
     80      CALL grid_group__set_attribut(Pt_gg,attrib) 
     81      IF (PRESENT(OK)) ok=.TRUE. 
     82    ELSE 
     83      IF (.NOT.PRESENT(OK)) THEN 
     84        WRITE(message,*) 'grid group id :',id,'is undefined' 
     85        CALL error('mod_grid_group::grid_group__set_attribut') 
     86      ELSE 
     87        OK=.FALSE. 
     88      ENDIF 
     89    ENDIF  
     90     
     91  END SUBROUTINE grid_group__set_attribut_id 
     92   
     93  SUBROUTINE grid_group__set_attribut_pt(pt_gg,attrib) 
     94  USE mod_attribut 
     95  USE mod_object 
     96  IMPLICIT NONE 
     97    TYPE(grid_group),POINTER :: Pt_gg 
     98    TYPE(attribut),INTENT(IN) :: attrib 
     99      
     100    IF (attrib%object==grid_object) THEN 
     101      CALL grid__set_attribut(pt_gg%default_attribut,attrib) 
     102    ENDIF 
     103     
     104  END SUBROUTINE grid_group__set_attribut_pt     
     105 
     106 
     107 
    60108  RECURSIVE SUBROUTINE grid_group__new(Pt_gg,Id) 
    61109  USE string_function 

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

    r40 r42  
    3030  TYPE(vector_zoom),POINTER,SAVE             :: zoom_Ids 
    3131  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids  
     32 
     33  INTERFACE zoom__set_attribut 
     34    MODULE PROCEDURE zoom__set_attribut_id,zoom__set_attribut_pt 
     35  END INTERFACE 
    3236   
    3337CONTAINS 
    … …  
    120124   END SUBROUTINE zoom__set    
    121125 
    122  SUBROUTINE zoom__set_attribut(id,attrib) 
     126  SUBROUTINE zoom__set_attribut_id(id,attrib,ok) 
     127  USE mod_attribut 
     128  USE error_msg 
     129  IMPLICIT NONE 
     130    CHARACTER(LEN=*),INTENT(IN)   :: id 
     131    TYPE(attribut),INTENT(IN)     :: attrib 
     132    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok 
     133     
     134    TYPE(zoom),POINTER              :: Pt_zoom 
     135    INTEGER                         :: Pos 
     136    LOGICAL                         :: success 
     137     
     138    CALL sorted_list__find(Ids,hash(Id),Pos,success) 
     139    IF (success) THEN 
     140      Pt_zoom=>zoom_ids%at(Pos)%Pt 
     141      CALL zoom__set_attribut_pt(Pt_zoom,attrib) 
     142      IF (PRESENT(OK)) OK=.TRUE. 
     143    ELSE 
     144      IF (.NOT.PRESENT(OK)) THEN 
     145        WRITE(message,*) 'zoom id :',id,'is undefined' 
     146        CALL error('mod_zoom::zoom__set_attribut') 
     147      ELSE 
     148        OK=.FALSE. 
     149      ENDIF 
     150    ENDIF   
     151   
     152  END SUBROUTINE zoom__set_attribut_id 
     153       
     154  SUBROUTINE zoom__set_attribut_pt(Pt_zoom,attrib) 
    123155  USE mod_attribut 
    124156  USE mod_zoom_attribut 
    125157  USE error_msg 
    126158  IMPLICIT NONE 
    127     CHARACTER(LEN=*),INTENT(IN) :: id 
     159    TYPE(zoom),POINTER        :: Pt_zoom 
    128160    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   
    141161     
    142162    SELECT CASE(attrib%name) 
    … …  
    155175     END SELECT 
    156176 
    157      WRITE(message,*) 'zoom id ',id,' : Attribute type is incompatible with the provided value' 
     177     WRITE(message,*) 'zoom attribut ',attrib%name,' : type :',attrib%type,' : Attribute type is incompatible with the provided value' 
    158178     CALL error('mod_zoom::zoom__set_attribut') 
    159179     
    160   END SUBROUTINE zoom__set_attribut 
     180  END SUBROUTINE zoom__set_attribut_pt 
    161181 
    162182  SUBROUTINE zoom__get(Id,pt_zoom) 
Note: See TracChangeset for help on using the changeset viewer.