copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r infiles *subroutine infiles () 1 implicit none * #include "cdate.cdk"
#include "nesting.cdk"
#include "filename.cdk"
* integer longueur,wkoffit external longueur,wkoffit integer cnt,i,err character*200 fn * *---------------------------------------------------------------------- * npilf = 0 cnt = 0 * open (99,FILE='process/liste_inputfiles_for_LAM') * 77 cnt=cnt+1 read (99, '(a)', end = 9120) pilot_f(cnt) goto 77 9120 npilf = cnt - 1 close(99) * do cnt = 1, npilf fn = pilot_dir(1:longueur(pilot_dir))//'/'// $ pilot_f(cnt)(1:longueur(pilot_f(cnt))) err = wkoffit(fn) if ((err.ne.1).and.(err.ne.33)) then write(6,905) pilot_f(cnt)(1:longueur(pilot_f(cnt))), $ pilot_dir(1:longueur(pilot_dir)) pilot_f (cnt) = '@#$%^&' endif end do * i=0 do cnt = 1, npilf if (pilot_f(cnt).ne.'@#$%^&') then i = i+1 pilot_f(i) = pilot_f(cnt) endif end do npilf = i * if (npilf.lt.1) then write (6,1000) pilot_dir(1:longueur(pilot_dir)) endif * ipilf = 1 un_pil = -1 * if (npilf.ge.1) then write (6,900) pilot_dir(1:longueur(pilot_dir)) do cnt=1,npilf write(6,901) pilot_f(cnt)(1:longueur(pilot_f(cnt))) end do endif * 900 format (/' Available files in directory: ',a) 901 format (4x,a) 905 format (' FILE ',a,' FROM DIRECTORY ',a, $ ' UNAVAILABLE OR NOT RPN-STD FORMAT - WILL BE REMOVED') 1000 format (' NO RPN-STD AVAILABLE IN ',a) * *--------------------------------------------------------------------- return end