C @(#)statpl.for 17.1.1.1 (ES0-DMD) 01/25/02 17:14:44 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) C C This program is free software; you can redistribute it and/or C modify it under the terms of the GNU General Public License as C published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, C MA 02139, USA. C C Corresponding concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C PROGRAM STATPLOT C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.IDENT program STATPLOT Edwin Valentijn 881011 C Andris Lauberts 890721 C C.KEYWORDS table file, statistics C C.PURPOSE computes mean and sd of table file column given in p2 C AND DUMPS THAT IN TABLE WITH NAME T'P2' C text output in for007.dat -> T'p2'.dat C C.USAGE MIDAS application programme C execute as @@ STATPL P1 P2 P3 P4 C C.PARAMETERS C C P1 TABLE C*8 Input table C P2 I2COL I Column number .NE.NULL C TABLEO C*8 and name of output table C P3 SELECT C*50 Expression of logical select C P4 1: display statistics C C.COMMENTS Intended for statistics on ESOLV (PCAT) catalogue C using Type = column #7 as reference C C---------------------------------------------------------------------- IMPLICIT INTEGER*4 (A-Z) REAL OUT1,MORPH,SD,SDMIN,SDPLUS,MEAN,NN,ITY REAL PCOUNT(16) REAL PTCOUNT2,PTCOUNT5,PTCOUNT11 REAL XITS(16),XITS2(16) INTEGER TID,TIDO INTEGER KNUL,KUN INTEGER*4 CITS(16) CHARACTER TABLE*8,TYPE1*6,TYPE2*6,FORM*6 CHARACTER TABLEO*60 CHARACTER*50 SELECT CHARACTER*16 LABEL(6),UNIT(6) LOGICAL NULL LOGICAL FLAG CHARACTER*6 TYPER,FMTR CHARACTER*6 FMTI C COMMON /VMR/MADRID(1) C DATA TYPER/'R*4'/ DATA FMTR/'F8.2'/ DATA FMTI/'I6'/ C C keywords CALL STSPRO ('STATPLOT') CALL STKRDC('P1',1,1,8,IAV,TABLE,KNUL,KUN,ISTAT) CALL STKRDC('IN_A',1,1,60,IAV,TABLEO,KNUL,KUN,ISTAT) CALL STKRDI('INPUTI',1,1,IAV,I2COL,KNUL,KUN,ISTAT) CALL STKRDC('P3',1,1,50,IAV,SELECT,KNUL,KUN,ISTAT) C C input table C CALL TBTOPN(TABLE,F_O_MODE,TID,ISTAT) CALL TBIGET(TID,NCOL,NROW,NSCI,ACOL,AROW,ISTAT) CALL TBFGET(TID,7,FORM,LEN,TYPE1,ISTAT) CALL TBFGET(TID,I2COL,FORM,LEN,TYPE2,ISTAT) CALL TBUGET(TID,I2COL,UNIT(3),ISTAT) CALL TBLGET(TID,I2COL,LABEL(3),ISTAT) C DO I = 1,16,1 CITS(I) = 0 XITS(I) = 0. XITS2(I)= 0. ENDDO C C output table C LABEL(1) = 'TYPE' LABEL(2) = 'COUNT' C LABEL(3) = 'MEAN' LABEL(4) = 'SD' LABEL(5) = 'MINSD' LABEL(6) = 'PLUSSD' UNIT(1) = ' ' C CALL TBTINI(TABLEO,0,F_O_MODE,6,16,TIDO,STATUS) CALL TBCINI(TIDO,TYPER,1,FMTI,UNIT(1),LABEL(1),IC,STATUS) CALL TBCINI(TIDO,TYPER,1,FMTI,UNIT(1),LABEL(2),IC,STATUS) CALL TBCINI(TIDO,TYPER,1,FMTR,UNIT(3),LABEL(3),IC,STATUS) DO I=4,6,1 CALL TBCINI(TIDO,TYPER,1,FMTR,UNIT(1),LABEL(I),IC,STATUS) ENDDO c enter the big loop DO IROW = 1,NROW,1 CALL TBSGET(TID,IROW,FLAG,ISTAT) IF (FLAG) THEN CALL TBEGET(TID,TYPE1,IROW,7,MORPH,NULL,ISTAT) CALL TBEGET(TID,TYPE2,IROW,I2COL,OUT1,NULL,ISTAT) IF (.NOT.NULL.AND.MORPH.LT.-4.5) THEN N = 1 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.-3.5.AND.MORPH.GE.-4.5) THEN N = 2 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.-2.5.AND.MORPH.GE.-3.5) THEN N = 3 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.-1.5.AND.MORPH.GE.-2.5) THEN N = 4 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.-0.5.AND.MORPH.GE.-1.5) THEN N = 5 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.0.5.AND.MORPH.GE.-0.5) THEN N = 6 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.1.5.AND.MORPH.GE.0.5) THEN N = 7 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.2.5.AND.MORPH.GE.1.5) THEN N = 8 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.3.5.AND.MORPH.GE.2.5) THEN N = 9 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.4.5.AND.MORPH.GE.3.5) THEN N = 10 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.5.5.AND.MORPH.GE.4.5) THEN N = 11 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.6.5.AND.MORPH.GE.5.5) THEN N = 12 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.7.5.AND.MORPH.GE.6.5) THEN N = 13 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.8.5.AND.MORPH.GE.7.5) THEN N = 14 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.9.5.AND.MORPH.GE.8.5) THEN N = 15 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF IF (.NOT.NULL.AND.MORPH.LT.11..AND.MORPH.GE.9.5) THEN N = 16 CITS(N) = CITS(N) + 1 XITS(N) = XITS(N) + OUT1 XITS2(N) = XITS2(N) + OUT1**2. GOTO 333 END IF ENDIF 333 ENDDO C COUNTTOT=0 DO I=1,16,1 COUNTTOT = CITS(I) +COUNTTOT ENDDO C TCOUNT5 = CITS(4)+CITS(5)+CITS(6) TCOUNT2 = CITS(1)+CITS(2)+CITS(3) TCOUNT11 = COUNTTOT - (TCOUNT5 + TCOUNT2) PTCOUNT11 = 100. * TCOUNT11/COUNTTOT PTCOUNT5 = 100. * TCOUNT5/COUNTTOT PTCOUNT2 = 100. * TCOUNT2/COUNTTOT C DO I=1,16,1 PCOUNT(I) = 100 .* CITS(I) / COUNTTOT ENDDO C C table output ITY and N are reals (tables do not want integers) C DO II = 1,16 ITY = II - 6. NN = CITS(II)+0. MEAN = XITS(II) / NN SD = (NN*XITS2(II)) - (XITS(II)**2.) SD = SQRT( SD /(NN*(NN-1) ) ) SDMIN = MEAN - SD SDPLUS= MEAN + SD CALL TBEPUT(TIDO,TYPER,II,1,ITY,ISTAT) CALL TBEPUT(TIDO,TYPER,II,2,NN,ISTAT) CALL TBEPUT(TIDO,TYPER,II,3,MEAN,ISTAT) CALL TBEPUT(TIDO,TYPER,II,4,SD,ISTAT) CALL TBEPUT(TIDO,TYPER,II,5,SDMIN,ISTAT) CALL TBEPUT(TIDO,TYPER,II,6,SDPLUS,ISTAT) ENDDO C close table CALL TBTCLO(TIDO,STATUS) C C print output C WRITE(7,999) COUNTTOT,I2COL WRITE(7,990) SELECT WRITE(7,801) CITS(1),PCOUNT(1) WRITE(7,802) CITS(2),PCOUNT(2),TCOUNT2,PTCOUNT2 WRITE(7,803) CITS(3),PCOUNT(3) WRITE(7,804) CITS(4),PCOUNT(4) WRITE(7,805) CITS(5),PCOUNT(5),TCOUNT5,PTCOUNT5 WRITE(7,806) CITS(6),PCOUNT(6) WRITE(7,807) CITS(7),PCOUNT(7) WRITE(7,808) CITS(8),PCOUNT(8) WRITE(7,809) CITS(9),PCOUNT(9) WRITE(7,810) CITS(10),PCOUNT(10) WRITE(7,811) CITS(11),PCOUNT(11),TCOUNT11,PTCOUNT11 WRITE(7,812) CITS(12),PCOUNT(12) WRITE(7,813) CITS(13),PCOUNT(13) WRITE(7,814) CITS(14),PCOUNT(14) WRITE(7,815) CITS(15),PCOUNT(15) WRITE(7,816) CITS(16),PCOUNT(16) C23456 999 FORMAT(' TOTAL COUNT: ',I8,10X,' SELECTION ON COLUMN:# ',I8) 990 FORMAT(16X,' LOGICAL SELECT ON:',A50) 801 FORMAT(' TYPE -5 : ',I8,F8.1) 802 FORMAT(' TYPE -4 : ',I8,F8.1,10X,' TOTAL -5,-4,-3 :',I8,F8.1) 803 FORMAT(' TYPE -3 : ',I8,F8.1) 804 FORMAT(' TYPE -2 : ',I8,F8.1) 805 FORMAT(' TYPE -1 : ',I8,F8.1,10X,' TOTAL -2,-1,0 :',I8,F8.1) 806 FORMAT(' TYPE 0 : ',I8,F8.1) 807 FORMAT(' TYPE 1 : ',I8,F8.1) 808 FORMAT(' TYPE 2 : ',I8,F8.1) 809 FORMAT(' TYPE 3 : ',I8,F8.1) 810 FORMAT(' TYPE 4 : ',I8,F8.1) 811 FORMAT(' TYPE 5 : ',I8,F8.1,10X,' TOTAL >0.5 :',I8,F8.1) 812 FORMAT(' TYPE 6 : ',I8,F8.1) 813 FORMAT(' TYPE 7 : ',I8,F8.1) 814 FORMAT(' TYPE 8 : ',I8,F8.1) 815 FORMAT(' TYPE 9 : ',I8,F8.1) 816 FORMAT(' TYPE 10 : ',I8,F8.1) C CALL STSEPI END