50 lines
1.4 KiB
Fortran
50 lines
1.4 KiB
Fortran
SUBROUTINE CHCKAB
|
|
C
|
|
C check input abumdances of explicit atoms (unit 5) and those
|
|
C which follow from the models atmosphere (unit 7) obtained by
|
|
C summing all populations and upper sums
|
|
C The program stops if it finds discrepancy more than 10 %
|
|
c
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
dimension sumpop(matom),sumiat(matom)
|
|
c
|
|
IST=0
|
|
DO ID1=1,3
|
|
IF(ID1.EQ.1) ID=1
|
|
IF(ID1.EQ.2) ID=46
|
|
IF(ID1.EQ.3) ID=ND
|
|
CALL WNSTOR(ID)
|
|
ANE=ELEC(ID)
|
|
CALL SABOLF(ID)
|
|
DO IAT=1,NATOM
|
|
SUM=0.
|
|
sump=0.
|
|
DO I=N0A(IAT),NKA(IAT)
|
|
IL=ILK(I)
|
|
A=1.
|
|
IF(IL.GT.0) A=1.+ANE*USUM(IL)
|
|
SUM=SUM+A*POPUL(I,ID)
|
|
SUMP=SUMP+POPUL(I,ID)
|
|
END DO
|
|
SUMIAT(IAT)=SUM
|
|
SUMPOP(IAT)=SUMP
|
|
END DO
|
|
WRITE(6,600) ID
|
|
DO IAT=1,NATOM
|
|
X=SUMIAT(IAT)/SUMIAT(IATREF)
|
|
WRITE(6,601) IAT,X,abund(iat,id),SUMPOP(IAT)/SUMPOP(IATREF)
|
|
IF(X/abund(iat,id).GT.1.1.OR.X/abund(iat,id).LT.0.9) ist=ist+1
|
|
END DO
|
|
END DO
|
|
IF(IST.GT.0) THEN
|
|
WRITE(6,602)
|
|
STOP
|
|
END IF
|
|
600 FORMAT(' check of abundances (id =',i3/
|
|
* ' computed from model atmosphere - input abundances'/)
|
|
601 format(i5,1p3e20.3)
|
|
602 format(' ERROR !!! - inconsistent abundances'/)
|
|
RETURN
|
|
END
|