File indexing completed on 2018-03-02 18:36:59 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
7127f6f26f Jean*0001 #include "CPP_OPTIONS.h"
0002
0003
0004
0005
0006
0007 SUBROUTINE PACKAGES_UNUSED_MSG( sw_name, sr_name, df_sufx )
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019 IMPLICIT NONE
0020
0021 #include "SIZE.h"
0022 #include "EEPARAMS.h"
0023
0024
0025
0026
0027
0028
0029
0030 CHARACTER*(*) sw_name, sr_name, df_sufx
0031
0032
0033
0034 INTEGER ILNBLNK
0035 EXTERNAL ILNBLNK
0036
0037
0038
0039
0040
0041
0042
0043
0044 CHARACTER*(MAX_LEN_FNAM) data_file
0045 CHARACTER*(MAX_LEN_MBUF) caller_sub
0046 CHARACTER*(MAX_LEN_MBUF) pkgLwc, pkgUpc
0047 CHARACTER*(MAX_LEN_MBUF) msgBuf
0048 INTEGER iLen, iLen1, iLen2, iLen3
0049 INTEGER myThid
0050 LOGICAL existing
0051
0052
0053 WRITE(caller_sub,'(A)') ' '
0054 WRITE(data_file, '(A)') ' '
0055
0056 iLen1 = ILNBLNK(sw_name)
0057 iLen2 = ILNBLNK(sr_name)
0058 iLen3 = ILNBLNK(df_sufx)
0059
0060 IF ( iLen1.GE.4 ) THEN
0061 iLen = iLen1 - 3
0062 pkgLwc = sw_name(4:iLen1)
0063 CALL LCASE(pkgLwc(1:iLen))
0064 pkgUpc = sw_name(4:iLen1)
0065 CALL UCASE(pkgUpc(1:iLen))
0066 WRITE(data_file,'(2A)') 'data.', sw_name(4:iLen1)
0067 ELSE
0068 iLen = 7
0069 pkgLwc = 'unknown'
0070 pkgUpc = 'UNKNOWN'
0071 ENDIF
0072 IF ( iLen2.EQ.0 ) THEN
0073 WRITE(caller_sub,'(2A)') pkgUpc(1:iLen), '_READPARMS'
0074 iLen2 = iLen + 10
0075 ELSE
0076 WRITE(caller_sub,'(2A)') sr_name(1:iLen2)
0077 ENDIF
0078 IF ( iLen3.EQ.0 ) THEN
0079 WRITE(data_file,'(2A)') 'data.', pkgLwc(1:iLen)
0080 iLen3 = 5 + iLen
0081 ELSE
0082 WRITE(data_file,'(2A)') 'data.', df_sufx(1:iLen3)
0083 iLen3 = 5 + iLen3
0084 ENDIF
0085
0086
0087
0088
0089
0090
0091
0092
0093
0094
0095
0096 myThid = 1
0097 IF ( iLen1.GE.1 ) THEN
0098 INQUIRE( FILE=data_file, EXIST=existing )
0099 IF ( existing ) THEN
0100 WRITE(msgBuf,'(5A)') '** Warning ** ', caller_sub(1:iLen2),
0101 & ': ignores "', data_file(1:iLen3), '" file since'
0102 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
0103 & SQUEEZE_RIGHT, myThid )
0104 WRITE(msgBuf,'(5A)') '** Warning ** ', caller_sub(1:iLen2),
0105 & ': ', sw_name(1:iLen1), '= F (set from "data.pkg")'
0106 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
0107 & SQUEEZE_RIGHT, myThid )
0108 ENDIF
0109 ENDIF
0110
0111 RETURN
0112 END