1! 2! Copyright (C) 2001-2013 Quantum ESPRESSO group 3! This file is distributed under the terms of the 4! GNU General Public License. See the file `License' 5! in the root directory of the present distribution, 6! or http://www.gnu.org/copyleft/gpl.txt . 7! 8! 9 10!this module contains date which defines grids in time and in frequency 11 12 MODULE times_gw 13 USE kinds, only : DP 14 15 TYPE times_freqs 16 INTEGER :: grid_time!0=Gauss Legendre 1=Gauss Laguerre 17 INTEGER :: grid_freq!0=Gauss Legendre 1=Gauss Laguerre 18 INTEGER :: n!number of grid points (total of 2n+1 ) 19 REAL(kind=DP) :: tau!max time 20 REAL(kind=DP) :: omega!max frequency 21 REAL(kind=DP), POINTER :: times(:)!time grid 22 REAL(kind=DP), POINTER :: weights_time(:)!weights on time 23 REAL(kind=DP), POINTER :: freqs(:)!frequency grid 24 REAL(kind=DP), POINTER :: weights_freq(:)!weights on frequency 25 LOGICAL :: l_fft_timefreq!if true uses fft old-style and not grids 26 LOGICAL :: l_fourier_fit_time!if true fits the tails in time 27 LOGICAL :: l_fourier_fit_freq!if true fits the tails in freq 28 REAL(kind=DP) :: r_tau!ratio for finding outer time point 29 REAL(kind=DP) :: r_omega!ratio for finding outer frequency point 30 REAL(kind=DP) :: g_tau!ratio for treating bad cases in time 31 REAL(kind=DP) :: g_omega!ration for treating bad cases in frequency 32 INTEGER :: grid_fit!grid for self energy ON FREQUENCY: uses the same as for P,W, 1 equally spaced, 2 GL 33 REAL(kind=DP) :: omega_fit!max frequency to be considered 34 INTEGER :: n_grid_fit!number of grid points on half-axes 35 REAL(kind=DP), POINTER :: freqs_fit(:)!frequency grid fot fit 36 INTEGER, POINTER :: whois_freq(:)!correspondence for multipoint integration 37 REAL (kind=DP), POINTER :: relative_weight(:)!relative weight for multipoint integration 38 !options for grid_freq=5 39 INTEGER :: second_grid_n=10!sub spacing for second grid 40 INTEGER :: second_grid_i=1!max regular step using the second grid 41 42!variable for second frequency grid (for G) 43 LOGICAL :: l_g_grid!if true use a dedicated grid on frequency for G 44 REAL(kind=DP) :: omega_g! for G: max frequency 45 INTEGER :: n_g!for G grid 46 REAL(kind=DP), POINTER :: freqs_g(:)!frequency grid 47 REAL(kind=DP), POINTER :: weights_freq_g(:)!weights on frequency 48 REAL (kind=DP), POINTER :: relative_weight_g(:)!relative weight for multipoint integration 49 INTEGER :: grid_freq_g!for G grid 50 INTEGER :: second_grid_n_g!for G grid 51 INTEGER :: second_grid_i_g!for G grid 52 INTEGER, POINTER :: whois_freq_g(:)! for G grid 53 REAL(kind=DP), POINTER :: freqs_eff(:)!effective frequency grid 54 REAL(kind=DP), POINTER :: freqs_g_eff(:)!effective frequency grid for G 55 INTEGER :: grid_levels!for grids of type 4 56 END TYPE times_freqs 57 58 59 CONTAINS 60 61 SUBROUTINE free_memory_times_freqs( tf) 62 63 implicit none 64 65 TYPE(times_freqs) :: tf 66 67 if(associated(tf%times)) deallocate(tf%times) 68 if(associated(tf%weights_time)) deallocate(tf%weights_time) 69 if(associated(tf%freqs)) deallocate(tf%freqs) 70 if(associated(tf%weights_freq)) deallocate(tf%weights_freq) 71 if(associated(tf%freqs_fit)) deallocate(tf%freqs_fit) 72 if(associated(tf%whois_freq)) deallocate(tf%whois_freq) 73 if(associated(tf%relative_weight)) deallocate(tf%relative_weight) 74 if(associated(tf%freqs_g)) deallocate(tf%freqs_g) 75 if(associated(tf%relative_weight_g)) deallocate(tf%relative_weight_g) 76 if(associated(tf%weights_freq_g)) deallocate(tf%weights_freq_g) 77 if(associated(tf%freqs_eff)) deallocate(tf%freqs_eff) 78 if(associated(tf%freqs_g_eff)) deallocate(tf%freqs_g_eff) 79 80 return 81 END SUBROUTINE free_memory_times_freqs 82 83 SUBROUTINE setup_timefreq(tf,options) 84!sets up and allocates arrays for grids in time and frequency 85 86 USE input_gw, ONLY : input_options 87 USE io_global, ONLY : stdout 88 USE constants, ONLY : pi 89 90 implicit none 91 92 TYPE(input_options) :: options 93 TYPE(times_freqs) :: tf 94 95 96 REAL(kind=DP), ALLOCATABLE :: x(:),w(:) 97 INTEGER :: i,j,k,l,ii,nn 98 REAL(kind=DP) :: delta 99 100 tf%n = options%n 101 tf%grid_time=options%grid_time 102 tf%grid_freq=options%grid_freq 103 tf%tau=options%tau 104 tf%omega=options%omega 105 tf%l_fft_timefreq=options%l_fft_timefreq 106 107!fit options available only for Gauss-Legendre grid 108 tf%l_fourier_fit_time=options%l_fourier_fit_time 109 tf%l_fourier_fit_freq=options%l_fourier_fit_freq 110 tf%r_tau=options%r_tau 111 tf%r_omega=options%r_omega 112 tf%g_tau=options%g_tau 113 tf%g_omega=options%g_omega 114!options for grid_freq=5 115 tf%second_grid_n=options%second_grid_n 116 tf%second_grid_i=options%second_grid_i 117 118!options for grid_freq=6 119 tf%grid_levels=options%grid_levels 120 121 write(stdout,*) 'DB1',tf%n 122 ! allocate(tf%times(-tf%n:tf%n),tf%weights_time(-tf%n:tf%n)) 123 write(stdout,*) 'DB2' 124 if(tf%grid_freq/=5.and.tf%grid_freq/=6) then 125 allocate(tf%freqs(-tf%n:tf%n),tf%weights_freq(-tf%n:tf%n),tf%freqs_eff(-tf%n:tf%n)) 126 nullify(tf%whois_freq) 127 !nullify(tf%relative_weight) 128 allocate(tf%relative_weight(-nn:nn)) 129 else if (tf%grid_freq==5) then 130 nn=tf%n+tf%second_grid_n*(1+tf%second_grid_i*2) 131 allocate(tf%freqs(-nn:nn),tf%weights_freq(-nn:nn)) 132 allocate(tf%whois_freq(-nn:nn)) 133 allocate(tf%relative_weight(-nn:nn)) 134 allocate(tf%freqs_eff(-nn:nn)) 135 else!grid of type 6 136 if(tf%second_grid_i/=0)then 137 nn=tf%n-tf%second_grid_i+(tf%second_grid_i*tf%second_grid_n-tf%second_grid_i)*tf%grid_levels+tf%second_grid_i 138 else 139 nn=tf%n 140 endif 141 allocate(tf%freqs(-nn:nn),tf%weights_freq(-nn:nn)) 142 allocate(tf%whois_freq(-nn:nn)) 143 allocate(tf%relative_weight(-nn:nn)) 144 allocate(tf%freqs_eff(-nn:nn)) 145 endif 146 write(stdout,*) 'DB3' 147 allocate(x(2*tf%n+1),w(2*tf%n+1)) 148 149 x(:)=0.d0 150 w(:)=0.d0 151 152!frequency grid 153 154 if(tf%grid_freq==0) then!Gauss Legendre 155 if(.not.tf%l_fourier_fit_freq) then 156 call legzo(tf%n*2+1,x,w) 157 tf%freqs(-tf%n:tf%n)=-x(1:2*tf%n+1)*tf%omega 158 tf%weights_freq(-tf%n:tf%n)=w(1:2*tf%n+1)*tf%omega 159 else 160 call legzo(tf%n*2-1,x,w) 161 tf%freqs(-tf%n+1:tf%n-1)=-x(1:2*tf%n-1)*tf%omega 162 tf%weights_freq(-tf%n+1:tf%n-1)=w(1:2*tf%n-1)*tf%omega 163 tf%freqs(-tf%n)=-tf%r_omega*tf%omega 164 tf%freqs(tf%n)=tf%r_omega*tf%omega 165 tf%weights_freq(-tf%n)=0.d0 166 tf%weights_freq(tf%n) =0.d0 167 endif 168 tf%freqs_eff(-tf%n:tf%n)=tf%freqs(-tf%n:tf%n) 169 else if(tf%grid_freq==1) then!Gaus Laguerre 170 call lagzo(tf%n,x,w) 171 tf%freqs(1:tf%n)=x(1:tf%n) 172 do i=1,tf%n 173 tf%freqs(-i)=-tf%freqs(i) 174 enddo 175 tf%freqs(0)=0.d0 176 tf%weights_freq(1:tf%n)=w(1:tf%n)*exp(x(1:tf%n)) 177 do i=1,tf%n 178 tf%weights_freq(-i)=tf%weights_freq(i) 179 enddo 180 tf%weights_freq(0)=0.d0 181 tf%freqs_eff(-tf%n:tf%n)=tf%freqs(-tf%n:tf%n) 182 else if(tf%grid_freq==2) then 183 call legzo(tf%n,x,w) 184 tf%freqs(0)=0.d0 185 tf%freqs(1:tf%n)=(1.d0-x(1:tf%n))*tf%omega/2.d0 186 tf%freqs(-tf%n:-1)=(-1.d0-x(1:tf%n))*tf%omega/2.d0 187 tf%weights_freq(0)=0.d0 188 tf%weights_freq(1:tf%n)=w(1:tf%n)*tf%omega/2.d0 189 tf%weights_freq(-tf%n:-1)=w(1:tf%n)*tf%omega/2.d0 190 tf%freqs_eff(-tf%n:tf%n)=tf%freqs(-tf%n:tf%n) 191 else if (tf%grid_freq==3) then 192 do i=0,tf%n 193 tf%freqs(i)=(tf%omega/dble(tf%n))*dble(i) 194 tf%freqs(-i)=-tf%freqs(i) 195 enddo 196 tf%weights_freq(:)=tf%omega/dble(tf%n) 197 tf%weights_freq(0)=tf%omega/dble(tf%n)/2.d0 198 tf%freqs_eff(-tf%n:tf%n)=tf%freqs(-tf%n:tf%n) 199 else if(tf%grid_freq==4) then 200 do i=1,tf%n 201 tf%freqs(i)=(tf%omega/dble(tf%n))*dble(i)-(0.5d0*tf%omega/dble(tf%n)) 202 tf%freqs(-i)=-tf%freqs(i) 203 enddo 204 tf%freqs(0)=0.d0 205 tf%weights_freq(:)=(tf%omega/dble(tf%n)) 206 tf%weights_freq(0)=0.d0 207 tf%freqs_eff(-tf%n:tf%n)=tf%freqs(-tf%n:tf%n) 208 else if(tf%grid_freq==5) then 209 210 tf%freqs(0)=0.d0 211 tf%relative_weight(0)=0.d0 212 tf%whois_freq(0)=0 213 214 ii=1 215 do i=1,tf%second_grid_n 216 tf%freqs(ii)=(tf%omega/dble(2*tf%second_grid_n*tf%n))*dble(i)-0.5d0*tf%omega/dble(2*tf%second_grid_n*tf%n) 217 tf%relative_weight(ii)=1.d0/dble(2*tf%second_grid_n) 218 tf%whois_freq(ii)=0 219 tf%freqs_eff(ii)=0.d0 220 ii=ii+1 221 enddo 222 do j=1,tf%second_grid_i 223 do i=1,tf%second_grid_n 224 tf%freqs(ii)=(tf%omega/dble(2*tf%second_grid_n*tf%n))*& 225 &dble(i+tf%second_grid_n+2*tf%second_grid_n*(j-1))-0.5d0*tf%omega/dble(2*tf%second_grid_n*tf%n) 226 tf%relative_weight(ii)=1.d0/dble(2*tf%second_grid_n) 227 tf%whois_freq(ii)=j 228 tf%freqs_eff(ii)=tf%omega/dble(tf%n)*dble(j) 229 ii=ii+1 230 enddo 231 tf%freqs(ii)=tf%omega/dble(tf%n)*dble(j) 232 tf%relative_weight(ii)=0.d0 233 tf%whois_freq(ii)=j 234 tf%freqs_eff(ii)=tf%omega/dble(tf%n)*dble(j) 235 ii=ii+1 236 do i=1,tf%second_grid_n 237 tf%freqs(ii)=(tf%omega/dble(2*tf%second_grid_n*tf%n))*dble(i+2*tf%second_grid_n*j)-& 238 &0.5d0*tf%omega/dble(2*tf%second_grid_n*tf%n) 239 tf%relative_weight(ii)=1.d0/dble(2*tf%second_grid_n) 240 tf%whois_freq(ii)=j 241 tf%freqs_eff(ii)=tf%omega/dble(tf%n)*dble(j) 242 ii=ii+1 243 enddo 244 enddo 245 do i=tf%second_grid_i+1,tf%n 246 tf%freqs(ii)=tf%omega/dble(tf%n)*dble(i) 247 tf%relative_weight(ii)=1.d0 248 tf%whois_freq(ii)=i 249 tf%freqs_eff(ii)=tf%omega/dble(tf%n)*dble(i) 250 ii=ii+1 251 enddo 252 ii=ii-1 253 if(ii/=nn) then 254 write(stdout,*) 'ERROR ',nn,ii 255 stop 256 endif 257 do i=1,ii 258 tf%freqs(-i)=-tf%freqs(i) 259 tf%relative_weight(-i)=tf%relative_weight(i) 260 tf%whois_freq(-i)=-tf%whois_freq(i) 261 tf%freqs_eff(-i)=-tf%freqs_eff(i) 262 enddo 263 if(.not.options%l_self_time) then 264 tf%weights_freq(:)=tf%omega/dble(tf%n) 265 else 266 tf%weights_freq(0)=0.d0 267 ii=1 268 do i=1,tf%second_grid_n 269 tf%weights_freq(ii)=tf%omega/dble(tf%n)/dble(2*tf%second_grid_n) 270 ii=ii+1 271 enddo 272 do j=1,tf%second_grid_i 273 do i=1,tf%second_grid_n 274 tf%weights_freq(ii)=tf%omega/dble(tf%n)/dble(2*tf%second_grid_n) 275 ii=ii+1 276 enddo 277 tf%weights_freq(ii)=0.d0 278 ii=ii+1 279 do i=1,tf%second_grid_n 280 tf%weights_freq(ii)=tf%omega/dble(tf%n)/dble(2*tf%second_grid_n) 281 ii=ii+1 282 enddo 283 enddo 284 do i=tf%second_grid_i+1,tf%n 285 tf%weights_freq(ii)=tf%omega/dble(tf%n) 286 ii=ii+1 287 enddo 288 do i=1,nn 289 tf%weights_freq(-i)=tf%weights_freq(i) 290 tf%freqs(-i)=-tf%freqs(i) 291 enddo 292 endif 293 294 else if(tf%grid_freq==6) then 295 296 tf%freqs(0)=0.d0 297 tf%weights_freq(0)=0.d0 298 tf%relative_weight(0)=0.d0 299 tf%whois_freq(0)=0 300 ii=1 301 do l=1,tf%grid_levels 302 if(l==1) then 303 k=1 304 else 305 k=tf%second_grid_i+1 306 endif 307 do j=k,tf%second_grid_n*tf%second_grid_i 308 delta=(tf%omega/dble(tf%n))/(dble(tf%second_grid_n)**(tf%grid_levels-l+1)) 309 tf%freqs(ii)=delta*dble(j)-delta/2.d0 310 tf%weights_freq(ii)=delta 311 ii=ii+1 312 enddo 313 enddo 314 delta=(tf%omega/dble(tf%n)) 315 if(tf%grid_levels==0) then 316 j=1 317 else 318 j=tf%second_grid_i+1 319 endif 320 do i=j,tf%n 321 tf%freqs(ii)=delta*dble(i)-delta/2.d0 322 tf%weights_freq(ii)=delta 323 ii=ii+1 324 enddo 325 ii=ii-1 326 if(ii/=nn) then 327 write(stdout,*) 'ERROR ',nn,ii 328 stop 329 endif 330 do i=1,nn 331 tf%weights_freq(-i)=tf%weights_freq(i) 332 tf%freqs(-i)=-tf%freqs(i) 333 enddo 334 tf%freqs_eff(-nn:nn)=tf%freqs(-nn:nn) 335 336 else if(tf%grid_freq==7) then 337 do i=1,tf%n 338 tf%freqs(i)=tf%omega*tan(pi/2.d0/dble(tf%n+1)*dble(i-1)+pi/4.d0/dble(tf%n+1)) 339 tf%weights_freq(i)=tf%omega*tan(pi/2.d0/dble(tf%n+1)*dble(i))-tf%omega*tan(pi/2.d0/dble(tf%n+1)*dble(i-1)) 340 tf%freqs(-i)=-tf%freqs(i) 341 tf%weights_freq(-i)=tf%weights_freq(i) 342 enddo 343 tf%freqs(0)=0.d0 344 tf%weights_freq(0)=0.d0 345 tf%freqs_eff(-tf%n:tf%n)=tf%freqs(-tf%n:tf%n) 346 347 endif 348 deallocate(x,w) 349 350!setup frequency grid for fit 351 352 if(.not.(options%l_self_lanczos .and. options%l_lanczos_conv.and. .not.options%l_self_time)) then 353 tf%grid_fit=options%grid_fit 354 tf%omega_fit=options%omega_fit 355 tf%n_grid_fit=options%n_grid_fit 356 else 357 tf%grid_fit=1 358 tf%omega_fit=tf%omega 359 tf%n_grid_fit=tf%n 360 endif 361 if(tf%grid_fit==0) then 362 tf%omega_fit=tf%omega 363 tf%n_grid_fit=tf%n 364 endif 365 allocate(tf%freqs_fit(-tf%n_grid_fit:tf%n_grid_fit)) 366 if(tf%grid_fit==0) then 367 tf%freqs_fit(:)=tf%freqs(:) 368 else if(tf%grid_fit==1) then 369 do i=-tf%n_grid_fit,tf%n_grid_fit 370 tf%freqs_fit(i)=(tf%omega_fit/dble(tf%n_grid_fit))*dble(i) 371 enddo 372 else if(tf%grid_fit==2) then 373 allocate(x(2*tf%n_grid_fit+1),w(2*tf%n_grid_fit+1)) 374 x(:)=0.d0 375 w(:)=0.d0 376 write(stdout,*) 'CALL LEGZO', tf%n_grid_fit*2+1 377 call legzo(tf%n_grid_fit*2+1,x,w) 378 write(stdout,*) 'CALLED LEGZO' 379 tf%freqs_fit(-tf%n_grid_fit:tf%n_grid_fit)=-x(1:2*tf%n_grid_fit+1)*tf%omega_fit 380 deallocate(x,w) 381 endif 382 383 384!IN CASE 5 REDEFINE THE TOTAL NUMBER OF FREQUENCIES: 385 if(tf%grid_freq==5.or.tf%grid_freq==6) then 386 tf%n=nn 387 options%n=nn 388 endif 389 390!time grid 391 allocate(x(2*tf%n+1),w(2*tf%n+1)) 392 393 x(:)=0.d0 394 w(:)=0.d0 395 396 397 allocate(tf%times(-tf%n:tf%n),tf%weights_time(-tf%n:tf%n)) 398 if(tf%grid_time==0) then!Gauss Legendre 399 if(.not.tf%l_fourier_fit_time) then 400 call legzo(tf%n*2+1,x,w) 401 tf%times(-tf%n:tf%n)=-x(1:2*tf%n+1)*tf%tau 402 tf%weights_time(-tf%n:tf%n)=w(1:2*tf%n+1)*tf%tau 403 else 404 call legzo(tf%n*2+1-2,x,w) 405 tf%times(-tf%n+1:tf%n-1)=-x(1:2*tf%n-1)*tf%tau 406 tf%weights_time(-tf%n+1:tf%n-1)=w(1:2*tf%n-1)*tf%tau 407 tf%times(-tf%n)=-tf%r_tau*tf%tau 408 tf%times(tf%n)=tf%r_tau*tf%tau 409 tf%weights_time(-tf%n)=0.d0 410 tf%weights_time(tf%n)=0.d0 411 endif 412 do i=-tf%n,tf%n 413 write(stdout,*) 'TIME:',i, tf%times(i),tf%weights_time(i) 414 enddo 415 else if(tf%grid_time==1) then!Gaus Laguerre 416 call lagzo(tf%n,x,w) 417 tf%times(1:tf%n)=x(1:tf%n) 418 do i=1,tf%n 419 tf%times(-i)=-tf%times(i) 420 enddo 421 tf%times(0)=0.d0 422 tf%weights_time(1:tf%n)=w(1:tf%n)*exp(x(1:tf%n)) 423 do i=1,tf%n 424 tf%weights_time(-i)=tf%weights_time(i) 425 enddo 426 tf%weights_time(0)=0.d0 427 else if(tf%grid_time==2) then 428 call legzo(tf%n,x,w) 429 tf%times(0)=0.d0 430 tf%times(1:tf%n)=(1.d0-x(1:tf%n))*tf%tau/2.d0 431 tf%times(-tf%n:-1)=(-1.d0-x(1:tf%n))*tf%tau/2.d0 432 tf%weights_time(0)=0.d0 433 tf%weights_time(1:tf%n)=w(1:tf%n)*tf%tau/2.d0 434 tf%weights_time(-tf%n:-1)=w(1:tf%n)*tf%tau/2.d0 435 436 else if(tf%grid_time==3) then 437 do i=0,tf%n 438 tf%times(i)=(tf%tau/dble(tf%n))*dble(i) 439 tf%times(-i)=-tf%times(i) 440 enddo 441 tf%weights_time(:)=tf%tau/dble(tf%n) 442 else if(tf%grid_time==4) then 443 do i=1,tf%n 444 tf%times(i)=tf%tau/dble(tf%n)*dble(i)-(0.5d0*tf%tau/dble(tf%n)) 445 tf%times(-i)=-tf%times(i) 446 enddo 447 tf%times(0)=0.d0 448 tf%weights_time(:)=(tf%tau/dble(tf%n)) 449 tf%weights_time(0)=0.d0 450 endif 451 452 deallocate(x,w) 453 454!options for G grid 455 tf%l_g_grid=options%l_g_grid 456 457 if(tf%l_g_grid) then 458 tf%n_g=options%n_g 459 tf%grid_freq_g=options%grid_freq_g 460 tf%second_grid_n_g=options%second_grid_n_g 461 tf%second_grid_i_g=options%second_grid_i_g 462 tf%omega_g=options%omega_g 463 464 465 if(tf%grid_freq_g/=5) then 466 allocate(tf%freqs_g(-tf%n_g:tf%n_g),tf%weights_freq(-tf%n_g:tf%n_g),tf%freqs_g_eff(-tf%n_g:tf%n_g)) 467 nullify(tf%whois_freq_g) 468 nullify(tf%relative_weight_g) 469 else 470 nn=tf%n_g+tf%second_grid_n_g*(1+tf%second_grid_i_g*2) 471 allocate(tf%freqs_g(-nn:nn),tf%weights_freq_g(-nn:nn)) 472 allocate(tf%whois_freq_g(-nn:nn)) 473 allocate(tf%relative_weight_g(-nn:nn)) 474 allocate(tf%freqs_g_eff(-nn:nn)) 475 endif 476 477 allocate(x(2*tf%n_g+1),w(2*tf%n_g+1)) 478 x(:)=0.d0 479 w(:)=0.d0 480 481 if(tf%grid_freq_g==0) then!Gauss Legendre 482 call legzo(tf%n_g*2+1,x,w) 483 tf%freqs_g(-tf%n_g:tf%n_g)=-x(1:2*tf%n_g+1)*tf%omega_g 484 tf%weights_freq_g(-tf%n_g:tf%n_g)=w(1:2*tf%n_g+1)*tf%omega_g 485 tf%freqs_g_eff(-tf%n_g:tf%n_g)=tf%freqs_g(-tf%n_g:tf%n_g) 486 else if(tf%grid_freq_g==1) then!Gaus Laguerre 487 call lagzo(tf%n_g,x,w) 488 tf%freqs_g(1:tf%n_g)=x(1:tf%n_g) 489 do i=1,tf%n_g 490 tf%freqs_g(-i)=-tf%freqs_g(i) 491 enddo 492 tf%freqs_g(0)=0.d0 493 tf%weights_freq_g(1:tf%n_g)=w(1:tf%n_g)*exp(x(1:tf%n_g)) 494 do i=1,tf%n_g 495 tf%weights_freq_g(-i)=tf%weights_freq_g(i) 496 enddo 497 tf%weights_freq_g(0)=0.d0 498 tf%freqs_g_eff(-tf%n_g:tf%n_g)=tf%freqs_g(-tf%n_g:tf%n_g) 499 else if(tf%grid_freq_g==2) then 500 call legzo(tf%n_g,x,w) 501 tf%freqs_g(0)=0.d0 502 tf%freqs_g(1:tf%n_g)=(1.d0-x(1:tf%n_g))*tf%omega_g/2.d0 503 tf%freqs_g(-tf%n_g:-1)=(-1.d0-x(1:tf%n_g))*tf%omega_g/2.d0 504 tf%weights_freq_g(0)=0.d0 505 tf%weights_freq_g(1:tf%n_g)=w(1:tf%n_g)*tf%omega_g/2.d0 506 tf%weights_freq_g(-tf%n_g:1)=w(1:tf%n_g)*tf%omega_g/2.d0 507 tf%freqs_g_eff(-tf%n_g:tf%n_g)=tf%freqs_g(-tf%n_g:tf%n_g) 508 else if (tf%grid_freq_g==3) then 509 do i=0,tf%n_g 510 tf%freqs_g(i)=(tf%omega_g/dble(tf%n_g))*dble(i) 511 tf%freqs_g(-i)=-tf%freqs_g(i) 512 enddo 513 tf%weights_freq_g(:)=tf%omega_g/dble(tf%n_g) 514 tf%freqs_g_eff(-tf%n_g:tf%n_g)=tf%freqs_g(-tf%n_g:tf%n_g) 515 else if(tf%grid_freq_g==4) then 516 do i=1,tf%n_g 517 tf%freqs_g(i)=(tf%omega_g/dble(tf%n_g))*dble(i)-(0.5d0*tf%omega_g/dble(tf%n_g)) 518 tf%freqs_g(-i)=-tf%freqs_g(i) 519 enddo 520 tf%freqs_g(0)=0.d0 521 tf%weights_freq_g(:)=(tf%omega_g/dble(tf%n_g)) 522 tf%weights_freq_g(0)=0.d0 523 tf%freqs_g_eff(-tf%n_g:tf%n_g)=tf%freqs_g(-tf%n_g:tf%n_g) 524 else if(tf%grid_freq_g==5) then 525 tf%freqs_g(0)=0.d0 526 tf%relative_weight_g(0)=0.d0 527 tf%whois_freq_g(0)=0 528 529 ii=1 530 do i=1,tf%second_grid_n_g 531 tf%freqs_g(ii)=(tf%omega_g/dble(2*tf%second_grid_n_g*tf%n_g))*dble(i)-& 532 &0.5d0*tf%omega_g/dble(2*tf%second_grid_n_g*tf%n_g) 533 tf%relative_weight_g(ii)=1.d0/dble(2*tf%second_grid_n_g) 534 tf%whois_freq_g(ii)=0 535 tf%freqs_g_eff(ii)=0.d0 536 ii=ii+1 537 enddo 538 do j=1,tf%second_grid_i_g 539 do i=1,tf%second_grid_n_g 540 tf%freqs_g(ii)=(tf%omega_g/dble(2*tf%second_grid_n_g*tf%n_g))*& 541 &dble(i+tf%second_grid_n_g+2*tf%second_grid_n_g*(j-1))-0.5d0*tf%omega_g/dble(2*tf%second_grid_n_g*tf%n_g) 542 tf%relative_weight_g(ii)=1.d0/dble(2*tf%second_grid_n_g) 543 tf%whois_freq_g(ii)=j 544 tf%freqs_g_eff(ii)=tf%omega_g/dble(tf%n_g)*dble(j) 545 ii=ii+1 546 enddo 547 tf%freqs_g(ii)=tf%omega_g/dble(tf%n_g)*dble(j) 548 tf%relative_weight_g(ii)=0.d0 549 tf%whois_freq_g(ii)=j 550 tf%freqs_g_eff(ii)=tf%omega_g/dble(tf%n_g)*dble(j) 551 ii=ii+1 552 do i=1,tf%second_grid_n_g 553 tf%freqs_g(ii)=(tf%omega_g/dble(2*tf%second_grid_n_g*tf%n_g))*& 554 &dble(i+2*tf%second_grid_n_g*j)-0.5d0*tf%omega_g/dble(2*tf%second_grid_n_g*tf%n_g) 555 tf%relative_weight_g(ii)=1.d0/dble(2*tf%second_grid_n_g) 556 tf%whois_freq_g(ii)=j 557 tf%freqs_g_eff(ii)=tf%omega_g/dble(tf%n_g)*dble(j) 558 ii=ii+1 559 enddo 560 enddo 561 do i=tf%second_grid_i_g+1,tf%n_g 562 tf%freqs_g(ii)=tf%omega_g/dble(tf%n_g)*dble(i) 563 tf%relative_weight_g(ii)=1.d0 564 tf%whois_freq_g(ii)=i 565 tf%freqs_g_eff(ii)=tf%omega_g/dble(tf%n_g)*dble(i) 566 ii=ii+1 567 enddo 568 ii=ii-1 569 if(ii/=nn) then 570 write(stdout,*) 'ERROR ',nn,ii 571 stop 572 endif 573 do i=1,ii 574 tf%freqs_g(-i)=-tf%freqs_g(i) 575 tf%relative_weight_g(-i)=tf%relative_weight_g(i) 576 tf%whois_freq_g(-i)=-tf%whois_freq_g(i) 577 tf%freqs_g_eff(-i)= tf%freqs_g_eff(i) 578 enddo 579 if(.not.options%l_self_time) then 580 tf%weights_freq_g(:)=tf%omega_g/dble(tf%n_g) 581 else 582 tf%weights_freq_g(0)=0.d0 583 ii=1 584 do i=1,tf%second_grid_n_g 585 tf%weights_freq_g(ii)=tf%omega_g/dble(tf%n_g)/dble(2*tf%second_grid_n_g) 586 ii=ii+1 587 enddo 588 do j=1,tf%second_grid_i_g 589 do i=1,tf%second_grid_n_g 590 tf%weights_freq_g(ii)=tf%omega_g/dble(tf%n_g)/dble(2*tf%second_grid_n_g) 591 ii=ii+1 592 enddo 593 tf%weights_freq_g(ii)=0.d0 594 ii=ii+1 595 do i=1,tf%second_grid_n_g 596 tf%weights_freq_g(ii)=tf%omega_g/dble(tf%n_g)/dble(2*tf%second_grid_n_g) 597 ii=ii+1 598 enddo 599 enddo 600 do i=tf%second_grid_i_g+1,tf%n_g 601 tf%weights_freq_g(ii)=tf%omega_g/dble(tf%n_g) 602 ii=ii+1 603 enddo 604 do i=1,nn 605 tf%weights_freq_g(-i)=tf%weights_freq_g(i) 606 tf%freqs_g(-i)=-tf%freqs_g(i) 607 enddo 608 endif 609 tf%n_g=nn 610 611 endif 612 613 deallocate(x,w) 614 615 else 616 allocate(tf%freqs_g(-tf%n:tf%n),tf%weights_freq_g(-tf%n:tf%n),tf%freqs_g_eff(-tf%n:tf%n)) 617 allocate(tf%whois_freq_g(-tf%n:tf%n)) 618 allocate(tf%relative_weight_g(-tf%n:tf%n)) 619 tf%freqs_g(-tf%n:tf%n)= tf%freqs(-tf%n:tf%n) 620 tf%freqs_g_eff(-tf%n:tf%n)= tf%freqs_eff(-tf%n:tf%n) 621 tf%weights_freq_g(-tf%n:tf%n)=tf%weights_freq(-tf%n:tf%n) 622 tf%relative_weight_g(-tf%n:tf%n)=tf%relative_weight(-tf%n:tf%n) 623 tf%omega_g=tf%omega 624 tf%n_g=tf%n 625 tf%grid_freq_g=tf%grid_freq 626 tf%second_grid_n_g=tf%second_grid_n 627 tf%second_grid_i_g=tf%second_grid_i 628 629 endif 630 write(stdout,*) 'N:', tf%n,tf%n_g 631 write(stdout,*) 'Omega:', tf%omega,tf%omega_g 632 FLUSH(stdout) 633 do i=-tf%n,tf%n 634 write(stdout,*)'freq:',i, tf%freqs(i),tf%freqs_g(i) 635 write(stdout,*)'weight:',i, tf%weights_freq(i),tf%weights_freq_g(i) 636 FLUSH(stdout) 637 enddo 638 639 return 640 641 END SUBROUTINE setup_timefreq 642 643 END MODULE times_gw 644