[3331] | 1 | SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KLOEN,LDLINEAR_GRID,LDSPLIT,& |
---|
| 2 | &KAPSETS,KTMAX,KRESOL) |
---|
| 3 | |
---|
| 4 | !**** *SETUP_TRANS* - Setup transform package for specific resolution |
---|
| 5 | |
---|
| 6 | ! Purpose. |
---|
| 7 | ! -------- |
---|
| 8 | ! To setup for making spectral transforms. Each call to this routine |
---|
| 9 | ! creates a new resolution up to a maximum of NMAX_RESOL set up in |
---|
| 10 | ! SETUP_TRANS0. You need to call SETUP_TRANS0 before this routine can |
---|
| 11 | ! be called. |
---|
| 12 | |
---|
| 13 | !** Interface. |
---|
| 14 | ! ---------- |
---|
| 15 | ! CALL SETUP_TRANS(...) |
---|
| 16 | |
---|
| 17 | ! Explicit arguments : KLOEN,LDLINEAR_GRID,LDSPLIT,KAPSETS are optional arguments |
---|
| 18 | ! -------------------- |
---|
| 19 | ! KSMAX - spectral truncation required |
---|
| 20 | ! KDGL - number of Gaussian latitudes |
---|
| 21 | ! KLOEN(:) - number of points on each Gaussian latitude [2*KDGL] |
---|
| 22 | ! LDSPLIT - true if split latitudes in grid-point space [false] |
---|
| 23 | ! LDLINEAR_GRID - true if linear grid |
---|
| 24 | ! KAPSETS - Number of apple sets in the distribution [0] |
---|
| 25 | ! KTMAX - truncation order for tendencies? |
---|
| 26 | ! KRESOL - the resolution identifier |
---|
| 27 | |
---|
| 28 | ! KSMAX,KDGL,KTMAX and KLOEN are GLOBAL variables desribing the resolution |
---|
| 29 | ! in spectral and grid-point space |
---|
| 30 | |
---|
| 31 | ! LDSPLIT and KAPSETS describe the distribution among processors of |
---|
| 32 | ! grid-point data and has no relevance if you are using a single processor |
---|
| 33 | |
---|
| 34 | ! Method. |
---|
| 35 | ! ------- |
---|
| 36 | |
---|
| 37 | ! Externals. SET_RESOL - set resolution |
---|
| 38 | ! ---------- SETUP_DIMS - setup distribution independent dimensions |
---|
| 39 | ! SUMP_TRANS_PRELEG - first part of setup of distr. environment |
---|
| 40 | ! SULEG - Compute Legandre polonomial and Gaussian |
---|
| 41 | ! Latitudes and Weights |
---|
| 42 | ! SETUP_GEOM - Compute arrays related to grid-point geometry |
---|
| 43 | ! SUMP_TRANS - Second part of setup of distributed environment |
---|
| 44 | ! SUFFT - setup for FFT |
---|
| 45 | |
---|
| 46 | ! Author. |
---|
| 47 | ! ------- |
---|
| 48 | ! Mats Hamrud *ECMWF* |
---|
| 49 | |
---|
| 50 | ! Modifications. |
---|
| 51 | ! -------------- |
---|
| 52 | ! Original : 00-03-03 |
---|
| 53 | |
---|
| 54 | ! ------------------------------------------------------------------ |
---|
| 55 | |
---|
| 56 | USE PARKIND1 ,ONLY : JPIM ,JPRB |
---|
| 57 | |
---|
| 58 | !ifndef INTERFACE |
---|
| 59 | |
---|
| 60 | USE TPM_GEN |
---|
| 61 | USE TPM_DIM |
---|
| 62 | USE TPM_DISTR |
---|
| 63 | USE TPM_GEOMETRY |
---|
| 64 | USE TPM_FIELDS |
---|
| 65 | USE TPM_FFT |
---|
| 66 | |
---|
| 67 | USE SET_RESOL_MOD |
---|
| 68 | USE SETUP_DIMS_MOD |
---|
| 69 | USE SUMP_TRANS_MOD |
---|
| 70 | USE SUMP_TRANS_PRELEG_MOD |
---|
| 71 | USE SULEG_MOD |
---|
| 72 | USE SETUP_GEOM_MOD |
---|
| 73 | USE SUFFT_MOD |
---|
| 74 | USE ABORT_TRANS_MOD |
---|
| 75 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
---|
| 76 | |
---|
| 77 | !endif INTERFACE |
---|
| 78 | |
---|
| 79 | IMPLICIT NONE |
---|
| 80 | |
---|
| 81 | ! Dummy arguments |
---|
| 82 | |
---|
| 83 | INTEGER(KIND=JPIM) ,INTENT(IN) :: KSMAX,KDGL |
---|
| 84 | INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KLOEN(:) |
---|
| 85 | LOGICAL ,OPTIONAL,INTENT(IN) :: LDLINEAR_GRID |
---|
| 86 | LOGICAL ,OPTIONAL,INTENT(IN) :: LDSPLIT |
---|
| 87 | INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KAPSETS |
---|
| 88 | INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KTMAX |
---|
| 89 | INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT):: KRESOL |
---|
| 90 | |
---|
| 91 | !ifndef INTERFACE |
---|
| 92 | |
---|
| 93 | ! Local variables |
---|
| 94 | INTEGER(KIND=JPIM) :: JGL |
---|
| 95 | |
---|
| 96 | LOGICAL :: LLP1,LLP2 |
---|
| 97 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
| 98 | |
---|
| 99 | ! ------------------------------------------------------------------ |
---|
| 100 | |
---|
| 101 | IF (LHOOK) CALL DR_HOOK('SETUP_TRANS',0,ZHOOK_HANDLE) |
---|
| 102 | |
---|
| 103 | IF(MSETUP0 /= 1) THEN |
---|
| 104 | CALL ABORT_TRANS('SETUP_TRANS: SETUP_TRANS0 HAS TO BE CALLED BEFORE SETUP_TRANS') |
---|
| 105 | ENDIF |
---|
| 106 | LLP1 = NPRINTLEV>0 |
---|
| 107 | LLP2 = NPRINTLEV>1 |
---|
| 108 | IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SETUP_TRANS ===' |
---|
| 109 | |
---|
| 110 | ! Allocate resolution dependent structures |
---|
| 111 | IF(.NOT. ALLOCATED(DIM_RESOL)) THEN |
---|
| 112 | NDEF_RESOL = 1 |
---|
| 113 | ALLOCATE(DIM_RESOL(NMAX_RESOL)) |
---|
| 114 | ALLOCATE(FIELDS_RESOL(NMAX_RESOL)) |
---|
| 115 | ALLOCATE(GEOM_RESOL(NMAX_RESOL)) |
---|
| 116 | ALLOCATE(DISTR_RESOL(NMAX_RESOL)) |
---|
| 117 | ALLOCATE(FFT_RESOL(NMAX_RESOL)) |
---|
| 118 | ELSE |
---|
| 119 | NDEF_RESOL = NDEF_RESOL+1 |
---|
| 120 | IF(NDEF_RESOL > NMAX_RESOL) THEN |
---|
| 121 | CALL ABORT_TRANS('SETUP_TRANS:NDEF_RESOL > NMAX_RESOL') |
---|
| 122 | ENDIF |
---|
| 123 | ENDIF |
---|
| 124 | |
---|
| 125 | IF (PRESENT(KRESOL)) THEN |
---|
| 126 | KRESOL=NDEF_RESOL |
---|
| 127 | ENDIF |
---|
| 128 | |
---|
| 129 | ! Point at structures due to be initialized |
---|
| 130 | CALL SET_RESOL(NDEF_RESOL) |
---|
| 131 | |
---|
| 132 | IF(LLP1) WRITE(NOUT,*) '=== DEFINING RESOLUTION ',NCUR_RESOL |
---|
| 133 | |
---|
| 134 | |
---|
| 135 | |
---|
| 136 | ! Defaults for optional arguments |
---|
| 137 | |
---|
| 138 | |
---|
| 139 | G%LREDUCED_GRID = .FALSE. |
---|
| 140 | G%LINEAR_GRID = .FALSE. |
---|
| 141 | D%LSPLIT = .FALSE. |
---|
| 142 | D%NAPSETS = 0 |
---|
| 143 | |
---|
| 144 | ! NON-OPTIONAL ARGUMENTS |
---|
| 145 | R%NSMAX = KSMAX |
---|
| 146 | R%NDGL = KDGL |
---|
| 147 | R%NDLON = 2*KDGL |
---|
| 148 | |
---|
| 149 | IF (KDGL <= 0 .OR. MOD(KDGL,2) /= 0) THEN |
---|
| 150 | CALL ABORT_TRANS ('SETUP_TRANS: KDGL IS NOT A POSITIVE, EVEN NUMBER') |
---|
| 151 | ENDIF |
---|
| 152 | |
---|
| 153 | ! Optional arguments |
---|
| 154 | |
---|
| 155 | ALLOCATE(G%NLOEN(R%NDGL)) |
---|
| 156 | IF(LLP2)WRITE(NOUT,9) 'NLOEN ',SIZE(G%NLOEN ),SHAPE(G%NLOEN ) |
---|
| 157 | IF(PRESENT(KLOEN)) THEN |
---|
| 158 | DO JGL=1,R%NDGL |
---|
| 159 | IF(KLOEN(JGL) /= R%NDLON) THEN |
---|
| 160 | G%LREDUCED_GRID = .TRUE. |
---|
| 161 | EXIT |
---|
| 162 | ENDIF |
---|
| 163 | ENDDO |
---|
| 164 | ENDIF |
---|
| 165 | |
---|
| 166 | IF (G%LREDUCED_GRID) THEN |
---|
| 167 | G%NLOEN(:) = KLOEN(1:R%NDGL) |
---|
| 168 | ELSE |
---|
| 169 | G%NLOEN(:) = R%NDLON |
---|
| 170 | ENDIF |
---|
| 171 | |
---|
| 172 | IF(PRESENT(LDSPLIT)) THEN |
---|
| 173 | D%LSPLIT = LDSPLIT |
---|
| 174 | ENDIF |
---|
| 175 | |
---|
| 176 | IF(PRESENT(KAPSETS)) THEN |
---|
| 177 | D%NAPSETS = KAPSETS |
---|
| 178 | ENDIF |
---|
| 179 | |
---|
| 180 | IF(PRESENT(KTMAX)) THEN |
---|
| 181 | R%NTMAX = KTMAX |
---|
| 182 | ELSE |
---|
| 183 | R%NTMAX = R%NSMAX |
---|
| 184 | ENDIF |
---|
| 185 | IF(R%NTMAX /= R%NSMAX) THEN |
---|
| 186 | !This SHOULD work but I don't know how to test it /MH |
---|
| 187 | CALL ABORT_TRANS('SETUP_TRANS:R%NTMAX /= R%NSMAX HAS NOT BEEN VALIDATED') |
---|
| 188 | ENDIF |
---|
| 189 | !Temporary? |
---|
| 190 | IF(PRESENT(LDLINEAR_GRID)) THEN |
---|
| 191 | G%LINEAR_GRID = LDLINEAR_GRID |
---|
| 192 | ELSEIF(R%NSMAX > (R%NDLON+3)/3) THEN |
---|
| 193 | G%LINEAR_GRID = .TRUE. |
---|
| 194 | ENDIF |
---|
| 195 | |
---|
| 196 | ! Setup resolution dependent structures |
---|
| 197 | ! ------------------------------------- |
---|
| 198 | |
---|
| 199 | ! Setup distribution independent dimensions |
---|
| 200 | CALL SETUP_DIMS |
---|
| 201 | |
---|
| 202 | ! First part of setup of distributed environment |
---|
| 203 | CALL SUMP_TRANS_PRELEG |
---|
| 204 | |
---|
| 205 | ! Compute Legandre polonomial and Gaussian Latitudes and Weights |
---|
| 206 | CALL SULEG |
---|
| 207 | |
---|
| 208 | !CALL GSTATS(1802,0) MPL 2.12.08 |
---|
| 209 | ! Compute arrays related to grid-point geometry |
---|
| 210 | CALL SETUP_GEOM |
---|
| 211 | |
---|
| 212 | ! Second part of setup of distributed environment |
---|
| 213 | CALL SUMP_TRANS |
---|
| 214 | |
---|
| 215 | ! Initialize Fast Fourier Transform package |
---|
| 216 | CALL SUFFT |
---|
| 217 | !CALL GSTATS(1802,1) MPL 2.12.08 |
---|
| 218 | |
---|
| 219 | |
---|
| 220 | IF (LHOOK) CALL DR_HOOK('SETUP_TRANS',1,ZHOOK_HANDLE) |
---|
| 221 | ! ------------------------------------------------------------------ |
---|
| 222 | 9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) |
---|
| 223 | |
---|
| 224 | !endif INTERFACE |
---|
| 225 | |
---|
| 226 | END SUBROUTINE SETUP_TRANS |
---|
| 227 | |
---|
| 228 | |
---|