← Back to branch summary

~maddevelopers/mg5amcnlo/3.0.2

« back to all changes in this revision

Viewing changes to vendor/CutTools/src/cts/cts_kinematics.f90

  • Committer: Marco Zaro
  • Date: 2014-01-27 16:54:10 UTC
  • mfrom: (78.124.55 MG5_aMC_2.1)
  • Revision ID: marco.zaro@gmail.com-20140127165410-5lma8c2hzbzm426j
merged with lp:~maddevelopers/madgraph5/MG5_aMC_2.1 r 267

Show diffs side-by-side

added added

removed removed

Lines of Context:
vendor/CutTools/src/cts/cts_kinematics.f90
41
41
   , dimension(:,:), public, allocatable :: vden
42
42
  include 'cts_mpc.h'
43
43
   , dimension(:,:), public, allocatable :: mp_vden
44
 
  integer, private :: ierr
 
44
  integer, private :: ierr,icomp1,icomp2
45
45
  save den,vden
46
46
!
47
47
  interface load_denominators
165
165
  subroutine dp_allocate_den
166
166
   use dimensions
167
167
   use maxsolutions
 
168
   ierr= -1
168
169
   allocate (vden(1:dmns_a, max_solutions), stat=ierr)
169
170
   allocate (den(1:dmns_a), stat=ierr)
 
171
   if (ierr.ne.0) STOP "Allocation error in dp_allocate_den"
 
172
   vden= 0.d0
 
173
   do icomp2= 1,dmns_a
 
174
    den(icomp2)%i= 0
 
175
    den(icomp2)%m2= 0.d0
 
176
    den(icomp2)%p(0)= 0.d0
 
177
    den(icomp2)%p(1)= 0.d0
 
178
    den(icomp2)%p(2)= 0.d0
 
179
    den(icomp2)%p(3)= 0.d0
 
180
   enddo
170
181
  end subroutine dp_allocate_den
171
182
!
172
183
  subroutine mp_allocate_den
173
184
   use dimensions
174
185
   use maxsolutions
 
186
   ierr= -1
175
187
   allocate (mp_vden(1:dmns_a, max_solutions), stat=ierr)
176
188
   allocate (mp_den(1:dmns_a), stat=ierr)
 
189
   if (ierr.ne.0) STOP "Allocation error in mp_allocate_den"
 
190
   do icomp2= 1,dmns_a
 
191
    do icomp1= 1,max_solutions 
 
192
      mp_vden(icomp2,icomp1)= 0.d0
 
193
    enddo
 
194
    mp_den(icomp2)%i= 0
 
195
    mp_den(icomp2)%m2= 0.d0
 
196
    mp_den(icomp2)%p(0)= 0.d0
 
197
    mp_den(icomp2)%p(1)= 0.d0
 
198
    mp_den(icomp2)%p(2)= 0.d0
 
199
    mp_den(icomp2)%p(3)= 0.d0
 
200
   enddo
177
201
  end subroutine mp_allocate_den
178
202
!
179
203
  subroutine dp_load_vden(q,i,j,p0,m20)
2070
2094
  implicit none
2071
2095
  private
2072
2096
  public :: get_coefficients,dp_allocate_arrays,mp_allocate_arrays
2073
 
  integer, private :: ierr
 
2097
  integer, private :: ierr,icomp1,icomp2
2074
2098
!
2075
2099
! variables for the rational terms
2076
2100
!
2306
2330
  end subroutine dp_allocate_arrays
2307
2331
!
2308
2332
  subroutine dp_allocate_vectorsd
 
2333
   ierr= -1
2309
2334
   allocate      (p0vecd(0:3,dmns_d), stat=ierr)
2310
2335
   allocate      (dcoeff(0:1,dmns_d), stat=ierr)
2311
2336
   allocate (save_dcoeff(0:1,dmns_d), stat=ierr)
2312
2337
   allocate        (tvec(0:3,dmns_d), stat=ierr)
 
2338
   if (ierr.ne.0) STOP "Allocation error in dp_allocate_vectorsd"
 
2339
   p0vecd= 0.d0
 
2340
   dcoeff= 0.d0
 
2341
   save_dcoeff= 0.d0
 
2342
   tvec= 0.d0
2313
2343
  end subroutine dp_allocate_vectorsd
2314
2344
!
2315
2345
  subroutine dp_allocate_vectorsc
 
2346
   ierr= -1
2316
2347
   allocate      (p0vecc(0:3,dmns_c), stat=ierr)
2317
2348
   allocate       (l3vec(0:3,dmns_c), stat=ierr)  
2318
2349
   allocate       (l4vec(0:3,dmns_c), stat=ierr)  
2320
2351
   allocate    (ccoeff_2(0:2,dmns_c), stat=ierr)
2321
2352
   allocate (save_ccoeff(0:6,dmns_c), stat=ierr)
