istp/gray
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity

restored old contour_psi routine. Added check on regrid output

Browse Source
This commit is contained in:
Daniela Farina 2012-08-28 14:01:09 +00:00
parent 9aa699dd67
commit 6c4682fb56
1 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/gray.f
View File

@ -1200,7 +1200,7 @@ c icocos<10: input psi is in Wb/rad (gray convention)
do j=1,nz do j=1,nz
do i=1,nr do i=1,nr
if(ipsinorm.eq.0) then if(ipsinorm.eq.0) then
psin(i,j)=abs(psi(i,j)-psiax)/abs(psia0) psin(i,j)=(psi(i,j)-psiax)/(psia0)
psi(i,j)=psin(i,j)*psia psi(i,j)=psin(i,j)*psia
else else
psi(i,j)=psin(i,j)*psia psi(i,j)=psin(i,j)*psia
@ -1216,6 +1216,12 @@ c
call regrid(iopt,nr,rv,nz,zv,fvpsi,rmnm,rmxm,zmnm,zmxm, call regrid(iopt,nr,rv,nz,zv,fvpsi,rmnm,rmxm,zmnm,zmxm,
. kspl,kspl,sspl,nrest,nzest,nsr,tr,nsz,tz,cc,fp, . kspl,kspl,sspl,nrest,nzest,nsr,tr,nsz,tz,cc,fp,
. wrk,lwrk,iwrk,liwrk,ier) . wrk,lwrk,iwrk,liwrk,ier)
if(ier.eq.-1) then
sspl=0.0d0
call regrid(iopt,nr,rv,nz,zv,fvpsi,rmnm,rmxm,zmnm,zmxm,
. kspl,kspl,sspl,nrest,nzest,nsr,tr,nsz,tz,cc,fp,
. wrk,lwrk,iwrk,liwrk,ier)
end if
nsrt=nsr nsrt=nsr
nszt=nsz nszt=nsz
if (sspl.gt.0.0d0) then if (sspl.gt.0.0d0) then
@ -2057,17 +2063,17 @@ c
if(ier.gt.0) print*,' profil =',ier if(ier.gt.0) print*,' profil =',ier
val=h+psiaxis0/psia val=h+psiaxis0/psia
call sproota(val,tr,nsr,czc,zeroc,mest,m,ier) call sproota(val,tr,nsr,czc,zeroc,mest,m,ier)
call sort (mest, zeroc)
if (zeroc(1).gt.rwallm) then if (zeroc(1).gt.rwallm) then
iic=1 rcn(ic)=zeroc(1)
else
iic=2
if (zeroc(2).lt.rwallm) iic=3
end if
rcn(ic)=zeroc(iic)
zcn(ic)=zc zcn(ic)=zc
rcn(2*np+2-ic)=zeroc(iic+1) rcn(2*np+2-ic)=zeroc(2)
zcn(2*np+2-ic)=zc zcn(2*np+2-ic)=zc
else
rcn(ic)=zeroc(2)
zcn(ic)=zc
rcn(2*np+2-ic)=zeroc(3)
zcn(2*np+2-ic)=zc
end if
end do end do
if (ipr.gt.0) then if (ipr.gt.0) then
do ii=1,2*np+1 do ii=1,2*np+1