MODULE SETUP_GEOM_MOD
CONTAINS
SUBROUTINE SETUP_GEOM

USE PARKIND1  ,ONLY : JPIM     ,JPRB

USE TPM_GEN
USE TPM_DIM
USE TPM_FIELDS
USE TPM_GEOMETRY

IMPLICIT NONE

REAL(KIND=JPRB) :: ZSQM2(R%NDGL)
INTEGER(KIND=JPIM) :: IDGLU(0:R%NSMAX,R%NDGNH)
INTEGER(KIND=JPIM) :: JGL,JM

LOGICAL    :: LLP1,LLP2

!     ------------------------------------------------------------------

LLP1 = NPRINTLEV>0
LLP2 = NPRINTLEV>1

IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SETUP_GEOM ==='

ALLOCATE (G%NMEN(R%NDGL))
IF(LLP2)WRITE(NOUT,9) 'G%NMEN   ',SIZE(G%NMEN   ),SHAPE(G%NMEN   )

IF (G%LREDUCED_GRID) THEN
  IF (G%LINEAR_GRID) THEN
    ZSQM2(:) = 0.0_JPRB
  ELSE
    ZSQM2(:) = F%R1MU2(:)
  ENDIF
  G%NMEN(1) = MIN(R%NSMAX,INT(REAL(G%NLOEN(1)-1,JPRB)/(2.0_JPRB+ZSQM2(1))))
  DO JGL=2,R%NDGNH
    G%NMEN(JGL) = MIN(R%NSMAX,MAX(G%NMEN(JGL-1),&
     &INT(REAL(G%NLOEN(JGL)-1,JPRB)/(2.0_JPRB+ ZSQM2(JGL)))))
  ENDDO
  !       * SOUTHERN HEMISPHERE :
  G%NMEN(R%NDGL) = MIN(R%NSMAX,INT(REAL(G%NLOEN(R%NDGL)-1,JPRB)/(2.0_JPRB+ZSQM2(R%NDGL))))
  DO JGL=R%NDGL-1, R%NDGNH+1, -1
    G%NMEN(JGL) = MIN(R%NSMAX,MAX(G%NMEN(JGL+1),&
     &INT(REAL(G%NLOEN(JGL)-1,JPRB)/(2.0_JPRB+ ZSQM2(JGL)))))
  ENDDO
  
ELSE
  G%NMEN(:) = R%NSMAX
ENDIF
IF(LLP1) THEN
  WRITE(NOUT,FMT='('' (JGL,G%NLOEN,G%NMEN) '')')
  WRITE(NOUT,FMT='(8(1X,''('',I4,I4,I4,'')''))')&
   &(JGL,G%NLOEN(JGL),G%NMEN(JGL),JGL=1,R%NDGL)
ENDIF
ALLOCATE(G%NDGLU(0:R%NSMAX))
IF(LLP2)WRITE(NOUT,9) 'G%NDGLU   ',SIZE(G%NDGLU   ),SHAPE(G%NDGLU   )
IDGLU(:,:) = 0
G%NDGLU(:) = 0
DO JGL=1,R%NDGNH
  DO JM=0,G%NMEN(JGL)
    IDGLU(JM,JGL) = 1
  ENDDO
ENDDO
DO JM=0,R%NSMAX
  DO JGL=1,R%NDGNH
    G%NDGLU(JM) = G%NDGLU(JM)+IDGLU(JM,JGL)
  ENDDO
ENDDO
IF(LLP1) THEN
    WRITE(NOUT,FMT='('' (JM,G%NDGLU) '')')
  WRITE(NOUT,FMT='(10(1X,''('',I4,I4,'')''))')&
   &(JM,G%NDGLU(JM),JM=0,R%NSMAX)
ENDIF
!     ------------------------------------------------------------------
9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

END SUBROUTINE SETUP_GEOM
END MODULE SETUP_GEOM_MOD