!v1.1.0 ! ! Version history ! v2019CIRA_0.2.11 (GC) ! v1.0.0 - (MD) 5Feb2019 for NHC IT environment. ! v1.1.0 - (SS) 24Mar2020 removed ioper flag subroutine read_lsdiag_attributes(var_names_lsdiag,& var_names_lsdiag_exp,& eohc_attributes_path_local,& var_scales_arr,n_data_arr_max,& lu_log_info,lu_log_debug,lu_attr,ierr_attr) !this subroutine reads lsdiag variable scales from a file ! could be used to read scale just for a single variable, or several, or all ! variables. ! ! the expected attributes file format: !lsdiag_var_name scale_to_convert_float_to_int experimantal_lsiag_name ! NLON 10. KLON ! ! note that experimental lsdiag name is only used for testing ! and can be skipped if not needed ! ! !v2019.0.2.9 implicit none ! input ----------------------------- ! max allowed number of EOHC variables integer :: n_data_arr_max ! input logical unit for attributes file integer :: lu_attr ! input logical unit for log file integer :: lu_log_info ! input logical unit for debug file integer :: lu_log_debug ! local dir containing eohc_attributes.txt file character(len = 200) :: eohc_attributes_path_local ! output ----------------------------- ! array of variable names for EOHC variables character(len=4) :: var_names_lsdiag(n_data_arr_max) ! experimental verion of variable names for EOHC dta in lsdiag (KSST, ! KOHC, etc) character(len=4) :: var_names_lsdiag_exp(n_data_arr_max) ! array of scales for EOHC variables real :: var_scales_arr(n_data_arr_max) ! ! error flags ! master error for opening/reading attributes file ! ierr_attr must be zero on exit if file read without errors ! if errors encountered, it will be set to ErrOpen or ErrRead integer :: ierr_attr ! local ---------------------------------------- ! max allowed number of EOHC/climo variables integer,parameter :: n_max = 100 ! file containing scales and LSDIAG names character(len=19),parameter :: eohc_attributes_fname = 'eohc_attributes.txt' ! charachter iterator for variable names character(len=4) :: cvar ! float missing values used in EOHC file integer,parameter :: imiss = 9999 ! full filename for eohcatributes with path character(len = 200) :: eohc_attributes_fname_wpath ! location of SHIPS coefficients and other data files for operational ! runs character(len = 200) :: coef_location ! iterator integer :: ivar ! ! full array to read full attributes file ! experimental verion of variable names for EOHC dta in lsdiag (KSST, ! KOHC, etc) character(len=4) :: var_names_lsdiag_exp_all(n_max) ! array of scales for EOHC variables real :: var_scales_arr_all(n_max) ! array of variable names for EOHC variables character(len=4) :: var_names_lsdiag_all(n_max) ! !lsdiag experimental variable name K* character(len=4) :: var_exp ! eohc var_name character(len=6) :: var_name ! eohc var_scale real :: var_scale ! ! iterator integer :: ivar2 ! error flags ! error open attributes file integer :: ErrOpen ! error read attributes file integer :: ErrRead ! init master error to missing ierr_attr = imiss !init arrays of variable scales and names var_scales_arr(:) = 1. var_names_lsdiag_exp(:) = 'NONE' var_scales_arr_all(:) = 1. var_names_lsdiag_exp_all(:) = 'NONE' var_names_lsdiag_all(:) = 'NONE' ! read all data !open eohc_attributes file for reading call getenv( "SHIPS_COEF", coef_location ) eohc_attributes_fname_wpath = & trim( coef_location ) // trim( eohc_attributes_fname ) open(file=eohc_attributes_fname_wpath,unit=lu_attr,iostat=ErrOpen) if ( ErrOpen /= 0 ) then write(lu_log_info,*) 'CRITICAL ERROR: read_lsdiag_attributes: error opening & &attributes file' write(lu_log_info,*) 'CRITICAL ERROR: read_lsdiag_attributes: ErrOpen ', ErrOpen ierr_attr = ErrOpen stop endif do ivar = 1,n_max read (lu_attr, 11, iostat = ErrRead) var_name, var_scale, var_exp write(lu_log_debug,*) "DEBUG: read_lsdiag_attributes: & &var_name, var_scale, var_exp ", var_name,& &var_scale, var_exp,ErrRead 11 format(a4,1x,f7.2,2x,a4,4x,a4) if ( ErrRead > 0 ) then ! something wrong while reading file write(lu_log_info,*) 'ERROR: read_lsdiag_attributes: & &Error while reading file ', eohc_attributes_fname write(lu_log_info,*) 'CRITICAL ERROR: read_lsdiag_attributes: ErrRead ', ErrRead ierr_attr = ErrRead stop else if (ErrRead < 0 ) then ! end of file reached write(lu_log_info,*) 'INFO: read_lsdiag_attributes: & &End of file reached ', eohc_attributes_fname write(lu_log_info,*) 'INFO: read_lsdiag_attributes: ErrRead ', ErrRead ierr_attr = 0 exit else var_scales_arr_all(ivar) = var_scale var_names_lsdiag_exp_all(ivar) = var_exp var_names_lsdiag_all(ivar) = var_name ierr_attr = 0 endif enddo close(lu_attr) ! save matching data do ivar2 = 1, n_data_arr_max do ivar = 1, n_max if (var_names_lsdiag(ivar2) == var_names_lsdiag_all(ivar) ) then var_scales_arr(ivar2) = var_scales_arr_all(ivar) var_names_lsdiag_exp(ivar2) = var_names_lsdiag_exp_all(ivar) endif enddo enddo return end subroutine read_lsdiag_attributes