Changeset 312


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

suppress old fortran interface

YM

Location:
XIOS/trunk/src/fortran
Files:
15 edited

Legend:

Unmodified
Added
Removed

  • XIOS/trunk/src/fortran/context_interface.f90

    r286 r312  
    3838      END SUBROUTINE cxios_context_set_current 
    3939 
    40       SUBROUTINE cxios_context_create(context, context_id, context_id_size, calendar_type, & 
    41                                      year, month, day, hour, minute, second) BIND(C) 
    42          USE ISO_C_BINDING 
    43          INTEGER  (kind = C_INTPTR_T)               :: context 
    44          CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: context_id 
    45          INTEGER  (kind = C_INT)     , VALUE        :: context_id_size 
    46          INTEGER  (kind = C_INT)     , VALUE        :: calendar_type, year, month, day, hour, minute, second 
    47       END SUBROUTINE cxios_context_create 
    48  
    4940      SUBROUTINE cxios_context_valid_id(ret, idt, idt_size) BIND(C) 
    5041         USE ISO_C_BINDING 

  • XIOS/trunk/src/fortran/domain_interface.f90

    r286 r312  
    142142      END SUBROUTINE cxios_set_domain_zoom_jbegin 
    143143 
    144       SUBROUTINE cxios_set_domain_zoom_ni_loc(domain_hdl, zoom_ni_loc) BIND(C) 
    145          USE ISO_C_BINDING 
    146          INTEGER (kind = C_INTPTR_T), VALUE :: domain_hdl 
    147          INTEGER (kind = C_INT)     , VALUE :: zoom_ni_loc 
    148       END SUBROUTINE cxios_set_domain_zoom_ni_loc 
    149  
    150       SUBROUTINE cxios_set_domain_zoom_nj_loc(domain_hdl, zoom_nj_loc) BIND(C) 
    151          USE ISO_C_BINDING 
    152          INTEGER (kind = C_INTPTR_T), VALUE :: domain_hdl 
    153          INTEGER (kind = C_INT)     , VALUE :: zoom_nj_loc 
    154       END SUBROUTINE cxios_set_domain_zoom_nj_loc 
    155  
    156       SUBROUTINE cxios_set_domain_zoom_ibegin_loc(domain_hdl, zoom_ibegin_loc) BIND(C) 
    157          USE ISO_C_BINDING 
    158          INTEGER (kind = C_INTPTR_T), VALUE :: domain_hdl 
    159          INTEGER (kind = C_INT)     , VALUE :: zoom_ibegin_loc 
    160       END SUBROUTINE cxios_set_domain_zoom_ibegin_loc 
    161  
    162       SUBROUTINE cxios_set_domain_zoom_jbegin_loc(domain_hdl, zoom_jbegin_loc) BIND(C) 
    163          USE ISO_C_BINDING 
    164          INTEGER (kind = C_INTPTR_T), VALUE :: domain_hdl 
    165          INTEGER (kind = C_INT)     , VALUE :: zoom_jbegin_loc 
    166       END SUBROUTINE cxios_set_domain_zoom_jbegin_loc 
    167  
    168144      SUBROUTINE cxios_set_domain_data_n_index(domain_hdl, data_n_index) BIND(C) 
    169145         USE ISO_C_BINDING 

  • XIOS/trunk/src/fortran/domaingroup_interface.f90

    r286 r312  
    142142      END SUBROUTINE cxios_set_domaingroup_zoom_jbegin 
    143143 
    144       SUBROUTINE cxios_set_domaingroup_zoom_ni_loc(domaingroup_hdl, zoom_ni_loc) BIND(C) 
    145          USE ISO_C_BINDING 
    146          INTEGER (kind = C_INTPTR_T), VALUE :: domaingroup_hdl 
    147          INTEGER (kind = C_INT)     , VALUE :: zoom_ni_loc 
    148       END SUBROUTINE cxios_set_domaingroup_zoom_ni_loc 
    149  
    150       SUBROUTINE cxios_set_domaingroup_zoom_nj_loc(domaingroup_hdl, zoom_nj_loc) BIND(C) 
    151          USE ISO_C_BINDING 
    152          INTEGER (kind = C_INTPTR_T), VALUE :: domaingroup_hdl 
    153          INTEGER (kind = C_INT)     , VALUE :: zoom_nj_loc 
    154       END SUBROUTINE cxios_set_domaingroup_zoom_nj_loc 
    155  
    156       SUBROUTINE cxios_set_domaingroup_zoom_ibegin_loc(domaingroup_hdl, zoom_ibegin_loc) BIND(C) 
    157          USE ISO_C_BINDING 
    158          INTEGER (kind = C_INTPTR_T), VALUE :: domaingroup_hdl 
    159          INTEGER (kind = C_INT)     , VALUE :: zoom_ibegin_loc 
    160       END SUBROUTINE cxios_set_domaingroup_zoom_ibegin_loc 
    161  
    162       SUBROUTINE cxios_set_domaingroup_zoom_jbegin_loc(domaingroup_hdl, zoom_jbegin_loc) BIND(C) 
    163          USE ISO_C_BINDING 
    164          INTEGER (kind = C_INTPTR_T), VALUE :: domaingroup_hdl 
    165          INTEGER (kind = C_INT)     , VALUE :: zoom_jbegin_loc 
    166       END SUBROUTINE cxios_set_domaingroup_zoom_jbegin_loc 
    167  
    168144      SUBROUTINE cxios_set_domaingroup_data_n_index(domaingroup_hdl, data_n_index) BIND(C) 
    169145         USE ISO_C_BINDING 

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

    r286 r312  
    55   USE AXIS_INTERFACE 
    66   USE AXISGROUP_INTERFACE 
    7     
    8    TYPE XAxisHandle 
    9       INTEGER(kind = C_INTPTR_T) :: daddr 
    10    END TYPE XAxisHandle 
    11     
    12    TYPE XAxisGroupHandle 
    13       INTEGER(kind = C_INTPTR_T) :: daddr 
    14    END TYPE XAxisGroupHandle 
    157 
    168   TYPE txios(axis) 
    … …  
    2214   END TYPE txios(axisgroup) 
    2315    
    24    !---------------------------------------------------------------------------- 
    25    INTERFACE set_axis_attributes 
    26       MODULE PROCEDURE set_axis_attributes_id,set_axis_attributes_hdl 
    27    END INTERFACE   
    28     
    29    INTERFACE set_axis_group_attributes 
    30       MODULE PROCEDURE set_axisgroup_attributes_id,set_axisgroup_attributes_hdl 
    31    END INTERFACE   
    32    !---------------------------------------------------------------------------- 
    3316 
    3417          
    … …  
    199182 
    200183   END FUNCTION  xios(is_valid_axisgroup) 
    201     
    202  
    203  
    204  
    205 !!!!!!!!!!!!! anciennes interfaces  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    206 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    207  
    208    SUBROUTINE set_axis_attributes_id(axis_id, name_, standard_name_, long_name_, unit_, size_, zvalue_) 
    209       IMPLICIT NONE 
    210       TYPE(XAxisHandle)                                      :: axis_hdl 
    211       CHARACTER(len = *)                        , INTENT(IN) :: axis_id 
    212       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_ 
    213       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_ 
    214       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_ 
    215       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_ 
    216       INTEGER                         , OPTIONAL, INTENT(IN) :: size_ 
    217       REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:) 
    218        
    219       CALL axis_handle_create(axis_hdl, axis_id) 
    220       CALL set_axis_attributes_hdl(axis_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_) 
    221  
    222    END SUBROUTINE set_axis_attributes_id 
    223  
    224    SUBROUTINE set_axis_attributes_hdl(axis_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_) 
    225       IMPLICIT NONE 
    226       TYPE(XAxisHandle)                         , INTENT(IN) :: axis_hdl 
    227       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_ 
    228       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_ 
    229       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_ 
    230       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_ 
    231       INTEGER                         , OPTIONAL, INTENT(IN) :: size_ 
    232       REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:) 
    233        
    234       IF (PRESENT(name_))           THEN 
    235          CALL cxios_set_axis_name(axis_hdl%daddr, name_, len(name_)) 
    236       END IF 
    237       IF (PRESENT(standard_name_))  THEN 
    238          CALL cxios_set_axis_standard_name(axis_hdl%daddr, standard_name_, len(standard_name_)) 
    239       END IF 
    240       IF (PRESENT(long_name_))      THEN 
    241          CALL cxios_set_axis_long_name(axis_hdl%daddr, long_name_, len(long_name_)) 
    242       END IF 
    243       IF (PRESENT(unit_))           THEN 
    244          CALL cxios_set_axis_unit(axis_hdl%daddr, unit_, len(unit_)) 
    245       END IF 
    246       IF (PRESENT(size_))           THEN 
    247          CALL cxios_set_axis_size(axis_hdl%daddr, size_) 
    248       END IF 
    249       IF (PRESENT(zvalue_))         THEN 
    250          CALL cxios_set_axis_zvalue(axis_hdl%daddr, zvalue_, size(zvalue_, 1)) 
    251       END IF 
    252    END SUBROUTINE set_axis_attributes_hdl 
    253     
    254    SUBROUTINE set_axisgroup_attributes_id(axisgroup_id, name_, standard_name_, long_name_, unit_, size_, zvalue_) 
    255       IMPLICIT NONE 
    256       TYPE(XAxisGroupHandle)                                 :: axisgroup_hdl 
    257       CHARACTER(len = *)                        , INTENT(IN) :: axisgroup_id 
    258       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_ 
    259       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_ 
    260       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_ 
    261       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_ 
    262       INTEGER                         , OPTIONAL, INTENT(IN) :: size_ 
    263       REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:) 
    264        
    265       CALL axisgroup_handle_create(axisgroup_hdl, axisgroup_id) 
    266       CALL set_axisgroup_attributes_hdl(axisgroup_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_) 
    267  
    268    END SUBROUTINE set_axisgroup_attributes_id 
    269     
    270    SUBROUTINE set_axisgroup_attributes_hdl(axisgroup_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_) 
    271       IMPLICIT NONE 
    272       TYPE(XAxisGroupHandle)                    , INTENT(IN) :: axisgroup_hdl 
    273       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_ 
    274       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_ 
    275       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_ 
    276       CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_ 
    277       INTEGER                         , OPTIONAL, INTENT(IN) :: size_ 
    278       REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:) 
    279        
    280       IF (PRESENT(name_))           THEN 
    281          CALL cxios_set_axisgroup_name(axisgroup_hdl%daddr, name_, len(name_)) 
    282       END IF 
    283       IF (PRESENT(standard_name_))  THEN 
    284          CALL cxios_set_axisgroup_standard_name(axisgroup_hdl%daddr, standard_name_, len(standard_name_)) 
    285       END IF 
    286       IF (PRESENT(long_name_))      THEN 
    287          CALL cxios_set_axisgroup_long_name(axisgroup_hdl%daddr, long_name_, len(long_name_)) 
    288       END IF 
    289       IF (PRESENT(unit_))           THEN 
    290          CALL cxios_set_axisgroup_unit(axisgroup_hdl%daddr, unit_, len(unit_)) 
    291       END IF 
    292       IF (PRESENT(size_))           THEN 
    293          CALL cxios_set_axisgroup_size(axisgroup_hdl%daddr, size_) 
    294       END IF 
    295       IF (PRESENT(zvalue_))         THEN 
    296          CALL cxios_set_axisgroup_zvalue(axisgroup_hdl%daddr, zvalue_, size(zvalue_, 1)) 
    297       END IF 
    298    END SUBROUTINE set_axisgroup_attributes_hdl 
    299  
    300    SUBROUTINE axis_handle_create(ret, idt) 
    301       IMPLICIT NONE 
    302       TYPE(XAxisHandle) , INTENT(OUT):: ret 
    303       CHARACTER(len = *), INTENT(IN) :: idt       
    304       CALL cxios_axis_handle_create(ret%daddr, idt, len(idt))             
    305    END SUBROUTINE axis_handle_create 
    306     
    307    SUBROUTINE axisgroup_handle_create(ret, idt) 
    308       IMPLICIT NONE 
    309       TYPE(XAxisGroupHandle), INTENT(OUT):: ret 
    310       CHARACTER(len = *)    , INTENT(IN) :: idt       
    311       CALL cxios_axisgroup_handle_create(ret%daddr, idt, len(idt))             
    312    END SUBROUTINE axisgroup_handle_create 
    313  
    314    LOGICAL FUNCTION axis_valid_id(idt) 
    315       IMPLICIT NONE 
    316       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    317       LOGICAL  (kind = 1)                 :: val 
    318       CALL cxios_axis_valid_id(val, idt, len(idt)); 
    319       axis_valid_id = val 
    320    END FUNCTION  axis_valid_id 
    321  
    322    LOGICAL FUNCTION axisgroup_valid_id(idt) 
    323       IMPLICIT NONE 
    324       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    325       LOGICAL  (kind = 1)                 :: val 
    326       CALL cxios_axisgroup_valid_id(val, idt, len(idt)); 
    327       axisgroup_valid_id = val 
    328    END FUNCTION  axisgroup_valid_id 
    329184 
    330185END MODULE IAXIS 

  • XIOS/trunk/src/fortran/iccontext.cpp

    r300 r312  
    8181   } 
    8282    
    83    // ------------------------ Création de contexte ---------------------------- 
    84     
    85    void cxios_context_create(XContextPtr * context, 
    86                             const char  * context_id, 
    87                             int           context_id_size, 
    88                             XCalendarType calendar_type, 
    89                             int           year, 
    90                             int           month, 
    91                             int           day, 
    92                             int           hour, 
    93                             int           minute, 
    94                             int           second) 
    95    { 
    96       std::string context_id_str;  
    97       if (!cstr2string(context_id, context_id_size, context_id_str)) return; 
    98       try 
    99       { 
    100          boost::shared_ptr<xmlioserver::tree::CContext> _context = 
    101             CTreeManager::CreateContext(context_id_str); 
    102          *context = _context.get(); 
    103          switch(calendar_type) 
    104          { 
    105             case (D360)     : 
    106                _context->setCalendar(boost::shared_ptr<xmlioserver::date::CCalendar> 
    107                   (new xmlioserver::date::CD360Calendar 
    108                      (year, month, day, hour, minute, second))); 
    109                break; 
    110             case (ALLLEAP)  : 
    111                _context->setCalendar(boost::shared_ptr<xmlioserver::date::CCalendar> 
    112                   (new xmlioserver::date::CAllLeapCalendar 
    113                      (year, month, day, hour, minute, second))); 
    114                break; 
    115             case (NOLEAP)   : 
    116                _context->setCalendar(boost::shared_ptr<xmlioserver::date::CCalendar> 
    117                   (new xmlioserver::date::CNoLeapCalendar 
    118                      (year, month, day, hour, minute, second))); 
    119                break; 
    120             case (JULIAN)   : 
    121                _context->setCalendar(boost::shared_ptr<xmlioserver::date::CCalendar> 
    122                   (new xmlioserver::date::CJulianCalendar 
    123                      (year, month, day, hour, minute, second))); 
    124                break; 
    125             case (GREGORIAN): 
    126                _context->setCalendar(boost::shared_ptr<xmlioserver::date::CCalendar> 
    127                   (new xmlioserver::date::CGregorianCalendar 
    128                      (year, month, day, hour, minute, second))); 
    129                 break; 
    130             default: 
    131                std::cerr << "Le calendrier n'est pas identifié" << std::endl; 
    132                exit (EXIT_FAILURE); 
    133          } 
    134       } 
    135       catch (xmlioserver::CException & exc) 
    136       { 
    137          std::cerr << exc.getMessage() << std::endl; 
    138          exit (EXIT_FAILURE); 
    139       } 
    140    } 
    141  
     83  
    14284   // -------------------- Vérification des identifiants ----------------------- 
    14385 

  • XIOS/trunk/src/fortran/icdata.cpp

    r300 r312  
    8484   } 
    8585 
    86     
    87    void cxios_dtreatment_start() 
    88    { 
    89       using namespace xmlioserver::tree; 
    90       using namespace xmlioserver; 
    91       try 
    92       { 
    93         MPI_Comm comm_client_server=comm::CMPIManager::GetCommClientServer() ; 
    94         MPI_Comm comm_server=comm::CMPIManager::GetCommServer() ; 
    95          
    96          boost::shared_ptr<CContext> context = 
    97             CObjectFactory::GetObject<CContext>(CObjectFactory::GetCurrentContextId()); 
    98                  
    99          StdOStringStream oss; 
    100          oss << StdString("def_client_next.") 
    101              << CMPIManager::GetCommRank(CMPIManager::GetCommClient()); 
    102          CTreeManager::PrintTreeToFile(oss.str()); 
    103          oss.str(""); 
    104          boost::shared_ptr<CDataTreatment> dt(new CDataTreatment (context)); 
    105          context->setDataTreatment(dt); 
    106  
    107          oss << StdString("def_client_end.") 
    108              << CMPIManager::GetCommRank(CMPIManager::GetCommClient()); 
    109          CTreeManager::PrintTreeToFile(oss.str()); 
    110  
    111          if ( !comm::CMPIManager::IsConnected() ) 
    112          { 
    113             MPI_Request request = 0; 
    114             StdOStringStream ostrs; 
    115  
    116             CTreeManager::ToBinary(ostrs); 
    117             CLinearBuffer lbuffer(ostrs.str().size()+CBuffer::getDataHeaderSize()); 
    118             lbuffer.appendString(ostrs.str()); 
    119             CMPIManager::SendLinearBuffer(comm_client_server, 0, lbuffer, request); 
    120             CMPIManager::Wait(request);  // Pas encore en mode RPC 
    121                 
    122                 
    123             CXIOSManager::RunClient(false, CMPIManager::GetCommClient()); 
    124             CClient::CreateClient(CMPIManager::GetCommClientServer()); 
    125          } 
    126          else 
    127          { 
    128             dt->createDataOutput<CNc4DataOutput>(CMPIManager::GetCommClient()); 
    129          } 
    130       } 
    131       catch (CException & exc) 
    132       { 
    133          std::cerr << exc.getMessage() << std::endl; 
    134          exit (EXIT_FAILURE); 
    135       } 
    136    } 
    137     
    138    void cxios_dtreatment_end(void) 
    139    { 
    140       try 
    141       { 
    142          boost::shared_ptr<xmlioserver::tree::CContext> context = 
    143          xmlioserver::CObjectFactory::GetObject<xmlioserver::tree::CContext> 
    144             (CObjectFactory::GetCurrentContextId()); 
    145          boost::shared_ptr<xmlioserver::data::CDataTreatment> dtreat = context->getDataTreatment(); 
    146          dtreat->finalize(); 
    147           
    148 //         CMPIManager::Finalize(); 
    149       } 
    150       catch (CException & exc) 
    151       { 
    152          std::cerr << exc.getMessage() << std::endl; 
    153          exit (EXIT_FAILURE); 
    154       } 
    155    } 
    156  
    157    // ---------------------- Finalize du serveur ------------------------- 
    158  
    159    void cxios_finalize_ioserver(void) 
    160    { 
    161       try 
    162       { 
    163          CMPIManager::Finalize(); 
    164       } 
    165       catch (CException & exc) 
    166       { 
    167          std::cerr << exc.getMessage() << std::endl; 
    168          exit (EXIT_FAILURE); 
    169       } 
    170     } 
    171  
    172    // ---------------------- Initialisation du serveur ------------------------- 
    173  
    174    void cxios_init_ioserver(MPIComm * f_comm_client, MPIComm * f_comm_parent) 
    175    { 
    176       try 
    177       { 
    178          MPI_Comm comm_client_server, comm_server,comm_client,comm_parent; 
    179          xmlioserver::CTreeManager::ParseFile("iodef.xml"); 
    180          CTreeManager::SetCurrentContextId(StdString("xios")); 
    181          CMPIManager::InitialiseClient(NULL, NULL); 
    182          comm_parent=MPI_Comm_f2c(*f_comm_parent) ; 
    183          CMPIManager::DispatchClient(false, comm_client, comm_client_server, comm_server,comm_parent); 
    184          *f_comm_client=MPI_Comm_c2f(comm_client) ; 
    185       } 
    186       catch (CException & exc) 
    187       { 
    188          std::cerr << exc.getMessage() << std::endl; 
    189          exit (EXIT_FAILURE); 
    190       } 
    191    } 
     86  
    19287    
    19388   // ---------------------- Ecriture des données ------------------------------ 

  • XIOS/trunk/src/fortran/icdomain.cpp

    r300 r312  
    172172   } 
    173173    
    174    void cxios_set_domain_zoom_ni_loc(XDomainPtr domain_hdl, int zoom_ni_loc) 
    175    { 
    176       domain_hdl->zoom_ni_loc.setValue(zoom_ni_loc); 
    177       domain_hdl->sendAttributToServer(domain_hdl->zoom_ni_loc) ;  
    178    } 
    179     
    180    void cxios_set_domain_zoom_nj_loc(XDomainPtr domain_hdl, int zoom_nj_loc) 
    181    { 
    182       domain_hdl->zoom_nj_loc.setValue(zoom_nj_loc); 
    183       domain_hdl->sendAttributToServer(domain_hdl->zoom_nj_loc) ;  
    184    } 
    185     
    186    void cxios_set_domain_zoom_ibegin_loc(XDomainPtr domain_hdl, int zoom_ibegin_loc) 
    187    { 
    188       domain_hdl->zoom_ibegin_loc.setValue(zoom_ibegin_loc); 
    189       domain_hdl->sendAttributToServer(domain_hdl->zoom_ibegin_loc) ;  
    190    } 
    191     
    192    void cxios_set_domain_zoom_jbegin_loc(XDomainPtr domain_hdl, int zoom_jbegin_loc) 
    193    { 
    194       domain_hdl->zoom_jbegin_loc.setValue(zoom_jbegin_loc); 
    195       domain_hdl->sendAttributToServer(domain_hdl->zoom_jbegin_loc) ;  
    196    } 
    197     
    198174   void cxios_set_domain_data_n_index(XDomainPtr domain_hdl, int data_n_index) 
    199175   { 
    … …  
    389365   } 
    390366    
    391    void cxios_set_domaingroup_zoom_ni_loc(XDomainGroupPtr domaingroup_hdl, int zoom_ni_loc) 
    392    { 
    393       domaingroup_hdl->zoom_ni_loc.setValue(zoom_ni_loc); 
    394       domaingroup_hdl->sendAttributToServer(domaingroup_hdl->zoom_ni_loc) ; 
    395    } 
    396     
    397    void cxios_set_domaingroup_zoom_nj_loc(XDomainGroupPtr domaingroup_hdl, int zoom_nj_loc) 
    398    { 
    399       domaingroup_hdl->zoom_nj_loc.setValue(zoom_nj_loc); 
    400       domaingroup_hdl->sendAttributToServer(domaingroup_hdl->zoom_nj_loc) ; 
    401    } 
    402     
    403    void cxios_set_domaingroup_zoom_ibegin_loc(XDomainGroupPtr domaingroup_hdl, int zoom_ibegin_loc) 
    404    { 
    405       domaingroup_hdl->zoom_ibegin_loc.setValue(zoom_ibegin_loc); 
    406       domaingroup_hdl->sendAttributToServer(domaingroup_hdl->zoom_ibegin_loc) ; 
    407    } 
    408     
    409    void cxios_set_domaingroup_zoom_jbegin_loc(XDomainGroupPtr domaingroup_hdl, int zoom_jbegin_loc) 
    410    { 
    411       domaingroup_hdl->zoom_jbegin_loc.setValue(zoom_jbegin_loc); 
    412       domaingroup_hdl->sendAttributToServer(domaingroup_hdl->zoom_jbegin_loc) ; 
    413    } 
    414     
    415367   void cxios_set_domaingroup_data_n_index(XDomainGroupPtr domaingroup_hdl, int data_n_index) 
    416368   { 

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

    r286 r312  
    66   USE IDATE 
    77 
    8    TYPE XContextHandle 
    9       INTEGER(kind = C_INTPTR_T) :: daddr 
    10    END TYPE XContextHandle 
    118     
    129   TYPE txios(context) 
    … …  
    1411   END TYPE txios(context) 
    1512       
    16    !---------------------------------------------------------------------------- 
    17    INTERFACE set_context_attributes 
    18       MODULE PROCEDURE set_context_attributes_id,set_context_attributes_hdl 
    19    END INTERFACE   
    20    !---------------------------------------------------------------------------- 
    2113    
    2214   CONTAINS ! Fonctions disponibles pour les utilisateurs. 
    … …  
    10092 
    10193   END SUBROUTINE xios(set_current_context) 
    102     
    103     
    104 !   SUBROUTINE context_create(context_hdl, context_id, calendar_type, init_date) 
    105 !      TYPE(XContextHandle)          , INTENT(OUT) :: context_hdl 
    106 !      CHARACTER(len = *)            , INTENT(IN)  :: context_id 
    107 !      INTEGER                       , INTENT(IN)  :: calendar_type 
    108 !      TYPE(XDate)         , OPTIONAL, INTENT(IN)  :: init_date 
    109 !     IF (PRESENT(init_date)) THEN 
    110 !         CALL cxios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, & 
    111 !                                  init_date%year, init_date%month, init_date%day, & 
    112 !                                  init_date%hour, init_date%minute, init_date%second) 
    113 !      ELSE 
    114 !         CALL cxios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, & 
    115 !                                 0, 1, 1, 0, 0, 0) 
    116 !      END IF 
    117 !   END SUBROUTINE context_create 
    118  
     94  
    11995   LOGICAL FUNCTION xios(is_valid_context)(idt) 
    12096      IMPLICIT NONE 
    … …  
    127103   END FUNCTION  xios(is_valid_context) 
    128104 
    129  
    130  
    131  
    132  
    133  
    134  
    135  
    136  
    137  
    138  
    139  
    140  
    141  
    142  
    143  
    144  
    145  
    146  
    147  
    148 !!!!!!!! ancienne interface 
    149  
    150    SUBROUTINE set_context_attributes_id( context_id, calendar_type_, start_date_, output_dir_) 
    151       IMPLICIT NONE 
    152       TYPE(XContextHandle)                       :: context_hdl 
    153       CHARACTER(len = *)            , INTENT(IN) :: context_id 
    154       CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: calendar_type_ 
    155       CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: start_date_ 
    156       CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: output_dir_ 
    157           
    158       CALL context_handle_create(context_hdl, context_id) 
    159       CALL set_context_attributes_hdl( context_hdl, calendar_type_, start_date_, output_dir_) 
    160    END SUBROUTINE set_context_attributes_id 
    161  
    162    SUBROUTINE set_context_attributes_hdl( context_hdl, calendar_type_, start_date_, output_dir_) 
    163       IMPLICIT NONE 
    164       TYPE(XContextHandle)          , INTENT(IN) :: context_hdl 
    165       CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: calendar_type_ 
    166       CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: start_date_ 
    167       CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: output_dir_    
    168           
    169       IF (PRESENT(calendar_type_)) THEN 
    170          CALL cxios_set_context_calendar_type(context_hdl%daddr, calendar_type_, len(calendar_type_)) 
    171       END IF 
    172       IF (PRESENT(start_date_))    THEN 
    173          CALL cxios_set_context_start_date(context_hdl%daddr, start_date_, len(start_date_)) 
    174       END IF 
    175       IF (PRESENT(output_dir_))    THEN 
    176          CALL cxios_set_context_output_dir(context_hdl%daddr, output_dir_, len(output_dir_)) 
    177       END IF 
    178    END SUBROUTINE set_context_attributes_hdl 
    179  
    180    SUBROUTINE context_handle_create(ret, idt) 
    181       IMPLICIT NONE 
    182       TYPE(XContextHandle), INTENT(OUT):: ret 
    183       CHARACTER(len = *)  , INTENT(IN) :: idt       
    184       CALL cxios_context_handle_create(ret%daddr, idt, len(idt))             
    185    END SUBROUTINE context_handle_create 
    186     
    187    SUBROUTINE context_set_current(context, withswap) 
    188       TYPE(XContextHandle)          , INTENT(IN) :: context 
    189       LOGICAL             , OPTIONAL, INTENT(IN) :: withswap 
    190       LOGICAL (kind = 1)                       :: wswap 
    191       IF (PRESENT(withswap)) THEN 
    192          wswap = withswap 
    193       ELSE 
    194          wswap = .FALSE. 
    195       END IF 
    196       CALL cxios_context_set_current(context%daddr, wswap) 
    197    END SUBROUTINE context_set_current 
    198     
    199    SUBROUTINE context_create(context_hdl, context_id, calendar_type, init_date) 
    200       TYPE(XContextHandle)          , INTENT(OUT) :: context_hdl 
    201       CHARACTER(len = *)            , INTENT(IN)  :: context_id 
    202       INTEGER                       , INTENT(IN)  :: calendar_type 
    203       TYPE(XDate)         , OPTIONAL, INTENT(IN)  :: init_date 
    204       IF (PRESENT(init_date)) THEN 
    205          CALL cxios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, & 
    206                                   init_date%year, init_date%month, init_date%day, & 
    207                                   init_date%hour, init_date%minute, init_date%second) 
    208       ELSE 
    209          CALL cxios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, & 
    210                                  0, 1, 1, 0, 0, 0) 
    211       END IF 
    212    END SUBROUTINE context_create 
    213  
    214    LOGICAL FUNCTION context_valid_id(idt) 
    215       IMPLICIT NONE 
    216       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    217       LOGICAL  (kind = 1)                 :: val 
    218       CALL cxios_context_valid_id(val, idt, len(idt)); 
    219       context_valid_id = val 
    220    END FUNCTION  context_valid_id 
    221  
    222  
    223105    
    224106END MODULE ICONTEXT 

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

    r300 r312  
    3434      END SUBROUTINE cxios_context_finalize 
    3535      
    36       SUBROUTINE  cxios_init_ioserver(comm_client,comm_parent) BIND(C) 
    37          USE ISO_C_BINDING 
    38          INTEGER  (kind = C_INT) :: comm_client 
    39          INTEGER  (kind = C_INT) :: comm_parent 
    40       END SUBROUTINE cxios_init_ioserver 
    41  
    42       SUBROUTINE  cxios_finalize_ioserver BIND(C) 
    43       END SUBROUTINE cxios_finalize_ioserver 
    4436  
    4537      SUBROUTINE  cxios_finalize BIND(C) 
    4638      END SUBROUTINE cxios_finalize 
    4739 
    48       SUBROUTINE cxios_dtreatment_start() BIND(C) 
    49          USE ISO_C_BINDING 
    50       END SUBROUTINE cxios_dtreatment_start 
    51  
    52       SUBROUTINE cxios_dtreatment_end() BIND(C) 
    53          ! Sans argument 
    54       END SUBROUTINE cxios_dtreatment_end 
    55  
     40  
    5641      SUBROUTINE cxios_write_data_k81(fieldid, fieldid_size, data_k8, data_Xsize) BIND(C) 
    5742         USE ISO_C_BINDING 
    … …  
    10489   END INTERFACE 
    10590    
    106    INTERFACE write_data 
    107       MODULE PROCEDURE write_data_k81,write_data_k82,write_data_k83,write_data_k41,write_data_k42,write_data_k43 
    108    END INTERFACE 
    10991    
    11092   CONTAINS ! Fonctions disponibles pour les utilisateurs. 
    … …  
    210192   END SUBROUTINE xios(send_field_r4_3d) 
    211193    
    212  
    213  
    214  
    215 !!!!!!!!!!!!!! anciennes Interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    216 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    217  
    218    SUBROUTINE  init_ioserver(local_comm,return_comm ) 
    219    IMPLICIT NONE 
    220    INCLUDE 'mpif.h' 
    221       INTEGER, INTENT(OUT),OPTIONAL :: return_comm 
    222       INTEGER, INTENT(IN),OPTIONAL :: local_comm 
    223  
    224       INTEGER  :: comm_client 
    225       INTEGER  :: comm_parent 
    226        
    227       IF (PRESENT(local_comm)) THEN 
    228         comm_parent=local_comm 
    229       ELSE 
    230         comm_parent=MPI_COMM_WORLD 
    231       ENDIF 
    232        
    233       CALL cxios_init_ioserver(comm_client,comm_parent) 
    234       IF (PRESENT(return_comm)) return_comm=comm_client ; 
    235  
    236     END SUBROUTINE  init_ioserver 
    237  
    238    SUBROUTINE  finalize_ioserver 
    239    IMPLICIT NONE 
    240  
    241       CALL cxios_finalize_ioserver 
    242  
    243     END SUBROUTINE  finalize_ioserver 
    244  
    245     
    246    SUBROUTINE dtreatment_start(context_hdl, filetype) 
    247       TYPE(XContextHandle), INTENT(IN)           :: context_hdl 
    248       INTEGER             , INTENT(IN), OPTIONAL :: filetype  
    249       INTEGER                                    :: filetype_ 
    250       IF (PRESENT(filetype)) THEN 
    251          filetype_ = filetype 
    252       ELSE 
    253          filetype_ = NETCDF4 
    254       END IF 
    255       CALL context_set_current(context_hdl) 
    256       CALL cxios_dtreatment_start() 
    257    END SUBROUTINE dtreatment_start 
    258     
    259    SUBROUTINE dtreatment_end(context_hdl) 
    260       TYPE(XContextHandle), INTENT(IN), OPTIONAL :: context_hdl 
    261       CALL cxios_dtreatment_end() 
    262    END SUBROUTINE dtreatment_end 
    263     
    264    SUBROUTINE write_data_k81(fieldid, data1d_k8) 
    265       CHARACTER(len = *)               , INTENT(IN) :: fieldid 
    266       REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data1d_k8(:) 
    267       CALL cxios_write_data_k81(fieldid, len(fieldid), data1d_k8, size(data1d_k8, 1)) 
    268    END SUBROUTINE write_data_k81 
    269     
    270    SUBROUTINE write_data_k82(fieldid, data2d_k8) 
    271       CHARACTER(len = *)               , INTENT(IN) :: fieldid 
    272       REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data2d_k8(:,:) 
    273       CALL cxios_write_data_k82(fieldid, len(fieldid), data2d_k8, size(data2d_k8, 1), size(data2d_k8, 2)) 
    274    END SUBROUTINE write_data_k82 
    275     
    276    SUBROUTINE write_data_k83(fieldid, data3d_k8) 
    277       CHARACTER(len = *)               , INTENT(IN) :: fieldid 
    278       REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data3d_k8(:,:,:) 
    279       CALL cxios_write_data_k83(fieldid, len(fieldid), data3d_k8, size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3)) 
    280    END SUBROUTINE write_data_k83 
    281     
    282    SUBROUTINE write_data_k41(fieldid, data1d_k4) 
    283       CHARACTER(len = *)               , INTENT(IN) :: fieldid 
    284       REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data1d_k4(:) 
    285       CALL cxios_write_data_k41(fieldid, len(fieldid), data1d_k4, size(data1d_k4, 1)) 
    286    END SUBROUTINE write_data_k41 
    287     
    288    SUBROUTINE write_data_k42(fieldid, data2d_k4) 
    289       CHARACTER(len = *)               , INTENT(IN) :: fieldid 
    290       REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data2d_k4(:,:) 
    291       CALL cxios_write_data_k42(fieldid, len(fieldid), data2d_k4, size(data2d_k4, 1), size(data2d_k4, 2)) 
    292    END SUBROUTINE write_data_k42 
    293     
    294    SUBROUTINE write_data_k43(fieldid, data3d_k4) 
    295       CHARACTER(len = *)               , INTENT(IN) :: fieldid 
    296       REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data3d_k4(:,:,:) 
    297       CALL cxios_write_data_k43(fieldid, len(fieldid), data3d_k4, size(data3d_k4, 1), size(data3d_k4, 2), size(data3d_k4, 3)) 
    298    END SUBROUTINE write_data_k43 
    299194    
    300195END MODULE IDATA 

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

    r300 r312  
    55   ! enum XCalendarType 
    66   INTEGER(kind = C_INT), PARAMETER :: D360 = 0 , ALLLEAP = 1 , NOLEAP = 2 , JULIAN = 3 , GREGORIAN = 4 
    7  
    8    TYPE XDate 
    9       INTEGER :: year, month, day, hour, minute, second 
    10    END TYPE XDate 
    11  
    12    TYPE XDuration 
    13       REAL(kind = 8) :: year, month, day, hour, minute, second 
    14    END TYPE XDuration 
    157 
    168   TYPE txios(date) 
    … …  
    6355   END SUBROUTINE xios(update_calendar) 
    6456 
    65  
    66 !!!!!!!!!!!! anciennes interfaces !!!!!!!!!!!!!!!! 
    67 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    68     
    69    SUBROUTINE set_timestep(timestep) 
    70       TYPE(XDuration), INTENT(IN):: timestep 
    71       CALL cxios_set_timestep(timestep%year, timestep%month , timestep%day, & 
    72                              timestep%hour, timestep%minute, timestep%second) 
    73    END SUBROUTINE set_timestep 
    74     
    75    SUBROUTINE update_calendar(step) 
    76       INTEGER, INTENT(IN):: step 
    77       IF (step < 0) THEN 
    78          PRINT *, "L'argument 'step' ne peut être négatif" 
    79          STOP 
    80       END IF 
    81       CALL cxios_update_calendar(step) 
    82    END SUBROUTINE update_calendar 
    8357    
    8458END MODULE IDATE 

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

    r286 r312  
    66   USE DOMAINGROUP_INTERFACE 
    77    
    8    TYPE XDomainHandle 
    9       INTEGER(kind = C_INTPTR_T) :: daddr 
    10    END TYPE XDomainHandle 
    11     
    12    TYPE XDomainGroupHandle 
    13       INTEGER(kind = C_INTPTR_T) :: daddr 
    14    END TYPE XDomainGroupHandle 
    15  
    168   TYPE txios(domain) 
    179      INTEGER(kind = C_INTPTR_T) :: daddr 
    … …  
    2214   END TYPE txios(domaingroup) 
    2315    
    24    !---------------------------------------------------------------------------- 
    25    INTERFACE set_domain_attributes 
    26       MODULE PROCEDURE set_domain_attributes_id,set_domain_attributes_hdl 
    27    END INTERFACE   
    28     
    29    INTERFACE set_domain_group_attributes 
    30       MODULE PROCEDURE set_domaingroup_attributes_id,set_domaingroup_attributes_hdl 
    31    END INTERFACE   
    32    !---------------------------------------------------------------------------- 
    3316    
    3417   CONTAINS ! Fonctions disponibles pour les utilisateurs. 
    … …  
    3821   ( domaingroup_id, name, standard_name, long_name, domain_group_ref, ni_glo, nj_glo, ibegin, iend,       & 
    3922     ni, jbegin, jend, nj, mask, data_dim, data_ni, data_nj, data_ibegin, data_jbegin,                     & 
    40      zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, zoom_ni_loc, zoom_nj_loc, zoom_ibegin_loc,                & 
    41      zoom_jbegin_loc, data_n_index, data_i_index, data_j_index, lonvalue, latvalue) 
     23     zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, data_n_index, data_i_index, data_j_index,                 & 
     24     lonvalue, latvalue) 
    4225      IMPLICIT NONE 
    4326      TYPE(txios(domaingroup))                              :: domaingroup_hdl 
    … …  
    6548      INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ibegin 
    6649      INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_jbegin 
    67       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ni_loc 
    68       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_nj_loc 
    69       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc 
    70       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc 
    7150      INTEGER                        , OPTIONAL, INTENT(IN) :: data_n_index 
    7251      INTEGER       , dimension(*)   , OPTIONAL, INTENT(IN) :: data_i_index(:) 
    … …  
    7958   ( domaingroup_hdl, name, standard_name, long_name, domain_group_ref, ni_glo, nj_glo, ibegin, iend,      & 
    8059     ni, jbegin, jend, nj, mask, data_dim, data_ni, data_nj, data_ibegin, data_jbegin,                     & 
    81      zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, zoom_ni_loc, zoom_nj_loc, zoom_ibegin_loc,                & 
    82      zoom_jbegin_loc, data_n_index, data_i_index, data_j_index, lonvalue, latvalue) 
     60     zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, data_n_index, data_i_index, data_j_index,                 & 
     61     lonvalue, latvalue) 
    8362 
    8463   END SUBROUTINE xios(set_domaingroup_attr) 
    … …  
    8766   ( domaingroup_hdl,name, standard_name, long_name, domain_group_ref, ni_glo, nj_glo, ibegin, iend,       & 
    8867     ni, jbegin, jend, nj, mask, data_dim, data_ni, data_nj, data_ibegin, data_jbegin,                     & 
    89      zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, zoom_ni_loc, zoom_nj_loc, zoom_ibegin_loc,                & 
    90      zoom_jbegin_loc, data_n_index, data_i_index, data_j_index, lonvalue, latvalue) 
     68     zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, data_n_index, data_i_index,                               & 
     69     data_j_index, lonvalue, latvalue) 
    9170      IMPLICIT NONE 
    9271      TYPE(txios(domaingroup))             , INTENT(IN) :: domaingroup_hdl 
    … …  
    11392      INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin 
    11493      INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin 
    115       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ni_loc 
    116       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_nj_loc 
    117       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc 
    118       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc 
    11994      INTEGER                          , OPTIONAL, INTENT(IN) :: data_n_index 
    12095      INTEGER       , dimension(*)     , OPTIONAL, INTENT(IN) :: data_i_index(:) 
    … …  
    12398      REAL(kind = 8), dimension(*)     , OPTIONAL, INTENT(IN) :: latvalue(:)    
    12499 
    125       CALL xios(set_domaingroup_attr_hdl_)                                                                  & 
    126    ( domaingroup_hdl,name, standard_name, long_name, domain_group_ref, ni_glo, nj_glo, ibegin, iend,       & 
     100      CALL xios(set_domaingroup_attr_hdl_)                                                               & 
     101   ( domaingroup_hdl,name, standard_name, long_name, domain_group_ref, ni_glo, nj_glo, ibegin, iend,     & 
    127102     ni, jbegin, jend, nj, mask, data_dim, data_ni, data_nj, data_ibegin, data_jbegin,                   & 
    128      zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, zoom_ni_loc, zoom_nj_loc, zoom_ibegin_loc,                 & 
    129      zoom_jbegin_loc, data_n_index, data_i_index, data_j_index, lonvalue, latvalue) 
     103     zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, data_n_index, data_i_index, data_j_index,               & 
     104     lonvalue, latvalue) 
    130105 
    131106    END SUBROUTINE xios(set_domaingroup_attr_hdl) 
    … …  
    134109   ( domaingroup_hdl, name_, standard_name_, long_name_, domain_group_ref_, ni_glo_, nj_glo_, ibegin_, iend_,       & 
    135110     ni_, jbegin_, jend_, nj_, mask_, data_dim_, data_ni_, data_nj_, data_ibegin_, data_jbegin_,                   & 
    136      zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, zoom_ni_loc_, zoom_nj_loc_, zoom_ibegin_loc_,                 & 
    137      zoom_jbegin_loc_, data_n_index_, data_i_index_, data_j_index_, lonvalue_, latvalue_) 
     111     zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, data_n_index_, data_i_index_, data_j_index_,                  & 
     112     lonvalue_, latvalue_) 
    138113      IMPLICIT NONE 
    139114      TYPE(txios(domaingroup))             , INTENT(IN) :: domaingroup_hdl 
    … …  
    161136      INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_ 
    162137      INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_ 
    163       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ni_loc_ 
    164       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_nj_loc_ 
    165       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc_ 
    166       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc_ 
    167138      INTEGER                          , OPTIONAL, INTENT(IN) :: data_n_index_ 
    168139      INTEGER       , dimension(*)     , OPTIONAL, INTENT(IN) :: data_i_index_(:) 
    … …  
    240211         CALL cxios_set_domaingroup_zoom_jbegin(domaingroup_hdl%daddr, zoom_jbegin_) 
    241212      END IF 
    242       IF (PRESENT(zoom_ni_loc_))      THEN 
    243          CALL cxios_set_domaingroup_zoom_ni_loc(domaingroup_hdl%daddr, zoom_ni_loc_) 
    244       END IF    
    245       IF (PRESENT(zoom_nj_loc_))      THEN 
    246          CALL cxios_set_domaingroup_zoom_nj_loc(domaingroup_hdl%daddr, zoom_nj_loc_) 
    247       END IF 
    248       IF (PRESENT(zoom_ibegin_loc_))  THEN 
    249          CALL cxios_set_domaingroup_zoom_ibegin_loc(domaingroup_hdl%daddr, zoom_ibegin_loc_) 
    250       END IF 
    251       IF (PRESENT(zoom_jbegin_loc_))  THEN 
    252          CALL cxios_set_domaingroup_zoom_jbegin_loc(domaingroup_hdl%daddr, zoom_jbegin_loc_) 
    253       END IF 
     213 
    254214      IF (PRESENT(data_n_index_))     THEN 
    255215         CALL cxios_set_domaingroup_data_n_index(domaingroup_hdl%daddr, data_n_index_) 
    … …  
    274234   ( domain_id, name, standard_name, long_name, domain_group_ref, ni_glo, nj_glo, ibegin, iend,    & 
    275235     ni, jbegin, jend, nj, mask, data_dim, data_ni, data_nj, data_ibegin, data_jbegin,             & 
    276      zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, zoom_ni_loc, zoom_nj_loc, zoom_ibegin_loc,        & 
    277      zoom_jbegin_loc, data_n_index, data_i_index, data_j_index, lonvalue, latvalue) 
    278       IMPLICIT NONE 
     236     zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, data_n_index, data_i_index, data_j_index,         & 
     237     lonvalue, latvalue) 
     238      IMPLICIT NONE 
     239      
    279240      TYPE(txios(domain))                                   :: domain_hdl 
    280241      CHARACTER(len = *)                       , INTENT(IN) :: domain_id 
    … …  
    301262      INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ibegin 
    302263      INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_jbegin 
    303       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ni_loc 
    304       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_nj_loc 
    305       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc 
    306       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc 
    307264      INTEGER                        , OPTIONAL, INTENT(IN) :: data_n_index 
    308265      INTEGER       , dimension(*)   , OPTIONAL, INTENT(IN) :: data_i_index(:) 
    … …  
    312269  
    313270      CALL xios(get_domain_handle)(domain_id,domain_hdl) 
    314       CALL xios(set_domain_attr_hdl_)                                                                     & 
     271      CALL xios(set_domain_attr_hdl_)                                                               & 
    315272   ( domain_hdl, name, standard_name, long_name, domain_group_ref, ni_glo, nj_glo, ibegin, iend,    & 
    316273     ni, jbegin, jend, nj, mask, data_dim, data_ni, data_nj, data_ibegin, data_jbegin,              & 
    317      zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, zoom_ni_loc, zoom_nj_loc, zoom_ibegin_loc,         & 
    318      zoom_jbegin_loc, data_n_index, data_i_index, data_j_index, lonvalue, latvalue) 
     274     zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, data_n_index, data_i_index, data_j_index,          & 
     275     lonvalue, latvalue) 
    319276 
    320277   END SUBROUTINE xios(set_domain_attr) 
    321278 
    322279 
    323    SUBROUTINE xios(set_domain_attr_hdl)                                                             & 
     280   SUBROUTINE xios(set_domain_attr_hdl)                                                            & 
    324281   ( domain_hdl,name, standard_name, long_name, domain_group_ref, ni_glo, nj_glo, ibegin, iend,    & 
    325282     ni, jbegin, jend, nj, mask, data_dim, data_ni, data_nj, data_ibegin, data_jbegin,             & 
    326      zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, zoom_ni_loc, zoom_nj_loc, zoom_ibegin_loc,        & 
    327      zoom_jbegin_loc, data_n_index, data_i_index, data_j_index, lonvalue, latvalue) 
    328       IMPLICIT NONE 
     283     zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, data_n_index, data_i_index,                       & 
     284     data_j_index, lonvalue, latvalue) 
     285      IMPLICIT NONE 
     286      
    329287      TYPE(txios(domain))                       , INTENT(IN) :: domain_hdl 
    330288      CHARACTER(len = *)               , OPTIONAL, INTENT(IN) :: name 
    … …  
    350308      INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin 
    351309      INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin 
    352       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ni_loc 
    353       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_nj_loc 
    354       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc 
    355       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc 
    356310      INTEGER                          , OPTIONAL, INTENT(IN) :: data_n_index 
    357311      INTEGER       , dimension(*)     , OPTIONAL, INTENT(IN) :: data_i_index(:) 
    … …  
    363317   ( domain_hdl,name, standard_name, long_name, domain_group_ref, ni_glo, nj_glo, ibegin, iend,   & 
    364318     ni, jbegin, jend, nj, mask, data_dim, data_ni, data_nj, data_ibegin, data_jbegin,            & 
    365      zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, zoom_ni_loc, zoom_nj_loc, zoom_ibegin_loc,       & 
    366      zoom_jbegin_loc, data_n_index, data_i_index, data_j_index, lonvalue, latvalue) 
     319     zoom_ni, zoom_nj, zoom_ibegin, zoom_jbegin, data_n_index, data_i_index, data_j_index,        & 
     320     lonvalue, latvalue) 
    367321      
    368322   END SUBROUTINE xios(set_domain_attr_hdl) 
    369323        
    370    SUBROUTINE xios(set_domain_attr_hdl_)                                                                  & 
     324   SUBROUTINE xios(set_domain_attr_hdl_)                                                                 & 
    371325   ( domain_hdl,name_, standard_name_, long_name_, domain_group_ref_, ni_glo_, nj_glo_, ibegin_, iend_,  & 
    372326     ni_, jbegin_, jend_, nj_, mask_, data_dim_, data_ni_, data_nj_, data_ibegin_, data_jbegin_,         & 
    373      zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, zoom_ni_loc_, zoom_nj_loc_, zoom_ibegin_loc_,       & 
    374      zoom_jbegin_loc_, data_n_index_, data_i_index_, data_j_index_, lonvalue_, latvalue_) 
     327     zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, data_n_index_, data_i_index_, data_j_index_,        & 
     328     lonvalue_, latvalue_) 
     329 
    375330      IMPLICIT NONE 
    376331      TYPE(txios(domain))                       , INTENT(IN) :: domain_hdl 
    … …  
    398353      INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_ 
    399354      INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_ 
    400       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ni_loc_ 
    401       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_nj_loc_ 
    402       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc_ 
    403       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc_ 
    404355      INTEGER                          , OPTIONAL, INTENT(IN) :: data_n_index_ 
    405356      INTEGER       , dimension(*)     , OPTIONAL, INTENT(IN) :: data_i_index_(:) 
    … …  
    476427         CALL cxios_set_domain_zoom_jbegin(domain_hdl%daddr, zoom_jbegin_) 
    477428      END IF 
    478       IF (PRESENT(zoom_ni_loc_))      THEN 
    479          CALL cxios_set_domain_zoom_ni_loc(domain_hdl%daddr, zoom_ni_loc_) 
    480       END IF    
    481       IF (PRESENT(zoom_nj_loc_))      THEN 
    482          CALL cxios_set_domain_zoom_nj_loc(domain_hdl%daddr, zoom_nj_loc_) 
    483       END IF 
    484       IF (PRESENT(zoom_ibegin_loc_))  THEN 
    485          CALL cxios_set_domain_zoom_ibegin_loc(domain_hdl%daddr, zoom_ibegin_loc_) 
    486       END IF 
    487       IF (PRESENT(zoom_jbegin_loc_))  THEN 
    488          CALL cxios_set_domain_zoom_jbegin_loc(domain_hdl%daddr, zoom_jbegin_loc_) 
    489       END IF 
    490429      IF (PRESENT(data_n_index_))     THEN 
    491430         CALL cxios_set_domain_data_n_index(domain_hdl%daddr, data_n_index_) 
    … …  
    541480      xios(is_valid_domaingroup) = val 
    542481   END FUNCTION  xios(is_valid_domaingroup) 
    543  
    544  
    545  
    546  
    547  
    548  
    549  
    550  
    551  
    552  
    553  
    554  
    555  
    556  
    557  
    558  
    559  
    560  
    561  
    562  
    563  
    564  
    565  
    566  
    567  
    568  
    569  
    570  
    571  
    572  
    573  
    574 !!!!!!!!!!!! Ancienne interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    575 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    576     
    577    SUBROUTINE set_domaingroup_attributes_id                                                                        & 
    578    ( domaingroup_id, name_, standard_name_, long_name_, domain_group_ref_, ni_glo_, nj_glo_, ibegin_, iend_,       & 
    579      ni_, jbegin_, jend_, nj_, mask_, data_dim_, data_ni_, data_nj_, data_ibegin_, data_jbegin_,                   & 
    580      zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, zoom_ni_loc_, zoom_nj_loc_, zoom_ibegin_loc_,                 & 
    581      zoom_jbegin_loc_, data_n_index_, data_i_index_, data_j_index_, lonvalue_, latvalue_) 
    582       IMPLICIT NONE 
    583       TYPE(XDomainGroupHandle)                              :: domaingroup_hdl 
    584       CHARACTER(len = *)                       , INTENT(IN) :: domaingroup_id 
    585       CHARACTER(len = *)             , OPTIONAL, INTENT(IN) :: name_ 
    586       CHARACTER(len = *)             , OPTIONAL, INTENT(IN) :: standard_name_ 
    587       CHARACTER(len = *)             , OPTIONAL, INTENT(IN) :: long_name_ 
    588       CHARACTER(len = *)             , OPTIONAL, INTENT(IN) :: domain_group_ref_ 
    589       INTEGER                        , OPTIONAL, INTENT(IN) :: ni_glo_ 
    590       INTEGER                        , OPTIONAL, INTENT(IN) :: nj_glo_ 
    591       INTEGER                        , OPTIONAL, INTENT(IN) :: ibegin_ 
    592       INTEGER                        , OPTIONAL, INTENT(IN) :: iend_ 
    593       INTEGER                        , OPTIONAL, INTENT(IN) :: ni_ 
    594       INTEGER                        , OPTIONAL, INTENT(IN) :: jbegin_ 
    595       INTEGER                        , OPTIONAL, INTENT(IN) :: jend_ 
    596       INTEGER                        , OPTIONAL, INTENT(IN) :: nj_ 
    597       LOGICAL          , dimension(*), OPTIONAL, INTENT(IN) :: mask_(:,:) 
    598       INTEGER                        , OPTIONAL, INTENT(IN) :: data_dim_ 
    599       INTEGER                        , OPTIONAL, INTENT(IN) :: data_ni_ 
    600       INTEGER                        , OPTIONAL, INTENT(IN) :: data_nj_ 
    601       INTEGER                        , OPTIONAL, INTENT(IN) :: data_ibegin_ 
    602       INTEGER                        , OPTIONAL, INTENT(IN) :: data_jbegin_ 
    603       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ni_ 
    604       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_nj_ 
    605       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ibegin_ 
    606       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_jbegin_ 
    607       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ni_loc_ 
    608       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_nj_loc_ 
    609       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc_ 
    610       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc_ 
    611       INTEGER                        , OPTIONAL, INTENT(IN) :: data_n_index_ 
    612       INTEGER       , dimension(*)   , OPTIONAL, INTENT(IN) :: data_i_index_(:) 
    613       INTEGER       , dimension(*)   , OPTIONAL, INTENT(IN) :: data_j_index_(:) 
    614       REAL(kind = 8), dimension(*)   , OPTIONAL, INTENT(IN) :: lonvalue_(:) 
    615       REAL(kind = 8), dimension(*)   , OPTIONAL, INTENT(IN) :: latvalue_(:) 
    616   
    617       CALL domaingroup_handle_create(domaingroup_hdl, domaingroup_id) 
    618       CALL set_domaingroup_attributes_hdl                                                                          & 
    619    ( domaingroup_hdl, name_, standard_name_, long_name_, domain_group_ref_, ni_glo_, nj_glo_, ibegin_, iend_,      & 
    620      ni_, jbegin_, jend_, nj_, mask_, data_dim_, data_ni_, data_nj_, data_ibegin_, data_jbegin_,                   & 
    621      zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, zoom_ni_loc_, zoom_nj_loc_, zoom_ibegin_loc_,                 & 
    622      zoom_jbegin_loc_, data_n_index_, data_i_index_, data_j_index_, lonvalue_, latvalue_) 
    623  
    624    END SUBROUTINE set_domaingroup_attributes_id 
    625     
    626    SUBROUTINE set_domaingroup_attributes_hdl                                                                       & 
    627    ( domaingroup_hdl,name_, standard_name_, long_name_, domain_group_ref_, ni_glo_, nj_glo_, ibegin_, iend_,       & 
    628      ni_, jbegin_, jend_, nj_, mask_, data_dim_, data_ni_, data_nj_, data_ibegin_, data_jbegin_,                   & 
    629      zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, zoom_ni_loc_, zoom_nj_loc_, zoom_ibegin_loc_,                 & 
    630      zoom_jbegin_loc_, data_n_index_, data_i_index_, data_j_index_, lonvalue_, latvalue_) 
    631       IMPLICIT NONE 
    632       TYPE(XDomainGroupHandle)                   , INTENT(IN) :: domaingroup_hdl 
    633       CHARACTER(len = *)               , OPTIONAL, INTENT(IN) :: name_ 
    634       CHARACTER(len = *)               , OPTIONAL, INTENT(IN) :: standard_name_ 
    635       CHARACTER(len = *)               , OPTIONAL, INTENT(IN) :: long_name_ 
    636       CHARACTER(len = *)               , OPTIONAL, INTENT(IN) :: domain_group_ref_ 
    637       INTEGER                          , OPTIONAL, INTENT(IN) :: ni_glo_ 
    638       INTEGER                          , OPTIONAL, INTENT(IN) :: nj_glo_ 
    639       INTEGER                          , OPTIONAL, INTENT(IN) :: ibegin_ 
    640       INTEGER                          , OPTIONAL, INTENT(IN) :: iend_ 
    641       INTEGER                          , OPTIONAL, INTENT(IN) :: ni_ 
    642       INTEGER                          , OPTIONAL, INTENT(IN) :: jbegin_ 
    643       INTEGER                          , OPTIONAL, INTENT(IN) :: jend_ 
    644       INTEGER                          , OPTIONAL, INTENT(IN) :: nj_ 
    645       LOGICAL          , dimension(*)  , OPTIONAL, INTENT(IN) :: mask_(:,:) 
    646       LOGICAL(kind = 1), dimension(:,:), ALLOCATABLE          :: mask__! (size(mask_,1),size(mask,2)) 
    647       INTEGER                          , OPTIONAL, INTENT(IN) :: data_dim_ 
    648       INTEGER                          , OPTIONAL, INTENT(IN) :: data_ni_ 
    649       INTEGER                          , OPTIONAL, INTENT(IN) :: data_nj_ 
    650       INTEGER                          , OPTIONAL, INTENT(IN) :: data_ibegin_ 
    651       INTEGER                          , OPTIONAL, INTENT(IN) :: data_jbegin_ 
    652       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ni_ 
    653       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_nj_ 
    654       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_ 
    655       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_ 
    656       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ni_loc_ 
    657       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_nj_loc_ 
    658       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc_ 
    659       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc_ 
    660       INTEGER                          , OPTIONAL, INTENT(IN) :: data_n_index_ 
    661       INTEGER       , dimension(*)     , OPTIONAL, INTENT(IN) :: data_i_index_(:) 
    662       INTEGER       , dimension(*)     , OPTIONAL, INTENT(IN) :: data_j_index_(:) 
    663       REAL(kind = 8), dimension(*)     , OPTIONAL, INTENT(IN) :: lonvalue_(:) 
    664       REAL(kind = 8), dimension(*)     , OPTIONAL, INTENT(IN) :: latvalue_(:) 
    665        
    666       IF (PRESENT(name_))             THEN 
    667          CALL cxios_set_domaingroup_name(domaingroup_hdl%daddr, name_, len(name_)) 
    668       END IF 
    669       IF (PRESENT(standard_name_))    THEN 
    670          CALL cxios_set_domaingroup_standard_name(domaingroup_hdl%daddr, standard_name_, len(standard_name_)) 
    671       END IF 
    672       IF (PRESENT(long_name_))        THEN 
    673          CALL cxios_set_domaingroup_long_name(domaingroup_hdl%daddr, long_name_, len(long_name_)) 
    674        END IF 
    675       IF (PRESENT(domain_group_ref_)) THEN 
    676          CALL cxios_set_domaingroup_domain_group_ref(domaingroup_hdl%daddr, domain_group_ref_, len(domain_group_ref_)) 
    677       END IF 
    678       IF (PRESENT(ni_glo_))           THEN 
    679          CALL cxios_set_domaingroup_ni_glo(domaingroup_hdl%daddr, ni_glo_) 
    680       END IF 
    681       IF (PRESENT(nj_glo_))           THEN 
    682          CALL cxios_set_domaingroup_nj_glo(domaingroup_hdl%daddr, nj_glo_) 
    683       END IF 
    684       IF (PRESENT(ibegin_))           THEN 
    685          CALL cxios_set_domaingroup_ibegin(domaingroup_hdl%daddr, ibegin_) 
    686        END IF 
    687       IF (PRESENT(iend_))             THEN 
    688          CALL cxios_set_domaingroup_iend(domaingroup_hdl%daddr, iend_) 
    689       END IF 
    690       IF (PRESENT(ni_))               THEN 
    691          CALL cxios_set_domaingroup_ni(domaingroup_hdl%daddr, ni_) 
    692       END IF 
    693       IF (PRESENT(jbegin_))           THEN 
    694          CALL cxios_set_domaingroup_jbegin(domaingroup_hdl%daddr, jbegin_) 
    695       END IF 
    696       IF (PRESENT(jend_))             THEN 
    697          CALL cxios_set_domaingroup_jend(domaingroup_hdl%daddr, jend_) 
    698       END IF 
    699       IF (PRESENT(nj_))               THEN 
    700          CALL cxios_set_domaingroup_nj(domaingroup_hdl%daddr, nj_) 
    701       END IF 
    702       IF (PRESENT(mask_))             THEN 
    703          ALLOCATE(mask__(size(mask_, 1), size(mask_, 2))) 
    704          mask__(:,:) = mask_(:,:) 
    705          CALL cxios_set_domaingroup_mask(domaingroup_hdl%daddr, mask__, size(mask_, 1), size(mask_, 2))          
    706          DEALLOCATE(mask__) 
    707       END IF 
    708       IF (PRESENT(data_dim_))         THEN 
    709          CALL cxios_set_domaingroup_data_dim(domaingroup_hdl%daddr, data_dim_) 
    710       END IF 
    711       IF (PRESENT(data_ni_))          THEN 
    712          CALL cxios_set_domaingroup_data_ni(domaingroup_hdl%daddr, data_ni_) 
    713       END IF  
    714       IF (PRESENT(data_nj_))          THEN 
    715          CALL cxios_set_domaingroup_data_nj(domaingroup_hdl%daddr, data_nj_) 
    716       END IF 
    717       IF (PRESENT(data_ibegin_))      THEN 
    718          CALL cxios_set_domaingroup_data_ibegin(domaingroup_hdl%daddr, data_ibegin_) 
    719       END IF 
    720       IF (PRESENT(data_jbegin_))      THEN 
    721          CALL cxios_set_domaingroup_data_jbegin(domaingroup_hdl%daddr, data_jbegin_) 
    722       END IF 
    723       IF (PRESENT(zoom_ni_))          THEN 
    724          CALL cxios_set_domaingroup_zoom_ni(domaingroup_hdl%daddr, zoom_ni_) 
    725       END IF 
    726       IF (PRESENT(zoom_nj_))          THEN 
    727        CALL cxios_set_domaingroup_zoom_nj(domaingroup_hdl%daddr, zoom_nj_) 
    728       END IF 
    729       IF (PRESENT(zoom_ibegin_))      THEN 
    730          CALL cxios_set_domaingroup_zoom_ibegin(domaingroup_hdl%daddr, zoom_ibegin_) 
    731       END IF 
    732       IF (PRESENT(zoom_jbegin_))      THEN 
    733          CALL cxios_set_domaingroup_zoom_jbegin(domaingroup_hdl%daddr, zoom_jbegin_) 
    734       END IF 
    735       IF (PRESENT(zoom_ni_loc_))      THEN 
    736          CALL cxios_set_domaingroup_zoom_ni_loc(domaingroup_hdl%daddr, zoom_ni_loc_) 
    737       END IF    
    738       IF (PRESENT(zoom_nj_loc_))      THEN 
    739          CALL cxios_set_domaingroup_zoom_nj_loc(domaingroup_hdl%daddr, zoom_nj_loc_) 
    740       END IF 
    741       IF (PRESENT(zoom_ibegin_loc_))  THEN 
    742          CALL cxios_set_domaingroup_zoom_ibegin_loc(domaingroup_hdl%daddr, zoom_ibegin_loc_) 
    743       END IF 
    744       IF (PRESENT(zoom_jbegin_loc_))  THEN 
    745          CALL cxios_set_domaingroup_zoom_jbegin_loc(domaingroup_hdl%daddr, zoom_jbegin_loc_) 
    746       END IF 
    747       IF (PRESENT(data_n_index_))     THEN 
    748          CALL cxios_set_domaingroup_data_n_index(domaingroup_hdl%daddr, data_n_index_) 
    749       END IF 
    750       IF (PRESENT(data_i_index_))     THEN 
    751          CALL cxios_set_domaingroup_data_i_index(domaingroup_hdl%daddr, data_i_index_, size(data_i_index_, 1)) 
    752       END IF 
    753       IF (PRESENT(data_j_index_))     THEN 
    754          CALL cxios_set_domaingroup_data_j_index(domaingroup_hdl%daddr, data_j_index_, size(data_j_index_, 1)) 
    755       END IF 
    756       IF (PRESENT(lonvalue_))         THEN 
    757          CALL cxios_set_domaingroup_lonvalue(domaingroup_hdl%daddr, lonvalue_, size(lonvalue_, 1)) 
    758       END IF 
    759       IF (PRESENT(latvalue_))         THEN 
    760          CALL cxios_set_domaingroup_latvalue(domaingroup_hdl%daddr, latvalue_, size(latvalue_, 1)) 
    761       END IF 
    762  
    763    END SUBROUTINE set_domaingroup_attributes_hdl 
    764     
    765    SUBROUTINE set_domain_attributes_id                                                                   & 
    766    ( domain_id, name_, standard_name_, long_name_, domain_group_ref_, ni_glo_, nj_glo_, ibegin_, iend_,  & 
    767      ni_, jbegin_, jend_, nj_, mask_, data_dim_, data_ni_, data_nj_, data_ibegin_, data_jbegin_,         & 
    768      zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, zoom_ni_loc_, zoom_nj_loc_, zoom_ibegin_loc_,       & 
    769      zoom_jbegin_loc_, data_n_index_, data_i_index_, data_j_index_, lonvalue_, latvalue_) 
    770       IMPLICIT NONE 
    771       TYPE(XDomainHandle)                                   :: domain_hdl 
    772       CHARACTER(len = *)                       , INTENT(IN) :: domain_id 
    773       CHARACTER(len = *)             , OPTIONAL, INTENT(IN) :: name_ 
    774       CHARACTER(len = *)             , OPTIONAL, INTENT(IN) :: standard_name_ 
    775       CHARACTER(len = *)             , OPTIONAL, INTENT(IN) :: long_name_ 
    776       CHARACTER(len = *)             , OPTIONAL, INTENT(IN) :: domain_group_ref_ 
    777       INTEGER                        , OPTIONAL, INTENT(IN) :: ni_glo_ 
    778       INTEGER                        , OPTIONAL, INTENT(IN) :: nj_glo_ 
    779       INTEGER                        , OPTIONAL, INTENT(IN) :: ibegin_ 
    780       INTEGER                        , OPTIONAL, INTENT(IN) :: iend_ 
    781       INTEGER                        , OPTIONAL, INTENT(IN) :: ni_ 
    782       INTEGER                        , OPTIONAL, INTENT(IN) :: jbegin_ 
    783       INTEGER                        , OPTIONAL, INTENT(IN) :: jend_ 
    784       INTEGER                        , OPTIONAL, INTENT(IN) :: nj_ 
    785       LOGICAL          , dimension(*), OPTIONAL, INTENT(IN) :: mask_(:,:) 
    786       INTEGER                        , OPTIONAL, INTENT(IN) :: data_dim_ 
    787       INTEGER                        , OPTIONAL, INTENT(IN) :: data_ni_ 
    788       INTEGER                        , OPTIONAL, INTENT(IN) :: data_nj_ 
    789       INTEGER                        , OPTIONAL, INTENT(IN) :: data_ibegin_ 
    790       INTEGER                        , OPTIONAL, INTENT(IN) :: data_jbegin_ 
    791       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ni_ 
    792       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_nj_ 
    793       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ibegin_ 
    794       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_jbegin_ 
    795       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ni_loc_ 
    796       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_nj_loc_ 
    797       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc_ 
    798       INTEGER                        , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc_ 
    799       INTEGER                        , OPTIONAL, INTENT(IN) :: data_n_index_ 
    800       INTEGER       , dimension(*)   , OPTIONAL, INTENT(IN) :: data_i_index_(:) 
    801       INTEGER       , dimension(*)   , OPTIONAL, INTENT(IN) :: data_j_index_(:) 
    802       REAL(kind = 8), dimension(*)   , OPTIONAL, INTENT(IN) :: lonvalue_(:) 
    803       REAL(kind = 8), dimension(*)   , OPTIONAL, INTENT(IN) :: latvalue_(:) 
    804   
    805       CALL domain_handle_create(domain_hdl, domain_id) 
    806       CALL set_domain_attributes_hdl                                                                     & 
    807    ( domain_hdl, name_, standard_name_, long_name_, domain_group_ref_, ni_glo_, nj_glo_, ibegin_, iend_, & 
    808      ni_, jbegin_, jend_, nj_, mask_, data_dim_, data_ni_, data_nj_, data_ibegin_, data_jbegin_,         & 
    809      zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, zoom_ni_loc_, zoom_nj_loc_, zoom_ibegin_loc_,       & 
    810      zoom_jbegin_loc_, data_n_index_, data_i_index_, data_j_index_, lonvalue_, latvalue_) 
    811  
    812    END SUBROUTINE set_domain_attributes_id 
    813     
    814    SUBROUTINE set_domain_attributes_hdl                                                                  & 
    815    ( domain_hdl,name_, standard_name_, long_name_, domain_group_ref_, ni_glo_, nj_glo_, ibegin_, iend_,  & 
    816      ni_, jbegin_, jend_, nj_, mask_, data_dim_, data_ni_, data_nj_, data_ibegin_, data_jbegin_,         & 
    817      zoom_ni_, zoom_nj_, zoom_ibegin_, zoom_jbegin_, zoom_ni_loc_, zoom_nj_loc_, zoom_ibegin_loc_,       & 
    818      zoom_jbegin_loc_, data_n_index_, data_i_index_, data_j_index_, lonvalue_, latvalue_) 
    819       IMPLICIT NONE 
    820       TYPE(XDomainHandle)                        , INTENT(IN) :: domain_hdl 
    821       CHARACTER(len = *)               , OPTIONAL, INTENT(IN) :: name_ 
    822       CHARACTER(len = *)               , OPTIONAL, INTENT(IN) :: standard_name_ 
    823       CHARACTER(len = *)               , OPTIONAL, INTENT(IN) :: long_name_ 
    824       CHARACTER(len = *)               , OPTIONAL, INTENT(IN) :: domain_group_ref_ 
    825       INTEGER                          , OPTIONAL, INTENT(IN) :: ni_glo_ 
    826       INTEGER                          , OPTIONAL, INTENT(IN) :: nj_glo_ 
    827       INTEGER                          , OPTIONAL, INTENT(IN) :: ibegin_ 
    828       INTEGER                          , OPTIONAL, INTENT(IN) :: iend_ 
    829       INTEGER                          , OPTIONAL, INTENT(IN) :: ni_ 
    830       INTEGER                          , OPTIONAL, INTENT(IN) :: jbegin_ 
    831       INTEGER                          , OPTIONAL, INTENT(IN) :: jend_ 
    832       INTEGER                          , OPTIONAL, INTENT(IN) :: nj_ 
    833       LOGICAL          , dimension(*)  , OPTIONAL, INTENT(IN) :: mask_(:,:) 
    834       LOGICAL(kind = 1), dimension(:,:), ALLOCATABLE          :: mask__ 
    835       INTEGER                          , OPTIONAL, INTENT(IN) :: data_dim_ 
    836       INTEGER                          , OPTIONAL, INTENT(IN) :: data_ni_ 
    837       INTEGER                          , OPTIONAL, INTENT(IN) :: data_nj_ 
    838       INTEGER                          , OPTIONAL, INTENT(IN) :: data_ibegin_ 
    839       INTEGER                          , OPTIONAL, INTENT(IN) :: data_jbegin_ 
    840       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ni_ 
    841       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_nj_ 
    842       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_ 
    843       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_ 
    844       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ni_loc_ 
    845       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_nj_loc_ 
    846       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_ibegin_loc_ 
    847       INTEGER                          , OPTIONAL, INTENT(IN) :: zoom_jbegin_loc_ 
    848       INTEGER                          , OPTIONAL, INTENT(IN) :: data_n_index_ 
    849       INTEGER       , dimension(*)     , OPTIONAL, INTENT(IN) :: data_i_index_(:) 
    850       INTEGER       , dimension(*)     , OPTIONAL, INTENT(IN) :: data_j_index_(:) 
    851       REAL(kind = 8), dimension(*)     , OPTIONAL, INTENT(IN) :: lonvalue_(:) 
    852       REAL(kind = 8), dimension(*)     , OPTIONAL, INTENT(IN) :: latvalue_(:) 
    853       IF (PRESENT(name_))             THEN 
    854          CALL cxios_set_domain_name(domain_hdl%daddr, name_, len(name_)) 
    855       END IF 
    856       IF (PRESENT(standard_name_))    THEN 
    857          CALL cxios_set_domain_standard_name(domain_hdl%daddr, standard_name_, len(standard_name_)) 
    858       END IF 
    859       IF (PRESENT(long_name_))        THEN 
    860          CALL cxios_set_domain_long_name(domain_hdl%daddr, long_name_, len(long_name_)) 
    861        END IF 
    862       IF (PRESENT(domain_group_ref_)) THEN 
    863          CALL cxios_set_domain_domain_group_ref(domain_hdl%daddr, domain_group_ref_, len(domain_group_ref_)) 
    864       END IF 
    865       IF (PRESENT(ni_glo_))           THEN 
    866          CALL cxios_set_domain_ni_glo(domain_hdl%daddr, ni_glo_) 
    867       END IF 
    868       IF (PRESENT(nj_glo_))           THEN 
    869          CALL cxios_set_domain_nj_glo(domain_hdl%daddr, nj_glo_) 
    870       END IF 
    871       IF (PRESENT(ibegin_))           THEN 
    872          CALL cxios_set_domain_ibegin(domain_hdl%daddr, ibegin_) 
    873        END IF 
    874       IF (PRESENT(iend_))             THEN 
    875          CALL cxios_set_domain_iend(domain_hdl%daddr, iend_) 
    876       END IF 
    877       IF (PRESENT(ni_))               THEN 
    878          CALL cxios_set_domain_ni(domain_hdl%daddr, ni_) 
    879       END IF 
    880       IF (PRESENT(jbegin_))           THEN 
    881          CALL cxios_set_domain_jbegin(domain_hdl%daddr, jbegin_) 
    882       END IF 
    883       IF (PRESENT(jend_))             THEN 
    884          CALL cxios_set_domain_jend(domain_hdl%daddr, jend_) 
    885       END IF 
    886       IF (PRESENT(nj_))               THEN 
    887          CALL cxios_set_domain_nj(domain_hdl%daddr, nj_) 
    888       END IF 
    889       IF (PRESENT(mask_))             THEN 
    890          ALLOCATE(mask__(size(mask_, 1), size(mask_, 2))) 
    891          mask__(:,:) = mask_(:,:) 
    892          CALL cxios_set_domain_mask(domain_hdl%daddr, mask__, size(mask_, 1), size(mask_, 2))          
    893          DEALLOCATE(mask__) 
    894       END IF 
    895       IF (PRESENT(data_dim_))         THEN 
    896          CALL cxios_set_domain_data_dim(domain_hdl%daddr, data_dim_) 
    897       END IF 
    898       IF (PRESENT(data_ni_))          THEN 
    899          CALL cxios_set_domain_data_ni(domain_hdl%daddr, data_ni_) 
    900       END IF  
    901       IF (PRESENT(data_nj_))          THEN 
    902          CALL cxios_set_domain_data_nj(domain_hdl%daddr, data_nj_) 
    903       END IF 
    904       IF (PRESENT(data_ibegin_))      THEN 
    905          CALL cxios_set_domain_data_ibegin(domain_hdl%daddr, data_ibegin_) 
    906       END IF 
    907       IF (PRESENT(data_jbegin_))      THEN 
    908          CALL cxios_set_domain_data_jbegin(domain_hdl%daddr, data_jbegin_) 
    909       END IF 
    910       IF (PRESENT(zoom_ni_))          THEN 
    911          CALL cxios_set_domain_zoom_ni(domain_hdl%daddr, zoom_ni_) 
    912       END IF 
    913       IF (PRESENT(zoom_nj_))          THEN 
    914        CALL cxios_set_domain_zoom_nj(domain_hdl%daddr, zoom_nj_) 
    915       END IF 
    916       IF (PRESENT(zoom_ibegin_))      THEN 
    917          CALL cxios_set_domain_zoom_ibegin(domain_hdl%daddr, zoom_ibegin_) 
    918       END IF 
    919       IF (PRESENT(zoom_jbegin_))      THEN 
    920          CALL cxios_set_domain_zoom_jbegin(domain_hdl%daddr, zoom_jbegin_) 
    921       END IF 
    922       IF (PRESENT(zoom_ni_loc_))      THEN 
    923          CALL cxios_set_domain_zoom_ni_loc(domain_hdl%daddr, zoom_ni_loc_) 
    924       END IF    
    925       IF (PRESENT(zoom_nj_loc_))      THEN 
    926          CALL cxios_set_domain_zoom_nj_loc(domain_hdl%daddr, zoom_nj_loc_) 
    927       END IF 
    928       IF (PRESENT(zoom_ibegin_loc_))  THEN 
    929          CALL cxios_set_domain_zoom_ibegin_loc(domain_hdl%daddr, zoom_ibegin_loc_) 
    930       END IF 
    931       IF (PRESENT(zoom_jbegin_loc_))  THEN 
    932          CALL cxios_set_domain_zoom_jbegin_loc(domain_hdl%daddr, zoom_jbegin_loc_) 
    933       END IF 
    934       IF (PRESENT(data_n_index_))     THEN 
    935          CALL cxios_set_domain_data_n_index(domain_hdl%daddr, data_n_index_) 
    936       END IF 
    937       IF (PRESENT(data_i_index_))     THEN 
    938          CALL cxios_set_domain_data_i_index(domain_hdl%daddr, data_i_index_, size(data_i_index_, 1)) 
    939       END IF 
    940       IF (PRESENT(data_j_index_))     THEN 
    941          CALL cxios_set_domain_data_j_index(domain_hdl%daddr, data_j_index_, size(data_j_index_, 1)) 
    942       END IF 
    943       IF (PRESENT(lonvalue_))         THEN 
    944          CALL cxios_set_domain_lonvalue(domain_hdl%daddr, lonvalue_, size(lonvalue_, 1)) 
    945       END IF 
    946       IF (PRESENT(latvalue_))         THEN 
    947          CALL cxios_set_domain_latvalue(domain_hdl%daddr, latvalue_, size(latvalue_, 1)) 
    948       END IF 
    949  
    950    END SUBROUTINE set_domain_attributes_hdl 
    951     
    952    SUBROUTINE domain_handle_create(ret, idt) 
    953       IMPLICIT NONE 
    954       TYPE(XDomainHandle), INTENT(OUT):: ret 
    955       CHARACTER(len = *) , INTENT(IN) :: idt       
    956       CALL cxios_domain_handle_create(ret%daddr, idt, len(idt))             
    957    END SUBROUTINE domain_handle_create 
    958     
    959    SUBROUTINE domaingroup_handle_create(ret, idt) 
    960       IMPLICIT NONE 
    961       TYPE(XDomainGroupHandle), INTENT(OUT):: ret 
    962       CHARACTER(len = *)      , INTENT(IN) :: idt       
    963       CALL cxios_domaingroup_handle_create(ret%daddr, idt, len(idt))             
    964    END SUBROUTINE domaingroup_handle_create 
    965  
    966    LOGICAL FUNCTION domain_valid_id(idt) 
    967       IMPLICIT NONE 
    968       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    969       LOGICAL  (kind = 1)                 :: val 
    970       CALL cxios_domain_valid_id(val, idt, len(idt)); 
    971       domain_valid_id = val 
    972    END FUNCTION  domain_valid_id 
    973  
    974    LOGICAL FUNCTION domaingroup_valid_id(idt) 
    975       IMPLICIT NONE 
    976       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    977       LOGICAL  (kind = 1)                 :: val 
    978       CALL cxios_domaingroup_valid_id(val, idt, len(idt)); 
    979       domaingroup_valid_id = val 
    980    END FUNCTION  domaingroup_valid_id 
    981482    
    982483END MODULE IDOMAIN 

  • 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 

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

    r300 r312  
    66   USE FILEGROUP_INTERFACE 
    77    
    8    TYPE XFileHandle 
    9       INTEGER(kind = C_INTPTR_T) :: daddr 
    10    END TYPE XFileHandle 
    11     
    12    TYPE XFileGroupHandle 
    13       INTEGER(kind = C_INTPTR_T) :: daddr 
    14    END TYPE XFileGroupHandle 
    15  
    168   TYPE txios(file) 
    179      INTEGER(kind = C_INTPTR_T) :: daddr 
    … …  
    2214   END TYPE txios(filegroup) 
    2315    
    24    !---------------------------------------------------------------------------- 
    25    INTERFACE set_file_attributes 
    26       MODULE PROCEDURE set_file_attributes_id,set_file_attributes_hdl 
    27    END INTERFACE   
    28     
    29    INTERFACE set_file_group_attributes 
    30       MODULE PROCEDURE set_filegroup_attributes_id,set_filegroup_attributes_hdl 
    31    END INTERFACE   
    32    !---------------------------------------------------------------------------- 
    33    
    3416   CONTAINS ! Fonctions disponibles pour les utilisateurs. 
    3517 
    … …  
    180162 
    181163 
    182  
    183164   SUBROUTINE xios(get_file_handle)( idt, ret) 
    184165      IMPLICIT NONE 
    … …  
    219200   END FUNCTION  xios(is_valid_filegroup) 
    220201 
    221  
    222  
    223  
    224  
    225  
    226  
    227  
    228  
    229  
    230  
    231  
    232  
    233  
    234  
    235  
    236 !!!!!!!!!!!!!! Anciennes interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    237 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    238     
    239    SUBROUTINE set_file_attributes_id(file_id, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_) 
    240       IMPLICIT NONE 
    241       TYPE(XFileHandle)                        :: file_hdl 
    242       CHARACTER(len = *)          , INTENT(IN) :: file_id 
    243       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_ 
    244       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_ 
    245       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_ 
    246       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_ 
    247       INTEGER           , OPTIONAL, INTENT(IN) :: output_level_ 
    248       LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_ 
    249        
    250       CALL file_handle_create(file_hdl, file_id) 
    251       CALL set_file_attributes_hdl(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_) 
    252        
    253    END SUBROUTINE set_file_attributes_id 
    254     
    255    SUBROUTINE set_file_attributes_hdl(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_) 
    256       TYPE(XFileHandle)           , INTENT(IN) :: file_hdl 
    257       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_ 
    258       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_ 
    259       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_ 
    260       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_ 
    261       INTEGER           , OPTIONAL, INTENT(IN) :: output_level_ 
    262       LOGICAL(kind = 1)                        :: enabled__ 
    263       LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_ 
    264        
    265       IF (PRESENT(name_))         THEN 
    266          CALL cxios_set_file_name(file_hdl%daddr, name_, len(name_)) 
    267       END IF 
    268       IF (PRESENT(description_))  THEN 
    269          CALL cxios_set_file_description(file_hdl%daddr, description_, len(description_)) 
    270       END IF 
    271       IF (PRESENT(name_suffix_))  THEN 
    272          CALL cxios_set_file_name_suffix(file_hdl%daddr, name_suffix_, len(name_suffix_)) 
    273       END IF 
    274       IF (PRESENT(output_freq_))  THEN 
    275          CALL cxios_set_file_output_freq(file_hdl%daddr, output_freq_, len(output_freq_)) 
    276       END IF 
    277       IF (PRESENT(output_level_)) THEN 
    278          CALL cxios_set_file_output_level(file_hdl%daddr, output_level_) 
    279       END IF 
    280       IF (PRESENT(enabled_))      THEN 
    281          enabled__ = enabled_         
    282          CALL cxios_set_file_enabled(file_hdl%daddr, enabled__) 
    283       END IF 
    284  
    285    END SUBROUTINE set_file_attributes_hdl 
    286     
    287    SUBROUTINE set_filegroup_attributes_id(filegroup_id, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_) 
    288       IMPLICIT NONE 
    289       TYPE(XFileGroupHandle)                   :: filegroup_hdl 
    290       CHARACTER(len = *)          , INTENT(IN) :: filegroup_id 
    291       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_ 
    292       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_ 
    293       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_ 
    294       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_ 
    295       INTEGER           , OPTIONAL, INTENT(IN) :: output_level_ 
    296       LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_ 
    297        
    298       CALL filegroup_handle_create(filegroup_hdl, filegroup_id) 
    299       CALL set_filegroup_attributes_hdl(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_) 
    300        
    301    END SUBROUTINE set_filegroup_attributes_id 
    302     
    303    SUBROUTINE set_filegroup_attributes_hdl(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_) 
    304       IMPLICIT NONE 
    305       TYPE(XFileGroupHandle)      , INTENT(IN) :: filegroup_hdl 
    306       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_ 
    307       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_ 
    308       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_ 
    309       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_ 
    310       INTEGER           , OPTIONAL, INTENT(IN) :: output_level_ 
    311       LOGICAL(kind = 1)                        :: enabled__ 
    312       LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_ 
    313        
    314       IF (PRESENT(name_))         THEN 
    315          CALL cxios_set_filegroup_name(filegroup_hdl%daddr, name_, len(name_)) 
    316       END IF 
    317       IF (PRESENT(description_))  THEN 
    318          CALL cxios_set_filegroup_description(filegroup_hdl%daddr, description_, len(description_)) 
    319       END IF 
    320       IF (PRESENT(name_suffix_))  THEN 
    321          CALL cxios_set_filegroup_name_suffix(filegroup_hdl%daddr, name_suffix_, len(name_suffix_)) 
    322       END IF 
    323       IF (PRESENT(output_freq_))  THEN 
    324          CALL cxios_set_filegroup_output_freq(filegroup_hdl%daddr, output_freq_, len(output_freq_)) 
    325       END IF 
    326       IF (PRESENT(output_level_)) THEN 
    327          CALL cxios_set_filegroup_output_level(filegroup_hdl%daddr, output_level_) 
    328       END IF 
    329       IF (PRESENT(enabled_))      THEN 
    330         enabled__ = enabled_  
    331         CALL cxios_set_filegroup_enabled(filegroup_hdl%daddr, enabled__) 
    332       END IF 
    333  
    334    END SUBROUTINE set_filegroup_attributes_hdl 
    335     
    336    SUBROUTINE file_handle_create(ret, idt) 
    337       IMPLICIT NONE 
    338       TYPE(XFileHandle) , INTENT(OUT):: ret 
    339       CHARACTER(len = *), INTENT(IN) :: idt       
    340       CALL cxios_file_handle_create(ret%daddr, idt, len(idt))             
    341    END SUBROUTINE file_handle_create 
    342     
    343    SUBROUTINE filegroup_handle_create(ret, idt) 
    344       IMPLICIT NONE 
    345       TYPE(XFileGroupHandle), INTENT(OUT):: ret 
    346       CHARACTER(len = *)    , INTENT(IN) :: idt       
    347       CALL cxios_filegroup_handle_create(ret%daddr, idt, len(idt))             
    348    END SUBROUTINE filegroup_handle_create 
    349  
    350    LOGICAL FUNCTION file_valid_id(idt) 
    351       IMPLICIT NONE 
    352       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    353       LOGICAL  (kind = 1)                 :: val 
    354       CALL cxios_file_valid_id(val, idt, len(idt)); 
    355       file_valid_id = val 
    356    END FUNCTION  file_valid_id 
    357  
    358    LOGICAL FUNCTION filegroup_valid_id(idt) 
    359       IMPLICIT NONE 
    360       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    361       LOGICAL  (kind = 1)                 :: val 
    362       CALL cxios_filegroup_valid_id(val, idt, len(idt)); 
    363       filegroup_valid_id = val 
    364    END FUNCTION  filegroup_valid_id 
    365202    
    366203END MODULE IFILE 

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

    r286 r312  
    55   USE GRID_INTERFACE 
    66   USE GRIDGROUP_INTERFACE 
    7     
    8    TYPE XGridHandle 
    9       INTEGER(kind = C_INTPTR_T) :: daddr 
    10    END TYPE XGridHandle 
    11     
    12    TYPE XGridGroupHandle 
    13       INTEGER(kind = C_INTPTR_T) :: daddr 
    14    END TYPE XGridGroupHandle 
    157 
    168   TYPE txios(grid) 
    … …  
    2214   END TYPE txios(gridgroup) 
    2315    
    24    !---------------------------------------------------------------------------- 
    25    INTERFACE set_grid_attributes 
    26       MODULE PROCEDURE set_grid_attributes_id,set_grid_attributes_hdl 
    27    END INTERFACE   
    28     
    29    INTERFACE set_grid_group_attributes 
    30       MODULE PROCEDURE set_gridgroup_attributes_id,set_gridgroup_attributes_hdl 
    31    END INTERFACE   
    32    !---------------------------------------------------------------------------- 
    3316    
    3417   CONTAINS ! Fonctions disponibles pour les utilisateurs. 
    … …  
    175158   END FUNCTION  xios(is_valid_gridgroup) 
    176159 
    177  
    178  
    179  
    180  
    181  
    182  
    183  
    184  
    185  
    186  
    187  
    188  
    189  
    190  
    191  
    192  
    193  
    194  
    195  
    196  
    197 !!!!!!!!!!!!!!!!!!!!  Anciennes interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    198 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    199     
    200    SUBROUTINE set_grid_attributes_id(grid_id, name_, description_, domain_ref_, axis_ref_) 
    201       IMPLICIT NONE 
    202       TYPE(XGridHandle)                             :: grid_hdl 
    203       CHARACTER(len = *)               , INTENT(IN) :: grid_id 
    204       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_ 
    205       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_ 
    206       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_ 
    207       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_ 
    208        
    209       CALL grid_handle_create(grid_hdl, grid_id) 
    210       CALL set_grid_attributes_hdl(grid_hdl, name_, description_, domain_ref_, axis_ref_) 
    211  
    212    END SUBROUTINE set_grid_attributes_id 
    213  
    214    SUBROUTINE set_grid_attributes_hdl(grid_hdl, name_, description_, domain_ref_, axis_ref_) 
    215       IMPLICIT NONE 
    216       TYPE      (XGridHandle)                       :: grid_hdl 
    217       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_ 
    218       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_ 
    219       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_ 
    220       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_ 
    221        
    222       IF (PRESENT(name_))        THEN 
    223        CALL cxios_set_grid_name(grid_hdl%daddr, name_, len(name_)) 
    224       END IF 
    225       IF (PRESENT(description_)) THEN 
    226        CALL cxios_set_grid_description(grid_hdl%daddr, description_, len(description_)) 
    227       END IF 
    228       IF (PRESENT(domain_ref_))  THEN 
    229        CALL cxios_set_grid_domain_ref(grid_hdl%daddr, domain_ref_, len(domain_ref_)) 
    230       END IF 
    231       IF (PRESENT(axis_ref_))    THEN 
    232        CALL cxios_set_grid_axis_ref(grid_hdl%daddr, axis_ref_, len(axis_ref_)) 
    233       END IF 
    234    END SUBROUTINE set_grid_attributes_hdl 
    235     
    236    SUBROUTINE set_gridgroup_attributes_id(gridgroup_id, name_, description_, domain_ref_, axis_ref_) 
    237       IMPLICIT NONE 
    238       TYPE(XGridGroupHandle)                        :: gridgroup_hdl 
    239       CHARACTER(len = *)               , INTENT(IN) :: gridgroup_id 
    240       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_ 
    241       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_ 
    242       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_ 
    243       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_ 
    244        
    245       CALL gridgroup_handle_create(gridgroup_hdl, gridgroup_id) 
    246       CALL set_gridgroup_attributes_hdl(gridgroup_hdl, name_, description_, domain_ref_, axis_ref_) 
    247  
    248    END SUBROUTINE set_gridgroup_attributes_id 
    249  
    250    SUBROUTINE set_gridgroup_attributes_hdl(gridgroup_hdl, name_, description_, domain_ref_, axis_ref_) 
    251       IMPLICIT NONE 
    252       TYPE      (XGridGroupHandle)                  :: gridgroup_hdl 
    253       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_ 
    254       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_ 
    255       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_ 
    256       CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_ 
    257        
    258       IF (PRESENT(name_))        THEN 
    259        CALL cxios_set_gridgroup_name(gridgroup_hdl%daddr, name_, len(name_)) 
    260       END IF 
    261       IF (PRESENT(description_)) THEN 
    262        CALL cxios_set_gridgroup_description(gridgroup_hdl%daddr, description_, len(description_)) 
    263       END IF 
    264       IF (PRESENT(domain_ref_))  THEN 
    265        CALL cxios_set_gridgroup_domain_ref(gridgroup_hdl%daddr, domain_ref_, len(domain_ref_)) 
    266       END IF 
    267       IF (PRESENT(axis_ref_))    THEN 
    268        CALL cxios_set_gridgroup_axis_ref(gridgroup_hdl%daddr, axis_ref_, len(axis_ref_)) 
    269       END IF 
    270    END SUBROUTINE set_gridgroup_attributes_hdl 
    271  
    272    SUBROUTINE grid_handle_create(ret, idt) 
    273       IMPLICIT NONE 
    274       TYPE(XGridHandle), INTENT(OUT):: ret 
    275       CHARACTER(len = *), INTENT(IN) :: idt       
    276       CALL cxios_grid_handle_create(ret%daddr, idt, len(idt))             
    277    END SUBROUTINE grid_handle_create 
    278     
    279    SUBROUTINE gridgroup_handle_create(ret, idt) 
    280       IMPLICIT NONE 
    281       TYPE(XGridGroupHandle), INTENT(OUT):: ret 
    282       CHARACTER(len = *)     , INTENT(IN) :: idt       
    283       CALL cxios_gridgroup_handle_create(ret%daddr, idt, len(idt))             
    284    END SUBROUTINE gridgroup_handle_create 
    285  
    286    LOGICAL FUNCTION grid_valid_id(idt) 
    287       IMPLICIT NONE 
    288       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    289       LOGICAL  (kind = 1)                 :: val 
    290       CALL cxios_grid_valid_id(val, idt, len(idt)); 
    291       grid_valid_id = val 
    292    END FUNCTION  grid_valid_id 
    293  
    294    LOGICAL FUNCTION gridgroup_valid_id(idt) 
    295       IMPLICIT NONE 
    296       CHARACTER(len  = *)    , INTENT(IN) :: idt 
    297       LOGICAL  (kind = 1)                 :: val 
    298       CALL cxios_gridgroup_valid_id(val, idt, len(idt)); 
    299       gridgroup_valid_id = val 
    300    END FUNCTION  gridgroup_valid_id 
    301160    
    302161END MODULE IGRID 

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

    r286 r312  
    126126      
    127127   END INTERFACE 
    128     
    129    !---------------------------------------------------------------------------- 
    130    INTERFACE xml_tree_add 
    131       MODULE PROCEDURE xml_tree_add_axis,   xml_tree_add_axisgroup,    & 
    132                        xml_tree_add_file,   xml_tree_add_filegroup,    & 
    133                        xml_tree_add_grid,   xml_tree_add_gridgroup,    & 
    134                        xml_tree_add_field,  xml_tree_add_fieldgroup,   & 
    135                        xml_tree_add_domain, xml_tree_add_domaingroup,  & 
    136                        xml_tree_add_fieldgrouptofile, xml_tree_add_fieldtofile 
    137    END INTERFACE   
    138    !---------------------------------------------------------------------------- 
     128 
    139129    
    140130   CONTAINS ! Fonctions disponibles pour les utilisateurs. 
    … …  
    298288 
    299289   END SUBROUTINE xios(add_fieldgrouptofile) 
    300  
    301 !   SUBROUTINE xml_tree_show(filename) 
    302 !      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: filename 
    303 !      IF (PRESENT(filename)) THEN 
    304 !         CALL cxios_xml_tree_show(filename, len(filename)) 
    305 !      ELSE 
    306 !         CALL cxios_xml_tree_show("NONE", -1) 
    307 !      END IF 
    308 !   END SUBROUTINE xml_tree_show 
    309     
    310 !   SUBROUTINE xml_parse_file(filename) 
    311 !      CHARACTER(len = *), INTENT(IN) :: filename 
    312 !      CALL cxios_xml_parse_file(filename, len(filename)) 
    313 !   END SUBROUTINE xml_Parse_File 
    314     
    315 !   SUBROUTINE xml_parse_string(xmlcontent) 
    316 !      CHARACTER(len = *), INTENT(IN) :: xmlcontent 
    317 !      CALL cxios_xml_parse_string(xmlcontent, len(xmlcontent)) 
    318 !   END SUBROUTINE xml_Parse_String 
    319  
    320  
    321  
    322  
    323  
    324  
    325  
    326  
    327  
    328  
    329  
    330  
    331  
    332  
    333  
    334 !!!!!!!!!!!!! Anciennes interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    335 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    336  
    337    SUBROUTINE xml_tree_add_axis(parent_hdl, child_hdl, child_id) 
    338       TYPE(XAxisGroupHandle)      , INTENT(IN) :: parent_hdl 
    339       TYPE(XAxisHandle)           , INTENT(OUT):: child_hdl 
    340       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id 
    341       IF (PRESENT(child_id)) THEN 
    342          CALL cxios_xml_tree_add_axis(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    343       ELSE 
    344          CALL cxios_xml_tree_add_axis(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    345       END IF 
    346    END SUBROUTINE xml_tree_add_axis 
    347     
    348    SUBROUTINE xml_tree_add_file(parent_hdl, child_hdl, child_id) 
    349       TYPE(XFileGroupHandle)      , INTENT(IN) :: parent_hdl 
    350       TYPE(XFileHandle)           , INTENT(OUT):: child_hdl 
    351       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id 
    352       IF (PRESENT(child_id)) THEN 
    353          CALL cxios_xml_tree_add_file(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    354       ELSE 
    355          CALL cxios_xml_tree_add_file(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    356       END IF 
    357    END SUBROUTINE xml_tree_add_file 
    358     
    359    SUBROUTINE xml_tree_add_grid(parent_hdl, child_hdl, child_id) 
    360       TYPE(XGridGroupHandle)      , INTENT(IN) :: parent_hdl 
    361       TYPE(XGridHandle)           , INTENT(OUT):: child_hdl 
    362       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id 
    363       IF (PRESENT(child_id)) THEN 
    364          CALL cxios_xml_tree_add_grid(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    365       ELSE 
    366          CALL cxios_xml_tree_add_grid(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    367       END IF 
    368    END SUBROUTINE xml_tree_add_grid 
    369     
    370    SUBROUTINE xml_tree_add_field(parent_hdl, child_hdl, child_id) 
    371       TYPE(XFieldGroupHandle)     , INTENT(IN) :: parent_hdl 
    372       TYPE(XFieldHandle)          , INTENT(OUT):: child_hdl 
    373       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id 
    374       IF (PRESENT(child_id)) THEN 
    375          CALL cxios_xml_tree_add_field(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    376       ELSE 
    377          CALL cxios_xml_tree_add_field(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    378       END IF 
    379    END SUBROUTINE xml_tree_add_field 
    380     
    381    SUBROUTINE xml_tree_add_domain(parent_hdl, child_hdl, child_id) 
    382       TYPE(XDomainGroupHandle)     , INTENT(IN) :: parent_hdl 
    383       TYPE(XDomainHandle)          , INTENT(OUT):: child_hdl 
    384       CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id 
    385       IF (PRESENT(child_id)) THEN 
    386          CALL cxios_xml_tree_add_domain(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    387       ELSE 
    388          CALL cxios_xml_tree_add_domain(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    389       END IF 
    390    END SUBROUTINE xml_tree_add_domain 
    391     
    392    SUBROUTINE xml_tree_add_fieldtofile(parent_hdl, child_hdl, child_id) 
    393       TYPE(XFileHandle)            , INTENT(IN) :: parent_hdl 
    394       TYPE(XFieldHandle)           , INTENT(OUT):: child_hdl 
    395       CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id 
    396       IF (PRESENT(child_id)) THEN 
    397          CALL cxios_xml_tree_add_fieldtofile(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    398       ELSE 
    399          CALL cxios_xml_tree_add_fieldtofile(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    400       END IF 
    401    END SUBROUTINE xml_tree_add_fieldtofile 
    402  
    403    SUBROUTINE xml_tree_add_axisgroup(parent_hdl, child_hdl, child_id) 
    404       TYPE(XAxisGroupHandle)      , INTENT(IN) :: parent_hdl 
    405       TYPE(XAxisGroupHandle)      , INTENT(OUT):: child_hdl 
    406       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id 
    407       IF (PRESENT(child_id)) THEN 
    408          CALL cxios_xml_tree_add_axisgroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    409       ELSE 
    410          CALL cxios_xml_tree_add_axisgroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    411       END IF 
    412    END SUBROUTINE xml_tree_add_axisgroup 
    413  
    414    SUBROUTINE xml_tree_add_filegroup(parent_hdl, child_hdl, child_id) 
    415       TYPE(XFileGroupHandle)      , INTENT(IN) :: parent_hdl 
    416       TYPE(XFileGroupHandle)      , INTENT(OUT):: child_hdl 
    417       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id 
    418       IF (PRESENT(child_id)) THEN 
    419          CALL cxios_xml_tree_add_filegroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    420       ELSE 
    421          CALL cxios_xml_tree_add_filegroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    422       END IF 
    423    END SUBROUTINE xml_tree_add_filegroup 
    424  
    425    SUBROUTINE xml_tree_add_gridgroup(parent_hdl, child_hdl, child_id) 
    426       TYPE(XGridGroupHandle)      , INTENT(IN) :: parent_hdl 
    427       TYPE(XGridGroupHandle)      , INTENT(OUT):: child_hdl 
    428       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id 
    429       IF (PRESENT(child_id)) THEN 
    430          CALL cxios_xml_tree_add_gridgroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    431       ELSE 
    432          CALL cxios_xml_tree_add_gridgroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    433       END IF 
    434    END SUBROUTINE xml_tree_add_gridgroup 
    435  
    436    SUBROUTINE xml_tree_add_fieldgroup(parent_hdl, child_hdl, child_id) 
    437       TYPE(XFieldGroupHandle)     , INTENT(IN) :: parent_hdl 
    438       TYPE(XFieldGroupHandle)     , INTENT(OUT):: child_hdl 
    439       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id 
    440       IF (PRESENT(child_id)) THEN 
    441          CALL cxios_xml_tree_add_fieldgroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    442       ELSE 
    443          CALL cxios_xml_tree_add_fieldgroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    444       END IF 
    445    END SUBROUTINE xml_tree_add_fieldgroup 
    446  
    447    SUBROUTINE xml_tree_add_domaingroup(parent_hdl, child_hdl, child_id) 
    448       TYPE(XDomainGroupHandle)     , INTENT(IN) :: parent_hdl 
    449       TYPE(XDomainGroupHandle)     , INTENT(OUT):: child_hdl 
    450       CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id 
    451       IF (PRESENT(child_id)) THEN 
    452          CALL cxios_xml_tree_add_domaingroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    453       ELSE 
    454          CALL cxios_xml_tree_add_domaingroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    455       END IF 
    456    END SUBROUTINE xml_tree_add_domaingroup 
    457  
    458    SUBROUTINE xml_tree_add_fieldgrouptofile(parent_hdl, child_hdl, child_id) 
    459       TYPE(XFileHandle)            , INTENT(IN) :: parent_hdl 
    460       TYPE(XFieldGroupHandle)      , INTENT(OUT):: child_hdl 
    461       CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id 
    462       IF (PRESENT(child_id)) THEN 
    463          CALL cxios_xml_tree_add_fieldgrouptofile(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id)) 
    464       ELSE 
    465          CALL cxios_xml_tree_add_fieldgrouptofile(parent_hdl%daddr, child_hdl%daddr, "NONE", -1) 
    466       END IF 
    467    END SUBROUTINE xml_tree_add_fieldgrouptofile 
    468  
    469    SUBROUTINE xml_tree_show(filename) 
    470       CHARACTER(len = *), OPTIONAL, INTENT(IN) :: filename 
    471       IF (PRESENT(filename)) THEN 
    472          CALL cxios_xml_tree_show(filename, len(filename)) 
    473       ELSE 
    474          CALL cxios_xml_tree_show("NONE", -1) 
    475       END IF 
    476    END SUBROUTINE xml_tree_show 
    477     
    478    SUBROUTINE xml_parse_file(filename) 
    479       CHARACTER(len = *), INTENT(IN) :: filename 
    480       CALL cxios_xml_parse_file(filename, len(filename)) 
    481    END SUBROUTINE xml_Parse_File 
    482     
    483    SUBROUTINE xml_parse_string(xmlcontent) 
    484       CHARACTER(len = *), INTENT(IN) :: xmlcontent 
    485       CALL cxios_xml_parse_string(xmlcontent, len(xmlcontent)) 
    486    END SUBROUTINE xml_Parse_String 
    487290       
    488291END MODULE IXML_TREE 
Note: See TracChangeset for help on using the changeset viewer.