*IF DEF,C80_1A,OR,DEF,UTILIO,OR,DEF,RECON,OR,DEF,FLDMOD UIE3F404.38
C ******************************COPYRIGHT****************************** GTS2F400.7345
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7346
C GTS2F400.7347
C Use, duplication or disclosure of this code is subject to the GTS2F400.7348
C restrictions as set forth in the contract. GTS2F400.7349
C GTS2F400.7350
C Meteorological Office GTS2F400.7351
C London Road GTS2F400.7352
C BRACKNELL GTS2F400.7353
C Berkshire UK GTS2F400.7354
C RG12 2SZ GTS2F400.7355
C GTS2F400.7356
C If no contract has been raised with this copy of the code, the use, GTS2F400.7357
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7358
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7359
C Modelling at the above address. GTS2F400.7360
C ******************************COPYRIGHT****************************** GTS2F400.7361
C GTS2F400.7362
CLL SUBROUTINE POSERROR--------------------------------------- POSERR1A.3
CLL POSERR1A.4
CLL Purpose: POSERR1A.5
CLL Prints out a message when position of a data block as POSERR1A.6
CLL pointed to by fixed length header differs from actual POSERR1A.7
CLL position in model dump. POSERR1A.8
CLL POSERR1A.9
CLL Written by A. Dickinson 29/12/89 POSERR1A.10
CLL POSERR1A.11
CLL Model Modification history from model version 3.0: POSERR1A.12
CLL version date POSERR1A.13
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.237
CLL portability. Author Tracey Smith. TS150793.238
CLL 4.4 15/10/97 Added code to print the error message to GBC2F404.99
CLL stderr, and call abort in case all the GBC2F404.100
CLL PE's have not detected the error condition. GBC2F404.101
CLL Author: Bob Carruthers, Cray Research GBC2F404.102
CLL POSERR1A.14
CLL Programming standard: POSERR1A.15
CLL Unified Model Documentation Paper No 3 POSERR1A.16
CLL Version No 1 15/1/90 POSERR1A.17
CLL POSERR1A.18
CLL System component: E4 POSERR1A.19
CLL POSERR1A.20
CLL System task: F3 POSERR1A.21
CLL POSERR1A.22
CLL Documentation: POSERR1A.23
CLL None POSERR1A.24
CLL------------------------------------------------------------ POSERR1A.25
C*L Arguments:------------------------------------------------- POSERR1A.26
SUBROUTINE POSERROR(STRING,START_BLOCK,HEAD_POS,HEAD_ADDRESS) 42,1POSERR1A.27
POSERR1A.28
IMPLICIT NONE POSERR1A.29
POSERR1A.30
INTEGER POSERR1A.31
* START_BLOCK !IN Actual position of data block POSERR1A.32
*,HEAD_POS !IN Position in FIXHD of pointer POSERR1A.33
*,HEAD_ADDRESS !IN Position in file pointed to by FIXHD(HEAD_POS) POSERR1A.34
POSERR1A.35
*IF DEF,T3E GBC2F404.103
character*(*) string GBC2F404.104
*ELSE GBC2F404.105
CHARACTER*(80) STRING !IN Description of block TS150793.239
*ENDIF GBC2F404.106
POSERR1A.38
C ------------------------------------------------------------- POSERR1A.39
C Workspace usage:--------------------------------------------- POSERR1A.40
C None POSERR1A.41
C ------------------------------------------------------------- POSERR1A.42
C*L External subroutines called:------------------------------- POSERR1A.43
C None POSERR1A.44
C*------------------------------------------------------------- POSERR1A.45
POSERR1A.46
CL Internal structure: none POSERR1A.47
POSERR1A.48
WRITE(6,'('' ******FATAL ERROR WHEN READING MODEL DUMP******'')') POSERR1A.49
WRITE(6,'('' Conflict between start position of '',A)')STRING POSERR1A.50
WRITE(6,'('' block and pointer in fixed length header: FIXHD('', POSERR1A.51
*I3,'') ='',I9)')HEAD_POS,HEAD_ADDRESS POSERR1A.52
WRITE(6,'('' Current position in file ='',I9,'' words in'')') POSERR1A.53
*START_BLOCK POSERR1A.54
WRITE(6,'('' ***********************************************'')') POSERR1A.55
*IF DEF,T3E GBC2F404.107
c GBC2F404.108
write(0,'(//)') GBC2F404.109
WRITE(0,'('' ******FATAL ERROR WHEN READING MODEL DUMP******'')') GBC2F404.110
WRITE(0,'('' Conflict between start position of '',A)')STRING GBC2F404.111
WRITE(0,'('' Block and Pointer in Fixed Length Header: FIXHD('', GBC2F404.112
*I3,'') ='',I9)')HEAD_POS,HEAD_ADDRESS GBC2F404.113
WRITE(0,'('' Current position in file ='',I9,'' words in'')') GBC2F404.114
*START_BLOCK GBC2F404.115
WRITE(0,'('' ***********************************************'')') GBC2F404.116
call abort
('I/O Position Error') GBC2F404.117
*ENDIF GBC2F404.118
POSERR1A.56
RETURN POSERR1A.57
END POSERR1A.58
POSERR1A.59
*ENDIF POSERR1A.60