! subroutine getms(mspath,dskfile,tmpdir,lnkfile) #ifdef MPI use mpi_module,only: mytid #endif implicit none c c Get file mspath from mss to dskfile, saving a link in tmpdir. c If the file already exists in tmpdir, link it to dskfile rather than c acquiring from the mss (see procedure below). c c On input (all character data types): c mspath is full mss path and file name of needed file. c dskfile is the disk file name (not a path) needed in the cwd. c tmpdir is a temporary directory in which the file is to be c searched for and saved (linked) to for possible future use. c lnkfile is "in use" if it contains non-blank characters, c otherwise it is "not in use". If lnkfile is in use, then it is the c file name to use in linking to/from tmpdir. c On output: c dskfile is in cwd, and a link has been saved to tmpdir/lnkfile c (if lnkfile is in use), or tmpdir/dskfile (if lnkfile not in use) c c Procedure: c 1. If any of the first 3 arguments are all blanks, stop with err msg c 2. If directory tmpdir does not exist, create it with global permissions c 3. If dskfile exists (cwd) AND lnkfile NOT in use, then link dskfile to c tmpdir/dskfile and return. c 4. If dskfile does not exist in cwd OR lnkfile IS in use, then: c a) if lnkfile is NOT in use, check for existence of tmpdir/dskfile, c and if it exists, link it to dskfile and return c b) if lnkfile IS in use, check for existence of tmpdir/lnkfile, c and if it exists, link it to dskfile and return c c) if neither a nor b above are satisfied, then acquire mspath from c the mss to dskfile, and link to tmpdir/dskfile (if lnkfile not in c use), or to tmpdir/lnkfile (if lnkfile is in use) c c Notes: c The use of lnkfile simply allows the file to be looked for and c saved in tmpdir with a different name than dskfile. If lnkfile c is in use, any pre-existing dskfile is not used, and is removed c before msread if msread is necessary. c No special options are used in the msread (no passwords, etc). c Ishell is used only if tmpdir has to be created; all other commands c are via fortran calls. c If the file is linked from tmpdir, any pre-existing dskfile is c removed before the link is made. c If a link to the file is saved in tmpdir, any pre-existing file there c is first removed before linking from cwd. c A warning is printed if any links fail; all other errors are fatal c and program is stopped with error message to stdout. c Length of (number of non-blank chars) tmpdir+dskfile+1 or c tmpdir+lnkfile+1 (if lnkfile is in use) must be <= mxfilelen c c B. Foster 2/95 ! 10/99: cpp conditionals for UNICOS, SGI, or AIX ! ! Args: character(len=*),intent(in) :: mspath,dskfile,tmpdir,lnkfile ! ! Local: integer,parameter :: mxfilelen = 240 ! maximum number chars in file name logical exists character(len=80) :: errmsg character(len=120) :: testfile ! ! tmpfile = tmpdir/dskfile or tmpdir/lnkdir character(len=mxfilelen) :: tmpfile,cmd integer :: istat,ier ! ! External: ! (ilink, iunlink, and isystem are in util.F) integer,external :: ilink,iunlink,isystem ! #ifdef MPI ! ! If an MPI job, only master task should execute this routine, and ! slave tasks must wait. Mytid is use-associated from the mpi module. ! #include "mpif.h" if (mytid /= 0) goto 100 ! write(6,"('getms: MPI master task: mspath = ',a)") trim(mspath) #endif c c If any of the first 3 arguments have zero length, stop with error msg: c write(6,"(' ',/72('-'),/'GETMS:')") ! write(6,"('enter getms: len_trim(dskfile)=',i3, ! | ' trim(dskfile)=$',a,'$')") len_trim(dskfile),trim(dskfile) ! subroutine getms(mspath,dskfile,tmpdir,lnkfile) ! write(6,"(' mspath = ',a)") trim(mspath) ! write(6,"(' dskfile = ',a)") trim(dskfile) ! write(6,"(' tmpdir = ',a)") trim(tmpdir) ! write(6,"(' lnkfile = ',a)") trim(lnkfile) if (len_trim(mspath).le.0) then write(6,"('>>> Bad mspath=',a)") mspath write(6,"(72('-'),/)") stop 'getms' endif if (len_trim(dskfile).le.0) then write(6,"('>>> Bad dskfile=',a)") dskfile write(6,"(72('-'),/)") stop 'getms' endif if (len_trim(tmpdir).le.0) then write(6,"('>>> Bad tmpdir=',a)") tmpdir write(6,"(72('-'),/)") stop 'getms' endif #if (MSS == 0) call get_dskfile(dskfile,tmpdir) #endif c c Construct full tmp path with file name (tmpfile = tmpdir/dskfile, if c lnkfile is zero-length, tmpdir/lnkfile otherwise): c (tmpfile may be up to mxfilelen characters long) c if (len_trim(lnkfile).gt.0) then if (len_trim(tmpdir)+len_trim(lnkfile)+1.gt.mxfilelen) then write(6,"('>>> WARNING: lengths of tmpdir+lnkfile too ', | 'long (sum must be <= 319): len_trim(tmpdir)=',i3, | ' len_trim(lnkfile)=',i3)") len_trim(tmpdir), | len_trim(lnkfile) endif write(tmpfile,"(a,'/',a)") trim(tmpdir),trim(lnkfile) else if (len_trim(tmpdir)+len_trim(dskfile)+1.gt.mxfilelen) then write(6,"('>>> WARNING: lengths of tmpdir+dskfile too ', | 'long (sum must be <= 319): len_trim(tmpdir)=',i3, | ' len_trim(dskfile)=',i3)") | len_trim(tmpdir),len_trim(dskfile) endif write(tmpfile,"(a,'/',a)") trim(tmpdir),trim(dskfile) endif c c If tmpdir does not exist, create it with global permissions: c #if defined(OSF1) ! ! Inquire(file=name,exist=exists) statement under OSF always returns false ! if "name" is a directory (presumably it must be a file name). Therefore, ! to test existence of the directory tmpdir we attempt to create a file in ! tmpdir with the "touch" command, and then inquire on that: ! write(testfile,"(a,'/test.file')") trim(tmpdir) cmd = ' ' write(cmd,"('touch ',a)") trim(testfile) istat = isystem(trim(cmd)) inquire(file=trim(testfile),exist=exists) #else inquire(file=tmpdir,exist=exists) #endif if (.not.exists) then cmd = ' ' write(cmd,"('mkdir -p -m 777 ',a)") trim(tmpdir) write(6,"('getms: mkdir command: ',a)") trim(cmd) ! ! isystem is local (util.F), and uses platform dependent escape ! functions to the shell (for AIX, isystem adds null-termination ! to the command string). ! istat = isystem(trim(cmd)) if (istat.eq.0) then write(6,"('Created ',a,' with global permissions')") + trim(tmpdir) else write(6,"('>>> WARNING: error creating tmpdir ',a, + ' istat=',i3)") trim(tmpdir),istat endif endif c c If file already exists in cwd and lnkfile not in use, save a link c in tmpdir (remove any pre-existing tmpfile): c (tmpfile = tmpdir/dskfile in this case) c inquire(file=dskfile,exist=exists) if (exists.and.len_trim(lnkfile).le.0) then write(6,"('Found file ',a,' in cwd')") trim(dskfile) ! istat = iunlink(tmpfile) ! istat = ilink(dskfile,tmpfile) c c If file not in cwd (or lnkfile was passed in), check in tmpdir: c (in this case tmpfile=tmpdir/lnkfile OR tmpdir/dskfile) c else inquire(file=tmpfile,exist=exists) c c If it exists in tmpdir, link it to cwd: c if (exists) then istat = iunlink(dskfile,0) istat = ilink(tmpfile,dskfile,1) if (istat /= 0) then write(6,"('Getms error linking to cwd: istat=',i3)") istat cmd = " " cmd = "cp "//trim(tmpfile)//" "//trim(dskfile) write(6,"('Will try copy: ',/,a)") trim(cmd) istat = isystem(cmd) if (istat==0) then write(6,"('Copy succeeded.')") else write(6,"('>>> WARNING: copy failed. istat=',i4)") istat endif endif c c If not in cwd or tmpdir, get from mss to cwd: c (if lnkfile is in use, dskfile may already exist in cwd, c so remove it first) c else write(6,"('Doing msread of mss file ',a,' to disk file ', + a,'...')") trim(mspath),trim(dskfile) istat = iunlink(dskfile,0) #if defined(UNICOS) || defined(IRIX) || defined(OSF1) || defined(AIX) #ifdef MSS ! call msread(ier,trim(dskfile),trim(mspath),' ',' ') if (ier.ne.0) then ! call mserror(errmsg) write(6,"('>>> Error from msread reading mspath ',a, + ' to diskfile ',a)") trim(mspath),trim(dskfile) write(6,"(' Error message: ',a)") errmsg write(6,"(' ',/72('-'))") stop 'getms' c c If msread was successful, save a link in tmpdir: c (remove any pre-existing copy in tmpdir) c else write(6,"('Acquired mss file ',a,' to disk file ', + a)") trim(mspath),trim(dskfile) istat = iunlink(tmpfile,0) istat = ilink(dskfile,tmpfile,1) endif ! msread return #endif #else ! ! 2/00: msread appears to be on most machines -- if OS is ! unresolved, try msrcp: ! write(6,"('>>> WARNING getms: unresolved OS cpp directive', | ' -- will try msrcp system call.')") cmd = ' ' cmd = "msrcp"//" mss:"//trim(mspath) cmd = trim(cmd)//" "//trim(dskfile) write(6,"('Executing isystem call on AIX: cmd=',/,a)") | trim(cmd) istat = isystem(cmd) ! cmd is null-terminated by isystem for aix write(6,"('After msrcp system call on AIX: istat=',i3)") istat ! Save a link on tmpfile istat = iunlink(trim(tmpfile),0) istat = ilink(dskfile,trim(tmpfile),1) write(6,"('After link to tmpfile ',a,': istat=',i3)") | trim(tmpfile),istat #endif endif ! is or is not in tmpdir endif ! is or is not in cwd write(6,"(72('-'),/)") #ifdef MPI ! ! If mpi job, slave tasks jump down here and wait for master proc: 100 continue call mpi_barrier(MPI_COMM_WORLD,ier) ! if (mytid==0) then ! write(6,"('getms MPI: master passed barrier after ', ! | ' acquiring mspath ',a)") trim(mspath) ! else ! write(6,"('getms MPI: task ',i2,' passed barrier...')") mytid ! endif #endif return end !----------------------------------------------------------------------- subroutine get_dskfile(dskfile,tmpdir) ! ! This routine is called if mss is not available (MSS==0). ! Check for existence of file dskfile in cwd. If not there, ! check for existence of tmpdir/dskfile. If not there either ! stop with error message. If tmpdir/dskfile does exist, copy ! it to the cwd. ! implicit none character(len=*) :: dskfile,tmpdir character(len=800) :: path,cmd logical :: exists integer :: istat integer,external :: isystem ! ! dskfile must be non-null: if (len_trim(dskfile).le.0) then write(6,"('>>> get_dskfile: Bad dskfile=',a)") dskfile stop 'get_dskfile' endif ! ! Check for existence of dskfile in cwd: inquire(file=dskfile,exist=exists) if (exists) then write(6,"('get_dskfile: found ',a,' in cwd.')") trim(dskfile) return else write(6,"('get_dskfile: file ',a,' not found.')") trim(dskfile) endif ! ! Check for existence of dskfile in tmpdir: if (len_trim(tmpdir).le.0) then write(6,"('>>> get_dskfile: Bad tmpdir=',a)") tmpdir stop 'get_dskfile' endif if (len_trim(dskfile)+len_trim(tmpdir) > 800) | write(6,"('>>> WARNING get_dskfile: length of dskfile+tmpdir', | ' > 800')") path = trim(tmpdir)//'/'//trim(dskfile) inquire(file=path,exist=exists) if (.not.exists) then write(6,"(/,'>>> get_dskfile: could not find tmpdir/dskfile ', | a,/)") trim(path) stop 'disk file not found' else write(cmd,"('cp ',a,' .')") trim(path) istat = isystem(trim(cmd)) if (istat.eq.0) then write(6,"('get_dskfile: copied ',a,' to cwd.')") trim(path) else write(6,"('>>> WARNING: error copying ',a, + ' to cwd: istat=',i3)") trim(path),istat endif endif end subroutine get_dskfile