,pointer character(512):: integer:: number logical:: integer :: (:,:) (2) integer :: (:,:) (3) real(8) :: (:,:) (2) real(8) :: (:,:) (3) real(8) :: integer :: character(1024):: ! missing something type _type type( _type_array),pointer:: array(:) type( _type),pointer:: end type type _type_array type( _type),pointer:: end type type _type logical::exists end type module mod use inputdom implicit none type( _type):: contains getstruct function getstruct (thisnode) implicit none type(Node),pointer::thisnode type( _type),pointer::getstruct type(Node),pointer::np integer::len=1,i=0 allocate(getstruct ) #ifdef INPUTDEBUG write(*,*)"we are at " #endif getstruct %exists=.false. if (associated(thisnode)) getstruct %exists=.true. nullify(np) np=>getAttributeNode(thisnode," ") % = if(associated(np)) then call extractDataAttribute(thisnode," ", % ) call removeAttribute(thisnode," ") else write(*,*)"Parser ERROR: The element ' ' requires the attribute ' ' to be defined." write(*,*)"stopped" stop endif getstruct %number=stringtonumber (getstruct % ) len= countChildEmentsWithName(thisnode," ") if(len.eq.0) then write(*,*)"Parser ERROR: The element must contain at least and maximum element s " endif allocate( % array(len)) % =>null() Do i=0,len-1 % array(i+1)% =>getstruct (& removeChild(thisnode,item(getElementsByTagname(thisnode,& " "),0)) ) enddo len= countChildEmentsWithName (thisnode," ") allocate( % ( 2 3 ,len)) Do i=1,len % (:,i) =getvalueof (& removechild(thisnode,item(getElementsByTagname(thisnode,& " "),0))) end do i=0 len=0 call handleunknownnodes(thisnode) end function function getvalueof (thisnode) implicit none type(Node),pointer::thisnode getvalueof #ifdef INPUTDEBUG write(*,*)"we are at " #endif call extractDataContent(thisnode, getvalueof ) end function integer function stringtonumber (string) character(80),intent(in)::string select case(trim(adjustl(string))) case(' ') stringtonumber = case('') stringtonumber =0 case default write(*,*) "Parser ERROR: '", string,"' is not valid selection for " stop end select end function function countChildEmentsWithName(nodep,name) implicit none integer::countChildEmentsWithName type(Node),pointer ::nodep character(len=*),intent(in)::name type(NodeList),pointer::children type(Node),pointer::child integer::i children=>getChildNodes(nodep) countChildEmentsWithName=0 do i=0,getlength(children)-1 child=>item(children,i) if(name.eq.getNodeName(child)) countChildEmentsWithName=countChildEmentsWithName+1 end do end function ! these are some transient helper functions to simplify the port (should not be used) function isspinorb() logical::isspinorb isspinorb=.false. if(associated(input%groundstate%spin))then if (input%groundstate%spin%spinorb) then isspinorb=.true. endif endif end function function isspinspiral() logical::isspinspiral isspinspiral=.false. if(associated(input%groundstate%spin))then if (input%groundstate%spin%spinsprl) then isspinspiral=.true. endif endif end function function getfixspinnumber() implicit none integer::getfixspinnumber getfixspinnumber=0 if(associated(input%groundstate%spin))then getfixspinnumber=input%groundstate%spin%fixspinnumber endif end function function istetraocc() implicit none logical ::istetraocc istetraocc =.false. if(associated(input%xs)) then if(associated(input%xs%tetra)) then istetraocc=input%xs%tetra%tetraocc endif endif end function end module (/ , /) .. ""