      PROGRAM INSERT
      PARAMETER (NLYRS=38,NSTND=14)
      PARAMETER (NINTFC=NLYRS+1,NLM1=NLYRS-1,NLM2=NLYRS-2)
      PARAMETER (NLDBL2=2*NLYRS,NIDBL=2*NINTFC)
      REAL DETA(NLYRS)
      REAL EINTFC(NINTFC),AETA(NLYRS),STNDPR(NSTND)
      REAL AETDBL(NLDBL2),EINDBL(NIDBL)
      REAL DRAW1(NINTFC)
      INTEGER LDT1(NLYRS)
      DATA PTOP2/25./
C     DATA DETAB2/0.002428592/,PTOP2/25./
      DATA STNDPR/20.,30.,50.,70.,100.,150.,200.,250.,300.,400.
     1,           500.,700.,850.,1000./
C----------------------------------------------------------------------
C***
C***  THIS PROGRAM WILL READ IN A SET OF DETA'S FOR A GIVEN PTOP1
C***  THAT YIELDS A 20M BOTTOM LAYER THEN CHANGE ALL LAYERS SO THAT
C***  THEY ARE APPROPRIATE FOR A NEW PTOP2.  THIS INCLUDES CHANGING
C***  THE BOTTOM LAYER TO THE NEW DETAB2.
C***
C***  READ IN THE DETA VALUE AT BOTTOM W/THICKNESS OF 20 M
C***
      READ(5,10)DETAB2
      WRITE(6,10)DETAB2
   10 FORMAT(F12.10)
C***
C----------------------------------------------------------------------
C***
C***  READ IN THE ORIGINAL DETA DISTRIBUTION.
C***
      REWIND 12
      READ(12)DETA
C----------------------------------------------------------------------
C***
C***  SUBTRACT THE NEW DETA FROM UNITY AND PROPORTIONATELY DIVIDE
C***  THE REMAINDER AMONG THE OTHER LAYERS.
C***
      REST=1.-DETAB2
      SUMOLD=0.
      SUMNEW=0.
      DO 25 L=1,NLM1
      SUMOLD=SUMOLD+DETA(L)
   25 CONTINUE
      DO 50 L=1,NLM1
      DETA(L)=DETA(L)/SUMOLD*REST
      SUMNEW=SUMNEW+DETA(L)
   50 CONTINUE
      DETA(NLYRS)=DETAB2
      SUMNEW=SUMNEW+DETA(NLYRS)
      WRITE(6,275)SUMNEW
  275 FORMAT(' SUMNEW=',E12.5)
  300 CONTINUE
C
      DETAMH=0.
      PRES=PTOP2
      PD=1013.25-PTOP2
      NSTND2=NSTND-2
      NN=1
      DO 350 N=1,NLYRS
      DETAH=0.5*DETA(N)
      PRES=PRES+(DETAMH+DETAH)*PD
      DETAMH=DETAH
      DIF1=ABS(PRES-STNDPR(NN))
      NN1=MIN(NN+1,NSTND)
      DIF2=ABS(PRES-STNDPR(NN1))
      IF(DIF1.LT.DIF2)THEN
        LDT1(N)=MAX(NN-1,1)
      ELSE
        LDT1(N)=MIN(NN,NSTND2)
        IF(NN.LT.NSTND)NN=NN+1
      ENDIF
  350 CONTINUE
      DO 400 L=1,NINTFC
      IF(L.EQ.1)THEN
        EINTFC(L)=0.
        GO TO 400
      ELSE
        EINTFC(L)=EINTFC(L-1)+DETA(L-1)
      ENDIF
  400 CONTINUE
      DO 500 N=1,NINTFC
      NI=N-1
      IF(N.EQ.1)THEN
        WRITE(6,450)NI,EINTFC(N)
  450   FORMAT(' INTFC=',I3,'  ETA=',E13.6)
      ELSE
        AETA(NI)=EINTFC(N-1)+0.5*DETA(N-1)
        WRITE(6,460)NI,EINTFC(N),DETA(N-1),AETA(NI),LDT1(N-1)
  460   FORMAT(' INTFC=',I3,'  ETA=',E13.6,'  DETA=',E13.6,
     1         '  AETA=',E13.6,' LDT1=',I2)
      ENDIF
  500 CONTINUE
      PRS=PTOP2
      DO 610 N=1,NLYRS
      DPRS=PD*DETA(N)
      PRS=PRS+DPRS
      WRITE(6,605)N,DPRS,PRS
  605 FORMAT(' N=',I3,' DELPRS=',E13.6,' PRS=',E12.5)
  610 CONTINUE
C     DO 700 L=1,NINTFC
C     DOTS=6.*(DRAW1(L)-AINT(DRAW1(L)))
C     DRAW1(L)=AINT(DRAW1(L))
C     WRITE(6,695)L,DRAW1(L),DOTS
  695 FORMAT(' L=',I2,' INT=',F3.0,' DOTS=',F4.2)
  700 CONTINUE
C***
C***  FOR SOME REASON, THE FRONT-END CODE READS ONLY EVERY
C***  OTHER WORD FROM THE MIDLAYER AND INTERFACE ARRAYS, SO
C***  BEFORE WRITING THEM OUT, REPEAT EACH WORD.
C***  WRITE MIDLAYER AND INTERFACE ETA VALUES FOR CO2 ROUTINES
C***
C***  THIS LOGIC NOT NEEDED FOR CRAY VERSION
C***
c     DO 750 N=1,NLYRS
c     NN=2*N-1
c     AETDBL(NN)=AETA(N)
c     AETDBL(NN+1)=AETA(N)
c 750 CONTINUE
c     DO 760 N=1,NINTFC
c     NN=2*N-1
c     EINDBL(NN)=EINTFC(N)
c     EINDBL(NN+1)=EINTFC(N)
c 760 CONTINUE
      WRITE(23)(AETA(N),N=NLYRS,1,-1)
      WRITE(23)(EINDBL(N),N=NINTFC,1,-1)
      WRITE(24)DETA,LDT1
      STOP
      END
