model/src/packages_error_msg.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_error_msg.F,v 1.1 2007/04/28 00:15:11 jmc Exp $
C $Name:  $

#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: PACKAGES_ERROR_MSG
C     !INTERFACE:
      SUBROUTINE PACKAGES_ERROR_MSG( msg1, msg2, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE PACKAGES_ERROR_MSG
C     | o Generate error message due to failed package
C     |   dependancies check
C     *==========================================================*
C     |   This routine is called if use_PKG was true but PKG code
C     |   was not compiled (#undef ALLOW_KPG)
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     msg1   ::  package name
C     msg2   ::  package On/Off flag
C     myThid ::  My thread Id number
      CHARACTER*(*) msg1, msg2
      INTEGER myThid

C     !LOCAL VARIABLES:
C     === Local variables ===
C     msgBuf :: Informational/error message buffer
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      CHARACTER*(MAX_LEN_MBUF) msgLwc,msgUpc
      INTEGER iLen
CEOP

      iLen = LEN(msg1)
      msgLwc(1:iLen) = msg1
      msgUpc(1:iLen) = msg1
      CALL LCASE(msgLwc(1:iLen))
      CALL UCASE(msgUpc(1:iLen))
      IF ( msg2 .EQ. ' ' ) THEN
       WRITE(msgBuf,'(4A)') 'from PACKAGES_CHECK: ',
     &  'run-time control flag use',msg1,' is set'
      ELSE
       WRITE(msgBuf,'(4A)') 'from PACKAGES_CHECK: ',
     &  'run-time parameter ',msg2,' is used'
      ENDIF
      CALL PRINT_ERROR( msgBuf, myThid )
      WRITE(msgBuf,'(5A)') 'but pkg/',msgLwc(1:iLen),
     &  ' was not compiled (ALLOW_',msgUpc(1:iLen),' undef).'
      CALL PRINT_ERROR( msgBuf, myThid )
      WRITE(msgBuf,'(3A)')
     &  '==> Re-compile with pkg "',msgLwc(1:iLen),
     &  '" in file "packages.conf"'
      CALL PRINT_ERROR( msgBuf, myThid )
      CALL ALL_PROC_DIE( myThid )
      STOP 'ABNORMAL END: S/R PACKAGE_ERROR_MSG'

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/model/src/packages_error_msg.F,v 1.1 2007/04/28 00:15:11 jmc Exp $
2	C $Name: $
3
4	#include "CPP_OPTIONS.h"
5
6	CBOP
7	C !ROUTINE: PACKAGES_ERROR_MSG
8	C !INTERFACE:
9	SUBROUTINE PACKAGES_ERROR_MSG( msg1, msg2, myThid )
10
11	C !DESCRIPTION: \bv
12	C ==========================================================
13	C \| SUBROUTINE PACKAGES_ERROR_MSG
14	C \| o Generate error message due to failed package
15	C \| dependancies check
16	C ==========================================================
17	C \| This routine is called if use_PKG was true but PKG code
18	C \| was not compiled (#undef ALLOW_KPG)
19	C ==========================================================
20	C \ev
21
22	C !USES:
23	IMPLICIT NONE
24	C === Global variables ===
25	#include "SIZE.h"
26	#include "EEPARAMS.h"
27
28	C !INPUT/OUTPUT PARAMETERS:
29	C === Routine arguments ===
30	C msg1 :: package name
31	C msg2 :: package On/Off flag
32	C myThid :: My thread Id number
33	CHARACTER() msg1, msg2
34	INTEGER myThid
35
36	C !LOCAL VARIABLES:
37	C === Local variables ===
38	C msgBuf :: Informational/error message buffer
39	CHARACTER*(MAX_LEN_MBUF) msgBuf
40	CHARACTER*(MAX_LEN_MBUF) msgLwc,msgUpc
41	INTEGER iLen
42	CEOP
43
44	iLen = LEN(msg1)
45	msgLwc(1:iLen) = msg1
46	msgUpc(1:iLen) = msg1
47	CALL LCASE(msgLwc(1:iLen))
48	CALL UCASE(msgUpc(1:iLen))
49	IF ( msg2 .EQ. ' ' ) THEN
50	WRITE(msgBuf,'(4A)') 'from PACKAGES_CHECK: ',
51	& 'run-time control flag use',msg1,' is set'
52	ELSE
53	WRITE(msgBuf,'(4A)') 'from PACKAGES_CHECK: ',
54	& 'run-time parameter ',msg2,' is used'
55	ENDIF
56	CALL PRINT_ERROR( msgBuf, myThid )
57	WRITE(msgBuf,'(5A)') 'but pkg/',msgLwc(1:iLen),
58	& ' was not compiled (ALLOW_',msgUpc(1:iLen),' undef).'
59	CALL PRINT_ERROR( msgBuf, myThid )
60	WRITE(msgBuf,'(3A)')
61	& '==> Re-compile with pkg "',msgLwc(1:iLen),
62	& '" in file "packages.conf"'
63	CALL PRINT_ERROR( msgBuf, myThid )
64	CALL ALL_PROC_DIE( myThid )
65	STOP 'ABNORMAL END: S/R PACKAGE_ERROR_MSG'
66
67	RETURN
68	END