*IF DEF,CONTROL JOBCTL1.2
C ******************************COPYRIGHT****************************** GTS2F400.5149
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5150
C GTS2F400.5151
C Use, duplication or disclosure of this code is subject to the GTS2F400.5152
C restrictions as set forth in the contract. GTS2F400.5153
C GTS2F400.5154
C Meteorological Office GTS2F400.5155
C London Road GTS2F400.5156
C BRACKNELL GTS2F400.5157
C Berkshire UK GTS2F400.5158
C RG12 2SZ GTS2F400.5159
C GTS2F400.5160
C If no contract has been raised with this copy of the code, the use, GTS2F400.5161
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5162
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5163
C Modelling at the above address. GTS2F400.5164
C ******************************COPYRIGHT****************************** GTS2F400.5165
C GTS2F400.5166
CLL Subroutine: JOBCTL ------------------------------------------------ JOBCTL1.3
CLL JOBCTL1.4
CLL Purpose: Outputs job release request to output processing server JOBCTL1.5
CLL task at selected timesteps. JOBCTL1.6
CLL JOBCTL1.7
CLL Tested under compiler: cft77 JOBCTL1.8
CLL Tested under OS version: UNICOS 5.1 JOBCTL1.9
CLL JOBCTL1.10
CLL Author: T.C.Johns JOBCTL1.11
CLL JOBCTL1.12
CLL Model Modification history from model version 3.0: JOBCTL1.13
CLL version date JOBCTL1.14
CLL 3.1 3/02/93 : added comdeck CHSUNITS to define NUNITS for i/o RS030293.119
CLL AD050293.237
CLL 3.1 05/02/93 Portable Fortran unit no assigns AD050293.238
CLL Author: A. Dickinson Reviewer: R. Stratton AD050293.239
CLL 3.4 16/6/94 : Change CHARACTER*(*) to CHARACTER*(80) N.Farnon ANF0F304.26
CLL 3.5 25/04/95 Sub_models stage 1: make generic. RTHBarnes. GRB1F305.319
CLL 4.3 31-01-97 Parallelise writes to the pipe. LCWiles GLW2F403.1
CLL 4.4 09/10/97 Change the closes on unit 8 to flushes GBCCF404.3
CLL Author: Bob Carruthers, Cray Research GBCCF404.4
CLL JOBCTL1.15
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) JOBCTL1.16
CLL JOBCTL1.17
CLL Logical components covered: C0 JOBCTL1.18
CLL JOBCTL1.19
CLL Project task: C0 JOBCTL1.20
CLL JOBCTL1.21
CLL External documentation: JOBCTL1.22
CLL On-line UM document C0 - The top-level control system JOBCTL1.23
CLL On-line UM document - Automated output processing system JOBCTL1.24
CLL JOBCTL1.25
CLL ------------------------------------------------------------------- JOBCTL1.26
C*L Interface and arguments: ------------------------------------------ JOBCTL1.27
C JOBCTL1.28
SUBROUTINE JOBCTL(I_AO,ICODE,CMESSAGE) 1,1JOBCTL1.29
C JOBCTL1.30
C*---------------------------------------------------------------------- JOBCTL1.31
IMPLICIT NONE JOBCTL1.32
C JOBCTL1.33
INTEGER I_AO ! Internal model indicator GRB1F305.320
! ! 1 - Atmosphere; 2 - Ocean GRB1F305.321
INTEGER ICODE ! Error return code JOBCTL1.35
CHARACTER*(80) CMESSAGE ! Error return message ANF0F304.27
C JOBCTL1.37
C Common blocks JOBCTL1.38
C JOBCTL1.39
*CALL CMAXSIZE 
GRB1F305.322
*CALL CSUBMODL GRB1F305.323
*CALL CHSUNITS GRB1F305.324
*CALL CHISTORY GRB1F305.325
*CALL CCONTROL GRB1F305.326
*CALL CTIME JOBCTL1.40
C JOBCTL1.42
*IF DEF,MPP GLW2F403.2
*CALL PARVARS GLW2F403.3
*ENDIF GLW2F403.4
C GLW2F403.5
C GLW2F403.6
C Local variables JOBCTL1.43
c AD050293.241
c External subroutines AD050293.242
c AD050293.243
EXTERNAL GET_FILE AD050293.244
INTEGER I ! Loop counter JOBCTL1.45
* ,MODJOBREL ! modulus of jobrel_step JOBCTL1.46
CHARACTER*2 CDIGIT(10) ! Character array of digits JOBCTL1.47
CHARACTER*80 CREQUEST ! Template processing request JOBCTL1.48
CHARACTER*80 FILENAME AD050293.240
DATA CDIGIT JOBCTL1.49
* / "1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10" / JOBCTL1.50
DATA CREQUEST JOBCTL1.51
* / "%%% _JOB_MEMBER_ REL NET" / JOBCTL1.52
C JOBCTL1.53
CL---------------------------------------------------------------------- JOBCTL1.54
C Get name of pipe AD050293.245
CALL GET_FILE(8,FILENAME,80,ICODE) GTD0F400.162
CL 1. Set character for internal model type GRB1F305.327
CL JOBCTL1.56
IF (I_AO.EQ.1) THEN JOBCTL1.58
CREQUEST(5:5) = "A" JOBCTL1.59
ELSE IF (I_AO.EQ.2) THEN GRB1F305.328
CREQUEST(5:5) = "O" GRB1F305.329
ELSE GRB1F305.330
ICODE = I_AO GRB1F305.331
CMESSAGE = 'JOBCTL1: invalid internal model indicator' GRB1F305.332
GO TO 9999 GRB1F305.333
END IF GRB1F305.334
GRB1F305.335
CL 2. Job Release - loop over release timesteps GRB1F305.336
CL GRB1F305.337
DO I=1,10 JOBCTL1.60
IF (JOBREL_STEPim(I,I_AO).LT.0) THEN GRB1F305.338
MODJOBREL=ABS(JOBREL_STEPim(I,I_AO)) GRB1F305.339
IF (MOD(STEPim(I_AO),MODJOBREL).EQ.0) THEN GRB1F305.340
CREQUEST(18:19) = CDIGIT(I) JOBCTL1.64
*IF DEF,MPP GLW2F403.7
IF(mype.eq.0) THEN GLW2F403.8
WRITE(8,*) CREQUEST GLW2F403.9
*IF DEF,T3E GBCCF404.5
call flush(8, icode) GBCCF404.6
*ELSE GBCCF404.7
CLOSE(8) GLW2F403.10
OPEN(8,FILE=FILENAME) GLW2F403.11
*ENDIF GBCCF404.8
ENDIF GLW2F403.12
*ELSE GLW2F403.13
WRITE(8,*) CREQUEST JOBCTL1.65
CLOSE(8) JOBCTL1.66
OPEN(8,FILE=FILENAME) GLW2F403.14
*ENDIF GLW2F403.15
ENDIF JOBCTL1.68
ELSE JOBCTL1.69
IF (JOBREL_STEPim(I,I_AO).EQ.STEPim(I_AO)) THEN GRB1F305.341
CREQUEST(18:19) = CDIGIT(I) JOBCTL1.71
*IF DEF,MPP GLW2F403.16
IF(mype.eq.0) THEN GLW2F403.17
WRITE(8,*) CREQUEST GLW2F403.18
*IF DEF,T3E GBCCF404.9
call flush(8, icode) GBCCF404.10
*ELSE GBCCF404.11
CLOSE(8) GLW2F403.19
OPEN(8,FILE=FILENAME) GLW2F403.20
*ENDIF GBCCF404.12
ENDIF GLW2F403.21
*ELSE GLW2F403.22
WRITE(8,*) CREQUEST JOBCTL1.72
CLOSE(8) JOBCTL1.73
OPEN(8,FILE=FILENAME) GLW2F403.23
*ENDIF GLW2F403.24
ENDIF JOBCTL1.75
ENDIF JOBCTL1.76
ENDDO JOBCTL1.77
C JOBCTL1.106
9999 CONTINUE GRB1F305.342
RETURN JOBCTL1.107
END JOBCTL1.108
*ENDIF JOBCTL1.109