104 lines
2.7 KiB
Fortran
104 lines
2.7 KiB
Fortran
SUBROUTINE COOLRT
|
|
C =================
|
|
C
|
|
C Evaluation of cooling and heating rates for each ion
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
INCLUDE 'ALIPAR.FOR'
|
|
INCLUDE 'ARRAY1.FOR'
|
|
INCLUDE 'ITERAT.FOR'
|
|
parameter (pi4=4.*3.14159265d0)
|
|
DIMENSION CLHT1(MDEPTH),CLHT2(MDEPTH),CLHT3(MDEPTH)
|
|
DIMENSION CLRAT(MION,MDEPTH),HTRAT(MION,MDEPTH)
|
|
COMMON/COOLCO/ABSOTI(MION,MDEPTH),EMISTI(MION,MDEPTH),
|
|
* ABSOC1(MDEPTH),EMISC1(MDEPTH)
|
|
C
|
|
DO ID=1,ND
|
|
DO ION=1,NION
|
|
CLRAT(ION,ID)=0.
|
|
HTRAT(ION,ID)=0.
|
|
END DO
|
|
CLHT1(ID)=0.
|
|
CLHT2(ID)=0.
|
|
CLHT3(ID)=0.
|
|
END DO
|
|
C
|
|
DO IJ=1,NFREQ
|
|
IF(IJX(IJ).NE.-1) THEN
|
|
CALL OPACFA(IJ)
|
|
CALL RTEFR1(IJ)
|
|
DO ID=1,ND
|
|
DO ION=1,NION
|
|
CLRAT(ION,ID)=CLRAT(ION,ID)+W(IJ)*EMISTI(ION,ID)
|
|
HTRAT(ION,ID)=HTRAT(ION,ID)+
|
|
& W(IJ)*ABSOTI(ION,ID)*RAD1(ID)
|
|
END DO
|
|
EM=EMIS1(ID)+SCAT1(ID)*RAD1(ID)
|
|
CLHT2(ID)=CLHT2(ID)+W(IJ)*(EM-ABSO1(ID)*RAD1(ID))
|
|
CLHT3(ID)=CLHT3(ID)+W(IJ)*EMIS1(ID)
|
|
END DO
|
|
C
|
|
if(ipopac.eq.1) then
|
|
if(ij.le.nfreqc) then
|
|
write(85,685) ij,freq(ij),(absoc1(id)/dens(id),id=1,nd)
|
|
end if
|
|
end if
|
|
if(ipopac.eq.2) then
|
|
if(ij.le.nfreqc) then
|
|
write(87,686) ij,freq(ij)
|
|
taud=abso1(1)*dedm1
|
|
do id=1,nd
|
|
if(id.gt.1) taud=taud+deldmz(id-1)*
|
|
* (absot(id-1)+absot(id))
|
|
end do
|
|
end if
|
|
end if
|
|
685 format(i5,1pe15.7/(1p8e10.3))
|
|
686 format(i5,1pe15.7)
|
|
C
|
|
END IF
|
|
END DO
|
|
C
|
|
if(icoolp.le.0) return
|
|
C
|
|
DO ID=1,ND
|
|
DO ION=1,NION
|
|
CLHT1(ID)=CLHT1(ID)+CLRAT(ION,ID)-HTRAT(ION,ID)
|
|
END DO
|
|
WRITE(86,1060) ID,CLHT1(ID)*pi4,CLHT2(ID)*pi4,
|
|
* CLHT3(ID)*pi4
|
|
1060 FORMAT(I5,1P3E14.6)
|
|
END DO
|
|
c
|
|
if(icoolp.lt.2) return
|
|
c
|
|
DO ID=1,ND
|
|
WRITE(87,1071) id,
|
|
* ((CLRAT(ION,ID)-HTRAT(ION,ID))*pi4,ION=1,NION)
|
|
END DO
|
|
c
|
|
if(icoolp.lt.10) return
|
|
WRITE(87,1070) ND,NION
|
|
IOFE2=0
|
|
DO ION=1,NION
|
|
NN1=NFIRST(ION)
|
|
IAT2=IATM(NN1)
|
|
IF(NUMAT(IAT2).EQ.26 .and. IZ(ION).EQ.2) IOFE2=ION
|
|
END DO
|
|
REWIND 8
|
|
READ(8,*) NDR
|
|
READ(8,*) TTR,RSR
|
|
DO ID=ND,1,-1
|
|
READ(8,*) RSR
|
|
WRITE(88,1071) RSR,CLRAT(IOFE2,ID)
|
|
END DO
|
|
1070 FORMAT(2I5)
|
|
1071 FORMAT(i5/(1P6E13.5))
|
|
|
|
RETURN
|
|
END
|