Ignore:
Timestamp:
02/14/12 15:36:14 (12 years ago)
Author:
ymipsl
Message:

suppress old fortran interface

YM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • XIOS/trunk/src/fortran/ifield.F90

    r310 r312  
    66   USE FIELDGROUP_INTERFACE 
    77    
    8    TYPE XFieldHandle 
    9       INTEGER(kind = C_INTPTR_T) :: daddr 
    10    END TYPE XFieldHandle 
    11     
    12    TYPE XFieldGroupHandle 
    13       INTEGER(kind = C_INTPTR_T) :: daddr 
    14    END TYPE XFieldGroupHandle 
    15  
    168   TYPE txios(field) 
    179      INTEGER(kind = C_INTPTR_T) :: daddr 
    … …  
    2113      INTEGER(kind = C_INTPTR_T) :: daddr 
    2214   END TYPE txios(fieldgroup) 
    23     
    24    !---------------------------------------------------------------------------- 
    25    INTERFACE set_field_attributes 
    26       MODULE PROCEDURE set_field_attributes_id,set_field_attributes_hdl 
    27    END INTERFACE   
    28     
    29    INTERFACE set_field_group_attributes 
    30       MODULE PROCEDURE set_fieldgroup_attributes_id,set_fieldgroup_attributes_hdl 
    31    END INTERFACE   
    32    !---------------------------------------------------------------------------- 
    33     
    3415    
    3516   CONTAINS ! Fonctions disponibles pour les utilisateurs. 
    … …  
    341322   END FUNCTION  xios(field_is_active_hdl)  
    342323  
    343     
    344     
    345     
    346     
    347     
    348     
    349     
    350  
    351  
    352 !!!!!!!!!!!!!!!!!!!!!!!!!! Ancienne interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    353 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!     
    354    SUBROUTINE set_fieldgroup_attributes_id                                                 & 
    355    (fieldgroup_id, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, & 
    356     prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_) 
    357      
    358       IMPLICIT NONE 
    359       TYPE(XFieldGroupHandle)                       :: fieldgroup_hdl 
    360       CHARACTER(len = *)               , INTENT(IN) :: fieldgroup_id 
    361       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_ 
    362       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_ 
    363       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_ 
    364       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_ 
    365       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_ 
    366       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_ 
    367       INTEGER                , OPTIONAL, INTENT(IN) :: level_ 
    368       INTEGER                , OPTIONAL, INTENT(IN) :: prec_ 
    369       LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_ 
    370       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_ 
    371       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_ 
    372       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_ 
    373       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_ 
    374       REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_ 
    375          
    376       CALL fieldgroup_handle_create(fieldgroup_hdl, fieldgroup_id) 
    377       CALL set_fieldgroup_attributes_hdl                                                          & 
    378          (fieldgroup_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, & 
    379           prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_) 
    380  
    381    END SUBROUTINE set_fieldgroup_attributes_id 
    382  
    383    SUBROUTINE set_fieldgroup_attributes_hdl                                                 & 
    384    (fieldgroup_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, & 
    385     prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_) 
    386       IMPLICIT NONE 
    387       TYPE(XFieldgroupHandle)          , INTENT(IN) :: fieldgroup_hdl 
    388       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_ 
    389       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_ 
    390       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_ 
    391       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_ 
    392       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_ 
    393       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_ 
    394       INTEGER                , OPTIONAL, INTENT(IN) :: level_ 
    395       INTEGER                , OPTIONAL, INTENT(IN) :: prec_ 
    396       LOGICAL(kind = 1)                             :: enabled__ 
    397       LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_ 
    398       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_ 
    399       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_ 
    400       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_ 
    401       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_ 
    402       REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_ 
    403        
    404       IF (PRESENT(name_))           THEN 
    405          CALL cxios_set_fieldgroup_name(fieldgroup_hdl%daddr, name_, len(name_)) 
    406       END IF 
    407       IF (PRESENT(standard_name_))  THEN 
    408          CALL cxios_set_fieldgroup_standard_name(fieldgroup_hdl%daddr, standard_name_, len(standard_name_)) 
    409       END IF 
    410       IF (PRESENT(long_name_))      THEN 
    411          CALL cxios_set_fieldgroup_long_name(fieldgroup_hdl%daddr, long_name_, len(long_name_)) 
    412       END IF 
    413       IF (PRESENT(unit_))           THEN 
    414          CALL cxios_set_fieldgroup_unit(fieldgroup_hdl%daddr, unit_, len(unit_)) 
    415       END IF 
    416       IF (PRESENT(operation_))      THEN 
    417          CALL cxios_set_fieldgroup_operation(fieldgroup_hdl%daddr, operation_, len(operation_)) 
    418       END IF 
    419       IF (PRESENT(freq_op_))        THEN 
    420          CALL cxios_set_fieldgroup_freq_op(fieldgroup_hdl%daddr, freq_op_, len(freq_op_)) 
    421       END IF 
    422       IF (PRESENT(level_))          THEN 
    423          CALL cxios_set_fieldgroup_level(fieldgroup_hdl%daddr, level_) 
    424       END IF 
    425       IF (PRESENT(prec_))           THEN 
    426          CALL cxios_set_fieldgroup_prec(fieldgroup_hdl%daddr, prec_) 
    427       END IF 
    428       IF (PRESENT(enabled_))        THEN 
    429          enabled__ = enabled_   
    430          CALL cxios_set_fieldgroup_enabled(fieldgroup_hdl%daddr, enabled__) 
    431       END IF 
    432       IF (PRESENT(domain_ref_))     THEN 
    433          CALL cxios_set_fieldgroup_domain_ref(fieldgroup_hdl%daddr, domain_ref_, len(domain_ref_)) 
    434       END IF 
    435       IF (PRESENT(axis_ref_))       THEN 
    436          CALL cxios_set_fieldgroup_axis_ref(fieldgroup_hdl%daddr, axis_ref_, len(axis_ref_)) 
    437       END IF 
    438       IF (PRESENT(grid_ref_))       THEN 
    439          CALL cxios_set_fieldgroup_grid_ref(fieldgroup_hdl%daddr, grid_ref_, len(grid_ref_)) 
    440       END IF 
    441       IF (PRESENT(field_ref_))      THEN 
    442          CALL cxios_set_fieldgroup_field_ref(fieldgroup_hdl%daddr, field_ref_, len(field_ref_)) 
    443       END IF 
    444       IF (PRESENT(default_value_))  THEN 
    445          CALL cxios_set_fieldgroup_default_value(fieldgroup_hdl%daddr, default_value_) 
    446       END IF 
    447  
    448    END SUBROUTINE set_fieldgroup_attributes_hdl 
    449     
    450    SUBROUTINE set_field_attributes_id                                                 & 
    451    (field_id, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, & 
    452     prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_) 
    453      
    454       IMPLICIT NONE 
    455       TYPE(XFieldHandle)                            :: field_hdl 
    456       CHARACTER(len = *)               , INTENT(IN) :: field_id 
    457       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_ 
    458       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_ 
    459       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_ 
    460       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_ 
    461       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_ 
    462       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_ 
    463       INTEGER                , OPTIONAL, INTENT(IN) :: level_ 
    464       INTEGER                , OPTIONAL, INTENT(IN) :: prec_ 
    465       LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_ 
    466       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_ 
    467       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_ 
    468       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_ 
    469       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_ 
    470       REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_ 
    471        
    472       CALL field_handle_create(field_hdl, field_id) 
    473       CALL set_field_attributes_hdl                                                          & 
    474          (field_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, & 
    475           prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_) 
    476  
    477    END SUBROUTINE set_field_attributes_id 
    478  
    479    SUBROUTINE set_field_attributes_hdl                                                 & 
    480    (field_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, & 
    481     prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_) 
    482       IMPLICIT NONE 
    483       TYPE(XFieldHandle)               , INTENT(IN) :: field_hdl 
    484       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_ 
    485       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_ 
    486       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_ 
    487       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_ 
    488       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_ 
    489       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_ 
    490       INTEGER                , OPTIONAL, INTENT(IN) :: level_ 
    491       INTEGER                , OPTIONAL, INTENT(IN) :: prec_ 
    492       LOGICAL(kind = 1)                             :: enabled__ 
    493       LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_ 
    494       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_ 
    495       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_ 
    496       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_ 
    497       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_ 
    498       REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_ 
    499        
    500       IF (PRESENT(name_))           THEN 
    501          CALL cxios_set_field_name(field_hdl%daddr, name_, len(name_)) 
    502       END IF 
    503       IF (PRESENT(standard_name_))  THEN 
    504          CALL cxios_set_field_standard_name(field_hdl%daddr, standard_name_, len(standard_name_)) 
    505       END IF 
    506       IF (PRESENT(long_name_))      THEN 
    507          CALL cxios_set_field_long_name(field_hdl%daddr, long_name_, len(long_name_)) 
    508       END IF 
    509       IF (PRESENT(unit_))           THEN 
    510          CALL cxios_set_field_unit(field_hdl%daddr, unit_, len(unit_)) 
    511       END IF 
    512       IF (PRESENT(operation_))      THEN 
    513          CALL cxios_set_field_operation(field_hdl%daddr, operation_, len(operation_)) 
    514       END IF 
    515       IF (PRESENT(freq_op_))        THEN 
    516          CALL cxios_set_field_freq_op(field_hdl%daddr, freq_op_, len(freq_op_)) 
    517       END IF 
    518       IF (PRESENT(level_))          THEN 
    519          CALL cxios_set_field_level(field_hdl%daddr, level_) 
    520       END IF 
    521       IF (PRESENT(prec_))           THEN 
    522          CALL cxios_set_field_prec(field_hdl%daddr, prec_) 
    523       END IF 
    524       IF (PRESENT(enabled_))        THEN 
    525          enabled__ = enabled_   
    526          CALL cxios_set_field_enabled(field_hdl%daddr, enabled__) 
    527       END IF 
    528       IF (PRESENT(domain_ref_))     THEN 
    529          CALL cxios_set_field_domain_ref(field_hdl%daddr, domain_ref_, len(domain_ref_)) 
    530       END IF 
    531       IF (PRESENT(axis_ref_))       THEN 
    532          CALL cxios_set_field_axis_ref(field_hdl%daddr, axis_ref_, len(axis_ref_)) 
    533       END IF 
    534       IF (PRESENT(grid_ref_))       THEN 
    535          CALL cxios_set_field_grid_ref(field_hdl%daddr, grid_ref_, len(grid_ref_)) 
    536       END IF 
    537       IF (PRESENT(field_ref_))      THEN 
    538          CALL cxios_set_field_field_ref(field_hdl%daddr, field_ref_, len(field_ref_)) 
    539       END IF 
    540       IF (PRESENT(default_value_))  THEN 
    541          CALL cxios_set_field_default_value(field_hdl%daddr, default_value_) 
    542       END IF 
    543  
    544    END SUBROUTINE set_field_attributes_hdl 
    545  
    546    SUBROUTINE field_handle_create(ret, idt) 
    547       IMPLICIT NONE 
    548       TYPE(XFieldHandle), INTENT(OUT):: ret 
    549       CHARACTER(len = *), INTENT(IN) :: idt       
    550       CALL cxios_field_handle_create(ret%daddr, idt, len(idt))             
    551    END SUBROUTINE field_handle_create 
    552     
    553    SUBROUTINE fieldgroup_handle_create(ret, idt) 
    554       IMPLICIT NONE 
    555       TYPE(XFieldGroupHandle), INTENT(OUT):: ret 
    556       CHARACTER(len = *)     , INTENT(IN) :: idt       
    557       CALL cxios_fieldgroup_handle_create(ret%daddr, idt, len(idt))             
    558    END SUBROUTINE fieldgroup_handle_create 
    559  
    560    LOGICAL FUNCTION field_valid_id(idt) 
    561       IMPLICIT NONE 
    562       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    563       LOGICAL  (kind = 1)                 :: val 
    564       CALL cxios_field_valid_id(val, idt, len(idt)); 
    565       field_valid_id = val 
    566    END FUNCTION  field_valid_id 
    567   
    568  
    569    LOGICAL FUNCTION fieldgroup_valid_id(idt) 
    570       IMPLICIT NONE 
    571       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    572       LOGICAL  (kind = 1)                 :: val 
    573       CALL cxios_fieldgroup_valid_id(val, idt, len(idt)); 
    574       fieldgroup_valid_id = val 
    575    END FUNCTION  fieldgroup_valid_id 
    576324 
    577325END MODULE IFIELD 
Note: See TracChangeset for help on using the changeset viewer.