| 1 | module pdstemplates |
|---|
| 2 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 3 | ! . . . . |
|---|
| 4 | ! MODULE: pdstemplates |
|---|
| 5 | ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11 |
|---|
| 6 | ! |
|---|
| 7 | ! ABSTRACT: This Fortran Module contains info on all the available |
|---|
| 8 | ! GRIB2 Product Definition Templates used in Section 4 (PDS). |
|---|
| 9 | ! Each Template has three parts: The number of entries in the template |
|---|
| 10 | ! (mapgridlen); A map of the template (mapgrid), which contains the |
|---|
| 11 | ! number of octets in which to pack each of the template values; and |
|---|
| 12 | ! a logical value (needext) that indicates whether the Template needs |
|---|
| 13 | ! to be extended. In some cases the number of entries in a template |
|---|
| 14 | ! can vary depending upon values specified in the "static" part of |
|---|
| 15 | ! the template. ( See Template 4.3 as an example ) |
|---|
| 16 | ! |
|---|
| 17 | ! This module also contains two subroutines. Subroutine getpdstemplate |
|---|
| 18 | ! returns the octet map for a specified Template number, and |
|---|
| 19 | ! subroutine extpdstemplate will calculate the extended octet map |
|---|
| 20 | ! of an appropriate template given values for the "static" part of the |
|---|
| 21 | ! template. See docblocks below for the arguments and usage of these |
|---|
| 22 | ! routines. |
|---|
| 23 | ! |
|---|
| 24 | ! NOTE: Array mapgrid contains the number of octets in which the |
|---|
| 25 | ! corresponding template values will be stored. A negative value in |
|---|
| 26 | ! mapgrid is used to indicate that the corresponding template entry can |
|---|
| 27 | ! contain negative values. This information is used later when packing |
|---|
| 28 | ! (or unpacking) the template data values. Negative data values in GRIB |
|---|
| 29 | ! are stored with the left most bit set to one, and a negative number |
|---|
| 30 | ! of octets value in mapgrid() indicates that this possibility should |
|---|
| 31 | ! be considered. The number of octets used to store the data value |
|---|
| 32 | ! in this case would be the absolute value of the negative value in |
|---|
| 33 | ! mapgrid(). |
|---|
| 34 | ! |
|---|
| 35 | ! |
|---|
| 36 | ! PROGRAM HISTORY LOG: |
|---|
| 37 | ! 2000-05-11 Gilbert |
|---|
| 38 | ! 2001-12-04 Gilbert - Added Templates 4.12, 4.12, 4.14, |
|---|
| 39 | ! 4.1000, 4.1001, 4.1002, 4.1100 and 4.1101 |
|---|
| 40 | ! |
|---|
| 41 | ! USAGE: use pdstemplates |
|---|
| 42 | ! |
|---|
| 43 | ! ATTRIBUTES: |
|---|
| 44 | ! LANGUAGE: Fortran 90 |
|---|
| 45 | ! MACHINE: IBM SP |
|---|
| 46 | ! |
|---|
| 47 | !$$$ |
|---|
| 48 | |
|---|
| 49 | integer,parameter :: MAXLEN=200,MAXTEMP=23 |
|---|
| 50 | |
|---|
| 51 | type pdstemplate |
|---|
| 52 | integer :: template_num |
|---|
| 53 | integer :: mappdslen |
|---|
| 54 | integer,dimension(MAXLEN) :: mappds |
|---|
| 55 | logical :: needext |
|---|
| 56 | end type pdstemplate |
|---|
| 57 | |
|---|
| 58 | type(pdstemplate),dimension(MAXTEMP) :: templates |
|---|
| 59 | |
|---|
| 60 | data templates(1)%template_num /0/ ! Fcst at Level/Layer |
|---|
| 61 | data templates(1)%mappdslen /15/ |
|---|
| 62 | data templates(1)%needext /.false./ |
|---|
| 63 | data (templates(1)%mappds(j),j=1,15) |
|---|
| 64 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/ |
|---|
| 65 | |
|---|
| 66 | data templates(2)%template_num /1/ ! Ens fcst at level/layer |
|---|
| 67 | data templates(2)%mappdslen /18/ |
|---|
| 68 | data templates(2)%needext /.false./ |
|---|
| 69 | data (templates(2)%mappds(j),j=1,18) |
|---|
| 70 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/ |
|---|
| 71 | |
|---|
| 72 | data templates(3)%template_num /2/ ! Derived Ens fcst at level/layer |
|---|
| 73 | data templates(3)%mappdslen /17/ |
|---|
| 74 | data templates(3)%needext /.false./ |
|---|
| 75 | data (templates(3)%mappds(j),j=1,17) |
|---|
| 76 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1/ |
|---|
| 77 | |
|---|
| 78 | data templates(4)%template_num /3/ ! Ens cluster fcst rect. area |
|---|
| 79 | data templates(4)%mappdslen /31/ |
|---|
| 80 | data templates(4)%needext /.true./ |
|---|
| 81 | data (templates(4)%mappds(j),j=1,31) |
|---|
| 82 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,-4,4,4, |
|---|
| 83 | & 1,-1,4,-1,4/ |
|---|
| 84 | |
|---|
| 85 | data templates(5)%template_num /4/ ! Ens cluster fcst circ. area |
|---|
| 86 | data templates(5)%mappdslen /30/ |
|---|
| 87 | data templates(5)%needext /.true./ |
|---|
| 88 | data (templates(5)%mappds(j),j=1,30) |
|---|
| 89 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,4,4, |
|---|
| 90 | & 1,-1,4,-1,4/ |
|---|
| 91 | |
|---|
| 92 | data templates(6)%template_num /5/ ! Prob fcst at level/layer |
|---|
| 93 | data templates(6)%mappdslen /22/ |
|---|
| 94 | data templates(6)%needext /.false./ |
|---|
| 95 | data (templates(6)%mappds(j),j=1,22) |
|---|
| 96 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,4,1,4/ |
|---|
| 97 | |
|---|
| 98 | data templates(7)%template_num /6/ ! Percentile fcst at level/layer |
|---|
| 99 | data templates(7)%mappdslen /16/ |
|---|
| 100 | data templates(7)%needext /.false./ |
|---|
| 101 | data (templates(7)%mappds(j),j=1,16) |
|---|
| 102 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1/ |
|---|
| 103 | |
|---|
| 104 | data templates(8)%template_num /7/ ! Error at level/layer |
|---|
| 105 | data templates(8)%mappdslen /15/ |
|---|
| 106 | data templates(8)%needext /.false./ |
|---|
| 107 | data (templates(8)%mappds(j),j=1,15) |
|---|
| 108 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/ |
|---|
| 109 | |
|---|
| 110 | data templates(9)%template_num /8/ ! Ave or Accum at level/layer |
|---|
| 111 | data templates(9)%mappdslen /29/ |
|---|
| 112 | data templates(9)%needext /.true./ |
|---|
| 113 | data (templates(9)%mappds(j),j=1,29) |
|---|
| 114 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/ |
|---|
| 115 | |
|---|
| 116 | data templates(10)%template_num /9/ ! Prob over time interval |
|---|
| 117 | data templates(10)%mappdslen /36/ |
|---|
| 118 | data templates(10)%needext /.true./ |
|---|
| 119 | data (templates(10)%mappds(j),j=1,36) |
|---|
| 120 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,-1,4,-1,4,2,1,1,1,1,1, |
|---|
| 121 | & 1,4,1,1,1,4,1,4/ |
|---|
| 122 | |
|---|
| 123 | data templates(11)%template_num /10/ ! Percentile over time interval |
|---|
| 124 | data templates(11)%mappdslen /30/ |
|---|
| 125 | data templates(11)%needext /.true./ |
|---|
| 126 | data (templates(11)%mappds(j),j=1,30) |
|---|
| 127 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,2,1,1,1,1,1,1,4, |
|---|
| 128 | & 1,1,1,4,1,4/ |
|---|
| 129 | |
|---|
| 130 | data templates(12)%template_num /11/ ! Ens member over time interval |
|---|
| 131 | data templates(12)%mappdslen /32/ |
|---|
| 132 | data templates(12)%needext /.true./ |
|---|
| 133 | data (templates(12)%mappds(j),j=1,32) |
|---|
| 134 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,2,1,1,1,1,1,1, |
|---|
| 135 | & 4,1,1,1,4,1,4/ |
|---|
| 136 | |
|---|
| 137 | data templates(13)%template_num /12/ ! Derived Ens fcst over time int |
|---|
| 138 | data templates(13)%mappdslen /31/ |
|---|
| 139 | data templates(13)%needext /.true./ |
|---|
| 140 | data (templates(13)%mappds(j),j=1,31) |
|---|
| 141 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1, |
|---|
| 142 | & 2,1,1,1,1,1,1,4,1,1,1,4,1,4/ |
|---|
| 143 | |
|---|
| 144 | data templates(14)%template_num /13/ ! Ens cluster fcst rect. area |
|---|
| 145 | data templates(14)%mappdslen /45/ |
|---|
| 146 | data templates(14)%needext /.true./ |
|---|
| 147 | data (templates(14)%mappds(j),j=1,45) |
|---|
| 148 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,-4,4,4, |
|---|
| 149 | & 1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/ |
|---|
| 150 | |
|---|
| 151 | data templates(15)%template_num /14/ ! Ens cluster fcst circ. area |
|---|
| 152 | data templates(15)%mappdslen /44/ |
|---|
| 153 | data templates(15)%needext /.true./ |
|---|
| 154 | data (templates(15)%mappds(j),j=1,44) |
|---|
| 155 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,4,4, |
|---|
| 156 | & 1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/ |
|---|
| 157 | |
|---|
| 158 | data templates(16)%template_num /20/ ! Radar Product |
|---|
| 159 | data templates(16)%mappdslen /19/ |
|---|
| 160 | data templates(16)%needext /.false./ |
|---|
| 161 | data (templates(16)%mappds(j),j=1,19) |
|---|
| 162 | & /1,1,1,1,1,-4,4,2,4,2,1,1,1,1,1,2,1,3,2/ |
|---|
| 163 | |
|---|
| 164 | data templates(17)%template_num /30/ ! Satellite Product |
|---|
| 165 | data templates(17)%mappdslen /5/ |
|---|
| 166 | data templates(17)%needext /.true./ |
|---|
| 167 | data (templates(17)%mappds(j),j=1,5) |
|---|
| 168 | & /1,1,1,1,1/ |
|---|
| 169 | |
|---|
| 170 | data templates(18)%template_num /254/ ! CCITTIA5 Character String |
|---|
| 171 | data templates(18)%mappdslen /3/ |
|---|
| 172 | data templates(18)%needext /.false./ |
|---|
| 173 | data (templates(18)%mappds(j),j=1,3) |
|---|
| 174 | & /1,1,4/ |
|---|
| 175 | |
|---|
| 176 | data templates(19)%template_num /1000/ ! Cross section |
|---|
| 177 | data templates(19)%mappdslen /9/ |
|---|
| 178 | data templates(19)%needext /.false./ |
|---|
| 179 | data (templates(19)%mappds(j),j=1,9) |
|---|
| 180 | & /1,1,1,1,1,2,1,1,4/ |
|---|
| 181 | |
|---|
| 182 | data templates(20)%template_num /1001/ ! Cross section over time |
|---|
| 183 | data templates(20)%mappdslen /16/ |
|---|
| 184 | data templates(20)%needext /.false./ |
|---|
| 185 | data (templates(20)%mappds(j),j=1,16) |
|---|
| 186 | & /1,1,1,1,1,2,1,1,4,4,1,1,1,4,1,4/ |
|---|
| 187 | |
|---|
| 188 | data templates(21)%template_num /1002/ ! Cross section processed time |
|---|
| 189 | data templates(21)%mappdslen /15/ |
|---|
| 190 | data templates(21)%needext /.false./ |
|---|
| 191 | data (templates(21)%mappds(j),j=1,15) |
|---|
| 192 | & /1,1,1,1,1,2,1,1,4,1,1,1,4,4,2/ |
|---|
| 193 | |
|---|
| 194 | data templates(22)%template_num /1100/ ! Hovmoller grid |
|---|
| 195 | data templates(22)%mappdslen /15/ |
|---|
| 196 | data templates(22)%needext /.false./ |
|---|
| 197 | data (templates(22)%mappds(j),j=1,15) |
|---|
| 198 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/ |
|---|
| 199 | |
|---|
| 200 | data templates(23)%template_num /1101/ ! Hovmoller with stat proc |
|---|
| 201 | data templates(23)%mappdslen /22/ |
|---|
| 202 | data templates(23)%needext /.false./ |
|---|
| 203 | data (templates(23)%mappds(j),j=1,22) |
|---|
| 204 | & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,4,1,1,1,4,1,4/ |
|---|
| 205 | |
|---|
| 206 | |
|---|
| 207 | contains |
|---|
| 208 | |
|---|
| 209 | integer function getpdsindex(number) |
|---|
| 210 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 211 | ! . . . . |
|---|
| 212 | ! SUBPROGRAM: getpdsindex |
|---|
| 213 | ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-28 |
|---|
| 214 | ! |
|---|
| 215 | ! ABSTRACT: This function returns the index of specified Product |
|---|
| 216 | ! Definition Template 4.NN (NN=number) in array templates. |
|---|
| 217 | ! |
|---|
| 218 | ! PROGRAM HISTORY LOG: |
|---|
| 219 | ! 2001-06-28 Gilbert |
|---|
| 220 | ! |
|---|
| 221 | ! USAGE: index=getpdsindex(number) |
|---|
| 222 | ! INPUT ARGUMENT LIST: |
|---|
| 223 | ! number - NN, indicating the number of the Product Definition |
|---|
| 224 | ! Template 4.NN that is being requested. |
|---|
| 225 | ! |
|---|
| 226 | ! RETURNS: Index of PDT 4.NN in array templates, if template exists. |
|---|
| 227 | ! = -1, otherwise. |
|---|
| 228 | ! |
|---|
| 229 | ! REMARKS: None |
|---|
| 230 | ! |
|---|
| 231 | ! ATTRIBUTES: |
|---|
| 232 | ! LANGUAGE: Fortran 90 |
|---|
| 233 | ! MACHINE: IBM SP |
|---|
| 234 | ! |
|---|
| 235 | !$$$ |
|---|
| 236 | integer,intent(in) :: number |
|---|
| 237 | |
|---|
| 238 | getpdsindex=-1 |
|---|
| 239 | |
|---|
| 240 | do j=1,MAXTEMP |
|---|
| 241 | if (number.eq.templates(j)%template_num) then |
|---|
| 242 | getpdsindex=j |
|---|
| 243 | return |
|---|
| 244 | endif |
|---|
| 245 | enddo |
|---|
| 246 | |
|---|
| 247 | end function |
|---|
| 248 | |
|---|
| 249 | |
|---|
| 250 | |
|---|
| 251 | |
|---|
| 252 | subroutine getpdstemplate(number,nummap,map,needext,iret) |
|---|
| 253 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 254 | ! . . . . |
|---|
| 255 | ! SUBPROGRAM: getpdstemplate |
|---|
| 256 | ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11 |
|---|
| 257 | ! |
|---|
| 258 | ! ABSTRACT: This subroutine returns PDS template information for a |
|---|
| 259 | ! specified Product Definition Template 4.NN. |
|---|
| 260 | ! The number of entries in the template is returned along with a map |
|---|
| 261 | ! of the number of octets occupied by each entry. Also, a flag is |
|---|
| 262 | ! returned to indicate whether the template would need to be extended. |
|---|
| 263 | ! |
|---|
| 264 | ! PROGRAM HISTORY LOG: |
|---|
| 265 | ! 2000-05-11 Gilbert |
|---|
| 266 | ! |
|---|
| 267 | ! USAGE: CALL getpdstemplate(number,nummap,map,needext,iret) |
|---|
| 268 | ! INPUT ARGUMENT LIST: |
|---|
| 269 | ! number - NN, indicating the number of the Product Definition |
|---|
| 270 | ! Template 4.NN that is being requested. |
|---|
| 271 | ! |
|---|
| 272 | ! OUTPUT ARGUMENT LIST: |
|---|
| 273 | ! nummap - Number of entries in the Template |
|---|
| 274 | ! map() - An array containing the number of octets that each |
|---|
| 275 | ! template entry occupies when packed up into the PDS. |
|---|
| 276 | ! needext - Logical variable indicating whether the Product Defintion |
|---|
| 277 | ! Template has to be extended. |
|---|
| 278 | ! ierr - Error return code. |
|---|
| 279 | ! 0 = no error |
|---|
| 280 | ! 1 = Undefine Product Template number. |
|---|
| 281 | ! |
|---|
| 282 | ! REMARKS: None |
|---|
| 283 | ! |
|---|
| 284 | ! ATTRIBUTES: |
|---|
| 285 | ! LANGUAGE: Fortran 90 |
|---|
| 286 | ! MACHINE: IBM SP |
|---|
| 287 | ! |
|---|
| 288 | !$$$ |
|---|
| 289 | integer,intent(in) :: number |
|---|
| 290 | integer,intent(out) :: nummap,map(*),iret |
|---|
| 291 | logical,intent(out) :: needext |
|---|
| 292 | |
|---|
| 293 | iret=0 |
|---|
| 294 | |
|---|
| 295 | index=getpdsindex(number) |
|---|
| 296 | |
|---|
| 297 | if (index.ne.-1) then |
|---|
| 298 | nummap=templates(index)%mappdslen |
|---|
| 299 | needext=templates(index)%needext |
|---|
| 300 | map(1:nummap)=templates(index)%mappds(1:nummap) |
|---|
| 301 | else |
|---|
| 302 | nummap=0 |
|---|
| 303 | needext=.false. |
|---|
| 304 | print *,'getpdstemplate: PDS Template ',number, |
|---|
| 305 | & ' not defined.' |
|---|
| 306 | iret=1 |
|---|
| 307 | endif |
|---|
| 308 | |
|---|
| 309 | end subroutine |
|---|
| 310 | |
|---|
| 311 | subroutine extpdstemplate(number,list,nummap,map) |
|---|
| 312 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 313 | ! . . . . |
|---|
| 314 | ! SUBPROGRAM: extpdstemplate |
|---|
| 315 | ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11 |
|---|
| 316 | ! |
|---|
| 317 | ! ABSTRACT: This subroutine generates the remaining octet map for a |
|---|
| 318 | ! given Product Definition Template, if required. Some Templates can |
|---|
| 319 | ! vary depending on data values given in an earlier part of the |
|---|
| 320 | ! Template, and it is necessary to know some of the earlier entry |
|---|
| 321 | ! values to generate the full octet map of the Template. |
|---|
| 322 | ! |
|---|
| 323 | ! PROGRAM HISTORY LOG: |
|---|
| 324 | ! 2000-05-11 Gilbert |
|---|
| 325 | ! |
|---|
| 326 | ! USAGE: CALL extpdstemplate(number,list,nummap,map) |
|---|
| 327 | ! INPUT ARGUMENT LIST: |
|---|
| 328 | ! number - NN, indicating the number of the Product Definition |
|---|
| 329 | ! Template 4.NN that is being requested. |
|---|
| 330 | ! list() - The list of values for each entry in the |
|---|
| 331 | ! the Product Definition Template 4.NN. |
|---|
| 332 | ! |
|---|
| 333 | ! OUTPUT ARGUMENT LIST: |
|---|
| 334 | ! nummap - Number of entries in the Template |
|---|
| 335 | ! map() - An array containing the number of octets that each |
|---|
| 336 | ! template entry occupies when packed up into the GDS. |
|---|
| 337 | ! |
|---|
| 338 | ! ATTRIBUTES: |
|---|
| 339 | ! LANGUAGE: Fortran 90 |
|---|
| 340 | ! MACHINE: IBM SP |
|---|
| 341 | ! |
|---|
| 342 | !$$$ |
|---|
| 343 | integer,intent(in) :: number,list(*) |
|---|
| 344 | integer,intent(out) :: nummap,map(*) |
|---|
| 345 | |
|---|
| 346 | index=getpdsindex(number) |
|---|
| 347 | if (index.eq.-1) return |
|---|
| 348 | |
|---|
| 349 | if ( .not. templates(index)%needext ) return |
|---|
| 350 | nummap=templates(index)%mappdslen |
|---|
| 351 | map(1:nummap)=templates(index)%mappds(1:nummap) |
|---|
| 352 | |
|---|
| 353 | if ( number.eq.3 ) then |
|---|
| 354 | N=list(27) |
|---|
| 355 | do i=1,N |
|---|
| 356 | map(nummap+i)=1 |
|---|
| 357 | enddo |
|---|
| 358 | nummap=nummap+N |
|---|
| 359 | elseif ( number.eq.4 ) then |
|---|
| 360 | N=list(26) |
|---|
| 361 | do i=1,N |
|---|
| 362 | map(nummap+i)=1 |
|---|
| 363 | enddo |
|---|
| 364 | nummap=nummap+N |
|---|
| 365 | elseif ( number.eq.8 ) then |
|---|
| 366 | if ( list(22).gt.1 ) then |
|---|
| 367 | do j=2,list(22) |
|---|
| 368 | do k=1,6 |
|---|
| 369 | map(nummap+k)=map(23+k) |
|---|
| 370 | enddo |
|---|
| 371 | nummap=nummap+6 |
|---|
| 372 | enddo |
|---|
| 373 | endif |
|---|
| 374 | elseif ( number.eq.9 ) then |
|---|
| 375 | if ( list(29).gt.1 ) then |
|---|
| 376 | do j=2,list(29) |
|---|
| 377 | do k=1,6 |
|---|
| 378 | map(nummap+k)=map(30+k) |
|---|
| 379 | enddo |
|---|
| 380 | nummap=nummap+6 |
|---|
| 381 | enddo |
|---|
| 382 | endif |
|---|
| 383 | elseif ( number.eq.10 ) then |
|---|
| 384 | if ( list(23).gt.1 ) then |
|---|
| 385 | do j=2,list(23) |
|---|
| 386 | do k=1,6 |
|---|
| 387 | map(nummap+k)=map(24+k) |
|---|
| 388 | enddo |
|---|
| 389 | nummap=nummap+6 |
|---|
| 390 | enddo |
|---|
| 391 | endif |
|---|
| 392 | elseif ( number.eq.11 ) then |
|---|
| 393 | if ( list(25).gt.1 ) then |
|---|
| 394 | do j=2,list(25) |
|---|
| 395 | do k=1,6 |
|---|
| 396 | map(nummap+k)=map(26+k) |
|---|
| 397 | enddo |
|---|
| 398 | nummap=nummap+6 |
|---|
| 399 | enddo |
|---|
| 400 | endif |
|---|
| 401 | elseif ( number.eq.12 ) then |
|---|
| 402 | if ( list(24).gt.1 ) then |
|---|
| 403 | do j=2,list(24) |
|---|
| 404 | do k=1,6 |
|---|
| 405 | map(nummap+k)=map(25+k) |
|---|
| 406 | enddo |
|---|
| 407 | nummap=nummap+6 |
|---|
| 408 | enddo |
|---|
| 409 | endif |
|---|
| 410 | elseif ( number.eq.13 ) then |
|---|
| 411 | if ( list(38).gt.1 ) then |
|---|
| 412 | do j=2,list(38) |
|---|
| 413 | do k=1,6 |
|---|
| 414 | map(nummap+k)=map(39+k) |
|---|
| 415 | enddo |
|---|
| 416 | nummap=nummap+6 |
|---|
| 417 | enddo |
|---|
| 418 | endif |
|---|
| 419 | N=list(27) |
|---|
| 420 | do i=1,N |
|---|
| 421 | map(nummap+i)=1 |
|---|
| 422 | enddo |
|---|
| 423 | nummap=nummap+N |
|---|
| 424 | elseif ( number.eq.14 ) then |
|---|
| 425 | if ( list(37).gt.1 ) then |
|---|
| 426 | do j=2,list(37) |
|---|
| 427 | do k=1,6 |
|---|
| 428 | map(nummap+k)=map(38+k) |
|---|
| 429 | enddo |
|---|
| 430 | nummap=nummap+6 |
|---|
| 431 | enddo |
|---|
| 432 | endif |
|---|
| 433 | N=list(26) |
|---|
| 434 | do i=1,N |
|---|
| 435 | map(nummap+i)=1 |
|---|
| 436 | enddo |
|---|
| 437 | nummap=nummap+N |
|---|
| 438 | elseif ( number.eq.30 ) then |
|---|
| 439 | do j=1,list(5) |
|---|
| 440 | map(nummap+1)=2 |
|---|
| 441 | map(nummap+2)=2 |
|---|
| 442 | map(nummap+3)=1 |
|---|
| 443 | map(nummap+4)=1 |
|---|
| 444 | map(nummap+5)=4 |
|---|
| 445 | nummap=nummap+5 |
|---|
| 446 | enddo |
|---|
| 447 | endif |
|---|
| 448 | |
|---|
| 449 | end subroutine |
|---|
| 450 | |
|---|
| 451 | integer function getpdtlen(number) |
|---|
| 452 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 453 | ! . . . . |
|---|
| 454 | ! SUBPROGRAM: getpdtlen |
|---|
| 455 | ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-05-11 |
|---|
| 456 | ! |
|---|
| 457 | ! ABSTRACT: This function returns the initial length (number of entries) in |
|---|
| 458 | ! the "static" part of specified Product Definition Template 4.number. |
|---|
| 459 | ! |
|---|
| 460 | ! PROGRAM HISTORY LOG: |
|---|
| 461 | ! 2004-05-11 Gilbert |
|---|
| 462 | ! |
|---|
| 463 | ! USAGE: CALL getpdtlen(number) |
|---|
| 464 | ! INPUT ARGUMENT LIST: |
|---|
| 465 | ! number - NN, indicating the number of the Product Definition |
|---|
| 466 | ! Template 4.NN that is being requested. |
|---|
| 467 | ! |
|---|
| 468 | ! RETURNS: Number of entries in the "static" part of PDT 4.number |
|---|
| 469 | ! OR returns 0, if requested template is not found. |
|---|
| 470 | ! |
|---|
| 471 | ! REMARKS: If user needs the full length of a specific template that |
|---|
| 472 | ! contains additional entries based on values set in the "static" part |
|---|
| 473 | ! of the PDT, subroutine extpdstemplate can be used. |
|---|
| 474 | ! |
|---|
| 475 | ! ATTRIBUTES: |
|---|
| 476 | ! LANGUAGE: Fortran 90 |
|---|
| 477 | ! MACHINE: IBM SP |
|---|
| 478 | ! |
|---|
| 479 | !$$$ |
|---|
| 480 | integer,intent(in) :: number |
|---|
| 481 | |
|---|
| 482 | getpdtlen=0 |
|---|
| 483 | |
|---|
| 484 | index=getpdsindex(number) |
|---|
| 485 | |
|---|
| 486 | if (index.ne.-1) then |
|---|
| 487 | getpdtlen=templates(index)%mappdslen |
|---|
| 488 | endif |
|---|
| 489 | |
|---|
| 490 | end function |
|---|
| 491 | |
|---|
| 492 | |
|---|
| 493 | end module |
|---|
| 494 | |
|---|
