model/src/packages_unused_msg.F

7127f6f26f Jean*0001 #include "CPP_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: PACKAGES_UNUSED_MSG
                0006 C     !INTERFACE:
                0007       SUBROUTINE PACKAGES_UNUSED_MSG( sw_name, sr_name, df_sufx )
                0008
                0009 C     !DESCRIPTION: \bv
                0010 C     *==============================================================*
                0011 C     | SUBROUTINE PACKAGES_UNUSED_MSG
                0012 C     | o This routine is called (within the corresponding
                0013 C     |   {PKG}_READPARAMS routine) when this {PKG} is not used; it
                0014 C     |   prints a (weak) warning if {PKG} parameter file is found.
                0015 C     *==============================================================*
                0016 C     \ev
                0017
                0018 C     !USES:
                0019       IMPLICIT NONE
                0020 C     === Global variables ===
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023
                0024 C     !INPUT/OUTPUT PARAMETERS:
                0025 C     === Routine arguments ===
                0026 C     sw_name :: package on/off switch flag name
                0027 C     sr_name :: subroutine name which calls this S/R
                0028 C     df_sufx :: package parameter file sufix (prefix='data.')
                0029 C     myThid  ::  My thread Id number
                0030       CHARACTER*(*) sw_name, sr_name, df_sufx
                0031 c     INTEGER myThid
                0032
                0033 C     !FUNCTIONS:
                0034       INTEGER  ILNBLNK
                0035       EXTERNAL ILNBLNK
                0036
                0037 C     !LOCAL VARIABLES:
                0038 C     === Local variables ===
                0039 C     caller_sub :: name of subroutine which is calling this S/R
                0040 C     data_file  :: parameter file to open and copy
                0041 C     pkgLwc     :: PKG name (Lower case)
                0042 C     pkgUpc     :: PKG name (Upper case)
                0043 C     msgBuf     :: Informational/error message buffer
                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 CEOP
                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 c       WRITE(errorMessageUnit,'(I4,3A)')
                0087 c    &        iLen1, ' >', sw_name(1:iLen1),    '<'
                0088 c       WRITE(errorMessageUnit,'(I4,3A)')
                0089 c    &        iLen2, ' >', caller_sub(1:iLen2), '<'
                0090 c       WRITE(errorMessageUnit,'(I4,3A)')
                0091 c    &        iLen3, ' >', data_file(1:iLen3),  '<'
                0092
                0093 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0094
                0095 C--   PKG exf is not used: print a (weak) warning if data_file is found
                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