225 lines
7.2 KiB
Fortran
225 lines
7.2 KiB
Fortran
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
|