C @(#)replsubs.for 17.1.1.1 (ES0-DMD) 01/25/02 17:41:00 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 SUBROUTINE IREPLA(A,T,B,BB,C,IFCNT,OPER,NDIM,LOW,HI,NLIMIT,VAL) C IMPLICIT NONE C INTEGER NDIM,NLIMIT,IFCNT INTEGER N C REAL A(NDIM),T(NDIM),B(NDIM),BB(NDIM),C(NDIM) REAL LOW,HI,VAL(2) REAL ZVAL1,ZVAL2 C CHARACTER*(*) OPER C C first part only constant ZVAL1 = VAL(1) IF (NLIMIT.EQ.-1) GOTO 200 IF (NLIMIT.EQ.1) GOTO 400 C IF (OPER(2:2).EQ.' ') THEN !check if alternative... DO 100 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = A(N) ENDIF 100 CONTINUE ELSE ZVAL2 = VAL(2) C IF (OPER(2:2).EQ.'C') THEN DO 110 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = ZVAL2 ENDIF 110 CONTINUE C ELSE IF (OPER(2:2).EQ.'+') THEN DO 120 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) + ZVAL2 ENDIF 120 CONTINUE C ELSE IF (OPER(2:2).EQ.'-') THEN DO 130 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) - ZVAL2 ENDIF 130 CONTINUE C ELSE IF (OPER(2:2).EQ.'*') THEN DO 140 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 140 CONTINUE C ELSE IF (OPER(2:2).EQ.'/') THEN ZVAL2 = 1. / ZVAL2 DO 150 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 150 CONTINUE C ELSE DO 160 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) ENDIF 160 CONTINUE ENDIF ENDIF RETURN C C 200 IF (OPER(2:2).EQ.' ') THEN !check if alternative... DO 205 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = A(N) ENDIF 205 CONTINUE ELSE ZVAL2 = VAL(2) C IF (OPER(2:2).EQ.'C') THEN DO 210 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = ZVAL2 ENDIF 210 CONTINUE C ELSE IF (OPER(2:2).EQ.'+') THEN DO 220 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) + ZVAL2 ENDIF 220 CONTINUE C ELSE IF (OPER(2:2).EQ.'-') THEN DO 230 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) - ZVAL2 ENDIF 230 CONTINUE C ELSE IF (OPER(2:2).EQ.'*') THEN DO 240 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 240 CONTINUE C ELSE IF (OPER(2:2).EQ.'/') THEN ZVAL2 = 1. / ZVAL2 DO 250 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 250 CONTINUE C ELSE DO 260 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) ENDIF 260 CONTINUE ENDIF ENDIF RETURN C 400 IF (OPER(2:2).EQ.' ') THEN !check if alternative... DO 405 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = A(N) ENDIF 405 CONTINUE ELSE ZVAL2 = VAL(2) C IF (OPER(2:2).EQ.'C') THEN DO 410 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = ZVAL2 ENDIF 410 CONTINUE C ELSE IF (OPER(2:2).EQ.'+') THEN DO 420 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) + ZVAL2 ENDIF 420 CONTINUE C ELSE IF (OPER(2:2).EQ.'-') THEN DO 430 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) - ZVAL2 ENDIF 430 CONTINUE C ELSE IF (OPER(2:2).EQ.'*') THEN DO 440 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 440 CONTINUE C ELSE IF (OPER(2:2).EQ.'/') THEN ZVAL2 = 1. / ZVAL2 DO 450 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 450 CONTINUE C ELSE DO 460 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = ZVAL1 ELSE C(N) = BB(N) ENDIF 460 CONTINUE ENDIF C RETURN ENDIF C END SUBROUTINE IREPLB(A,T,B,BB,C,IFCNT,OPER,NDIM,LOW,HI,NLIMIT,VAL) C IMPLICIT NONE C INTEGER NDIM,NLIMIT,IFCNT INTEGER N C REAL A(NDIM),T(NDIM),B(NDIM),BB(NDIM),C(NDIM) REAL LOW,HI,VAL(2) REAL ZVAL1,ZVAL2 C CHARACTER*(*) OPER C C first part B(N) + VAL(1) ZVAL1 = VAL(1) IF (NLIMIT.EQ.-1) GOTO 200 IF (NLIMIT.EQ.1) GOTO 400 C IF (OPER(2:2).EQ.' ') THEN !check if alternative... DO 100 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN C(N) = B(N) + ZVAL1 IFCNT = IFCNT + 1 ELSE C(N) = A(N) ENDIF 100 CONTINUE ELSE ZVAL2 = VAL(2) C IF (OPER(2:2).EQ.'C') THEN DO 110 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = ZVAL2 ENDIF 110 CONTINUE C ELSE IF (OPER(2:2).EQ.'+') THEN DO 120 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) + ZVAL2 ENDIF 120 CONTINUE C ELSE IF (OPER(2:2).EQ.'-') THEN DO 130 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) - ZVAL2 ENDIF 130 CONTINUE C ELSE IF (OPER(2:2).EQ.'*') THEN DO 140 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 140 CONTINUE C ELSE IF (OPER(2:2).EQ.'/') THEN ZVAL2 = 1. / ZVAL2 DO 150 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 150 CONTINUE C ELSE DO 160 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) ENDIF 160 CONTINUE ENDIF ENDIF RETURN C C 200 IF (OPER(2:2).EQ.' ') THEN !check if alternative... DO 205 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = A(N) ENDIF 205 CONTINUE ELSE ZVAL2 = VAL(2) C IF (OPER(2:2).EQ.'C') THEN DO 210 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = ZVAL2 ENDIF 210 CONTINUE C ELSE IF (OPER(2:2).EQ.'+') THEN DO 220 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) + ZVAL2 ENDIF 220 CONTINUE C ELSE IF (OPER(2:2).EQ.'-') THEN DO 230 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) - ZVAL2 ENDIF 230 CONTINUE C ELSE IF (OPER(2:2).EQ.'*') THEN DO 240 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 240 CONTINUE C ELSE IF (OPER(2:2).EQ.'/') THEN ZVAL2 = 1. / ZVAL2 DO 250 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 250 CONTINUE C ELSE DO 260 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) ENDIF 260 CONTINUE ENDIF ENDIF RETURN C 400 IF (OPER(2:2).EQ.' ') THEN !check if alternative... DO 405 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = A(N) ENDIF 405 CONTINUE ELSE ZVAL2 = VAL(2) C IF (OPER(2:2).EQ.'C') THEN DO 410 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = ZVAL2 ENDIF 410 CONTINUE C ELSE IF (OPER(2:2).EQ.'+') THEN DO 420 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) + ZVAL2 ENDIF 420 CONTINUE C ELSE IF (OPER(2:2).EQ.'-') THEN DO 430 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) - ZVAL2 ENDIF 430 CONTINUE C ELSE IF (OPER(2:2).EQ.'*') THEN DO 440 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 440 CONTINUE C ELSE IF (OPER(2:2).EQ.'/') THEN ZVAL2 = 1. / ZVAL2 DO 450 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 450 CONTINUE C ELSE DO 460 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) + ZVAL1 ELSE C(N) = BB(N) ENDIF 460 CONTINUE ENDIF C RETURN ENDIF C END SUBROUTINE IREPLC(A,T,B,BB,C,IFCNT,OPER,NDIM,LOW,HI,NLIMIT,VAL) C IMPLICIT NONE C INTEGER NDIM,NLIMIT,IFCNT INTEGER N C REAL A(NDIM),T(NDIM),B(NDIM),BB(NDIM),C(NDIM) REAL LOW,HI,VAL(2) REAL ZVAL1,ZVAL2 C CHARACTER*(*) OPER C C first part B(N) - VAL(1) ZVAL1 = VAL(1) IF (NLIMIT.EQ.-1) GOTO 200 IF (NLIMIT.EQ.1) GOTO 400 C IF (OPER(2:2).EQ.' ') THEN !check if alternative... DO 100 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = A(N) ENDIF 100 CONTINUE ELSE ZVAL2 = VAL(2) C IF (OPER(2:2).EQ.'C') THEN DO 110 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = ZVAL2 ENDIF 110 CONTINUE C ELSE IF (OPER(2:2).EQ.'+') THEN DO 120 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) + ZVAL2 ENDIF 120 CONTINUE C ELSE IF (OPER(2:2).EQ.'-') THEN DO 130 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) - ZVAL2 ENDIF 130 CONTINUE C ELSE IF (OPER(2:2).EQ.'*') THEN DO 140 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 140 CONTINUE C ELSE IF (OPER(2:2).EQ.'/') THEN ZVAL2 = 1. / ZVAL2 DO 150 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 150 CONTINUE C ELSE DO 160 N=1,NDIM IF ((T(N).GE.LOW).AND.(T(N).LE.HI)) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) ENDIF 160 CONTINUE ENDIF ENDIF RETURN C C 200 IF (OPER(2:2).EQ.' ') THEN !check if alternative... DO 205 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = A(N) ENDIF 205 CONTINUE ELSE ZVAL2 = VAL(2) C IF (OPER(2:2).EQ.'C') THEN DO 210 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = ZVAL2 ENDIF 210 CONTINUE C ELSE IF (OPER(2:2).EQ.'+') THEN DO 220 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) + ZVAL2 ENDIF 220 CONTINUE C ELSE IF (OPER(2:2).EQ.'-') THEN DO 230 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) - ZVAL2 ENDIF 230 CONTINUE C ELSE IF (OPER(2:2).EQ.'*') THEN DO 240 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 240 CONTINUE C ELSE IF (OPER(2:2).EQ.'/') THEN ZVAL2 = 1. / ZVAL2 DO 250 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 250 CONTINUE C ELSE DO 260 N=1,NDIM IF (T(N).LE.HI) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) ENDIF 260 CONTINUE ENDIF ENDIF RETURN C 400 IF (OPER(2:2).EQ.' ') THEN !check if alternative... DO 405 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = A(N) ENDIF 405 CONTINUE ELSE ZVAL2 = VAL(2) C IF (OPER(2:2).EQ.'C') THEN DO 410 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = ZVAL2 ENDIF 410 CONTINUE C ELSE IF (OPER(2:2).EQ.'+') THEN DO 420 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) + ZVAL2 ENDIF 420 CONTINUE C ELSE IF (OPER(2:2).EQ.'-') THEN DO 430 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) - ZVAL2 ENDIF 430 CONTINUE C ELSE IF (OPER(2:2).EQ.'*') THEN DO 440 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 440 CONTINUE C ELSE IF (OPER(2:2).EQ.'/') THEN ZVAL2 = 1. / ZVAL2 DO 450 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) * ZVAL2 ENDIF 450 CONTINUE C ELSE DO 460 N=1,NDIM IF (T(N).GE.LOW) THEN IFCNT = IFCNT + 1 C(N) = B(N) - ZVAL1 ELSE C(N) = BB(N) ENDIF 460 CONTINUE ENDIF C RETURN ENDIF C END