*IF DEF,GRIBCON GRIB_CO1.2
C ******************************COPYRIGHT****************************** GTS2F400.3439
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3440
C GTS2F400.3441
C Use, duplication or disclosure of this code is subject to the GTS2F400.3442
C restrictions as set forth in the contract. GTS2F400.3443
C GTS2F400.3444
C Meteorological Office GTS2F400.3445
C London Road GTS2F400.3446
C BRACKNELL GTS2F400.3447
C Berkshire UK GTS2F400.3448
C RG12 2SZ GTS2F400.3449
C GTS2F400.3450
C If no contract has been raised with this copy of the code, the use, GTS2F400.3451
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3452
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3453
C Modelling at the above address. GTS2F400.3454
C ******************************COPYRIGHT****************************** GTS2F400.3455
C GTS2F400.3456
CLL PROGRAM GRIB_CONVERT ---------------------------------- GRIB_CO1.3
CLL GRIB_CO1.4
CLL Purpose: GRIB_CO1.5
CLL Reads in ECMWF GRIB encoded blocked data and strips off GRIB_CO1.6
CLL extra bytes which appear in file before writing out GRIB_CO1.7
CLL GRIB data to unblocked binary file. GRIB_CO1.8
CLL GRIB_CO1.9
CLL 2K records are assumed (LRECL_BYTES), derived GRIB_CO1.10
CLL from an IBM RECFM=VB format dataset using df=bb GRIB_CO1.11
CLL when transferring via SUPERLINK. This means that GRIB_CO1.12
CLL 2 control bytes at the beginning and 4 bytes at GRIB_CO1.13
CLL the end of each record must be stripped off. GRIB_CO1.14
CLL GRIB_CO1.15
CLL Data in the above format may be obtained from the GRIB_CO1.16
CLL ECMWF MARS archive and transferred directly to GRIB_CO1.17
CLL COSMOS using the DECNET link. GRIB_CO1.18
CLL GRIB_CO1.19
CLL Model Modification history: GRIB_CO1.20
CLL version Date GRIB_CO1.21
CLL 3.1 20/12/92 Written by A. Dickinson GRIB_CO1.22
CLL 3.5 24/03/95 Changed OPEN to FILE_OPEN P.Burton GPB1F305.38
! 4.3 03/04/97 Changed GETARG to PFXGETARG D.M.Goddard UDG4F403.2
! 4.4 23/07/97 Give BUFFOU8 a character array argument UDG3F404.1
! This makes usage consistent with that of BUFFIN8 UDG3F404.2
! within unified model. D.M. Goddard UDG3F404.3
CLL GRIB_CO1.23
CLL Documentation: GRIB_CO1.24
CLL ECMWF MARS manual GRIB_CO1.25
CLL Unified Model Documentation Paper S1 GRIB_CO1.26
CLL GRIB_CO1.27
CLL------------------------------------------------------------ GRIB_CO1.28
GRIB_CO1.29
PROGRAM GRIB_CONVERT ,5GRIB_CO1.30
GRIB_CO1.31
IMPLICIT NONE GRIB_CO1.32
GRIB_CO1.33
INTEGER GRIB_CO1.34
* NFTIN !Unit no containing GRIB data GRIB_CO1.35
*,NFTOUT !Unit no to which GRIB data is written GRIB_CO1.36
*,LRECL_WORDS !Record length in words of GRIB file GRIB_CO1.37
*,LEN_IO !Length of record read in GRIB_CO1.38
*,LRECL_BYTES !Record length in bytes of GRIB file GRIB_CO1.39
GRIB_CO1.40
REAL GRIB_CO1.41
* A !Return code from BUFFER IN GRIB_CO1.42
GRIB_CO1.43
PARAMETER (LRECL_BYTES=2048 GRIB_CO1.44
* ,LRECL_WORDS=LRECL_BYTES/8) GRIB_CO1.45
GRIB_CO1.46
INTEGER GRIB_CO1.47
* ICHAR2(LRECL_WORDS) !Integer equivalence of array used GRIB_CO1.48
!to read in each GRIB record GRIB_CO1.49
GRIB_CO1.50
CHARACTER*1 GRIB_CO1.51
* CHAR2(LRECL_BYTES) !Character equivalence of array used GRIB_CO1.52
!to read in each GRIB record GRIB_CO1.53
GRIB_CO1.54
EQUIVALENCE (CHAR2,ICHAR2) GRIB_CO1.55
GRIB_CO1.56
CHARACTER*80 FILE1,FILE2 !Names of input & output files GRIB_CO1.57
GRIB_CO1.58
INTEGER GRIB_CO1.59
& LEN_FILE1 ! PXFGETARG return code UDG4F403.3
&,LEN_FILE2 ! PXFGETARG & FILE_OPEN return code UDG4F403.4
&,IERR ! PXFGETARG & FILE_OPEN return code UDG4F403.5
&,I ! Index GRIB_CO1.64
EXTERNAL PXFGETARG UDG4F403.6
GRIB_CO1.66
CL 1. Identify and open files GRIB_CO1.67
GRIB_CO1.68
CL 1.1 Get name of source file from command line GRIB_CO1.69
CALL PXFGETARG(
1,FILE1,LEN_FILE1,IERR) UDG4F403.7
IF(LEN_FILE1.LE.0.OR.IERR.NE.0)THEN UDG4F403.8
WRITE(6,*)' gribcon: No source file specified' GRIB_CO1.72
CALL ABORT GRIB_CO1.73
ENDIF GRIB_CO1.74
GRIB_CO1.75
CL 1.2 Get name of source file from command line GRIB_CO1.76
CALL PXFGETARG(2,FILE2,LEN_FILE2,IERR) UDG4F403.9
IF(LEN_FILE2.LE.0.OR.IERR.NE.0)THEN UDG4F403.10
WRITE(6,*)' gribcon: No target file specified' GRIB_CO1.79
CALL ABORT GRIB_CO1.80
ENDIF GRIB_CO1.81
GRIB_CO1.82
CL 1.3 Open files GRIB_CO1.83
NFTIN=10 GRIB_CO1.84
NFTOUT=20 GRIB_CO1.85
OPEN(NFTIN,FILE=FILE1,FORM='UNFORMATTED') GRIB_CO1.86
CALL FILE_OPEN(NFTOUT,FILE2,LEN_FILE2,1,1,IERR) UDG4F403.11
IF(IERR.NE.0)THEN GRIB_CO1.88
WRITE(6,*)'Cannot open file ',FILE2 GRIB_CO1.89
CALL ABORT GRIB_CO1.90
ENDIF GRIB_CO1.91
GRIB_CO1.92
CL 2. Read in data, strip off unwanted bytes and write to new file GRIB_CO1.93
A=10. GRIB_CO1.94
DO WHILE(A.NE.0.) GRIB_CO1.95
LEN_IO=LRECL_WORDS GRIB_CO1.96
DO WHILE(LEN_IO.EQ.LRECL_WORDS) GRIB_CO1.97
BUFFER IN(NFTIN,0) (ICHAR2(1),ICHAR2(LRECL_WORDS)) GRIB_CO1.98
A=UNIT(NFTIN) GRIB_CO1.99
LEN_IO=LENGTH(NFTIN) GRIB_CO1.100
C Strip off control bytes GRIB_CO1.101
IF(A.NE.0.)THEN GRIB_CO1.102
DO I=1,LEN_IO*8-6 GRIB_CO1.103
CHAR2(I)=CHAR2(I+2) GRIB_CO1.104
ENDDO GRIB_CO1.105
CALL BUFFOU8(NFTOUT,CHAR2,LEN_IO*8-6,LEN_IO,A) UDG3F404.4
ENDIF GRIB_CO1.107
ENDDO GRIB_CO1.108
ENDDO GRIB_CO1.109
GRIB_CO1.110
STOP GRIB_CO1.111
END GRIB_CO1.112
*ENDIF GRIB_CO1.113