source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/rrtm/setup_geom_mod.F90 @ 3331

Last change on this file since 3331 was 3331, checked in by acozic, 6 years ago

Add modification for isotopes

  • Property svn:executable set to *
File size: 1.9 KB
Line 
1MODULE SETUP_GEOM_MOD
2CONTAINS
3SUBROUTINE SETUP_GEOM
4
5USE PARKIND1  ,ONLY : JPIM     ,JPRB
6
7USE TPM_GEN
8USE TPM_DIM
9USE TPM_FIELDS
10USE TPM_GEOMETRY
11
12IMPLICIT NONE
13
14REAL(KIND=JPRB) :: ZSQM2(R%NDGL)
15INTEGER(KIND=JPIM) :: IDGLU(0:R%NSMAX,R%NDGNH)
16INTEGER(KIND=JPIM) :: JGL,JM
17
18LOGICAL    :: LLP1,LLP2
19
20!     ------------------------------------------------------------------
21
22LLP1 = NPRINTLEV>0
23LLP2 = NPRINTLEV>1
24
25IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SETUP_GEOM ==='
26
27ALLOCATE (G%NMEN(R%NDGL))
28IF(LLP2)WRITE(NOUT,9) 'G%NMEN   ',SIZE(G%NMEN   ),SHAPE(G%NMEN   )
29
30IF (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 
48ELSE
49  G%NMEN(:) = R%NSMAX
50ENDIF
51IF(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)
55ENDIF
56ALLOCATE(G%NDGLU(0:R%NSMAX))
57IF(LLP2)WRITE(NOUT,9) 'G%NDGLU   ',SIZE(G%NDGLU   ),SHAPE(G%NDGLU   )
58IDGLU(:,:) = 0
59G%NDGLU(:) = 0
60DO JGL=1,R%NDGNH
61  DO JM=0,G%NMEN(JGL)
62    IDGLU(JM,JGL) = 1
63  ENDDO
64ENDDO
65DO JM=0,R%NSMAX
66  DO JGL=1,R%NDGNH
67    G%NDGLU(JM) = G%NDGLU(JM)+IDGLU(JM,JGL)
68  ENDDO
69ENDDO
70IF(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)
74ENDIF
75!     ------------------------------------------------------------------
769 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
77
78END SUBROUTINE SETUP_GEOM
79END MODULE SETUP_GEOM_MOD
Note: See TracBrowser for help on using the repository browser.