      SUBROUTINE SIGP(nlev,ntype,nmodel,pd,pd8,gtemp)
      implicit real(selected_real_kind(15)) (a-h,o-z)
      dimension q(200),qmh(200),pd(200),pd8(200),plm(200),gtemp(200)
      dimension q1(9),q2(18),q3(9),q4(18),q5(18)
C     9 LEVEL SIGMAS FOR EXP PRED GP
      DATA Q1/.0089163236,.074074073,.18861453,.33607680,.49999997,
     1 .66392314,.81138542,.92592590,.99108367/
C     18 LEVEL SIGMAS FOR EXP PRED GP
      DATA Q2/.0022719,.0196759,.0525120,.0987226,.1562500,
     1 .2230367,.2970250,.3761574,.4583762,.5416238,.6238425,
     2 .7029749,.7769632,.8437499,.9012774,.9474880,.9803240,
     3 .9977280/
C     DATA FOR WYMAN1 GRID (9 SIGMA LEVELS)
      DATA Q3/ .017145,.080245,.192730,.338135,.500000,
     1        .661865,.807270,.919755,.983855/
C     DATA FOR WYMAN2 GRID (18 SIGMA LEVELS)
C     DATA Q4/ .004460,.021605,.054180,.100135,.157405,.223935,
C    1        .297670,.376545,.458505,.541495,.623455,.702330,
C    2        .776065,.842595,.899865,.945820,.978395,.995540/
C     DATA Q/ .00334,.01534,.02963,.04656,.06649,.08979,
C    1        .11680,.14781,.18301,.22246,.26606,.31348,
C    2        .36419,.41744,.47230,.52770,.58256,.63581,
C    3        .68652,.73394,.77754,.81699,.85219,.88320,
C    4        .91021,.93351,.95344,.97037,.98466,.99666/
C     18 LEVEL SIGMAS FOR NMC MRF(NEW) MODEL
      DATA Q5/.021,.074,.124,.175,.225,.275,.325,.375,.425,.497,
     1       .594,.688,.777,.856,.920,.960,.981,.995/
C     FOR SIGMA MODELS,Q=SIGMA,QMH=0.5(Q(I)+Q(I+1),
C     PD=Q*PSS,PLM=QMH*PSS.PSS=SURFACE PRESSURE(SPEC.)
C
      kd=nlev
      kp=kd+1
      km=kd-1
      kp2=kd+2 
        PSS=    1013250.
      if (ntype.eq.3) then
        if (nmodel.eq.1) then
          do 201 k=1,nlev
            q(k)=q1(k)
201       continue
        endif 
        if (nmodel.eq.2) then
          do 202 k=1,nlev
            q(k)=q2(k)
202       continue
        endif 
        if (nmodel.eq.3) then
          do 203 k=1,nlev
            q(k)=q3(k)
203       continue
        endif 
        if (nmodel.eq.4) then
          do 204 k=1,nlev
            q(k)=q4(k)
204       continue
        endif 
        if (nmodel.eq.5) then
          do 205 k=1,nlev
            q(k)=q5(k)
205       continue
        endif 
        QMH(1)=0.
        QMH(KP)=1.
        DO 1 K=2,KD
        QMH(K)=0.5*(Q(K-1)+Q(K))
1       CONTINUE
        PD(1)=0.
        PD(KP2)=PSS
        DO 2 K=2,KP
        PD(K)=Q(K-1)*PSS
2       CONTINUE
      endif
c       This scaling is necessary to make the units come out right.
c       MRD 3/4/92
        do 234 l1=1,11
	   pd(l1) = 1.e3*pd(l1)
c          print *,l1,pd(l1)
 234      continue
      PLM(1)=0.
      DO 3 K=1,KM
      PLM(K+1)=0.5*(PD(K+1)+PD(K+2))
3     CONTINUE
      PLM(KP)=PSS
      DO 4 K=1,KD
      GTEMP(K)=PD(K+1)**0.2*(1.+PD(K+1)/30000.)**0.8/1013250.
4     CONTINUE
      GTEMP(KP)=0.
c     WRITE (10,100) (GTEMP(K),K=1,KD)
c     WRITE (10,100) (PD(K),K=1,KP2)
c     WRITE (10,100) (PLM(K),K=1,KP)
C***TAPES 41,42 ARE OUTPUT TO THE CO2 INTERPOLATION PROGRAM (PS=1013MB)
C  THE FOLLOWING PUTS P-DATA INTO MB
      DO 11 I=1,KP
      PD(I)=PD(I)*1.0E-3
      PLM(I)=PLM(I)*1.0E-3
11    CONTINUE
      PD(KP2)=PD(KP2)*1.0E-3
      if ( ntype.ne.0 ) then
      WRITE (41,101) (PD(K),K=1,KP2)
      WRITE (41,101) (PLM(K),K=1,KP)
      WRITE (42,101) (PLM(K),K=1,KP)
      end if
C***SECOND PASS: PSS=810MB,GTEMP NOT COMPUTED
      PSS=0.8*1013250.
      if (ntype.eq.3) then
        QMH(1)=0.
        QMH(KP)=1.
        DO 401 K=2,KD
        QMH(K)=0.5*(Q(K-1)+Q(K))
401     CONTINUE
        PD8(1)=0.
        PD8(KP2)=PSS
        DO 402 K=2,KP
        PD8(K)=Q(K-1)*PSS
402     CONTINUE
      endif
      PLM(1)=0.
      DO 403 K=1,KM
      PLM(K+1)=0.5*(PD8(K+1)+PD8(K+2))
403   CONTINUE
      PLM(KP)=PSS
c     WRITE (10,100) (PD8(K),K=1,KP2)
c     WRITE (10,100) (PLM(K),K=1,KP)
C***TAPES 43,44 ARE OUTPUT TO THE CO2 INTERPOLATION PROGRAM(PS=810 MB)
C  THE FOLLOWING PUTS P-DATA INTO MB
      DO 411 I=1,KP
      PD8(I)=PD8(I)*1.0E-3
      PLM(I)=PLM(I)*1.0E-3
411   CONTINUE
      PD8(KP2)=PD8(KP2)*1.0E-3
      if ( ntype.ne.0 ) then
      WRITE (43,101) (PD8(K),K=1,KP2)
      WRITE (43,101) (PLM(K),K=1,KP)
      WRITE (44,101) (PLM(K),K=1,KP)
      end if
100   FORMAT (1X,5E20.13)
101   FORMAT (5E16.9)
      RETURN
      END
