55 '$Id: ODPS_Binary_IO.f90 2169 2008-06-12 15:07:56Z paul.vandelst@noaa.gov $' 57 INTEGER,
PARAMETER ::
set = 1
59 INTEGER,
PARAMETER ::
ml = 512
208 n_Layers , & ! Optional output
209 n_Components , & ! Optional output
210 n_Absorbers , & ! Optional output
211 n_Channels , & ! Optional output
212 n_Coeffs , & ! Optional output
213 n_OCoeffs , & ! Optional output
214 Release , & ! Optional Output
215 Version , & ! Optional Output
216 Sensor_Id , & ! Optional Output
217 WMO_Satellite_Id, & ! Optional Output
218 WMO_Sensor_Id , & ! Optional Output
219 RCS_Id , & ! Revision control
221 result( error_status )
223 CHARACTER(*),
INTENT(IN) :: filename
224 INTEGER ,
OPTIONAL,
INTENT(OUT) :: n_layers
225 INTEGER ,
OPTIONAL,
INTENT(OUT) :: n_components
226 INTEGER ,
OPTIONAL,
INTENT(OUT) :: n_absorbers
227 INTEGER ,
OPTIONAL,
INTENT(OUT) :: n_channels
228 INTEGER ,
OPTIONAL,
INTENT(OUT) :: n_coeffs
229 INTEGER ,
OPTIONAL,
INTENT(OUT) :: n_ocoeffs
230 INTEGER ,
OPTIONAL,
INTENT(OUT) :: release
231 INTEGER ,
OPTIONAL,
INTENT(OUT) :: version
232 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: sensor_id
233 INTEGER ,
OPTIONAL,
INTENT(OUT) :: wmo_satellite_id
234 INTEGER ,
OPTIONAL,
INTENT(OUT) :: wmo_sensor_id
235 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: rcs_id
236 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: message_log
238 INTEGER :: error_status
240 CHARACTER(*),
PARAMETER :: routine_name =
'Inquire_ODPS_Binary' 242 CHARACTER(ML) :: message
255 message =
'File '//trim(filename)//
' not found.' 263 IF ( error_status /=
success )
THEN 264 message =
'Error opening ODPS Binary file '//trim(filename)
271 READ( fileid, iostat=io_status ) odps%Release, odps%Version
272 IF ( io_status /= 0 )
THEN 273 WRITE( message,
'("Error reading Release/Version values from ",a,& 274 &". IOSTAT = ",i0)' ) &
275 trim(filename), io_status
282 READ( fileid, iostat=io_status ) odps%Algorithm
283 IF ( io_status /= 0 )
THEN 284 WRITE( message,
'("Error reading Algorithm ID from ",a,& 285 &". IOSTAT = ",i0)' ) &
286 trim(filename), io_status
293 READ( fileid, iostat=io_status ) odps%n_Layers , &
300 IF ( io_status /= 0 )
THEN 301 WRITE( message,
'("Error reading dimension values from ",a,& 302 &". IOSTAT = ",i0)' ) &
303 trim(filename), io_status
310 READ( fileid, iostat=io_status ) odps%Sensor_Id , &
311 odps%WMO_Satellite_Id, &
313 IF ( io_status /= 0 )
THEN 314 WRITE( message,
'("Error reading sensor information from ",a,& 315 &". IOSTAT = ",i0)' ) &
316 trim(filename), io_status
323 CLOSE( fileid, iostat=io_status )
324 IF ( io_status /= 0 )
THEN 325 WRITE( message,
'("Error closing ",a,". IOSTAT = ",i0)' ) &
326 trim(filename), io_status
334 IF (
PRESENT(n_layers ) ) n_layers = odps%n_Layers
335 IF (
PRESENT(n_components) ) n_components = odps%n_Components
336 IF (
PRESENT(n_absorbers ) ) n_absorbers = odps%n_Absorbers
337 IF (
PRESENT(n_channels ) ) n_channels = odps%n_Channels
338 IF (
PRESENT(n_coeffs) ) n_coeffs = odps%n_Coeffs
339 IF (
PRESENT(n_ocoeffs) ) n_ocoeffs = odps%n_OCoeffs
342 IF (
PRESENT(release) ) release = odps%Release
343 IF (
PRESENT(version) ) version = odps%Version
346 IF (
PRESENT(sensor_id ) ) sensor_id = odps%Sensor_Id(1:
min(len(sensor_id),len_trim(odps%Sensor_Id)))
347 IF (
PRESENT(wmo_satellite_id) ) wmo_satellite_id = odps%WMO_Satellite_Id
348 IF (
PRESENT(wmo_sensor_id ) ) wmo_sensor_id = odps%WMO_Sensor_Id
353 INTEGER,
OPTIONAL,
INTENT(IN) :: Close_File
354 CHARACTER(256) :: Close_Message
356 IF (
PRESENT(close_file) )
THEN 357 IF ( close_file ==
set )
THEN 358 CLOSE( fileid, iostat=io_status )
359 IF ( io_status /= 0 )
THEN 360 WRITE( close_message,
'("; Error closing input file during error cleanup. IOSTAT=",i0)') &
362 message = trim(message)//trim(close_message)
371 message_log=message_log )
485 Quiet , & ! Optional input
486 Process_ID , & ! Optional input
487 Output_Process_ID, & ! Optional input
488 RCS_Id , & ! Revision control
490 result( error_status )
492 CHARACTER(*) ,
INTENT(IN) :: filename
494 INTEGER ,
OPTIONAL,
INTENT(IN) :: quiet
495 INTEGER ,
OPTIONAL,
INTENT(IN) :: process_id
496 INTEGER ,
OPTIONAL,
INTENT(IN) :: output_process_id
497 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: rcs_id
498 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: message_log
500 INTEGER :: error_status
502 CHARACTER(*),
PARAMETER :: routine_name =
'Read_ODPS_Binary' 504 CHARACTER(ML) :: message
505 CHARACTER(ML) :: process_id_tag
517 message =
'File '//trim(filename)//
' not found.' 525 IF (
PRESENT(quiet) )
THEN 526 IF ( quiet ==
set ) noisy = .false.
528 IF ( noisy .AND.
PRESENT(process_id) .AND.
PRESENT(output_process_id) )
THEN 529 IF ( process_id /= output_process_id ) noisy = .false.
534 IF (
PRESENT(process_id) )
THEN 535 WRITE( process_id_tag,
'("; MPI Process ID: ",i0)' ) process_id
544 IF ( error_status /=
success )
THEN 545 message =
'Error opening '//trim(filename)
556 message_log = message_log )
557 IF ( error_status /=
success )
THEN 558 message =
'Error reading data from '//trim(filename)
565 CLOSE( fileid, iostat=io_status )
566 IF ( io_status /= 0 )
THEN 567 WRITE( message,
'("Error closing ",a," after read. IOSTAT = ",i0)' ) &
568 trim(filename), io_status
570 trim(message)//trim(process_id_tag), &
572 message_log=message_log )
580 'FILE: '//trim(filename)//
'; '//trim(message), &
582 message_log = message_log )
591 Process_ID_Tag , & ! Optional input
593 result( error_status )
595 CHARACTER(*) ,
INTENT(IN) :: filename
596 INTEGER ,
INTENT(IN) :: fileid
598 CHARACTER(*) ,
INTENT(IN) :: process_id_tag
599 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: message_log
601 INTEGER :: error_status
603 CHARACTER(*),
PARAMETER :: routine_name =
'Read_ODPS_Data' 605 CHARACTER(ML) :: message
607 INTEGER(Long) :: version
608 INTEGER(Long) :: algorithm
609 INTEGER(Long) :: n_layers
610 INTEGER(Long) :: n_components
611 INTEGER(Long) :: n_absorbers
612 INTEGER(Long) :: n_channels
613 INTEGER(Long) :: n_coeffs
614 INTEGER(Long) :: n_opindex
615 INTEGER(Long) :: n_ocoeffs
619 READ( fileid, iostat=io_status ) odps%Release, version
620 IF ( io_status /= 0 )
THEN 621 WRITE( message,
'("Error reading Release/Version values from ",a,& 622 &". IOSTAT = ",i0)' ) &
623 trim(filename), io_status
629 IF ( error_status /=
success )
THEN 630 message =
'ODPS Release check failed for '//trim(filename)
637 READ( fileid, iostat=io_status ) algorithm
638 IF ( io_status /= 0 )
THEN 639 WRITE( message,
'("Error reading Algorithm ID from ",a,& 640 &". IOSTAT = ",i0)' ) &
641 trim(filename), io_status
647 IF ( error_status /=
success )
THEN 648 message =
'ODPS Algorithm check failed for '//trim(filename)
655 READ( fileid, iostat=io_status ) n_layers , &
662 IF ( io_status /= 0 )
THEN 663 WRITE( message,
'("Error reading dimension values from ",a,& 664 &". IOSTAT = ",i0)' ) &
665 trim(filename), io_status
677 message_log=message_log)
678 IF ( error_status /=
success )
THEN 679 message =
'ODPS allocation failed' 684 odps%Version = version
689 READ( fileid, iostat=io_status ) odps%Group_Index
690 IF ( io_status /= 0 )
THEN 691 WRITE( message,
'("Error reading Group ID from ",a,& 692 &". IOSTAT = ",i0)' ) &
693 trim(filename), io_status
699 READ( fileid, iostat=io_status ) odps%Sensor_Id , &
700 odps%WMO_Satellite_Id, &
701 odps%WMO_Sensor_Id , &
703 IF ( io_status /= 0 )
THEN 704 WRITE( message,
'("Error reading sensor information from ",a,& 705 &". IOSTAT = ",i0)' ) &
706 trim(filename), io_status
713 READ( fileid, iostat=io_status ) odps%Sensor_Channel
714 IF ( io_status /= 0 )
THEN 715 WRITE( message,
'("Error reading sensor channel data from ",a,& 716 &". IOSTAT = ",i0)' ) &
717 trim(filename), io_status
723 READ( fileid, iostat=io_status ) odps%Component_ID
724 IF ( io_status /= 0 )
THEN 725 WRITE( message,
'("Error reading tansmittance component ID from ",a,& 726 &". IOSTAT = ",i0)' ) &
727 trim(filename), io_status
733 READ( fileid, iostat=io_status ) odps%Absorber_ID
734 IF ( io_status /= 0 )
THEN 735 WRITE( message,
'("Error reading absorber ID from ",a,& 736 &". IOSTAT = ",i0)' ) &
737 trim(filename), io_status
743 READ( fileid, iostat=io_status ) odps%Ref_Level_Pressure, &
745 odps%Ref_Temperature, &
749 IF ( io_status /= 0 )
THEN 750 WRITE( message,
'("Error reading reference profiles from ",a,& 751 &". IOSTAT = ",i0)' ) &
752 trim(filename), io_status
758 READ( fileid, iostat=io_status ) odps%n_Predictors, &
760 IF ( io_status /= 0 )
THEN 761 WRITE( message,
'("Error reading n_Predictors and Pos_Index data from ",a,& 762 &". IOSTAT = ",i0)' ) &
763 trim(filename), io_status
770 IF( odps%n_Coeffs > 0 )
THEN 771 READ( fileid, iostat=io_status ) odps%C
772 IF ( io_status /= 0 )
THEN 773 WRITE( message,
'("Error reading regression coefficients from ",a,& 774 &". IOSTAT = ",i0)' ) &
775 trim(filename), io_status
780 IF( n_ocoeffs > 0 )
THEN 784 message_log=message_log)
785 IF ( error_status /=
success )
THEN 786 message =
'ODPS OPTRAN array allocation failed' 790 READ( fileid, iostat=io_status ) odps%OSignificance, &
795 odps%Alpha, odps%Alpha_C1, odps%Alpha_C2, &
796 odps%OComponent_Index
797 IF ( io_status /= 0 )
THEN 798 WRITE( message,
'("Error reading ODPS OPTRAN data to ",a,& 799 &". IOSTAT = ",i0)' ) &
800 trim(filename), io_status
808 CHARACTER(ML) :: Close_Message
809 INTEGER :: Destroy_Status
813 CLOSE( fileid, iostat=io_status )
814 IF ( io_status /= 0 )
THEN 815 WRITE( close_message,
'("; Error closing ",a," during error cleanup. IOSTAT=",i0)') &
816 trim(filename), io_status
817 message = trim(message)//trim(close_message)
822 destroy_status =
destroy_odps( odps, message_log=message_log )
823 IF ( destroy_status /=
success ) &
824 message = trim(message)//
'; Error destroying ODPS structure during error cleanup.' 828 trim(message)//trim(process_id_tag), &
830 message_log=message_log )
913 Quiet , & ! Optional input
914 RCS_Id , & ! Revision control
916 result( error_status )
918 CHARACTER(*) ,
INTENT(IN) :: filename
920 INTEGER ,
OPTIONAL,
INTENT(IN) :: quiet
921 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: rcs_id
922 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: message_log
924 INTEGER :: error_status
926 CHARACTER(*),
PARAMETER :: routine_name =
'Write_ODPS_Binary' 928 CHARACTER(ML) :: message
941 IF ( error_status /=
success )
THEN 942 message =
'Error opening '//trim( filename )
950 IF (
PRESENT( quiet ) )
THEN 951 IF ( quiet == 1 ) noisy = .false.
957 message_log=message_log )
959 IF ( error_status /=
success )
THEN 960 message =
'Error writing data to '//trim( filename )
968 CLOSE( fileid, iostat=io_status )
969 IF ( io_status /= 0 )
THEN 970 WRITE( message,
'("Error closing ",a," after write. IOSTAT = ",i0)' ) &
971 trim(filename), io_status
975 message_log=message_log )
984 'FILE: '//trim(filename)//
'; '//trim(message), &
986 message_log = message_log )
995 result( error_status )
996 CHARACTER(*) ,
INTENT(IN) :: filename
997 INTEGER ,
INTENT(IN) :: fileid
999 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: message_log
1001 CHARACTER(*),
PARAMETER :: routine_name =
'Write_ODPS_Data' 1003 INTEGER :: error_status
1005 CHARACTER(ML) :: message
1006 INTEGER :: io_status
1010 message =
'Some or all INPUT ODPS pointer members are NOT associated.' 1016 IF ( error_status /=
success )
THEN 1017 message =
'ODPS structure Release check failed.' 1023 IF ( error_status /=
success )
THEN 1024 message =
'ODPS Algorithm check failed' 1030 IF ( odps%n_Layers < 1 .OR. &
1031 odps%n_Components < 1 .OR. &
1032 odps%n_Absorbers < 1 .OR. &
1033 odps%n_Channels < 1 .OR. &
1034 odps%n_Coeffs < 0 .OR. &
1035 odps%n_OPIndex < 1 .OR. &
1036 odps%n_OCoeffs < 0 )
THEN 1037 message =
"One or more ODPS dimension variables have incorrect values" 1044 WRITE( fileid, iostat=io_status ) odps%Release, odps%Version
1045 IF ( io_status /= 0 )
THEN 1046 WRITE( message,
'("Error writing Release/Version values to ",a,& 1047 &". IOSTAT = ",i0)' ) &
1048 trim(filename), io_status
1055 WRITE( fileid, iostat=io_status ) odps%Algorithm
1056 IF ( io_status /= 0 )
THEN 1057 WRITE( message,
'("Error writing Algorithm ID to ",a,& 1058 &". IOSTAT = ",i0)' ) &
1059 trim(filename), io_status
1066 WRITE( fileid, iostat=io_status ) odps%n_Layers , &
1067 odps%n_Components, &
1068 odps%n_Absorbers , &
1073 IF ( io_status /= 0 )
THEN 1074 WRITE( message,
'("Error writing dimension values to ",a,& 1075 &". IOSTAT = ",i0)' ) &
1076 trim(filename), io_status
1082 WRITE( fileid, iostat=io_status ) odps%Group_Index
1083 IF ( io_status /= 0 )
THEN 1084 WRITE( message,
'("Error writing Group ID to ",a,& 1085 &". IOSTAT = ",i0)' ) &
1086 trim(filename), io_status
1092 WRITE( fileid, iostat=io_status ) odps%Sensor_Id , &
1093 odps%WMO_Satellite_Id, &
1094 odps%WMO_Sensor_Id , &
1096 IF ( io_status /= 0 )
THEN 1097 WRITE( message,
'("Error writing sensor information to ",a,& 1098 &". IOSTAT = ",i0)' ) &
1099 trim(filename), io_status
1106 WRITE( fileid, iostat=io_status ) odps%Sensor_Channel
1107 IF ( io_status /= 0 )
THEN 1108 WRITE( message,
'("Error writing sensor channel data to ",a,& 1109 &". IOSTAT = ",i0)' ) &
1110 trim(filename), io_status
1117 WRITE( fileid, iostat=io_status ) odps%Component_ID
1118 IF ( io_status /= 0 )
THEN 1119 WRITE( message,
'("Error writing component ID to ",a,& 1120 &". IOSTAT = ",i0)' ) &
1121 trim(filename), io_status
1127 WRITE( fileid, iostat=io_status ) odps%Absorber_ID
1128 IF ( io_status /= 0 )
THEN 1129 WRITE( message,
'("Error writing absorber ID to ",a,& 1130 &". IOSTAT = ",i0)' ) &
1131 trim(filename), io_status
1137 WRITE( fileid, iostat=io_status ) odps%Ref_Level_Pressure, &
1138 odps%Ref_Pressure, &
1139 odps%Ref_Temperature, &
1140 odps%Ref_Absorber, &
1141 odps%Min_Absorber, &
1144 IF ( io_status /= 0 )
THEN 1145 WRITE( message,
'("Error writing reference profile data to ",a,& 1146 &". IOSTAT = ",i0)' ) &
1147 trim(filename), io_status
1153 WRITE( fileid, iostat=io_status ) odps%n_Predictors, &
1155 IF ( io_status /= 0 )
THEN 1156 WRITE( message,
'("Error writing n_Predictors and Pos_Index data to ",a,& 1157 &". IOSTAT = ",i0)' ) &
1158 trim(filename), io_status
1165 IF( odps%n_Coeffs > 0 )
THEN 1166 WRITE( fileid, iostat=io_status ) odps%C
1167 IF ( io_status /= 0 )
THEN 1168 WRITE( message,
'("Error writing regression coefficients to ",a,& 1169 &". IOSTAT = ",i0)' ) &
1170 trim(filename), io_status
1175 IF( odps%n_OCoeffs > 0 )
THEN 1176 WRITE( fileid, iostat=io_status ) odps%OSignificance, &
1181 odps%Alpha, odps%Alpha_C1, odps%Alpha_C2, &
1182 odps%OComponent_Index
1183 IF ( io_status /= 0 )
THEN 1184 WRITE( message,
'("Error writing ODPS OPTRAN data to ",a,& 1185 &". IOSTAT = ",i0)' ) &
1186 trim(filename), io_status
1194 CHARACTER(ML) :: Close_Message
1198 CLOSE( fileid, iostat=io_status, status=
'DELETE' )
1199 IF ( io_status /= 0 )
THEN 1200 WRITE( close_message,
'("; Error deleting ",a," during error cleanup. IOSTAT=",i0)') &
1201 trim(filename), io_status
1202 message = trim(message)//trim(close_message)
1211 message_log=message_log )
integer, parameter, public failure
integer function, public checkalgorithm_odps(ODPS, RCS_Id, Message_Log)
integer, parameter, public set
character(*), parameter module_rcs_id
integer, parameter, public warning
integer function, public allocate_odps(n_Layers, n_Components, n_Absorbers, n_Channels, n_Coeffs, ODPS, RCS_Id, Message_Log)
integer, parameter, public long
subroutine, public info_odps(ODPS, Info, RCS_Id)
integer function, public destroy_odps(ODPS, No_Clear, RCS_Id, Message_Log)
integer function, public write_odps_data(Filename, FileID, ODPS, Message_Log)
subroutine inquire_cleanup()
integer function, public inquire_odps_binary(Filename, n_Layers, n_Components, n_Absorbers, n_Channels, n_Coeffs, n_OCoeffs, Release, Version, Sensor_Id, WMO_Satellite_Id, WMO_Sensor_Id, RCS_Id, Message_Log)
integer function, public read_odps_binary(Filename, ODPS, Quiet, Process_ID, Output_Process_ID, RCS_Id, Message_Log)
subroutine read_cleanup()
subroutine write_cleanup()
integer function, public open_binary_file(Filename, FileID, For_Output, No_Check)
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
logical function, public associated_odps(ODPS, ANY_Test)
integer function, public checkrelease_odps(ODPS, RCS_Id, Message_Log)
integer function, public write_odps_binary(Filename, ODPS, Quiet, RCS_Id, Message_Log)
integer function, public read_odps_data(Filename, FileID, ODPS, Process_ID_Tag, Message_Log)
integer, parameter, public success
integer function, public allocate_odps_optran(n_OCoeffs, ODPS, RCS_Id, Message_Log)
integer, parameter, public information