[1989] | 1 | MODULE SETUP_GEOM_MOD |
---|
| 2 | CONTAINS |
---|
| 3 | SUBROUTINE SETUP_GEOM |
---|
| 4 | |
---|
| 5 | USE PARKIND1 ,ONLY : JPIM ,JPRB |
---|
| 6 | |
---|
| 7 | USE TPM_GEN |
---|
| 8 | USE TPM_DIM |
---|
| 9 | USE TPM_FIELDS |
---|
| 10 | USE TPM_GEOMETRY |
---|
| 11 | |
---|
| 12 | IMPLICIT NONE |
---|
| 13 | |
---|
| 14 | REAL(KIND=JPRB) :: ZSQM2(R%NDGL) |
---|
| 15 | INTEGER(KIND=JPIM) :: IDGLU(0:R%NSMAX,R%NDGNH) |
---|
| 16 | INTEGER(KIND=JPIM) :: JGL,JM |
---|
| 17 | |
---|
| 18 | LOGICAL :: LLP1,LLP2 |
---|
| 19 | |
---|
| 20 | ! ------------------------------------------------------------------ |
---|
| 21 | |
---|
| 22 | LLP1 = NPRINTLEV>0 |
---|
| 23 | LLP2 = NPRINTLEV>1 |
---|
| 24 | |
---|
| 25 | IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SETUP_GEOM ===' |
---|
| 26 | |
---|
| 27 | ALLOCATE (G%NMEN(R%NDGL)) |
---|
| 28 | IF(LLP2)WRITE(NOUT,9) 'G%NMEN ',SIZE(G%NMEN ),SHAPE(G%NMEN ) |
---|
| 29 | |
---|
| 30 | IF (G%LREDUCED_GRID) THEN |
---|
| 31 | IF (G%LINEAR_GRID) THEN |
---|
| 32 | ZSQM2(:) = 0.0_JPRB |
---|
| 33 | ELSE |
---|
| 34 | ZSQM2(:) = F%R1MU2(:) |
---|
| 35 | ENDIF |
---|
| 36 | G%NMEN(1) = MIN(R%NSMAX,INT(REAL(G%NLOEN(1)-1,JPRB)/(2.0_JPRB+ZSQM2(1)))) |
---|
| 37 | DO JGL=2,R%NDGNH |
---|
| 38 | G%NMEN(JGL) = MIN(R%NSMAX,MAX(G%NMEN(JGL-1),& |
---|
| 39 | &INT(REAL(G%NLOEN(JGL)-1,JPRB)/(2.0_JPRB+ ZSQM2(JGL))))) |
---|
| 40 | ENDDO |
---|
| 41 | ! * SOUTHERN HEMISPHERE : |
---|
| 42 | G%NMEN(R%NDGL) = MIN(R%NSMAX,INT(REAL(G%NLOEN(R%NDGL)-1,JPRB)/(2.0_JPRB+ZSQM2(R%NDGL)))) |
---|
| 43 | DO JGL=R%NDGL-1, R%NDGNH+1, -1 |
---|
| 44 | G%NMEN(JGL) = MIN(R%NSMAX,MAX(G%NMEN(JGL+1),& |
---|
| 45 | &INT(REAL(G%NLOEN(JGL)-1,JPRB)/(2.0_JPRB+ ZSQM2(JGL))))) |
---|
| 46 | ENDDO |
---|
| 47 | |
---|
| 48 | ELSE |
---|
| 49 | G%NMEN(:) = R%NSMAX |
---|
| 50 | ENDIF |
---|
| 51 | IF(LLP1) THEN |
---|
| 52 | WRITE(NOUT,FMT='('' (JGL,G%NLOEN,G%NMEN) '')') |
---|
| 53 | WRITE(NOUT,FMT='(8(1X,''('',I4,I4,I4,'')''))')& |
---|
| 54 | &(JGL,G%NLOEN(JGL),G%NMEN(JGL),JGL=1,R%NDGL) |
---|
| 55 | ENDIF |
---|
| 56 | ALLOCATE(G%NDGLU(0:R%NSMAX)) |
---|
| 57 | IF(LLP2)WRITE(NOUT,9) 'G%NDGLU ',SIZE(G%NDGLU ),SHAPE(G%NDGLU ) |
---|
| 58 | IDGLU(:,:) = 0 |
---|
| 59 | G%NDGLU(:) = 0 |
---|
| 60 | DO JGL=1,R%NDGNH |
---|
| 61 | DO JM=0,G%NMEN(JGL) |
---|
| 62 | IDGLU(JM,JGL) = 1 |
---|
| 63 | ENDDO |
---|
| 64 | ENDDO |
---|
| 65 | DO JM=0,R%NSMAX |
---|
| 66 | DO JGL=1,R%NDGNH |
---|
| 67 | G%NDGLU(JM) = G%NDGLU(JM)+IDGLU(JM,JGL) |
---|
| 68 | ENDDO |
---|
| 69 | ENDDO |
---|
| 70 | IF(LLP1) THEN |
---|
| 71 | WRITE(NOUT,FMT='('' (JM,G%NDGLU) '')') |
---|
| 72 | WRITE(NOUT,FMT='(10(1X,''('',I4,I4,'')''))')& |
---|
| 73 | &(JM,G%NDGLU(JM),JM=0,R%NSMAX) |
---|
| 74 | ENDIF |
---|
| 75 | ! ------------------------------------------------------------------ |
---|
| 76 | 9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) |
---|
| 77 | |
---|
| 78 | END SUBROUTINE SETUP_GEOM |
---|
| 79 | END MODULE SETUP_GEOM_MOD |
---|