forked from gravitationalwave01/eDDA
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathddscat.f90
2788 lines (2463 loc) · 109 KB
/
ddscat.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
PROGRAM DDSCAT
!-------------------------------- v7.1.0 -------------------------------
USE DDPRECISION,ONLY: WP
USE DDCOMMON_1,ONLY: AKR,DX
USE DDCOMMON_2,ONLY: CXADIA
USE DDCOMMON_3,ONLY: CXZC
USE DDCOMMON_4,ONLY: CXZW
USE DDCOMMON_5,ONLY: IOCC
USE DDCOMMON_6,ONLY: GAMMA,PYD,PZD,MXNATF,MXNXF,MXNYF,MXNZF,NAT,NAT3, &
NAT0,NX,NY,NZ,MXN3F,IDVOUT,IPBC
USE DDCOMMON_7,ONLY: CXAOFF
USE DDCOMMON_8,ONLY: CMDFFT
USE DDCOMMON_10,ONLY: MYID
IMPLICIT NONE
!-----------------------------------------------------------------------
! Instructions for Enabling or Disabling MPI
! ==========================================
! To enable MPI use (this requires that you have installed the "full"
! version of DDSCAT):
! uncomment INCLUDE 'mpif.h' statement
! comment out INTEGER MPI_COMM_WORLD statement
! compile mpi_subs.f
! For non-MPI version (either the "plain" version of DDSCAT, or the
! "full" version with MPI support disabled:
! comment out INCLUDE 'mpif.h' statement
! uncomment INTEGER MPI_COMM_WORLD statement
! compile mpi_fake.f
#ifdef mpi
INCLUDE 'mpif.h'
#endif
#ifndef mpi
INTEGER :: MPI_COMM_WORLD
#endif
!-----------------------------------------------------------------------
!**********************************************************************
! DDSCAT is a program to use the Discrete Dipole Approximation (DDA)
! to calculate the absorption and scattering properties of targets
! of arbitrary geometry and dielectric properties. The only
! approximation is that the target may be approximated by an array
! of point dipoles on a cubic lattice.
! DDA theory and validity criteria are discussed in
! Draine, B.T. 1988,
! "The Discrete-Dipole Approximation and its Application to
! Interstellar Graphite Grains",
! Astrophys. J., 333, pp. 848-872
! Draine, B.T., & Flatau, P.J. 1994,
! "Discrete dipole approximation for scattering calculations",
! J. Opt. Soc. Am. A, 11, 1491-1499
! The original version of DDSCAT was developed by B. T. Draine,
! Princeton University Observatory.
! Subsequent versions of DDSCAT were jointly developed by
! B. T. Draine (Princeton University Observatory) and
! P. J. Flatau (University of California, San Diego, Scripps Inst.
! of Oceanography, La Jolla)
! DDSCAT.7.0.4 includes the following features:
! 1. Optional generation of target arrays for to approximate several
! standard target shapes, including
! a. ellipsoid (sphere is special case) ("ELLIPSOID")
! b. cylindrical prism ("CYLINDER1")
! c. rectangular prism ("RCTGLPRSM")
! d. hexagonal prism ("HEX_PRISM")
! e. regular tetrahedron ("TETRAHDRN")
! f. cylindrical prism with anisotropic diel. tensor ("UNIAXICYL")
! (uniaxial material with crystal axis = cylinder axis)
! g. ellipsoid with anisotropic diel. tensor ("ANIELLIPS")
! h. two touching ellipsoids with either isotropic or aniostropic
! dielectric tensors ("ELLIPSO_2" or "ANI_ELL_2")
! i. three thouching ellipsoids with either isotropic or aniostrop
! dielectric constants ("ELLIPSO_3" or "ANI_ELL_3")
! j. two concentric ellipsoids ("CONELLIPS")
! k. target consisting of cubic blocks ("MULTBLOKS")
! l. target consisting of union of N spheres ("SPHERES_N")
! m. triangular prism ("TRNGLPRSM")
! n. layered slab ("LAYRDSLAB")
! ... and additional target options (see UserGuide)
! 2. Alternatively, program may read in target array properties from
! ascii file ("FROM_FILE")
! 3. User may easily specify target orientation with respect to
! incident plane wave.
! 4. Solution is found iteratively using Complex Conjugate Gradient
! methods.
! 5. User may select FFT implementation:
! a. GPFA code of Temperton (recommended for general use).
! b. FFTW code of Frigo and Johnson
! c. Convex vector library implementation (if on Convex);
! 6. User may select prescription for determining dipole
! polarizabilities:
! a. 'LATTDR' = Lattice Dispersion Relation of
! Draine & Goodman 1993
! b. 'GKDLDR' = Lattice Dispersion Relation of
! Gutkowicz-Krusin & Draine 2004
! 7. Automatic computation of cross sections for:
! a. absorption;
! b. extinction;
! c. scattering;
! d. vector radiation pressure;
! e. vector torque.
! 8. User may easily specify scattering directions for which
! scattering matrixs is to be computed.
! 9. Automatic computation of orientational averages, with
! orientation weights provided by simple subroutine.
! 10. Multicomponent targets are allowed.
! 11. Anisotropic dielectric tensors are allowed, although with
! the restriction that the principal axes must be aligned with
! the xyz directions in the "target frame".
! 12. Wavelength-dependent dielectric functions are read from user-
! provided files, with automatic interpolation if necessary.
! 13. Automatic looping over radii and wavelengths if desired.
! 14. User may select up to nine Mueller matrix elements for
! computation.
! 15. DDSCAT.6.0 introduces support for MPI (Message Passing Interface
! for parallel computations of different scattering orientations.
! 16. New with DDSCAT.6.1:
! Automatic selection of scattering directions for computation
! of angular averages: radiation pressure force, <cos>, <cos^2>,
! and radiation torque. User sets a single parameter ETASCA
! which controls angular resolution. Reducing ETASCA will lead
! to greater accuracy in calculation of angular averages.
! ETASCA=1 should provide accuracy of better than 1% for angular
! averages.
! 17. New with DDSCAT 6.2:
! gaussian sphere targets
! arbitrary orientation of anisotropic constituent material
! 18. New with DDSCAT 7.0:
! support for infinite periodic targets
! History:
! Note: Overall history of significant changes to the DDSCAT package may
! be found in the comments in subroutine version.f .
! Here we limit comments to changes to this program module, DDSCAT.f:
! 90.11.30 (BTD): Removed LSC3 portion of CXSC complex scratch space.
! 90.12.03 (BTD): Reordered vectors.
! Removed LSC2 and LSC1 portions of CXSC scratch space.
! 90.12.21 (BTD): Added code to create output files
! 'qtable' (summary of Q values)
! 'mtable' (summary of diel. func. for material 1)
! 91.01.03 (BTD): Added MXBETA,MXPHI,MXTHET to argument list for REAPAR
! 91.01.05 (BTD): Changed I4 -> I7 in format statements 9010,9011.
! Set IOSHP=-1 to suppress printing of target.out file.
! 91.05.08 (BTD): Added CALPHA to argument lists for REAPAR and ALPHA
! and added CALPHA to various WRITE statements.
! 91.05.23 (BTD): Added IWRKSC to arg. list for REAPAR and use it to
! control creation of wAArBBkCCC.sca files
! Move lines calculating G.
! Move code writing to qtable and mtable.
! Added IDVOUT to argument list for TARGET
! 91.08.14 (BTD): Add QBKSCA to arg. list for GETFML
! Modify code to print out Q_bk
! 91.08.15 (BTD): Provide different headings for qtable depending on
! whether IORTH=1 or 2 (add statement 9043).
! 91.09.17 (BTD): Remove calls to ALPHA and EVALA (needed to move these
! to subroutine GETFML since alpha from Lattice
! Dispersion Relation depends on propagation direction
! and polarization state)
! Add CALPHA,CXEPS,ICOMP,MXCOMP to argument list for
! GETFML (information required by ALPHA)
! 91.11.12 (BTD): Added variable IDVSHP to argument list for TARGET
! (device number for REASHP to use in reading shape file
! 93.01.15 (BTD): Divided output file qtable into 2 files:
! qtable (containing Q_ext,Q_abs,Q_sca,g,Q_bk) and
! qtable2 (containing Q_pha, Q_pol, Q_cpol)
! 93.01.16 (BTD): Modify so that qtable, qtable2, and mtable are closed
! after writing, and reopened for each new write
! 93.01.20 (BTD): Add MXNX, MXNY, MXNZ to argument list for subroutine
! EXTEND to permit checking of target size against
! maximum allowed dimensions
! 93.03.11 (BTD): Deleted all code associated with unused variable
! CMACHN (originally included to identify machine/OS)
! 93.03.12 (BTD): Changed CDESCR*60 -> CDESCR*67
! Moved WRITE(IDVOUT,9010) to subr. TARGET
! 93.06.02 (BTD): Corrected error in FORMAT statement 9045
! 93.06.03 (BTD): Corrected error in computation of angle-averaged
! backscattering cross section QBKSUM(JO) (had neglected
! to reset sum to zero for each new target).
! 93.09.28 (BTD): Add "fix" to work around Sun compiler/OS bug (see
! description below.
! 93.12.15 (BTD): Corrected calculation of PPOL. Added comments on
! correspondence between our notation and elements
! of 2x2 amplitude scattering matrix and 4x4 Mueller
! scattering matrix.
! 94.01.27 (BTD): Replaced SHPAR1,SHPAR2,SHPAR3 by SHPAR(1-6) to
! allow up to 6 shape parameters
! 94.06.20 (PJF): Comment about NEWTMP FFT and corresponding changes
! in reapar, eself, extend. Add FFT timing code
! TSTFFT to distribution and changes to cxfft3 and
! timeit routines.
! 94.12.20 (BTD): Introduce subroutine VERSION to set value of
! variable CSTAMP. version.f will now serve as
! location to maintain log of significant code
! changes.
! 95.06.15 (BTD): Changed CSTAMP from character*11 to character*22
! to include a date.
! 95.06.14 (BTD): Create version 5x.1 for internal use.
! Version 5x.1 computes vector force and torque
! on grain due to incident radiation.
! Changed QSCATG(2) to QSCAG(3,2) to allow for
! asymmetric scattering by target.
! Added variable QTRQSC(1-3,1-2) and added to
! argument list of GETFML
! Replaced variable GSUM(1-2) to QSCGSUM(1-3,1-2)
! Added variables QTRQAB(1-3,1-2) and
! QTRQABSUM(1-3,1-2)
! 95.06.20 (PJF+: Introduce changes into DDSCAT in order to support
! BTD): use of modular iterative solvers (e.g., CCG).
! : add CMDSOL to argument list to specify method
! of solution
! : add CMDTRQ to argument list of REAPAR and GETFML
! 95.07.10 (BTD): deleted redundant declarations of NAT,NAT0,NAT3,
! NX,NY,NZ (already declared in COMMON/M6/
! 95.07.20 (BTD): added new scratch array SCRRS2(MXNAT) for use in
! torque calculations in SCAT
! 95.07.27 (BTD): Added new scratch variable CXSCR1 for GETFML to
! use for storing first polarization solution while
! solving for second.
! 96.01.26 (BTD): Replaced IX0,IY0,IZ0 by IXYZ0
! (with simultaneous change in TARGET)
! 96.02.23 (BTD): Modified format statements to get additional digits
! for a_1, a_2, k vector, and pol. vectors.
! 96.11.05 (BTD): Modified to remove various computations to
! subroutines GETMUELLER and WRITESCA
! 96.11.14 (PJF): Add TIMERS, MXTIMERS, NTIMERS
! Add cbinflag, cbinfile, IOBIN (binary file)
! Add cbinflag to formal parameters of REAPAR routine
! Remove GETSET routine calls
! 96.11.15 (PJF): Add cnetflag, cnetfile to reapar call. Add netCDF clos
! 96.11.21 (BTD): Declared IDNC,NTIMERS,etc.
! Removed call to NCCLOS
! Added call to WRITESCA in order to call WRITENET in
! order to call NCCLOS in order to close netCDF file
! 96.12.02 (BTD): initialized smori to zero before looping over
! orientations
! eliminated variables S1212,S222,CX1112,CX1122,
! CX1221,CX1222,CX2122
! 97.07.24 (BTD): Changed argument list for GETMUELLER, replacing
! PHI by PHIN, in order to correct error in computation
! of Mueller matrix elements and amplitude scattering
! matrix elements (see GETMUELLER).
! 97.11.01 (BTD): Modified to allow noncubic rectangular lattice.
! Information on lattice anisotropy is contained
! in variable DX(1-3)=(dx/d,dy/d,dz/d) where
! dx,dy,dz=lattice spacings in x,y,z directions
! d=(dx*dy*dz)**(1/3)
! Note that by definition, DX(1)*DX(2)*DX(3)=1
! Pass DX through COMMON/M1/ for use by subroutines
! MATVEC and CMATVEC
! 97.12.25 (BTD): Added CXAOFF to COMMON/M7/
! 98.01.13 (BTD): Added DX to argument list in last 2 calls to WRITESCA
! 98.05.01 (BTD): Removed DATA/IDVOUT/0 since IDVOUT is in COMMON
! Reduced number of continuation lines in CALL WRITESCA
! statements
! 98.08.09 (BTD): Slight change to FORMAT statement 9020
! 98.12.12 (BTD): Add NSMELTS,SMIND1,SMIND2 to argument lists of REAPAR
! and WRITESCA, to allow selection of Muller matrix
! elements
! 98.12.21 (BTD): changed dimension of CFLPAR from CHARACTER*40 to
! CHARACTER*60 to allow longer file names
! (also changed in reapar.f and dielec.f)
! 99.01.26 (BTD): modify so we can restart calculation for specified
! IWAV0,IRAD0,IORI0
! now need to input IWAV0,IRAD0,IORI0 through ddscat.par
! 00.06.12 (BTD): added CFLSHP to argument list of REAPAR to support
! option SPHERES_N (need to pass CFLSPH from REAPAR to
! TARGET)
! 03.02.13 (BTD): added 1 more digit of precision to qtable and qtable2
! outputs; modified header line in stmnts 9044,9046
! 03.04.13 (BTD): added character variable CFLLOG to contain name of
! running output file
! added call to NAMID to generate a unique name for outp
! file, to support MPI use.
! Unfortunately, when this is done, output to device 0
! is no longer unbuffered.
! If it is necessary to reenable unbuffered output for
! debugging purposes,
! OPEN(UNIT=IDVOUT,FILE=CFLLOG)
! should be commented out
! Added variables ITNUM(2) and MXITER to argument lists
! for GETFML and WRITESCA
! 03.07.13 (BTD): Added new variable ITNUMMX(2) to store maximum number
! of iterations taken for any of the orientations for
! each size and wavelength, for output in orientational
! average files waarbbkccc.sca
! Develop version 6.1
! 03.10.23 (BTD): Removed ICTHM and IPHIM from argument lists of
! REAPAR, GETFML, SHARE1, and WRITESCA -- these
! variables are no longer used, since SCAT now
! determines scattering directions automatically
! Add ETASCA to argument list of REAPAR, SHARE1,
! GETFML, WRITESCA
! Added NAVG to argument list of GETFML and WRITESCA
! Add IWRKSC to argument list of SHARE1
! 04.02.22 (BTD): Add IWRKSC to argument list of WRITESCA and SHARE1
! 04.02.25 (BTD): Added final call to WRIMSG reporting normal
! termination
! 04.04.01 (BTD): Added NPY,NPZ to COMMON/M6/ to support periodic
! boundary condition option
! 04.04.04 (BTD): Added NPY,NPZ to argument list of TARGET to be
! compatible with new version of TARGET
! 04.05.21 (BTD): One of the calls to WRITESCA had QSCGSUM and
! QSCG2SUM in incorrect order. Fixed.
! 04.05.22 (BTD): Added IF(CBINFLAG.NE.'NOTBIN') conditional
! before closing dd.bin (file never opened otherwise)
! 04.09.14 (BTD): Add new variables THETADF,PHIDF,BETADF to specify
! orientation of "Dielectric Frame" for each dipole.
! 05.06.16 (BTD): Replaced integer variables NPY,NPZ by
! real variables PYD,PZD in
! COMMON/M6/
! argument list of TARGET
! 05.08.04 (BTD): Added new character variable CMDFRM to be read by
! subroutine REAPAR from input file ddscat.par.
! CMDFRM=LFRAME : angles THETAN,PHIN are relative to
! Lab Frame (xlab,ylab,zlab)
! CMDFRM=TFRAME : angles THETAN,PHIN are relative to
! Target Frame (a1,a2,a3)
! Modified DDSCAT.f to define ENSC,EM1,EM2 accordingly
! 05.09.26 (BTD): Corrected bug in calculation of scattering for
! option CMDFRM = TFRAME
! 05.10.11 (BTD): Modified to support up to 1000 wavelengths:
! changed MXWAV from 100 to 1000
! changed CFLAVG*13 to CFLAVG*14
! changed CFLSCA*14 to CFLSCA*15
! (also changes in NAMER and WRITESCA)
! 05.10.11 (BTD): Added CMDFRM to argument list of WRITESCA
! 05.10.18 (BTD): Modified to allow use of more than 1000 orientations
! if IWRKSC=0 (previously would exceed array limits
! in subroutine NAMER with IORI>1000).
! 06.04.14 (BTD): Modified to call routine WRITEPOL to write files
! wxxxryykzzz.pol1 and wxxxryykzzz.pol2 with
! polarization array and other information
! 06.09.21 (BTD): Modified to add PYD,PZD, and DX to argument list of
! WRITEPOL
! 06.09.28 (BTD): *** Version 7.0.0 ***
! 06.10.05 (BTD): Added call to PBCSCAVEC to prepare scattering
! vectors for PBC targets
! 06.12.24 (BTD): Added ORDERM,ORDERN to argument list of subroutine
! GETMUELLER
! 06.12.28 (BTD): Added arrays XLR(3),YLR(3),ZLR(3),A3(3)
! Added XLR,YLR,ZLR to argument list of PBCSCAVEC
! 07.01.18 (BTD): Added A3(3),IWRPOL,IPBC,JPBC,MXNX,MXNY,MXNZ,MXPBC,
! ORDERM(MXSCA),ORDERN(MXSCA),
! PYD,PYDDX,PZD,PZDDX to argument list of SHARE1
! 07.06.20 (BTD): v7.0.2:
! * define X0(3)
! * add X0 to argument list of TARGET
! * add X0 to argument list of EXTEND
! * add X0 to argument list of GETFML
! * add X0 to argument list of WRITEPOL
! * add X0 to argument list of SHARE1
! 07.06.22 (BTD): removed THETAN and PHIN from argument list of GETFML
! (not needed, because scattering directions are
! specified through vector AKSR)
! 07.06.30 (BTD): moved CMDFFT from COMMON/M6/... CMDFFT
! to COMMON/M8/CMDFFT
! moved PYD,PZD to beginning of COMMON/M6/
! 07.07.03 (BTD): add ENSC to argument list of GETMUELLER
! add ENSC to argument list of PBCSCAVEC
! 07.07.08 (BTD): add EM1,EM2 to argument list of PBCSCAVEC
! add EM1,EM2 to argument list of GETMUELLER
! 07.08.04 (BTD): Version 7.0.3
! * replaced COMMON/M1/ with USE MODULE DDCOMMON_1
! * replaced COMMON/M2/ with USE MODULE DDCOMMON_2
! add dynamic allocation of CXADIA
! * replaced COMMON/M3/ with USE MODULE DDCOMMON_3
! add dynamic allocation of CXZC
! * replaced COMMON/M4/ with USE MODULE DDCOMMON_4
! add dynamic allocation of CXZW
! * replaced COMMON/M5/ with USE MODULE DDCOMMON_5
! add dynamic allocation of IOCC
! * replaced COMMON/M6/ with USE MODULE DDCOMMON_6
! * replaced COMMON/M7/ with USE MODULE DDCOMMON_7
! add dynamic allocation of CXAOFF
! * replaced COMMON/M8/ with USE MODULE DDCOMMON_8
! 07.08.05 (BTD): * Modified to do dynamic memory allocation based
! on actual target size
! * Read size upper bounds MXNX,MXNY,MXNZ from
! ddscat.par
! * Add MXNX,MXNY,MXNZ to argument list of REAPAR
! * Add output line reporting whether single- or
! double-precision version used
! * Add output to report memory allocation, so that
! if system memory limits prevent execution, there
! will be an indication of this in log file
! 07.08.31 (BTD): * Added call to new routines NAMER2 and WRITEFML
! to write out scattering amplitudes f_ml
! 07.10.07 (BTD): * Added THETA, BETA to argument list of PBCSCAVEC
! 07.10.09 (BTD): * Added EM1R,EM2R to argument list of GETMUELLER
! 07.10.24 (BTD) * Defined new array ENSCR
! Added ENSCR to argument list of GETMUELLER
! 07.10.27 (BTD) v7.0.4
! * changed CSHAPE*6 to CSHAPE*9
! * changed shape names to 9 character strings
! * changed SHPAR(6) -> SHPAR(10)
! 07.10.28 (BTD) * eliminated CDIEL -- reading from tables is now standard
! 08.01.06 (BTD) * added comments
! * minor streamlining since CONVEX and TMPRTN are no
! longer options
! * cosmetic changes
! 08.01.12 (BTD) * add PYDDX,PZDDX to argument list of WRITESCA
! 08.01.13 (BTD) * introduce variable NRWORD = length (bytes) of real word
! * add to argument list of WRITEPOL, so that this can
! be stored in file written by WRITEPOL for sanity check
! 08.01.17 (BTD) * add new variable IANISO to indicate whether target
! is isotropic (IANISO=0), anisotropic with optical
! axes || (x,y,z)_TF (IANISO=1), or generally anisotropic
! (IANISO=2)
! * add IANISO to argument list of TARGET
! * modify TARGET to set value of IANISO
! * modifications to support changes to WRITEPOL
! 08.01.21 (BTD) * add IANISO to argument list of SHARE1
! 08.02.01 (BTD) * changed SHPAR(10) -> SHPAR(12) to allow up to 12
! shape parameters to be passed to TARGET
! 08.02.17 (BTD) * add call to routine SHARE0 to share dimensioning
! information to all processes
! * change so ALLOCATION is done by all processes
! * add DAEFF to argument list of SHARE1
! * add CLOSE(11) to close mtable at end
! 08.03.11 (BTD) ver7.0.5
! * added ALPHA to argument list of REAPAR
! * added ALPHA to argument list of SHARE1
! * added ALPHA to DDCOMMON_6 (to communicate with CPROD)
! 08.03.15 (BTD) * added DDCOMMON_10 to transfer MYID to DIRECT_CALC
! 08.04.17 (BTD) * changed MXRAD from 100 to 1000
! 08.04.19 (BTD) * changed notation: ALPHA -> GAMMA
! * changed order of arguments in argument list of
! * REAPAR
! * SHARE1 (in mpi_subs.f90)
! * GETFML
! 08.05.01 (BTD) * added MYID to argument list of SHARE0
! * added MYID to argument list of SHARE1
! 08.05.09 (BTD) * added LACE,LAXI,LCLM,LGI,LPI,LQI,LSC0 to argument list
! of SHARE0
! * added MYID to argument list of WRITESCA
! * moved block of code calculating scratch array positions
! LACE, etc. so that it is executed for all MYID values
! 08.05.10 (BTD) * Introduce new arrays
! CX1121_1
! QABSUM_1
! QBKSUM_1
! QEXTSUM_1
! QPHSUM_1
! QSCAGSUM_1
! QSCG2SUM_1
! QSCASUM_1
! QTRQABSUM_1
! QTRQSCSUM_1
! S1111_1
! S2121_1
! SMORI_1
! 08.05.12 (BTD) ver7.0.6
! * changes introduced by Art Lazanoff, NASA Ames:
! added loops initializing IXYZ0,CXZC,CXZW,CXSCR1,SCRRS1
! to zero, but BTD does not see why this is helpful...
! 08.05.29 (BTD) * changed declarations to allow single call to MPI_REDUCE
! in routine COLSUM:
! SM(MXSCA,4,4) -> SM(4,4,MXSCA)
! SMORI(MXSCA,4,4) -> SMORI(4,4,MXSCA)
! SMORI_1(MXSCA,4,4) -> SMORI_1(4,4,MXSCA)
! 08.07.22 (BTD) * added XMAX,XMIN,YMAX,YMIN,ZMAX,ZMIN to argument list
! of SHARE1
! 08.07.23 (BTD) * removed some MPI_BARRIER calls, added others just
! before SHARE1 and SHARE2
! 08.07.27 (BTD) * changed final allocation of BETADF,PHIDF,THETADF
! from NAT0 -> MXNAT
! 08.08.29 (BTD) v7.0.7
! * removed variable CNETFLAG and CNETFILE
! * removed CNETFLAG from argument list of REAPAR
! * removed CNETFLAG from argument list of SHARE1
! * removed CNETFLAG and CNETFILE from argument list of
! WRITESCA
! 09.09.11 (BTD) v7.0.8
! * added variable NCOMP_NEED to communicate with REASHP
! via subroutine TARGET
! * added check that NCOMP_NEED does not exceed NCOMP
! 10.01.28 (BTD) v7.1.0
! * when IWRKSC=0, change IORI from 0 to 1 in call to
! NAMER
! 10.01.30 (BTD) * eliminate restriction against
! CMDFRM='TFRAME' and JPBC=0
! end history
! Copyright (C) 1993,1994,1995,1996,1997,1998,1999,2000,2003,2004,2005,
! 2006,2007,2008,2009,2010 B.T. Draine and P.J. Flatau
! This code is covered by the GNU General Public License.
!***********************************************************************
! Adjustable Parameters:
! MXNX = max. extent of target in x direction
! MXNY = y
! MXNZ = z
! MXPBC = 0 if not planning to use PBC option
! = 1 for best memory use with PBC option
! MXCOMP = max. number of different dielectric functions
! MXTHET = max. number of target rotation angles THETA
! MXBETA = max. number of target rotation angles BETA
! MXPHI = max. number of target rotation angles PHI
! MXSCA = max. number of scattered directions
! MXRAD = max. number of radii
! MXWAV = max. number of wavelengths
! MXWAVT = max. number of wavelengths in dielectric tables
!*** Set parameter MXPBC
INTEGER :: MXPBC,MXPBC_SH
PARAMETER(MXPBC=1)
INTEGER :: MXNX,MXNY,MXNZ
! experiment with temporary storage for ixyz0 to support first call to target
INTEGER :: MXNAT0,MXN03
!*** Set parameters MXCOMP,MXTHET,MXBETA,MXPHI,MXRAD,MXWAV,MXWAVT,MXSCA
INTEGER :: MXCOMP,MXCOMP_SH
PARAMETER(MXCOMP=9)
INTEGER :: MXTHET,MXTHET_SH,MXBETA,MXBETA_SH,MXPHI,MXPHI_SH
PARAMETER(MXTHET=100,MXBETA=100,MXPHI=100)
INTEGER :: MXRAD,MXRAD_SH,MXWAV,MXWAV_SH,MXWAVT
PARAMETER(MXRAD=1000,MXWAV=1000,MXWAVT=1500)
INTEGER :: MXSCA,MXSCA_SH
PARAMETER(MXSCA=10000)
INTEGER :: MXTIMERS,NTIMERS
PARAMETER(MXTIMERS=20,NTIMERS=12)
!*** Derived Parameters: **********************************************
INTEGER :: MXNAT,MXN3
INTEGER :: MXCXSC
! Local variables:
CHARACTER :: CMDFRM*6,CMDSOL*6,CMDTRQ*6,CMSGNM*70
COMPLEX(WP) :: CXEN
INTEGER :: IANISO,JX,JXMAX,JXMIN,JY,JYMAX,JYMIN,JZ,JZMAX,JZMIN, &
NAVG,NRWORD,NCOMP_NEED
REAL(WP) :: AEFF,AK1,AK3,BETAD,BETAMI,BETAMX,BETMID,BETMXD,COSBET, &
COSPHI,COSTHE,CWORD,DAEFF,DEGRAD,DSTORAGE,ETASCA,FREQ,MB, &
PHID,PHIMAX,PHIMID,PHIMIN,PHIMXD,PI,PIA2,PYDDX,PZDDX,RWORD, &
SINBET,SINPHI,SINTHE,STORAGE,STORAGE0,THETAD,THETMI,THETMX, &
THTMID,THTMXD,TOL,WAVE,XMAX,XMIN,XX,YMAX,YMIN,ZMAX,ZMIN
!e-Beam center variable, added by NWB 3/13/12
REAL(WP) :: CENTER(3)
!Electron energy variable, added by NWB 7/12/12
REAL(WP) :: ELENERGY
! Target Properties:
! AEFF=aeff=effective radius of target (physical units)
! PIA2=pi*(aeff/d)**2=pi*(3*NAT/4*pi)**(2/3)
! Incident Wave Properties:
! AK1=(k*d), where k=2*pi/wave=propagation vector and d=dipole spacing
! AK3=(k*d)**3
! AKE2=(k*d \dot E0), where E0 is incident polarization vector
! WAVE=wavelength (in vacuo) in physical units
! XX=k*aeff=2*pi*aeff/wave
! Scattering Properties:
! G=<cos(theta)> for scattered radiation
! QSCGSUM(1-3,1-2)=running (weighted) sum of g(1-3)*Q_sca
! over target orientations, for incident polarizations 1-2,
! where
! g(1)=<cos(theta)> for scattered radiation
! g(2)=<sin(theta)cos(phi)> for scattered radiation
! g(3)=<sin(theta)sin(phi)> for scattered radiation
! theta is measured relative to incident direction
! phi is measured relative to x,y plane (Lab Frame)
! QPHA(1-2)=(phaseshift cross section)/(pi*aeff**2)
! QEXSUM(1-2)=running sum of QEXT over target orientations
! QABSUM(1-2)=running sum of QABS over target orientations
! QBKSUM(1-2)=running sum of QBKSCA over target orientations
! QSCSUM(1-2)=running sum of QSCA over target orientations
! QSCG2SUM(1-2)=running sum of cos^2*Q_sca
! QTRQSCSUM(1-3,1-2)=running sum of QTRQSC(1-3,1-2) over target orientat
! THETND=scattering angle theta in degrees
! PHIND=scattering angle phi in degrees
! SINPHI=sin(phi)
! DEPOLR=depolarization ratio for scattered of initially polarized
! light into direction theta,phi
! PPOL=percentage polarization for scattering of initially unpolarized
! light into direction theta,phi
INTEGER :: IBETA,IBETA1,IBETH,IBETH1,IDIR,IDNC,IDVERR,IDVSHP,IERR,INIT, &
ILIN10,ILIN12,IOBIN,IOPAR,IORI,IORI0,IORI1,IORTH,IOSHP,IPHI, &
IPHI1,IRAD,IRAD0,IRAD1,ITASK,ITHETA,ITHETA1,IWAV,IWAV0, &
IWAV1,IWRKSC,IWRPOL,J,JJ,JO,JPBC,LACE,LAXI,LCLM,LGI,LPI,LQI, &
LSC0,NBETA,NBETH,NCOMP,NORI,NPHI,NRAD,NSCAT,NSMELTS,NTHETA, &
NUMPROCS,NWAV
INTEGER :: MXITER
INTEGER :: &
ITNUM(2), &
ITNUMMX(2), &
SMIND1(9), &
SMIND2(9)
! MYID = MPI process identifier that runs from 0-(NUMPROCS-1). 0 is
! master process.
! NUMPROCS = number of MPI parallel processes (including the master)
! IERR = MPI error code, which we ignore
! NAT=number of dipoles in target
! NAT3=3*NAT
! NBETA=number of different beta values for target orientation
! NBETH=NBETA*NTHETA=number of target orientations for outer orientation
! NTHETA=number of different theta values for target orientation
! NPHI=number of different phi values for target orientation
! NORI=NBETA*NTHETA*NPHI=total number of target orientations
! NSCAT=number of different scattering directions for each orientation
! NWAV=number of different wavelengths
! NRAD=number of different target radii
! NSMELTS=number of scattering matrix elements to print out
! INIT=0,1,2 for choice of initial vector |x0> in complex conjugate grad
! method
! IORTH=1 or 2 to do 1 or 2 incident polarizations
! IWRKSC=0 or 1 to suppress or generate "wAArBBkCCC.sca" files for each
! target orientation
! NX=x-length of extended target
! NY=y-length of extended target
! NZ=z-length of extended target
! SMIND1(1-NSMELTS) = index 1 of scattering matrix elements to
! be printed out (e.g., 1 for element S_{13})
! SMIND2(1-NSMELTS) = index 2 of scattering matrix elements to
! be printed out (e.g., 3 for element S_{13})
! Variables for fast eDDA NWB 7/11/12
REAL(WP) :: c, h_bar, h_bar2, e_charge, m_e, velocity, &
DielectricConst
CHARACTER :: CALPHA*6,CSHAPE*9,CSTAMP*26,CFLAVG*15,CFLFML*16, &
CFLPAR*13,CFLPOL1*17,CFLPOL2*17,CFLSCA*16,CFLSHP*80,CDESCR*67, &
CBINFLAG*6,CBINFILE*14
CHARACTER :: CFLLOG*14
CHARACTER(60) :: &
CFLEPS(MXCOMP)
! ..
! .. Local Arrays ..
COMPLEX(WP),ALLOCATABLE :: &
CXALOF(:), &
CXALOS(:), &
CXALPH(:), &
CXE(:), &
CXSC(:), &
CXSCR1(:), &
CXXI(:)
COMPLEX(WP) :: &
CX1121(MXSCA), &
CX1121_1(MXSCA), &
CXE01(3), &
CXE02(3), &
CXE01R(3), &
CXE02R(3), &
CXEPS(MXCOMP), &
CXF11(MXSCA), &
CXF12(MXSCA), &
CXF21(MXSCA), &
CXF22(MXSCA), &
CXRLOC(MXCOMP+1,3,3), &
CXRFR(MXCOMP), &
CXS1(MXSCA), &
CXS2(MXSCA), &
CXS3(MXSCA), &
CXS4(MXSCA)
! Arrays describing target properties:
! CXADIA(1-3*NAT)=diagonal elements of A matrix
! CXEPS(1-MXCOMP)=dielectric const. for each of MXCOMP materials
! CXREFR(1-3)=complex refractive index at current wavelength
! CXALPH(1-3*NAT)=diagonal elements of dipole polarizability tensor alpha
! CXALOF(1-3*NAT)=off-diagonal elements of dipole polarizability tensor
! CXALOS(1-3*NAT)=off-diagonal elements of dipole polarizability tensor
! Arrays describing incident radiation:
! CXE01(1-3)=incident polarization vector e01 prior to target rotation
! CXE02(1-3)=incident polarization vector e02 prior to target rotation
! CXE01R(1-3)=rotated incident polarization vector e01 in Target Frame
! CXE02R(1-3)=rotated incident polarization vector e02 in Target Frame
! CXE0R(1-3)=incident polarization vector (=CXE01R or CXE02R) being used
! CXE(1-3*NAT)=incident electric field vector in Target Frame
! Array describing polarization of target for one incident wave:
! CXXI(1-3*NAT)=polarization vector at each dipole
! Arrays describing scattering properties of target:
! CXFF11(1-NSCAT)=scattering matrix element f11 for each of NSCAT directions
! CXFF12(1-NSCAT)= f12
! CXFF21(1-NSCAT)= f21
! CXFF22(1-NSCAT)= f22
! CX1121(1-NSCAT)=sum of f11* \times f21 over orientations
! Scratch arrays:
! CXSC(1-MXCXSC)=scratch array used by DDACCG
INTEGER*2,ALLOCATABLE :: &
ICOMP(:), &
ISCR1(:)
INTEGER,ALLOCATABLE :: &
IXYZ0(:,:)
! IXYZ0(1-NAT0,1-3)=[x-X0(1)]/d,
! [y-X0(2)]/d,
! [z-X0(3)]/d for dipoles 1-NAT0 in real target
! where offset vector X0(1-3) is set by routine TARGET
! X0(1-3)*DX(1-3) = location of lattice site (0,0,0)
! Scratch arrays:
! ISCR1,ISCR2,ISCR3,ISCR4 (used by EXTEND)
REAL(WP) :: &
A1(3), &
A2(3), &
A3(3), &
AEFFA(MXRAD), &
AKSR(3,MXSCA), &
BETA(MXBETA), &
E1A(MXWAVT), &
E2A(MXWAVT), &
EM1(3,MXSCA), &
EM1R(3,MXSCA), &
EM2(3,MXSCA), &
EM2R(3,MXSCA), &
EN0R(3), &
ENSC(3,MXSCA), &
ENSCR(3,MXSCA), &
ORDERM(MXSCA), &
ORDERN(MXSCA), &
PHI(MXPHI), &
PHIN(MXSCA)
REAL(WP) :: &
QABS(2), &
QABSUM(2), &
QABSUM_1(2), &
QBKSCA(2), &
QBKSUM(2), &
QBKSUM_1(2), &
QEXT(2), &
QEXSUM(2), &
QEXSUM_1(2), &
QPHA(2), &
QPHSUM(2), &
QPHSUM_1(2), &
QSCAT(2), &
QSCAG(3,2), &
QSCAG2(2), &
QSCG2SUM(2), &
QSCG2SUM_1(2), &
QSCGSUM(3,2), &
QSCGSUM_1(3,2), &
QSCSUM(2), &
QSCSUM_1(2), &
QTRQAB(3,2), &
QTRQSC(3,2), &
QTRQABSUM(3,2), &
QTRQABSUM_1(3,2), &
QTRQSCSUM(3,2), &
QTRQSCSUM_1(3,2)
REAL(WP) :: &
S1111(MXSCA), &
S1111_1(MXSCA), &
S2121(MXSCA), &
S2121_1(MXSCA), &
SHPAR(12), &
SM(4,4,MXSCA), &
SMORI(4,4,MXSCA), &
SMORI_1(4,4,MXSCA), &
THETA(MXTHET), &
THETAN(MXSCA), &
TIMERS(MXTIMERS), &
WAVEA(MXWAV), &
WGTA(MXTHET,MXPHI), &
WGTB(MXBETA), &
WVA(MXWAVT), &
X0(3), &
XLR(3), &
YLR(3), &
ZLR(3)
REAL(WP),ALLOCATABLE :: &
BETADF(:), &
PHIDF(:), &
SCRRS1(:,:), &
SCRRS2(:), &
THETADF(:)
! IANISO=0 for isotropic target
! 1 for anisotropic target, but with principal axes of
! dielectric tensor || x_TF,y_TF,z_TF
! (i.e., for every dipole, Dielectric Frame = Target Frame)
! 2 for general anisotropic target, where orientation of
! Dielectric Frame is specified for every dipole
!
! Arrays describing target properties:
! A1(1-3)=direction of target axis a1 in Target Frame
! =initial direction of target axis a1 in Lab Frame
! A2(1-3)=direction of target axis a2 in Target Frame
! =initial direction of target axis a2 in Lab Frame
! A3(1-3)=direction of target axis a3=a1xa2 in Target Frame
! =initial direction of target axis a3 in Lab Frame
! AEFFA(1-NRAD)=values of effective radius of target (physical units)
! SHPAR(1-10)=up to 10 parameters for defining target geometry
! X0(1-3)=offset for IXYZ array, such that
! x/d = IXYZ(J,1) - X0(1)
! y/d = IXYZ(J,2) - X0(2)
! z/d = IXYZ(J,3) - X0(3)
! Arrays describing orientation of "Dielectric Frame" for anisotropic
! material relative to Target Frame, for each dipole location:
! BETADF(1-NAT) = angle BETADF (radians)
! PHIDF(1-NAT) = angle PHIDF (radians)
! THETADF(1-NAT) = angle THETADF (radians)
! Arrays describing target rotation:
! THETA(1-NTHETA)=desired values of target rotation angle theta
! BETA(1-NBETA)=desired values of target rotation angle beta
! PHI(1-NPHI)=desired values of target rotation angle phi
! WGTA(1-NTHETA,1-NPHI)=weight factor for each orientation of target
! axis a1 in Lab Frame
! WGTB(1-NBETA)=weight factor for rotation of target around a1
! Arrays describing incident wave:
! WAVEA(1-NWAV)=values of wavelength (physical units)
! EN0R(3)=unit vector in direction of incidence in (rotated) Target
! Frame
! AKR(3)=k*d vector in (rotated) Target Frame
! XLR(3)=unit vector xlab in target frame
! YLR(3)=unit vector ylab in target frame
! ZLR(3)=unit vector zlab in target frame
! Arrays describing scattering properties:
! ENSC(1-3,1-NSCAT)=unit scattering vectors in Lab Frame
! ENSCR(1-3,1-NSCAT)=unit scattering vectors in Target Frame
! AKSR(1-3,1-NSCAT)=scattering k-vectors in Target Frame
! EM1(1-3,1-NSCAT)=scattering polarization state 1 in Lab Frame
! EM2(1-3,1-NSCAT)=scattering polarization state 2 in Lab Frame
! EM1R(1-3,1-NSCAT)=scattering polarization state 1 in Target Frame
! EM1R(1-3,1-NSCAT)=scattering polarization state 2 in Target Frame
! THETAN(1-NSCAT)=values of theta for NSCAT scattering directions nhat
! at which scattering matrix fml is to be calculated
! For finite target (JPBC=0), THETAN is specified
! in the Lab Frame
! PHIN(1-NSCAT)=values of phi for scattering NSCAT directions nhat at
! which scattering matrix fml is to be calculated
! For finite target (JPBC=0), PHIN is specified
! in the Lab Frame.
! S1111(1-NSCAT)=sum of |f11|**2 over target orientations
! S2121(1-NSCAT)= |f21|**2
! QABS(1-2)=(absorption cross section)/(pi*aeff**2) for 2 polarizations
! QBKSCA(1-2)=4*pi*(diff.scatt.cross section for theta=pi)/(pi*aeff**2)
! for 2 polarizations
! QEXT(1-2)=(extinction cross section)/(pi*aeff**2)
! QSCA(1-2)=(scattering cross section)/(pi*aeff**2)=QEXT-QABS
! QSCAT(1-2)=(scattering cross section)/(pi*aeff**2) estimated by SCAT
! Scratch array:
! SCRRS1(1-NAT,3)=scratch array used by DDACCG and SCAT
! SCRRS2(1-NAT)=scratch array used by SCAT
! External subroutines:
EXTERNAL DIELEC,NAMER,REAPAR
! Intrinsic functions:
INTRINSIC ATAN,SQRT,REAL
DATA CFLPAR/'ddscat.par'/
DATA CFLSHP/'shape.dat'/
! Set device numbers:
! IDVERR = device number for error messages
! IOPAR = device number for reading ddscat.par file
! IOSHP = device number for writing target.out (IOSHP<0 to suppress)
! IDVSHP = device number for reading shape file
DATA IDVERR/0/
DATA IDVSHP/10/
DATA IOPAR/1/
DATA IOSHP/ -1/
! IDVOUT = device number for running I/O
! on Solaris IDVOUT=0 produces unbuffered output to standard
! output
! IDVOUT=6 produces buffered output to standard
! output
! Initialize IDVOUT (cannot be done in DATA statement because IDVOUT
! is in COMMON/M6/
IDVOUT=0
!*** diagnostic
! write(0,*)'ddscat ckpt 0.9'
!***
!***********************************************************************
! Define variables for eDDA NWB 7/11/12
c = 3.E8_WP !Speed of light, m/s
e_charge = 1.60217646E-19_WP !Charge of electron, Coulombs
! e_charge = 1._WP !Charge of electron, fundamental
m_e = 9.10938188E-31_WP !Mass of electron, kg
! velocity = 0.5_WP * c !Velocity of electron, m/s
DielectricConst = 1._WP !Dielectric constant -- 1 for vacuum
h_bar = 1.054572E-34_WP !h_bar, j-s
h_bar2 = 6.582119E-19_WP !h_bar, eV-s
!***********************************************************************
! MPI environment setup:
CALL MPI_INIT(IERR)
CALL MPI_COMM_RANK(MPI_COMM_WORLD,MYID,IERR)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NUMPROCS,IERR)
IF(MYID==0)THEN
WRITE(CMSGNM,FMT='(A,I4)')'NUMPROC=',NUMPROCS
CALL WRIMSG('DDSCAT',CMSGNM)
ENDIF
! MPI_INIT is called by each process to initialize the MPI environment
! MPI_COMM_RANK is called by each process to determine its identifier
! which is stored in MYID
! MPI_COMM_SIZE is called by each process to determine the number of
! parallel processes, stored in NUMPROCS
! If not using MPI, these calls can be turned into dummies by including
! subroutines in mpi_fake.f (also need to comment out INCLUDE 'mpif.h'
! and uncomment declaration of integer variable MPI_COMM_WORLD as noted
! above)
! Initialize variables to pass to SHARE1:
MXBETA_SH=MXBETA
MXCOMP_SH=MXCOMP
MXPBC_SH=MXPBC
MXPHI_SH=MXPHI
MXRAD_SH=MXRAD
MXSCA_SH=MXSCA
MXTHET_SH=MXTHET
MXWAV_SH=MXWAV
! Call subroutine NAMID to obtain unique filename for output file
! written by this process.
!*** diagnostic
! write(0,*)'ddscat ckpt 1.1, myid=',myid
! call mpi_barrier(mpi_comm_world,ierr)
!***
CALL NAMID(MYID,CFLLOG)
!*** diagnostic
! write(0,*)'ddscat ckpt 1.2, myid=',myid
!***
!=======================================================================
! When following statement is enabled, output is buffered.
! If using MPI, each MPI process will write to a unique file named
! ddscat.log_xxx , where xxx=000,001,002, etc.
! If it is necessary to have unbuffered output for debugging purposes,
! comment out the following OPEN statement, in which case running
! diagnostic information will be written to standard output.
! Note that in this case, if using MPI, all MPI processes will write
! to a single output stream.
! OPEN(UNIT=IDVOUT,FILE=CFLLOG)
!=======================================================================
CALL VERSION(CSTAMP)
IF(MYID==0)THEN ! begin if(myid==0)... #1
WRITE(IDVOUT,FMT=9000)CSTAMP
#ifdef openmp
WRITE(IDVOUT,FMT=9000)'compiled with OpenMP enabled'
#endif
IF(WP==KIND(0.E0))THEN
WRITE(CMSGNM,FMT='(A)')' Single-precision version'
! for storage computations:
! NRWORD,RWORD = length (bytes) of REAL word
! CWORD = length (bytes) of COMPLEX word
NRWORD=4
RWORD=4._WP
CWORD=2._WP*RWORD
ELSEIF(WP==KIND(0.D0))THEN
WRITE(CMSGNM,FMT='(A)')' Double-precision version'
NRWORD=8.
RWORD=8._WP
CWORD=2._WP*RWORD
ELSE