SpectraRust/tlusty/extracted/osccor.f
2026-03-19 14:05:33 +08:00

65 lines
1.5 KiB
Fortran

subroutine osccor
c =================
c
c routine for finding and removing oscillations in the temperature
c
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'MODELQ.FOR'
INCLUDE 'ITERAT.FOR'
dimension delt(mdepth),dda(mdepth)
c
ndos=abs(ioscor)+1
do id=2,ndos
delt(id)=temp(id)-temp(id-1)
end do
do id=2,ndos-1
dd=delt(id)*delt(id+1)
dda(id)=1.
if(dd.ne.0.) dda(id)=dd/abs(dd)
end do
c
iobeg=0
ioend=0
do id=2,ndos-1
if(dda(id).lt.0.and.iobeg.eq.0) iobeg=id
if(dda(id).gt.0.and.dda(id-1).lt.0) ioend=id
end do
iobeg=iobeg-1
if(iobeg.gt.0) then
write(6,601) iter,iobeg,ioend,(temp(id),id=iobeg,ioend)
601 format(/' oscillation in T in iteration',i4,
* ' between depths',i4,' and ',i4/(10f8.1))
c
st=log(temp(ioend)/temp(iobeg))/log(dm(ioend)/dm(iobeg))
tl0=log(temp(iobeg))
do id=iobeg,ioend
dml=log(dm(id)/dm(iobeg))
tl=tl0+dml*st
temp(id)=exp(tl)
end do
write(6,603) (temp(id),id=iobeg,ioend)
603 format(/' removed and replaced by the values:'/(10f8.1))
c
end if
c
c set surface temperature to the minimum one
c
if(ioscor.lt.0) then
tmin=1.e9
do id=1,nd
if(temp(id).lt.tmin) then
tmin=temp(id)
imin=id
end if
end do
c
do id=1,imin
temp(id)=tmin
end do
c
end if
return
end