2322
2353
   allocate         (c4_rat1(dmns_c), stat=ierr)  
 
2354
   if (ierr.ne.0) STOP "Allocation error in dp_allocate_vectorsc"
 
2355
   p0vecc= 0.d0
 
2356
   l3vec= 0.d0  
 
2357
   l4vec= 0.d0  
 
2358
   ccoeff= 0.d0
 
2359
   ccoeff_2= 0.d0
 
2360
   save_ccoeff= 0.d0
 
2361
   c4_rat1= 0.d0  
2323
2362
  end subroutine dp_allocate_vectorsc
2324
2363
!
2325
2364
  subroutine dp_allocate_vectorsb
 
2365
   ierr= -1
2326
2366
   allocate      (p0vecb(0:3,dmns_b), stat=ierr)
2327
2367
   allocate       (l5vec(0:3,dmns_b), stat=ierr)  
2328
2368
   allocate       (l6vec(0:3,dmns_b), stat=ierr)  
2333
2373
   allocate          (vveck1(dmns_b), stat=ierr)
2334
2374
   allocate          (b_rat1(dmns_b), stat=ierr)
2335
2375
   allocate         (b3_rat1(dmns_b), stat=ierr)
 
2376
   if (ierr.ne.0) STOP "Allocation error in dp_allocate_vectorsb"
 
2377
   p0vecb= 0.d0
 
2378
   l5vec= 0.d0  
 
2379
   l6vec= 0.d0  
 
2380
   bcoeff= 0.d0
 
2381
   bcoeff_2= 0.d0
 
2382
   save_bcoeff= 0.d0
 
2383
   vvecb= 0.d0
 
2384
   vveck1= 0.d0
 
2385
   b_rat1= 0.d0
 
2386
   b3_rat1= 0.d0
2336
2387
  end subroutine dp_allocate_vectorsb
2337
2388
!
2338
2389
  subroutine dp_allocate_vectorsa
 
2390
   ierr= -1
2339
2391
   allocate  (vveca(0:3,dmns_a),      stat=ierr)
2340
2392
   allocate (p0veca(0:3,dmns_a),      stat=ierr)
2341
2393
   allocate  (l7vec(0:3,dmns_a),      stat=ierr)  
2345
2397
   allocate (save_acoeff(0:4,dmns_a), stat=ierr)
2346
2398
   allocate   (kvec(0:3,dmns_a),      stat=ierr) 
2347
2399
   allocate     (a_rat1(dmns_a),      stat=ierr) 
 
2400
   if (ierr.ne.0) STOP "Allocation error in dp_allocate_vectorsa"
 
2401
   vveca= 0.d0
 
2402
   p0veca= 0.d0
 
2403
   l7vec= 0.d0 
 
2404
   l8vec= 0.d0 
 
2405
   acoeff= 0.d0
 
2406
   acoeff_2= 0.d0
 
2407
   save_acoeff= 0.d0
 
2408
   kvec= 0.d0
 
2409
   a_rat1= 0.d0 
2348
2410
  end subroutine dp_allocate_vectorsa
2349
2411
!
2350
2412
  subroutine mp_allocate_arrays(np)
2356
2418
  end subroutine mp_allocate_arrays
2357
2419
!
2358
2420
  subroutine mp_allocate_vectorsd
 
2421
   ierr= -1
2359
2422
   allocate (mp_p0vecd(0:3,dmns_d), stat=ierr)
2360
2423
   allocate (mp_dcoeff(0:1,dmns_d), stat=ierr)
2361
2424
   allocate (save_mp_dcoeff(0:1,dmns_d), stat=ierr)
2362
2425
   allocate (mp_tvec(0:3,dmns_d), stat=ierr)
 
2426
   if (ierr.ne.0) STOP "Allocation error in mp_allocate_vectorsd"
 
2427
   do icomp2= 1,dmns_d
 
2428
    do icomp1= 0,3
 
2429
     mp_p0vecd(icomp1,icomp2)= 0.d0
 
2430
     mp_tvec(icomp1,icomp2)= 0.d0
 
2431
    enddo
 
2432
    do icomp1= 0,1
 
2433
     mp_dcoeff(icomp1,icomp2)= 0.d0
 
2434
     save_mp_dcoeff(icomp1,icomp2)= 0.d0
 
2435
    enddo
 
2436
   enddo
2363
2437
  end subroutine mp_allocate_vectorsd
2364
2438
!
2365
2439
  subroutine mp_allocate_vectorsc
 
2440
   ierr= -1
2366
2441
   allocate      (mp_p0vecc(0:3,dmns_c), stat=ierr)
2367
2442
   allocate       (mp_l3vec(0:3,dmns_c), stat=ierr)  
2368
2443
   allocate       (mp_l4vec(0:3,dmns_c), stat=ierr)  
2370
2445
   allocate    (mp_ccoeff_2(0:2,dmns_c), stat=ierr)
