Commit 613287a5 authored by Markus Pahlow's avatar Markus Pahlow

indent code and remove commented and obsolete lines

parent cf799492
......@@ -59,91 +59,82 @@
! jj is a counter for only those latitudes which are filtered
do j=js,je
jrow = j + joff
if ((jrow.gt.jft1.and.jrow.lt.jft2) .or. jrow.lt.jfrst) cycle
jj = jrow-jfrst+1
if (jrow .ge. jft2) jj = jj-jskpt+1
! if previous strips were of same length, do not recompute
! fourier coeffs
isave = 0
ieave = 0
do l=1,lsegf
do k=1,km
if (istf(jj,l,k) .ne. 0) then
is = istf(jj,l,k)
ie = ietf(jj,l,k)
ism1 = is-1
iredo = 0
if (is.ne.isave .or. ie.ne.ieave) then
iredo = -1
isave = is
ieave = ie
im = ie-ism1
if ((jrow.gt.jft1.and.jrow.lt.jft2) .or. jrow.lt.jfrst) cycle
jj = jrow-jfrst+1
if (jrow .ge. jft2) jj = jj-jskpt+1
! if previous strips were of same length, do not recompute
! fourier coeffs
isave = 0
ieave = 0
do l=1,lsegf
do k=1,km
if (istf(jj,l,k) .ne. 0) then
is = istf(jj,l,k)
ie = ietf(jj,l,k)
ism1 = is-1
iredo = 0
if (is.ne.isave .or. ie.ne.ieave) then
iredo = -1
isave = is
ieave = ie
im = ie-ism1
# if defined O_cyclic
if (im.ne.imtm2 .or. kmt(1,jrow).lt.k) then
m = 1
n = nint(im*cst(jrow)*cstr(jft0))
else ! one strip encompassing all longitudes
m = 3
n = nint(im*cst(jrow)*cstr(jft0)*0.5)
endif
if (im.ne.imtm2 .or. kmt(1,jrow).lt.k) then
m = 1
n = nint(im*cst(jrow)*cstr(jft0))
else ! one strip encompassing all longitudes
m = 3
n = nint(im*cst(jrow)*cstr(jft0)*0.5)
endif
# else
m = 1
n = nint(im*cst(jrow)*cstr(jft0))
m = 1
n = nint(im*cst(jrow)*cstr(jft0))
# endif
endif
do mm=1,nt
idx = iredo+mm
tempik(1:im,k) = t(tindx(is:ie),k,j,mm,taup1)
endif
do mm=1,nt
idx = iredo+mm
tempik(1:im,k) = t(tindx(is:ie),k,j,mm,taup1)
call filtr (tempik(1,k), im, m, n, idx)
call filtr (tempik(1,k), im, m, n, idx)
# if defined O_opem_pos
! filtr can result in negative concentrations; if this happens for a
! tracer to be kept positive (index is in ipos), reduce the positive
! changes imposed by filtr by a factor (fract) and add the difference
! to the negative concentrations so that they remain positive; here
! the maximum allowed reduction is 90%
IF (ANY(mm.EQ.ipos).AND.ANY(tempik(1:im,k).LT.0.)) THEN ! mm is the tracer index
tmin(1:im) = MAX(t(tindx(is:ie),k,j,mm,taup1),
& 0.)*0.1 ! restrict reductions to < 90%
dtr(1:im) = tempik(1:im,k) ! changes induced by filtr
& - t(tindx(is:ie),k,j,mm,taup1)
msk(1:im) = tempik(1:im,k).LT.tmin(1:im)
msk1(1:im) = dtr(1:im).GT.0. ! positive changes
mtr = SUM(tmin(1:im)-tempik(1:im,k), MASK=msk(1:im)) ! missing tracer
IF (ANY(msk1(1:im))) THEN
fract = max(min(mtr/SUM(dtr(1:im), MASK=msk1(1:im)),! fraction of pos. changes to revoke
& 1.), 0.) ! so that t is positive everywhere
tempik(1:im,k) = UNPACK(MASK=msk1(1:im),
& VECTOR=PACK(tempik(1:im,k) - fract*dtr(1:im), ! reduce positive changes
& MASK=msk1(1:im)),
& FIELD=UNPACK(MASK=msk(1:im),
& VECTOR=PACK(tmin(1:im), MASK=msk(1:im)), ! replace negative t
& FIELD=tempik(1:im,k))) ! unchanged t
ELSE ! all changes are 0 or negative -> do not apply
tempik(1:im,k) = t(tindx(is:ie),k,j,mm,taup1)
! write(*,*)'filt:130:j,k,msk1=',j,k,msk1(1:im)
ENDIF
c$$$ if(fract.gt.1..or.fract.lt.0.)then
c$$$ write(*,*)'filt:mtr=',sum(tempik(1:im,k)),
c$$$ & sum(t(tindx(is:ie),k,j,mm,taup1))
c$$$ write(*,*)'filt:msk=',msk1(1:im)
c$$$ write(*,*)'filt:tr=',t(tindx(is:ie),k,j,mm,taup1)
c$$$ write(*,*)'filt:tmin=',tmin(1:im)
c$$$ write(*,*)'filt:dtr=',dtr(1:im)
c$$$ write(*,*)'filt:j,k,fract=',j,k,fract
c$$$ stop
c$$$ endif
ENDIF
IF (ANY(mm.EQ.ipos).AND.ANY(tempik(1:im,k).LT.0.)) ! mm is the tracer index
& THEN
tmin(1:im) = MAX(t(tindx(is:ie),k,j,mm,taup1),
& 0.)*0.1 ! restrict reductions to < 90%
dtr(1:im) = tempik(1:im,k) ! changes induced by filtr
& - t(tindx(is:ie),k,j,mm,taup1)
msk(1:im) = tempik(1:im,k).LT.tmin(1:im)
msk1(1:im) = dtr(1:im).GT.0. ! positive changes
mtr = SUM(tmin(1:im)-tempik(1:im,k), ! missing tracer
& MASK=msk(1:im))
IF (ANY(msk1(1:im))) THEN
fract = max(min(mtr/SUM(dtr(1:im), ! fraction of pos. changes to revoke
& MASK=msk1(1:im)), 1.), 0.) ! so that t is positive everywhere
tempik(1:im,k) = UNPACK(MASK=msk1(1:im),
& VECTOR=PACK(tempik(1:im,k) ! reduce positive changes
& - fract*dtr(1:im),
& MASK=msk1(1:im)),
& FIELD=UNPACK(MASK=msk(1:im),
& VECTOR=PACK(tmin(1:im), MASK=msk(1:im)), ! replace negative t
& FIELD=tempik(1:im,k))) ! unchanged t
ELSE ! all changes are 0 or negative -> do not apply
tempik(1:im,k) = t(tindx(is:ie),k,j,mm,taup1)
ENDIF
ENDIF
# endif
t(tindx(is:ie),k,j,mm,taup1) = tempik(1:im,k)
enddo
endif
t(tindx(is:ie),k,j,mm,taup1) = tempik(1:im,k)
enddo
endif
enddo
enddo
enddo
101 continue
enddo
# endif
# if defined O_firfil
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment