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