00001
00002
00003
00004
00005
00006
00007
00008
00009 #include <stdio.h>
00010 #include <stdlib.h>
00011 #include <string.h>
00012 #include "ADF.h"
00013 #include "ADF_internals.h"
00014 #ifdef MEM_DEBUG
00015 #include "cg_malloc.h"
00016 #endif
00017
00018
00019
00020
00021
00022
00023 void FNAME(adfcna2,ADFCNA2)(
00024 const Fdouble *PID,
00025 const Fint *istart,
00026 const Fint *imaxnum,
00027 const Fint *idim,
00028 const Fint *name_length,
00029 Fint *inum_ret,
00030 Fchar names,
00031 Fint *error_return )
00032 {
00033 int i;
00034 char *pstr, *tmp_names;
00035
00036 if( *idim != *name_length ) {
00037 *error_return = BAD_DIMENSION_VALUE ;
00039 return ;
00040 }
00041
00042 pstr = F2CP(names);
00043
00044 tmp_names = (char *) malloc( (*imaxnum) * (*name_length + 1) * (sizeof(char)) ) ;
00045 if( tmp_names == NULL ) {
00046 *error_return = MEMORY_ALLOCATION_FAILED ;
00047 return ;
00048 }
00049
00050 ADF_Children_Names( *PID, *istart, *imaxnum, *name_length, inum_ret,
00051 tmp_names, error_return ) ;
00052 if( *error_return != NO_ERROR ) {
00053 free( tmp_names ) ;
00054 return ;
00055 }
00056
00057 for( i=0; i<*inum_ret; i++ ) {
00058 if( strlen( &tmp_names[ i * (*name_length+1) ]) == *name_length ) {
00060 strncpy( &pstr[ i * (*name_length) ], &tmp_names[ i * (*name_length+1) ],
00061 *name_length ) ;
00062 }
00063 else {
00065 strcpy( &pstr[ i * (*name_length) ], &tmp_names[ i * (*name_length+1) ] ) ;
00066 ADFI_blank_fill_string( &pstr[ i * (*name_length) ], *name_length ) ;
00067 }
00068 }
00069
00070 free( tmp_names ) ;
00071 }
00072
00073
00074
00075
00076
00077 void FNAME(adfcid2,ADFCID2)(
00078 const Fdouble *PID,
00079 const Fint *istart,
00080 const Fint *imaxnum,
00081 Fint *inum_ret,
00082 Fdouble *CIDs,
00083 Fint *error_return )
00084 {
00085 ADF_Children_IDs( *PID, *istart, *imaxnum, inum_ret, CIDs, error_return ) ;
00086 }
00087
00088
00089
00090
00091
00092 void FNAME(adfcre2,ADFCRE2)(
00093 const Fdouble *PID,
00094 const Fchar name,
00095 const Fint *name_length,
00096 Fdouble *ID,
00097 Fint *error_return )
00098 {
00099 char c_name[ ADF_NAME_LENGTH + 1 ] ;
00100
00101 ADFI_string_2_C_string( F2CP(name), MIN(ADF_NAME_LENGTH, *name_length), c_name,
00102 error_return ) ;
00103 if( *error_return != NO_ERROR )
00104 return ;
00105
00106 ADF_Create( *PID, c_name, ID, error_return ) ;
00107 }
00108
00109
00110
00111
00112
00113 void FNAME(adfdcl2,ADFDCL2)(
00114 const Fdouble *Root_ID,
00115 Fint *error_return )
00116 {
00117 ADF_Database_Close( *Root_ID, error_return ) ;
00118 }
00119
00120
00121
00122
00123
00124 void FNAME(adfdde2,ADFDDE2)(
00125 const Fchar filename,
00126 const Fint *name_length,
00127 Fint *error_return )
00128 {
00129 char c_name[ ADF_FILENAME_LENGTH + 1 ] ;
00130
00131 ADFI_string_2_C_string( F2CP(filename), MIN(ADF_FILENAME_LENGTH, *name_length),
00132 c_name, error_return ) ;
00133 if( *error_return != NO_ERROR )
00134 return ;
00135 ADF_Database_Delete( c_name, error_return ) ;
00136 }
00137
00138
00139
00140
00141
00142 void FNAME(adfdel2,ADFDEL2)(
00143 const Fdouble *PID,
00144 const Fdouble *ID,
00145 Fint *error_return )
00146 {
00147 ADF_Delete( *PID, *ID, error_return ) ;
00148 }
00149
00150
00151
00152
00153
00154 void FNAME(adfdgc2,ADFDGC2)(
00155 const Fdouble *ID,
00156 Fint *error_return )
00157 {
00158 ADF_Database_Garbage_Collection( *ID, error_return ) ;
00159 }
00160
00161
00162
00163
00164
00165 void FNAME(adfdgf2,ADFDGF2)(
00166 const Fdouble *Root_ID,
00167 Fchar format,
00168 const Fint *format_length,
00169 Fint *error_return )
00170 {
00171 ADF_Database_Get_Format( *Root_ID, F2CP(format), error_return ) ;
00172 if( *error_return != NO_ERROR )
00173 return ;
00174
00175 ADFI_blank_fill_string( F2CP(format), *format_length ) ;
00176 }
00177
00178
00179
00180
00181
00182 void FNAME(adfdop2,ADFDOP2)(
00183 const Fchar filename,
00184 const Fint *filename_length,
00185 Fchar status_in,
00186 const Fint *status_length,
00187 const Fchar format,
00188 const Fint *format_length,
00189 Fdouble *Root_ID,
00190 Fint *error_return )
00191 {
00192 char c_filename[ ADF_FILENAME_LENGTH + 1 ],
00193 c_status[ ADF_NAME_LENGTH+1 ],
00194 c_format[ ADF_NAME_LENGTH+1 ] ;
00195
00196 ADFI_string_2_C_string( F2CP(filename),
00197 MIN(ADF_FILENAME_LENGTH, *filename_length),
00198 c_filename, error_return ) ;
00199 if( *error_return != NO_ERROR )
00200 return ;
00201 ADFI_string_2_C_string( F2CP(status_in),
00202 MIN(ADF_NAME_LENGTH, *status_length),
00203 c_status, error_return ) ;
00204 if( *error_return != NO_ERROR )
00205 return ;
00206 ADFI_string_2_C_string( F2CP(format),
00207 MIN(ADF_NAME_LENGTH, *format_length), c_format,
00208 error_return ) ;
00209 if( *error_return != NO_ERROR )
00210 return ;
00211
00212 ADF_Database_Open( c_filename, c_status, c_format,
00213 Root_ID, error_return ) ;
00214 }
00215
00216
00217
00218
00219
00220 void FNAME(adfdsf2,ADFDSF2)(
00221 const Fdouble *Root_ID,
00222 const Fchar format,
00223 const Fint *format_length,
00224 Fint *error_return )
00225 {
00226 char c_format[ ADF_NAME_LENGTH + 1 ] ;
00227
00228 ADFI_string_2_C_string( F2CP(format),
00229 MIN(ADF_NAME_LENGTH, *format_length), c_format,
00230 error_return ) ;
00231 if( *error_return != NO_ERROR )
00232 return ;
00233
00234 ADF_Database_Set_Format( *Root_ID, c_format, error_return ) ;
00235 }
00236
00237
00238
00239
00240
00241 void FNAME(adfdve2,ADFDVE2)(
00242 const Fdouble *Root_ID,
00243 Fchar version,
00244 Fchar creation_date,
00245 Fchar modification_date,
00246 const Fint *v_length,
00247 const Fint *c_length,
00248 const Fint *m_length,
00249 Fint *error_return )
00250 {
00251 ADF_Database_Version( *Root_ID, F2CP(version), F2CP(creation_date),
00252 F2CP(modification_date), error_return ) ;
00253
00254 ADFI_blank_fill_string( F2CP(version), *v_length ) ;
00255 ADFI_blank_fill_string( F2CP(creation_date), *c_length ) ;
00256 ADFI_blank_fill_string( F2CP(modification_date), *m_length ) ;
00257 }
00258
00259
00260
00261
00262
00263 void FNAME(adferr2,ADFERR2)(
00264 const Fint *error_return_input,
00265 Fchar error_string,
00266 const Fint *str_length )
00267 {
00268 char msg_buf[ADF_MAX_ERROR_STR_LENGTH+1] ;
00269
00270 ADF_Error_Message( *error_return_input, msg_buf ) ;
00271 strncpy( F2CP(error_string), msg_buf, *str_length ) ;
00272 ADFI_blank_fill_string( F2CP(error_string), *str_length ) ;
00273 }
00274
00275
00276
00277
00278
00279 void FNAME(adfftd2,ADFFTD2)(
00280 const Fdouble *ID,
00281 Fint *error_return )
00282 {
00283 ADF_Flush_to_Disk( *ID, error_return ) ;
00284 }
00285
00286
00287
00288
00289
00290 void FNAME(adfgdt2,ADFGDT2)(
00291 const Fdouble *ID,
00292 Fchar data_type,
00293 const Fint *data_type_length,
00294 Fint *error_return )
00295 {
00296 char ctype[ ADF_DATA_TYPE_LENGTH + 1 ] ;
00297
00298 ADF_Get_Data_Type( *ID, ctype, error_return ) ;
00299 if( *error_return == NO_ERROR ) {
00300 if( strlen( ctype ) < *data_type_length ) {
00301 strcpy( F2CP(data_type), ctype ) ;
00302 ADFI_blank_fill_string( F2CP(data_type), *data_type_length ) ;
00303 }
00304 else {
00305 strncpy( F2CP(data_type), ctype, *data_type_length ) ;
00306 }
00307 }
00308 }
00309
00310
00311
00312
00313
00314 void FNAME(adfgdv2,ADFGDV2)(
00315 const Fdouble *ID,
00316 Fint dim_vals[],
00317 Fint *error_return )
00318 {
00319 ADF_Get_Dimension_Values( *ID, dim_vals, error_return ) ;
00320 }
00321
00322
00323
00324
00325
00326 void FNAME(adfges2,ADFGES2)(
00327 Fint *error_state,
00328 Fint *error_return )
00329 {
00330 ADF_Get_Error_State( error_state, error_return ) ;
00331 }
00332
00333
00334
00335
00336
00337 void FNAME(adfglb2,ADFGLB2)(
00338 const Fdouble *ID,
00339 Fchar label,
00340 const Fint *label_length,
00341 Fint *error_return )
00342 {
00343 char clabel[ ADF_LABEL_LENGTH + 1 ] ;
00344
00345 ADF_Get_Label( *ID, clabel, error_return ) ;
00346 if( *error_return == NO_ERROR ) {
00347 if( strlen( clabel ) < *label_length ) {
00348 strcpy( F2CP(label), clabel ) ;
00349 ADFI_blank_fill_string( F2CP(label), *label_length ) ;
00350 }
00351 else {
00352 strncpy( F2CP(label), clabel, *label_length ) ;
00353 }
00354 }
00355 }
00356
00357
00358
00359
00360
00361 void FNAME(adfglk2,ADFGLK2)(
00362 const Fdouble *ID,
00363 Fchar filename,
00364 const Fint *filename_length,
00365 Fchar link_path,
00366 const Fint *link_path_length,
00367 Fint *error_return )
00368 {
00369 char cpath[ ADF_MAX_LINK_DATA_SIZE + 1 ],
00370 cfilename[ ADF_FILENAME_LENGTH + 1 ] ;
00371
00372 ADF_Get_Link_Path( *ID, cfilename, cpath, error_return ) ;
00373 if( *error_return == NO_ERROR ) {
00374 if( strlen(cfilename) < *filename_length ) {
00375 strcpy( F2CP(filename), cfilename ) ;
00376 ADFI_blank_fill_string( F2CP(filename), *filename_length ) ;
00377 }
00378 else {
00379 strncpy( F2CP(filename), cfilename, *filename_length ) ;
00380 }
00381
00382 if( strlen(cpath) < *link_path_length ) {
00383 strcpy( F2CP(link_path), cpath ) ;
00384 ADFI_blank_fill_string( F2CP(link_path), *link_path_length ) ;
00385 }
00386 else {
00387 strncpy( F2CP(link_path), cpath, *link_path_length ) ;
00388 }
00389 }
00390 }
00391
00392
00393
00394
00395
00396 void FNAME(adfgna2,ADFGNA2)(
00397 const Fdouble *ID,
00398 Fchar name,
00399 const Fint *name_length,
00400 Fint *error_return )
00401 {
00402 char cname[ ADF_NAME_LENGTH + 1 ] ;
00403
00404 ADF_Get_Name( *ID, cname, error_return ) ;
00405 if( *error_return == NO_ERROR ) {
00406 if( strlen( cname ) < *name_length ) {
00407 strcpy( F2CP(name), cname ) ;
00408 ADFI_blank_fill_string( F2CP(name), *name_length ) ;
00409 }
00410 else {
00411 strncpy( F2CP(name), cname, *name_length ) ;
00412 }
00413 }
00414 }
00415
00416
00417
00418
00419
00420 void FNAME(adfgnd2,ADFGND2)(
00421 const Fdouble *ID,
00422 Fint *num_dims,
00423 Fint *error_return )
00424 {
00425 ADF_Get_Number_of_Dimensions( *ID, num_dims, error_return ) ;
00426 }
00427
00428
00429
00430
00431
00432 void FNAME(adfgni2,ADFGNI2)(
00433 const Fdouble *PID,
00434 const Fchar name,
00435 const Fint *name_length,
00436 Fdouble *ID,
00437 Fint *error_return )
00438 {
00439 char c_name[ ADF_FILENAME_LENGTH + 1 ] ;
00440
00441 ADFI_string_2_C_string( F2CP(name), MIN(ADF_FILENAME_LENGTH, *name_length),
00442 c_name, error_return ) ;
00443 if( *error_return != NO_ERROR )
00444 return ;
00445 ADF_Get_Node_ID( *PID, c_name, ID, error_return ) ;
00446 }
00447
00448
00449
00450
00451
00452 void FNAME(adfgri2,ADFGRI2)(
00453 const Fdouble *ID,
00454 Fdouble *Root_ID,
00455 Fint *error_return )
00456 {
00457 ADF_Get_Root_ID( *ID, Root_ID, error_return ) ;
00458 }
00459
00460
00461
00462
00463
00464 void FNAME(adfisl2,ADFISL2)(
00465 const Fdouble *ID,
00466 Fint *link_path_length,
00467 Fint *error_return )
00468 {
00469 ADF_Is_Link( *ID, link_path_length, error_return ) ;
00470 }
00471
00472
00473
00474
00475
00476 void FNAME(adflin2,ADFLIN2)(
00477 const Fdouble *PID,
00478 const Fchar name,
00479 const Fchar file,
00480 const Fchar name_in_file,
00481 const Fint *name_length,
00482 const Fint *file_length,
00483 const Fint *nfile_length,
00484 Fdouble *ID,
00485 Fint *error_return )
00486 {
00487 char c_name[ ADF_FILENAME_LENGTH + 1 ],
00488 c_file[ ADF_FILENAME_LENGTH + 1 ],
00489 c_nfile[ ADF_MAX_LINK_DATA_SIZE + 1 ] ;
00490
00491 ADFI_string_2_C_string( F2CP(name),
00492 MIN(ADF_FILENAME_LENGTH, *name_length),
00493 c_name, error_return ) ;
00494 if( *error_return != NO_ERROR )
00495 return ;
00496 ADFI_string_2_C_string( F2CP(file),
00497 MIN(ADF_FILENAME_LENGTH, *file_length),
00498 c_file, error_return ) ;
00499 if( *error_return != NO_ERROR )
00500 return ;
00501 ADFI_string_2_C_string( F2CP(name_in_file),
00502 MIN(ADF_MAX_LINK_DATA_SIZE, *nfile_length),
00503 c_nfile,
00504 error_return ) ;
00505 if( *error_return != NO_ERROR )
00506 return ;
00507
00508 ADF_Link( *PID, c_name, c_file, c_nfile, ID, error_return ) ;
00509 }
00510
00511
00512
00513
00514
00515 void FNAME(adflve2,ADFLVE2)(
00516 Fchar version,
00517 const Fint *version_length,
00518 Fint *error_return )
00519 {
00520 ADF_Library_Version( F2CP(version), error_return ) ;
00521 ADFI_blank_fill_string ( F2CP(version), *version_length );
00522 }
00523
00524
00525
00526
00527
00528 void FNAME(adfmov2,ADFMOV2)(
00529 const Fdouble *PID,
00530 const Fdouble *ID,
00531 const Fdouble *NPID,
00532 Fint *error_return )
00533 {
00534 ADF_Move_Child( *PID, *ID, *NPID, error_return ) ;
00535 }
00536
00537
00538
00539
00540
00541 void FNAME(adfncl2,ADFNCL2)(
00542 const Fdouble *ID,
00543 Fint *num_children,
00544 Fint *error_return )
00545 {
00546 ADF_Number_of_Children( *ID, num_children, error_return ) ;
00547 }
00548
00549
00550
00551
00552
00553 void FNAME(adfpdi2,ADFPDI2)(
00554 const Fdouble *ID,
00555 const Fchar data_type,
00556 const Fint *data_type_length,
00557 const Fint *dims,
00558 const Fint dim_vals[],
00559 Fint *error_return )
00560 {
00561 char c_data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
00562
00563
00564 int i;
00565 for (i=0;i<ADF_DATA_TYPE_LENGTH;i++)
00566 c_data_type[i] = ' ';
00567 c_data_type[i] = '\0';
00568
00569
00570 ADFI_string_2_C_string( F2CP(data_type),
00571 MIN(ADF_DATA_TYPE_LENGTH, *data_type_length),
00572 c_data_type, error_return ) ;
00573 if( *error_return != NO_ERROR )
00574 return ;
00575
00576 ADF_Put_Dimension_Information( *ID, c_data_type, *dims, dim_vals,
00577 error_return ) ;
00578 }
00579
00580
00581
00582
00583
00584 void FNAME(adfpna2,ADFPNA2)(
00585 const Fdouble *PID,
00586 const Fdouble *ID,
00587 const Fchar name,
00588 const Fint *name_length,
00589 Fint *error_return )
00590 {
00591 char c_name[ ADF_NAME_LENGTH + 1 ] ;
00592
00593 ADFI_string_2_C_string( F2CP(name),
00594 MIN(ADF_NAME_LENGTH, *name_length), c_name,
00595 error_return ) ;
00596 if( *error_return != NO_ERROR )
00597 return ;
00598
00599 ADF_Put_Name( *PID, *ID, c_name, error_return ) ;
00600 }
00601
00602
00603
00604
00605
00606
00607
00608
00609
00610
00611
00612
00613
00614 void FNAME(adfrall,ADFRALL)(
00615 const Fdouble *ID,
00616 Fchar data,
00617 Fint *error_return )
00618 {
00619
00620 #if defined(cray) && defined(_ADDR64)
00621
00622 int local_error ;
00623 char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
00624 char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;
00625
00628 ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
00629 if( local_error != NO_ERROR ) {
00630 ADF_Error_Message( local_error, errmsg ) ;
00631 printf( "%s\n", errmsg ) ;
00632 printf( "Unrecoverable ADF error. ADFRALL\n" ) ;
00633 printf( "Cannot determine data type, so cannot determine function\n" ) ;
00634 printf( "argument list (character arrays are different than other\n" ) ;
00635 printf( "types in this environemnt), so cannot set error_return.\n" ) ;
00636 abort () ;
00637 }
00638
00639 if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
00642 ADF_Read_All_Data( *ID, F2CP(data), error_return ) ;
00643 }
00644 else {
00647 ADF_Read_All_Data( *ID, data.c_pointer, (int *)data.fcd_len ) ;
00648 }
00649
00650 #else
00651
00652 ADF_Read_All_Data( *ID, F2CP(data), error_return ) ;
00653
00654 #endif
00655 }
00656
00657
00658
00659
00660
00661
00662
00663
00664
00665
00666
00667
00668
00669 void FNAME(adfrblk,ADFRBLK)(
00670 const Fdouble *ID,
00671 const Fint *b_start,
00672 const Fint *b_end,
00673 Fchar data,
00674 Fint *error_return )
00675 {
00676
00677 #if defined(cray) && defined(_ADDR64)
00678
00679 int local_error ;
00680 char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
00681 char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;
00682
00685 ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
00686 if( local_error != NO_ERROR ) {
00687 ADF_Error_Message( local_error, errmsg ) ;
00688 fprintf(stderr,"%s\n", errmsg ) ;
00689 fprintf(stderr,"Unrecoverable ADF error. ADFRBLK\n" ) ;
00690 fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
00691 fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
00692 fprintf(stderr,"types in this environemnt), so cannot set error_return.\n" ) ;
00693 abort () ;
00694 }
00695
00696 if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
00699 ADF_Read_Block_Data( *ID, (long) *b_start, (long) *b_end,
00700 F2CP(data), error_return ) ;
00701 }
00702 else {
00705 ADF_Read_Block_Data( *ID, (long) *b_start, (long) *b_end,
00706 data.c_pointer, (int *)data.fcd_len ) ;
00707 }
00708
00709 #else
00710
00711 ADF_Read_Block_Data( *ID, (long) *b_start, (long) *b_end,
00712 F2CP(data), error_return ) ;
00713
00714 #endif
00715 }
00716
00717
00718
00719
00720
00721
00722
00723
00724
00725
00726
00727
00728
00729
00730
00731
00732
00733
00734
00735
00736
00737
00738
00739
00740
00741
00742
00743
00744
00745
00746
00747
00748
00749
00750
00751
00752
00753
00754
00755
00756 void FNAME(adfread,ADFREAD)(
00757 const Fdouble *ID,
00758 const Fint s_start[],
00759 const Fint s_end[],
00760 const Fint s_stride[],
00761 const Fint *m_num_dims,
00762 const Fint m_dims[],
00763 const Fint m_start[],
00764 const Fint m_end[],
00765 const Fint m_stride[],
00766 Fchar data,
00767 Fint *error_return )
00768 {
00769
00770 #if defined(cray) && defined(_ADDR64)
00771
00772 int local_error ;
00773 char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
00774 char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;
00775
00778 ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
00779 if( local_error != NO_ERROR ) {
00780 ADF_Error_Message( local_error, errmsg ) ;
00781 fprintf(stderr,"%s\n", errmsg ) ;
00782 fprintf(stderr,"Unrecoverable ADF error. ADFREAD\n" ) ;
00783 fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
00784 fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
00785 fprintf(stderr,"types in this environemnt), so cannot set error_return.\n" ) ;
00786 abort () ;
00787 }
00788
00789 if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
00792 ADF_Read_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
00793 m_start, m_end, m_stride, F2CP(data), error_return ) ;
00794 }
00795 else {
00798 ADF_Read_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
00799 m_start, m_end, m_stride,
00800 data.c_pointer, (int *)data.fcd_len ) ;
00801 }
00802
00803 #else
00804
00805 ADF_Read_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
00806 m_start, m_end, m_stride, F2CP(data), error_return ) ;
00807
00808 #endif
00809 }
00810
00811
00812
00813
00814
00815 void FNAME(adfses2,ADFSES2)(
00816 const Fint *error_state,
00817 Fint *error_return )
00818 {
00819 ADF_Set_Error_State( *error_state, error_return ) ;
00820 }
00821
00822
00823
00824
00825
00826 void FNAME(adfslb2,ADFSLB2)(
00827 const Fdouble *ID,
00828 const Fchar label,
00829 const Fint *label_length,
00830 Fint *error_return )
00831 {
00832 char c_label[ ADF_LABEL_LENGTH + 1 ] ;
00833
00834 ADFI_string_2_C_string( F2CP(label),
00835 MIN(ADF_LABEL_LENGTH, *label_length),
00836 c_label, error_return ) ;
00837 if( *error_return != NO_ERROR )
00838 return ;
00839
00840 ADF_Set_Label( *ID, c_label, error_return ) ;
00841 }
00842
00843
00844
00845
00846
00847
00848
00849
00850
00851
00852
00853
00854
00855 void FNAME(adfwall,ADFWALL)(
00856 const Fdouble *ID,
00857 const Fchar data,
00858 Fint *error_return )
00859 {
00860
00861 #if defined(cray) && defined(_ADDR64)
00862
00863 int local_error ;
00864 char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
00865 char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;
00866
00878 ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
00879 if( local_error != NO_ERROR ) {
00880 ADF_Error_Message( local_error, errmsg ) ;
00881 fprintf(stderr,"%s\n", errmsg ) ;
00882 fprintf(stderr,"Unrecoverable ADF error. ADFWALL\n" ) ;
00883 fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
00884 fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
00885 fprintf(stderr,"types in this environemnt), so cannot set error_return.\n" ) ;
00886 abort () ;
00887 }
00888
00889 if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
00892 ADF_Write_All_Data( *ID, F2CP(data), error_return ) ;
00893 }
00894 else {
00895
00902 ADF_Write_All_Data( *ID, data.c_pointer, (int *)data.fcd_len ) ;
00903 }
00904
00905 #else
00906
00914 ADF_Write_All_Data( *ID, F2CP(data), error_return ) ;
00915
00916 #endif
00917 }
00918
00919
00920
00921
00922
00923
00924
00925
00926
00927
00928
00929
00930
00931 void FNAME(adfwblk,ADFWBLK)(
00932 const Fdouble *ID,
00933 const Fint *b_start,
00934 const Fint *b_end,
00935 Fchar data,
00936 Fint *error_return )
00937 {
00938
00939 #if defined(cray) && defined(_ADDR64)
00940
00941 int local_error ;
00942 char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
00943 char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;
00944
00947 ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
00948 if( local_error != NO_ERROR ) {
00949 ADF_Error_Message( local_error, errmsg ) ;
00950 fprintf(stderr,"%s\n", errmsg ) ;
00951 fprintf(stderr,"Unrecoverable ADF error. ADFWBLK\n" ) ;
00952 fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
00953 fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
00954 fprintf(stderr,"types in this environemnt), so cannot set error_return.\n" ) ;
00955 abort () ;
00956 }
00957
00958 if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
00961 ADF_Write_Block_Data( *ID, (long) *b_start, (long) *b_end,
00962 F2CP(data), error_return ) ;
00963 }
00964 else {
00967 ADF_Write_Block_Data( *ID, (long) *b_start, (long) *b_end,
00968 data.c_pointer, (int *)data.fcd_len ) ;
00969 }
00970
00971 #else
00972
00973 ADF_Write_Block_Data( *ID, (long) *b_start, (long) *b_end,
00974 F2CP(data), error_return ) ;
00975
00976 #endif
00977 }
00978
00979
00980
00981
00982
00983
00984
00985
00986
00987
00988
00989
00990
00991
00992
00993
00994
00995
00996
00997
00998
00999
01000
01001
01002
01003
01004
01005
01006
01007
01008 void FNAME(adfwrit,ADFWRIT)(
01009 const Fdouble *ID,
01010 const Fint s_start[],
01011 const Fint s_end[],
01012 const Fint s_stride[],
01013 const Fint *m_num_dims,
01014 const Fint m_dims[],
01015 const Fint m_start[],
01016 const Fint m_end[],
01017 const Fint m_stride[],
01018 const Fchar data,
01019 Fint *error_return )
01020 {
01021
01022 #if defined(cray) && defined(_ADDR64)
01023
01024 int local_error ;
01025 char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
01026 char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;
01027
01030 ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
01031 if( local_error != NO_ERROR ) {
01032 ADF_Error_Message( local_error, errmsg ) ;
01033 fprintf(stderr,"%s\n", errmsg ) ;
01034 fprintf(stderr,"Unrecoverable ADF error. ADFWRIT\n" ) ;
01035 fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
01036 fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
01037 fprintf(stderr,"types in this environemnt), so cannot set error_return.\n" ) ;
01038 abort () ;
01039 }
01040
01041 if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
01044 ADF_Write_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
01045 m_start, m_end, m_stride, F2CP(data), error_return ) ;
01046 }
01047 else {
01050 ADF_Write_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
01051 m_start, m_end, m_stride,
01052 data.c_pointer, (int *)data.fcd_len ) ;
01053 }
01054
01055 #else
01056 ADF_Write_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
01057 m_start, m_end, m_stride, F2CP(data), error_return ) ;
01058
01059 #endif
01060 }
01061
01062