*IF DEF,HPRT WRITRSU1.2
C ******************************COPYRIGHT****************************** GTS2F400.12169
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.12170
C GTS2F400.12171
C Use, duplication or disclosure of this code is subject to the GTS2F400.12172
C restrictions as set forth in the contract. GTS2F400.12173
C GTS2F400.12174
C Meteorological Office GTS2F400.12175
C London Road GTS2F400.12176
C BRACKNELL GTS2F400.12177
C Berkshire UK GTS2F400.12178
C RG12 2SZ GTS2F400.12179
C GTS2F400.12180
C If no contract has been raised with this copy of the code, the use, GTS2F400.12181
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.12182
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.12183
C Modelling at the above address. GTS2F400.12184
C ******************************COPYRIGHT****************************** GTS2F400.12185
C GTS2F400.12186
CLL Routine: WRITRSUB ------------------------------------------------- WRITRSU1.3
CLL WRITRSU1.4
CLL Purpose: To create file containing job details for qsub to resubmit WRITRSU1.5
CLL the climate model, using history block information. WRITRSU1.6
CLL WRITRSU1.7
CLL Tested under compiler: cft77 WRITRSU1.8
CLL Tested under OS version: UNICOS 6.1.5A WRITRSU1.9
CLL WRITRSU1.10
CLL Author: A.B.SANGSTER WRITRSU1.11
CLL WRITRSU1.12
CLL Model Modification history from model version 3.0: WRITRSU1.13
CLL version date WRITRSU1.14
CLL AD050293.150
CLL 3.1 05/02/93 Portable Fortran unit no assigns AD050293.151
CLL Author: A. Dickinson Reviewer: R. Stratton AD050293.152
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.219
CLL portability. Author Tracey Smith. TS150793.220
CLL WRITRSU1.15
CLL Programming standard: UM Doc Paper 3, draft version WRITRSU1.16
CLL WRITRSU1.17
CLL Logical components covered: C0 WRITRSU1.18
CLL WRITRSU1.19
CLL Project task: C0 WRITRSU1.20
CLL WRITRSU1.21
CLL External documentation: On-line UM document C0 - The top-level WRITRSU1.22
CLL control system WRITRSU1.23
CLL WRITRSU1.24
C*L Interface and arguments: WRITRSU1.25
C WRITRSU1.26
SUBROUTINE WRITRSUB 1,2WRITRSU1.27
* ( UNITRSUB,ICODE,CMESSAGE ) WRITRSU1.28
C WRITRSU1.29
IMPLICIT NONE WRITRSU1.30
C WRITRSU1.31
INTEGER HIST_UNIT GGH2F400.1
INTEGER UNITRSUB ! In - RSUB file unit WRITRSU1.32
INTEGER ICODE ! Out - Return code from routine WRITRSU1.33
CHARACTER*(80) CMESSAGE ! Out - Return message if failure occured TS150793.221
CHARACTER *80 FILENAME AD050293.153
PARAMETER(HIST_UNIT=10) GGH2F400.2
C* WRITRSU1.35
C WRITRSU1.36
CL Common blocks WRITRSU1.37
C WRITRSU1.38
*CALL CSUBMODL 
GGH0F305.67
*CALL CHSUNITS GGH0F305.68
*CALL CHISTORY GGH0F305.69
C WRITRSU1.40
C*L EXTERNAL subroutines called WRITRSU1.41
EXTERNAL GET_FILE AD050293.154
C* WRITRSU1.43
C 0. Read the top record of the permenant history GGH2F400.3
C file. GGH2F400.4
CALL GET_FILE(HIST_UNIT,FILENAME,80,ICODE) GGH2F400.5
OPEN(HIST_UNIT,FILE=FILENAME,FORM='FORMATTED',IOSTAT=ICODE, PXNAMLST.26
& DELIM='APOSTROPHE') PXNAMLST.27
PXNAMLST.28
C GGH2F400.7
C Check for error GGH2F400.8
C GGH2F400.9
IF(ICODE .GT.0)THEN GGH2F400.10
CMESSAGE='HPRINT : Failed in OPEN of history file' GGH2F400.11
GOTO 999 GGH2F400.12
ELSEIF(ICODE .LT. 0)THEN GGH2F400.13
WRITE(6,*)'HPRINT : Warning message on OPEN of history file' GIE0F403.694
WRITE(6,*)'IOSTAT= ',ICODE GIE0F403.695
ENDIF GGH2F400.16
C GGH2F400.17
REWIND(HIST_UNIT) GGH2F400.18
READ(HIST_UNIT,NLIHISTO) GGH2F400.19
READ(HIST_UNIT,NLCHISTO) GGH2F400.20
READ(HIST_UNIT,NLIHISTG) GGH2F400.21
READ(HIST_UNIT,NLCHISTG) GGH2F400.22
READ(HIST_UNIT,NLCFILES) GGH2F400.23
C GGH2F400.24
C Check for error GGH2F400.25
C GGH2F400.26
IF(ICODE .GT.0)THEN GGH2F400.27
CMESSAGE='HPRINT : Failed in READ of history file' GGH2F400.28
GOTO 999 GGH2F400.29
ELSEIF(ICODE .LT. 0)THEN GGH2F400.30
WRITE(6,*)'HPRINT : Warning message on READ of history file' GIE0F403.696
WRITE(6,*)'IOSTAT= ',ICODE GIE0F403.697
ENDIF GGH2F400.33
C GGH2F400.34
CL WRITRSU1.44
CL 1. Open, rewind and write a record WRITRSU1.45
CL WRITRSU1.46
CALL GET_FILE(UNITRSUB,FILENAME,80,ICODE) GJC0F405.38
OPEN(UNITRSUB,FILE=FILENAME,IOSTAT=ICODE) AD050293.156
C WRITRSU1.48
C Check for error WRITRSU1.49
C WRITRSU1.50
IF(ICODE .GT.0)THEN WRITRSU1.51
CMESSAGE='WRITRSUB: Failed in OPEN of output unit' WRITRSU1.52
GOTO 999 WRITRSU1.53
ELSEIF(ICODE .LT. 0)THEN WRITRSU1.54
WRITE(6,*)'WRITRSUB: Warning message on OPEN of output unit' GIE0F403.698
WRITE(6,*)'IOSTAT= ',ICODE GIE0F403.699
ENDIF WRITRSU1.57
C WRITRSU1.58
REWIND(UNITRSUB) WRITRSU1.59
WRITE(UNITRSUB,100,IOSTAT=ICODE) WRITRSU1.60
* RUN_RESUBMIT, WRITRSU1.61
* RUN_RESUBMIT_Q, WRITRSU1.62
* RUN_RESUBMIT_TIME, WRITRSU1.63
* RUN_RESUBMIT_CPU, WRITRSU1.64
* RUN_RESUBMIT_MEMORY, WRITRSU1.65
* RUN_RESUBMIT_PRTY, WRITRSU1.66
* RUN_RESUBMIT_JOBNAME, WRITRSU1.67
* RUN_JOB_NAME WRITRSU1.68
C WRITRSU1.69
C Check for error WRITRSU1.70
C WRITRSU1.71
IF(ICODE .GT.0)THEN WRITRSU1.72
CMESSAGE='WRITRSUB: Failed in WRITE to output unit' WRITRSU1.73
GOTO 999 WRITRSU1.74
ELSEIF(ICODE .LT. 0)THEN WRITRSU1.75
WRITE(6,*)'WRITRSUB: Warning message on WRITE to output unit' GIE0F403.700
WRITE(6,*)'IOSTAT= ',ICODE GIE0F403.701
ENDIF WRITRSU1.78
C WRITRSU1.79
C WRITRSU1.80
100 FORMAT('FLAG = ',A1/ WRITRSU1.81
* 'QUEUE = ',A12/ WRITRSU1.82
* 'TIME = ',A12/ WRITRSU1.83
* 'CPU = ',A12/ WRITRSU1.84
* 'MEMORY = ',A12/ WRITRSU1.85
* 'PRTY = ',A12/ WRITRSU1.86
* 'JOBNAME = ',A8/ WRITRSU1.87
* 'THISJOB = ',A8) WRITRSU1.88
999 CONTINUE WRITRSU1.89
CL WRITRSU1.90
CL 2. Close and return WRITRSU1.91
CL WRITRSU1.92
CLOSE(UNITRSUB) WRITRSU1.93
RETURN WRITRSU1.94
END WRITRSU1.95
*ENDIF WRITRSU1.96