SUBROUTINE PSLIMS(IPFIRST,IPLAST,IFIRST,ILAST) 1PSLIMS1.5
IMPLICIT NONE PSLIMS1.6
PSLIMS1.7
! Description: PSLIMS1.8
! PSLIMS1.9
! Method: PSLIMS1.10
! PSLIMS1.11
! Current code owner: S.J.Swarbrick PSLIMS1.12
! PSLIMS1.13
! History: PSLIMS1.14
! Version Date Comment PSLIMS1.15
! ======= ==== ======= PSLIMS1.16
! 3.5 Apr. 95 Original code. S.J.Swarbrick PSLIMS1.17
! 4.0 03/01/96 Use SWBND/LWBND to get limits for pseudo levels GDR8F400.6
! involving SW/LW radiation bands. D. Robinson GDR8F400.7
! 4.1 May 96 Include last pseudo level codes for wave model GSS3F401.974
! S.J.Swarbrick GSS3F401.975
! 4.4 10/9/97 Include last pseudo level codes for sulphate ABX1F404.1
! loading patterns and surface types ABX1F404.2
! R.A.Betts ABX1F404.3
! PSLIMS1.18
! Code description: PSLIMS1.19
! FORTRAN 77 + common Fortran 90 extensions. PSLIMS1.20
! Written to UM programming standards version 7. PSLIMS1.21
! PSLIMS1.22
! System component covered: PSLIMS1.23
! System task: Sub-Models Project PSLIMS1.24
! PSLIMS1.25
! Subroutine arguments: PSLIMS1.26
! Scalar arguments with intent(in) GSS3F401.976
INTEGER IPFIRST PSLIMS1.30
INTEGER IPLAST PSLIMS1.31
PSLIMS1.32
! Scalar arguments with intent(out): PSLIMS1.33
INTEGER IFIRST PSLIMS1.35
INTEGER ILAST PSLIMS1.36
PSLIMS1.37
! Global variables: PSLIMS1.38
*CALL CSUBMODL 
PSLIMS1.40
*CALL VERSION PSLIMS1.41
*CALL TYPSIZE GSS3F401.977
*CALL CSENARIO ABX1F404.4
*CALL NSTYPES ABX1F404.5
*CALL MODEL PSLIMS1.42
PSLIMS1.43
!- End of Header -------------------------------------------------- PSLIMS1.44
PSLIMS1.45
IF(IPFIRST.EQ.1) THEN PSLIMS1.46
IFIRST=1 PSLIMS1.47
ELSE IF(IPFIRST.EQ.21) THEN PSLIMS1.48
IFIRST=AASPF(1) PSLIMS1.49
ELSE IF(IPFIRST.EQ.22) THEN PSLIMS1.50
IFIRST=AASPF(2) PSLIMS1.51
ELSE IF(IPFIRST.EQ.23) THEN PSLIMS1.52
IFIRST=AASPF(3) PSLIMS1.53
ELSE IF(IPFIRST.EQ.24) THEN PSLIMS1.54
IFIRST=AASPF(4) PSLIMS1.55
ELSE IF(IPFIRST.EQ.25) THEN PSLIMS1.56
IFIRST=AASPF(5) PSLIMS1.57
ELSE PSLIMS1.58
write(6,*) 'S: PSLIMS(PRELIM).INVALID IPFIRST. NO CHECKING' PSLIMS1.59
IFIRST=1 PSLIMS1.60
END IF PSLIMS1.61
PSLIMS1.62
IF(IPLAST.EQ.1) THEN PSLIMS1.63
ILAST=SWBND GDR8F400.8
ELSE IF(IPLAST.EQ.2) THEN PSLIMS1.65
ILAST=LWBND GDR8F400.9
ELSE IF(IPLAST.EQ.3) THEN PSLIMS1.67
ILAST=OCEAN_BASINS*MEAD_TYPES PSLIMS1.68
ELSE IF(IPLAST.EQ.4) THEN GSS3F401.978
!Wave model: frequency pseudo levels GSS3F401.979
ILAST=NFRE GSS3F401.980
ELSE IF(IPLAST.EQ.5) THEN GSS3F401.981
!Wave model: wave train pseudo levels GSS3F401.982
ILAST=NWTRAIN GSS3F401.983
ELSE IF(IPLAST.EQ.6) THEN ABX1F404.6
!Sulphate loading patterns ABX1F404.7
ILAST=NSULPAT ABX1F404.8
ELSE IF(IPLAST.EQ.7) THEN ABX1F404.9
!Direct vegetation parametrization: all surface types ABX1F404.10
ILAST=NTYPE ABX1F404.11
ELSE IF(IPLAST.EQ.8) THEN ABX1F404.12
!Direct vegetation parametrization: only plant functional types ABX1F404.13
ILAST=NPFT ABX1F404.14
ELSE IF(IPLAST.EQ.9) THEN ABX1F404.15
!Direct vegetation parametrization: all surface types except ice ABX1F404.16
ILAST=NTYPE-1 ABX1F404.17
ELSE IF(IPLAST.EQ.21) THEN PSLIMS1.69
ILAST=AASPL(1) PSLIMS1.70
ELSE IF(IPLAST.EQ.22) THEN PSLIMS1.71
ILAST=AASPL(2) PSLIMS1.72
ELSE IF(IPLAST.EQ.23) THEN PSLIMS1.73
ILAST=AASPL(3) PSLIMS1.74
ELSE IF(IPLAST.EQ.24) THEN PSLIMS1.75
ILAST=AASPL(4) PSLIMS1.76
ELSE IF(IPLAST.EQ.25) THEN PSLIMS1.77
ILAST=AASPL(5) PSLIMS1.78
ELSE PSLIMS1.79
write(6,*) 'S: PSLIMS(PRELIM). INVALID IPLAST. NO CHECKING' PSLIMS1.80
ILAST=1000 PSLIMS1.81
END IF PSLIMS1.82
PSLIMS1.83
RETURN PSLIMS1.84
END PSLIMS1.85
*ENDIF PSLIMS1.86