MODULE yaml_parser ! !git $Id$ !svn $Id: yaml_parser_test.F 1197 2023-08-31 20:35:47Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2023 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.md ! !======================================================================= ! ! ! This module contains several routines to process input YAML files. ! ! ! ! Notice that several Fortran parsers exist for complex and simple ! ! YAML files coded with Object-Oriented Programming (OOP) principles. ! ! For example, check: ! ! ! ! * FCKit (https://github.com/ecmwf/fckit) ! ! * Fortran-YAML (https://github.com/BoldingBruggeman/fortran-yaml) ! ! * yaFyaml (https://github.com/Goddard-Fortran-Ecosystem/yaFyaml) ! ! ! ! However, this YAML parser is more uncomplicated with substantial ! ! capabilities. It is a hybrid between standard and OOP principles ! ! but without the need for recurrency, inheritance, polymorphism, ! ! and containers. ! ! ! ! The only constraint is that the YAML file is read twice for ! ! simplicity. The first read determines the number indentation of ! ! blanks policy and the length of the collection list(:) pairs object ! ! (CLASS yaml_pair). It supports: ! ! ! ! * Single or multiple line comments start with a hash '#'. Also, ! ! comment after a key/value pair is allowed. All comments are ! ! skipped during processing. ! ! * Unlimited nested structure (lists, mappings, hierarchies). ! ! Indentation of whitespace is used to denote structure. ! ! * Unrestricted schema indentation. However, some schema validators ! ! recommend or impose two whitespace indentations. ! ! * A key is followed by a colon to denote a mapping value (like ! ! ocean_model: ROMS). ! ! * Aliases and Anchors. ! ! * Blocking lists: members are denoted by a leading hyphen and ! ! space, which is considered as part of the indentation. ! ! * Flow sequence: a vector list with values enclosed in square ! ! brackets and separated by a comma-and-space: [val1, ..., valN]. ! ! * Keyword values are processed and stored as strings but converted ! ! to a logical, integer, or floating-point type when appropriate ! ! during extraction. If derived-type values are needed, the caller ! ! can process such structure outside this module, as shown below. ! ! * Remove unwanted control characters like tabs and separators ! ! (ASCII character code 0-31) ! ! * English uppercase and lowercase alphabet, but it can be expanded ! ! to other characters (see yaml_ValueType routine) ! ! * Module is self contained, but it has very minimal association to ! ! four ROMS modules. ! ! * Multiple or continuation lines are supported, for example we can ! ! have: ! ! ! ! state variables: [sea_surface_height_above_geopotential_datum, ! ! barotropic_sea_water_x_velocity, ! ! barotropic_sea_water_y_velocity, ! ! sea_water_x_velocity, ! ! sea_water_y_velocity, ! ! sea_water_potential_temperature, ! ! sea_water_practical_salinity] ! ! ! ! Usage: ! ! ! ! USE yaml_parser_mod, ONLY : yaml_initialize, yaml_get, yaml_tree ! ! ! ! TYPE (yaml_tree) :: YML ! ! ! ! CALL yaml_initialize (YML, 'ocn_coupling.yaml', report) ! ! status = yaml_get(YML, 'Nimport', Nimport) ! ! status = yaml_get(YML, 'import.standard_name', Sstandard) ! ! status = yaml_get(YML, 'import.standard_name.short_name', S%short)! ! status = yaml_get(YML, 'import.standard_name.unit', S%units) ! ! ... ! ! ! ! and so on for logical, integer, floating-point, and string ! ! key/value pairs. ! ! ! ! Here, 'Sstandard(1:Nimport) will contain all 'standard_name' ! ! values for the YAML block 'import:'. Notice that nested keywords ! ! are concatenated with a period: 'key1.key2.key3' for a three- ! ! level nested block, similar to how Matlab build structures. The ! ! key can have more than one word separated by one space. For ! ! example, we can have 'bulk_flux import.standard_name'. Similarly, ! ! any otherkey/value pair can be extrated from the YML object. ! ! ! !======================================================================= ! ! Define local parameters. ! logical :: yaml_Master = .TRUE. ! Master process logical :: Lreport = .TRUE. ! dumps YAML dictionaty ! integer, parameter :: kind_real = SELECTED_REAL_KIND(12,300) integer, parameter :: dp = SELECTED_REAL_KIND(12,300) integer, parameter :: yaml_stdout = 6 ! standard output integer, parameter :: stdout = 6 ! standard output integer, parameter :: NoError = 0 ! No error flag integer :: yaml_ErrFlag = 0 ! error flag ! !----------------------------------------------------------------------- ! Structures/Objects to hold YAML dictionary lists with theirs keys and ! values. !----------------------------------------------------------------------- ! ! YAML file key/value pair. ! TYPE, PUBLIC :: yaml_pair logical :: has_alias ! alias '*' token logical :: has_anchor ! anchor '&' token logical :: is_block ! block '-' list logical :: is_sequence ! sequence '[]' tokens ! logical :: is_logical ! logical value logical :: is_integer ! integer value logical :: is_real ! numerical value logical :: is_string ! string value ! integer :: id ! key/value ID integer :: parent_id ! parent ID integer :: left_padding ! indent level: 0,1,.. ! character (len=:), allocatable :: line ! YAML line character (len=:), allocatable :: key ! YAML keyword: character (len=:), allocatable :: value ! YAML value(s) character (len=:), allocatable :: anchor ! anchor keyword END TYPE yaml_pair ! ! YAML file dictionary tree. ! TYPE, PUBLIC :: yaml_tree logical :: IsCreated = .FALSE. ! Object creation switch integer :: Nbranches ! total number of branches integer :: Npairs ! total number of pairs integer :: indent ! blank indentation policy ! character (len=:), allocatable :: filename ! YAML file name ! ! YAML file collection pairs, [1:Npairs]. ! TYPE (yaml_pair), pointer :: list(:) ! CONTAINS ! CLASS objects ! PROCEDURE :: create => yaml_tree_create PROCEDURE :: destroy => yaml_tree_destroy PROCEDURE :: dump => yaml_tree_dump PROCEDURE :: extract => yaml_tree_extract PROCEDURE :: fill => yaml_tree_fill PROCEDURE :: fill_aliases => yaml_tree_fill_aliases PROCEDURE :: has => yaml_tree_has PROCEDURE :: read_line => yaml_tree_read_line END TYPE yaml_tree ! ! Public structures that can be used in applications to extract block ! list YAML constructs. The key may represents a sequence flow [...] ! with a vector of values. The values can be integers, logicals, reals, ! or strings. For example, ! ! import: ! - standard_name: surface_downward_heat_flux_in_sea_water ! long_name: surface net heat flux ! short_name: shflux ! data_variables: [shf, shf_time] ! - standard_name: surface_wind_x_stress ! long_name: surface zonal wind stress component ! short_name: sustr ! data_variables: [taux, atm_time] ! - standard_name: surface_wind_y_stress ! long_name: surface meridional wind stress component ! short_name: svstr ! data_variables: [tauy, atm_time] ! ! The extraction is loaded into V, which is a TYPE "yaml_Svec" ! structure: ! ! status = yaml_get(YML, 'import.data_variables', V) ! ! or altenatively ! ! IF (yaml_Error(yaml_get(YML, 'import.data_variables', V), & ! & NoErr, __LINE__, MyFile)) RETURN ! ! yielding the following block-list, string structure in a single ! invocation of the overloaded function "yaml_get": ! ! V(1)%vector(1)%value = 'shf' ! V(1)%vector(2)%value = 'shf_time' ! V(2)%vector(1)%value = 'taux' ! V(2)%vector(2)%value = 'atm_time' ! V(3)%vector(1)%value = 'tauy' ! V(3)%vector(2)%value = 'atm_time' ! ! It is a compact way to extract similar data blocks. ! TYPE, PUBLIC :: yaml_Ivec ! integer structure integer, allocatable :: vector(:) ! vector values END TYPE yaml_Ivec ! TYPE, PUBLIC :: yaml_Lvec ! logical structure logical, allocatable :: vector(:) ! vector values END TYPE yaml_Lvec ! TYPE, PUBLIC :: yaml_Rvec ! real structure real (kind_real), allocatable :: vector(:) ! vector values END TYPE yaml_Rvec ! TYPE, PUBLIC :: yaml_Svec ! string structure character (len=:), allocatable :: value ! scalar value TYPE (yaml_Svec), pointer :: vector(:) ! recursive vector END TYPE yaml_Svec ! values ! ! Derived-type structure, extended/inherited from parent "yaml_Svec", ! is used to extract hierarchies of keys and associated values from ! YAML dictionary object. The calling program specifies a key-string ! that may be generated by aggregating nested keys with a period. ! Also, it can extract flow sequence string element values that are ! separated by commas. ! TYPE, PRIVATE, EXTENDS(yaml_Svec) :: yaml_extract logical :: has_vector ! true if loaded vector values END TYPE yaml_extract ! !----------------------------------------------------------------------- ! Define public overloading API to extract key/value pairs from YAML ! tree dictionary object accounting to variable type. !----------------------------------------------------------------------- ! INTERFACE yaml_get MODULE PROCEDURE yaml_Get_i_struc ! Gets integer structure MODULE PROCEDURE yaml_Get_l_struc ! Gets logical structure MODULE PROCEDURE yaml_Get_r_struc ! Gets real structure MODULE PROCEDURE yaml_Get_s_struc ! Gets string structure ! MODULE PROCEDURE yaml_Get_ivar_0d ! Gets integer value MODULE PROCEDURE yaml_Get_ivar_1d ! Gest integer values MODULE PROCEDURE yaml_Get_lvar_0d ! Gets logical value MODULE PROCEDURE yaml_Get_lvar_1d ! Gets logical values MODULE PROCEDURE yaml_Get_rvar_0d ! Gets real value MODULE PROCEDURE yaml_Get_rvar_1d ! Gets real values MODULE PROCEDURE yaml_Get_svar_0d ! Gets string value MODULE PROCEDURE yaml_Get_svar_1d ! Gets string values END INTERFACE yaml_get ! ! !----------------------------------------------------------------------- ! Define generic coupling field to process import and export states. !----------------------------------------------------------------------- ! TYPE CouplingField logical :: connected logical :: debug_write ! real(dp) :: add_offset real(dp) :: scale ! character (len=:), allocatable :: connected_to character (len=:), allocatable :: data_netcdf_vname character (len=:), allocatable :: data_netcdf_tname character (len=:), allocatable :: destination_grid character (len=:), allocatable :: destination_units character (len=:), allocatable :: extrapolate_method character (len=:), allocatable :: long_name character (len=:), allocatable :: map_norm character (len=:), allocatable :: map_type character (len=:), allocatable :: regrid_method character (len=:), allocatable :: source_units character (len=:), allocatable :: source_grid character (len=:), allocatable :: short_name character (len=:), allocatable :: standard_name ! END TYPE CouplingField ! ! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ! YAML Tree Post-proccesing Variables and Structures: ! ! Define generic YAML dictionary, containers, and counters used ! during processing. !----------------------------------------------------------------------- ! logical :: LdebugMetadata = .TRUE. ! Debugging switch ! ! Counters. ! integer :: Ientry ! entry counter integer :: Nentries ! number of entries ! ! logical scalar dummy values. ! logical, allocatable :: Ylogical1(:) ! ! Real scalar dummy values. ! real(kind_real), allocatable :: Yreal1(:) real(kind_real), allocatable :: Yreal2(:) ! ! Derived-type dummy structures for processing string value or set ! of values from a sequence flow, [val1, ..., valN]. ! TYPE (yaml_Svec), allocatable :: Ystring1 (:) TYPE (yaml_Svec), allocatable :: Ystring2 (:) TYPE (yaml_Svec), allocatable :: Ystring3 (:) TYPE (yaml_Svec), allocatable :: Ystring4 (:) TYPE (yaml_Svec), allocatable :: Ystring5 (:) TYPE (yaml_Svec), allocatable :: Ystring6 (:) TYPE (yaml_Svec), allocatable :: Ystring7 (:) TYPE (yaml_Svec), allocatable :: Ystring8 (:) TYPE (yaml_Svec), allocatable :: Ystring9 (:) TYPE (yaml_Svec), allocatable :: Ystring10(:) TYPE (yaml_Svec), allocatable :: Ystring11(:) TYPE (yaml_Svec), allocatable :: Ystring12(:) ! PUBLIC :: cmeps_metadata PUBLIC :: coupling_metadata PUBLIC :: process_yaml ! ! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ! PUBLIC :: yaml_AssignString PUBLIC :: yaml_Error PUBLIC :: yaml_get PUBLIC :: yaml_initialize ! PRIVATE :: yaml_CountKeys PRIVATE :: yaml_LowerCase PRIVATE :: yaml_UpperCase PRIVATE :: yaml_ValueType ! PRIVATE ! !----------------------------------------------------------------------- ! Local module parameters. !----------------------------------------------------------------------- ! logical, parameter :: LdebugYAML = .FALSE. ! debugging switch ! integer, parameter :: Ldim = 8 ! logical Lswitch dimension integer, parameter :: Lkey = 254 ! Maximum characters per keyword integer, parameter :: Lmax = 2048 ! Maximum characters per line integer, parameter :: NoErr = 0 ! no error flag integer, parameter :: iunit = 222 ! Fortan unit for reading ! character (len=55), dimension(7) :: yaml_ErrMsg = & & (/ ' YAML_PARSER - Blows up ................ yaml_ErrFlag: ', & & ' YAML_PARSER - Input error ............. yaml_ErrFlag: ', & & ' YAML_PARSER - Output error ............ yaml_ErrFlag: ', & & ' YAML_PARSER - I/O error ............... yaml_ErrFlag: ', & & ' YAML_PARSER - Configuration error ..... yaml_ErrFlag: ', & & ' YAML_PARSER - Partition error ......... yaml_ErrFlag: ', & & ' YAML_PARSER - Illegal input parameter . yaml_ErrFlag: ' /) ! !----------------------------------------------------------------------- CONTAINS !----------------------------------------------------------------------- ! FUNCTION yaml_initialize (self, filename, report) RESULT (status) ! !*********************************************************************** ! ! ! It creates a YAML tree dictionary object. First, it reads the YAML ! ! file to determine the indentation policy and length of list oject ! ! (TYPE yaml_tree). ! ! ! ! After the object is allocated, the Fortran unit is rewinded and the ! ! YAML file is read again to populate the keyword values. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! filename YAML filename (string) ! ! report Switch to dump to standard output (logical, OPTIONAL) ! ! ! ! On Ouptut: ! ! ! ! self Allocated and populated YAML object. ! ! status Error flag (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(inout) :: self character (len=*), intent(in ) :: filename logical, optional, intent(in ) :: report ! ! Local variable declarations. ! logical :: Ldump ! integer :: LenStr, status ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_initialize" ! !----------------------------------------------------------------------- ! Initialize YAML object. !----------------------------------------------------------------------- ! status=Noerr ! ! Set switch to print the processed YAML key/value pairs to standard ! ouput. ! IF (PRESENT(report)) THEN Ldump = report ELSE Ldump = .FALSE. END IF ! ! Set YAML file path and name. ! IF (yaml_Error(yaml_AssignString(self%filename, & & filename, LenStr), & & NoErr, __LINE__, MyFile)) THEN status=yaml_ErrFlag RETURN END IF ! ! Create and populate YAML object. ! IF (self%IsCreated) CALL self%destroy () ! CALL self%create () IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN status=yaml_ErrFlag RETURN END IF ! ! Report YAML tree dictionary, for debugging. ! IF (Ldump) CALL self%dump () ! RETURN END FUNCTION yaml_initialize ! SUBROUTINE yaml_tree_create (self) ! !*********************************************************************** ! ! ! It creates a YAML tree dictionary object. First, it reads the YAML ! ! file to determine the dimensions of parent and children structures. ! ! After the structures are allocate, the Fortran unit is rewinded and ! ! YAML file is read again to populate the keyword values. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! ! ! On Ouptut: ! ! ! ! self Allocated and populated YAML object. ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(inout) :: self ! ! Local variable declarations. ! logical :: FirstPass, Lswitch(Ldim) ! integer :: Nblanks, Nbranches, Npairs integer :: i, io_err, status ! character (len=Lkey) :: anchor, io_errmsg, key character (len=Lmax) :: line, value ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_tree_create" ! !----------------------------------------------------------------------- ! Open YAML file for reading. !----------------------------------------------------------------------- ! OPEN (UNIT=iunit, FILE=self%filename, FORM='formatted', & & STATUS='old', IOSTAT=io_err, IOMSG=io_errmsg) IF (io_err.ne.0) THEN yaml_ErrFlag=5 IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) self%filename, & & TRIM(io_errmsg) RETURN END IF END IF ! ! Determine the total number of YAML key/value pairs. ! Nblanks = 0 Nbranches = 0 Npairs = 0 ! FirstPass = .TRUE. ! YAML_LINE : DO WHILE (.TRUE.) ! status=self%read_line(Nblanks, line, key, value, anchor, & & Lswitch) ! SELECT CASE (status) CASE (-1) ! error condition during reading yaml_ErrFlag=5 IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,20) self%filename, & & TRIM(line) RETURN END IF CASE (0) ! end-of-file EXIT CASE (1) ! blank or comment line, move to the next line CYCLE CASE (2) ! processed viable line Npairs=Npairs+1 END SELECT ! ! If no leading blanks, advance YAML tree branch counter. ! IF (Nblanks.eq.0) THEN Nbranches = Nbranches+1 ! hierarchy start END IF ! ! On first pass, establish indentation policy: number of blanks. ! IF (FirstPass.and.(Nblanks.gt.0)) THEN FirstPass=.FALSE. self%indent=Nblanks END IF ! ! Check for consitent identation policy. Some YAML validators impose ! a two-blank spacing policy. ! IF (Nblanks.gt.0) THEN IF (MOD(Nblanks, self%indent).ne.0) THEN yaml_ErrFlag=2 IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,30) nblanks, & & self%indent RETURN END IF END IF END IF END DO YAML_LINE ! ! Rewind unit since we need to reprocess the file again to load the ! data into the allocated "self%list(1:Npairs)" container. ! REWIND (iunit) ! !----------------------------------------------------------------------- ! Allocate YAML dictionary container. !----------------------------------------------------------------------- ! ! Set number of main branches and number of key/values in YAML 'list'. ! self%Nbranches=Nbranches self%Npairs=Npairs ! ! Allocate YAML key/value pair list (TYPE 'yaml_pair') object. ! IF (.not.self%IsCreated) THEN ALLOCATE ( self%list(Npairs) ) self%IsCreated=.TRUE. END IF ! !----------------------------------------------------------------------- ! Re-read YAML file again and populate dictionary. !----------------------------------------------------------------------- ! CALL self%fill () ! 10 FORMAT (/,' YAML_TREE_CREATE - Unable to open input YAML file: ', & & a,/,20x,'ERROR: ',a) 20 FORMAT (/,' YAML_TREE_CREATE - Error while reading YAML file: ', & & a,/,20x,'LINE: ',a) 30 FORMAT (/,' YAML_TREE_CREATE - Inconsistent indentation, ', & & 'self%indent = ',i0,', nblanks = ',i0) 40 FORMAT (/,' YAML_TREE_CREATE - Inconsistent indentation, ', & & 'nblanks = ',i0,', indent blank policy = ',i0,/,20x, & & 'Number of nested collections = ',i0, & & ' is greater than 3',/,20x,'Line: ',a) 50 FORMAT (/,' YAML_TREE_CREATE - Cannot find branches in YAML ', & & 'file: ',a) ! RETURN END SUBROUTINE yaml_tree_create ! SUBROUTINE yaml_tree_destroy (self) ! !*********************************************************************** ! ! ! It deallocates/destroys the YAML dictionary object. ! ! ! ! Arguments: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(inout) :: self ! ! Local variable declarations. ! logical :: Lopened ! !----------------------------------------------------------------------- ! Deallocate YAML dictionary object. !----------------------------------------------------------------------- ! ! If applicable, close YAML Fortran unit. ! INQUIRE (UNIT=iunit, OPENED=Lopened) IF (Lopened) THEN CLOSE (iunit) END IF ! ! Recall that Fortran 2003 standard allows deallocating just the ! parent object to deallocate all array variables within its scope ! automatically. ! IF (ASSOCIATED(self%list)) THEN self%IsCreated=.FALSE. DEALLOCATE (self%list) END IF ! RETURN END SUBROUTINE yaml_tree_destroy ! SUBROUTINE yaml_tree_dump (self) ! !*********************************************************************** ! ! ! It prints the YAML dictionary to standard output for debugging ! ! purposes. ! ! ! ! Arguments: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self ! ! Local variable declarations. ! integer :: Lstr, Nblanks, i, indent, padding ! character (len=Lkey) :: key character (len=Lmax) :: string, value ! !----------------------------------------------------------------------- ! Report the contents of the YAML tree directory. !----------------------------------------------------------------------- ! IF (yaml_Master) THEN WRITE (yaml_stdout,10) self%filename indent=self%indent ! DO i=1,self%Npairs padding=self%list(i)%left_padding Nblanks=indent*padding key=self%list(i)%key IF (ALLOCATED(self%list(i)%value)) THEN value=self%list(i)%value Lstr=LEN_TRIM(value) ELSE Lstr=0 END IF IF (self%list(i)%is_block) THEN IF (Lstr.gt.0) THEN IF (self%list(i)%is_sequence) THEN WRITE (string,20) i, REPEAT(CHAR(32),Nblanks), '- ', & & TRIM(key), ': [', TRIM(value), ']' ELSE WRITE (string,30) i, REPEAT(CHAR(32),Nblanks), '- ', & & TRIM(key), ': ', TRIM(value) END IF ELSE WRITE (string,40) i, REPEAT(CHAR(32),Nblanks), '- ', & & TRIM(key), ':' END IF ELSE IF (Lstr.gt.0) THEN IF (self%list(i)%is_sequence) THEN WRITE (string,30) i, REPEAT(CHAR(32),Nblanks), & & TRIM(key), ': [', TRIM(value), ']' ELSE WRITE (string,40) i, REPEAT(CHAR(32),Nblanks), & & TRIM(key), ': ', TRIM(value) END IF ELSE WRITE (string,50) i, REPEAT(CHAR(32),Nblanks), & & TRIM(key), ':' END IF END IF WRITE (yaml_stdout,60) TRIM(string) END DO END IF ! 10 FORMAT (/,"YAML Tree Dictinary, file: '",a,"'",/, & & '==========================',/) 20 FORMAT ('L=',i4.4,1x,'% ',6a) 30 FORMAT ('L=',i4.4,1x,'% ',5a) 40 FORMAT ('L=',i4.4,1x,'% ',4a) 50 FORMAT ('L=',i4.4,1x,'% ',3a) 60 FORMAT (a) ! RETURN END SUBROUTINE yaml_tree_dump ! FUNCTION yaml_tree_extract (self, keystring, S) RESULT (status) ! !*********************************************************************** ! ! ! It extracts YAML value(s) from processing key-string. The key ! ! string may be a set of keys aggregated with a period, CHAR(46). ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring Aggregated YAML keys (string) ! ! ! ! On Output: ! ! ! ! S Separated YAML key/pair value (TYPE yaml_extract) ! ! nkeys Number of extracted keys (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring TYPE (yaml_extract), allocatable, intent(inout) :: S(:) ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: K(:) ! logical :: BlockFlow ! integer :: i, ib, ic, ie, ik, ipair, is, j, li, pID integer :: Lstr, LenStr, nkeys, npairs, nvalues integer :: icomma, idot integer :: status ! integer, allocatable :: P(:) ! pair index ! character (len=:), allocatable :: Kstring ! key string character (len=:), allocatable :: Vstring ! value string ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_tree_extract" ! !----------------------------------------------------------------------- ! Extract YAML key(s) from key-string. !----------------------------------------------------------------------- ! status=Noerr ! ! Count the number keys in key-string, separated by period. ! Lstr=LEN_TRIM(keystring) IF (yaml_Error(yaml_AssignString(Kstring, & & keystring, LenStr), & & NoErr, __LINE__, MyFile)) RETURN ! nkeys=yaml_CountKeys(Kstring, CHAR(46)) ! ! Allocate key structure. ! ALLOCATE ( K(nkeys) ) ! ! Extract keys. ! is=1 DO i=1,nkeys idot=INDEX(Kstring,CHAR(46),BACK=.FALSE.) ie=idot IF (idot.eq.0) THEN ie=LEN_TRIM(Kstring) ELSE ie=ie-1 END IF IF (yaml_Error(yaml_AssignString(K(i)%value, & & Kstring(is:ie), LenStr), & & NoErr, __LINE__, MyFile)) RETURN IF (idot.gt.0) Kstring(is:ie+1) = REPEAT(CHAR(32), ie-is+2) Kstring=TRIM(ADJUSTL(Kstring)) END DO ! !----------------------------------------------------------------------- ! Determine the number of YAML tree pairs to process and assoicated ! list array element. !----------------------------------------------------------------------- ! ! Check if key-string is a blocking list where any of the members has ! a leading hyphen as indentation. If blocking, all the pairs with the ! same key-string are extracted. ! BlockFlow=.FALSE. ! Switch to process all block membert ib=0 ! block list(s) counter ic=0 ! key/value pair counter ik=1 ! key counter to avoid double DO-loops ! DO i=1,self%Npairs Lstr=LEN_TRIM(self%list(i)%key) IF ((self%list(i)%key).eq.(K(ik)%value)) THEN IF (yaml_Master.and.LdebugYAML) THEN PRINT '(2(a,i0,2a))', 'key ',ik,' = ', TRIM(K(ik)%value), & & ', YAML list ',i,' = ', & & TRIM(self%list(i)%key) END IF pID=self%list(i)%parent_id IF (self%list(i)%is_block.or.self%list(pID)%is_block) THEN ib=ib+1 ! advance block counter END IF IF (ik.eq.nkeys) THEN ic=ic+1 ! advance pair counter IF (ib.eq.0) THEN li=i ! list index to extract EXIT ! no blocking list found ELSE BlockFlow=.TRUE. END IF ELSE ik=ik+1 ! advance key counter END IF END IF IF (BlockFlow.and.(self%list(i)%left_padding.eq.0)) THEN EXIT ! processed all blocks END IF END DO npairs=ic ! pairs to process ! ! Allocate pair index array, P. ! IF (npairs.ne.0) THEN IF (.not.ALLOCATED(P)) ALLOCATE ( P(npairs) ) ELSE yaml_ErrFlag=7 status=yaml_ErrFlag IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) keystring, & & self%filename RETURN END IF END IF ! ! Set pair element(s) to extract. ! IF (BlockFlow) THEN ic=0 ik=1 DO i=1,self%Npairs IF ((self%list(i)%key).eq.(K(ik)%value)) THEN IF (ik.eq.nkeys) THEN ic=ic+1 P(ic)=i ! multiple pair index ELSE ik=ik+1 END IF END IF IF ((ic.gt.0).and.(self%list(i)%left_padding.eq.0)) THEN EXIT ! processed all blocks END IF END DO ELSE P(1)=li ! single pair index END IF ! !----------------------------------------------------------------------- ! Extract pair(s) value(s). !----------------------------------------------------------------------- ! DO i=1,npairs ipair=P(i) ! ! Get key-string value. ! IF (yaml_Error(yaml_AssignString(Vstring, & & self%list(ipair)%value, & & LenStr), & & NoErr, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Extract/load keys-tring value(s). In a sequence, values are separated ! by commas. !----------------------------------------------------------------------- ! ! Extract pair from a blocking list. Currently, scalar value are ! allowed. Nested blocking is not supported since it is complicated ! to process. For example, the following nested blocking lists are ! not supported. ! ! branch: ! - blocklist1: value ! blocklist1_key1: value ! - blocklist1A: value ! not supported ! IF (BlockFlow) THEN ! ! Process a block list pair with vector values (flow sequence): ! S(i)%vector(1)%value to S(i)%vector(nvalues)%value ! IF (self%list(ipair)%is_sequence) THEN Lstr=LEN_TRIM(Vstring) nvalues=COUNT((/(Vstring(j:j), j=1,Lstr)/) == CHAR(44)) + 1 ! IF (.not.ALLOCATED(S)) THEN ALLOCATE ( S(npairs) ) ! main structure END IF ALLOCATE ( S(i)%vector(nvalues) ) ! sub-structure S(i)%has_vector=.TRUE. ! is=1 DO j=1,nvalues icomma=INDEX(Vstring,CHAR(44),BACK=.FALSE.) ie=icomma IF (icomma.eq.0) THEN ie=LEN_TRIM(Vstring) ELSE ie=ie-1 END IF IF (yaml_Error(yaml_AssignString(S(i)%vector(j)%value, & & Vstring(is:ie), & & LenStr), & & NoErr, __LINE__, MyFile)) RETURN IF (yaml_Master.and.LdebugYAML) THEN PRINT '(3a,2(i0,a),a)', 'keystring = ',TRIM(keystring), & & ', S(', i, ')%vector(', j, ') = ', & & TRIM(S(i)%vector(j)%value) END IF IF (icomma.gt.0) Vstring(is:ie+1)=REPEAT(CHAR(32),ie-is+2) Vstring=TRIM(ADJUSTL(Vstring)) END DO ! ! Process a block list pair with a scalar value, S(i)%value ! ELSE ! IF (.not.ALLOCATED(S)) THEN ALLOCATE ( S(npairs) ) END IF S(i)%has_vector=.FALSE. ! IF (yaml_Error(yaml_AssignString(S(i)%value, & & Vstring, LenStr), & & NoErr, __LINE__, MyFile)) RETURN IF (yaml_Master.and.LdebugYAML) THEN PRINT '(a,i0,4a)', 'keystring ',i,' = ', TRIM(keystring), & & ', value = ', TRIM(S(i)%value) END IF END IF ! ! Otherwise, process a non-block list. ! ELSE ! ! Process a flow sequence: S(1)%value to S(nvalues)%value. ! IF (self%list(ipair)%is_sequence) THEN Lstr=LEN_TRIM(Vstring) nvalues=COUNT((/(Vstring(j:j), j=1,Lstr)/) == CHAR(44)) + 1 ! ALLOCATE ( S(nvalues) ) S(i)%has_vector=.FALSE. ! is=1 DO j=1,nvalues icomma=INDEX(Vstring,CHAR(44),BACK=.FALSE.) ie=icomma IF (icomma.eq.0) THEN ie=LEN_TRIM(Vstring) ELSE ie=ie-1 END IF IF (yaml_Error(yaml_AssignString(S(j)%value, & & Vstring(is:ie), & & LenStr), & & NoErr, __LINE__, MyFile)) RETURN IF (icomma.gt.0) Vstring(is:ie+1)=REPEAT(CHAR(32),ie-is+2) Vstring=TRIM(ADJUSTL(Vstring)) IF (yaml_Master.and.LdebugYAML) THEN PRINT '(a,i0,4a)', 'keystring ',j,' = ', & & TRIM(keystring), & & ', value = ', TRIM(S(j)%value) END IF END DO ! ! Process a single scalar value, S(1)%value. ! ELSE ! ALLOCATE ( S(1) ) S(1)%has_vector=.FALSE. ! IF (yaml_Error(yaml_AssignString(S(1)%value, & & Vstring, LenStr), & & NoErr, __LINE__, MyFile)) RETURN IF (yaml_Master.and.LdebugYAML) THEN PRINT '(4a)', 'keystring = ', TRIM(keystring), & & ', value = ', TRIM(S(1)%value) END IF END IF END IF END DO ! !----------------------------------------------------------------------- ! Deallocate local variables. !----------------------------------------------------------------------- ! IF (ALLOCATED(K)) DEALLOCATE (K) IF (ALLOCATED(P)) DEALLOCATE (P) IF (ALLOCATED(Kstring)) DEALLOCATE (Kstring) IF (ALLOCATED(Vstring)) DEALLOCATE (Vstring) ! 10 FORMAT (/," YAML_TREE_EXTRACT - Cannot find key-string: '",a, & & "'",/,21x,'File: ',a) 20 FORMAT (/," YAML_TREE_EXTRACT - Not supported key-string: '",a, & & "'",/,21x,'nested sub-blocking in a leading blocking ', & & 'list',/,21x,'File: ',a) ! RETURN END FUNCTION yaml_tree_extract ! SUBROUTINE yaml_tree_fill (self) ! !*********************************************************************** ! ! ! It reads YAML file and fills structure with the key/value pairs. ! ! Both the key and value pairs are strings. The numercal convertions ! ! are done elsewhere when needed. ! ! ! ! Arguments: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(inout) :: self ! ! Local variable declarations. ! logical :: Lswitch(Ldim) ! integer :: Nblanks, LenStr, left_padding, new_parent, old_parent integer :: i, ibranch, icount, ic_alias, ic_anchor, status ! character (len=Lkey) :: anchor, key character (len=Lmax) :: line, value ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_tree_fill" ! !----------------------------------------------------------------------- ! Read and populate YAML structure. !----------------------------------------------------------------------- ! ibranch=0 icount=0 ic_alias=0 ic_anchor=0 new_parent=0 old_parent=0 ! YAML_LINE : DO WHILE (.TRUE.) ! status=self%read_line(Nblanks, line, key, value, anchor, & & Lswitch) ! SELECT CASE (status) CASE (-1) ! error condition during reading yaml_ErrFlag=4 IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) self%filename, & & TRIM(line) RETURN END IF CASE (0) ! end-of-file EXIT CASE (1) ! blank or comment line, move to the next line CYCLE CASE (2) ! processed viable line icount=icount+1 END SELECT ! ! Determine structure indices according to the nested levels counters. ! IF (Nblanks.eq.0) THEN ibranch=ibranch+1 new_parent=icount old_parent=icount END IF ! ! Load YAML pair switch identifiers. ! self%list(icount)%has_alias = Lswitch(1) self%list(icount)%has_anchor = Lswitch(2) self%list(icount)%is_block = Lswitch(3) self%list(icount)%is_sequence = Lswitch(4) self%list(icount)%is_logical = Lswitch(5) self%list(icount)%is_integer = Lswitch(6) self%list(icount)%is_real = Lswitch(7) self%list(icount)%is_string = Lswitch(8) ! IF (Lswitch(1)) ic_alias=ic_alias+1 IF (Lswitch(2)) ic_anchor=ic_anchor+1 ! ! Set left-padding indentation level: 0, 1, 2, ... ! left_padding=Nblanks/self%indent self%list(icount)%left_padding=left_padding ! ! Load key/value ID and parent ID. ! IF (Nblanks.gt.0) THEN IF (left_padding.gt.self%list(icount-1)%left_padding) THEN new_parent=old_parent old_parent=icount END IF END IF self%list(icount)%id=icount self%list(icount)%parent_id=new_parent ! ! Allocate and load line, key, and value strings. If applicable, loal ! anchor value. Notice that it is possible to have keyword without ! value in the main branches. ! IF (yaml_Error(yaml_AssignString(self%list(icount)%line, & & line, LenStr), & & NoErr, __LINE__, MyFile)) RETURN ! IF (yaml_Error(yaml_AssignString(self%list(icount)%key, & & key, LenStr), & & NoErr, __LINE__, MyFile)) RETURN ! IF (LEN_TRIM(value).gt.0) THEN IF (yaml_Error(yaml_AssignString(self%list(icount)%value, & & value, LenStr), & & NoErr, __LINE__, MyFile)) RETURN END IF ! IF (Lswitch(2).and.LEN_TRIM(anchor).gt.0) THEN IF (yaml_Error(yaml_AssignString(self%list(icount)%anchor, & & anchor, LenStr), & & NoErr, __LINE__, MyFile)) RETURN END IF ! END DO YAML_LINE ! ! Substitute 'Alias' with 'Anchor' values. Notice that Anchors and ! Aliases let you identify an item with an 'anchor' in a YAML pair, ! and then refer to that item with an alias later in the same tile. ! It is done to avoid repetitions and errors. ! IF ((ic_alias.gt.0).and.(ic_anchor.gt.0)) THEN CALL self%fill_aliases (ic_alias, ic_anchor) END IF ! ! Close YAML file. ! CLOSE (iunit) ! 10 FORMAT (/,' YAML_TREE_FILL - Error while reading YAML file: ', & & a,/,18x,'LINE: ',a) ! RETURN END SUBROUTINE yaml_tree_fill ! SUBROUTINE yaml_tree_fill_aliases (self, Nalias, Nanchor) ! !*********************************************************************** ! ! ! It replaces the Aliases items with its respective Anchors values in ! ! YAML dictionary. ! ! ! ! Arguments: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! Nalias Number of Aliases items in YAML file (integer) ! ! Nanchors Number of Anchors in YAML file (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(inout) :: self integer, intent(in) :: Nalias integer, intent(in) :: Nanchor ! ! Local variable declarations. ! logical :: Lswitch(Ldim) ! integer :: Ialias, LenStr, i, j, ic ! character (len=Lkey), dimension(Nanchor) :: AnchorKey, AnchorVal character (len=Lmax) :: AliasVal ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_tree_fill_aliases" ! !----------------------------------------------------------------------- ! Extract Anchors keyword and value. !----------------------------------------------------------------------- ! ic=0 DO i=1,self%Npairs IF (self%list(i)%has_anchor) THEN ic=ic+1 AnchorKey(ic)=self%list(i)%anchor AnchorVal(ic)=self%list(i)%value END IF END DO ! !----------------------------------------------------------------------- ! Replace Aliases with associate Anchors values. !----------------------------------------------------------------------- ! DO j=1,self%Npairs ! ! Get Aliases keyword. ! IF (self%list(j)%has_alias) THEN AliasVal=self%list(j)%value Ialias=INDEX(AliasVal,CHAR(42),BACK=.FALSE.) ! alias '*' IF (Ialias.gt.0) THEN AliasVal(Ialias:Ialias)=CHAR(32) ! blank AliasVal=TRIM(ADJUSTL(AliasVal)) END IF ! ! Replace Aliases with anchor values and update value type. ! DO i=1,ic IF (TRIM(AliasVal).eq.TRIM(AnchorKey(i))) THEN DEALLOCATE (self%list(j)%value) IF (yaml_Error(yaml_AssignString(self%list(j)%value, & & TRIM(AnchorVal(i)), & & LenStr), & & NoErr, __LINE__, MyFile)) RETURN ! Lswitch=.FALSE. CALL yaml_ValueType (self%list(j)%value, Lswitch) self%list(j)%is_logical = Lswitch(5) self%list(j)%is_integer = Lswitch(6) self%list(j)%is_real = Lswitch(7) self%list(j)%is_string = Lswitch(8) END IF END DO END IF END DO ! RETURN END SUBROUTINE yaml_tree_fill_aliases ! FUNCTION yaml_tree_has (self, keystring) RESULT (FoundIt) ! !*********************************************************************** ! ! ! It checks if YAML dictionary has requested key string. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! ! ! keystring Requested YAML key-string (string) ! ! ! ! On Output: ! ! ! ! FoundIt Switch indicating if the key string was found or not ! ! in the YAML dictionary. ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(inout) :: self character (len=*), intent(in ) :: keystring ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: K(:) ! logical :: foundit ! integer :: Lstr, LenStr integer :: i, idot, ie, is, j, nkeys ! character (len=:), allocatable :: Kstring character (len=*), parameter :: MyFile = & & __FILE__//", yaml_tree_has" ! !----------------------------------------------------------------------- ! Check if requested key-string is available in YAML dictionary !----------------------------------------------------------------------- ! FoundIt=.FALSE. ! ! Count number of keys in key-string, separated by period, CHAR(46). ! Lstr=LEN_TRIM(keystring) IF (yaml_Error(yaml_AssignString(Kstring, & & keystring, LenStr), & & NoErr, __LINE__, MyFile)) RETURN ! nkeys=yaml_CountKeys(Kstring, CHAR(46)) ! ! Check single key. ! IF (nkeys.eq.1) THEN DO i=1,SIZE(self%list) IF (self%list(i)%key.eq.Kstring) THEN FoundIt=.TRUE. EXIT END IF END DO DEALLOCATE (Kstring) RETURN ! ! Otherwise, check for compound key separated by period. ! ELSE ALLOCATE ( K(nkeys) ) ! ! Extract keys. ! is=1 DO j=1,nkeys idot=INDEX(Kstring,CHAR(46),BACK=.FALSE.) ie=idot IF (idot.eq.0) THEN ie=LEN_TRIM(Kstring) ELSE ie=ie-1 END IF IF (yaml_Error(yaml_AssignString(K(j)%value, & & Kstring(is:ie), LenStr), & & NoErr, __LINE__, MyFile)) RETURN IF (idot.gt.0) Kstring(is:ie+1) = REPEAT(CHAR(32), ie-is+2) Kstring=TRIM(ADJUSTL(Kstring)) END DO ! ! Check for compound key: val1.val2 ... ! (It fails if any of the compound keys is not found) ! is=1 DO j=1,nkeys FoundIt=.FALSE. DO i=is,SIZE(self%list) IF (self%list(i)%key.eq.K(j)%value) THEN FoundIt=.TRUE. is=i+1 EXIT END IF END DO IF (.not.FoundIt) EXIT END DO DEALLOCATE (K, Kstring) RETURN END IF ! END FUNCTION yaml_tree_has ! FUNCTION yaml_tree_read_line (self, Nblanks, line, key, value, & & anchor, Lswitch) & & RESULT (status) ! !*********************************************************************** ! ! ! It reads a single text line from current YAML file. It uses the ! ! ASCII character set extensively. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! ! ! On Output: ! ! ! ! Nblanks YAML leading blanks identation (integer) ! ! ! ! line Current YAML file line (string) ! ! ! ! key YAML line keyword (string) ! ! ! ! value YAML line keyword value (string) ! ! ! ! anchor YAML value ancher keyword (string) ! ! ! ! Lswitch YAML key/value switches (logical, vector) ! ! ! ! Lswitch(1) = T/F, value has an alias '*' token ! ! Lswitch(2) = T/F, value has an anchor '&' token ! ! Lswitch(3) = T/F, key/value starts a block '-' ! ! Lswitch(4) = T/F, value has sequence '[...]' tokens ! ! Lswitch(5) = T/F, logical value(s) ! ! Lswitch(6) = T/F, integer value(s) ! ! Lswitch(7) = T/F, floating-point value(s) ! ! Lswitch(8) = T/F, string value(s) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(inout) :: self ! logical, intent(out) :: Lswitch(:) ! integer, intent(out) :: Nblanks ! character (len=*), intent(out) :: line character (len=*), intent(out) :: key character (len=*), intent(out) :: value character (len=*), intent(out) :: anchor ! ! Local variable declarations. ! logical :: Lbracket, Rbracket ! integer :: Ialias, Ianchor, Iblank, Icolon, Idash, Ihash, Ispace integer :: IbracketL, IbracketR integer :: Lstr, LstrNext, LstrVal, i, j, k integer :: status ! character (len=Lmax) :: linecopy, next_line character (len=*), parameter :: MyFile = & & __FILE__//", yaml_tree_read_line" ! !----------------------------------------------------------------------- ! Read a single YAML file line !----------------------------------------------------------------------- ! ! Initialize. ! status=-1 ! error condition ! DO i=1,LEN(key) key(i:i)=CHAR(32) END DO DO i=1,LEN(value) value(i:i)=CHAR(32) END DO DO i=1,LEN(anchor) anchor(i:i)=CHAR(32) END DO ! Lswitch=.FALSE. Lbracket=.FALSE. Rbracket=.FALSE. ! ! Read in next YAML file line. ! READ (iunit,'(a)',ERR=10,END=20) line ! ! Replace illegal control characters with a blank space CHAR(32) ! Lstr=LEN_TRIM(line) DO i=1,LEN_TRIM(line) j=ICHAR(line(i:i)) IF (j.lt.32) THEN line(i:i)=CHAR(32) END IF END DO linecopy=TRIM(ADJUSTL(line)) ! ! Get length of "line". Remove comment after the KEYWORD, if any. ! In YAML, a comment starts with a hash (#), CHAR(35). ! IF ((Lstr.gt.0).and.(linecopy(1:1).ne.CHAR(35))) THEN Ihash=INDEX(line,CHAR(35),BACK=.FALSE.) IF (Ihash.gt.0) THEN Lstr=Ihash-1 line=TRIM(line(1:Lstr)) ! remove trailing comment Lstr=LEN_TRIM(line) END IF status=2 ! viable line ELSE status=1 ! blank or commented line, RETURN ! move to the next line END IF ! ! Find colon sign CHAR(58) and determine the number of leading blank ! spaces. YAML uses indentations with one or more spaces to describe ! nested collections (lists, mappings). YAML also uses dash plus space, ! '- ', as enumerator of block lists. ! ! It checks if the KEYWORD is a multi-word separated by space. ! Icolon=INDEX(line,CHAR(58),BACK=.FALSE.) IF (Icolon.eq.0) THEN status=-1 yaml_ErrFlag=2 IF (yaml_Master) THEN WRITE (yaml_stdout,30) TRIM(line) END IF IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) RETURN END IF ! Idash =INDEX(line,CHAR(45),BACK=.FALSE.) IF ((Idash.gt.0).and.(Idash.lt.Icolon)) THEN Iblank=INDEX(line(1:Idash),CHAR(32),BACK=.TRUE.) ELSE Iblank=INDEX(line(1:Icolon),CHAR(32),BACK=.TRUE.) IF (Iblank.gt.0) THEN k=Iblank-1 IF ((65.le.ICHAR(line(1:1))).and. & & (ICHAR(line(1:1)).le.122)) THEN ! multi-word branch key Iblank=0 ELSE IF ((65.le.ICHAR(line(k:k))).and. & & (ICHAR(line(k:k)).le.122)) THEN ! multi-word pair key Iblank=INDEX(line(1:k),CHAR(32),BACK=.TRUE.) END IF END IF END IF ! ! Set number of YAML line leading blacks. ! Nblanks=Iblank ! ! Extract key and value pair and return. ! IF ((Idash.gt.0).and.(Idash.lt.Icolon)) THEN key=TRIM(ADJUSTL(line(Idash+1:Icolon-1))) ELSE key=TRIM(ADJUSTL(line(1:Icolon-1))) END IF value=TRIM(ADJUSTL(line(Icolon+1:Lstr))) ! ! Check for special YAML tokens in value string and replace with blank. ! Ialias=INDEX(value,CHAR(42),BACK=.FALSE.) ! alias '*' IF (Ialias.gt.0) THEN Lswitch(1)=.TRUE. END IF ! Ianchor=INDEX(value,CHAR(38),BACK=.FALSE.) ! anchor '&' IF (Ianchor.gt.0) THEN Ispace=INDEX(value(Ianchor+1:),CHAR(32),BACK=.FALSE.) anchor=value(Ianchor+1:Ispace) ! anchor value Lswitch(2)=.TRUE. value(Ianchor:Ispace)=REPEAT(CHAR(32),Ispace-Ianchor+1) value=TRIM(ADJUSTL(value)) END IF ! IF ((Idash.gt.0).and.(Idash.lt.Icolon)) THEN Lswitch(3)=.TRUE. ! block pair '- ' END IF ! IbracketL=INDEX(value,CHAR(91),BACK=.FALSE.) ! left bracket '[' IF (IbracketL.gt.0) THEN Lbracket=.TRUE. value(IbracketL:IbracketL)=CHAR(32) value=TRIM(ADJUSTL(value)) END IF ! IbracketR=INDEX(value,CHAR(93),BACK=.FALSE.) ! right bracket ']' IF (IbracketR.gt.0) THEN Rbracket=.TRUE. value(IbracketR:IbracketR)=CHAR(32) value=TRIM(ADJUSTL(value)) END IF ! !----------------------------------------------------------------------- ! If right square bracket is not found, the key values are broken into ! multiple lines. Process the necessary lines. !----------------------------------------------------------------------- ! IF (.not.Rbracket.and.Lbracket) THEN DO WHILE (.not.Rbracket) READ (iunit,'(a)',ERR=10,END=20) next_line ! ! Replace illegal control characters with a blank space CHAR(32) ! DO i=1,LEN_TRIM(next_line) j=ICHAR(next_line(i:i)) IF (j.lt.32) THEN next_line(i:i)=CHAR(32) END IF END DO next_line=TRIM(ADJUSTL(next_line)) ! ! If applicable, remove trailing comments starting with a hash (#), ! CHAR(35). ! Ihash=INDEX(next_line,CHAR(35),BACK=.FALSE.) LstrNext=LEN_TRIM(next_line) IF ((LstrNext.gt.0).and.(Ihash.gt.0)) THEN LstrNext=Ihash-1 next_line=TRIM(next_line(1:LstrNext)) LstrNext=LEN_TRIM(next_line) END IF ! ! Aggregate new 'next_line' to previous 'line' and 'value'. ! Lstr=LEN_TRIM(line) LstrVal=LEN_TRIM(value) line=line(1:Lstr)//CHAR(32)//next_line(1:LstrNext) value=value(1:LstrVal)//CHAR(32)//next_line(1:LstrNext) ! IbracketR=INDEX(value,CHAR(93),BACK=.FALSE.) IF (IbracketR.gt.0) THEN Rbracket=.TRUE. value(IbracketR:IbracketR)=CHAR(32) value=TRIM(ADJUSTL(value)) END IF END DO END IF IF (Lbracket.and.Rbracket) Lswitch(4)=.TRUE. ! !----------------------------------------------------------------------- ! Determine value representation: logical (boolean), numerical ! (integer/reals), or string(s). Others can be added as needed. !----------------------------------------------------------------------- ! CALL yaml_ValueType (value, Lswitch) ! RETURN ! ! Read flow control determines the status flag. ! 10 status=-1 ! error during reading 20 status=0 ! end-of-file encoutered ! 30 FORMAT (/,' YAML_TREE_READ_LINE - Unable to find colon token ', & & 'after key word',/,23x,'LINE: ',a) END FUNCTION yaml_tree_read_line ! FUNCTION yaml_AssignString (OutString, InpString, Lstr) & & RESULT (ErrFlag) ! !======================================================================= ! ! ! It assigns allocatable strings. It allocates/reallocates output ! ! string variable. ! ! ! ! On Input: ! ! ! ! InpString String to be assigned (character) ! ! ! ! On Output: ! ! ! ! OutString Assigned allocatable string (character) ! ! Lstr Length allocated string (integer) ! ! ErrFlag Error flag (integer) ! ! ! !======================================================================= ! ! Imported variable declarations. ! character (len=:), allocatable, intent(inout) :: OutString character (len=*), intent(in) :: InpString integer, intent(out) :: Lstr ! ! Local variable declarations. ! integer :: ErrFlag ! !----------------------------------------------------------------------- ! Allocate output string to the size of input string. !----------------------------------------------------------------------- ! ErrFlag = -1 ! Lstr=LEN_TRIM(InpString) IF (.not.allocated(OutString)) THEN allocate ( character(LEN=Lstr) :: OutString, STAT=ErrFlag) ELSE deallocate (OutString) allocate ( character(LEN=Lstr) :: OutString, STAT=ErrFlag) END IF ! ! Assign requested value. ! OutString = InpString ! RETURN END FUNCTION yaml_AssignString ! FUNCTION yaml_CountKeys (string, token) RESULT (nkeys) ! !======================================================================= ! ! ! It counts the number of concatenated key separated by the specified ! ! token during processing extraction from YAML object. The same task ! ! can be done elegantly as: ! ! ! ! nkeys=COUNT((/ (string(i:i), i=1,Lstr) /) == token) + 1 ! ! ! ! But compilier like 'gfortran' cannot handle such abstraction. ! ! ! ! On Input: ! ! ! ! string Aggregated YAML keys (string) ! ! token Key separator (string) ! ! ! ! On Output: ! ! ! ! nkeys Number of aggregated keys (integer) ! ! ! !======================================================================= ! ! Imported variable declarations. ! character (len=*), intent(in) :: string character (len=*), intent(in) :: token ! ! Local variable declarations. ! integer :: nkeys integer :: Lstr, i ! !----------------------------------------------------------------------- ! Count number of concatenated keys in input string. !----------------------------------------------------------------------- ! nkeys=1 Lstr=LEN_TRIM(string) DO i=1,Lstr IF (string(i:i).eq.token) THEN nkeys=nkeys+1 END IF END DO ! RETURN END FUNCTION yaml_CountKeys ! FUNCTION yaml_Error (flag, NoErr, line, routine) RESULT (foundit) ! !======================================================================= ! ! ! It checks YAML execution flag against no-error code and issue a ! ! message if they are not equal. ! ! ! ! On Input: ! ! ! ! flag YAML execution flag (integer) ! ! NoErr No Error code (integer) ! ! line Calling model routine line (integer) ! ! routine Calling model routine (string) ! ! ! ! On Output: ! ! ! ! foundit The value of the result is TRUE/FALSE if the ! ! execution flag is in error. ! ! ! !======================================================================= ! ! Imported variable declarations. ! integer, intent(in) :: flag, NoErr, line character (len=*), intent(in) :: routine ! ! Local variable declarations. ! logical :: foundit ! !----------------------------------------------------------------------- ! Scan array for requested string. !----------------------------------------------------------------------- ! foundit=.FALSE. IF (flag.ne.NoErr) THEN foundit=.TRUE. IF (yaml_Master) THEN WRITE (yaml_stdout,10) flag, line, TRIM(routine) 10 FORMAT (' Found Error: ', i2.2, t20, 'Line: ', i0, & & t35, 'Source: ', a) END IF FLUSH (yaml_stdout) END IF RETURN END FUNCTION yaml_Error ! FUNCTION yaml_Get_i_struc (self, keystring, V) RESULT (status) ! !*********************************************************************** ! ! ! It loads a vector set of integers in YAML block-list structure, ! ! V(1:Nitems)%vector(1:Nvalues). If the dummy argument V structure ! ! is allocated, it deallocates/allocates the required Nitems and ! ! Nvalues dimensions. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! V Vector of integers in block list (TYPE yaml_Ivec) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring TYPE (yaml_Ivec), allocatable, intent(out) :: V(:) ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: LenStr, Nitems, Nvalues, i, n integer :: status ! character (len=Lmax) :: msg character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_i_struc" ! !----------------------------------------------------------------------- ! Extract requested key-string values. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Allocate output structure. ! Nitems=SIZE(S, DIM=1) IF (ALLOCATED(V)) DEALLOCATE (V) ALLOCATE ( V(Nitems) ) ! ! Convert string vector values to integers. ! DO n=1,Nitems IF (S(n)%has_vector) THEN Nvalues=SIZE(S(n)%vector) ALLOCATE ( V(n)%vector(Nvalues) ) DO i=1,Nvalues READ (S(n)%vector(i)%value, * ,IOSTAT=status, IOMSG=msg) & & V(n)%vector(i) IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN yaml_ErrFlag=5 IF (yaml_Master) WRITE (yaml_stdout,10) TRIM(keystring), & & S(n)%vector(i)%value, & & TRIM(msg) RETURN END IF END DO END IF END DO ! ! Deallocate local extraction structure. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_I_STRUC - Error while converting string to', & & ' integer, key: ',a,', value = ',a,/,20x,'ErrMsg: ',a) ! RETURN END FUNCTION yaml_Get_i_struc ! FUNCTION yaml_Get_l_struc (self, keystring, V) RESULT (status) ! !*********************************************************************** ! ! ! It loads a vector set of logicals in YAML block-list structure, ! ! V(1:Nitems)%vector(1:Nvalues). If the dummy argument V structure ! ! is allocated, it deallocates/allocates the required Nitems and ! ! Nvalues dimensions. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! V Vector of logicals in block list (TYPE yaml_Lvec) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring TYPE (yaml_Lvec), allocatable, intent(out) :: V(:) ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nitems, Nvalues, n, i integer :: status ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_l_struc" ! !----------------------------------------------------------------------- ! Extract requested key-string values. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Allocate output structure. ! Nitems=SIZE(S, DIM=1) IF (ALLOCATED(V)) DEALLOCATE (V) ALLOCATE ( V(Nitems) ) ! ! Convert string vector values to logicals. ! DO n=1,Nitems IF (S(n)%has_vector) THEN Nvalues=SIZE(S(n)%vector) ALLOCATE ( V(n)%vector(Nvalues) ) DO i=1,Nvalues IF (yaml_UpperCase(S(n)%vector(i)%value(1:1)).eq.'T') THEN V(n)%vector(i)=.TRUE. ELSE V(n)%vector(i)=.FALSE. END IF END DO END IF END DO ! ! Deallocate local extraction structure. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! RETURN END FUNCTION yaml_Get_l_struc ! FUNCTION yaml_Get_r_struc (self, keystring, V) RESULT (status) ! !*********************************************************************** ! ! ! It loads a vector set of real values in YAML block-list structure, ! ! V(1:Nitems)%vector(1:Nvalues). If the dummy argument V structure ! ! is allocated, it deallocates/allocates the required Nitems and ! ! Nvalues dimensions. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! V Vector of reals in block list (TYPE yaml_Rvec) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring TYPE (yaml_Rvec), allocatable, intent(out) :: V(:) ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nitems, Nvalues, i, n integer :: status ! character (len=Lmax) :: msg character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_r_struc" ! !----------------------------------------------------------------------- ! Extract requested key-string values. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Allocate output structure. ! Nitems=SIZE(S, DIM=1) IF (ALLOCATED(V)) DEALLOCATE (V) ALLOCATE ( V(Nitems) ) ! ! Convert string vector values to floating-point. ! DO n=1,Nitems IF (S(n)%has_vector) THEN Nvalues=SIZE(S(n)%vector) ALLOCATE ( V(n)%vector(Nvalues) ) DO i=1,Nvalues READ (S(n)%vector(i)%value, * ,IOSTAT=status, IOMSG=msg) & & V(n)%vector(i) IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN yaml_ErrFlag=5 IF (yaml_Master) WRITE (yaml_stdout,10) TRIM(keystring), & & S(n)%vector(i)%value, & & TRIM(msg) RETURN END IF END DO ELSE READ (S(n)%value, * ,IOSTAT=status, IOMSG=msg) & & V(n)%vector(i) IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN yaml_ErrFlag=5 IF (yaml_Master) WRITE (yaml_stdout,10) TRIM(keystring), & & S(n)%value, & & TRIM(msg) RETURN END IF END IF END DO ! ! Deallocate local extraction structure. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_R_STRUC - Error while converting string to', & & ' real, key: ',a,', value = ',a,/,20x,'ErrMsg: ',a) ! RETURN END FUNCTION yaml_Get_r_struc ! FUNCTION yaml_Get_s_struc (self, keystring, V) RESULT (status) ! !*********************************************************************** ! ! ! It loads a vector set of strings in YAML block-list structure, ! ! V(1:Nitems)%vector(1:Nvalues)%value. If the dummy argument V ! ! structure is allocated, it deallocates/allocates the required ! ! Nitems and Nvalues dimensions. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! V Vector of strings in block list (TYPE yaml_Svec) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring TYPE (yaml_Svec), allocatable, intent(out) :: V(:) ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nitems, Nvalues, n, i integer :: status ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_s_struc" ! !----------------------------------------------------------------------- ! Extract requested key-string values. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Allocate output structure. ! Nitems=SIZE(S, DIM=1) IF (ALLOCATED(V)) DEALLOCATE (V) ALLOCATE ( V(Nitems) ) ! ! Load string vector values to output structure. ! DO n=1,Nitems IF (S(n)%has_vector) THEN Nvalues=SIZE(S(n)%vector) ALLOCATE ( V(n)%vector(Nvalues) ) DO i=1,Nvalues V(n)%vector(i)%value=S(n)%vector(i)%value END DO ELSE V(n)%value=S(n)%value END IF END DO ! ! Deallocate local extraction structure. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! RETURN END FUNCTION yaml_Get_s_struc ! FUNCTION yaml_Get_ivar_0d (self, keystring, value) RESULT (status) ! !*********************************************************************** ! ! ! It gets scalar integer data from YAML dictionary object. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! value YAML value (integer; scalar) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring integer, intent(out) :: value ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nvalues, status ! character (len=Lmax) :: msg character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_ivar_0d" ! !----------------------------------------------------------------------- ! Extract requested key-string value. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Make sure that extracted value is a scalar. ! Nvalues=SIZE(S) ! IF (Nvalues.gt.1) THEN status=7 yaml_ErrFlag=status IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) keystring, Nvalues, & & self%filename RETURN END IF ! ! Convert string value to integer. ! ELSE READ (S(1)%value, *, IOSTAT=status, IOMSG=msg) value IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN yaml_ErrFlag=5 IF (yaml_Master) WRITE (yaml_stdout,20) TRIM(keystring), & & S(1)%value, TRIM(msg) RETURN END IF END IF ! ! Deallocate. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_IVAR_0D - Extracted value is not a scalar,', & & ' key-string: ',a,/,20x,'Nvalues = ',i0,/,20x,'File: ',a) 20 FORMAT (/,' YAML_GET_IVAR_0D - Error while converting string to', & & ' integer, key: ',a,', value = ',a,/,20x,'ErrMsg: ',a) ! RETURN END FUNCTION yaml_Get_ivar_0d ! FUNCTION yaml_Get_ivar_1d (self, keystring, value) RESULT (status) ! !*********************************************************************** ! ! ! It gets 1D integer data from YAML dictionary object. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! value YAML value (integer; 1D-array) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring integer, intent(out) :: value(:) ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nvalues, i, status ! character (len=Lmax) :: msg character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_ivar_1d" ! !----------------------------------------------------------------------- ! Extract requested key-string values. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Make sure that extracted value is a scalar. ! Nvalues=SIZE(S, DIM=1) ! IF (SIZE(value, DIM=1).lt.Nvalues) THEN status=7 yaml_ErrFlag=status IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) keystring, Nvalues, & & SIZE(value, DIM=1), & & self%filename RETURN END IF END IF ! ! Convert string values to integers. ! DO i=1,Nvalues READ (S(i)%value, *, IOSTAT=status, IOMSG=msg) value(i) IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN yaml_ErrFlag=5 IF (yaml_Master) WRITE (yaml_stdout,20) TRIM(keystring), & & S(i)%value, TRIM(msg) RETURN END IF END DO ! ! Deallocate. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_IVAR_1D - Inconsistent number of values,', & & ' key-string: ',a,/,20x,'YAML size = ',i0, & & ', Variable size = ',i0,/,20x,'File: ',a) 20 FORMAT (/,' YAML_GET_IVAR_1D - Error while converting string to', & & ' integer, key: ',a,', value = ',a,/,20x,'ErrMsg: ',a) ! RETURN END FUNCTION yaml_Get_ivar_1d ! FUNCTION yaml_Get_lvar_0d (self, keystring, value) RESULT (status) ! !*********************************************************************** ! ! ! It gets scalar logical data from YAML disctionary object. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! value YAML value (logical; scalar) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring logical, intent(out) :: value ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nvalues, status ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_lvar_0d" ! !----------------------------------------------------------------------- ! Extract requested key-string value. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Make sure that extracted value is a scalar. ! Nvalues=SIZE(S) ! IF (Nvalues.gt.1) THEN status=7 yaml_ErrFlag=status IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) keystring, Nvalues, & & self%filename RETURN END IF ! ! Convert string value to logical. ! ELSE IF (yaml_UpperCase(S(1)%value(1:1)).eq.'T') THEN value=.TRUE. ELSE value=.FALSE. END IF END IF ! ! Deallocate. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_LVAR_0D - Extracted value is not a scalar,', & & ' key-string: ',a,/,20x,'Nvalues = ',i0,/,20x,'File: ',a) ! RETURN END FUNCTION yaml_Get_lvar_0d ! FUNCTION yaml_Get_lvar_1d (self, keystring, value) RESULT (status) ! !*********************************************************************** ! ! ! It gets 1D logical data from YAML dictionary object. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! value YAML value (logical; 1D-array) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring logical, intent(out) :: value(:) ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nvalues, i, status ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_lvar_1d" ! !----------------------------------------------------------------------- ! Extract requested key-string values. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Make sure that extracted value is a scalar. ! Nvalues=SIZE(S, DIM=1) ! IF (SIZE(value, DIM=1).lt.Nvalues) THEN yaml_ErrFlag=7 status=yaml_ErrFlag IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) keystring, Nvalues, & & SIZE(value, DIM=1), & & self%filename RETURN END IF END IF ! ! Convert string values to logicals. ! DO i=1,Nvalues IF (yaml_UpperCase(S(i)%value(1:1)).eq.'T') THEN value(i)=.TRUE. ELSE value(i)=.FALSE. END IF END DO ! ! Deallocate. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_LVAR_1D - Inconsistent number of values,', & & ' key-string: ',a,/,20x,'YAML size = ',i0, & & ', Variable size = ',i0,/,20x,'File: ',a) ! RETURN END FUNCTION yaml_Get_lvar_1d ! FUNCTION yaml_Get_rvar_0d (self, keystring, value) RESULT (status) ! !*********************************************************************** ! ! ! It gets scalar floating-point data from YAML dictionary object. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! value YAML value (real; scalar) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring real (kind_real), intent(out) :: value ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nvalues, ie, status ! character (len=Lmax) :: msg character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_rvar_0d" ! !----------------------------------------------------------------------- ! Extract requested key-string value. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Make sure that extracted value is a scalar. ! Nvalues=SIZE(S) ! IF (Nvalues.gt.1) THEN yaml_ErrFlag=7 status=yaml_ErrFlag IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) keystring, Nvalues, & & self%filename RETURN END IF ! ! Convert string value to real. ! ELSE S(1)%value=ADJUSTL(S(1)%value) ie=LEN_TRIM(S(1)%value) READ (S(1)%value(1:ie), *, IOSTAT=status, IOMSG=msg) value IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN yaml_ErrFlag=5 IF (yaml_Master) WRITE (yaml_stdout,20) TRIM(keystring), & & S(1)%value, TRIM(msg) RETURN END IF END IF ! ! Deallocate. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_RVAR_0D - Extracted value is not a scalar,', & & ' key-string: ',a,/,20x,'Nvalues = ',i0,/,20x,'File: ',a) 20 FORMAT (/,' YAML_GET_RVAR_0D - Error while converting string to', & & ' integer, key: ',a,', value = ',a,/,20x,'ErrMsg: ',a) ! RETURN END FUNCTION yaml_Get_rvar_0d ! FUNCTION yaml_Get_rvar_1d (self, keystring, value) RESULT (status) ! !*********************************************************************** ! ! ! It gets 1D floating-point data from YAML dictionary object. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! value YAML value (real; 1D-array) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in) :: self character (len=*), intent(in) :: keystring real (kind_real), intent(out) :: value(:) ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nvalues, i, ie, status ! character (len=Lmax) :: msg character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_rvar_1d" ! !----------------------------------------------------------------------- ! Extract requested key-string values. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Make sure that extracted value is a scalar. ! Nvalues=SIZE(S, DIM=1) ! IF (SIZE(value, DIM=1).lt.Nvalues) THEN yaml_ErrFlag=7 status=yaml_ErrFlag IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) keystring, Nvalues, & & SIZE(value, DIM=1), & & self%filename RETURN END IF END IF ! ! Convert string values to reals. ! DO i=1,Nvalues S(i)%value=ADJUSTL(S(i)%value) ie=LEN_TRIM(S(i)%value) READ (S(i)%value(1:ie), *, IOSTAT=status, IOMSG=msg) value(i) IF (yaml_Error(status, NoErr, __LINE__, MyFile)) THEN yaml_ErrFlag=5 IF (yaml_Master) WRITE (yaml_stdout,20) TRIM(keystring), & & S(i)%value, TRIM(msg) RETURN END IF END DO ! ! Deallocate. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_RVAR_1D - Inconsistent number of values,', & & ' key-string: ',a,/,20x,'YAML size = ',i0, & & ', Variable size = ',i0,/,20x,'File: ',a) 20 FORMAT (/,' YAML_GET_RVAR_1D - Error while converting string to', & & ' real, key: ',a,', value = ',a,/,20x,'ErrMsg: ',a) ! RETURN END FUNCTION yaml_Get_rvar_1d ! FUNCTION yaml_Get_svar_0d (self, keystring, value) RESULT (status) ! !*********************************************************************** ! ! ! It gets scalar string data from YAML dictionary object. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! value YAML value (string; scalar) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in ) :: self character (len=*), intent(in ) :: keystring character (len=*), intent(out) :: value ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nvalues, status ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_lvar_0d" ! !----------------------------------------------------------------------- ! Extract requested key-string value. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Make sure that extracted value is a scalar. ! Nvalues=SIZE(S) ! IF (Nvalues.gt.1) THEN yaml_ErrFlag=7 status=yaml_ErrFlag IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) keystring, Nvalues, & & self%filename RETURN END IF ! ! Load string value. ! ELSE value=S(1)%value END IF ! ! Deallocate. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_SVAR_0D - Extracted value is not a scalar,', & & ' key-string: ',a,/,20x,'Nvalues = ',i0,/,20x,'File: ',a) ! RETURN END FUNCTION yaml_Get_svar_0d ! FUNCTION yaml_Get_svar_1d (self, keystring, value) RESULT (status) ! !*********************************************************************** ! ! ! It gets 1D string data from YAML dictionary object. ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary object (CLASS yaml_tree) ! ! keystring YAML tree aggregated keys (string) ! ! ! ! On Output: ! ! ! ! value YAML value (string; 1D-array) ! ! status Error code (integer) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! CLASS (yaml_tree), intent(in ) :: self character (len=*), intent(in ) :: keystring character (len=*), intent(out) :: value(:) ! ! Local variable declarations. ! TYPE (yaml_extract), allocatable :: S(:) ! integer :: Nvalues, i, status ! character (len=*), parameter :: MyFile = & & __FILE__//", yaml_Get_lvar_1d" ! !----------------------------------------------------------------------- ! Extract requested key-string values. !----------------------------------------------------------------------- ! status=NoErr ! IF (yaml_Error(self%extract(keystring, S), & & NoErr, __LINE__, MyFile)) RETURN ! ! Make sure that extracted value is a scalar. ! Nvalues=SIZE(S, DIM=1) ! IF (SIZE(value, DIM=1).lt.Nvalues) THEN yaml_ErrFlag=7 status=yaml_ErrFlag IF (yaml_Error(yaml_ErrFlag, NoErr, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (yaml_stdout,10) keystring, Nvalues, & & SIZE(value, DIM=1), & & self%filename RETURN END IF END IF ! ! Load string values. ! DO i=1,Nvalues value(i)=S(i)%value END DO ! ! Deallocate. ! IF (ALLOCATED(S)) DEALLOCATE (S) ! 10 FORMAT (/,' YAML_GET_SVAR_1D - Inconsistent number of values,', & & ' key-string: ',a,/,20x,'YAML size = ',i0, & & ', Variable size = ',i0,/,20x,'File: ',a) ! RETURN END FUNCTION yaml_Get_svar_1d ! FUNCTION yaml_LowerCase (Sinp) RESULT (Sout) ! !======================================================================= ! ! ! It converts all string elements to lowercase. ! ! ! ! Reference: ! ! ! ! Cooper Redwine, 1995: "Upgrading to Fortran 90", Springer- ! ! Verlag, New York, pp 416. ! ! ! !======================================================================= ! ! Imported variable declarations. ! character(len=*), intent(in) :: Sinp ! ! Local variable definitions. ! integer :: Lstr, i, j character (len=LEN(Sinp)) :: Sout character (len=26), parameter :: L = 'abcdefghijklmnopqrstuvwxyz' character (len=26), parameter :: U = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' ! !----------------------------------------------------------------------- ! Convert input string to lowercase. !----------------------------------------------------------------------- ! Lstr=LEN(Sinp) Sout=Sinp DO i=1,Lstr j=INDEX(U, Sout(i:i)) IF (j.ne.0) THEN Sout(i:i)=L(j:j) END IF END DO ! RETURN END FUNCTION yaml_LowerCase ! FUNCTION yaml_UpperCase (Sinp) RESULT (Sout) ! !======================================================================= ! ! ! It converts all string elements to uppercase. ! ! ! ! Reference: ! ! ! ! Cooper Redwine, 1995: "Upgrading to Fortran 90", Springer- ! ! Verlag, New York, pp 416. ! ! ! !======================================================================= ! ! Imported variable declarations. ! character (len=*), intent(in) :: Sinp ! ! Local variable definitions. ! integer :: Lstr, i, j ! character (len=LEN(Sinp)) :: Sout ! character (len=26), parameter :: L = 'abcdefghijklmnopqrstuvwxyz' character (len=26), parameter :: U = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' ! !----------------------------------------------------------------------- ! Convert input string to uppercase. !----------------------------------------------------------------------- ! Lstr=LEN(Sinp) Sout=Sinp DO i=1,Lstr j=INDEX(L, Sout(i:i)) IF (j.ne.0) THEN Sout(i:i)=U(j:j) END IF END DO ! RETURN END FUNCTION yaml_UpperCase ! SUBROUTINE yaml_ValueType (value, Lswitch) ! !*********************************************************************** ! ! ! It determines the YAML value type as logical, integer, real, or ! ! string. ! ! ! ! On Input: ! ! ! ! self YAML pair value (string) ! ! ! ! On Output: ! ! ! ! Lswitch YAML key/value switches (logical, vector) ! ! ! ! Lswitch(1) = T/F, value has an alias '*' token ! ! Lswitch(2) = T/F, value has an anchor '&' token ! ! Lswitch(3) = T/F, key/value starts a block '-' ! ! Lswitch(4) = T/F, value has sequence '[...]' tokens ! ! Lswitch(5) = T/F, logical value(s) ! ! Lswitch(6) = T/F, integer value(s) ! ! Lswitch(7) = T/F, floating-point value(s) ! ! Lswitch(8) = T/F, string value(s) ! ! ! !*********************************************************************** ! ! Imported variable declarations. ! logical, intent(inout) :: Lswitch(:) ! character (len=*), intent(inout) :: value ! ! Local variable declarations. ! integer :: Lstr, Schar integer :: colon, dot, exponent, letter, numeric, precision integer :: i, multiple ! !----------------------------------------------------------------------- ! Set keyword value type. !----------------------------------------------------------------------- ! ! Initialize. ! colon=0 dot=0 exponent=0 letter=0 multiple=0 numeric=0 precision=0 ! ! Check input value string. ! Lstr=LEN_TRIM(value) IF (Lstr.gt.0) THEN DO i=1,lstr Schar=ICHAR(value(i:i)) ! ! Check for numbers, plus, and minus signs. For example, value=-1.0E+37 ! is a floating-point numerical value. ! IF (((48.le.Schar).and.(Schar.le.57)).or. & & (Schar.eq.43).or.(Schar.eq.45)) numeric=numeric+1 ! ! Check for dot/period, CHAR(46). If period is not found in a numerical ! expression, identify value as an integer. ! IF (Schar.eq.46) dot=dot+1 ! ! Check for precision character: D=ICHAR(68) and d=ICHAR(100). For ! example, value=0.0d0 and others in the future. ! IF ((Schar.eq.69).or.(Schar.eq.101)) precision=precision+1 ! ! Check for exponent character: E=CHAR(69) and e=CHAR(101). ! IF ((Schar.eq.69).or.(Schar.eq.101)) exponent=exponent+1 ! ! Check for multiple values separate by comma, CHAR(44), in a sequence ! of values: [val1, val2, ..., valN]. ! IF (Lswitch(4)) multiple=multiple+1 ! ! Check for colon, CHAR(58). We can have value=2020-01-01T00:00:00Z, ! which has numbers, hyphen, and letters. It is the colon that makes ! it a string variable (https://www.myroms.org). ! IF (Schar.eq.58) colon=colon+1 ! ! English uppercase and lowercase alphabet. ! IF (((65.le.Schar).and.(Schar.le.90)).or. & & (Schar.eq.97).or.(Schar.eq.122)) letter=letter+1 END DO ! ! Set integer or floating-point type. ! IF ((numeric.gt.0).and.(colon.eq.0)) THEN IF ((dot.gt.0).or.(exponent.gt.0).or.(precision.gt.0)) THEN Lswitch(7)=.TRUE. ! floating-point ELSE Lswitch(6)=.TRUE. ! integer END IF ELSE IF ((value.eq.'true').or.(value.eq.'false').or. & & (value.eq.'TRUE').or.(value.eq.'FALSE')) THEN Lswitch(5)=.TRUE. ! logical ELSE IF (letter.gt.0) THEN Lswitch(8)=.TRUE. ! string END IF END IF END IF ! RETURN END SUBROUTINE yaml_ValueType ! ! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ! SUBROUTINE process_yaml (yaml_file) ! ! Imported variable declarations. ! character (len=*), intent(in) :: yaml_file ! ! Local variable declarations. ! character (len=*), parameter :: MyFile = & & __FILE__//', process_yaml' TYPE (yaml_tree) :: YML ! YAML tree structure TYPE (CouplingField), allocatable :: E(:), I(:), S(:) ! ! Create YAML object and report its content. ! IF (yaml_Error(yaml_initialize(YML, TRIM(yaml_file), Lreport), & & NoError, __LINE__, MyFile)) THEN WRITE (6,10) TRIM(yaml_file) 10 FORMAT (/,' PROCESS_YAML - Unable to create YAML object for:', & & /,13x,'FileName = ',a) RETURN END IF ! ! If CMEPS file, extract export and import states metadata. ! IF (YML%has('export').and.YML%has('import')) THEN CALL cmeps_metadata (YML, TRIM(yaml_file), 'export', E) CALL cmeps_metadata (YML, TRIM(yaml_file), 'import', I) CALL YML%destroy () ! ! If ROMS coupling file, extract export nas import state metadata. ! ELSE IF (.not.YML%has('svn_repository').and. & & YML%has('metadata')) THEN CALL coupling_metadata (YML, TRIM(yaml_file), S) ! ! IF ROMS 'varingo.yaml', extract input and output variables metadata. ! ELSE IF (YML%has('svn_repository').and. & & YML%has('metadata')) THEN CALL io_metadata (YML, TRIM(yaml_file)) END IF ! RETURN ! END SUBROUTINE process_yaml ! SUBROUTINE cmeps_metadata (self, filename, key, S) ! !======================================================================= ! ! ! It process either import or export fields which are stored as block ! ! lists (leading key/value is hyphenated) in the YAML file. The YAML ! ! file is used to configure ROMS ESMF/NUOPC 'cap' module to be run by ! ! the Community Mediator for Earth Prediction Systems (CMEPS). ! ! ! ! On Input: ! ! ! ! self YAML tree dictionary (TYPE yaml_tree) ! ! ! ! filename ROMS YAML configuration filename for CMEPS (string) ! ! ! ! key Leading blocking key to process (string), for example: ! ! 'export', 'import', or 'bulk_flux import' ! ! ! ! On Output: ! ! ! ! S Import or Export coupling fields (TYPE CouplingField) ! ! ! !======================================================================= ! ! Imported variable declarations. ! TYPE (yaml_tree), intent(inout) :: self character (len=*), intent(in ) :: filename character (len=*), intent(in ) :: key TYPE (CouplingField), allocatable, intent(out) :: S(:) ! ! Local variable declarations. ! integer :: i, LenStr ! character (len=*), parameter :: MyFile = & & __FILE__//", cmeps_metadata" ! !----------------------------------------------------------------------- ! Process coupling import or export metadata for CMEPS. !----------------------------------------------------------------------- ! ! If applicable, create YAML tree dictionary. ! IF (.not.ASSOCIATED(self%list)) THEN IF (yaml_Error(yaml_initialize(self, TRIM(filename), & & .FALSE.), & & NoError, __LINE__, MyFile)) THEN IF (yaml_Master) WRITE (stdout,10) TRIM(filename) RETURN END IF END IF ! ! Extract requested blocking list. ! IF (yaml_error(yaml_get(self, TRIM(key)//'.standard_name', & & Ystring1), & & NoError, __LINE__, MyFile)) RETURN Nentries=SIZE(Ystring1) ! IF (yaml_error(yaml_get(self, TRIM(key)//'.long_name', & & Ystring2), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(self, TRIM(key)//'.short_name', & & Ystring3), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(self, TRIM(key)//'.data_variables', & & Ystring4), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(self, TRIM(key)//'.source_units', & & Ystring5), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(self, TRIM(key)//'.destination_units', & & Ystring6), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(self, TRIM(key)//'.source_grid', & & Ystring7), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(self, TRIM(key)//'.destination_grid', & & Ystring8), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(self, TRIM(key)//'.connected_to', & & Ystring9), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(self, TRIM(key)//'.map_type', & & Ystring10), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(self, TRIM(key)//'.map_norm', & & Ystring11), & & NoError, __LINE__, MyFile)) RETURN ! IF (.not.allocated(Yreal1)) THEN allocate ( Yreal1(Nentries) ) END IF IF (yaml_error(yaml_get(self, TRIM(key)//'.add_offset', & & Yreal1), & & NoError, __LINE__, MyFile)) RETURN ! IF (.not.allocated(Yreal2)) THEN allocate ( Yreal2(Nentries) ) END IF IF (yaml_error(yaml_get(self, TRIM(key)//'.scale', & & Yreal2), & & NoError, __LINE__, MyFile)) RETURN IF (.not.allocated(Yreal1)) THEN allocate ( Yreal1(Nentries) ) END IF ! IF (.not.allocated(Ylogical1)) THEN allocate ( Ylogical1(Nentries) ) END IF IF (yaml_error(yaml_get(self, TRIM(key)//'.debug_write', & & Ylogical1), & & NoError, __LINE__, MyFile)) RETURN ! ! Load metadata into output structure. ! IF (.not.allocated(S)) allocate ( S(Nentries) ) ! DO i=1,Nentries S(i)%debug_write = Ylogical1(i) S(i)%add_offset = Yreal1(i) S(i)%scale = Yreal2(i) ! IF (yaml_error(yaml_AssignString(S(i)%standard_name, & & Ystring1(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%long_name, & & Ystring2(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%short_name, & & Ystring3(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%data_netcdf_vname, & & Ystring4(i)%vector(1)%value, & & LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%data_netcdf_tname, & & Ystring4(i)%vector(2)%value, & & LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%source_units, & & Ystring5(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%destination_units, & & Ystring6(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%source_grid, & & Ystring7(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%destination_grid, & & Ystring8(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%connected_to, & & Ystring9(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN IF (yaml_LowerCase(S(i)%connected_to).eq.'false') THEN S(i)%connected=.FALSE. ELSE S(i)%connected=.TRUE. END IF ! IF (yaml_error(yaml_AssignString(S(i)%map_type, & & Ystring10(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%map_norm, & & Ystring11(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN END DO ! ! Deallocate generic structures. ! IF (allocated(Ystring1 )) deallocate (Ystring1 ) IF (allocated(Ystring2 )) deallocate (Ystring2 ) IF (allocated(Ystring3 )) deallocate (Ystring3 ) IF (allocated(Ystring4 )) deallocate (Ystring4 ) IF (allocated(Ystring5 )) deallocate (Ystring5 ) IF (allocated(Ystring6 )) deallocate (Ystring6 ) IF (allocated(Ystring7 )) deallocate (Ystring7 ) IF (allocated(Ystring8 )) deallocate (Ystring8 ) IF (allocated(Ystring9 )) deallocate (Ystring9 ) IF (allocated(Ystring10)) deallocate (Ystring10) IF (allocated(Ystring11)) deallocate (Ystring11) IF (allocated(Ylogical1)) deallocate (Ylogical1) IF (allocated(Yreal1)) deallocate (Yreal1) IF (allocated(Yreal2)) deallocate (Yreal2) ! ! Report. ! IF (yaml_Master.and.LdebugMetadata) THEN WRITE (stdout,'(/,3a,/,3a)') & & "Coupling Metadata Dictionary, key: '", TRIM(key), "',", & & REPEAT('=',28), ' File: ', TRIM(filename) DO i=1,SIZE(S) WRITE (stdout,'(/,a,a)') ' - standard_name: ', & & TRIM(S(i)%standard_name) WRITE (stdout,'(a,a)') ' long_name: ', & & TRIM(S(i)%long_name) WRITE (stdout,'(a,a)') ' short_name: ', & & TRIM(S(i)%short_name) WRITE (stdout,'(a,a)') ' data_netcdf_variable: ', & & TRIM(S(i)%data_netcdf_vname) WRITE (stdout,'(a,a)') ' data_netcdf_time: ', & & TRIM(S(i)%data_netcdf_tname) WRITE (stdout,'(a,a)') ' source_units: ', & & TRIM(S(i)%source_units) WRITE (stdout,'(a,a)') ' destination_units: ', & & TRIM(S(i)%destination_units) WRITE (stdout,'(a,a)') ' source_grid: ', & & TRIM(S(i)%source_grid) WRITE (stdout,'(a,a)') ' destination_grid: ', & & TRIM(S(i)%destination_grid) WRITE (stdout,'(a,1p,e15.8)') ' add_offset: ', & & S(i)%add_offset WRITE (stdout,'(a,1p,e15.8)') ' scale: ', & & S(i)%scale WRITE (stdout,'(a,l1)') ' debug_write: ', & & S(i)%debug_write WRITE (stdout,'(a,l1)') ' connected: ', & & S(i)%connected WRITE (stdout,'(a,a)') ' connected_to: ', & & TRIM(S(i)%connected_to) WRITE (stdout,'(a,a)') ' map_type: ', & & TRIM(S(i)%map_type) WRITE (stdout,'(a,a)') ' map_norm: ', & & TRIM(S(i)%map_norm) END DO FLUSH (stdout) END IF ! 10 FORMAT (/,' CMEPS_METADATA - Unable to create YAML object for', & & ' ROMS/CMEPS configuration metadata file: ',/,21x,a,/, & & 21x,'Default file is located in source directory.') ! RETURN END SUBROUTINE cmeps_metadata ! SUBROUTINE coupling_metadata (YML, filename, S) ! !======================================================================= ! ! ! It processes import and export field dictionary for ROMS coupling ! ! system with the ESMF/NUOPC library. If processes field metadata ! ! entry-by-entry from 'coupling_*.yaml'. ! ! ! ! On Input: ! ! ! ! YML YAML tree dictionary (TYPE yaml_tree) ! ! ! ! filename Coupling metadata filename (string) ! ! ! ! On Output: ! ! ! ! S Import/Export coupling fields (TYPE CouplingField) ! ! ! !======================================================================= ! ! Imported variable declarations. ! character (len=*), intent(in) :: filename ! TYPE (yaml_tree), intent(inout) :: YML TYPE (CouplingField), allocatable, intent(out) :: S(:) ! ! Local variable declarations. ! integer :: i ! character (len=*), parameter :: MyFile = & & __FILE__//", coupling_metadata" ! !----------------------------------------------------------------------- ! Process coupling import/export metadata. !----------------------------------------------------------------------- ! ! Create YAML dictionary. ! Ientry=0 ! ! Extract key/value pair (blocking list). ! IF (yaml_error(yaml_get(YML, 'metadata.standard_name', & & Ystring1), & & NoError, __LINE__, MyFile)) RETURN Nentries=SIZE(Ystring1) ! IF (yaml_error(yaml_get(YML, 'metadata.long_name', & & Ystring2), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.short_name', & & Ystring3), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.data_variables', & & Ystring4), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.source_units', & & Ystring5), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.destination_units', & & Ystring6), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.source_grid', & & Ystring7), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.destination_grid', & & Ystring8), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.connected_to', & & Ystring9), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.regrid_method', & & Ystring10), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.extrapolate_method', & & Ystring11), & & NoError, __LINE__, MyFile)) RETURN ! IF (allocated(Yreal1)) deallocate (Yreal1) allocate ( Yreal1(Nentries) ) IF (yaml_error(yaml_get(YML, 'metadata.add_offset', & & Yreal1), & & NoError, __LINE__, MyFile)) RETURN ! IF (allocated(Yreal2)) deallocate (Yreal2) allocate ( Yreal2(Nentries) ) IF (yaml_error(yaml_get(YML, 'metadata.scale', & & Yreal2), & & NoError, __LINE__, MyFile)) RETURN ! IF (allocated(Ylogical1)) deallocate (Ylogical1) allocate ( Ylogical1(Nentries) ) IF (yaml_error(yaml_get(YML, 'metadata.debug_write', & & Ylogical1), & & NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Load metadata information from YAML structures. !----------------------------------------------------------------------- ! IF (.not.allocated(S)) allocate ( S(Nentries) ) ! DO i=1,Nentries S(i)%debug_write = Ylogical1(i) S(i)%add_offset = Yreal1(i) S(i)%scale = Yreal2(i) ! IF (yaml_error(yaml_AssignString(S(i)%standard_name, & & Ystring1(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%long_name, & & Ystring2(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%short_name, & & Ystring3(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%data_netcdf_vname, & & Ystring4(i)%vector(1)%value, & & LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%data_netcdf_tname, & & Ystring4(i)%vector(2)%value, & & LenStr), & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%source_units, & & Ystring5(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%destination_units, & & Ystring6(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%source_grid, & & Ystring7(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%destination_grid, & & Ystring8(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%connected_to, & & Ystring9(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN IF (yaml_LowerCase(S(i)%connected_to).eq.'false') THEN S(i)%connected=.FALSE. ELSE S(i)%connected=.TRUE. END IF ! IF (yaml_error(yaml_AssignString(S(i)%regrid_method, & & Ystring10(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_AssignString(S(i)%extrapolate_method, & & Ystring11(i)%value, LenStr), & & NoError, __LINE__, MyFile)) RETURN END DO ! ! Deallocate generic structures. ! CALL YML%destroy () IF (allocated(Ystring1 )) deallocate (Ystring1 ) IF (allocated(Ystring2 )) deallocate (Ystring2 ) IF (allocated(Ystring3 )) deallocate (Ystring3 ) IF (allocated(Ystring4 )) deallocate (Ystring4 ) IF (allocated(Ystring5 )) deallocate (Ystring5 ) IF (allocated(Ystring6 )) deallocate (Ystring6 ) IF (allocated(Ystring7 )) deallocate (Ystring7 ) IF (allocated(Ystring8 )) deallocate (Ystring8 ) IF (allocated(Ystring9 )) deallocate (Ystring9 ) IF (allocated(Ystring10)) deallocate (Ystring10) IF (allocated(Ystring11)) deallocate (Ystring11) IF (allocated(Ylogical1)) deallocate (Ylogical1) IF (allocated(Yreal1)) deallocate (Yreal1) IF (allocated(Yreal2)) deallocate (Yreal2) ! ! Report. ! IF (yaml_Master.and.LdebugMetadata) THEN WRITE (stdout,'(/,2a,/,a)') & & 'Coupling Metadata Dictionary, File: ', & & TRIM(filename), REPEAT('=',28) DO i=1,SIZE(S) WRITE (stdout,'(/,a,a)') ' - standard_name: ', & & TRIM(S(i)%standard_name) WRITE (stdout,'(a,a)') ' long_name: ', & & TRIM(S(i)%long_name) WRITE (stdout,'(a,a)') ' short_name: ', & & TRIM(S(i)%short_name) WRITE (stdout,'(a,a)') ' data_netcdf_variable: ', & & TRIM(S(i)%data_netcdf_vname) WRITE (stdout,'(a,a)') ' data_netcdf_time: ', & & TRIM(S(i)%data_netcdf_tname) WRITE (stdout,'(a,a)') ' source_units: ', & & TRIM(S(i)%source_units) WRITE (stdout,'(a,a)') ' destination_units: ', & & TRIM(S(i)%destination_units) WRITE (stdout,'(a,a)') ' source_grid: ', & & TRIM(S(i)%source_grid) WRITE (stdout,'(a,a)') ' destination_grid: ', & & TRIM(S(i)%destination_grid) WRITE (stdout,'(a,1p,e15.8)') ' add_offset: ', & & S(i)%add_offset WRITE (stdout,'(a,1p,e15.8)') ' scale: ', & & S(i)%scale WRITE (stdout,'(a,l1)') ' debug_write: ', & & S(i)%debug_write WRITE (stdout,'(a,l1)') ' connected: ', & & S(i)%connected WRITE (stdout,'(a,a)') ' connected_to: ', & & TRIM(S(i)%connected_to) WRITE (stdout,'(a,a)') ' regrid_method: ', & & TRIM(S(i)%regrid_method) WRITE (stdout,'(a,a)') ' extrapolate_method: ', & & TRIM(S(i)%extrapolate_method) END DO FLUSH (stdout) END IF ! RETURN ! 10 FORMAT (/,' COUPLING_METADATA - Unable to create YAML object', & & ' for ROMS I/O metadata file: ',/,21x,a,/, & & 21x,'Default file is located in source directory.') ! END SUBROUTINE coupling_metadata ! SUBROUTINE io_metadata (YML, filename) ! !======================================================================= ! ! ! It processes ROMS input/output fields metadata entry-by-entry from ! ! YAML tree dictionary. ! ! ! ! On Input: ! ! ! ! YML YAML tree dictionary (TYPE yaml_tree) ! ! ! ! filename ROMS I/O metadata filename (string) ! ! ! ! It reports internal variables metadata: ! ! ! ! Vinfo I/O Variable information (string array) ! ! Vinfo(1): Field variable short-name ! ! Vinfo(2): Long-name attribute ! ! Vinfo(3): Units attribute ! ! Vinfo(4): Field attribute ! ! Vinfo(5): Associated time variable name ! ! Vinfo(6): Standard-name attribute ! ! Vinfo(7): Staggered C-grid variable type: ! ! 'nulvar' => non-grided variable ! ! 'p2dvar' => 2D PHI-variable ! ! 'r2dvar' => 2D RHO-variable ! ! 'u2dvar' => 2D U-variable ! ! 'v2dvar' => 2D V-variable ! ! 'p3dvar' => 3D PSI-variable ! ! 'r3dvar' => 3D RHO-variable ! ! 'u3dvar' => 3D U-variable ! ! 'v3dvar' => 3D V-variable ! ! 'w3dvar' => 3D W-variable ! ! 'b3dvar' => 3D BED-sediment ! ! 'l3dvar' => 3D spectral light variable ! ! 'l4dvar' => 4D spectral light variable ! ! Vinfo(8): Index code for information arrays ! ! ! ! scale Scale to convert input data to model units (real) ! ! ! ! offeset Value to add to input data (real) ! ! ! ! Ldone True if end-of-file or dictionary found ! ! ! !======================================================================= ! ! Imported variable declarations. ! character (len=*), intent(in) :: filename ! TYPE (yaml_tree), intent(inout) :: YML ! ! Local variable declarations. ! integer :: i, j, n ! real (dp) :: offset, scale ! character (len=160) :: Vinfo(8) character (len=*), parameter :: MyFile = & & __FILE__//", io_metadata" ! !----------------------------------------------------------------------- ! On first pass, initialize metadata processing. !----------------------------------------------------------------------- ! ! Extract values from YML tree. ! IF (yaml_error(yaml_get(YML, 'metadata.variable', & & Ystring1), & & NoError, __LINE__, MyFile)) RETURN Nentries=SIZE(Ystring1, DIM=1) ! IF (yaml_error(yaml_get(YML, 'metadata.long_name', & & Ystring2), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.units', & & Ystring3), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.field', & & Ystring4), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.time', & & Ystring5), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.standard_name', & & Ystring6), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.type', & & Ystring7), & & NoError, __LINE__, MyFile)) RETURN ! IF (yaml_error(yaml_get(YML, 'metadata.index_code', & & Ystring8), & & NoError, __LINE__, MyFile)) RETURN ! IF (allocated(Yreal1)) deallocate (Yreal1) allocate ( Yreal1(Nentries) ) IF (yaml_error(yaml_get(YML, 'metadata.add_offset', & & Yreal1), & & NoError, __LINE__, MyFile)) RETURN ! IF (allocated(Yreal2)) deallocate (Yreal2) allocate ( Yreal2(Nentries) ) IF (yaml_error(yaml_get(YML, 'metadata.scale', & & Yreal2), & & NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Process metadata entries. !----------------------------------------------------------------------- ! ! Extract metadata information from YAML structures. ! IF (yaml_Master.and.LdebugMetadata) THEN WRITE (stdout,'(/,2a,/,a)') & & 'ROMS I/O Metadata Dictionary, File: ', & & TRIM(filename), REPEAT('=',28) ! DO n=1,Nentries DO j=1,SIZE(Vinfo) DO i=1,LEN(Vinfo(1)) Vinfo(j)(i:i)=CHAR(32) END DO END DO ! Vinfo(1)=Ystring1(n)%value ! 'variable' key Vinfo(2)=Ystring2(n)%value ! 'long_name' key Vinfo(3)=Ystring3(n)%value ! 'units' key Vinfo(4)=Ystring4(n)%value ! 'field' key Vinfo(5)=Ystring5(n)%value ! 'time' key Vinfo(6)=Ystring6(n)%value ! 'standard_name' key Vinfo(7)=Ystring7(n)%value ! 'type' key Vinfo(8)=Ystring8(n)%value ! 'index_code' key offset =Yreal1(n) ! 'add_offset' key scale =Yreal2(n) ! 'scale' key ! WRITE (stdout,'(/,a,a)') ' - variable: ', & & TRIM(Vinfo(1)) WRITE (stdout,'(a,a)') ' standard_name: ', & & TRIM(Vinfo(6)) WRITE (stdout,'(a,a)') ' long_name: ', & & TRIM(Vinfo(2)) WRITE (stdout,'(a,a)') ' units: ', & & TRIM(Vinfo(3)) WRITE (stdout,'(a,a)') ' field: ', & & TRIM(Vinfo(4)) WRITE (stdout,'(a,a)') ' time: ', & & TRIM(Vinfo(5)) WRITE (stdout,'(a,a)') ' index_code: ', & & TRIM(Vinfo(8)) WRITE (stdout,'(a,a)') ' type: ', & & TRIM(Vinfo(7)) WRITE (stdout,'(a,1p,e15.8)') ' add_offset: ', & & offset WRITE (stdout,'(a,1p,e15.8)') ' scale: ', & & scale END DO FLUSH (stdout) END IF ! ! Destroy and deallocate. ! CALL YML%destroy () IF (allocated(Ystring1)) deallocate (Ystring1) IF (allocated(Ystring2)) deallocate (Ystring2) IF (allocated(Ystring3)) deallocate (Ystring3) IF (allocated(Ystring4)) deallocate (Ystring4) IF (allocated(Ystring5)) deallocate (Ystring5) IF (allocated(Ystring6)) deallocate (Ystring6) IF (allocated(Ystring7)) deallocate (Ystring7) IF (allocated(Ystring8)) deallocate (Ystring8) IF (allocated(Yreal1)) deallocate (Yreal1) IF (allocated(Yreal2)) deallocate (Yreal2) ! RETURN END SUBROUTINE io_metadata ! !----------------------------------------------------------------------- END MODULE yaml_parser !----------------------------------------------------------------------- ! PROGRAM yaml_parser_test ! !======================================================================= ! ! ! This program can be used to test the YAML parser available in ROMS. ! ! ! !======================================================================= ! USE yaml_parser, ONLY : process_yaml ! ! Local variable definitions. ! character (len=120) :: yaml_file ! YAML filename character (len=*), parameter :: MyFile = & & __FILE__//', read_yaml' ! ! Get YAML file name. ! DO WHILE (.TRUE.) WRITE (6,10) 10 FORMAT (/,' Enter YAML filename: ',$) READ(5,'(a)',ERR=20) yaml_file ! ! Create and process YAML object. ! CALL process_yaml (TRIM(yaml_file)) END DO 20 STOP END PROGRAM yaml_parser_test