copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r bcs_ftype *integer function bcs_ftype ( ft,ftperm,datev,nav,unf ) 1,2 implicit none * character* (*) ft character*15 datev logical nav integer ftperm(3), unf * *ARGUMENTS * NAMES I/O TYPE A/S DESCRIPTION * ft I/O C S Input file type * *IMPLICIT #include "lcldim.cdk"
#include "bcsdim.cdk"
#include "ifd.cdk"
* integer nav_3df external nav_3df character*3 ft_pref character*256 fn logical mustnav integer k,n,err ** *----------------------------------------------------------------------- * 1 ft_pref = 'NON' if (ftperm(1).eq.0) then fn = '../casc/bcs_'//datev open (unf,file=fn,access='SEQUENTIAL',status='OLD', $ iostat=err,form='UNFORMATTED') else err = -1 endif if ( err.eq.0 ) then ft_pref = 'BCS' else if (ftperm(2).eq.0) then fn = '../casc/3df_filemap.txt' open (unf,file=fn,access='SEQUENTIAL',status='OLD', $ iostat=err,form='FORMATTED') else err = -1 endif if ( err.eq.0 ) then ft_pref = '3DF' else if (ftperm(3).eq.0) then fn='../bm'//datev//'_s' open (unf,file=fn,access='SEQUENTIAL',status='OLD', $ iostat=err,form='FORMATTED') else err = -1 endif if ( err.eq.0 ) ft_pref = 'BMF' endif endif * bcs_ftype = -2 if (ft_pref.eq.'NON') goto 889 * mustnav = .false. if (ft.ne.ft_pref) mustnav = .true. ft = ft_pref * mustnav = mustnav .or. nav if (ft.eq.'BMF') mustnav = .false. nav = mustnav * if (mustnav) then if (ft.eq.'3DF') then bcs_ftype = nav_3df
(unf,hx,hy,1.2) if (bcs_ftype.lt.0) goto 779 bcs_nia = ifd_niaf - ifd_niad + 1 bcs_nja = ifd_njaf - ifd_njad + 1 endif if (ft.eq.'BCS') then bcs_ftype = 0 endif else bcs_ftype = 0 endif * 779 if (ft.eq.'BCS') ftperm(1) = -1 if (ft.eq.'3DF') ftperm(2) = -1 if (ft.eq.'BMF') ftperm(3) = -1 * if (bcs_ftype.lt.0) goto 1 * if (ft.eq.'BMF') close (unf) * 889 if (bcs_ftype.eq.-2) ftperm = -1 call mc2stop
(bcs_ftype) * *----------------------------------------------------------------------- return end