SUBROUTINE THEPRO90
!use consts
use global
implicit none  
    
real(DP) :: rlam1,cl1,res,cap,z1,zz,diso,a
integer :: i,j,il,jj
save

      RLAM1=RLAML(1)
      CL1=CL(1)
      
      DO 2 I=1,IDIM
      DO 2 J=1,JDIM
      RLAM(I,J)=RLAM1
    2 CIN(I,J)=CL1
    
      D(1)=THL(1)
      IF(ILAY.EQ.1) GO TO 8
      DO 10 I=2,ILAY
   10 D(I)=D(I-1)+THL(I)
   
    8 IL=1
      JJ=3
    5 IF(Z(JJ).GT.D(IL)) GO TO 15
      DO 11 I=1,IMAX1
      RLAM(I,JJ-1)=RLAML(IL)
      CIN(I,JJ-1)=CL(IL)
   11 CONTINUE
      !RLAM(1:IMAX1,JJ-1)=RLAML(IL)
      !CIN(1:IMAX1,JJ-1)=CL(IL)
   
   12 JJ=JJ+1
      IF(JJ.GT.JMAX1) GO TO 35
      GO TO 5
   15 RES=0.
      CAP=0.
      Z1=Z(JJ-1)
   20 ZZ=D(IL)-Z1
      RES=ZZ/RLAML(IL)+RES
      CAP=ZZ*CL(IL)+CAP
      Z1=D(IL)
      IL=IL+1
      IF(Z(JJ).GT.D(IL)) GO TO 20
      ZZ=Z(JJ)-Z1
      RES=ZZ/RLAML(IL)+RES
      CAP=ZZ*CL(IL)+CAP
      ZZ=Z(JJ)-Z(JJ-1)
      RES=ZZ/RES
      CAP=CAP/ZZ

      DO 30 I=1,IMAX1
      RLAM(I,JJ-1)=RES
      CIN(I,JJ-1)=CAP
   30 CONTINUE
      !RLAM(1:IMAX1,JJ-1)=RES
      !CIN(1:IMAX1,JJ-1)=CAP   
   
      GO TO 12
   35 CONTINUE
      IRR1=IRR+1
      JBZ1=JBZ+1
      
      RISOR=0.
      RISOZ=0.
   
      IF(ISO.EQ.0) GO TO 200
        
      RISOZ(2:IRR,JTZ)=RIST
      RISOZ(2:IRR,JBZ1)=RISB
   
      IF(FRISO.EQ.0.) GO TO 200
      IF(ISO.EQ.2) GO TO 80
      DISO=DEPTH+FRISO*HEIGHT
      J=JTZ
      A=100000000.
   60 CONTINUE
      IF(DISO.GT.Z(J+1)) GO TO 70
      A=(DISO-Z(J))/(Z(J+1)-Z(J))
      RISS=RISS*A
   70 CONTINUE
      RISOR(IRR1,J)=RISS
      J=J+1
      IF(J.GT.JBZ) GO TO 200
      IF(A.GT.1.) GO TO 60
      GO TO 200
   80 CONTINUE
      DISO=RADIUS+FRISO*HEIGHT
      I=IRR+1
      A=10000000.
   90 CONTINUE
      IF(DISO.GT.R(I+1)) GO TO 100
      A=(DISO**2-R(I)**2)/(R(I+1)**2-R(I)**2)
      RISS=RISS*A
  100 CONTINUE
      RISOZ(I,JTZ)=RISS
      I=I+1
      IF(I.GT.IMAX) GO TO 200
      IF(A.GT.1.) GO TO 90
  200 CONTINUE

RETURN
END subroutine thepro90