! Adding kludges for JTech paper. -Ross ! In the analyses we are doing covDelx = covDely = 0 and a1=a2, b1=b2, o1=o2. ! Below I propose how to hack this for the current purpose. ! Add square of C_x for error bound estimation. ! Add VC-QC to sumABOaddOperator. ! This is not a final solution. ! !****************************************************************************** module covTypes !****************************************************************************** ! English Name: Covariance Types ! ------------- ! ! Purpose: Contains utilities for accumulating metrics for calculating ! -------- observation, background and analysis covariance from the VAM ! observational data sets. ! ! Language: Fortran 90 ! --------- ! ! Notes: ! ------ ! ! See Also: ! --------- ! ! Interface: Type Access Description ! ---------- Intent ! ! StatisticalSums derived PUB data structure containing statistical ! sum components. Key symbols for the ! definitions below are: ! ! a: VAM final analysis ! b: VAM background analysis ! o: VAM observation ! 1: location-1 ! 2: location-2 ! ! count integer * sample size ! a1b1o2b2 real * (a1 - b1) * (o2 - b2) ! o1a1o2b2 real * (o1 - a1) * (o2 - b2) ! a1b1o2a2 real * (a1 - b1) * (o2 - a2) ! a1b1o1b1 real * (a1 - b1) * (o1 - b1) ! a2b2o2b2 real * (a2 - b2) * (o2 - b2) ! o1a1o1b1 real * (o1 - a1) * (o1 - b1) ! o2a2o2b2 real * (o2 - a2) * (o2 - b2) ! a1b1o1a1 real * (a1 - b1) * (o1 - a1) ! a2b2o2a2 real * (a2 - b2) * (o2 - a2) ! a1 real * a1 ! b1 real * b1 ! o1 real * o1 ! a1a1 real * a1 * a1 ! b1b1 real * b1 * b1 ! o1o1 real * o1 * o1 ! o2a2 real * o2 - a2 ! o2b2 real * o2 - b2 ! Additional kludge sums ! a1b1o2b2sq real * [(a1 - b1) * (o2 - b2)]^2 ! o1a1o2b2sq real * [(o1 - a1) * (o2 - b2)]^2 ! a1b1o2a2sq real * [(a1 - b1) * (o2 - a2)]^2 ! ! AnaBkgObs derived PRIV collocations of analysis, background ! and observations at location 1 and 2. ! Key symbols for the definitions below ! are: ! ! a: VAM final analysis ! b: VAM background analysis ! o: VAM observation ! 1: location-1 ! 2: location-2 ! ! A1 real * a1 ! B1 real * b1 ! O1 real * o1 ! A1B1 real * a1 - b1 ! A2B2 real * a2 - b2 ! O1B1 real * o1 - b1 ! O2B2 real * o2 - b2 ! O1A1 real * o1 - a1 ! O2A2 real * o2 - a2 ! ! ! IMAP integer PRIV longitude dimension of bytemap grid. ! ! JMAP integer PRIV latitude dimension of bytemap grid. ! ! LONINC real PRIV longitude inc of bytemap grid (deg). ! ! LATINC real PRIV latitude inc of bytemap grid (deg). ! ! STLON real PRIV starting lon of bytemap grid(deg east) ! ! STLAT real PRIV starting lat of bytemap grid(deg north) ! ! Programmer: Joseph V. Ardizzone ! ----------- (NASA Goddard Space Flight Center) ! (Synoptic Evaluation Group) ! ! Modified: Date Author Description ! --------- ! 09/01/2011 J.Ardizzone created. !****************************************************************************** public integer, parameter :: IMAP = 1440 integer, parameter :: JMAP = 720 integer, parameter :: RECSIZE = IMAP * JMAP real, parameter :: LONINC = 0.25 real, parameter :: LATINC = 0.25 real, parameter :: STLAT = -89.875 real, parameter :: STLON = 0.125 type StatisticalSums integer :: count double precision :: a1b1o2b2 double precision :: o1a1o2b2 double precision :: a1b1o2a2 double precision :: a1b1o1b1 double precision :: a2b2o2b2 double precision :: o1a1o1b1 double precision :: o2a2o2b2 double precision :: a1b1o1a1 double precision :: a2b2o2a2 double precision :: a1 double precision :: b1 double precision :: o1 double precision :: a1a1 double precision :: b1b1 double precision :: o1o1 double precision :: o2a2 double precision :: o2b2 ! Additional kludge sums added for accumulating squares of C_x double precision :: a1b1o2b2sq double precision :: o1a1o2b2sq double precision :: a1b1o2a2sq end type StatisticalSums type AnaBkgObs real :: A1,B1,O1 real :: A1B1,A2B2,O1B1,O2B2,O1A1,O2A2 end type AnaBkgObs interface operator (+) module procedure sumAddOperator module procedure sumArrayAddOperator module procedure sumABOaddOperator end interface interface assignment (=) module procedure sumAssignOperator module procedure sumArrayAssignOperator end interface type (AnaBkgObs) :: abo contains !****************************************************************************** function sumABOaddOperator(sums,abo) result(sumnew) !****************************************************************************** ! English Name: Update Statistical Sums ! ------------- ! ! Purpose: Adds new collocated information to each member of a StatisticalSums ! -------- data structure. ! ! Language: Fortran 90 ! --------- ! ! Notes: ! ------ ! ! Interface: Type Access Description ! ---------- Intent ! ! sums StatisticalSums INOUT statistical sums to be updated. ! ! (see module prolog for a description of collocated information to be added) ! ! Programmer: Joseph V. Ardizzone ! ----------- (NASA Goddard Space Flight Center) ! (Software Integration and Visualization Office - SIVO) ! ! Modified: Date Author Description ! --------- ! 09/22/2011 J.Ardizzone created. !****************************************************************************** type (StatisticalSums), intent(in) :: sums type (StatisticalSums) :: sumnew type (AnaBkgObs), intent(in) :: abo ! VC-QC parameter, logical :: VCQC=.TRUE. ! Turn this on or off here parameter, integer :: nSigma=6 parameter, real :: uB=1.3, uO=0.4, uA=0.075, sB=2, sO=0.9, sA=0.66 if (VCQC) then if ( (abo%A1B1 * abo%O2B2 - uB)/sB .GT. nSigma & .OR. (abo%O1A1 * abo%O2B2 - uO)/sO .GT. nSigma & .OR. (abo%A1B1 * abo%O2A2 - uA)/sA .GT. nSigma ) then sumnew = sums return endif endif ! end VC-QC sumnew%count = sums%count + 1 sumnew%a1b1o2b2 = sums%a1b1o2b2 + abo%A1B1 * abo%O2B2 sumnew%o1a1o2b2 = sums%o1a1o2b2 + abo%O1A1 * abo%O2B2 sumnew%a1b1o2a2 = sums%a1b1o2a2 + abo%A1B1 * abo%O2A2 sumnew%a1b1o1b1 = sums%a1b1o1b1 + abo%A1B1 * abo%O1B1 sumnew%a2b2o2b2 = sums%a2b2o2b2 + abo%A2B2 * abo%O2B2 sumnew%o1a1o1b1 = sums%o1a1o1b1 + abo%O1A1 * abo%O1B1 sumnew%o2a2o2b2 = sums%o2a2o2b2 + abo%O2A2 * abo%O2B2 sumnew%a1b1o1a1 = sums%a1b1o1a1 + abo%A1B1 * abo%O1A1 sumnew%a2b2o2a2 = sums%a2b2o2a2 + abo%A2B2 * abo%O2A2 sumnew%a1 = sums%a1 + abo%A1 sumnew%b1 = sums%b1 + abo%B1 sumnew%o1 = sums%o1 + abo%O1 sumnew%a1a1 = sums%a1a1 + abo%A1 * abo%A1 sumnew%b1b1 = sums%b1b1 + abo%B1 * abo%B1 sumnew%o1o1 = sums%o1o1 + abo%O1 * abo%O1 sumnew%o2a2 = sums%o2a2 + abo%O2A2 sumnew%o2b2 = sums%o2b2 + abo%O2B2 ! Additional kludge sums sumnew%a1b1o2b2sq = sums%a1b1o2b2sq + abo%A1B1 * abo%O2B2 * abo%A1B1 * abo%O2B2 sumnew%o1a1o2b2sq = sums%o1a1o2b2sq + abo%O1A1 * abo%O2B2 * abo%O1A1 * abo%O2B2 sumnew%a1b1o2a2sq = sums%a1b1o2a2sq + abo%A1B1 * abo%O2A2 * abo%A1B1 * abo%O2A2 end function sumABOaddOperator !****************************************************************************** function sumAddOperator(sum1,sum2) result (sum3) !****************************************************************************** ! English Name: Addition Operator for Scalar Statistical Summing ! ------------- ! ! Purpose: Executes addition operations on each member of a StatisticalSums ! -------- data structure. ! ! Language: Fortran 90 ! --------- ! ! Notes: ! ------ ! ! Interface: Type Access Description ! ---------- Intent ! ! sum1 StatisticalSums IN Operand-1 ! ! sum2 StatisticalSums IN Operand-2 ! ! sum3 StatisticalSums OUT Addition of operands. ! ! ! Programmer: Joseph V. Ardizzone ! ----------- (NASA Goddard Space Flight Center) ! (Software Integration and Visualization Office - SIVO) ! ! Modified: Date Author Description ! --------- ! 09/22/2011 J.Ardizzone created. !****************************************************************************** implicit none type (StatisticalSums), intent(in) :: sum1 type (StatisticalSums), intent(in) :: sum2 type (StatisticalSums) :: sum3 sum3%count = sum1%count + sum2%count sum3%a1b1o2b2 = sum1%a1b1o2b2 + sum2%a1b1o2b2 sum3%o1a1o2b2 = sum1%o1a1o2b2 + sum2%o1a1o2b2 sum3%a1b1o2a2 = sum1%a1b1o2a2 + sum2%a1b1o2a2 sum3%a1b1o1b1 = sum1%a1b1o1b1 + sum2%a1b1o1b1 sum3%a2b2o2b2 = sum1%a2b2o2b2 + sum2%a2b2o2b2 sum3%o1a1o1b1 = sum1%o1a1o1b1 + sum2%o1a1o1b1 sum3%o2a2o2b2 = sum1%o2a2o2b2 + sum2%o2a2o2b2 sum3%a1b1o1a1 = sum1%a1b1o1a1 + sum2%a1b1o1a1 sum3%a2b2o2a2 = sum1%a2b2o2a2 + sum2%a2b2o2a2 sum3%a1 = sum1%a1 + sum2%a1 sum3%b1 = sum1%b1 + sum2%b1 sum3%o1 = sum1%o1 + sum2%o1 sum3%a1a1 = sum1%a1a1 + sum2%a1a1 sum3%b1b1 = sum1%b1b1 + sum2%b1b1 sum3%o1o1 = sum1%o1o1 + sum2%o1o1 sum3%o2a2 = sum1%o2a2 + sum2%o2a2 sum3%o2b2 = sum1%o2b2 + sum2%o2b2 ! Additional kludge sums sum3%a1b1o2b2sq = sum1%a1b1o2b2sq + sum2%a1b1o2b2sq sum3%o1a1o2b2sq = sum1%o1a1o2b2sq + sum2%o1a1o2b2sq sum3%a1b1o2a2sq = sum1%a1b1o2a2sq + sum2%a1b1o2a2sq end function sumAddOperator !****************************************************************************** function sumArrayAddOperator(sum1,sum2) result (sum3) !****************************************************************************** ! English Name: Addition Operator for Array Statistical Summing ! ------------- ! ! Purpose: Executes addition operations on each element of an array of ! -------- a StatisticalSums data structure. ! ! Language: Fortran 90 ! --------- ! ! Notes: ! ------ ! ! Interface: Type Access Description ! ---------- Intent ! ! sum1(:,:) StatisticalSums IN Operand-1 ! ! sum2(:,:) StatisticalSums IN Operand-2 ! ! sum3(:,:) StatisticalSums OUT Addition of operands. ! ! ! Programmer: Joseph V. Ardizzone ! ----------- (NASA Goddard Space Flight Center) ! (Software Integration and Visualization Office - SIVO) ! ! Modified: Date Author Description ! --------- ! 09/22/2011 J.Ardizzone created. !****************************************************************************** implicit none type (StatisticalSums), dimension(IMAP,JMAP), intent(in) :: sum1 type (StatisticalSums), dimension(IMAP,JMAP), intent(in) :: sum2 type (StatisticalSums), dimension(IMAP,JMAP) :: sum3 integer :: i,j do j = 1,JMAP do i = 1,IMAP sum3(i,j) = sum1(i,j) + sum2(i,j) end do end do end function sumArrayAddOperator !****************************************************************************** subroutine sumAssignOperator(sums,value) !****************************************************************************** ! English Name: Initialize Sums ! ------------- ! ! Purpose: Initializes covariance sums for a single instantiation of the ! -------- derived covariance data type. ! ! Language: Fortran 90 ! --------- ! ! Notes: ! ------ ! ! Interface: Type Access Description ! ---------- Intent ! ! sums(:,:) StatisticalSums OUT Statistical sums data structure ! initialized to zero. ! ! Programmer: Joseph V. Ardizzone ! ----------- (NASA Goddard Space Flight Center) ! (Software Integration and Visualization Office - SIVO) ! ! Modified: Date Author Description ! --------- ! 08/30/2011 J.Ardizzone created. !****************************************************************************** implicit none type (StatisticalSums), intent(out) :: sums real, intent(in) :: value sums%count = 0 sums%a1b1o2b2 = value sums%o1a1o2b2 = value sums%a1b1o2a2 = value sums%a1b1o1b1 = value sums%a2b2o2b2 = value sums%o1a1o1b1 = value sums%o2a2o2b2 = value sums%a1b1o1a1 = value sums%a2b2o2a2 = value sums%a1 = value sums%b1 = value sums%o1 = value sums%a1a1 = value sums%b1b1 = value sums%o1o1 = value sums%o2a2 = value sums%o2b2 = value ! Additional kludge sums sums%a1b1o2b2sq = value sums%o1a1o2b2sq = value sums%a1b1o2a2sq = value end subroutine sumAssignOperator !****************************************************************************** subroutine sumArrayAssignOperator(sums,value) !****************************************************************************** ! English Name: Initialize Sums ! ------------- ! ! Purpose: Initializes covariance sums for a single instantiation of the ! -------- derived covariance data type. ! ! Language: Fortran 90 ! --------- ! ! Notes: ! ------ ! ! Interface: Type Access Description ! ---------- Intent ! ! sums(:,:) StatisticalSums OUT Statistical sums data structure ! initialized to zero. ! ! Programmer: Joseph V. Ardizzone ! ----------- (NASA Goddard Space Flight Center) ! (Software Integration and Visualization Office - SIVO) ! ! Modified: Date Author Description ! --------- ! 08/30/2011 J.Ardizzone created. !****************************************************************************** implicit none type (StatisticalSums), dimension(IMAP,JMAP), intent(out) :: sums real, intent(in) :: value integer :: i,j do j = 1,JMAP do i = 1,IMAP sums(i,j) = value end do end do end subroutine sumArrayAssignOperator end module covTypes