2371
2446
   allocate (save_mp_ccoeff(0:6,dmns_c), stat=ierr)
2372
2447
   allocate         (mp_c4_rat1(dmns_c), stat=ierr)  
 
2448
   if (ierr.ne.0) STOP "Allocation error in mp_allocate_vectorsc"
 
2449
   do icomp2= 1,dmns_c
 
2450
    do icomp1= 0,3
 
2451
     mp_p0vecc(icomp1,icomp2)= 0.d0
 
2452
     mp_l3vec(icomp1,icomp2)= 0.d0 
 
2453
     mp_l4vec(icomp1,icomp2)= 0.d0  
 
2454
    enddo
 
2455
    do icomp1= 0,6
 
2456
     mp_ccoeff(icomp1,icomp2)= 0.d0 
 
2457
     save_mp_ccoeff(icomp1,icomp2)= 0.d0 
 
2458
    enddo
 
2459
    do icomp1= 0,2
 
2460
     mp_ccoeff_2(icomp1,icomp2)= 0.d0
 
2461
    enddo
 
2462
    mp_c4_rat1(icomp2)= 0.d0
 
2463
   enddo
2373
2464
  end subroutine mp_allocate_vectorsc
2374
2465
!
2375
2466
  subroutine mp_allocate_vectorsb
 
2467
   ierr= -1
2376
2468
   allocate      (mp_p0vecb(0:3,dmns_b), stat=ierr)
2377
2469
   allocate       (mp_l5vec(0:3,dmns_b), stat=ierr)  
2378
2470
   allocate       (mp_l6vec(0:3,dmns_b), stat=ierr)  
2383
2475
   allocate          (mp_vveck1(dmns_b), stat=ierr)
2384
2476
   allocate          (mp_b_rat1(dmns_b), stat=ierr)
2385
2477
   allocate         (mp_b3_rat1(dmns_b), stat=ierr)
 
2478
   if (ierr.ne.0) STOP "Allocation error in mp_allocate_vectorsb"
 
2479
   do icomp2= 1,dmns_b
 
2480
    do icomp1= 0,3
 
2481
     mp_p0vecb(icomp1,icomp2)= 0.d0
 
2482
     mp_l5vec(icomp1,icomp2)= 0.d0
 
2483
     mp_l6vec(icomp1,icomp2)= 0.d0
 
2484
     mp_vvecb(icomp1,icomp2)= 0.d0
 
2485
    enddo 
 
2486
    do icomp1= 0,8
 
2487
     mp_bcoeff(icomp1,icomp2)= 0.d0
 
2488
     save_mp_bcoeff(icomp1,icomp2)= 0.d0 
 
2489
    enddo
 
2490
    mp_bcoeff_2(icomp2)= 0.d0
 
2491
    mp_vveck1(icomp2)= 0.d0
 
2492
    mp_b_rat1(icomp2)= 0.d0
 
2493
    mp_b3_rat1(icomp2)= 0.d0
 
2494
   enddo
2386
2495
  end subroutine mp_allocate_vectorsb
2387
2496
!
2388
2497
  subroutine mp_allocate_vectorsa
 
2498
   ierr= -1
2389
2499
   allocate  (mp_vveca(0:3,dmns_a)     , stat=ierr)
2390
2500
   allocate (save_mp_acoeff(0:4,dmns_a), stat=ierr)
2391
2501
   allocate (mp_p0veca(0:3,dmns_a),      stat=ierr)
2394
2504
   allocate (mp_acoeff(0:4,dmns_a),      stat=ierr)
2395
2505
   allocate   (mp_kvec(0:3,dmns_a),      stat=ierr) 
2396
2506
   allocate     (mp_a_rat1(dmns_a),      stat=ierr) 
 
2507
   if (ierr.ne.0) STOP "Allocation error in mp_allocate_vectorsa"
 
2508
   do icomp2= 1,dmns_a
 
2509
    do icomp1= 0,3
 
2510
     mp_vveca(icomp1,icomp2)= 0.d0
 
2511
     mp_p0veca(icomp1,icomp2)= 0.d0
 
2512
     mp_l7vec(icomp1,icomp2)= 0.d0
 
2513
     mp_l8vec(icomp1,icomp2)= 0.d0
 
2514
     mp_kvec(icomp1,icomp2)= 0.d0
 
2515
    enddo
 
2516
    do icomp1= 0,4
 
2517
     save_mp_acoeff(icomp1,icomp2)= 0.d0
 
2518
     mp_acoeff(icomp1,icomp2)= 0.d0
 
2519
    enddo
 
2520
    mp_a_rat1(icomp2)= 0.d0
 
2521
   enddo
2397
2522
  end subroutine mp_allocate_vectorsa
2398
2523
! 
2399
2524
  subroutine dp_get_coefficients(p,numdummy,number_propagators,dmr,ql)