setup_geom_mod.F90

Go to the documentation of this file.

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