GFC_REAL_4 secnds (GFC_REAL_4 *x) { GFC_INTEGER_4 values[VALUES_SIZE]; GFC_REAL_4 temp1, temp2; /* Make the INTEGER*4 array for passing to date_and_time, with enough space for a rank-one array. */ gfc_array_i4 *avalues = xmalloc (sizeof (gfc_array_i4) + sizeof (descriptor_dimension)); avalues->base_addr = &values[0]; GFC_DESCRIPTOR_DTYPE (avalues).type = BT_REAL; GFC_DESCRIPTOR_DTYPE (avalues).elem_len = 4; GFC_DESCRIPTOR_DTYPE (avalues).rank = 1; GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1); date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0); free (avalues); temp1 = 3600.0 * (GFC_REAL_4)values[4] + 60.0 * (GFC_REAL_4)values[5] + (GFC_REAL_4)values[6] + 0.001 * (GFC_REAL_4)values[7]; temp2 = fmod (*x, 86400.0); temp2 = (temp1 - temp2 >= 0.0) ? temp2 : (temp2 - 86400.0); return temp1 - temp2; }
GFC_REAL_4 secnds (GFC_REAL_4 *x) { GFC_INTEGER_4 values[VALUES_SIZE]; GFC_REAL_4 temp1, temp2; /* Make the INTEGER*4 array for passing to date_and_time. */ gfc_array_i4 *avalues = internal_malloc_size (sizeof (gfc_array_i4)); avalues->data = &values[0]; GFC_DESCRIPTOR_DTYPE (avalues) = ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) & GFC_DTYPE_TYPE_MASK) + (4 << GFC_DTYPE_SIZE_SHIFT); GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1); date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0); free (avalues); temp1 = 3600.0 * (GFC_REAL_4)values[4] + 60.0 * (GFC_REAL_4)values[5] + (GFC_REAL_4)values[6] + 0.001 * (GFC_REAL_4)values[7]; temp2 = fmod (*x, 86400.0); temp2 = (temp1 - temp2 >= 0.0) ? temp2 : (temp2 - 86400.0); return temp1 - temp2; }
GFC_LOGICAL_4 associated (const gfc_array_void *pointer, const gfc_array_void *target) { int n, rank; if (GFC_DESCRIPTOR_DATA (pointer) != GFC_DESCRIPTOR_DATA (target)) return 0; if (GFC_DESCRIPTOR_DTYPE (pointer) != GFC_DESCRIPTOR_DTYPE (target)) return 0; rank = GFC_DESCRIPTOR_RANK (pointer); for (n = 0; n < rank; n++) { if (pointer->dim[n].stride != target->dim[n].stride) return 0; if ((pointer->dim[n].ubound - pointer->dim[n].lbound) != (target->dim[n].ubound - target->dim[n].lbound)) return 0; } return 1; }