* PACKAGE IAVRG !" ヒストリー 空間平均 * *" [HIS] 90/11/02(numaguti) Original *" 93/05/27(takepiro) bug fix * ************************************************************************ SUBROUTINE XAVR !" 東西平均 I ( GDATA , HCORD , O GDATAO, IMAXD , JMAXD , KMAXD ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数，波数 #else #include "zcdim.F" !" 格子点数，波数 #endif * * [INPUT] REAL GDATA ( IDIM, JDIM, * ) CHARACTER HCORD *(*) * * [OUTPUT] REAL GDATAO( IDIM, JDIM, * ) INTEGER IMAXD, JMAXD, KMAXD * * [INTERNAL WORK] REAL DLON ( IMAX ) !" 第1軸Δ REAL DLAT ( JMAX ) !" 第2軸Δ REAL DSIG ( KMAX+1 ) !" 第3軸Δ * INTEGER I, J, K, KLEVS REAL TLON * CALL HQCORD I ( HCORD , O DLON , DLAT , DSIG , O KLEVS ) * IMAXD = 1 JMAXD = JMAX KMAXD = KLEVS * CALL RESET ( GDATAO, IDIM*JDIM*KLEVS ) TLON = 0. * DO 1100 I = 1, IMAX DO 1110 K = 1, KLEVS DO 1110 J = 1, JDIM GDATAO( 1,J,K ) = GDATAO( 1,J,K ) & + GDATA ( I,J,K ) * DLON( I ) 1110 CONTINUE TLON = TLON + DLON( I ) 1100 CONTINUE * DO 1200 K = 1, KLEVS DO 1200 J = 1, JDIM GDATAO( 1,J,K ) = GDATAO( 1,J,K ) / TLON 1200 CONTINUE * RETURN END ************************************************************************ SUBROUTINE ZAVR !" 鉛直平均 I ( GDATA , HCORD , O GDATAO, IMAXD , JMAXD , KMAXD ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数，波数 #else #include "zcdim.F" !" 格子点数，波数 #endif * [INPUT] REAL GDATA ( IDIM, JDIM, * ) CHARACTER HCORD *(*) * * [OUTPUT] REAL GDATAO( IDIM, JDIM, * ) INTEGER IMAXD, JMAXD, KMAXD * * [INTERNAL WORK] REAL DLON ( IMAX ) !" 第1軸Δ REAL DLAT ( JMAX ) !" 第2軸Δ REAL DSIG ( KMAX+1 ) !" 第3軸Δ * INTEGER I, J, K, KLEVS REAL TSIG * CALL HQCORD I ( HCORD , O DLON , DLAT , DSIG , O KLEVS ) * IMAXD = IMAX JMAXD = JMAX KMAXD = 1 * IF ( KLEVS .EQ. 1 ) THEN CALL COPY ( GDATAO, GDATA, IDIM*JDIM ) RETURN ENDIF * CALL RESET ( GDATAO, IDIM*JDIM ) TSIG = 0. * DO 1100 K = 1, KLEVS DO 1110 I = 1, IDIM DO 1110 J = 1, JDIM GDATAO( I,J,1 ) = GDATAO( I,J,1 ) & + GDATA ( I,J,K ) * DSIG( K ) 1110 CONTINUE TSIG = TSIG + DSIG( K ) 1100 CONTINUE * DO 1200 I = 1, IDIM DO 1200 J = 1, JDIM GDATAO( I,J,1 ) = GDATAO( I,J,1 ) / TSIG 1200 CONTINUE * RETURN END ************************************************************************ SUBROUTINE XZAVR !" 東西鉛直平均 I ( GDATA , HCORD , O GDATAO, IMAXD , JMAXD , KMAXD ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数，波数 #else #include "zcdim.F" !" 格子点数，波数 #endif * * [INPUT] REAL GDATA ( IDIM, JDIM, * ) CHARACTER HCORD *(*) * * [OUTPUT] REAL GDATAO( IDIM, JDIM, * ) INTEGER IMAXD, JMAXD, KMAXD * * [INTERNAL WORK] REAL DLON ( IMAX ) !" 第1軸Δ REAL DLAT ( JMAX ) !" 第2軸Δ REAL DSIG ( KMAX+1 ) !" 第3軸Δ * INTEGER I, J, K, KLEVS REAL TSIG, SUMO, TLON * CALL HQCORD I ( HCORD , O DLON , DLAT , DSIG , O KLEVS ) * IMAXD = 1 JMAXD = JMAX KMAXD = 1 * CALL RESET ( GDATAO, IDIM*JDIM ) TSIG = 0. * DO 1100 K = 1, KLEVS DO 1110 J = 1, JMAX DO 1110 I = 1, IMAX GDATAO( I,J,1 ) = GDATAO( I,J,1 ) & + GDATA ( I,J,K ) * DSIG( K ) 1110 CONTINUE TSIG = TSIG + DSIG( K ) 1100 CONTINUE * DO 1200 J = 1, JMAX * SUMO = 0. TLON = 0. DO 1300 I = 1, JMAX SUMO = SUMO + GDATAO( I,J,1 ) * DLON( I ) TLON = TLON + DLON( I ) 1300 CONTINUE * GDATAO( 1,J,1 ) = SUMO / TLON / TSIG * 1200 CONTINUE * RETURN END ************************************************************************ SUBROUTINE XYAVR !" 東西南北平均 I ( GDATA , HCORD , O GDATAO, IMAXD , JMAXD , KMAXD ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数，波数 #else #include "zcdim.F" !" 格子点数，波数 #endif * * [INPUT] REAL GDATA ( IDIM, JDIM, * ) CHARACTER HCORD *(*) * * [OUTPUT] REAL GDATAO( IDIM, JDIM, * ) INTEGER IMAXD, JMAXD, KMAXD * * [INTERNAL WORK] REAL DLON ( IMAX ) !" 第1軸Δ REAL DLAT ( JMAX ) !" 第2軸Δ REAL DSIG ( KMAX+1 ) !" 第3軸Δ * INTEGER I, J, K, KLEVS REAL TLAT, SUMO, TLON * CALL HQCORD I ( HCORD , O DLON , DLAT , DSIG , O KLEVS ) * IMAXD = 1 JMAXD = 1 KMAXD = KLEVS * CALL RESET ( GDATAO, IDIM*JDIM*KLEVS ) * DO 1100 K = 1, KLEVS * TLAT = 0. DO 1200 J = 1, JMAX DO 1210 I = 1, IDIM GDATAO( I,1,K ) = GDATAO( I,1,K ) & + GDATA ( I,J,K ) * DLAT( J ) 1210 CONTINUE TLAT = TLAT + DLAT( J ) 1200 CONTINUE * SUMO = 0. TLON = 0. DO 1300 I = 1, IMAX SUMO = SUMO + GDATAO( I,1,K ) * DLON( I ) TLON = TLON + DLON( I ) 1300 CONTINUE * GDATAO( 1,1,K ) = SUMO / TLAT / TLON * 1100 CONTINUE * RETURN END ************************************************************************ SUBROUTINE XYZAVR !" 東西南北鉛直平均 I ( GDATA , HCORD , O GDATAO, IMAXD , JMAXD , KMAXD ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数，波数 #else #include "zcdim.F" !" 格子点数，波数 #endif * * [INPUT] REAL GDATA ( IDIM, JDIM, * ) CHARACTER HCORD *(*) * * [OUTPUT] REAL GDATAO( IDIM, JDIM, * ) INTEGER IMAXD, JMAXD, KMAXD * * [INTERNAL WORK] REAL DLON ( IMAX ) !" 第1軸Δ REAL DLAT ( JMAX ) !" 第2軸Δ REAL DSIG ( KMAX+1 ) !" 第3軸Δ * INTEGER I, J, K, KLEVS REAL TLAT, TLON, TSIG, SUMO, SUMS * CALL HQCORD I ( HCORD , O DLON , DLAT , DSIG , O KLEVS ) * IMAXD = 1 JMAXD = 1 KMAXD = 1 !" 93/05/27(takepiro) bug fix * CALL RESET ( GDATAO, IDIM*JDIM*KLEVS ) * DO 1100 K = 1, KLEVS * TLAT = 0. DO 1200 J = 1, JMAX DO 1210 I = 1, IDIM GDATAO( I,1,K ) = GDATAO( I,1,K ) & + GDATA ( I,J,K ) * DLAT( J ) 1210 CONTINUE TLAT = TLAT + DLAT( J ) 1200 CONTINUE * SUMO = 0. TLON = 0. DO 1300 I = 1, IMAX SUMO = SUMO + GDATAO( I,1,K ) * DLON( I ) TLON = TLON + DLON( I ) 1300 CONTINUE * GDATAO( 1,1,K ) = SUMO / TLAT / TLON * 1100 CONTINUE * SUMS = 0. TSIG = 0. DO 2100 K = 1, KLEVS SUMS = SUMS + GDATAO( 1,1,K ) * DSIG( K ) TSIG = TSIG + DSIG( K ) 2100 CONTINUE * GDATAO( 1,1,1 ) = SUMS / TSIG * RETURN END ************************************************************************ SUBROUTINE NOAVR !" 平均しない I ( GDATA , HCORD , O GDATAO, IMAXD , JMAXD , KMAXD ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数，波数 #else #include "zcdim.F" !" 格子点数，波数 #endif * * [INPUT] REAL GDATA ( IDIM, JDIM, * ) CHARACTER HCORD *(*) * * [OUTPUT] REAL GDATAO( IDIM, JDIM, * ) INTEGER IMAXD, JMAXD, KMAXD * * [INTERNAL WORK] INTEGER KLEVS * CALL HQCORL I ( HCORD , O KLEVS ) * IMAXD = IMAX JMAXD = JMAX KMAXD = KLEVS * CALL COPY ( GDATAO, GDATA, IDIM*JDIM*KLEVS ) * RETURN END