1C Copyright 1981-2016 ECMWF. 2C 3C This software is licensed under the terms of the Apache Licence 4C Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. 5C 6C In applying this licence, ECMWF does not waive the privileges and immunities 7C granted to it by virtue of its status as an intergovernmental organisation 8C nor does it submit to any jurisdiction. 9C 10 11 LOGICAL FUNCTION JFINDFN3( DIRNAME, FILENAME, KLEN, KUNIT) 12C 13C----> 14C**** JFINDFN 15C 16C Purpose 17C _______ 18C 19C Completes the pathname given by a directory and filename, and 20C checks if the file exists. 21C 22C Interface 23C _________ 24C 25C LFOUND = JFINDFN( DIRNAME, FILENAME, KLEN, KUNIT) 26C 27C Input parameters 28C ________________ 29C 30C DIRNAME - the directory name. 31C FILENAME - the file name. 32C KLEN - number of characters in the name 33C 34C Output parameters 35C _________________ 36C 37C The function returns .TRUE. if the file is opened; in which case: 38C FILENAME - the full pathname. 39C KLEN - number of characters in the full pathname 40C KUNIT - the opened file descriptor (from PBOPEN). 41C 42C Otherwise it returns .FALSE. and FILENAME and KLEN are unchanged 43C 44C Common block usage 45C __________________ 46C 47C None. 48C 49C Externals 50C _________ 51C 52C PBOPEN - opens a file. 53C 54C Reference 55C _________ 56C 57C None. 58C 59C Comments 60C ________ 61C 62C None. 63C 64C Author 65C ______ 66C 67C J.D.Chambers *ECMWF* Mar 1996 68C 69C----< 70C _______________________________________________________ 71C 72 IMPLICIT NONE 73C 74C Parameters 75Cjdc INTEGER JPROUTINE 76Cjdc PARAMETER ( JPROUTINE = 30800 ) 77C 78C Subroutine arguments 79 CHARACTER*(*) DIRNAME, FILENAME 80 INTEGER KLEN, KUNIT 81C 82C Local variables 83 INTEGER IBLANK, IRET 84 CHARACTER*512 FULLPATH 85 CHARACTER*256 SAVENAME 86C 87 88C _______________________________________________________ 89C 90C* Section 1. Try the full path name.. 91C _______________________________________________________ 92C 93 100 CONTINUE 94C 95 JFINDFN3 = .TRUE. 96 SAVENAME = FILENAME 97C 98 IBLANK = INDEX(DIRNAME, ' ') - 1 99 FULLPATH = DIRNAME(1:IBLANK) // '/' // FILENAME(1:KLEN) 100 IBLANK = INDEX(FULLPATH, ' ') - 1 101 FILENAME(1:IBLANK) = FULLPATH(1:IBLANK) 102C 103Cjdc print*,'***',FILENAME(1:IBLANK),'***' 104 CALL PBOPEN3(KUNIT, FILENAME(1:IBLANK), 'r', IRET) 105 IF( IRET.NE.0 ) THEN 106 FILENAME = SAVENAME 107 JFINDFN3 = .FALSE. 108 ELSE 109 KLEN = INDEX(FULLPATH, ' ') - 1 110 FILENAME(1:KLEN) = FULLPATH(1:KLEN) 111 ENDIF 112C 113C _______________________________________________________ 114C 115C* Section 9. Return. 116C _______________________________________________________ 117C 118 900 CONTINUE 119C 120 RETURN 121 END 122