SUBROUTINE CONVHEAD(VERT_ARG,HORIZ_ARG, 1,6CONVHEA1.20
* LEN_FIXHD_OUT,FIXHD_OUT,LEN_FIXHD_IN,FIXHD_IN, CONVHEA1.21
* LEN_INTHD_OUT,INTHD_OUT,LEN_INTHD_IN,INTHD_IN, CONVHEA1.22
* LEN_REALHD_OUT,REALHD_OUT,LEN_REALHD_IN,REALHD_IN, CONVHEA1.23
* LEN2_LEVDEPC_OUT,LEN1_LEVDEPC_OUT,LEVDEPC_OUT, CONVHEA1.24
* LEN2_LEVDEPC_IN,LEN1_LEVDEPC_IN,LEVDEPC_IN, CONVHEA1.25
* LEN1_ROWDEPC_OUT,LEN2_ROWDEPC_OUT,ROWDEPC_OUT, CONVHEA1.26
* LEN1_ROWDEPC_IN,LEN2_ROWDEPC_IN,ROWDEPC_IN, CONVHEA1.27
* LEN1_COLDEPC_IN,LEN2_COLDEPC_IN,COLDEPC_IN, CONVHEA1.28
* LEN1_COLDEPC_OUT,LEN2_COLDEPC_OUT,COLDEPC_OUT, CONVHEA1.29
* LEN1_FLDDEPC_IN,LEN2_FLDDEPC_IN,FLDDEPC_IN, CONVHEA1.30
* LEN1_FLDDEPC_OUT,LEN2_FLDDEPC_OUT,FLDDEPC_OUT, CONVHEA1.31
* LEN_EXTCNST_IN,EXTCNST_IN,LEN_EXTCNST_OUT,EXTCNST_OUT, CONVHEA1.32
* LEN_CFI1_IN,CFI1_IN,LEN_CFI1_OUT,CFI1_OUT, CONVHEA1.33
* LEN_CFI2_IN,CFI2_IN,LEN_CFI2_OUT,CFI2_OUT, CONVHEA1.34
* LEN_CFI3_IN,CFI3_IN,LEN_CFI3_OUT,CFI3_OUT, CONVHEA1.35
* LEN_DUMPHIST_OUT,DUMPHIST_OUT,LEN_DUMPHIST_IN,DUMPHIST_IN, CONVHEA1.36
* LEN1_LOOKUP_OUT,LEN2_LOOKUP_OUT,LEN_DATA_OUT, CONVHEA1.37
* ROW_LENGTH_OUT,P_ROWS_OUT,P_LEVELS_OUT,Q_LEVELS_OUT, CONVHEA1.38
* ST_LEVELS_OUT,SM_LEVELS_OUT, UJS1F401.239
* TR_LEVELS_OUT,BL_LEVELS_OUT,TR_VARS_OUT, UJS1F401.240
& MAX_VARIABLES_OUT, OZONE_LEVELS_OUT, GDR6F405.34
* U_ROWS_OUT,U_FIELD_OUT,P_FIELD_OUT,TR_LEVELS_ADV_OUT, CONVHEA1.41
* RadialGridOut, UIE2F401.359
* P_LEVELS_IN,Q_LEVELS_IN,ST_LEVELS_IN,SM_LEVELS_IN, UJS1F401.241
* TOPOG_MASK,RESET,OCEAN UJS1F401.242
*,C_GRID_OUT) AD200593.198
CONVHEA1.43
IMPLICIT NONE CONVHEA1.44
CONVHEA1.45
INTEGER CONVHEA1.46
* LEN_FIXHD_OUT !IN Length of fixed length header (output) CONVHEA1.47
*,LEN_FIXHD_IN !IN Length of fixed length header (input) CONVHEA1.48
*,LEN_INTHD_OUT !IN Length of integer header (output) CONVHEA1.49
*,LEN_INTHD_IN !IN Length of integer header (input) CONVHEA1.50
*,LEN_REALHD_OUT !IN Length of real header (output) CONVHEA1.51
*,LEN_REALHD_IN !IN Length of real header (input) CONVHEA1.52
*,LEN2_LEVDEPC_OUT !IN 2nd dim of lev dep consts (output) CONVHEA1.53
*,LEN1_LEVDEPC_OUT !IN ist dim of lev dep consts (output) CONVHEA1.54
*,LEN2_LEVDEPC_IN !IN 2nd dim of lev dep consts (input) CONVHEA1.55
*,LEN1_LEVDEPC_IN !IN 1st dim of lev dep consts (input) CONVHEA1.56
*,LEN1_ROWDEPC_IN !IN 1st dim of row dep consts (input) CONVHEA1.57
*,LEN2_ROWDEPC_IN !IN 2nd dim of row dep consts (input) CONVHEA1.58
*,LEN1_ROWDEPC_OUT !IN 1st dim of row dep consts (output) CONVHEA1.59
*,LEN2_ROWDEPC_OUT !IN 2nd dim of row dep consts (output) CONVHEA1.60
*,LEN1_COLDEPC_IN !IN 1st dim of col dep consts (input) CONVHEA1.61
*,LEN2_COLDEPC_IN !IN 2nd dim of col dep consts (input) CONVHEA1.62
*,LEN1_COLDEPC_OUT !IN 1st dim of col dep consts (output) CONVHEA1.63
*,LEN2_COLDEPC_OUT !IN 2nd dim of col dep consts (output) CONVHEA1.64
*,LEN_DUMPHIST_OUT !IN Length of history header (output) CONVHEA1.65
*,LEN_DUMPHIST_IN !IN Length of history header (input) CONVHEA1.66
*,LEN_CFI1_IN !IN Len of compressed field index1 (input) CONVHEA1.67
*,LEN_CFI2_IN !IN Len of compressed field index2 (input) CONVHEA1.68
*,LEN_CFI3_IN !IN Len of compressed field index3 (input) CONVHEA1.69
*,LEN_CFI1_OUT !IN Len of compressed field index1 (output) CONVHEA1.70
*,LEN_CFI2_OUT !IN Len of compressed field index2 (output) CONVHEA1.71
*,LEN_CFI3_OUT !IN Len of compressed field index3 (output) CONVHEA1.72
*,LEN1_LOOKUP_OUT !IN 1st dim of lookup header (output) CONVHEA1.73
*,LEN2_LOOKUP_OUT !IN 2nd dim of lookup header (output) CONVHEA1.74
*,LEN_DATA_OUT !IN Length of output data (output) CONVHEA1.75
*,LEN_EXTCNST_OUT !IN Length of extra constants (output) CONVHEA1.76
*,LEN_EXTCNST_IN !IN Length of extra constants (input) CONVHEA1.77
*,LEN1_FLDDEPC_OUT !IN 1st dim of field dep consts (output) CONVHEA1.78
*,LEN2_FLDDEPC_OUT !IN 2nd dim of field dep consts (output) CONVHEA1.79
*,LEN1_FLDDEPC_IN !IN 1st dim of field dep consts (input) CONVHEA1.80
*,LEN2_FLDDEPC_IN !IN 2nd dim of field dep consts (input) CONVHEA1.81
*,ROW_LENGTH_OUT !IN No of points E-W (output) CONVHEA1.82
*,P_ROWS_OUT !IN No of P-points N-S (output) CONVHEA1.83
*,P_LEVELS_OUT !IN No of levels (output) CONVHEA1.84
*,Q_LEVELS_OUT !IN No of wet levels (output) CONVHEA1.85
*,SM_LEVELS_OUT !IN No of soil moisture levels (output) UJS1F401.243
*,ST_LEVELS_OUT !IN No of deep soil temp levels (output) UJS1F401.244
*,TR_LEVELS_OUT !IN No of tracer levels (output) CONVHEA1.87
*,TR_LEVELS_ADV_OUT !IN No of tracer levels to be adv'ted (output) CONVHEA1.88
*,BL_LEVELS_OUT !IN No of b.l. levels (output) CONVHEA1.89
*,TR_VARS_OUT !IN No of tracer variables (output) CONVHEA1.90
*,MAX_VARIABLES_OUT !IN Maximum no of variables (output) CONVHEA1.91
*,OZONE_LEVELS_OUT !IN No of ozone levels (output) CONVHEA1.94
*,P_LEVELS_IN !IN No of levels (input) CONVHEA1.95
*,Q_LEVELS_IN !IN No of wet levels (input) CONVHEA1.96
*,SM_LEVELS_IN !IN No of soil moisture levels (input) UJS1F401.245
*,ST_LEVELS_IN !IN No of deep soil temp levels (input) UJS1F401.246
*,U_ROWS_OUT !IN No of uv-points N-S (output) CONVHEA1.98
*,U_FIELD_OUT !IN No of UV-points per level (output) CONVHEA1.99
*,P_FIELD_OUT !IN No of p-points per level (output) CONVHEA1.100
CONVHEA1.101
INTEGER CONVHEA1.102
* FIXHD_OUT(LEN_FIXHD_OUT) CONVHEA1.103
*,FIXHD_IN(LEN_FIXHD_IN) CONVHEA1.104
*,INTHD_OUT(LEN_INTHD_OUT) CONVHEA1.105
*,INTHD_IN(LEN_INTHD_IN) CONVHEA1.106
*,CFI1_IN(LEN_CFI1_IN+1) CONVHEA1.107
*,CFI2_IN(LEN_CFI2_IN+1) CONVHEA1.108
*,CFI3_IN(LEN_CFI3_IN+1) CONVHEA1.109
*,CFI1_OUT(LEN_CFI1_OUT+1) CONVHEA1.110
*,CFI2_OUT(LEN_CFI2_OUT+1) CONVHEA1.111
*,CFI3_OUT(LEN_CFI3_OUT+1) CONVHEA1.112
CONVHEA1.113
LOGICAL CONVHEA1.114
* TOPOG_MASK(P_FIELD_OUT) !IN Mask for topography subarea CONVHEA1.115
*,RESET !IN =T, reset fc time info in FIXHD CONVHEA1.116
*,OCEAN !IN =T, ocean reconfiguration CONVHEA1.117
*,C_GRID_OUT !IN =T C-grid; =F B-grid output grid AD200593.199
*,RadialGridOut ! IN Indicates whether data is on a UIE2F401.360
* ! radial coordinate UIE2F401.361
CONVHEA1.118
REAL CONVHEA1.119
* REALHD_OUT(LEN_REALHD_OUT) CONVHEA1.120
*,REALHD_IN(LEN_REALHD_IN) CONVHEA1.121
*,LEVDEPC_OUT(LEN2_LEVDEPC_OUT*LEN1_LEVDEPC_OUT) CONVHEA1.122
*,LEVDEPC_IN(LEN2_LEVDEPC_IN*LEN1_LEVDEPC_IN) CONVHEA1.123
*,ROWDEPC_IN(LEN1_ROWDEPC_IN*LEN2_ROWDEPC_IN+1) CONVHEA1.124
*,ROWDEPC_OUT(LEN1_ROWDEPC_OUT*LEN2_ROWDEPC_OUT+1) CONVHEA1.125
*,COLDEPC_IN(LEN1_COLDEPC_IN*LEN2_COLDEPC_IN+1) CONVHEA1.126
*,COLDEPC_OUT(LEN1_COLDEPC_OUT*LEN2_COLDEPC_OUT+1) CONVHEA1.127
*,EXTCNST_IN(LEN_EXTCNST_IN+1) CONVHEA1.128
*,EXTCNST_OUT(LEN_EXTCNST_OUT+1) CONVHEA1.129
*,FLDDEPC_IN(LEN1_FLDDEPC_IN*LEN2_FLDDEPC_IN+1) CONVHEA1.130
*,FLDDEPC_OUT(LEN1_FLDDEPC_OUT*LEN2_FLDDEPC_OUT+1) CONVHEA1.131
*,DUMPHIST_OUT(LEN_DUMPHIST_OUT) CONVHEA1.132
*,DUMPHIST_IN(LEN_DUMPHIST_IN) CONVHEA1.133
CONVHEA1.134
EXTERNAL SETFHEAD,ABCALC UDG1F305.5
UDG1F305.6
INTEGER FIXHD9 !Value of FIXHD_OUT(9) UDG1F305.7
INTEGER I !Loop variable UDG1F305.8
INTEGER IERR !Return code from routine ABCALC UDG1F305.9
INTEGER IJ !Counter UDG1F305.10
INTEGER IPOS !Start address of data in dump UDG1F305.11
INTEGER ITIMES !Counter UDG1F305.12
INTEGER IRES !Resolut'n of print of topog msk UDG1F305.13
INTEGER J !Loop variable UDG1F305.14
INTEGER K !Loop variable UDG1F305.15
INTEGER LEN_FIXHD !Length of fixed header UDG1F305.16
INTEGER LEN_INTHD !Length of integer header UDG1F305.17
INTEGER LEN_REALHD !Length of real header UDG1F305.18
INTEGER LEN2_LEVDEPC !2nd dimension for LEVDEPC array UDG1F305.19
INTEGER JSOIL_DEPTHS !Soil thickness pointer for AJS1F400.140
C ! level dependent constants AJS1F400.141
UDG1F305.20
REAL P !Reference pressure AK+BK*1.E+5 UDG1F305.21
REAL THREF !Reference Theta UDG1F305.22
REAL AL10000 !ln(10000) UDG1F305.23
UDG1F305.24
LOGICAL VERT_ARG !T if vertical interpolation UDG1F305.25
! required UDG1F305.26
LOGICAL HORIZ_ARG !T if horizontal interpolation UDG1F305.27
! required UDG1F305.28
CONVHEA1.150
C ------------------------------------------------------------- CONVHEA1.151
*CALL C_R_CP 
CONVHEA1.152
*CALL C_MDI TJ050593.21
*CALL C_VERT UDG1F305.29
*CALL C_HORIZ UDG1F305.30
*CALL C_ECMWF_19 UDG1F305.31
*CALL C_ECMWF_31 UDG1F305.32
*CALL C_SOILTH AJS1F400.142
*CALL SOIL_THICK UJS1F401.247
*CALL CNTLATM UJS1F401.248
C ------------------------------------------------------------- CONVHEA1.153
CONVHEA1.154
UDG1F305.33
REAL RELHD(100) CONVHEA1.217
INTEGER INTHD(100),FIXHD(256) CONVHEA1.218
CONVHEA1.219
NAMELIST /HEADERS/ INTHD,RELHD,FIXHD CONVHEA1.220
CONVHEA1.221
DATA CONVHEA1.222
* INTHD/100*IMDI/ TJ050593.31
*,FIXHD/256*IMDI/ TJ050593.32
*,RELHD/100*RMDI/ TJ050593.33
CONVHEA1.226
C-------------------------------------------------------------- CONVHEA1.227
C Read in values specified on NAMELISTs CONVHEA1.228
C-------------------------------------------------------------- CONVHEA1.229
CONVHEA1.230
READ(5,VERTICAL) CONVHEA1.231
READ(5,HORIZONT) CONVHEA1.232
READ(5,HEADERS) CONVHEA1.233
CONVHEA1.234
IF(GLOBAL)THEN UDG1F305.34
IF(.NOT.OCEAN)THEN UDG1F305.35
DELTA_LAMBDA=360./REAL(ROW_LENGTH_OUT) UDG1F305.36
DELTA_PHI=180./REAL(P_ROWS_OUT-1) UDG1F305.37
HORIZ_GRID_TYPE=0 UDG1F305.38
ELSE UDG1F305.39
HORIZ_GRID_TYPE=0 UDG1F305.40
ENDIF UDG1F305.41
ELSEIF((PHI_TLC.GT.89.99).AND. UDG1F305.42
& (DELTA_LAMBDA*ROW_LENGTH_OUT.GT.359.99).AND. UDG1F305.43
& (DELTA_PHI*(P_ROWS_OUT-1).LT.89.99).AND. UDG1F305.44
& (DELTA_PHI*(P_ROWS_OUT-1).GT.90.01))THEN UDG1F305.45
IF(.NOT.OCEAN)THEN UDG1F305.46
DELTA_LAMBDA=360./REAL(ROW_LENGTH_OUT) UDG1F305.47
DELTA_PHI=90./REAL(P_ROWS_OUT-1) UDG1F305.48
HORIZ_GRID_TYPE=1 UDG1F305.49
ELSE UDG1F305.50
HORIZ_GRID_TYPE=1 UDG1F305.51
ENDIF UDG1F305.52
ELSEIF((PHI_TLC.LT.-89.99).AND. UDG1F305.53
& (DELTA_LAMBDA*ROW_LENGTH_OUT.GT.359.99).AND. UDG1F305.54
& (DELTA_PHI*(P_ROWS_OUT-1).LT.89.99).AND. UDG1F305.55
& (DELTA_PHI*(P_ROWS_OUT-1).GT.90.01))THEN UDG1F305.56
IF(.NOT.OCEAN)THEN UDG1F305.57
DELTA_LAMBDA=360./REAL(ROW_LENGTH_OUT) UDG1F305.58
DELTA_PHI=90./REAL(P_ROWS_OUT-1) UDG1F305.59
HORIZ_GRID_TYPE=2 UDG1F305.60
ELSE UDG1F305.61
HORIZ_GRID_TYPE=2 UDG1F305.62
ENDIF UDG1F305.63
ELSEIF(ROW_LENGTH_OUT*DELTA_LAMBDA.GT.359.99)THEN UDG1F305.64
IF(PHI_NPOLE.GT.89.99)THEN UDG1F305.65
HORIZ_GRID_TYPE=4 UDG1F305.66
ELSE UDG1F305.67
HORIZ_GRID_TYPE=104 UDG1F305.68
ENDIF UDG1F305.69
ELSE UDG1F305.70
IF(PHI_NPOLE.GT.89.99)THEN UDG1F305.71
HORIZ_GRID_TYPE=3 UDG1F305.72
ELSE UDG1F305.73
HORIZ_GRID_TYPE=103 UDG1F305.74
ENDIF UDG1F305.75
ENDIF UDG1F305.76
UDG1F305.77
! Calculate VERT_COORD_TYPE UDG1F305.78
IF(OCEAN)THEN UDG1F305.79
VERT_COORD_TYPE=4 UDG1F305.80
ELSEIF(MAX_SIG_HLEV.EQ.P_LEVELS_OUT+1)THEN UDG1F305.81
VERT_COORD_TYPE=2 UDG1F305.82
ELSEIF(MIN_PRS_HLEV.EQ.1)THEN UDG1F305.83
VERT_COORD_TYPE=3 UDG1F305.84
ELSE UDG1F305.85
VERT_COORD_TYPE=1 UDG1F305.86
ENDIF UDG1F305.87
! If RadialGridOut true then copy across existing value of fixhd( UIE2F401.370
! B->C then fixhd(3) is altered in subroutine INIT_LS. C->C then UIE2F401.371
! fixhd(3) already indicates that the data is on a radial grid UIE2F401.372
IF((RadialGridOut))THEN UIE2F401.373
VERT_COORD_TYPE = FIXHD_IN(3) UIE2F401.374
END IF UIE2F401.375
UDG1F305.88
CONVHEA1.244
WRITE(6,VERTICAL) CONVHEA1.245
WRITE(6,HORIZONT) CONVHEA1.246
WRITE(6,HEADERS) CONVHEA1.247
! UDG1F305.89
! Calculate AK,BK,AKH,BKH from ETAH if atmosphere dump UDG1F305.90
! UDG1F305.91
IF(.NOT.OCEAN)THEN UDG1F305.92
UDG1F305.93
IF(METH_LEV_CALC.EQ.9.AND.P_LEVELS_OUT.EQ.NLEVELS19)THEN UDG1F305.94
! UDG1F305.95
! Use preset values of AK, BK, AKH and BKH (19 levels) UDG1F305.96
! UDG1F305.97
DO I=1,NLEVELS19 UDG1F305.98
AK(I)=AK_ECMWF_19(I) UDG1F305.99
BK(I)=BK_ECMWF_19(I) UDG1F305.100
END DO UDG1F305.101
DO I=1,NLEVELS19+1 UDG1F305.102
AKH(I)=AKH_ECMWF_19(I) UDG1F305.103
BKH(I)=BKH_ECMWF_19(I) UDG1F305.104
END DO UDG1F305.105
UDG1F305.106
ELSEIF(METH_LEV_CALC.EQ.9.AND.P_LEVELS_OUT.EQ.NLEVELS31)THEN UDG1F305.107
! UDG1F305.108
! Use preset values of AK, BK, AKH and BKH (31 levels) UDG1F305.109
! UDG1F305.110
DO I=1,NLEVELS31 UDG1F305.111
AK(I)=AK_ECMWF_31(I) UDG1F305.112
BK(I)=BK_ECMWF_31(I) UDG1F305.113
END DO UDG1F305.114
DO I=1,NLEVELS31+1 UDG1F305.115
AKH(I)=AKH_ECMWF_31(I) UDG1F305.116
BKH(I)=BKH_ECMWF_31(I) UDG1F305.117
END DO UDG1F305.118
UDG1F305.119
ELSEIF(METH_LEV_CALC.NE.9)THEN UDG1F305.120
! UDG1F305.121
! Calculate AK, BK, AKH and BKH from ETAH UDG1F305.122
! UDG1F305.123
CALL ABCALC(METH_LEV_CALC,1,1,P_LEVELS_OUT UDG1F305.124
&, ETAH(MIN_PRS_HLEV),ETAH(MAX_SIG_HLEV),ETAH UDG1F305.125
&, AK,BK,AKH,BKH,IERR) UDG1F305.126
UDG1F305.127
IF(IERR.NE.0) THEN UDG1F305.128
WRITE(6,*) ' *ERROR* IN ABCALC FROM CONVHEAD. IERR = ' UDG1F305.129
& ,IERR UDG1F305.130
WRITE(6,*) ' CHECK YOUR ATMOS LEVEL SPEC FOR MODEL' UDG1F305.131
CALL ABORT UDG1F305.132
END IF UDG1F305.133
ELSE UDG1F305.134
WRITE(6,*) ' *ERROR* IN CONVHEAD. Presets ' UDG1F305.135
&, 'not available' UDG1F305.136
CALL ABORT UDG1F305.137
ENDIF UDG1F305.138
UDG1F305.139
WRITE(6,*) 'AK=' UDG1F305.140
WRITE(6,'(3(E22.15,'',''))')(AK(J),J=1,P_LEVELS_OUT) UDG1F305.141
WRITE(6,*) 'BK=' UDG1F305.142
WRITE(6,'(3(E22.15,'',''))')(BK(J),J=1,P_LEVELS_OUT) UDG1F305.143
WRITE(6,*) 'AKH=' UDG1F305.144
WRITE(6,'(3(E22.15,'',''))')(AKH(J),J=1,P_LEVELS_OUT+1) UDG1F305.145
WRITE(6,*) 'BKH=' UDG1F305.146
WRITE(6,'(3(E22.15,'',''))')(BKH(J),J=1,P_LEVELS_OUT+1) UDG1F305.147
UDG1F305.148
ENDIF UDG1F305.149
UDG1F305.150
CONVHEA1.248
! Set indicator for grid staggering used to decide whether UIE2F401.362
! horizontal interpolation required. UIE2F401.363
IF(C_GRID_OUT)THEN UIE2F401.364
FIXHD9=3 UIE2F401.365
ELSE UIE2F401.366
FIXHD9=2 UIE2F401.367
ENDIF UIE2F401.368
C----------------------------------------------------------------- CONVHEA1.249
C Decide whether horizontal and/or vertical interpolation required CONVHEA1.250
C----------------------------------------------------------------- CONVHEA1.251
CONVHEA1.252
C Horizontal CONVHEA1.253
WRITE(6,*)REALHD_IN(1),DELTA_LAMBDA, CONVHEA1.254
* REALHD_IN(2),DELTA_PHI, CONVHEA1.255
* INTHD_IN(6),ROW_LENGTH_OUT, CONVHEA1.256
* INTHD_IN(7),P_ROWS_OUT, CONVHEA1.257
* PHI_TLC,REALHD_IN(3), CONVHEA1.258
* LAMBDA_TLC,REALHD_IN(4), CONVHEA1.259
* PHI_NPOLE,REALHD_IN(5), CONVHEA1.260
* LAMBDA_NPOLE,REALHD_IN(6) CONVHEA1.261
IF(ABS(REALHD_IN(1)-DELTA_LAMBDA).GT.1.E-4.OR. CONVHEA1.262
* ABS(REALHD_IN(2)-DELTA_PHI) .GT.1.E-4.OR. CONVHEA1.263
* INTHD_IN(6).NE.ROW_LENGTH_OUT .OR. CONVHEA1.264
* INTHD_IN(7).NE.P_ROWS_OUT .OR. CONVHEA1.265
* ABS(PHI_TLC-REALHD_IN(3)).GT.1.E-4 .OR. CONVHEA1.266
* ABS(LAMBDA_TLC-REALHD_IN(4)).GT.1.E-4 .OR. CONVHEA1.267
* ABS(PHI_NPOLE-REALHD_IN(5)).GT.1.E-4 .OR. CONVHEA1.268
* (FIXHD9.NE.FIXHD_IN(9)) .OR. UIE2F401.369
* ABS(LAMBDA_NPOLE-REALHD_IN(6)).GT.1.E-4)THEN CONVHEA1.269
CONVHEA1.270
HORIZ_ARG=.TRUE. CONVHEA1.271
WRITE(6,'('' HORIZONTAL INTERPOLATION SWITCHED ON'')') CONVHEA1.272
CONVHEA1.273
ELSE CONVHEA1.274
CONVHEA1.275
HORIZ_ARG=.FALSE. CONVHEA1.276
WRITE(6,'('' HORIZONTAL INTERPOLATION SWITCHED OFF'')') CONVHEA1.277
CONVHEA1.278
ENDIF CONVHEA1.279
CONVHEA1.280
C Vertical CONVHEA1.281
IF(.NOT.OCEAN)THEN CONVHEA1.282
IF((AK(1).EQ.RMDI.OR.AK(1).EQ.RMDI_OLD).OR. TJ050593.34
* (BK(1).EQ.RMDI.OR.BK(1).EQ.RMDI_OLD)) THEN TJ050593.35
IF(INTHD_IN(8).NE.P_LEVELS_OUT CONVHEA1.284
* .OR.INTHD_IN(9).NE.Q_LEVELS_OUT)THEN CONVHEA1.285
WRITE(6,'('' *ERROR* Hybrid coords not specified when a'', CONVHEA1.286
* '' change in levels is implied '')') CONVHEA1.287
WRITE(6,*)AK(1),BK(1),INTHD_IN(8),P_LEVELS_OUT,INTHD_IN(9) CONVHEA1.288
* ,Q_LEVELS_OUT CONVHEA1.289
CALL ABORT CONVHEA1.290
ENDIF CONVHEA1.291
ENDIF CONVHEA1.292
CONVHEA1.293
ENDIF CONVHEA1.294
CONVHEA1.295
IF((AK(1).EQ.RMDI.OR.AK(1).EQ.RMDI_OLD).OR. TJ050593.36
* (BK(1).EQ.RMDI.OR.BK(1).EQ.RMDI_OLD)) THEN TJ050593.37
CONVHEA1.297
VERT_ARG=.FALSE. CONVHEA1.298
WRITE(6,'('' VERTICAL INTERPOLATION SWITCHED OFF'')') CONVHEA1.299
CONVHEA1.300
ELSE CONVHEA1.301
CONVHEA1.302
C Calculate DELTA_AK and DELTA_BK if half levels input CONVHEA1.303
IF(DELTA_AK(1).EQ.RMDI.OR.DELTA_AK(1).EQ.RMDI_OLD)THEN TJ050593.38
DO K=2,P_LEVELS_OUT+1 CONVHEA1.305
DELTA_AK(K-1)=AKH(K)-AKH(K-1) CONVHEA1.306
DELTA_BK(K-1)=BKH(K)-BKH(K-1) CONVHEA1.307
ENDDO CONVHEA1.308
ENDIF CONVHEA1.309
CONVHEA1.310
VERT_ARG=.TRUE. CONVHEA1.311
CONVHEA1.312
C Switch of vertical interpolation if all input/output levels identical CONVHEA1.313
IF(INTHD_IN(8).EQ.P_LEVELS_OUT.AND. CONVHEA1.314
* INTHD_IN(9).EQ.Q_LEVELS_OUT)THEN CONVHEA1.315
CONVHEA1.316
VERT_ARG=.FALSE. CONVHEA1.317
CONVHEA1.318
DO I=1,LEN1_LEVDEPC_OUT CONVHEA1.319
WRITE(6,*)LEVDEPC_IN(I),AK(I), CONVHEA1.320
* LEVDEPC_IN(I+LEN1_LEVDEPC_IN),BK(I), CONVHEA1.321
* LEVDEPC_IN(I+2*LEN1_LEVDEPC_IN),DELTA_AK(I), CONVHEA1.322
* LEVDEPC_IN(I+3*LEN1_LEVDEPC_IN),DELTA_BK(I) CONVHEA1.323
IF(ABS(LEVDEPC_IN(I)-AK(I)).GT.1.E-8 .OR. CONVHEA1.324
* ABS(LEVDEPC_IN(I+LEN1_LEVDEPC_IN)-BK(I)).GT.1.E-8 .OR. CONVHEA1.325
* ABS(LEVDEPC_IN(I+2*LEN1_LEVDEPC_IN)-DELTA_AK(I)).GT.1.E-8 .OR. CONVHEA1.326
* ABS(LEVDEPC_IN(I+3*LEN1_LEVDEPC_IN)-DELTA_BK(I)).GT.1.E-8 )THEN CONVHEA1.327
CONVHEA1.328
VERT_ARG=.TRUE. CONVHEA1.329
CONVHEA1.330
ENDIF CONVHEA1.331
ENDDO CONVHEA1.332
ENDIF CONVHEA1.333
CONVHEA1.334
IF(VERT_ARG)THEN CONVHEA1.335
WRITE(6,'('' VERTICAL INTERPOLATION SWITCHED ON'')') CONVHEA1.336
ELSE CONVHEA1.337
WRITE(6,'('' VERTICAL INTERPOLATION SWITCHED OFF'')') CONVHEA1.338
ENDIF CONVHEA1.339
ENDIF CONVHEA1.340
CONVHEA1.341
C-------------------------------------------------------------- CONVHEA1.342
C Process NAMELIST HORIZ parameters for LAM topography subarea CONVHEA1.343
C-------------------------------------------------------------- CONVHEA1.344
IF(.NOT.OCEAN)THEN CONVHEA1.345
CONVHEA1.346
C Initialise mask for updating topography CONVHEA1.347
DO I=1,P_FIELD_OUT CONVHEA1.348
TOPOG_MASK(I)=.TRUE. CONVHEA1.349
ENDDO CONVHEA1.350
CONVHEA1.351
C Recalculate mask if subarea pointers set CONVHEA1.352
IF(RIM_WIDTH_NORTH_TOPOG.NE.0.OR. CONVHEA1.353
* RIM_WIDTH_SOUTH_TOPOG.NE.0.OR. CONVHEA1.354
* RIM_WIDTH_EAST_TOPOG.NE.0.OR. CONVHEA1.355
* RIM_WIDTH_WEST_TOPOG.NE.0)THEN CONVHEA1.356
CONVHEA1.357
C Check if subarea fits inside LAM area CONVHEA1.358
IF(RIM_WIDTH_NORTH_TOPOG.LT.0.OR. CONVHEA1.359
* RIM_WIDTH_NORTH_TOPOG.GE.P_ROWS_OUT.OR. CONVHEA1.360
* RIM_WIDTH_SOUTH_TOPOG.LT.0.OR. CONVHEA1.361
* RIM_WIDTH_SOUTH_TOPOG.GE.P_ROWS_OUT.OR. CONVHEA1.362
* RIM_WIDTH_EAST_TOPOG.LT.0.OR. CONVHEA1.363
* RIM_WIDTH_EAST_TOPOG.GE.ROW_LENGTH_OUT.OR. CONVHEA1.364
* RIM_WIDTH_WEST_TOPOG.LT.0.OR. CONVHEA1.365
* RIM_WIDTH_WEST_TOPOG.GE.ROW_LENGTH_OUT)THEN CONVHEA1.366
CONVHEA1.367
WRITE(6,'('' *ERROR* Topography subarea specified incorrectly'' CONVHEA1.368
*,'' on namelist HORIZ'')') CONVHEA1.369
CALL ABORT CONVHEA1.370
ENDIF CONVHEA1.371
CONVHEA1.372
C Recalculate topography mask CONVHEA1.373
DO I=1,P_FIELD_OUT CONVHEA1.374
TOPOG_MASK(I)=.FALSE. CONVHEA1.375
ENDDO CONVHEA1.376
DO J=1+RIM_WIDTH_NORTH_TOPOG,P_ROWS_OUT-RIM_WIDTH_SOUTH_TOPOG CONVHEA1.377
DO I=1+RIM_WIDTH_WEST_TOPOG,ROW_LENGTH_OUT-RIM_WIDTH_EAST_TOPOG CONVHEA1.378
TOPOG_MASK(I+(J-1)*ROW_LENGTH_OUT)=.TRUE. CONVHEA1.379
ENDDO CONVHEA1.380
ENDDO CONVHEA1.381
CONVHEA1.382
WRITE(6,'('' TOPOGRAPHY MASK'')') CONVHEA1.383
CONVHEA1.384
ITIMES=ROW_LENGTH_OUT/150 CONVHEA1.385
DO K=1,ITIMES CONVHEA1.386
WRITE(6,'('' BLOCK '',I3)')K CONVHEA1.387
IJ=1+(K-1)*150 CONVHEA1.388
DO J=1,P_ROWS_OUT CONVHEA1.389
WRITE(6,'('' '',150L1)')(TOPOG_MASK(I),I=IJ,IJ+149) CONVHEA1.390
IJ=IJ+ROW_LENGTH_OUT CONVHEA1.391
ENDDO CONVHEA1.392
ENDDO CONVHEA1.393
IRES=ROW_LENGTH_OUT-ITIMES*150 CONVHEA1.394
IF(IRES.NE.0)THEN CONVHEA1.395
WRITE(6,'('' BLOCK '',I3)')ITIMES+1 CONVHEA1.396
IJ=1+ITIMES*150 CONVHEA1.397
DO J=1,P_ROWS_OUT CONVHEA1.398
WRITE(6,'('' '',150L1)')(TOPOG_MASK(I),I=IJ,IJ+IRES-1) CONVHEA1.399
IJ=IJ+ROW_LENGTH_OUT CONVHEA1.400
ENDDO CONVHEA1.401
ENDIF CONVHEA1.402
CONVHEA1.403
ENDIF CONVHEA1.404
CONVHEA1.405
ENDIF CONVHEA1.406
CONVHEA1.407
C-------------------------------------------------------------- CONVHEA1.408
C Initialise fixed length header CONVHEA1.409
C-------------------------------------------------------------- CONVHEA1.410
AD200593.201
CONVHEA1.411
CALL SETFHEAD(FIXHD_OUT CONVHEA1.412
*,LEN_FIXHD_OUT CONVHEA1.413
*,LEN_INTHD_OUT CONVHEA1.414
*,LEN_REALHD_OUT CONVHEA1.415
*,LEN1_LEVDEPC_OUT,LEN2_LEVDEPC_OUT CONVHEA1.416
*,LEN1_ROWDEPC_OUT,LEN2_ROWDEPC_OUT CONVHEA1.417
*,LEN1_COLDEPC_OUT,LEN2_COLDEPC_OUT CONVHEA1.418
*,LEN1_FLDDEPC_OUT,LEN2_FLDDEPC_OUT CONVHEA1.419
*,LEN_EXTCNST_OUT CONVHEA1.420
*,LEN_DUMPHIST_OUT CONVHEA1.421
*,LEN_CFI1_OUT,LEN_CFI2_OUT,LEN_CFI3_OUT CONVHEA1.422
*,LEN1_LOOKUP_OUT,LEN2_LOOKUP_OUT CONVHEA1.423
*,LEN_DATA_OUT CONVHEA1.424
*,FIXHD_IN(34) GO030594.5
*,FIXHD_IN(28),FIXHD_IN(29),FIXHD_IN(30),FIXHD_IN(31),FIXHD_IN(32) CONVHEA1.426
*,FIXHD_IN(27) GO030594.6
*,FIXHD_IN(21),FIXHD_IN(22),FIXHD_IN(23),FIXHD_IN(24),FIXHD_IN(25) CONVHEA1.428
*,IMDI,FIXHD_IN(2),VERT_COORD_TYPE,HORIZ_GRID_TYPE GDR7F404.480
*,FIXHD_IN(5),FIXHD_IN(6),FIXHD_IN(7),FIXHD_IN(8) CONVHEA1.430
*,FIXHD9,FIXHD_IN(10),IPROJ AD200593.207
*,IPOS) CONVHEA1.432
CONVHEA1.433
C Overwrite analysis time with verification time if RESET=true CONVHEA1.439
IF(RESET)THEN CONVHEA1.440
DO I=21,27 CONVHEA1.441
FIXHD_OUT(I)=FIXHD_OUT(I+7) CONVHEA1.442
ENDDO CONVHEA1.443
WRITE(6,'('' ANALYSIS TIME RESET'')') CONVHEA1.444
WRITE(6,'('' Analysis:'',7I9)')(FIXHD_OUT(I),I=21,27) CONVHEA1.445
WRITE(6,'('' Verif :'',7I9)')(FIXHD_OUT(I),I=28,34) CONVHEA1.446
ENDIF CONVHEA1.447
CONVHEA1.448
CONVHEA1.449
C Overwrite FIXHD_OUT with values on namelist CONVHEA1.450
CONVHEA1.451
C LEN_FIXHD caters for different lengths. (LEN_FIXHD_OUT) UDG7F304.8
LEN_FIXHD=MIN(256,LEN_FIXHD_OUT) UDG7F304.9
DO I=1,LEN_FIXHD UDG7F304.10
IF (FIXHD(I).NE.IMDI) THEN UDR2F305.3
WRITE(6,*)'FIXHD_OUT(',I,') reset from ',FIXHD_OUT(I), UDR2F305.4
& ' to ',FIXHD(I) UDR2F305.5
FIXHD_OUT(I) = FIXHD(I) UDR2F305.6
ENDIF UDR2F305.7
ENDDO CONVHEA1.454
IF(LEN_FIXHD_OUT.GT.256)THEN UDG7F304.11
WRITE(6,*)'Length of fixed header is longer than 256' UDG7F304.12
WRITE(6,*)'Elements 257 onwards set to ',IMDI UDG7F304.13
WRITE(6,*)'Length of FIXHD is 256' UDG7F304.14
WRITE(6,*)'Length of FIXHD_OUT is ',LEN_FIXHD_OUT UDG7F304.15
ENDIF UDG7F304.16
CONVHEA1.455
C-------------------------------------------------------------- CONVHEA1.456
C Initialise integer constants record CONVHEA1.457
C-------------------------------------------------------------- CONVHEA1.458
CONVHEA1.459
C Initialise INTHD_OUT to IMDI UDG7F304.17
DO I=1,LEN_INTHD_OUT UDG7F304.18
INTHD_OUT(I)=IMDI UDG7F304.19
ENDDO UDG7F304.20
UDG7F304.21
C Copy INTHD_IN into INTHD_OUT UDG7F304.22
C LEN_INTHD caters for different lengths. (LEN_INTHD_IN/OUT) UDG7F304.23
LEN_INTHD=MIN(LEN_INTHD_IN,LEN_INTHD_OUT) UDG7F304.24
DO I=1,LEN_INTHD UDG7F304.25
INTHD_OUT(I)=INTHD_IN(I) CONVHEA1.461
ENDDO CONVHEA1.462
IF(LEN_INTHD_OUT.NE.LEN_INTHD_IN) THEN UDG7F304.26
WRITE(6,*)'Length of integer header has been changed' UDG7F304.27
WRITE(6,*)'Length of INTHD_IN is ',LEN_INTHD_IN UDG7F304.28
WRITE(6,*)'Length of INTHD_OUT is ',LEN_INTHD_OUT UDG7F304.29
ELSE UDG7F304.30
WRITE(6,*)'Length of integer header is ',LEN_INTHD_OUT UDG7F304.31
ENDIF UDG7F304.32
CONVHEA1.463
INTHD_OUT(6)=ROW_LENGTH_OUT CONVHEA1.464
INTHD_OUT(7)=P_ROWS_OUT CONVHEA1.465
INTHD_OUT(8)=P_LEVELS_OUT CONVHEA1.466
INTHD_OUT(9)=Q_LEVELS_OUT CONVHEA1.467
INTHD_OUT(10)=ST_LEVELS_OUT UJS1F401.249
IF(OCEAN)THEN CONVHEA1.469
INTHD_OUT(11)=OCEAN_SEA_POINTS CONVHEA1.470
ELSE CONVHEA1.471
INTHD_OUT(11)=IMDI TJ050593.40
ENDIF CONVHEA1.473
INTHD_OUT(12)=TR_LEVELS_OUT CONVHEA1.474
INTHD_OUT(13)=BL_LEVELS_OUT CONVHEA1.475
IF(OCEAN)THEN GDG5F304.4
INTHD_OUT(14)=TR_VARS_OUT+2 GDG5F304.5
ELSE GDG5F304.6
INTHD_OUT(14)=TR_VARS_OUT CONVHEA1.476
ENDIF GDG5F304.7
INTHD_OUT(15)=MAX_VARIABLES_OUT CONVHEA1.477
INTHD_OUT(16)=IMDI GDR6F405.35
INTHD_OUT(17)=IMDI GDR6F405.36
INTHD_OUT(26)=OZONE_LEVELS_OUT CONVHEA1.480
INTHD_OUT(27)=TR_LEVELS_ADV_OUT CONVHEA1.481
INTHD_OUT(28)=SM_LEVELS_OUT UJS1F401.250
CONVHEA1.482
C Run Time Constants removed from Integer Header (Vn 3.5 onwards) UDR2F305.8
C Words 22-24 and 27 UDR2F305.9
IF (.NOT.OCEAN) THEN UDR2F305.10
DO I=22,27 UDR2F305.11
IF (LEN_INTHD_OUT.GE.I .AND. (I.LE.24 .OR. I.EQ.27) ) THEN UDR2F305.12
IF (INTHD_OUT(I).NE.IMDI) THEN UDR2F305.13
INTHD_OUT(I) = IMDI UDR2F305.14
WRITE(6,*)'INTHD_OUT(',I,') reset to IMDI' UDR2F305.15
ENDIF UDR2F305.16
ENDIF UDR2F305.17
ENDDO UDR2F305.18
ENDIF UDR2F305.19
UDR2F305.20
C Overwrite INTHD_OUT with values on namelist CONVHEA1.483
CONVHEA1.484
LEN_INTHD=MIN(100,LEN_INTHD_OUT) UDG7F304.33
DO I=1,LEN_INTHD UDG7F304.34
IF (INTHD(I).NE.IMDI) THEN UDR2F305.21
WRITE(6,*)'INTHD_OUT(',I,') reset from ',INTHD_OUT(I), UDR2F305.22
& ' to ',INTHD(I) UDR2F305.23
INTHD_OUT(I) = INTHD(I) UDR2F305.24
ENDIF UDR2F305.25
ENDDO CONVHEA1.487
IF(LEN_INTHD_OUT.GT.100)THEN UDG7F304.35
WRITE(6,*)'Length of integer header is longer than 100' UDG7F304.36
WRITE(6,*)'Elements 101 onwards set to ',IMDI UDG7F304.37
WRITE(6,*)'Length of INTHD is 100' UDG7F304.38
WRITE(6,*)'Length of INTHD_OUT is ',LEN_INTHD_OUT UDG7F304.39
ENDIF UDG7F304.40
CONVHEA1.488
C-------------------------------------------------------------- CONVHEA1.489
C Initialise real constants CONVHEA1.490
C-------------------------------------------------------------- CONVHEA1.491
CONVHEA1.492
C Initialise REALHD_OUT to RMDI ADR1F304.52
DO I=1,LEN_REALHD_OUT CONVHEA1.493
REALHD_OUT(I)=RMDI ADR1F304.53
ENDDO ADR1F304.54
ADR1F304.55
C Copy REALHD_IN into REALHD_OUT ADR1F304.56
C LEN_REALHD caters for different lengths. (LEN_REALHD_IN/OUT) ADR1F304.57
LEN_REALHD=MIN(LEN_REALHD_IN,LEN_REALHD_OUT) ADR1F304.58
DO I=1,LEN_REALHD ADR1F304.59
REALHD_OUT(I)=REALHD_IN(I) CONVHEA1.494
ENDDO CONVHEA1.495
ADR1F304.60
IF(LEN_REALHD_OUT.NE.LEN_REALHD_IN) THEN ADR1F304.61
WRITE(6,*)'Length of real header has been changed' ADR1F304.62
WRITE(6,*)'Length of REALHD_IN is ',LEN_REALHD_IN ADR1F304.63
WRITE(6,*)'Length of REALHD_OUT is ',LEN_REALHD_OUT ADR1F304.64
ELSE ADR1F304.65
WRITE(6,*)'Length of real header is ',LEN_REALHD_OUT ADR1F304.66
ENDIF ADR1F304.67
ADR1F304.68
REALHD_OUT(1)=DELTA_LAMBDA CONVHEA1.496
REALHD_OUT(2)=DELTA_PHI CONVHEA1.497
REALHD_OUT(3)=PHI_TLC CONVHEA1.498
REALHD_OUT(4)=LAMBDA_TLC CONVHEA1.499
REALHD_OUT(5)=PHI_NPOLE CONVHEA1.500
REALHD_OUT(6)=LAMBDA_NPOLE CONVHEA1.501
CONVHEA1.502
IF(VERT_ARG.OR.HORIZ_ARG)THEN CONVHEA1.503
REALHD_OUT(19)=RMDI TJ050593.42
REALHD_OUT(20)=RMDI TJ050593.43
REALHD_OUT(21)=RMDI TJ050593.44
ENDIF CONVHEA1.507
CONVHEA1.508
C Run Time Constants removed from Real Header (Vn 3.5 onwards) UDR2F305.26
C Words 22-28 and 30-38 UDR2F305.27
IF (.NOT.OCEAN) THEN UDR2F305.28
DO I=22,38 UDR2F305.29
IF (LEN_REALHD_OUT.GE.I .AND. I.NE.29 ) THEN UDR2F305.30
IF (REALHD_OUT(I).NE.RMDI) THEN UDR2F305.31
REALHD_OUT(I) = RMDI UDR2F305.32
WRITE(6,*)'REALHD_OUT(',I,') reset to RMDI' UDR2F305.33
ENDIF UDR2F305.34
ENDIF UDR2F305.35
ENDDO UDR2F305.36
ENDIF UDR2F305.37
UDR2F305.38
C Overwrite REALHD_OUT with values on namelist CONVHEA1.509
CONVHEA1.510
LEN_REALHD=MIN(100,LEN_REALHD_OUT) UDG7F304.41
DO I=1,LEN_REALHD UDG7F304.42
IF (RELHD(I).NE.RMDI) THEN UDR2F305.39
WRITE(6,*)'REALHD_OUT(',I,') reset from ',REALHD_OUT(I), UDR2F305.40
& ' to ',RELHD(I) UDR2F305.41
REALHD_OUT(I) = RELHD(I) UDR2F305.42
ENDIF UDR2F305.43
ENDDO TJ050593.46
IF(LEN_REALHD_OUT.GT.100)THEN UDG7F304.43
WRITE(6,*)'Length of real header is longer than 100' UDG7F304.44
WRITE(6,*)'Elements 101 onwards set to ',RMDI UDG7F304.45
WRITE(6,*)'Length of RELHD is 100' UDG7F304.46
WRITE(6,*)'Length of REALHD_OUT is ',LEN_REALHD_OUT UDG7F304.47
ENDIF UDG7F304.48
TJ050593.47
C Replace old RMDI values from old dump header with new RMDI value TJ050593.48
TJ050593.49
DO I=1,LEN_REALHD_OUT TJ050593.50
IF(REALHD_OUT(I).EQ.RMDI_OLD) REALHD_OUT(I)=RMDI TJ050593.51
ENDDO CONVHEA1.513
CONVHEA1.514
C-------------------------------------------------------------- CONVHEA1.515
C Copy across or reset level dependent constants CONVHEA1.516
C-------------------------------------------------------------- CONVHEA1.517
CONVHEA1.518
C Initialise to RMDI ADR1F304.69
DO I=1,LEN1_LEVDEPC_OUT*LEN2_LEVDEPC_OUT ADR1F304.70
LEVDEPC_OUT(I)=RMDI ADR1F304.71
ENDDO ADR1F304.72
ADR1F304.73
IF (LEN2_LEVDEPC_OUT.NE.LEN2_LEVDEPC_IN) THEN UDR2F305.44
WRITE (6,*) UDR2F305.45
& 'No of variables in Level Dependent Constants array changed' UDR2F305.46
WRITE (6,*) UDR2F305.47
& 'No of variables in LEVDEPC_IN is ',LEN2_LEVDEPC_IN UDR2F305.48
WRITE (6,*) UDR2F305.49
& 'No of variables in LEVDEPC_OUT is ',LEN2_LEVDEPC_OUT UDR2F305.50
ENDIF UDR2F305.51
UDR2F305.52
C Copy data from LEVDEPC_IN if LEN1 dimensions are equal ADR1F304.74
IF (LEN1_LEVDEPC_IN.EQ.LEN1_LEVDEPC_OUT) THEN ADR1F304.75
ADR1F304.76
C Cater for different second dimensions LEN2 ADR1F304.77
LEN2_LEVDEPC = MIN (LEN2_LEVDEPC_IN,LEN2_LEVDEPC_OUT) ADR1F304.78
ADR1F304.79
C For atmos dumps, copy first 5 items. Vn 3.5 onwards UDR2F305.53
IF (.NOT.OCEAN) LEN2_LEVDEPC = MIN (5,LEN2_LEVDEPC) UDR2F305.54
UDR2F305.55
DO I=1,LEN1_LEVDEPC_OUT*LEN2_LEVDEPC ADR1F304.80
LEVDEPC_OUT(I)=LEVDEPC_IN(I) ADR1F304.81
ENDDO ADR1F304.82
ADR1F304.83
ENDIF ADR1F304.84
CONVHEA1.522
IF(.NOT.OCEAN)THEN CONVHEA1.523
CONVHEA1.524
CONVHEA1.525
IF (VERT_ARG) THEN ! Vertical Interpolation required ADR1F304.85
DO I=1,LEN1_LEVDEPC_OUT CONVHEA1.527
ADR1F304.86
C AK, BK, DELTA_AK and DELTA_BK ADR1F304.87
LEVDEPC_OUT(I)=AK(I) CONVHEA1.528
LEVDEPC_OUT(I+LEN1_LEVDEPC_OUT)=BK(I) CONVHEA1.529
LEVDEPC_OUT(I+2*LEN1_LEVDEPC_OUT)=DELTA_AK(I) CONVHEA1.530
LEVDEPC_OUT(I+3*LEN1_LEVDEPC_OUT)=DELTA_BK(I) CONVHEA1.531
ADR1F304.88
C THETA_REF ADR1F304.89
P=AK(I)+BK(I)*1.E+5 CONVHEA1.532
IF(P.GT.10000.)THEN CONVHEA1.533
THREF=300. CONVHEA1.534
ELSEIF(P.LT.100.)THEN CONVHEA1.535
THREF=400. CONVHEA1.536
ELSE CONVHEA1.537
AL10000=ALOG(10000.) CONVHEA1.538
THREF=300.+100.*(AL10000-ALOG(P))/(AL10000-ALOG(100.)) CONVHEA1.539
ENDIF CONVHEA1.540
LEVDEPC_OUT(I+4*LEN1_LEVDEPC_OUT) CONVHEA1.541
* =THREF/(P*1.E-5)**KAPPA CONVHEA1.542
ENDDO CONVHEA1.543
ENDIF CONVHEA1.544
CONVHEA1.545
IF (FIXHD_OUT(12).LT.305) THEN ! Pre Vn 3.5 only UDR2F305.56
DO I=1,LEN1_LEVDEPC_OUT CONVHEA1.546
C Diffusion coefficients - K1 and K2 ADR1F304.90
LEVDEPC_OUT(I+5*LEN1_LEVDEPC_OUT)=1.0E+5 CONVHEA1.547
LEVDEPC_OUT(I+6*LEN1_LEVDEPC_OUT)=4.0E+4 CONVHEA1.548
C Diffusion exponent - theta, u and v ADR1F304.91
LEVDEPC_OUT(I+7*LEN1_LEVDEPC_OUT)=0. CONVHEA1.549
C Diffusion exponent - q ADR1F304.92
LEVDEPC_OUT(I+8*LEN1_LEVDEPC_OUT)=0. CONVHEA1.550
C Divergence damping coefficient for assimilation and forecast ADR1F304.93
LEVDEPC_OUT(I+9*LEN1_LEVDEPC_OUT)=5.0E+7 CONVHEA1.551
LEVDEPC_OUT(I+10*LEN1_LEVDEPC_OUT)=5.0E+7 CONVHEA1.552
C Critical RH ADR1F304.94
LEVDEPC_OUT(I+11*LEN1_LEVDEPC_OUT)=0.0 CONVHEA1.553
ENDDO CONVHEA1.554
ENDIF UDR2F305.57
C AJS1F400.143
C Soil layer depth ratios AJS1F400.144
CONVHEA1.555
IF(FIXHD_OUT(12).LT.305)THEN AJS1F400.145
JSOIL_DEPTHS = 13 AJS1F400.146
ELSE AJS1F400.147
JSOIL_DEPTHS = 6 AJS1F400.148
ENDIF AJS1F400.149
AJS1F400.150
C***************************************************************** AJS1F400.155
C NB Set layer depths to constant global values for MOSES UJS1F401.251
C and to layer depth ratios that are dependent on the top layer UJS1F401.252
C for the multi-layer scheme UJS1F401.253
C**************************************************************** AJS1F400.164
IF(LMOSES)THEN UJS1F401.254
DO I=1,SM_LEVELS_OUT UJS1F401.255
LEVDEPC_OUT(I+(JSOIL_DEPTHS-1)*LEN1_LEVDEPC_OUT) UJS1F401.256
& = DZSOIL(I) UJS1F401.257
ENDDO UJS1F401.258
ELSE UJS1F401.264
DO I=1,ST_LEVELS_OUT+1 UJS1F401.265
LEVDEPC_OUT(I+(JSOIL_DEPTHS-1)*LEN1_LEVDEPC_OUT) UJS1F401.266
& = LAYER_DEPTH(I) UJS1F401.267
ENDDO UJS1F401.268
ENDIF UJS1F401.269
CONVHEA1.560
ENDIF CONVHEA1.561
CONVHEA1.562
C-------------------------------------------------------------- CONVHEA1.563
C Initialise row dependent constants CONVHEA1.564
C-------------------------------------------------------------- CONVHEA1.565
CONVHEA1.566
DO I=1,LEN1_ROWDEPC_OUT*LEN2_ROWDEPC_OUT CONVHEA1.567
IF (I.LE.LEN1_ROWDEPC_IN*LEN2_ROWDEPC_IN) THEN UIE2F404.38
ROWDEPC_OUT(I)=ROWDEPC_IN(I) UIE2F404.39
ENDIF UIE2F404.40
ENDDO CONVHEA1.569
CONVHEA1.570
IF(.NOT.OCEAN)THEN CONVHEA1.571
CONVHEA1.572
C SET FILTER WAVE VALUES TO MAX VALUES CONVHEA1.573
DO I=1,LEN1_ROWDEPC_OUT*LEN2_ROWDEPC_OUT CONVHEA1.574
ROWDEPC_OUT(I)=REAL(ROW_LENGTH_OUT) UDG6F405.142
ENDDO CONVHEA1.576
CONVHEA1.577
ENDIF CONVHEA1.578
CONVHEA1.579
C-------------------------------------------------------------- CONVHEA1.580
C Copy across column dependent consts CONVHEA1.581
C-------------------------------------------------------------- CONVHEA1.582
IF(OCEAN)THEN CONVHEA1.583
DO I=1,LEN1_COLDEPC_OUT*LEN2_COLDEPC_OUT CONVHEA1.584
COLDEPC_OUT(I)=COLDEPC_IN(I) CONVHEA1.585
ENDDO CONVHEA1.586
ENDIF CONVHEA1.587
CONVHEA1.588
C-------------------------------------------------------------- CONVHEA1.589
C Copy across fields of consts CONVHEA1.590
C-------------------------------------------------------------- CONVHEA1.591
CONVHEA1.592
IF(LEN1_FLDDEPC_OUT*LEN2_FLDDEPC_OUT.GT.0) THEN UIE2F401.350
! Copy across fields_of_constants for atmosphere model UIE2F401.351
IF( (LEN1_FLDDEPC_IN.EQ.LEN1_FLDDEPC_OUT).AND. UIE2F401.352
* (LEN2_FLDDEPC_IN.EQ.LEN2_FLDDEPC_OUT)) THEN UIE2F401.353
DO I=1,LEN1_FLDDEPC_OUT*LEN2_FLDDEPC_OUT CONVHEA1.594
FLDDEPC_OUT(I)=FLDDEPC_IN(I) CONVHEA1.595
ENDDO CONVHEA1.596
ENDIF UIE2F401.354
ENDIF CONVHEA1.597
CONVHEA1.598
C-------------------------------------------------------------- CONVHEA1.599
C Copy across extra consts CONVHEA1.600
C-------------------------------------------------------------- CONVHEA1.601
CONVHEA1.602
IF(OCEAN)THEN CONVHEA1.603
DO I=1,LEN_EXTCNST_OUT CONVHEA1.604
EXTCNST_OUT(I)=EXTCNST_IN(I) CONVHEA1.605
ENDDO CONVHEA1.606
ENDIF CONVHEA1.607
CONVHEA1.608
C-------------------------------------------------------------- CONVHEA1.609
C Copy across history block CONVHEA1.610
C-------------------------------------------------------------- CONVHEA1.611
CONVHEA1.612
DO I=1,LEN_DUMPHIST_OUT CONVHEA1.613
DUMPHIST_OUT(I)=DUMPHIST_IN(I) CONVHEA1.614
ENDDO CONVHEA1.615
CONVHEA1.616
C-------------------------------------------------------------- CONVHEA1.617
C Copy across compressed field index1 CONVHEA1.618
C-------------------------------------------------------------- CONVHEA1.619
CONVHEA1.620
IF(OCEAN)THEN CONVHEA1.621
DO I=1,LEN_CFI1_OUT CONVHEA1.622
CFI1_OUT(I)=CFI1_IN(I) CONVHEA1.623
ENDDO CONVHEA1.624
ENDIF CONVHEA1.625
CONVHEA1.626
C-------------------------------------------------------------- CONVHEA1.627
C Copy across compressed field index2 CONVHEA1.628
C-------------------------------------------------------------- CONVHEA1.629
CONVHEA1.630
IF(OCEAN)THEN CONVHEA1.631
DO I=1,LEN_CFI2_OUT CONVHEA1.632
CFI2_OUT(I)=CFI2_IN(I) CONVHEA1.633
ENDDO CONVHEA1.634
ENDIF CONVHEA1.635
CONVHEA1.636
C-------------------------------------------------------------- CONVHEA1.637
C Copy across compressed field index3 CONVHEA1.638
C-------------------------------------------------------------- CONVHEA1.639
CONVHEA1.640
IF(OCEAN)THEN CONVHEA1.641
DO I=1,LEN_CFI3_OUT CONVHEA1.642
CFI3_OUT(I)=CFI3_IN(I) CONVHEA1.643
ENDDO CONVHEA1.644
ENDIF CONVHEA1.645
CONVHEA1.646
RETURN CONVHEA1.647
END CONVHEA1.648
*ENDIF CONVHEA1.649