| (1) function parsv(x,xval) result(f_result) | | (2) implicit none | | (3) integer, intent(in):: x(:) | | (4) integer:: length, k | | (5) real(8), intent(in), dimension(3):: xval | | (6) real(8), dimension(3):: f_result | | (7) real(8), dimension(3,size(x)):: auxv | | (8) | | (9) length = size(x) | | (10) | | (11) auxv = mynan() | | (12) f_result = auxv(:,1) | | (13) | | (14) do k=1,length | | (15) if(x(k).ge.1.and. x(k).le. 10) auxv(:,k) = [1.d0*x(k), 0.d0, 0.d0] | | (16) if(x(k).eq.11) auxv(:,k) = xval | | (17) end do | | (18) | | (19) f_result = auxv(:,1) | | (20) | | (21) do k=length-1,1,-1 | | (22) if(.not. isnan( auxv(1,k+1) ).and. narg(x(k)).eq. 0 ) then | | (23) cycle | | (24) | | (25) elseif(.not. isnan( auxv(1,k+1) ).and. narg(x(k)).eq. 1 ) then | | (26) auxv(:,k) = operf(x(k),auxv(:,k+1)) | | (27) if( isnan(auxv(1,k)) ) return | | (28) | | (29) elseif(.not. isnan( auxv(1,k+1) ).and. narg(x(k)).eq.2)then | | (30) auxv(:,k) = operf2(x(k),auxv(:,k+1:length)) | | (31) | | (32) if( isnan(auxv(1,k)) ) return | | (33) end if | | (34) end do | | (35) | | (36) f_result = auxv(:,1) | | (37) | | (38) end function parsv |
|
