Commit 17655559455c6e26ca2a91ec1aa6b17445df4e48
1 parent
5a1df76c
Exists in
master
modifs Chihiro
Showing
1 changed file
with
36 additions
and
47 deletions
Show diff stats
Sources/Prop_code/sub_slct_p.f
| ... | ... | @@ -6,8 +6,7 @@ c======================================================================| |
| 6 | 6 | integer,intent(in) :: nang,ifnpo |
| 7 | 7 | real*8,intent(in) :: angref6(nang),dtr,touts |
| 8 | 8 | character*100 ,intent(in):: fntmp2(nang),fnin,fnout |
| 9 | - real*8,allocatable :: jsout(:,:),ddout(:,:,:) | |
| 10 | -!!!! elena : para(13) !!! not para(12) | |
| 9 | + real*8,allocatable :: jsout(:,:),ddout(:,:,:),jstmp2(:,:) | |
| 11 | 10 | real*8 :: angref0,para(13),js1,sec0 |
| 12 | 11 | integer :: i,j,ifn0,ifn1,ifn2,iang,nstep |
| 13 | 12 | integer :: iy0,im0,id0,jdd,jdd2,ihr0,imin0,isec0 |
| ... | ... | @@ -31,6 +30,7 @@ c======================================================================| |
| 31 | 30 | |
| 32 | 31 | ifn1=43 |
| 33 | 32 | ifn2=44 |
| 33 | + | |
| 34 | 34 | !---read input data |
| 35 | 35 | call count_lines(fnin,nnin) |
| 36 | 36 | allocate(datain(13,nnin),jsin(nnin),dangi(nnin),dangi2(nnin)) |
| ... | ... | @@ -53,6 +53,7 @@ c======================================================================| |
| 53 | 53 | allocate(jstmp(nstep)) |
| 54 | 54 | allocate(ddslct(10,nstep),jsslct(nstep)) |
| 55 | 55 | allocate(islct(nstep),dangtmp(2,nang,nstep),jsinref2(nstep)) |
| 56 | + allocate(jstmp2(6,nstep)) | |
| 56 | 57 | |
| 57 | 58 | do iang=1,nang |
| 58 | 59 | angref0=angref6(iang) |
| ... | ... | @@ -84,8 +85,7 @@ c---angle evaluation |
| 84 | 85 | bd1=dangi2(1); bd2=dangi2(nnin) |
| 85 | 86 | call convim(jsin,jsinref(iang,:),dangi2,dang1(iang,:) |
| 86 | 87 | 1 ,nnin,nstep,bd1,bd2) |
| 87 | - | |
| 88 | - | |
| 88 | + | |
| 89 | 89 | dangi(:)=datain(12,:) !--input-ref |
| 90 | 90 | dangi2(1)=dangi(1) |
| 91 | 91 | do i=2,nnin |
| ... | ... | @@ -96,7 +96,6 @@ c---angle evaluation |
| 96 | 96 | bd1=dangi2(1); bd2=dangi2(nnin) |
| 97 | 97 | call convim(jsin,jsoutrev(iang,:),dangi2,ang0(:) |
| 98 | 98 | 1 ,nnin,nstep,bd1,bd2) |
| 99 | - | |
| 100 | 99 | dango(:)=ang0(:)-angref0 !--output-ref |
| 101 | 100 | |
| 102 | 101 | c---planeatry rotation effect (2nd step) |
| ... | ... | @@ -126,24 +125,24 @@ c---angle selection |
| 126 | 125 | do iang=1,nang |
| 127 | 126 | idstep=0 |
| 128 | 127 | do i=2,nstep-1 |
| 129 | - jsout(1,i)=jsinref(iang,i+1)-jsinref(iang,i-1) | |
| 128 | + jstmp2(1,i)=jsinref(iang,i+1)-jsinref(iang,i-1) | |
| 130 | 129 | if((idprop.eq.-1.and.jsout(1,i).ge.86400.*20.).or. |
| 131 | 130 | 1 (idprop.eq.1.and.jsout(1,i).le.-86400.*20.)) then |
| 132 | 131 | idstep=idstep+1 |
| 133 | - jsout(2,idstep)=jsinref(iang,i) | |
| 134 | - jsout(3,idstep)=float(i) | |
| 132 | + jstmp2(2,idstep)=jsinref(iang,i) | |
| 133 | + jstmp2(3,idstep)=float(i) | |
| 135 | 134 | endif |
| 136 | 135 | enddo |
| 137 | 136 | if(idstep.ge.1)then |
| 138 | 137 | do i=1,idstep/2. |
| 139 | - jsout(4,i)=minval(minloc( | |
| 140 | - 1 abs(jsinref(iang,1:int(jsout(3,i)-1))-jsout(2,i*2)))) | |
| 141 | - dangtmp(2,iang,int(jsout(4,i)):int(jsout(3,i*2)))=901. | |
| 138 | + jstmp2(4,i)=minval(minloc( | |
| 139 | + 1 abs(jsinref(iang,1:int(jstmp2(3,i)-1))-jstmp2(2,i*2)))) | |
| 140 | + dangtmp(2,iang,int(jstmp2(4,i)):int(jstmp2(3,i*2)))=901. | |
| 142 | 141 | enddo |
| 143 | 142 | endif |
| 144 | 143 | do i=2,nstep-1 |
| 145 | - jsout(5,i)=dang2(iang,i+1)-dang2(iang,i-1) | |
| 146 | - if(abs(jsout(5,i)).lt.1.e-10) dangtmp(2,iang,i)=902. | |
| 144 | + jstmp2(5,i)=dang2(iang,i+1)-dang2(iang,i-1) | |
| 145 | + if(abs(jstmp2(5,i)).lt.1.e-10) dangtmp(2,iang,i)=902. | |
| 147 | 146 | if((idprop.eq.-1.and.ddout(iang,10,i).ge.jsin(1)) |
| 148 | 147 | 1 .or.(idprop.eq.1.and.ddout(iang,10,i).le.jsin(1))) |
| 149 | 148 | 1 dangtmp(2,iang,i)=999. |
| ... | ... | @@ -210,12 +209,7 @@ c---angle evaluation: in-out |
| 210 | 209 | if(idprop.eq.-1)then;bd1=dangi2(nnin);bd2=dangi2(1);endif |
| 211 | 210 | call convim(jsin,dangw,dangi2,angwin(:) |
| 212 | 211 | 1 ,nnin,nwout,bd1,bd2) |
| 213 | -! write(6,1115) real(dangi(1:60)) | |
| 214 | -! write(6,*) 'dangi2' | |
| 215 | -! write(6,1115) real(dangi2) | |
| 216 | -! write(6,*) 'angwin' | |
| 217 | -! write(6,1115) real(angwin) | |
| 218 | - | |
| 212 | + | |
| 219 | 213 | dangi(:)=datain(12,:) !--output-ref |
| 220 | 214 | dangi2(1)=dangi(1) |
| 221 | 215 | do i=2,nnin |
| ... | ... | @@ -227,46 +221,41 @@ c---angle evaluation: in-out |
| 227 | 221 | if(idprop.eq.-1)then;bd1=dangi2(nnin);bd2=dangi2(1);endif |
| 228 | 222 | call convim(jsin,jswout,dangi2,angwout(:) |
| 229 | 223 | 1 ,nnin,nwout,bd1,bd2) |
| 230 | -! write(6, *) 'angwout', nnin, nwout | |
| 231 | -! write(6,1115) real(angwout(1:60)) | |
| 232 | -1115 format(15f7.1) | |
| 233 | - dangw=angwin-angwout !--difference | |
| 224 | + | |
| 225 | + dangw=angwin-angwout !--difference | |
| 234 | 226 | call angrev(dangw,dangw,nwout) |
| 235 | -! write(6,1115) real(dangw) | |
| 236 | - | |
| 237 | 227 | idstep=0; idstep2=0 |
| 238 | 228 | do i=2,nwout |
| 239 | 229 | angw(i)=dangw(i)-dangw(i-1) |
| 240 | - if(angw(i).ge.300.) then | |
| 230 | + if(angw(i).ge.300.) then | |
| 241 | 231 | idstep=idstep+1 |
| 242 | - jsout(2,idstep)=jswout(i) | |
| 243 | - jsout(3,idstep)=float(i) | |
| 232 | + jstmp2(2,idstep)=jswout(i) | |
| 233 | + jstmp2(3,idstep)=float(i) | |
| 244 | 234 | endif |
| 245 | 235 | if(angw(i).le.-300.) then |
| 246 | 236 | idstep2=idstep2+1 |
| 247 | - jsout(4,idstep2)=jswout(i) | |
| 248 | - jsout(5,idstep2)=float(i) | |
| 237 | + jstmp2(4,idstep2)=jswout(i) | |
| 238 | + jstmp2(5,idstep2)=float(i) | |
| 249 | 239 | endif |
| 250 | - enddo | |
| 251 | - | |
| 240 | + enddo | |
| 241 | + | |
| 252 | 242 | if(idprop.eq.1.and.idstep.ge.1.and.idstep*2.eq.idstep2)then |
| 253 | - dangw(int(jsout(5,idstep*2-1)):int(jsout(3,idstep))) | |
| 254 | - 1 =dangw(int(jsout(5,idstep*2-1)):int(jsout(3,idstep)))+360. | |
| 255 | - dangw(int(jsout(3,idstep)):int(jsout(5,idstep*2))) | |
| 256 | - 1 =dangw(int(jsout(3,idstep))-1:int(jsout(5,idstep*2)))-360. | |
| 257 | - ddwout1(11,int(jsout(5,idstep*2-1)):int(jsout(5,idstep*2)))=1. | |
| 243 | + dangw(int(jstmp2(5,idstep*2-1)):int(jstmp2(3,idstep))) | |
| 244 | + 1 =dangw(int(jstmp2(5,idstep*2-1)):int(jstmp2(3,idstep)))+360. | |
| 245 | + dangw(int(jstmp2(3,idstep)):int(jstmp2(5,idstep*2))) | |
| 246 | + 1 =dangw(int(jstmp2(3,idstep)):int(jstmp2(5,idstep*2)))-360. | |
| 247 | +c 1 =dangw(int(jstmp2(3,idstep))-1:int(jstmp2(5,idstep*2)))-360. | |
| 248 | + ddwout1(11,int(jstmp2(5,idstep*2-1)):int(jstmp2(5,idstep*2)))=1. | |
| 258 | 249 | endif |
| 259 | - | |
| 260 | - if(idprop.eq.-1.and.idstep2.ge.1.and.idstep2*2.eq.idstep)then | |
| 261 | - dangw(int(jsout(3,idstep2*2-1)):int(jsout(5,idstep2))) | |
| 262 | - 1 =dangw(int(jsout(3,idstep2*2-1)):int(jsout(5,idstep2)))-360. | |
| 263 | -!!!!!! elena : dimensions mismatch | |
| 264 | - dangw(int(jsout(5,idstep2))-1:int(jsout(3,idstep2*2))) | |
| 265 | - 1 =dangw(int(jsout(5,idstep2))-1:int(jsout(3,idstep2*2)))+360. | |
| 250 | + if(idprop.eq.-1.and.idstep2.ge.1.and.idstep2*2.eq.idstep)then | |
| 251 | + dangw(int(jstmp2(3,idstep2*2-1)):int(jstmp2(5,idstep2))) | |
| 252 | + 1 =dangw(int(jstmp2(3,idstep2*2-1)):int(jstmp2(5,idstep2)))-360. | |
| 253 | +c dangw(int(jstmp2(5,idstep2)):int(jstmp2(3,idstep2*2))) | |
| 254 | + dangw(int(jstmp2(5,idstep2))-1:int(jstmp2(3,idstep2*2))) | |
| 255 | + 1 =dangw(int(jstmp2(5,idstep2))-1:int(jstmp2(3,idstep2*2)))+360. | |
| 266 | 256 | endif |
| 267 | - | |
| 268 | 257 | ddwout1(9,:)=dangw !separation angle |
| 269 | -! write(6,1115) real(dangw) | |
| 258 | + | |
| 270 | 259 | c---output |
| 271 | 260 | open(ifn2,file=fnout,status='unknown',form='formatted') |
| 272 | 261 | do i=1,nwout,1 |
| ... | ... | @@ -286,7 +275,7 @@ c write(62,'(i12,12e18.9)') int(jswout(i)),(ddwout1(j,i),j=1,11) |
| 286 | 275 | c---finish |
| 287 | 276 | deallocate(datain,jsin,dangi,dangi2 |
| 288 | 277 | 1 ,jsout,ddout,jsinref,ang0,dango,dang1,jsoutrev |
| 289 | - 1 ,jswout,ddwout,ddwout1) | |
| 278 | + 1 ,jswout,ddwout,ddwout1,jstmp2) | |
| 290 | 279 | return |
| 291 | 280 | end |
| 292 | 281 | c================================================== | ... | ... |