SUBROUTINE ODFSET C ================= C C Initialization of line ODF's C INCLUDE 'IMPLIC.FOR' INCLUDE 'BASICS.FOR' INCLUDE 'ATOMIC.FOR' INCLUDE 'MODELQ.FOR' INCLUDE 'ODFPAR.FOR' COMMON/STFCR/OFR(MFODF),OW(MFODF),OWSUB(MFODF), * ODFL0(MDODF,MFODF),ODF2(MDEPTH),IFTRA(MTRANS), * IDODF(MDODF),NDODF DIMENSION DML(MDEPTH) C IDSTD=ND*2/3 NLASTE=NFREQ ITR0=0 DO ID=1,ND IF(DM(ID).GT.0) THEN DML(ID)=LOG(DM(ID)) ELSE DML(ID)=ID END IF END DO C DO 500 ION=1,NION IND=INODF1(ION) IF(IND.LE.0) GO TO 500 IND2=INODF2(ION) IF(FIODF1(ION).NE.' ') OPEN(IND,FILE=FIODF1(ION),STATUS='OLD') IF(FIODF2(ION).NE.' ') OPEN(IND2,FILE=FIODF2(ION),STATUS='OLD') READ(IND,*,END=500) NDODF IF(NDODF.GT.MDODF) * CALL QUIT('too many depths for an ODF - ndodf.gt.mdodf', * ndodf,mdodf) READ(IND,*) (IDODF(ID),ID=1,NDODF) IREC=0 10 CONTINUE READ(IND,*,END=500) II,JJ,FR,NFRO,FAV IF(NFRO.GT.MFODF) * CALL QUIT('too many frequencies for an ODF - nfro.gt.mfodf', * nfro,mfodf) DO IJ=1,NFRO READ(IND,*) OFR(IJ),OW(IJ),OWSUB(IJ) END DO IND2=INODF2(ION) READ(IND2,*) ((ODFL0(ID,IF),ID=1,NDODF),IF=1,NFRO) IREC=IREC+1 C N0=NFIRST(ION)-1 I=II+N0 J=JJ+N0 IF(J.GT.NLAST(ION)) GO TO 10 IF(I.GE.NLAST(ION)) GO TO 500 ITR=ITRA(I,J) IF(ITR.EQ.ITR0) THEN ITR1=0 IF(IF1.EQ.1) THEN IFIJ=0 DO 30 IT=1,NTRANS IF(ILOW(IT).NE.I.OR.IUP(IT).NE.J) GO TO 30 IF(IT.EQ.ITR) GO TO 30 IFIJ=IFIJ+1 IFTRA(IT)=IFIJ 30 CONTINUE IF1=0 END IF DO IT=1,NTRANS IF(IFTRA(IT).GT.0) THEN ITR1=IT GO TO 50 END IF END DO 50 CONTINUE IF(ITR1.EQ.0) THEN WRITE(6,601) ITR,N0,II,JJ STOP 601 FORMAT(' CONFLICT IN ODF INPUT; ITR=',4I5) END IF ITR=ITR1 IFTRA(ITR)=0 OSC0(ITR)=FAV ELSE ITR0=ITR IF1=1 OSC0(ITR)=FAV END IF C MODE=IABS(INDEXP(ITR)) IF(MODE.EQ.3.OR.MODE.EQ.4) THEN LCOMP(ITR)=.FALSE. INTMOD(ITR)=5 END IF IFRQ0=IFR0(ITR) IFRQ1=IFR1(ITR) IF(OFR(1).GE.OFR(NFRO)) THEN IF(MODE.EQ.3) THEN IFR0(ITR)=NLASTE+1 IFR1(ITR)=NLASTE+NFRO DO IJ=1,NFRO FREQ(IJ+NLASTE)=OFR(IJ) W(IJ+NLASTE)=OW(IJ) END DO IF(NDODF.EQ.1) THEN DO ID=1,ND DO IJ=1,NFRO PRFLIN(ID,IJ+NLASTE)=real(ODFL0(1,IJ)) END DO END DO ELSE DO ID=1,ND ID1=1 DO IDO=1,NDODF-1 IF(ID.GE.IDODF(IDO).AND.ID.LE.IDODF(IDO+1)) THEN ID1=IDO ID2=IDO+1 GO TO 140 END IF END DO 140 CONTINUE IF(ID2.GT.NDODF) ID2=NDODF IF(ID1.EQ.ID2) THEN A1=1. A2=0. ELSE X=DML(IDODF(ID2))-DML(IDODF(ID1)) A1=(DML(IDODF(ID2))-DML(ID))/X A2=UN-A1 END IF DO IJ=1,NFRO IF(ODFL0(ID1,IJ).LE.0.OR. * ODFL0(ID2,IJ).LE.0) THEN PRFLIN(ID,IJ+NLASTE)=0. ELSE X=EXP(A1*LOG(ODFL0(ID1,IJ))+ * A2*LOG(ODFL0(ID2,IJ))) PRFLIN(ID,IJ+NLASTE)=real(X) END IF END DO END DO END IF C IF(IPROF(ITR).EQ.0) THEN DO ID=1,ND PRFLIN(ID,IFR1(ITR))=0. END DO END IF DO IJ=1,NFRO PROF(IJ+NLASTE)=PRFLIN(IDSTD,IJ+NLASTE) END DO NLASTE=IFR1(ITR) END IF ELSE IF(MODE.EQ.3) THEN IFR0(ITR)=NLASTE+1 IFR1(ITR)=NLASTE+NFRO DO IJ=1,NFRO FREQ(IJ+NLASTE)=OFR(NFRO-IJ+1) W(IJ+NLASTE)=OW(NFRO-IJ+1) END DO IF(NDODF.EQ.1) THEN DO ID=1,ND DO IJ=1,NFRO PRFLIN(ID,IJ+NLASTE)=real(ODFL0(1,NFRO-IJ+1)) END DO END DO ELSE DO ID=1,ND ID1=1 DO IDO=1,NDODF-1 IF(ID.GE.IDODF(IDO).AND.ID.LE.IDODF(IDO+1)) THEN ID1=IDO ID2=IDO+1 GO TO 240 END IF END DO 240 CONTINUE IF(ID2.GT.NDODF) ID2=NDODF IF(ID1.EQ.ID2) THEN A1=1. A2=0. ELSE X=DML(IDODF(ID2))-DML(IDODF(ID1)) A1=(DML(IDODF(ID2))-DML(ID))/X A2=UN-A1 END IF DO IJ=1,NFRO IJ0=NFRO-IJ+1 IF(ODFL0(ID1,IJ0).LE.0.OR.ODFL0(ID2,IJ0).LE.0) * THEN PRFLIN(ID,IJ+NLASTE)=0. ELSE X=EXP(A1*LOG(ODFL0(ID1,IJ0))+ * A2*LOG(ODFL0(ID2,IJ0))) PRFLIN(ID,IJ+NLASTE)=REAL(X) END IF END DO END DO END IF C IF(IPROF(ITR).EQ.0) THEN DO ID=1,ND PRFLIN(ID,IFR0(ITR))=0. END DO END IF DO IJ=1,NFRO PROF(IJ+NLASTE)=PRFLIN(IDSTD,IJ+NLASTE) END DO NLASTE=IFR1(ITR) END IF END IF IF(NLASTE.GT.MFREQ) * CALL QUIT(' too many frequencies in ODFSET - nlaste.gt.mfreq', * nlaste,mfreq) IF(INDEXP(ITR).NE.0) THEN CALL IJALIS(ITR,IFRQ0,IFRQ1) END IF GO TO 10 500 CONTINUE C NFREQ=NLASTE RETURN END