Ignore:
Timestamp:
09/21/16 14:35:03 (8 years ago)
Author:
mhnguyen
Message:

Adding Fortran interface for high-dimension grid (up to 7)

+) Add check mask for high-dimension grid
+) Add Fortran interface for send_field, recv_field

Test
+) On Curie
+) Work

File:
1 edited

Legend:

Unmodified
Added
Removed

  • XIOS/trunk/src/interface/fortran_attr/igrid_attr.F90

    r817 r932  
    1212 
    1313  SUBROUTINE xios(set_grid_attr)  & 
    14     ( grid_id, description, mask_1d, mask_2d, mask_3d, name ) 
     14    ( grid_id, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     15     ) 
    1516 
    1617    IMPLICIT NONE 
    … …  
    2425      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_3d(:,:,:) 
    2526      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_3d_tmp(:,:,:) 
     27      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_4d(:,:,:,:) 
     28      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_4d_tmp(:,:,:,:) 
     29      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_5d(:,:,:,:,:) 
     30      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_5d_tmp(:,:,:,:,:) 
     31      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_6d(:,:,:,:,:,:) 
     32      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_6d_tmp(:,:,:,:,:,:) 
     33      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_7d(:,:,:,:,:,:,:) 
     34      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_7d_tmp(:,:,:,:,:,:,:) 
    2635      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name 
    2736 
    2837      CALL xios(get_grid_handle)(grid_id,grid_hdl) 
    2938      CALL xios(set_grid_attr_hdl_)   & 
    30       ( grid_hdl, description, mask_1d, mask_2d, mask_3d, name ) 
     39      ( grid_hdl, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     40       ) 
    3141 
    3242  END SUBROUTINE xios(set_grid_attr) 
    3343 
    3444  SUBROUTINE xios(set_grid_attr_hdl)  & 
    35     ( grid_hdl, description, mask_1d, mask_2d, mask_3d, name ) 
     45    ( grid_hdl, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     46     ) 
    3647 
    3748    IMPLICIT NONE 
    … …  
    4455      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_3d(:,:,:) 
    4556      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_3d_tmp(:,:,:) 
     57      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_4d(:,:,:,:) 
     58      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_4d_tmp(:,:,:,:) 
     59      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_5d(:,:,:,:,:) 
     60      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_5d_tmp(:,:,:,:,:) 
     61      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_6d(:,:,:,:,:,:) 
     62      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_6d_tmp(:,:,:,:,:,:) 
     63      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_7d(:,:,:,:,:,:,:) 
     64      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_7d_tmp(:,:,:,:,:,:,:) 
    4665      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name 
    4766 
    4867      CALL xios(set_grid_attr_hdl_)  & 
    49       ( grid_hdl, description, mask_1d, mask_2d, mask_3d, name ) 
     68      ( grid_hdl, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     69       ) 
    5070 
    5171  END SUBROUTINE xios(set_grid_attr_hdl) 
    5272 
    5373  SUBROUTINE xios(set_grid_attr_hdl_)   & 
    54     ( grid_hdl, description_, mask_1d_, mask_2d_, mask_3d_, name_ ) 
     74    ( grid_hdl, description_, mask_1d_, mask_2d_, mask_3d_, mask_4d_, mask_5d_, mask_6d_, mask_7d_  & 
     75    , name_ ) 
    5576 
    5677    IMPLICIT NONE 
    … …  
    6384      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_3d_(:,:,:) 
    6485      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_3d__tmp(:,:,:) 
     86      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_4d_(:,:,:,:) 
     87      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_4d__tmp(:,:,:,:) 
     88      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_5d_(:,:,:,:,:) 
     89      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_5d__tmp(:,:,:,:,:) 
     90      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_6d_(:,:,:,:,:,:) 
     91      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_6d__tmp(:,:,:,:,:,:) 
     92      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_7d_(:,:,:,:,:,:,:) 
     93      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_7d__tmp(:,:,:,:,:,:,:) 
    6594      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name_ 
    6695 
    … …  
    87116      ENDIF 
    88117 
     118      IF (PRESENT(mask_4d_)) THEN 
     119        ALLOCATE(mask_4d__tmp(SIZE(mask_4d_,1), SIZE(mask_4d_,2), SIZE(mask_4d_,3), SIZE(mask_4d_,4))) 
     120        mask_4d__tmp = mask_4d_ 
     121        CALL cxios_set_grid_mask_4d(grid_hdl%daddr, mask_4d__tmp, SHAPE(mask_4d_)) 
     122      ENDIF 
     123 
     124      IF (PRESENT(mask_5d_)) THEN 
     125        ALLOCATE(mask_5d__tmp(SIZE(mask_5d_,1), SIZE(mask_5d_,2), SIZE(mask_5d_,3), SIZE(mask_5d_,4), SIZE(mask_5d_,5))) 
     126        mask_5d__tmp = mask_5d_ 
     127        CALL cxios_set_grid_mask_5d(grid_hdl%daddr, mask_5d__tmp, SHAPE(mask_5d_)) 
     128      ENDIF 
     129 
     130      IF (PRESENT(mask_6d_)) THEN 
     131        ALLOCATE(mask_6d__tmp(SIZE(mask_6d_,1), SIZE(mask_6d_,2), SIZE(mask_6d_,3), SIZE(mask_6d_,4), SIZE(mask_6d_,5), SIZE(mask_6d_,6))) 
     132        mask_6d__tmp = mask_6d_ 
     133        CALL cxios_set_grid_mask_6d(grid_hdl%daddr, mask_6d__tmp, SHAPE(mask_6d_)) 
     134      ENDIF 
     135 
     136      IF (PRESENT(mask_7d_)) THEN 
     137        ALLOCATE(mask_7d__tmp(SIZE(mask_7d_,1), SIZE(mask_7d_,2), SIZE(mask_7d_,3), SIZE(mask_7d_,4), SIZE(mask_7d_,5), SIZE(mask_7d_,6), SIZE(mask_7d_,7))) 
     138        mask_7d__tmp = mask_7d_ 
     139        CALL cxios_set_grid_mask_7d(grid_hdl%daddr, mask_7d__tmp, SHAPE(mask_7d_)) 
     140      ENDIF 
     141 
    89142      IF (PRESENT(name_)) THEN 
    90143        CALL cxios_set_grid_name(grid_hdl%daddr, name_, len(name_)) 
    … …  
    94147 
    95148  SUBROUTINE xios(get_grid_attr)  & 
    96     ( grid_id, description, mask_1d, mask_2d, mask_3d, name ) 
     149    ( grid_id, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     150     ) 
    97151 
    98152    IMPLICIT NONE 
    … …  
    106160      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_3d(:,:,:) 
    107161      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_3d_tmp(:,:,:) 
     162      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_4d(:,:,:,:) 
     163      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_4d_tmp(:,:,:,:) 
     164      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_5d(:,:,:,:,:) 
     165      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_5d_tmp(:,:,:,:,:) 
     166      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_6d(:,:,:,:,:,:) 
     167      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_6d_tmp(:,:,:,:,:,:) 
     168      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_7d(:,:,:,:,:,:,:) 
     169      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_7d_tmp(:,:,:,:,:,:,:) 
    108170      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: name 
    109171 
    110172      CALL xios(get_grid_handle)(grid_id,grid_hdl) 
    111173      CALL xios(get_grid_attr_hdl_)   & 
    112       ( grid_hdl, description, mask_1d, mask_2d, mask_3d, name ) 
     174      ( grid_hdl, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     175       ) 
    113176 
    114177  END SUBROUTINE xios(get_grid_attr) 
    115178 
    116179  SUBROUTINE xios(get_grid_attr_hdl)  & 
    117     ( grid_hdl, description, mask_1d, mask_2d, mask_3d, name ) 
     180    ( grid_hdl, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     181     ) 
    118182 
    119183    IMPLICIT NONE 
    … …  
    126190      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_3d(:,:,:) 
    127191      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_3d_tmp(:,:,:) 
     192      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_4d(:,:,:,:) 
     193      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_4d_tmp(:,:,:,:) 
     194      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_5d(:,:,:,:,:) 
     195      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_5d_tmp(:,:,:,:,:) 
     196      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_6d(:,:,:,:,:,:) 
     197      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_6d_tmp(:,:,:,:,:,:) 
     198      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_7d(:,:,:,:,:,:,:) 
     199      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_7d_tmp(:,:,:,:,:,:,:) 
    128200      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: name 
    129201 
    130202      CALL xios(get_grid_attr_hdl_)  & 
    131       ( grid_hdl, description, mask_1d, mask_2d, mask_3d, name ) 
     203      ( grid_hdl, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     204       ) 
    132205 
    133206  END SUBROUTINE xios(get_grid_attr_hdl) 
    134207 
    135208  SUBROUTINE xios(get_grid_attr_hdl_)   & 
    136     ( grid_hdl, description_, mask_1d_, mask_2d_, mask_3d_, name_ ) 
     209    ( grid_hdl, description_, mask_1d_, mask_2d_, mask_3d_, mask_4d_, mask_5d_, mask_6d_, mask_7d_  & 
     210    , name_ ) 
    137211 
    138212    IMPLICIT NONE 
    … …  
    145219      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_3d_(:,:,:) 
    146220      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_3d__tmp(:,:,:) 
     221      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_4d_(:,:,:,:) 
     222      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_4d__tmp(:,:,:,:) 
     223      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_5d_(:,:,:,:,:) 
     224      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_5d__tmp(:,:,:,:,:) 
     225      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_6d_(:,:,:,:,:,:) 
     226      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_6d__tmp(:,:,:,:,:,:) 
     227      LOGICAL  , OPTIONAL, INTENT(OUT) :: mask_7d_(:,:,:,:,:,:,:) 
     228      LOGICAL (KIND=C_BOOL) , ALLOCATABLE :: mask_7d__tmp(:,:,:,:,:,:,:) 
    147229      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: name_ 
    148230 
    … …  
    169251      ENDIF 
    170252 
     253      IF (PRESENT(mask_4d_)) THEN 
     254        ALLOCATE(mask_4d__tmp(SIZE(mask_4d_,1), SIZE(mask_4d_,2), SIZE(mask_4d_,3), SIZE(mask_4d_,4))) 
     255        CALL cxios_get_grid_mask_4d(grid_hdl%daddr, mask_4d__tmp, SHAPE(mask_4d_)) 
     256        mask_4d_ = mask_4d__tmp 
     257      ENDIF 
     258 
     259      IF (PRESENT(mask_5d_)) THEN 
     260        ALLOCATE(mask_5d__tmp(SIZE(mask_5d_,1), SIZE(mask_5d_,2), SIZE(mask_5d_,3), SIZE(mask_5d_,4), SIZE(mask_5d_,5))) 
     261        CALL cxios_get_grid_mask_5d(grid_hdl%daddr, mask_5d__tmp, SHAPE(mask_5d_)) 
     262        mask_5d_ = mask_5d__tmp 
     263      ENDIF 
     264 
     265      IF (PRESENT(mask_6d_)) THEN 
     266        ALLOCATE(mask_6d__tmp(SIZE(mask_6d_,1), SIZE(mask_6d_,2), SIZE(mask_6d_,3), SIZE(mask_6d_,4), SIZE(mask_6d_,5), SIZE(mask_6d_,6))) 
     267        CALL cxios_get_grid_mask_6d(grid_hdl%daddr, mask_6d__tmp, SHAPE(mask_6d_)) 
     268        mask_6d_ = mask_6d__tmp 
     269      ENDIF 
     270 
     271      IF (PRESENT(mask_7d_)) THEN 
     272        ALLOCATE(mask_7d__tmp(SIZE(mask_7d_,1), SIZE(mask_7d_,2), SIZE(mask_7d_,3), SIZE(mask_7d_,4), SIZE(mask_7d_,5), SIZE(mask_7d_,6), SIZE(mask_7d_,7))) 
     273        CALL cxios_get_grid_mask_7d(grid_hdl%daddr, mask_7d__tmp, SHAPE(mask_7d_)) 
     274        mask_7d_ = mask_7d__tmp 
     275      ENDIF 
     276 
    171277      IF (PRESENT(name_)) THEN 
    172278        CALL cxios_get_grid_name(grid_hdl%daddr, name_, len(name_)) 
    … …  
    176282 
    177283  SUBROUTINE xios(is_defined_grid_attr)  & 
    178     ( grid_id, description, mask_1d, mask_2d, mask_3d, name ) 
     284    ( grid_id, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     285     ) 
    179286 
    180287    IMPLICIT NONE 
    … …  
    189296      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_3d 
    190297      LOGICAL(KIND=C_BOOL) :: mask_3d_tmp 
     298      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_4d 
     299      LOGICAL(KIND=C_BOOL) :: mask_4d_tmp 
     300      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_5d 
     301      LOGICAL(KIND=C_BOOL) :: mask_5d_tmp 
     302      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_6d 
     303      LOGICAL(KIND=C_BOOL) :: mask_6d_tmp 
     304      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_7d 
     305      LOGICAL(KIND=C_BOOL) :: mask_7d_tmp 
    191306      LOGICAL, OPTIONAL, INTENT(OUT) :: name 
    192307      LOGICAL(KIND=C_BOOL) :: name_tmp 
    … …  
    194309      CALL xios(get_grid_handle)(grid_id,grid_hdl) 
    195310      CALL xios(is_defined_grid_attr_hdl_)   & 
    196       ( grid_hdl, description, mask_1d, mask_2d, mask_3d, name ) 
     311      ( grid_hdl, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     312       ) 
    197313 
    198314  END SUBROUTINE xios(is_defined_grid_attr) 
    199315 
    200316  SUBROUTINE xios(is_defined_grid_attr_hdl)  & 
    201     ( grid_hdl, description, mask_1d, mask_2d, mask_3d, name ) 
     317    ( grid_hdl, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     318     ) 
    202319 
    203320    IMPLICIT NONE 
    … …  
    211328      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_3d 
    212329      LOGICAL(KIND=C_BOOL) :: mask_3d_tmp 
     330      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_4d 
     331      LOGICAL(KIND=C_BOOL) :: mask_4d_tmp 
     332      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_5d 
     333      LOGICAL(KIND=C_BOOL) :: mask_5d_tmp 
     334      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_6d 
     335      LOGICAL(KIND=C_BOOL) :: mask_6d_tmp 
     336      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_7d 
     337      LOGICAL(KIND=C_BOOL) :: mask_7d_tmp 
    213338      LOGICAL, OPTIONAL, INTENT(OUT) :: name 
    214339      LOGICAL(KIND=C_BOOL) :: name_tmp 
    215340 
    216341      CALL xios(is_defined_grid_attr_hdl_)  & 
    217       ( grid_hdl, description, mask_1d, mask_2d, mask_3d, name ) 
     342      ( grid_hdl, description, mask_1d, mask_2d, mask_3d, mask_4d, mask_5d, mask_6d, mask_7d, name  & 
     343       ) 
    218344 
    219345  END SUBROUTINE xios(is_defined_grid_attr_hdl) 
    220346 
    221347  SUBROUTINE xios(is_defined_grid_attr_hdl_)   & 
    222     ( grid_hdl, description_, mask_1d_, mask_2d_, mask_3d_, name_ ) 
     348    ( grid_hdl, description_, mask_1d_, mask_2d_, mask_3d_, mask_4d_, mask_5d_, mask_6d_, mask_7d_  & 
     349    , name_ ) 
    223350 
    224351    IMPLICIT NONE 
    … …  
    232359      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_3d_ 
    233360      LOGICAL(KIND=C_BOOL) :: mask_3d__tmp 
     361      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_4d_ 
     362      LOGICAL(KIND=C_BOOL) :: mask_4d__tmp 
     363      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_5d_ 
     364      LOGICAL(KIND=C_BOOL) :: mask_5d__tmp 
     365      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_6d_ 
     366      LOGICAL(KIND=C_BOOL) :: mask_6d__tmp 
     367      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_7d_ 
     368      LOGICAL(KIND=C_BOOL) :: mask_7d__tmp 
    234369      LOGICAL, OPTIONAL, INTENT(OUT) :: name_ 
    235370      LOGICAL(KIND=C_BOOL) :: name__tmp 
    … …  
    255390      ENDIF 
    256391 
     392      IF (PRESENT(mask_4d_)) THEN 
     393        mask_4d__tmp = cxios_is_defined_grid_mask_4d(grid_hdl%daddr) 
     394        mask_4d_ = mask_4d__tmp 
     395      ENDIF 
     396 
     397      IF (PRESENT(mask_5d_)) THEN 
     398        mask_5d__tmp = cxios_is_defined_grid_mask_5d(grid_hdl%daddr) 
     399        mask_5d_ = mask_5d__tmp 
     400      ENDIF 
     401 
     402      IF (PRESENT(mask_6d_)) THEN 
     403        mask_6d__tmp = cxios_is_defined_grid_mask_6d(grid_hdl%daddr) 
     404        mask_6d_ = mask_6d__tmp 
     405      ENDIF 
     406 
     407      IF (PRESENT(mask_7d_)) THEN 
     408        mask_7d__tmp = cxios_is_defined_grid_mask_7d(grid_hdl%daddr) 
     409        mask_7d_ = mask_7d__tmp 
     410      ENDIF 
     411 
    257412      IF (PRESENT(name_)) THEN 
    258413        name__tmp = cxios_is_defined_grid_name(grid_hdl%daddr) 
Note: See TracChangeset for help on using the changeset viewer.