646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666 class(yaml_tree), intent(in) :: self
667 character (len=*), intent(in) :: keystring
668 TYPE (yaml_extract), allocatable, intent(inout) :: S(:)
669
670
671
672 TYPE (yaml_extract), allocatable :: K(:)
673
674 logical :: BlockFlow
675
676 integer :: i, ib, ic, ie, ik, ipair, is, j, li, pID
677 integer :: Lstr, LenStr, nkeys, npairs, nvalues
678 integer :: icomma, idot
679 integer :: status
680
681 integer, allocatable :: P(:)
682
683 character (len=:), allocatable :: Kstring
684 character (len=:), allocatable :: Vstring
685
686 character (len=*), parameter :: MyFile = &
687 & __FILE__//", yaml_tree_extract"
688
689
690
691
692
693 status=noerr
694
695
696
697 lstr=len_trim(keystring)
698 IF (yaml_error(yaml_assignstring(kstring, &
699 & keystring, lenstr), &
700 & noerr, __line__, myfile)) RETURN
701
702 nkeys=yaml_countkeys(kstring, char(46))
703
704
705
706 ALLOCATE ( k(nkeys) )
707
708
709
710 is=1
711 DO i=1,nkeys
712 idot=index(kstring,char(46),back=.false.)
713 ie=idot
714 IF (idot.eq.0) THEN
715 ie=len_trim(kstring)
716 ELSE
717 ie=ie-1
718 END IF
719 IF (yaml_error(yaml_assignstring(k(i)%value, &
720 & kstring(is:ie), lenstr), &
721 & noerr, __line__, myfile)) RETURN
722 IF (idot.gt.0) kstring(is:ie+1) = repeat(char(32), ie-is+2)
723 kstring=trim(adjustl(kstring))
724 END DO
725
726
727
728
729
730
731
732
733
734
735 blockflow=.false.
736 ib=0
737 ic=0
738 ik=1
739
740 DO i=1,self%Npairs
741 lstr=len_trim(self%list(i)%key)
742 IF ((self%list(i)%key).eq.(k(ik)%value)) THEN
743
744 IF (yaml_master.and.ldebugyaml) THEN
745 print '(2(a,i0,2a))', 'key ',ik,' = ', trim(k(ik)%value), &
746 & ', YAML list ',i,' = ', &
747 & trim(self%list(i)%key)
748 END IF
749
750 pid=self%list(i)%parent_id
751 IF (self%list(i)%is_block.or.self%list(pid)%is_block) THEN
752 ib=ib+1
753 END IF
754 IF (ik.eq.nkeys) THEN
755 ic=ic+1
756 IF (ib.eq.0) THEN
757 li=i
758 EXIT
759 ELSE
760 blockflow=.true.
761 END IF
762 ELSE
763 ik=ik+1
764 END IF
765 END IF
766 IF (blockflow.and.(self%list(i)%left_padding.eq.0)) THEN
767 EXIT
768 END IF
769 END DO
770 npairs=ic
771
772
773
774 IF (npairs.ne.0) THEN
775 IF (.not.ALLOCATED(p)) ALLOCATE ( p(npairs) )
776 ELSE
777 yaml_errflag=7
778 status=yaml_errflag
779 IF (yaml_error(yaml_errflag, noerr, __line__, myfile)) THEN
780 IF (yaml_master) WRITE (yaml_stdout,10) keystring, &
781 & self%filename
782 RETURN
783 END IF
784 END IF
785
786
787
788 IF (blockflow) THEN
789 ic=0
790 ik=1
791 DO i=1,self%Npairs
792 IF ((self%list(i)%key).eq.(k(ik)%value)) THEN
793 IF (ik.eq.nkeys) THEN
794 ic=ic+1
795 p(ic)=i
796 ELSE
797 ik=ik+1
798 END IF
799 END IF
800 IF ((ic.gt.0).and.(self%list(i)%left_padding.eq.0)) THEN
801 EXIT
802 END IF
803 END DO
804 ELSE
805 p(1)=li
806 END IF
807
808
809
810
811
812 DO i=1,npairs
813 ipair=p(i)
814
815
816
817 IF (yaml_error(yaml_assignstring(vstring, &
818 & self%list(ipair)%value, &
819 & lenstr), &
820 & noerr, __line__, myfile)) RETURN
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837 IF (blockflow) THEN
838
839
840
841
842 IF (self%list(ipair)%is_sequence) THEN
843 lstr=len_trim(vstring)
844 nvalues=yaml_countkeys(vstring, char(44))
845
846 IF (.not.ALLOCATED(s)) THEN
847 ALLOCATE ( s(npairs) )
848 END IF
849 IF (i.eq.1) THEN
850 s(1:npairs)%has_vector=.true.
851 END IF
852 ALLOCATE ( s(i)%vector(nvalues) )
853
854 is=1
855 DO j=1,nvalues
856 icomma=index(vstring,char(44),back=.false.)
857 ie=icomma
858 IF (icomma.eq.0) THEN
859 ie=len_trim(vstring)
860 ELSE
861 ie=ie-1
862 END IF
863 IF (yaml_error(yaml_assignstring(s(i)%vector(j)%value, &
864 & vstring(is:ie), &
865 & lenstr), &
866 & noerr, __line__, myfile)) RETURN
867
868 IF (yaml_master.and.ldebugyaml) THEN
869 print '(3a,2(i0,a),a)', 'keystring = ',trim(keystring), &
870 & ', S(', i, ')%vector(', j, ') = ', &
871 & trim(s(i)%vector(j)%value)
872 END IF
873
874 IF (icomma.gt.0) vstring(is:ie+1)=repeat(char(32),ie-is+2)
875 vstring=trim(adjustl(vstring))
876 END DO
877
878
879
880 ELSE
881
882 IF (.not.ALLOCATED(s)) THEN
883 ALLOCATE ( s(npairs) )
884 END IF
885 IF (i.eq.1) THEN
886 s(1:npairs)%has_vector=.false.
887 END IF
888
889 IF (yaml_error(yaml_assignstring(s(i)%value, &
890 & vstring, lenstr), &
891 & noerr, __line__, myfile)) RETURN
892
893 IF (yaml_master.and.ldebugyaml) THEN
894 print '(a,i0,4a)', 'keystring ',i,' = ', trim(keystring), &
895 & ', value = ', trim(s(i)%value)
896 END IF
897 END IF
898
899
900
901 ELSE
902
903
904
905 IF (self%list(ipair)%is_sequence) THEN
906 lstr=len_trim(vstring)
907 nvalues=yaml_countkeys(vstring, char(44))
908
909 IF (.not.ALLOCATED(s)) THEN
910 ALLOCATE ( s(nvalues) )
911 END IF
912 IF (i.eq.1) THEN
913 s(1:nvalues)%has_vector=.false.
914 END IF
915
916 is=1
917 DO j=1,nvalues
918 icomma=index(vstring,char(44),back=.false.)
919 ie=icomma
920 IF (icomma.eq.0) THEN
921 ie=len_trim(vstring)
922 ELSE
923 ie=ie-1
924 END IF
925 IF (yaml_error(yaml_assignstring(s(j)%value, &
926 & vstring(is:ie), &
927 & lenstr), &
928 & noerr, __line__, myfile)) RETURN
929 IF (icomma.gt.0) vstring(is:ie+1)=repeat(char(32),ie-is+2)
930 vstring=trim(adjustl(vstring))
931
932 IF (yaml_master.and.ldebugyaml) THEN
933 print '(a,i0,4a)', 'keystring ',j,' = ', &
934 & trim(keystring), &
935 & ', value = ', trim(s(j)%value)
936 END IF
937 END DO
938
939
940
941 ELSE
942
943 IF (.not.ALLOCATED(s)) THEN
944 allocate ( s(1) )
945 END IF
946 s(1)%has_vector=.false.
947
948 IF (yaml_error(yaml_assignstring(s(1)%value, &
949 & vstring, lenstr), &
950 & noerr, __line__, myfile)) RETURN
951
952 IF (yaml_master.and.ldebugyaml) THEN
953 print '(4a)', 'keystring = ', trim(keystring), &
954 & ', value = ', trim(s(1)%value)
955 END IF
956 END IF
957 END IF
958 END DO
959
960
961
962
963
964 IF (ALLOCATED(k)) DEALLOCATE (k)
965 IF (ALLOCATED(p)) DEALLOCATE (p)
966 IF (ALLOCATED(kstring)) DEALLOCATE (kstring)
967 IF (ALLOCATED(vstring)) DEALLOCATE (vstring)
968
969 10 FORMAT (/," YAML_TREE_EXTRACT - Cannot find key-string: '",a, &
970 & "'",/,21x,'File: ',a)
971 20 FORMAT (/," YAML_TREE_EXTRACT - Not supported key-string: '",a, &
972 & "'",/,21x,'nested sub-blocking in a leading blocking ', &
973 & 'list',/,21x,'File: ',a)
974
975 RETURN