SUBROUTINE BC_ABCALC (AK,BK,AKH,BKH,P_LEVELS_OUT, 1,1BCABCAL1.21
& ICODE,CMESSAGE) BCABCAL1.22
IMPLICIT NONE BCABCAL1.23
BCABCAL1.24
INTEGER BCABCAL1.25
& P_LEVELS_OUT BCABCAL1.26
& ,ICODE BCABCAL1.27
BCABCAL1.28
REAL BCABCAL1.29
& AK(P_LEVELS_OUT) BCABCAL1.30
& ,BK(P_LEVELS_OUT) BCABCAL1.31
& ,AKH(P_LEVELS_OUT+1) BCABCAL1.32
& ,BKH(P_LEVELS_OUT+1) BCABCAL1.33
BCABCAL1.34
CHARACTER*80 CMESSAGE BCABCAL1.35
BCABCAL1.36
*CALL C_MDI 
BCABCAL1.37
*CALL C_VERT_MAX BCABCAL1.38
*CALL C_VERT_NL BCABCAL1.39
*CALL C_ECMWF_19 BCABCAL1.40
*CALL C_ECMWF_31 BCABCAL1.41
BCABCAL1.42
INTEGER I,J BCABCAL1.43
BCABCAL1.44
! Read in VERTICAL Namelist BCABCAL1.45
READ (5,VERTICAL,ERR=101,END=102) BCABCAL1.46
GO TO 100 BCABCAL1.47
BCABCAL1.48
101 CONTINUE BCABCAL1.49
WRITE (6,*) ' Error trying to read VERTICAL namelist.' BCABCAL1.50
CMESSAGE = 'BCABCALC : Error trying to read VERTICAL namelist.' BCABCAL1.51
ICODE = 101 BCABCAL1.52
GO TO 9999 ! Return BCABCAL1.53
BCABCAL1.54
102 CONTINUE BCABCAL1.55
WRITE (6,*) ' VERTICAL namelist not found ??' BCABCAL1.56
CMESSAGE = 'BCABCALC : VERTICAL namelist not found ??' BCABCAL1.57
ICODE = 102 BCABCAL1.58
GO TO 9999 ! Return BCABCAL1.59
BCABCAL1.60
100 CONTINUE BCABCAL1.61
WRITE(6,VERTICAL) BCABCAL1.62
BCABCAL1.63
! Add checks on nlevs,nlevels19,nlevels31 BCABCAL1.64
! BCABCAL1.65
! Calculate AK,BK,AKH,BKH from ETAH BCABCAL1.66
! BCABCAL1.67
IF (METH_LEV_CALC.EQ.9 .AND. P_LEVELS_OUT.EQ.NLEVELS19) THEN BCABCAL1.68
! BCABCAL1.69
! Use preset values of AK, BK, AKH and BKH (19 levels) BCABCAL1.70
! BCABCAL1.71
DO I=1,NLEVELS19 BCABCAL1.72
AK(I)=AK_ECMWF_19(I) BCABCAL1.73
BK(I)=BK_ECMWF_19(I) BCABCAL1.74
END DO BCABCAL1.75
DO I=1,NLEVELS19+1 BCABCAL1.76
AKH(I)=AKH_ECMWF_19(I) BCABCAL1.77
BKH(I)=BKH_ECMWF_19(I) BCABCAL1.78
END DO BCABCAL1.79
BCABCAL1.80
ELSEIF (METH_LEV_CALC.EQ.9 .AND. P_LEVELS_OUT.EQ.NLEVELS31) THEN BCABCAL1.81
! BCABCAL1.82
! Use preset values of AK, BK, AKH and BKH (31 levels) BCABCAL1.83
! BCABCAL1.84
DO I=1,NLEVELS31 BCABCAL1.85
AK(I)=AK_ECMWF_31(I) BCABCAL1.86
BK(I)=BK_ECMWF_31(I) BCABCAL1.87
END DO BCABCAL1.88
DO I=1,NLEVELS31+1 BCABCAL1.89
AKH(I)=AKH_ECMWF_31(I) BCABCAL1.90
BKH(I)=BKH_ECMWF_31(I) BCABCAL1.91
END DO BCABCAL1.92
BCABCAL1.93
ELSEIF (METH_LEV_CALC.NE.9) THEN BCABCAL1.94
! BCABCAL1.95
! Calculate AK, BK, AKH and BKH from ETAH BCABCAL1.96
! BCABCAL1.97
CALL ABCALC (METH_LEV_CALC,1,1,P_LEVELS_OUT, BCABCAL1.98
& ETAH(MIN_PRS_HLEV),ETAH(MAX_SIG_HLEV),ETAH, BCABCAL1.99
& AK,BK,AKH,BKH,ICODE) BCABCAL1.100
BCABCAL1.101
IF (ICODE.NE.0) THEN BCABCAL1.102
CMESSAGE = 'Error in ABCALC in BC_ABCALC' BCABCAL1.103
WRITE (6,*) 'Error code from ABCALC = ',ICODE BCABCAL1.104
WRITE (6,*) 'Check your level specification for Model' BCABCAL1.105
GO TO 9999 ! Return BCABCAL1.106
END IF BCABCAL1.107
BCABCAL1.108
ELSE BCABCAL1.109
BCABCAL1.110
CMESSAGE = 'Invalid METH_LEV_CALC in VERTICAL Namleist' BCABCAL1.111
WRITE(6,*) CMESSAGE BCABCAL1.112
ICODE = 101 BCABCAL1.113
GO TO 9999 ! Return BCABCAL1.114
BCABCAL1.115
ENDIF BCABCAL1.116
BCABCAL1.117
WRITE(6,*) 'Vertical levels for Boundary Dataset fields./' BCABCAL1.118
WRITE(6,*) 'AK=' BCABCAL1.119
WRITE(6,'(3(E22.15,'',''))')(AK(J),J=1,P_LEVELS_OUT) BCABCAL1.120
WRITE(6,*) 'BK=' BCABCAL1.121
WRITE(6,'(3(E22.15,'',''))')(BK(J),J=1,P_LEVELS_OUT) BCABCAL1.122
WRITE(6,*) 'AKH=' BCABCAL1.123
WRITE(6,'(3(E22.15,'',''))')(AKH(J),J=1,P_LEVELS_OUT+1) BCABCAL1.124
WRITE(6,*) 'BKH=' BCABCAL1.125
WRITE(6,'(3(E22.15,'',''))')(BKH(J),J=1,P_LEVELS_OUT+1) BCABCAL1.126
BCABCAL1.127
9999 RETURN BCABCAL1.128
END BCABCAL1.129
*ENDIF BCABCAL1.130