diff --git a/src/pdstemplates.F90 b/src/pdstemplates.F90 index a595f86f..2b8218fb 100644 --- a/src/pdstemplates.F90 +++ b/src/pdstemplates.F90 @@ -39,7 +39,7 @@ module pdstemplates integer, parameter :: MAXLEN = 200 !< MAXLEN max length of entries - integer, parameter :: MAXTEMP = 44 !< MAXTEMP maximum number of templates + integer, parameter :: MAXTEMP = 48 !< MAXTEMP maximum number of templates !> This is the defined type for a Product Definition Section (PDS) !> template. @@ -350,6 +350,40 @@ module pdstemplates data (templates(44)%mappds(j), j = 1, 29) & ! Optical Properties of Aerosol /1, 1, 2, 1, -1, -4, -1, -4, 1, -1, -4, -1, -4, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, & 1, -1, -4, 1, 1, 1/ + ! + ! PDT 4.57 (10/07/2015) + ! + data templates(45)%template_num /57/ ! Analysis or Forecast at a horizontal level or in a + data templates(45)%mappdslen /7/ ! horizontal layer at a point in time for + data templates(45)%needext /.true./ ! atmospheric chemical constituents based on + data (templates(45)%mappds(j), j = 1, 7) & ! a distribution function. + /1, 1, 2, 2, 2, 2, 1/ + ! + ! PDT 4.60 (10/07/2015) + ! + data templates(46)%template_num /60/ ! Individual ensemble reforecast, control and perturbed, + data templates(46)%mappdslen /24/ ! at a horizontal level or in a horizontal layer + data templates(46)%needext /.false./ ! at a point in time. + data (templates(46)%mappds(j), j = 1, 24) & + /1, 1, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4, 1, 1, 1, 2, 1, 1, 1, 1, 1/ + ! + ! PDT 4.61 (10/07/2015) + ! + data templates(47)%template_num /61/ ! Individual ensemble reforecast, control and perturbed, + data templates(47)%mappdslen /38/ ! at a horizontal level or in a horizontal layer + data templates(47)%needext /.true./ ! in a continuous or non-continuous time interval. + data (templates(47)%mappds(j), j = 1, 38) & + /1, 1, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4, 1, 1, 1, 2, 1, 1, 1, 1, & + 1, 2, 1, 1, 1, 1, 1, 1, 4, 1, 1, 1, 4, 1, 4/ + ! + ! VALIDATION --- PDT 4.35 (10/07/2015) + ! + data templates(48)%template_num /35/ ! Satellite product with or without associated + data templates(48)%mappdslen /6/ ! quality values + data templates(48)%needext /.true./ + data (templates(48)%mappds(j), j = 1, 6) & + /1, 1, 1, 1, 1, 1/ + contains !> This function returns the index of specified Product @@ -582,6 +616,15 @@ subroutine extpdstemplate(number, list, nummap, map) map(nummap + i) = 1 enddo nummap = nummap + N + elseif (number .eq. 35) then + do j = 1, list(6) + map(nummap + 1) = 2 + map(nummap + 2) = 2 + map(nummap + 3) = 2 + map(nummap + 4) = 1 + map(nummap + 5) = 4 + nummap = nummap + 5 + enddo elseif (number .eq. 42) then if (list(23).gt.1) then do j = 2, list(23) @@ -640,6 +683,34 @@ subroutine extpdstemplate(number, list, nummap, map) map(nummap + i) = 1 enddo nummap = nummap + N + elseif (number .eq. 57) then + do j = 1, list(7) + map(nummap + 1) = 1 + map(nummap + 2) = -4 + map(nummap + 3) = 1 + map(nummap + 4) = 1 + map(nummap + 5) = 1 + map(nummap + 6) = 2 + map(nummap + 7) = 1 + map(nummap + 8) = 1 + map(nummap + 9) = -4 + map(nummap + 10) = 1 + map(nummap + 11) = -1 + map(nummap + 12) = -4 + map(nummap + 13) = 1 + map(nummap + 14) = -1 + map(nummap + 15) = -4 + nummap = nummap + 15 + enddo + elseif (number .eq. 61) then + if (list(31) .gt. 1) then + do j = 2, list(31) + do k = 1, 6 + map(nummap + k) = map(32 +k) + end do + nummap = nummap + 6 + enddo + endif elseif (number .eq. 91) then if (list(29).gt.1 ) then do j = 2, list(29) diff --git a/tests/test_pdstemplates.F90 b/tests/test_pdstemplates.F90 index 1e1c6e2a..ddda287b 100644 --- a/tests/test_pdstemplates.F90 +++ b/tests/test_pdstemplates.F90 @@ -14,10 +14,11 @@ program test_pdstemplates integer :: pdtlen integer, dimension(MAXLEN) :: map, list, exp_map0, exp_map3, exp_map4, exp_map8, exp_map9, exp_map10, & exp_map11, exp_map12, exp_map13, exp_map14, exp_map30, exp_map31, exp_map32, exp_map33, exp_map34, & - exp_map42, exp_map43, exp_map46, exp_map47, exp_map51, exp_map53, exp_map54, exp_map91, exp_extmap3, & - exp_extmap4, exp_extmap8, exp_extmap9, exp_extmap10, exp_extmap11, exp_extmap12, exp_extmap13, & - exp_extmap14, exp_extmap30, exp_extmap31, exp_extmap32, exp_extmap33, exp_extmap34, exp_extmap42, & - exp_extmap43, exp_extmap46, exp_extmap47, exp_extmap51, exp_extmap53, exp_extmap54, exp_extmap91 + exp_map35,exp_map42, exp_map43, exp_map46, exp_map47, exp_map51, exp_map53, exp_map54, exp_map57, & + exp_map61, exp_map91, exp_extmap3, exp_extmap4, exp_extmap8, exp_extmap9, exp_extmap10, exp_extmap11, & + exp_extmap12, exp_extmap13, exp_extmap14, exp_extmap30, exp_extmap31, exp_extmap32, exp_extmap33, & + exp_extmap34, exp_extmap35, exp_extmap42, exp_extmap43, exp_extmap46, exp_extmap47, exp_extmap51, & + exp_extmap53, exp_extmap54, exp_extmap57, exp_extmap61, exp_extmap91 print *, 'Testing pdstemplates, expect and ignore error messages...' @@ -135,6 +136,16 @@ program test_pdstemplates if (pdtlen .ne. 36) stop 61 exp_map91(1:pdtlen) = (/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, 1, 4, 1, 1, 1, 4, 1, 4/) + pdtlen = getpdtlen(57) + if (pdtlen .ne. 7) stop 62 + exp_map57(1:pdtlen) = (/1, 1, 2, 2, 2, 2, 1/) + pdtlen = getpdtlen(61) + if (pdtlen .ne. 38) stop 63 + exp_map61(1:pdtlen) = (/1, 1, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4, 1, 1, 1, 2, 1, 1, 1, 1, & + 1, 2, 1, 1, 1, 1, 1, 1, 4, 1, 1, 1, 4, 1, 4/) + pdtlen = getpdtlen(35) + if (pdtlen .ne. 6) stop 64 + exp_map35(1:pdtlen) = (/1,1,1,1,1,1/) ! Setting expexted extended maps exp_extmap3(1:32) = (/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, 1, -1, 4, -1, & @@ -174,6 +185,10 @@ program test_pdstemplates exp_extmap54(1:23) = (/1, 1, 1, 1, 4, 2, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4, 1, 1, 1, 1/) exp_extmap91(1:43) = (/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, 1, 4, & 1, 1, 1, 4, 1, 4, 1, 1, 1, 4, 1, 4, 1/) + exp_extmap57(1:22) = (/1, 1, 2, 2, 2, 2, 1, 1, -4, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4/) + exp_extmap61(1:44) = (/1, 1, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4, 1, 1, 1, 2, 1, 1, 1, 1, & + 1, 2, 1, 1, 1, 1, 1, 1, 4, 1, 1, 1, 4, 1, 4, 1, 1, 1, 4, 1, 4/) + exp_extmap35(1:11) = (/1,1,1,1,1,1,2,2,2,1,4/) print *, 'Testing extpdstemplate with index = -1' ! -- returns without doing anything @@ -442,5 +457,40 @@ program test_pdstemplates do i = 1, nummap if (map(i) .ne. exp_extmap91(i)) stop 143 end do + ! Template number 57 + call getpdstemplate(57, nummap, list, needext, iret) + if (iret .ne. 0 .or. nummap .ne. 7 .or. .not. needext) stop 36 + do i = 1, nummap + if (list(i) .ne. exp_map57(i)) stop 83 + end do + call extpdstemplate(57, list, nummap, map) + if (nummap .ne. 22) stop 144 + do i = 1, nummap + if (map(i) .ne. exp_extmap57(i)) stop 145 + end do + ! Template number 61 + call getpdstemplate(61, nummap, list, needext, iret) + if (iret .ne. 0 .or. nummap .ne. 38 .or. .not. needext) stop 37 + do i = 1, nummap + if (list(i) .ne. exp_map61(i)) stop 84 + end do + list(31) = 2 + call extpdstemplate(61, list, nummap, map) + if (nummap .ne. 44) stop 146 + do i = 1, nummap + if (map(i) .ne. exp_extmap61(i)) stop 147 + end do + ! Template number 35 + call getpdstemplate(35, nummap, list, needext, iret) + if (iret .ne. 0 .or. nummap .ne. 6 .or. .not. needext) stop 38 + do i = 1, nummap + if (list(i) .ne. exp_map35(i)) stop 85 + end do + call extpdstemplate(35, list, nummap, map) + if (nummap .ne. 11) stop 148 + do i = 1, nummap + if (map(i) .ne. exp_extmap35(i)) stop 149 + end do + print *, 'SUCCESS' end program test_pdstemplates diff --git a/tests/test_pdstemplates_2.F90 b/tests/test_pdstemplates_2.F90 index 087ab4b3..6857ccef 100644 --- a/tests/test_pdstemplates_2.F90 +++ b/tests/test_pdstemplates_2.F90 @@ -73,6 +73,12 @@ program test_pdstemplates 1, 4, 1, 1, 1, 4, 1, 4 /) integer, dimension(19) :: expected_map_53 = (/ 1, 1, 1, 1, 4, 2, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4 /) integer, dimension(22) :: expected_map_54 = (/ 1, 1, 1, 1, 4, 2, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4, 1, 1, 1 /) + integer, dimension(7) :: expected_map_57 = (/ 1, 1, 2, 2, 2, 2, 1 /) + integer, dimension(24) :: expected_map_60 = (/ 1, 1, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4, 1, 1, 1, 2, 1, 1, 1, 1, 1 /) + integer, dimension(38) :: expected_map_61 = (/ 1, 1, 1, 1, 1, 2, 1, 1, -4, 1, -1, -4, 1, -1, -4, 1, 1, 1, 2, 1, 1, 1, 1, & + 1, 2, 1, 1, 1, 1, 1, 1, 4, 1, 1, 1, 4, 1, 4 /) + integer, dimension(6) :: expected_map_35 = (/ 1, 1, 1, 1, 1, 1 /) + logical :: needext integer :: m integer :: iret @@ -344,5 +350,29 @@ program test_pdstemplates if (map(m) .ne. expected_map_54(m)) stop 100 end do + call getpdstemplate(57, nummap, map, needext, iret) + if (iret .ne. 0 .or. nummap .ne. 7 .or. .not. needext) stop 99 + do m = 1, nummap + if (map(m) .ne. expected_map_57(m)) stop 100 + end do + + call getpdstemplate(60, nummap, map, needext, iret) + if (iret .ne. 0 .or. nummap .ne. 24 .or. needext) stop 99 + do m = 1, nummap + if (map(m) .ne. expected_map_60(m)) stop 100 + end do + + call getpdstemplate(61, nummap, map, needext, iret) + if (iret .ne. 0 .or. nummap .ne. 38 .or. .not. needext) stop 99 + do m = 1, nummap + if (map(m) .ne. expected_map_61(m)) stop 100 + end do + + call getpdstemplate(35, nummap, map, needext, iret) + if (iret .ne. 0 .or. nummap .ne. 6 .or. .not. needext) stop 99 + do m = 1, nummap + if (map(m) .ne. expected_map_35(m)) stop 100 + end do + print *, 'SUCCESS' end program test_pdstemplates