*IF DEF,CONTROL OPERMES1.2
C ******************************COPYRIGHT****************************** OPERMES1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. OPERMES1.4
C OPERMES1.5
C Use, duplication or disclosure of this code is subject to the OPERMES1.6
C restrictions as set forth in the contract. OPERMES1.7
C OPERMES1.8
C Meteorological Office OPERMES1.9
C London Road OPERMES1.10
C BRACKNELL OPERMES1.11
C Berkshire UK OPERMES1.12
C RG12 2SZ OPERMES1.13
C OPERMES1.14
C If no contract has been raised with this copy of the code, the use, OPERMES1.15
C duplication or disclosure of it is strictly prohibited. Permission OPERMES1.16
C to do so must first be obtained in writing from the Head of Numerical OPERMES1.17
C Modelling at the above address. OPERMES1.18
C ******************************COPYRIGHT****************************** OPERMES1.19
! OPERMES1.20
!+ Write a message to the operator for operational runs OPERMES1.21
! OPERMES1.22
! Subroutine Interface: OPERMES1.23
SUBROUTINE OperatorMessage(nproc) 1,3OPERMES1.24
OPERMES1.25
IMPLICIT NONE OPERMES1.26
! OPERMES1.27
! Description: OperatorMessage writes a message to the operator for OPERMES1.28
! operational runs to indicate that jobs have started correctly. OPERMES1.29
! OPERMES1.30
! OPERMES1.31
! Method: Use SHELL routine to fork a process without copying a memory OPERMES1.32
! image. This allows unix command msgi to write a messsage to the OPERMES1.33
! operator. Only activated if environment variable UM_OPER_MESS="true". OPERMES1.34
! Note: fort_get_env fails if contents of environment variable is longer OPERMES1.35
! than the available storage, so length of UM_OPER_MESS (or RUNID) OPERMES1.36
! should not exceed env_char_len (=8 here). OPERMES1.37
! OPERMES1.38
! Current Code Owner: Rick Rawlins OPERMES1.39
! OPERMES1.40
! History: OPERMES1.41
! Version Date Comment OPERMES1.42
! ------- ---- ------- OPERMES1.43
! 4.5 16/02/98 Original code. Rick Rawlins OPERMES1.44
! OPERMES1.45
! Code Description: OPERMES1.46
! Language: FORTRAN 77 + common extensions. OPERMES1.47
! This code is written to UMDP3 v6 programming standards. OPERMES1.48
! OPERMES1.49
! Declarations: OPERMES1.50
OPERMES1.51
! Global variables (*CALLed COMDECKs etc...): OPERMES1.52
OPERMES1.53
! Subroutine arguments OPERMES1.54
! Scalar arguments with intent(in): OPERMES1.55
INTEGER nproc ! Number of processors OPERMES1.56
OPERMES1.57
! Local parameters: OPERMES1.58
OPERMES1.59
! Local scalars: OPERMES1.60
CHARACTER*80 shell_arg ! text for argument of shell call OPERMES1.61
CHARACTER*60 message OPERMES1.62
CHARACTER*8 env_char ! text of env. variable OPERMES1.63
OPERMES1.64
INTEGER shell_arg_len ! length of shell argument OPERMES1.65
& ,command_len ! length of shell command OPERMES1.66
& ,icode ! error return code OPERMES1.67
& ,RUNID_char_len ! length of RUNID contents OPERMES1.68
& ,env_char_len ! length of env_char array OPERMES1.69
OPERMES1.70
Parameter( OPERMES1.71
& RUNID_char_len=5) OPERMES1.72
OPERMES1.73
! Function & Subroutine calls: OPERMES1.74
External fort_get_env,shell OPERMES1.75
OPERMES1.76
!- End of header OPERMES1.77
message='"xxxx UM successfully running on xxxx PEs "' ! template OPERMES1.78
shell_arg='msgi' ! shell command OPERMES1.79
command_len=4 ! length of shell command OPERMES1.80
env_char_len=len(env_char) OPERMES1.81
OPERMES1.82
! Check that env.var. UM_OPER_MESS="true" in top level unix script OPERMES1.83
env_char='false' OPERMES1.84
CALL fort_get_env
('UM_OPER_MESS',12,env_char,env_char_len,icode) OPERMES1.85
OPERMES1.86
IF(icode.EQ.0 .AND. env_char(1:4).EQ.'true') THEN OPERMES1.87
OPERMES1.88
! Construct message: place RUNID and no. of PEs in message OPERMES1.89
CALL fort_get_env('RUNID',5,env_char,env_char_len,icode) OPERMES1.90
IF(icode.NE.0) THEN OPERMES1.91
write(6,*) 'Routine OperatorMessage: Warning: problem in ', OPERMES1.92
& 'reading environment variable RUNID, icode=',icode OPERMES1.93
ENDIF OPERMES1.94
OPERMES1.95
message(2:RUNID_char_len+1)=env_char ! substitute RUNID OPERMES1.96
write(message(34:37),'(I4)') nproc ! substitute no. of PEs OPERMES1.97
shell_arg(command_len+2:)=message OPERMES1.98
OPERMES1.99
! Send message to operator OPERMES1.100
shell_arg_len=len(shell_arg) OPERMES1.101
CALL shell(shell_arg,shell_arg_len) OPERMES1.102
write(6,*) shell_arg ! and standard output OPERMES1.103
OPERMES1.104
ENDIF ! Test on UM_OPER_MESS OPERMES1.105
OPERMES1.106
Return OPERMES1.107
End OPERMES1.108
*ENDIF OPERMES1.109