SUBROUTINE GRIB_TO_UNIFIED_MODEL( 1,13UDG2F305.400
*CALL ARGPPX 
UDG2F305.401
& NFTIN,NFTOUT) UDG2F305.402
GRIB_TO1.38
IMPLICIT NONE GRIB_TO1.39
GRIB_TO1.40
INTEGER GRIB_TO1.41
* NFTIN !Unit no containing GRIB data GRIB_TO1.42
*,NFTOUT !Unit no to which UM dump is written GRIB_TO1.43
GRIB_TO1.45
*CALL C_MDI TJ050593.65
*CALL CSUBMODL UDG2F305.403
*CALL CPPXREF UDG2F305.405
*CALL PPXLOOK UDG2F305.406
UDG2F305.407
INTEGER EXPPXI ! Function to extract integer UDG2F305.408
! from ppxref file UDG2F305.409
CHARACTER*36 EXPPXC ! Function to extract character string UDG2F305.410
! from ppxref file UDG2F305.411
TJ050593.66
INTEGER GRIB_TO1.46
* LEN2_LOOKUP !No of GRIB fields GRIB_TO1.47
*,ROW_LENGTH !No of points EW GRIB_TO1.48
*,P_ROWS !No of points NS GRIB_TO1.49
*,P_LEVELS !No of levels GRIB_TO1.50
*,BL_LEVELS !No of BL levels GRIB_TO1.51
*,SM_LEVELS !No of soil moisture levels UDG3F405.33
*,ST_LEVELS !No of soil temperature levels UDG3F405.34
*,LRECL_BYTES !Record length in bytes of GRIB file GRIB_TO1.52
*,LRECL_WORDS !Record length in words of GRIB file GRIB_TO1.53
*,LEN_IO !Length of record read in GRIB_TO1.54
*,K,I,J !Integer indices GRIB_TO1.55
!,IE ! integer index UDG3F400.4
!,IERR ! Error code (>0 if error) UDG3F400.5
*,YEAR ! GRIB_TO1.58
*,MONTH ! GRIB_TO1.59
*,DAY !> Analysis date & time GRIB_TO1.60
*,HOUR ! GRIB_TO1.61
*,MINUTE ! GRIB_TO1.62
*,N_M_FIELDS !No of upper level fields GRIB_TO1.63
*,N_S_FIELDS !No of single level fields GRIB_TO1.64
*,N_SOIL_LEVELS !Number of soil levels UDG3F405.35
*,POS_LSM !Position of LSM among single level fields UDG3F405.36
! in GRIB file. UDG3F405.37
UDG3F405.38
LOGICAL LPSTAR !=T if P STAR in GRIB file UDG3F405.39
!=F if log P STAR in GRIB file UDG3F405.40
LOGICAL LSKINTEMP !=T if GRIB code 235 in GRIB file UDG3F405.41
GRIB_TO1.65
*CALL TYPGRIB UDG3F400.6
UDG3F400.7
INTEGER ARRAY_LEN UDG3F400.8
!, BUFF_BYTES UDG3F400.9
PARAMETER(ARRAY_LEN=1000) UDG3F400.10
PARAMETER(BUFF_BYTES=256) UDG3F400.11
UDG3F400.12
REAL UDG3F400.13
! A UDG3F400.14
!,AE UDG3F400.15
!,AKH_GRIB(ARRAY_LEN) !Array containing h levs on GRIB file UDG3F400.16
!,BKH_GRIB(ARRAY_LEN) !Array containing h levs on GRIB file UDG3F400.17
!,AK_GRIB(ARRAY_LEN) !Array containing levels on GRIB file UDG3F400.18
!,BK_GRIB(ARRAY_LEN) !Array containing levels on GRIB file UDG3F400.19
UDG3F400.20
INTEGER M_SOIL_LEVELS UDG3F405.42
!Maximum number of ECMWF soil levels UDG3F405.43
PARAMETER (M_SOIL_LEVELS=4) UDG3F405.44
REAL UDG3F405.45
! ECMWF_SOIL_LEVELS(M_SOIL_LEVELS) UDG3F405.46
!Array containing ECMWF soil levels UDG3F405.47
!,ECMWF_SOIL_DEPTHS(M_SOIL_LEVELS) UDG3F405.48
!Array containing depth of ECMWF soil layers UDG3F405.49
INTEGER UDG3F400.21
! GRIB_RECORD_START_ADDRESS(ARRAY_LEN) UDG3F400.22
!,GRIB_RECORD_LENGTH(ARRAY_LEN) UDG3F400.23
!,GRIB_CODE_VALUE(ARRAY_LEN) UDG3F400.24
!,GRIB_PRESSURE_LEVEL(ARRAY_LEN) UDG3F400.25
!,S_CODES(ARRAY_LEN) !Array containing surface grib codes UDG3F400.26
!,M_CODES(ARRAY_LEN) !Array containing upper level grib codes UDG3F400.27
!,ST_CODES(ARRAY_LEN) !Array containing soil temperature UDG3F405.50
!grid codes UDG3F405.51
!,SM_CODES(ARRAY_LEN) !Array containing soil moisture UDG3F405.52
!grid codes UDG3F405.53
!,POINTER UDG3F400.28
UDG3F400.29
CHARACTER*256 BUFF ! I/O buffer used to search for UDG3F400.30
! start of each GRIB record UDG3F400.31
CHARACTER*1 CHAR2(LEN_MAX) ! Character array used to read in UDG3F400.32
CHARACTER*5 NULL5 ! null search pattern UDG3F400.33
CHARACTER*20 M_CODES_PHRASE(ARRAY_LEN) UDG3F400.34
!, S_CODES_PHRASE(ARRAY_LEN) UDG3F400.35
CHARACTER*24 ST_CODES_PHRASE(ARRAY_LEN) UDG3F405.54
!, SM_CODES_PHRASE(ARRAY_LEN) UDG3F405.55
UDG3F400.36
LOGICAL UDG3F400.37
! HYBRID ! =T data on hybrid levs; =F data on pressure levs UDG3F400.38
UDG3F400.39
INTEGER ICHAR2(LEN_MAX) ! INTEGER EQUIVALENT OF CHAR2 UDG3F404.8
EQUIVALENCE (CHAR2(1),ICHAR2(1)) UDG3F404.9
UDG3F404.10
*CALL CGRIB UDG3F400.40
UDG3F400.41
AD110293.37
UDG1F305.246
*CALL C_VERT UDG1F305.247
*CALL C_ECMWF_19 UDG1F305.248
*CALL C_ECMWF_31 UDG1F305.249
UDG1F305.250
C ------------------------------------------------------------- GRIB_TO1.109
C External subroutines called:--------------------------------- GRIB_TO1.110
EXTERNAL DECODE,BUFFIN8,SETPOS8,GRIB_UM,GRIB_FC_TIME UDG3F400.42
EXTERNAL ABCALC UDG1F305.251
C ------------------------------------------------------------- GRIB_TO1.112
GRIB_TO1.113
DO J=1,ARRAY_LEN UDG3F400.43
GRIB_RECORD_START_ADDRESS(J)=IMDI UDG3F400.44
GRIB_RECORD_LENGTH(J)=IMDI UDG3F400.45
GRIB_CODE_VALUE(J)=IMDI UDG3F400.46
GRIB_PRESSURE_LEVEL(J)=IMDI UDG3F400.47
ENDDO UDG3F400.48
C Find no of grib fields LEN2_LOOKUP GRIB_TO1.114
C no of levels P_LEVELS GRIB_TO1.115
C no of boundary layer levels BL_LEVELS GRIB_TO1.116
C value of levels AK GRIB_TO1.117
GRIB_TO1.118
HYBRID=.FALSE. AD110293.60
LPSTAR=.TRUE. UDG3F405.56
LSKINTEMP=.TRUE. UDG3F405.57
A=10. GRIB_TO1.120
P_LEVELS=0 GRIB_TO1.122
BL_LEVELS=0 GRIB_TO1.123
N_M_FIELDS=0 GRIB_TO1.124
N_S_FIELDS=0 GRIB_TO1.125
SM_LEVELS=0 UDG3F405.58
ST_LEVELS=0 UDG3F405.59
K=0 AD110293.61
POINTER=3 AD110293.62
GRIB_TO1.126
DO WHILE(A.NE.0.) GRIB_TO1.127
POINTER=POINTER-3 AD110293.63
CALL SETPOS8(NFTIN,POINTER) AD110293.64
BUFF=' ' UDG3F400.49
CALL BUFFIN8(NFTIN,BUFF,BUFF_BYTES,LEN_IO,A) AD110293.65
POINTER=POINTER+BUFF_BYTES AD110293.66
I=INDEX(BUFF,'GRIB') AD110293.67
IF(I.NE.0) THEN AD110293.68
POINTER=POINTER+I-1-BUFF_BYTES AD110293.69
K=K+1 AD110293.70
CALL SETPOS8(NFTIN,POINTER) AD110293.71
GRIB_RECORD_START_ADDRESS(K)=POINTER AD110293.72
IF(A.NE.0.0)THEN UDG3F400.50
CALL BUFFIN8(NFTIN,CHAR2(1),LEN_MAX,LEN_IO,A) UDG3F400.51
UDG3F400.52
C Decode grib headers UDG3F400.53
LEN_FP=LEN_MAX UDG3F400.54
JLEN=LEN_IO UDG3F400.55
CALL DECODE(FPDATA,FPWORK,LEN_FP,NUM_FP, UDG3F400.56
! VERT_COORDS,LEN_VERT,NUM_VERT, UDG3F400.57
! BITMAP,LEN_BITMAP,NUM_BITMAP, UDG3F400.58
! QUASI,LEN_Q,NUM_Q,WIDTH,WORD_SIZE, UDG3F400.59
! BLOCK0,BLOCK1,BLOCK2,BLOCK3,BLOCK4, UDG3F400.60
! BLOCKR,ICHAR2,JLEN,POSN,WORD,OFF,ERROR, UDG3F404.11
! WORK_INT1,WORK_INT2,WORK_RE1,IERR_UNIT,MSGLVL) UDG3F404.12
UDG3F400.63
IF(BLOCK0(3).NE.0)THEN UDG3F400.64
UDG3F400.65
C Edition 1 GRIB. Use BLOCK0(3) as length of encoded data UDG3F400.66
GRIB_RECORD_LENGTH(K) = BLOCK0(3) UDG3F400.67
POINTER=POINTER+GRIB_RECORD_LENGTH(K)-1 UDG3F400.68
ELSE UDG3F400.69
UDG3F400.70
C Edition 0 GRIB. Calculate length of encoded data by UDG3F400.71
C searching for end marker '7777' UDG3F400.72
IF(K.NE.1)THEN UDG3F400.73
GRIB_RECORD_LENGTH(K-1) = UDG3F400.74
&GRIB_RECORD_START_ADDRESS(K) - GRIB_RECORD_START_ADDRESS(K-1) UDG3F400.75
END IF UDG3F400.76
NULL5(1:1)=CHAR(0) UDG3F400.77
NULL5(2:2)=CHAR(0) UDG3F400.78
NULL5(3:3)=CHAR(0) UDG3F400.79
NULL5(4:4)=CHAR(0) UDG3F400.80
NULL5(5:5)=CHAR(0) UDG3F400.81
AE=10. UDG3F400.82
POINTER = POINTER+8 UDG3F400.83
DO WHILE(AE.NE.0.) UDG3F400.84
POINTER=POINTER-8 UDG3F400.85
CALL SETPOS8(NFTIN,POINTER) UDG3F400.86
BUFF=' ' UDG3F400.87
CALL BUFFIN8(NFTIN,BUFF,BUFF_BYTES,LEN_IO,AE) UDG3F400.88
POINTER=POINTER+BUFF_BYTES UDG3F400.89
IE=INDEX(BUFF,'7777'//NULL5) UDG3F400.90
IF(IE.NE.0) THEN UDG3F400.91
POINTER=POINTER+IE-1-BUFF_BYTES UDG3F400.92
AE=0. UDG3F400.93
CALL SETPOS8(NFTIN,POINTER) UDG3F400.94
ENDIF ! test for non-zero INDEX return UDG3F400.95
ENDDO ! test for end-of-file or end mark '7777' UDG3F400.96
ENDIF ! test for BLOCK0(3) being set0 UDG3F400.97
GRIB_CODE_VALUE(K)=BLOCK1(5) UDG3F400.98
GRIB_PRESSURE_LEVEL(K)=BLOCK1(7) UDG3F400.99
IF(K.NE.1)THEN UDG3F400.100
WRITE(6,'(1X,3I6,2I12)')K-1,GRIB_CODE_VALUE(K-1), UDG3F400.101
! GRIB_PRESSURE_LEVEL(K-1), UDG3F400.102
! GRIB_RECORD_LENGTH(K-1),GRIB_RECORD_START_ADDRESS(K-1) UDG3F400.103
ENDIF UDG3F400.104
UDG3F400.105
IF(K.EQ.1)THEN UDG3F400.106
UDG3F400.107
C Find horizontal dimensions and date of data UDG3F400.108
ROW_LENGTH=BLOCK2(4) UDG3F400.109
P_ROWS=BLOCK2(5) UDG3F400.110
CALL GRIB_FC_TIME(BLOCK1,MINUTE,HOUR,DAY,MONTH,YEAR) UDG3F400.111
UDG3F400.112
ENDIF UDG3F400.113
GRIB_TO1.149
C Count up number of multilevel fields GRIB_TO1.150
! Ignore log surface pressure UDG3F405.60
IF(BLOCK1(5).NE.152)THEN UDG3F405.61
IF(BLOCK1(7).EQ.1000.OR.BLOCK1(7).EQ.1)THEN UDG3F400.114
N_M_FIELDS=N_M_FIELDS+1 UDG3F400.115
M_CODES(N_M_FIELDS)=BLOCK1(5) UDG3F400.116
ENDIF UDG3F400.117
END IF UDG3F405.62
GRIB_TO1.155
C Count up number of single level fields GRIB_TO1.156
IF(BLOCK1(7).EQ.0.AND.BLOCK1(6).NE.112)THEN UDG3F405.63
N_S_FIELDS=N_S_FIELDS+1 UDG3F400.119
S_CODES(N_S_FIELDS)=BLOCK1(5) UDG3F400.120
IF(BLOCK1(5).EQ.GRIB_CODE(7))POS_LSM=N_S_FIELDS UDG3F405.64
ENDIF UDG3F400.121
! Count up number of soil levels and their values UDG3F405.65
! note ECMWF store depths in centimetres UDG3F405.66
IF(BLOCK1(6).EQ.112)THEN UDG3F405.67
! Using soil temperature UDG3F405.68
IF(BLOCK1(5).EQ.139.OR.BLOCK1(5).EQ.170.OR. UDG3F405.69
& BLOCK1(5).EQ.183.OR.BLOCK1(5).EQ.236)THEN UDG3F405.70
ST_LEVELS=ST_LEVELS+1 UDG3F405.71
ST_CODES(ST_LEVELS)=BLOCK1(5) UDG3F405.72
END IF UDG3F405.73
IF(BLOCK1(5).EQ.139)THEN UDG3F405.74
ECMWF_SOIL_LEVELS(1)=REAL(BLOCK1(7)+BLOCK1(8))/200.0 UDG3F405.75
ECMWF_SOIL_DEPTHS(1)=REAL(BLOCK1(8)-BLOCK1(7))/100.0 UDG3F405.76
ELSE IF(BLOCK1(5).EQ.170)THEN UDG3F405.77
ECMWF_SOIL_LEVELS(2)=REAL(BLOCK1(7)+BLOCK1(8))/200.0 UDG3F405.78
ECMWF_SOIL_DEPTHS(2)=REAL(BLOCK1(8)-BLOCK1(7))/100.0 UDG3F405.79
ELSE IF(BLOCK1(5).EQ.183)THEN UDG3F405.80
ECMWF_SOIL_LEVELS(3)=REAL(BLOCK1(7)+BLOCK1(8))/200.0 UDG3F405.81
ECMWF_SOIL_DEPTHS(3)=REAL(BLOCK1(8)-BLOCK1(7))/100.0 UDG3F405.82
ELSE IF(BLOCK1(5).EQ.236)THEN UDG3F405.83
!Bottom depth of 4th layer cannot be represented in GRIB header UDG3F405.84
ECMWF_SOIL_LEVELS(4)=REAL(BLOCK1(7)+289)/200.0 UDG3F405.85
ECMWF_SOIL_DEPTHS(4)=REAL(289-BLOCK1(7))/100.0 UDG3F405.86
END IF UDG3F405.87
! Using soil moisture UDG3F405.88
IF(BLOCK1(5).EQ.140.OR.BLOCK1(5).EQ.171.OR. UDG3F405.89
& BLOCK1(5).EQ.184.OR.BLOCK1(5).EQ.237)THEN UDG3F405.90
SM_LEVELS=SM_LEVELS+1 UDG3F405.91
SM_CODES(SM_LEVELS)=BLOCK1(5) UDG3F405.92
END IF UDG3F405.93
IF(ST_LEVELS.EQ.0)THEN UDG3F405.94
IF(BLOCK1(5).EQ.140)THEN UDG3F405.95
ECMWF_SOIL_LEVELS(1)=REAL(BLOCK1(7)+BLOCK1(8))/200.0 UDG3F405.96
ECMWF_SOIL_DEPTHS(1)=REAL(BLOCK1(8)-BLOCK1(7))/100.0 UDG3F405.97
ELSE IF(BLOCK1(5).EQ.171)THEN UDG3F405.98
ECMWF_SOIL_LEVELS(2)=REAL(BLOCK1(7)+BLOCK1(8))/200.0 UDG3F405.99
ECMWF_SOIL_DEPTHS(2)=REAL(BLOCK1(8)-BLOCK1(7))/100.0 UDG3F405.100
ELSE IF(BLOCK1(5).EQ.184)THEN UDG3F405.101
ECMWF_SOIL_LEVELS(3)=REAL(BLOCK1(7)+BLOCK1(8))/200.0 UDG3F405.102
ECMWF_SOIL_DEPTHS(3)=REAL(BLOCK1(8)-BLOCK1(7))/100.0 UDG3F405.103
ELSE IF(BLOCK1(5).EQ.237)THEN UDG3F405.104
!Bottom depth of 4th layer cannot be represented in GRIB header UDG3F405.105
ECMWF_SOIL_LEVELS(4)=REAL(BLOCK1(7)+289)/200.0 UDG3F405.106
ECMWF_SOIL_DEPTHS(4)=REAL(289-BLOCK1(7))/100.0 UDG3F405.107
END IF UDG3F405.108
END IF UDG3F405.109
END IF UDG3F405.110
! Treat log surface pressure as single level field UDG3F405.111
IF(BLOCK1(5).EQ.152)THEN UDG3F405.112
N_S_FIELDS=N_S_FIELDS+1 UDG3F405.113
S_CODES(N_S_FIELDS)=BLOCK1(5) UDG3F405.114
END IF UDG3F405.115
GRIB_TO1.161
IF(BLOCK1(5).EQ.134)THEN UDG3F405.116
LPSTAR=.TRUE. UDG3F405.117
ELSE IF (BLOCK1(5).EQ.152)THEN UDG3F405.118
LPSTAR=.FALSE. UDG3F405.119
END IF UDG3F405.120
GRIB_TO1.164
C Count up number of levels and their values using u-component of wind GRIB_TO1.165
IF(BLOCK1(5).EQ.131)THEN UDG3F400.123
P_LEVELS=P_LEVELS+1 UDG3F400.124
IF(BLOCK1(6).EQ.100)THEN UDG3F400.125
IF(BLOCK1(7).GT.850)THEN UDG3F400.126
BL_LEVELS=BL_LEVELS+1 UDG3F400.127
ENDIF UDG3F400.128
AK_GRIB(P_LEVELS)=BLOCK1(7)*100. UDG3F400.129
BK_GRIB(P_LEVELS)=0. UDG3F400.130
ELSE IF(BLOCK1(6).EQ.109)THEN UDG3F400.131
HYBRID=.TRUE. UDG3F400.132
ELSE UDG3F400.133
WRITE(6,'('' *ERROR* Grib data not on press'' UDG3F400.134
& ,''ure or hybrid levels'')') UDG3F400.135
CALL ABORT UDG3F400.136
ENDIF GRIB_TO1.174
ENDIF GRIB_TO1.176
ENDIF GRIB_TO1.178
GRIB_TO1.179
ENDIF ! TEST GRIB AD110293.110
GRIB_TO1.181
ENDDO GRIB_TO1.182
UDG3F400.137
IF (GRIB_RECORD_LENGTH(K).EQ.IMDI)THEN UDG3F400.138
CALL GETPOS8(NFTIN,POINTER) AD110293.111
GRIB_RECORD_LENGTH(K)=POINTER-1-GRIB_RECORD_START_ADDRESS(K-1) AD110293.112
END IF UDG3F400.139
LEN2_LOOKUP=K AD110293.113
WRITE(6,'(1X,3I6,2I12)')K,GRIB_CODE_VALUE(K) AD110293.114
*,GRIB_PRESSURE_LEVEL(K) AD110293.115
*,GRIB_RECORD_LENGTH(K),GRIB_RECORD_START_ADDRESS(K) AD110293.116
GRIB_TO1.183
CALL SETPOS8(NFTIN,0) AD110293.117
GRIB_TO1.185
AD110293.118
C If hybrid levels, copy from output values specified on UI AD110293.119
C This means that further vertical interpolation can only be AD110293.120
C done by a second iteration of reconfiguration. AD110293.121
AD110293.122
IF(HYBRID)THEN AD110293.123
WRITE(6,*)' *** WARNING ****' AD110293.124
WRITE(6,*)' Grib data is on ECMWF model levels' AD110293.125
WRITE(6,*)' ECMWF equivalent level values must' AD110293.126
WRITE(6,*)' be specified on User Interface' AD110293.127
WRITE(6,*)' *** WARNING ****' AD110293.128
READ(5,VERTICAL) AD110293.129
REWIND(5) AD110293.130
IF(METH_LEV_CALC.EQ.9.AND.P_LEVELS.EQ.NLEVELS19)THEN UDG1F305.252
! UDG1F305.253
! Use preset values of AK, BK, AKH and BKH (19 levels) UDG1F305.254
! UDG1F305.255
DO I=1,NLEVELS19 UDG1F305.256
AK(I)=AK_ECMWF_19(I) UDG1F305.257
BK(I)=BK_ECMWF_19(I) UDG1F305.258
END DO UDG1F305.259
DO I=1,NLEVELS19+1 UDG1F305.260
AKH(I)=AKH_ECMWF_19(I) UDG1F305.261
BKH(I)=BKH_ECMWF_19(I) UDG1F305.262
END DO UDG1F305.263
UDG1F305.264
ELSEIF(METH_LEV_CALC.EQ.9.AND.P_LEVELS.EQ.NLEVELS31)THEN UDG1F305.265
! UDG1F305.266
! Use preset values of AK, BK, AKH and BKH (31 levels) UDG1F305.267
! UDG1F305.268
DO I=1,NLEVELS31 UDG1F305.269
AK(I)=AK_ECMWF_31(I) UDG1F305.270
BK(I)=BK_ECMWF_31(I) UDG1F305.271
END DO UDG1F305.272
DO I=1,NLEVELS31+1 UDG1F305.273
AKH(I)=AKH_ECMWF_31(I) UDG1F305.274
BKH(I)=BKH_ECMWF_31(I) UDG1F305.275
END DO UDG1F305.276
UDG1F305.277
ELSEIF(METH_LEV_CALC.NE.9)THEN UDG1F305.278
! UDG1F305.279
! Calculate AK, BK, AKH and BKH from ETAH UDG1F305.280
! UDG1F305.281
UDG1F305.282
CALL ABCALC(METH_LEV_CALC,1,1,P_LEVELS UDG1F305.283
&, ETAH(MIN_PRS_HLEV),ETAH(MAX_SIG_HLEV),ETAH UDG1F305.284
&, AK,BK,AKH,BKH,IERR) UDG1F305.285
UDG1F305.286
IF(IERR.NE.0) THEN UDG1F305.287
WRITE(6,*) UDG1F305.288
& ' *ERROR* IN ABCALC FROM GRIB_TO_UNIFIED_MODEL. IERR = ' UDG1F305.289
& ,IERR UDG1F305.290
WRITE(6,*) ' CHECK YOUR ATMOS LEVEL SPEC FOR MODEL' UDG1F305.291
CALL ABORT UDG1F305.292
END IF UDG1F305.293
ELSE UDG1F305.294
WRITE(6,*) ' *ERROR* IN GRIB_TO_UNIFIED_MODEL. Presets ' UDG1F305.295
&, 'not available' UDG1F305.296
CALL ABORT UDG1F305.297
ENDIF UDG1F305.298
UDG1F305.299
WRITE(6,*) 'AK=' UDG1F305.300
WRITE(6,'(3(E22.15,'',''))')(AK(J),J=1,P_LEVELS) UDG1F305.301
WRITE(6,*) 'BK=' UDG1F305.302
WRITE(6,'(3(E22.15,'',''))')(BK(J),J=1,P_LEVELS) UDG1F305.303
WRITE(6,*) 'AKH=' UDG1F305.304
WRITE(6,'(3(E22.15,'',''))')(AKH(J),J=1,P_LEVELS+1) UDG1F305.305
WRITE(6,*) 'BKH=' UDG1F305.306
WRITE(6,'(3(E22.15,'',''))')(BKH(J),J=1,P_LEVELS+1) UDG1F305.307
DO I=1,P_LEVELS+1 AD110293.131
AKH_GRIB(P_LEVELS+2-I)=VERT_COORDS(I) UDG3F400.140
BKH_GRIB(P_LEVELS+2-I)=VERT_COORDS(I+P_LEVELS+1) UDG3F400.141
ENDDO AD110293.134
BL_LEVELS=4 AD110293.135
AD110293.136
IF(AK(1).EQ.RMDI.OR.AK(1).EQ.RMDI_OLD.OR. TJ050593.73
! BK(1).EQ.RMDI.OR.BK(1).EQ.RMDI_OLD.OR. UDG3F400.142
! AKH(1).EQ.RMDI.OR.AKH(1).EQ.RMDI_OLD.OR. UDG3F400.143
! BKH(1).EQ.RMDI.OR.BKH(1).EQ.RMDI_OLD)THEN UDG3F400.144
WRITE(6,'('' *ERROR* Full and half level hybrid coords '', AD110293.139
! ''not specified on namelist VERTICAL'')') UDG3F400.145
ENDIF AD110293.141
AD110293.142
DO I=1,P_LEVELS AD110293.143
AK_GRIB(I)=AK(I) AD110293.144
BK_GRIB(I)=BK(I) AD110293.145
ENDDO AD110293.146
AD110293.147
ENDIF AD110293.148
UDG3F405.121
! UDG3F405.122
IF((ST_LEVELS.EQ.1.OR.ST_LEVELS.EQ.M_SOIL_LEVELS+1) UDG3F405.123
& .AND.ST_CODES(1).EQ.139)THEN UDG3F405.124
LSKINTEMP=.FALSE. UDG3F405.125
POS_LSM=POS_LSM+1 UDG3F405.126
ST_LEVELS=ST_LEVELS-1 UDG3F405.127
N_S_FIELDS=N_S_FIELDS+1 UDG3F405.128
S_CODES(N_S_FIELDS)=ST_CODES(1) UDG3F405.129
IF(ST_LEVELS.NE.0)THEN UDG3F405.130
DO K=1,ST_LEVELS UDG3F405.131
ST_CODES(K)=ST_CODES(K+1) UDG3F405.132
END DO UDG3F405.133
END IF UDG3F405.134
END IF UDG3F405.135
GRIB_TO1.190
C Convert GRIB code to phrase GRIB_TO1.191
DO J=1,N_S_FIELDS GRIB_TO1.192
I=0 GRIB_TO1.193
DO K=1,N_CODES GRIB_TO1.194
IF(S_CODES(J).EQ.GRIB_CODE(K))I=K GRIB_TO1.195
ENDDO GRIB_TO1.196
IF(I.EQ.0)THEN GRIB_TO1.197
WRITE(6,'('' *ERROR* GRIB CODE NOT RECOGNIZED'',I6)')S_CODES(J) GRIB_TO1.198
CALL ABORT GRIB_TO1.199
ENDIF GRIB_TO1.200
S_CODES_PHRASE(J)=GRIB_CODE_PHRASE(I) GRIB_TO1.201
IF(.NOT.LSKINTEMP.AND.S_CODES(J).EQ.139)THEN UDG3F405.136
S_CODES_PHRASE(J)='Surface Temperature' UDG3F405.137
END IF UDG3F405.138
ENDDO GRIB_TO1.202
IF(ST_LEVELS.NE.0)THEN UDG3F405.139
DO J=1,ST_LEVELS UDG3F405.140
I=0 UDG3F405.141
DO K=1,N_CODES UDG3F405.142
IF(ST_CODES(J).EQ.GRIB_CODE(K))I=K UDG3F405.143
END DO UDG3F405.144
IF(I.EQ.0)THEN UDG3F405.145
WRITE(6,'('' *ERROR* GRIB CODE NOT RECOGNIZED'',I6)') UDG3F405.146
& ST_CODES(J) UDG3F405.147
CALL ABORT UDG3F405.148
ELSE UDG3F405.149
ST_CODES_PHRASE(J)=GRIB_CODE_PHRASE(I) UDG3F405.150
END IF UDG3F405.151
END DO UDG3F405.152
END IF UDG3F405.153
IF(SM_LEVELS.NE.0)THEN UDG3F405.154
DO J=1,SM_LEVELS UDG3F405.155
I=0 UDG3F405.156
DO K=1,N_CODES UDG3F405.157
IF(SM_CODES(J).EQ.GRIB_CODE(K))I=K UDG3F405.158
END DO UDG3F405.159
IF(I.EQ.0)THEN UDG3F405.160
WRITE(6,'('' *ERROR* GRIB CODE NOT RECOGNIZED'',I6)') UDG3F405.161
& SM_CODES(J) UDG3F405.162
CALL ABORT UDG3F405.163
ELSE UDG3F405.164
SM_CODES_PHRASE(J)=GRIB_CODE_PHRASE(I) UDG3F405.165
END IF UDG3F405.166
END DO UDG3F405.167
END IF UDG3F405.168
UDG3F405.169
DO J=1,N_M_FIELDS GRIB_TO1.203
I=0 GRIB_TO1.204
DO K=1,N_CODES GRIB_TO1.205
IF(M_CODES(J).EQ.GRIB_CODE(K))I=K GRIB_TO1.206
ENDDO GRIB_TO1.207
IF(I.EQ.0)THEN GRIB_TO1.208
WRITE(6,'('' *ERROR* GRIB CODE NOT RECOGNIZED'',I6)')M_CODES(J) GRIB_TO1.209
CALL ABORT GRIB_TO1.210
ENDIF GRIB_TO1.211
M_CODES_PHRASE(J)=GRIB_CODE_PHRASE(I) GRIB_TO1.212
ENDDO GRIB_TO1.213
GRIB_TO1.214
WRITE(6,'(/,''GRIB DATA SUMMARY '',/, UDG3F400.146
* '' ----------------- '',/, GRIB_TO1.216
* '' Date '',I2,''Z'',3I6,/, GRIB_TO1.217
* '' No of fields '',I6,/, GRIB_TO1.218
* '' Dimension (EWxNS) '',I6,'' x'',I6,/, GRIB_TO1.219
* '' Number of levels '',I6,/, GRIB_TO1.220
* '' Number of BL levels '',I6,/, GRIB_TO1.221
* '' Number of upper level fields '',I6,/, GRIB_TO1.222
* '' Upper level GRIB codes '')') GRIB_TO1.223
* HOUR,DAY,MONTH,YEAR GRIB_TO1.224
*,LEN2_LOOKUP,ROW_LENGTH,P_ROWS,P_LEVELS,BL_LEVELS GRIB_TO1.225
*,N_M_FIELDS GRIB_TO1.226
WRITE(6,'(1x,I6,2X,A30)') GRIB_TO1.227
* (M_CODES(I),M_CODES_PHRASE(I),I=1,N_M_FIELDS) GRIB_TO1.228
WRITE(6,'('' Number of Single level fields '',I6)') GRIB_TO1.229
* N_S_FIELDS GRIB_TO1.230
WRITE(6,'(1x,I6,2X,A30)') GRIB_TO1.231
* (S_CODES(I),S_CODES_PHRASE(I),I=1,N_S_FIELDS) GRIB_TO1.232
WRITE(6,*) 'Number of soil temperature levels ',ST_LEVELS UDG3F405.170
IF(ST_LEVELS.GT.0)THEN UDG3F405.171
WRITE(6,'(1x,I6,2X,A30)') UDG3F405.172
& (ST_CODES(I),ST_CODES_PHRASE(I),I=1,ST_LEVELS) UDG3F405.173
END IF UDG3F405.174
WRITE(6,*) 'Number of soil moisture levels ',SM_LEVELS UDG3F405.175
IF(SM_LEVELS.GT.0)THEN UDG3F405.176
WRITE(6,'(1x,I6,2X,A30)') UDG3F405.177
& (SM_CODES(I),SM_CODES_PHRASE(I),I=1,SM_LEVELS) UDG3F405.178
END IF UDG3F405.179
IF(HYBRID)THEN AD110293.149
WRITE(6,'(/,'' Data on hybrid levels'')') UDG3F400.147
ELSE AD110293.151
WRITE(6,'(/,'' Data on pressure levels'')') UDG3F400.148
UDG3F400.149
ENDIF AD110293.153
WRITE(6,'('' Level values '')') AD110293.154
WRITE(6,'(''AK'')') AD110293.155
WRITE(6,'(5E12.5)') AD110293.156
* (AK_GRIB(K),K=1,P_LEVELS) AD110293.157
WRITE(6,'(''BK'')') AD110293.158
WRITE(6,'(5E12.5)') AD110293.159
* (BK_GRIB(K),K=1,P_LEVELS) AD110293.160
GRIB_TO1.235
! Check for consistent number of soil levels UDG3F405.180
IF(ST_LEVELS.EQ.0)THEN UDG3F405.181
N_SOIL_LEVELS=SM_LEVELS UDG3F405.182
ELSE IF(SM_LEVELS.EQ.0)THEN UDG3F405.183
N_SOIL_LEVELS=ST_LEVELS UDG3F405.184
ELSE IF(ST_LEVELS.NE.M_SOIL_LEVELS)THEN UDG3F405.185
WRITE(6,*) 'Error in routine GRIB_TO_UNIFIED MODEL' UDG3F405.186
WRITE(6,*) 'Incorrect number of soil temperature fields' UDG3F405.187
CALL ABORT UDG3F405.188
ELSE IF(SM_LEVELS.NE.M_SOIL_LEVELS)THEN UDG3F405.189
write(6,*) 'Error in routine GRIB_TO_UNIFIED MODEL' UDG3F405.190
write(6,*) 'Incorrect number of soil moisture fields' UDG3F405.191
CALL ABORT UDG3F405.192
ELSE UDG3F405.193
N_SOIL_LEVELS=M_SOIL_LEVELS UDG3F405.194
END IF UDG3F405.195
C Call remainder of program using numbers to dimension arrays GRIB_TO1.236
CALL GRIB_UM( UDG2F305.412
*CALL ARGPPX UDG2F305.413
& LEN2_LOOKUP,ROW_LENGTH,P_ROWS,P_LEVELS, UDG2F305.414
& BL_LEVELS,SM_LEVELS,ST_LEVELS, UDG3F405.196
& YEAR,MONTH,DAY,HOUR,MINUTE, UDG3F405.197
& N_M_FIELDS,N_S_FIELDS,POS_LSM, UDG3F405.198
& N_SOIL_LEVELS,LSKINTEMP, UDG3F405.199
& ECMWF_SOIL_LEVELS,ECMWF_SOIL_DEPTHS, UDG3F405.200
& NFTIN,NFTOUT,LPSTAR,GRIB_RECORD_START_ADDRESS UDG3F405.201
*,GRIB_RECORD_LENGTH,AK_GRIB,BK_GRIB,HYBRID) AD110293.163
GRIB_TO1.240
RETURN GRIB_TO1.241
END GRIB_TO1.242
GRIB_TO1.243
*ENDIF GRIB_TO1.244