SUBROUTINE MESGEN90(IVAL,IDIMA,A,IMIN,IMUT,D1,D2,DRRMIN,DRMIN,DRMAX,FAC,FACL)

implicit none
INTEGER, PARAMETER :: iknd=SELECTED_INT_KIND(8)  ! nobody does this
INTEGER, PARAMETER :: DP=SELECTED_REAL_KIND(14)  ! this is double precision
INTEGER, PARAMETER :: SP=SELECTED_REAL_KIND(6)  ! this is single precision
real(DP) :: A(IDIMA),id0,id2,b0,b1,drmin,b2,d1,fac,im,i1,i2
real(DP) :: a1,a2,a3,c1,drmax,is,im1,ij,is1,drrmin,facl,d2
integer :: ival,iflag,i,idima,imin,imut
save

      A(1)=0.
      A(2)=0.
      GO TO(1,100,200,300),IVAL
!ONLY FOR VERTICAL MESH GROUND ABOVE THE STORAGE VOLUME
    1 IFLAG=0
      ID0=0
      ID2=0
      B0=0.
      B1=DRMIN
      B2=D2-D1
    5 ID0=ID0+1
      B0=B0+B1
      IF(B0.GT.B2) GO TO 10
      ID2=ID2+1
      B2=B2-B1
      IF(B0.GT.B2) GO TO 10
!      B1=B1*FAC
!---The smallest cell is repeated twice. Old version: no repetition ---DP
      IF(ID0.GT.1) B1=B1*FAC
      GO TO 5
   10 CONTINUE
      IM=ID0+ID2
      IF(IM.GT.2) GO TO 15
      IF (IM.GT.1) THEN
          A(IMIN+2)=D2
          A(IMIN+1)=0.5*(D1+D2)
          IMUT=IMIN+2
      ELSE
          A(IMIN+1)=D2
          IMUT=IMIN+1
      END IF
      RETURN
      
   15 CONTINUE
      A(IMIN+IM)=D2
      IF(ID0.GT.ID2) IFLAG=1
      ID0=IMIN
      ID2=IMIN+IM
      B1=DRMIN
   20 ID0=ID0+1
      IF(ID0.EQ.ID2) GO TO 30
      A(ID0)=A(ID0-1)+B1
      ID2=ID2-1
      IF(ID2.EQ.ID0) GO TO 30
      A(ID2)=A(ID2+1)-B1
!      B1=B1*FAC
!---The smallest cell is repeated twice. Old version: no repetition ---DP
      IF(ID0.GT.(IMIN+1)) B1=B1*FAC
      GO TO 20
   30 CONTINUE
      I1=ID0-IMIN
      I2=IM+IMIN-ID2
!-----IF(I1.GT.I2) ID0=ID0-1 This statement is executed 6 lines further!-DP
      IF(I1.GT.I2) GO TO 38
      ID2=ID2+1
      A(ID0)=0.5*(A(ID0-1)+A(ID2))
      GO TO 40
   38 CONTINUE
      ID0=ID0-1
      A1=A(ID2)-A(ID0)
      A2=A(ID0)-A(ID0-1)
      IF(A1.GT.A2) GO TO 40
      A3=(A(ID2+1)-A(ID0-1))/3.
      A(ID0)=A(ID0-1)+A3
      A(ID2)=A(ID2+1)-A3
   40 CONTINUE
      IMUT=IMIN+IM
      RETURN
!MESH GENERATOR FOR EXTERNAL FIELDS (RADIAL AND VERTICAL)
  100 CONTINUE
      C1=D1+DRMAX
      B1=DRMIN
      IS=IMIN+1
  110 A(IS)=A(IS-1)+B1
      IF(A(IS).GT.C1) GO TO 120
!---The smallest cell is repeated twice. Old version: no repetition ---DP
      IF(IS.GT.(IMIN+1)) B1=B1*FAC
      IS=IS+1
      GO TO 110
  120 CONTINUE
      IMUT=IS+1
      A(IMUT)=A(IS)+100.
      RETURN
!MESH GENERATOR FOR INTERNAL FIELDS (RADIAL AND VERTICAL)
  200 CONTINUE
      IM1=1
      B1=DRMIN
      B2=D1
  210 B2=B2-B1
      IF(B2.LT.0.) GO TO 220
      IM1=IM1+1
!---The smallest cell is repeated twice. Old version: no repetition ---DP
      IF(IM1.GT.2) B1=B1*FAC
      GO TO 210
  220 CONTINUE
      B1=DRMIN
      IM=IM1-1
      IS=IM1+2
      IJ=IS
      IF(IS.EQ.3) IS=4
      A(IS)=D1
      IF(IJ.EQ.3) GO TO 250
      IS1=IS-1
      IJ=IS1
      DO 230 I=3,IS1
      A(IJ)=A(IJ+1)-B1
      IJ=IJ-1
!---The smallest cell is repeated twice. Old version: no repetition ---DP
      IF(I.GT.3) B1=B1*FAC
  230 CONTINUE
      A1=A(3)-A(2)
      A2=A(4)-A(3)
      IF(A1.GT.A2) GO TO 260
  250 A(3)=0.5*(A(2)+A(4))
  260 CONTINUE
      IMUT=IS
      RETURN
!LOCAL FIELD MESH GENERATION
  300 CONTINUE
      B1=DRRMIN
      A(2)=D1
      IS=3
  310 A(IS)=A(IS-1)+B1
      IF(A(IS).GT.D2) GO TO 320

!---The smallest cell is repeated twice. Old version: no repetition ---DP
      IF(IS.GT.3) B1=B1*FACL
      IS=IS+1
      GO TO 310
  320 CONTINUE
      IMUT=IS
      A1=A(IS-1)-A(IS-2)
      A2=D2-A(IS-1)
      IF(A1.LT.A2) GO TO 330
      A(IS-1)=0.5*(A(IS-2)+D2)
  330 A(IS)=D2

RETURN
END subroutine mesgen90