From 17655559455c6e26ca2a91ec1aa6b17445df4e48 Mon Sep 17 00:00:00 2001 From: Elena.Budnik Date: Fri, 13 Oct 2017 12:04:36 +0200 Subject: [PATCH] modifs Chihiro --- Sources/Prop_code/sub_slct_p.f | 83 ++++++++++++++++++++++++++++++++++++----------------------------------------------- 1 file changed, 36 insertions(+), 47 deletions(-) diff --git a/Sources/Prop_code/sub_slct_p.f b/Sources/Prop_code/sub_slct_p.f index 21e0cf0..254453c 100644 --- a/Sources/Prop_code/sub_slct_p.f +++ b/Sources/Prop_code/sub_slct_p.f @@ -6,8 +6,7 @@ c======================================================================| integer,intent(in) :: nang,ifnpo real*8,intent(in) :: angref6(nang),dtr,touts character*100 ,intent(in):: fntmp2(nang),fnin,fnout - real*8,allocatable :: jsout(:,:),ddout(:,:,:) -!!!! elena : para(13) !!! not para(12) + real*8,allocatable :: jsout(:,:),ddout(:,:,:),jstmp2(:,:) real*8 :: angref0,para(13),js1,sec0 integer :: i,j,ifn0,ifn1,ifn2,iang,nstep integer :: iy0,im0,id0,jdd,jdd2,ihr0,imin0,isec0 @@ -31,6 +30,7 @@ c======================================================================| ifn1=43 ifn2=44 + !---read input data call count_lines(fnin,nnin) allocate(datain(13,nnin),jsin(nnin),dangi(nnin),dangi2(nnin)) @@ -53,6 +53,7 @@ c======================================================================| allocate(jstmp(nstep)) allocate(ddslct(10,nstep),jsslct(nstep)) allocate(islct(nstep),dangtmp(2,nang,nstep),jsinref2(nstep)) + allocate(jstmp2(6,nstep)) do iang=1,nang angref0=angref6(iang) @@ -84,8 +85,7 @@ c---angle evaluation bd1=dangi2(1); bd2=dangi2(nnin) call convim(jsin,jsinref(iang,:),dangi2,dang1(iang,:) 1 ,nnin,nstep,bd1,bd2) - - + dangi(:)=datain(12,:) !--input-ref dangi2(1)=dangi(1) do i=2,nnin @@ -96,7 +96,6 @@ c---angle evaluation bd1=dangi2(1); bd2=dangi2(nnin) call convim(jsin,jsoutrev(iang,:),dangi2,ang0(:) 1 ,nnin,nstep,bd1,bd2) - dango(:)=ang0(:)-angref0 !--output-ref c---planeatry rotation effect (2nd step) @@ -126,24 +125,24 @@ c---angle selection do iang=1,nang idstep=0 do i=2,nstep-1 - jsout(1,i)=jsinref(iang,i+1)-jsinref(iang,i-1) + jstmp2(1,i)=jsinref(iang,i+1)-jsinref(iang,i-1) if((idprop.eq.-1.and.jsout(1,i).ge.86400.*20.).or. 1 (idprop.eq.1.and.jsout(1,i).le.-86400.*20.)) then idstep=idstep+1 - jsout(2,idstep)=jsinref(iang,i) - jsout(3,idstep)=float(i) + jstmp2(2,idstep)=jsinref(iang,i) + jstmp2(3,idstep)=float(i) endif enddo if(idstep.ge.1)then do i=1,idstep/2. - jsout(4,i)=minval(minloc( - 1 abs(jsinref(iang,1:int(jsout(3,i)-1))-jsout(2,i*2)))) - dangtmp(2,iang,int(jsout(4,i)):int(jsout(3,i*2)))=901. + jstmp2(4,i)=minval(minloc( + 1 abs(jsinref(iang,1:int(jstmp2(3,i)-1))-jstmp2(2,i*2)))) + dangtmp(2,iang,int(jstmp2(4,i)):int(jstmp2(3,i*2)))=901. enddo endif do i=2,nstep-1 - jsout(5,i)=dang2(iang,i+1)-dang2(iang,i-1) - if(abs(jsout(5,i)).lt.1.e-10) dangtmp(2,iang,i)=902. + jstmp2(5,i)=dang2(iang,i+1)-dang2(iang,i-1) + if(abs(jstmp2(5,i)).lt.1.e-10) dangtmp(2,iang,i)=902. if((idprop.eq.-1.and.ddout(iang,10,i).ge.jsin(1)) 1 .or.(idprop.eq.1.and.ddout(iang,10,i).le.jsin(1))) 1 dangtmp(2,iang,i)=999. @@ -210,12 +209,7 @@ c---angle evaluation: in-out if(idprop.eq.-1)then;bd1=dangi2(nnin);bd2=dangi2(1);endif call convim(jsin,dangw,dangi2,angwin(:) 1 ,nnin,nwout,bd1,bd2) -! write(6,1115) real(dangi(1:60)) -! write(6,*) 'dangi2' -! write(6,1115) real(dangi2) -! write(6,*) 'angwin' -! write(6,1115) real(angwin) - + dangi(:)=datain(12,:) !--output-ref dangi2(1)=dangi(1) do i=2,nnin @@ -227,46 +221,41 @@ c---angle evaluation: in-out if(idprop.eq.-1)then;bd1=dangi2(nnin);bd2=dangi2(1);endif call convim(jsin,jswout,dangi2,angwout(:) 1 ,nnin,nwout,bd1,bd2) -! write(6, *) 'angwout', nnin, nwout -! write(6,1115) real(angwout(1:60)) -1115 format(15f7.1) - dangw=angwin-angwout !--difference + + dangw=angwin-angwout !--difference call angrev(dangw,dangw,nwout) -! write(6,1115) real(dangw) - idstep=0; idstep2=0 do i=2,nwout angw(i)=dangw(i)-dangw(i-1) - if(angw(i).ge.300.) then + if(angw(i).ge.300.) then idstep=idstep+1 - jsout(2,idstep)=jswout(i) - jsout(3,idstep)=float(i) + jstmp2(2,idstep)=jswout(i) + jstmp2(3,idstep)=float(i) endif if(angw(i).le.-300.) then idstep2=idstep2+1 - jsout(4,idstep2)=jswout(i) - jsout(5,idstep2)=float(i) + jstmp2(4,idstep2)=jswout(i) + jstmp2(5,idstep2)=float(i) endif - enddo - + enddo + if(idprop.eq.1.and.idstep.ge.1.and.idstep*2.eq.idstep2)then - dangw(int(jsout(5,idstep*2-1)):int(jsout(3,idstep))) - 1 =dangw(int(jsout(5,idstep*2-1)):int(jsout(3,idstep)))+360. - dangw(int(jsout(3,idstep)):int(jsout(5,idstep*2))) - 1 =dangw(int(jsout(3,idstep))-1:int(jsout(5,idstep*2)))-360. - ddwout1(11,int(jsout(5,idstep*2-1)):int(jsout(5,idstep*2)))=1. + dangw(int(jstmp2(5,idstep*2-1)):int(jstmp2(3,idstep))) + 1 =dangw(int(jstmp2(5,idstep*2-1)):int(jstmp2(3,idstep)))+360. + dangw(int(jstmp2(3,idstep)):int(jstmp2(5,idstep*2))) + 1 =dangw(int(jstmp2(3,idstep)):int(jstmp2(5,idstep*2)))-360. +c 1 =dangw(int(jstmp2(3,idstep))-1:int(jstmp2(5,idstep*2)))-360. + ddwout1(11,int(jstmp2(5,idstep*2-1)):int(jstmp2(5,idstep*2)))=1. endif - - if(idprop.eq.-1.and.idstep2.ge.1.and.idstep2*2.eq.idstep)then - dangw(int(jsout(3,idstep2*2-1)):int(jsout(5,idstep2))) - 1 =dangw(int(jsout(3,idstep2*2-1)):int(jsout(5,idstep2)))-360. -!!!!!! elena : dimensions mismatch - dangw(int(jsout(5,idstep2))-1:int(jsout(3,idstep2*2))) - 1 =dangw(int(jsout(5,idstep2))-1:int(jsout(3,idstep2*2)))+360. + if(idprop.eq.-1.and.idstep2.ge.1.and.idstep2*2.eq.idstep)then + dangw(int(jstmp2(3,idstep2*2-1)):int(jstmp2(5,idstep2))) + 1 =dangw(int(jstmp2(3,idstep2*2-1)):int(jstmp2(5,idstep2)))-360. +c dangw(int(jstmp2(5,idstep2)):int(jstmp2(3,idstep2*2))) + dangw(int(jstmp2(5,idstep2))-1:int(jstmp2(3,idstep2*2))) + 1 =dangw(int(jstmp2(5,idstep2))-1:int(jstmp2(3,idstep2*2)))+360. endif - ddwout1(9,:)=dangw !separation angle -! write(6,1115) real(dangw) + c---output open(ifn2,file=fnout,status='unknown',form='formatted') do i=1,nwout,1 @@ -286,7 +275,7 @@ c write(62,'(i12,12e18.9)') int(jswout(i)),(ddwout1(j,i),j=1,11) c---finish deallocate(datain,jsin,dangi,dangi2 1 ,jsout,ddout,jsinref,ang0,dango,dang1,jsoutrev - 1 ,jswout,ddwout,ddwout1) + 1 ,jswout,ddwout,ddwout1,jstmp2) return end c================================================== -- libgit2 0.21.2