-
Notifications
You must be signed in to change notification settings - Fork 71
/
DDmodel-current.f95
2188 lines (1871 loc) · 83 KB
/
DDmodel-current.f95
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
MODULE DriftDiffusion
IMPLICIT NONE
! Some constants
REAl(KIND=16), PARAMETER :: q = 1.60217646e-19 !Electron charge (C)
REAl(KIND=16), PARAMETER :: kb = 1.3806503e-23 !Boltzmann constant (m2 Kg s-2 K-1)
REAl(KIND=16), PARAMETER :: m0 = 9.10938188e-31 !Electron rest mass (kg)
REAl(KIND=16), PARAMETER :: Epsi0 = 8.854187817e-12 !Vacuum permitivity (F/m)
REAl(KIND=16), PARAMETER :: hp = 6.626068e-34 !Planck's constant (m^2 Kg/s)
REAl(KIND=16), PARAMETER :: Pi = 3.14159265359
!
! ---------------------------------------------------------------------------
! Everything included here are global variables available in the whole module
! ---------------------------------------------------------------------------
! Some useful variables
REAl(KIND=16) :: T = 300 !Temperature. Default room temperature.
!
! Variable inputs and/or outputs. They will have M+1 elements.
REAl(KIND=16), DIMENSION(0:6000) :: X !Node possition (m)
REAl(KIND=16), DIMENSION(0:6000) :: dX !Node spacing (m)
REAl(KIND=16), DIMENSION(0:6000) :: n, p !Electron and hole densities (m-3)
REAl(KIND=16), DIMENSION(0:6000) :: Rho !Total charge density Rho = Nd+p-Nd-n (m-3)
REAl(KIND=16), DIMENSION(0:6000) :: ni !Carrier intrinsic densities (m-3)
REAl(KIND=16), DIMENSION(0:6000) :: Nc, Nv !Total effective density of states of electrons and holes (m-3)
REAl(KIND=16), DIMENSION(0:6000) :: Nd, Na !Density of ionised donors and acceptors (m-3).
REAl(KIND=16), DIMENSION(0:6000) :: Fn, Fp !Quasi-Fermi potential for electrons and holes (V)
REAl(KIND=16), DIMENSION(0:6000) :: Psi !Electrostatic potential (V)
REAl(KIND=16), DIMENSION(0:6000) :: Eg !Energy gap (eV)
REAl(KIND=16), DIMENSION(0:6000) :: Xi !Electron afinity (eV)
REAl(KIND=16), DIMENSION(0:6000) :: Mun, Mup !Mobilities of electrons and holes (m^2/Vs)
REAl(KIND=16), DIMENSION(0:6000) :: Epsi !Relative permitivity (-)
REAl(KIND=16), DIMENSION(0:6000) :: Ncc, Nvhh, Nvlh !Effective density of states of electrons and holes (m-3)
REAl(KIND=16), DIMENSION(0:6000) :: tn, tp !Lifetime of minority carriers in the SRH model
REAl(KIND=16), DIMENSION(0:6000) :: Brad !Radiative recombination coeficient
REAl(KIND=16), DIMENSION(0:6000) :: CCn, CCp !Auger recombination coeficients
REAl(KIND=16), DIMENSION(0:6000) :: alfa !Absorption coefficient.
REAl(KIND=16), DIMENSION(0:6000, 0:3000) :: AbsProfile !Absorption coefficient as a function of wavelength.
REAl(KIND=16), DIMENSION(0:6000) :: IQE, IQEsrh, IQErad, IQEaug, IQEsurb, IQEsurf ! Internal quantum efficiency of the device as a function of wavelength
!
! Some derived potentials useful for the calculation
REAl(KIND=16), DIMENSION(0:6000) :: Vn, Vp !Band edge potentials with respect certain reference
REAl(KIND=16), DIMENSION(0:6000) :: Cn, Cp !Modified electric potentials
!
!
! Bulk generation and recombination, including all processes
REAl(KIND=16), DIMENSION(0:6000) :: GR ! Generation-Recombination = Rsrh + Rrad + Raug - G
REAl(KIND=16), DIMENSION(0:6000) :: Rrad ! Radiative recombination
REAl(KIND=16), DIMENSION(0:6000) :: Rsrh ! SRH recombinaiton
REAl(KIND=16), DIMENSION(0:6000) :: Raug ! Auger recombinaiton
REAl(KIND=16), DIMENSION(0:6000) :: G ! Generation
REAl(KIND=16), DIMENSION(6000) :: vpoint ! Voltage in an IV curve
REAl(KIND=16), DIMENSION(6000) :: jpoint ! Total current in an IV curve
REAl(KIND=16), DIMENSION(6000) :: jsrhpoint ! SRH current in an IV curve
REAl(KIND=16), DIMENSION(6000) :: jradpoint ! Radiative current in an IV curve
REAl(KIND=16), DIMENSION(6000) :: jaugpoint ! Auger current in an IV curve
REAl(KIND=16), DIMENSION(6000) :: jsurpoint ! Surface recombination current in an IV curve
REAl(KIND=16), DIMENSION(6000) :: residual ! residual in an IV curve
INTEGER :: nvolt = 0
REAl(KIND=16) :: PhotonFlux ! Photon flux
REAl(KIND=16), DIMENSION(0:3000) :: PFspectrum = 0.0 ! Photon flux as a function of wavelength (same wl that the abs. coef.)
INTEGER :: SRH, RAD, AUG, GEN ! 1 = Included, 0 = Not included
REAl(KIND=16) :: Jtot2, CurrentsBias(6), Currents(6)
LOGICAL :: SingleWL = .FALSE. ! Controls the generation in IQE running mode
LOGICAL :: Dynamic = .FALSE. ! Controls if there is dynamic meshing or not
!
! Extra values for the boundary conditions
! REAl(KIND=16) :: Sn, Sp !Surface recombination velocity of minority carriers
REAl(KIND=16) :: Snfront, Spfront, Snback, Spback !Surface recombination velocity of minority carriers
REAl(KIND=16) :: fneq = 1
REAl(KIND=16) :: bneq = 1
REAl(KIND=16) :: fpeq = 1
REAl(KIND=16) :: bpeq = 1
INTEGER :: FTYPE, BTYPE, FSUR, BSUR
REAl(KIND=16) :: Vbarf, Vbarb
INTEGER :: EQ, SC, OC, OCn, OCp
!
! Reference values, tipically those at x = 0, on the left end of the device
REAl(KIND=16) :: nir
REAl(KIND=16) :: Munr, Mupr
REAl(KIND=16) :: Xir
REAl(KIND=16) :: Ncr, Nvr
REAl(KIND=16) :: Egr
REAl(KIND=16) :: Epsir
!
! Doping in the device. We start asuming a simple pin junction
REAl(KIND=16) :: Aceptors, Intrinsic, Donors ! Doping of the p, i and n regions.
REAl(KIND=16) :: XD = 0.0
!
! Other variables
INTEGER :: M ! The number of nodes -1
REAl(KIND=16) :: MasterNodes(1000) = 0 ! Array containing the position of the Masternodes
REAl(KIND=16) :: DML(1:1000, 20) ! DeviceMaterialsLibrary, array containing all the properties of the materials
! used in the device.
REAl(KIND=16) :: DoppingLibrary(200, 4) ! An array containing all the constant doping profiles used in the device.
REAl(KIND=16) :: AbsLibrary(-1:1000, 0:3000) = 0.0 ! An array containing all the absorption profiles used in the device.
INTEGER :: MGrid = 1 ! The number of grid lines (Max MGrid=200)
INTEGER :: MReg = 0 ! The number of different material regions (Max MReg=200)
! Mesh variables
INTEGER :: NumWL = 2 ! The number of wavelengths in the photon flux and the absroption coefficient
REAl(KIND=16) :: Coarse, Fine, Ultrafine ! The different mesh sizes
REAl(KIND=16) :: Growth ! Growth parameter for the dynamic meshing
! The clamp for the variables Fn, Psi and Fp.
REAl(KIND=16) :: clamp = 20
REAl(KIND=16) :: ATol = 3.1622776601683796e-17 ! SQRT of machine epsilon at quadruple precission
REAl(KIND=16) :: RTol = 1e-6
INTEGER :: nitermax = 40
!
! Voltage, current an series resistance information
REAl(KIND=16) :: Vbi, Vi, Vap ! Built-in voltage, Vi = q*Vbi/kbT, applied voltage (used only in dep.aprox.)
REAl(KIND=16) :: Voc, Isc, Vmax, Imax, Pmax, FF
REAl(KIND=16) :: Rs = 0
!
! Set of equations to be solved simultaneously [f]=0. For each internal node k = 1, M-2:
! - f(3k-1) corresponds to the continuty of Jp, associated to Fp
! - f(3k) corresponds to the Poisson equation, associated to Psi
! - f(3k+1) corresponds to the continuity of Jn, associated to Fn
! The total vector of equations with 3M-1 elements and auxiliary vector
REAl(KIND=16), DIMENSION(18003) :: f, dsol
! The Jacobian matrix in compact form. It only contains the non-zero elements
REAl(KIND=16), DIMENSION(18003,11) :: Jac
!
!
! Scaling factors
! REAl(KIND=16) :: x0 ! Max length scale x0 = total device thickness
REAl(KIND=16) :: b ! Inverse of thermal voltage b = q/(kb*T)
REAl(KIND=16) :: C0 ! Maximum intrinsic concentration
REAl(KIND=16) :: Mu0 ! Maximum mobility
REAl(KIND=16) :: D0 ! D0 = Mu0/b
REAl(KIND=16) :: G0 ! Recombination-Generation G0 = D0*C0/x0**2
REAl(KIND=16) :: t0 ! t0 = X0/D0
REAl(KIND=16) :: J0 ! Current density J0 = q*D0*C0/X0
! Output file name
CHARACTER(200) :: output
INTEGER :: ou = 6
LOGICAL :: make_log = .FALSE.
! ---------------------------------------------------------------------------
! End of the definition of global variables
! ---------------------------------------------------------------------------
CONTAINS
!-------------------------------------------------
SUBROUTINE log_file(my_log_file)
CHARACTER(200) :: my_log_file
output = my_log_file
make_log = .TRUE.
END SUBROUTINE log_file
!-------------------------------------------------
SUBROUTINE cancel_log()
make_log = .FALSE.
END SUBROUTINE cancel_log
!-------------------------------------------------
SUBROUTINE open_log()
LOGICAL :: exist_file, opened_unit
IF (make_log) THEN
ou = 2
INQUIRE(file=output, exist=exist_file)
INQUIRE(unit=ou, opened=opened_unit)
IF (.NOT.opened_unit) THEN
IF (exist_file) THEN
OPEN(ou, file=output, status="old", position="append", action="write")
ELSE
OPEN(ou, file=output, status="new", action="write")
END IF
END IF
END IF
END SUBROUTINE open_log
!-------------------------------------------------
SUBROUTINE close_log()
IF (make_log) THEN
close(unit=ou)
END IF
ou = 6
END SUBROUTINE close_log
!-------------------------------------------------
SUBROUTINE version()
CHARACTER(10) :: ver
ver = '0.5.0'
CALL open_log()
WRITE(ou,*) 'Fotran Poisson - DriftDiffusion version: ', ver
CALL close_log()
END SUBROUTINE version
!-------------------------------------------------
SUBROUTINE InitDevice(MM)
INTEGER :: i, j, k
INTEGER :: MM
REAl(KIND=16) :: Nqw, Nbulk, Vconf
CALL open_log()
! Scaling factors
b = q/(kb*T)
C0 = MAXVAL(DML(:, 16))
Mu0 = MAX( MAXVAL(DML(:, 5)), MAXVAL(DML(:, 6)) )
D0 = Mu0/b
G0 = D0*C0/XD**2
t0 = XD**2/D0
J0 = q*D0*C0/XD
!We create the mesh
CALL CreateMesh(MM)
! Refine the mesh if appropiate and show the information
WRITE(ou,*) 'CREATE MESH...'
IF (MM <= 0) THEN
WRITE(ou,*) 'Masternodes at (nm):'
WRITE(ou,'(1f10.1)')( MasterNodes(i)/1e-9, i = 1, MGrid)
END IF
! We fill the arrays with the material properties and doping as a function of position
DO i = 1, MReg ! Loop over the layers
DO j=0,M ! Loop over the nodes
IF ( (X(j)>=DML(i, 1)).AND.(X(j)<=DML(i, 2)) ) THEN
Eg(j) = DML(i, 3)
Xi(j) = DML(i, 4)
Mun(j) = DML(i, 5)
Mup(j) = DML(i, 6)
Nc(j) = DML(i, 7)
Nv(j) = DML(i, 8)
tn(j) = DML(i, 10)
tp(j) = DML(i, 11)
Epsi(j) = DML(i, 12)
Brad(j) = DML(i, 13)
CCn(j) = DML(i, 17)
CCp(j) = DML(i, 18)
ni(j) = SQRT(Nc(j)*Nv(j)*EXP( -b*Eg(j) ) )
AbsProfile(j, 0:NumWL) = AbsLibrary(i, 0:NumWL)
Na(j) = DoppingLibrary(i, 1)
Nd(j) = DoppingLibrary(i, 2)
END IF
END DO
END DO
! Set the reference values to the properties of the last point, X(M)
Egr = Eg(M)
Xir = Xi(M)
Munr = Mun(M)
Mupr = Mup(M)
Ncr = Nc(M)
Nvr = Nv(M)
nir = ni(M)
DO i = 0, M
CALL Bandedge(i)
END DO
! Apply neutrality condition to find the initial values for the potential
WHERE (Nd(0:M)>Na(0:M))
n = 0.5*(Nd-Na) + 0.5*SQRT((Nd-Na)**2 + 4*ni**2)
p = ni**2/n
ELSEWHERE
p = -0.5*(Nd-Na)+ 0.5*SQRT((Nd-Na)**2 + 4*ni**2)
n = ni**2/p
ENDWHERE
Fn(0:M) = - LOG(n(M)/nir) + Vn(M)
Fp(0:M) = Fn(0:M)
Psi(0:M) = LOG(n(0:M)/nir) - Vn(0:M) + Fn(0:M)
! We smooth the potential to facilitate the initial convergence. We smooth 10 times
Do j = 1, 10
DO i = 1, M-1
Psi(i) = (Psi(i-1) + Psi(i) + Psi(i+1)) / 3.0
END DO
END DO
DO j = 0, M
CALL ModPotential(j)
CALL Carriers(j)
Rho(j)=q*( p(j)-n(j)+Nd(j)-Na(j) )
END DO
fneq = n(0)
bneq = n(M)
WRITE(ou,*) ' '
IF (Dynamic) THEN
WRITE(ou,*) 'Initial number of nodes (M+1): ', M+1
WRITE(ou,*) 'Refining mesh... '
CALL DynamicMesh(1)
WRITE(ou,*) '... Finished!'
END IF
WRITE(ou,*) 'Mesh with ', M+1, ' nodes.'
WRITE(ou,*) '----------------------------------'
CALL close_log()
END SUBROUTINE InitDevice
!-------------------------------------------------
SUBROUTINE AddLayer(args, dum2)
!External variables
REAl(KIND=8) :: args(0:dum2)
INTEGER :: dum2
!Internal variables
REAl(KIND=16) :: xini, xfin
MReg = MReg + 1
xini = XD
xfin = XD + REAL(args(0),16)
XD = xfin
DML(MReg, 1) = xini
DML(MReg, 2) = xfin
DML(MReg, 3) = REAL(args(1),16) ! Eg
DML(MReg, 4) = REAL(args(2),16) ! Xi
DML(MReg, 5) = REAL(args(3),16) ! Mun
DML(MReg, 6) = REAL(args(4),16) ! Mup
DML(MReg, 7) = REAL(args(5),16) ! Nc
DML(MReg, 8) = REAL(args(6),16) ! Nv
DML(MReg, 10) = REAL(args(7),16) ! tn
DML(MReg, 11) = REAL(args(8),16) ! tp
DML(MReg, 12) = REAL(args(9),16) ! Epsi
DML(MReg, 13) = REAL(args(10),16) ! Brad
DML(MReg, 17) = REAL(args(11),16) ! CCn
DML(MReg, 18) = REAL(args(12),16) ! CCp
DoppingLibrary(MReg, 1) = REAL(args(13),16) ! Acceptors
DoppingLibrary(MReg, 2) = REAL(args(14), 16) ! Donors
CALL AddMasterNode(REAL(xini,16))
CALL AddMasterNode(REAL(xfin,16)-1e-10)
CALL AddMasterNode(REAL(xfin,16))
END SUBROUTINE AddLayer
!-------------------------------------------------
SUBROUTINE AddAbsorption(Ab, WL, dum)
! Add the absorption coefficients to the structure. They MUST be added in the same order than the layers before initialise the structure.
REAl(KIND=8) :: Ab(0:dum), WL(0:dum)
INTEGER :: dum
IF (NumWL==2) THEN ! If the number of wavelengths is equal to 2, then this is the first call to this function.
NumWL = SIZE(WL)-1
AbsLibrary(-1, 0:NumWL) = REAL(WL(0:NumWL),16) ! We asign the wavelength values
END IF
AbsLibrary(MReg, 0:NumWL) = REAL(Ab(0:NumWL), 16)
END SUBROUTINE AddAbsorption
!-------------------------------------------------
SUBROUTINE set_generation(gen_profile, dum_m, dum_wl)
REAl(KIND=8) :: gen_profile(-1:dum_m, 0:dum_wl)
INTEGER :: dum_m, dum_wl
NumWL = dum_wl
AbsProfile(0:M, 0:NumWL) = REAL(gen_profile(0:dum_m, 0:dum_wl), 16)
AbsLibrary(-1, 0:NumWL) = REAL(gen_profile(-1, 0:dum_wl), 16)
END SUBROUTINE set_generation
!-------------------------------------------------
SUBROUTINE AddMasterNode(newpoint)
REAl(KIND=16) :: newpoint
INTEGER :: i, j
DO i = 1, MGrid
IF (MasterNodes(i) > newpoint + 0.5e-10) THEN
MasterNodes(i+1:MGrid+1) = MasterNodes(i:MGrid)
MasterNodes(i) = newpoint
MGrid = MGrid + 1
RETURN
ELSE IF ( ABS(MasterNodes(i)-newpoint) < 0.5e-10 ) THEN
RETURN
END IF
END DO
IF (MasterNodes(MGrid) < newpoint - 0.5e-10) THEN
MGrid = MGrid + 1
MasterNodes(MGrid) = newpoint
END IF
END SUBROUTINE AddMasterNode
!-------------------------------------------------
SUBROUTINE CreateMesh(MM)
INTEGER :: i, j, k, lc, lf, lu, extra
REAl(KIND=16) :: delta, deltaF, deltaUF
REAl(KIND=16) :: TempMasterNodes(1000)
INTEGER :: MM
IF (MM>0) THEN
M = MM
DO i = 0, M
X(i) = i*XD/M
dX(i) = XD/M
END DO
RETURN
END IF
MasterNodes(MGrid-1) = MasterNodes(MGrid)
MGrid = MGrid-1
IF (MM < 0) Dynamic = .TRUE.
j = 0
! Loop for the coarse mesh
DO i = 1, MGrid-1
X(j) = MasterNodes(i)
lc = CEILING((MasterNodes(i+1)-MasterNodes(i))/Coarse) - 1
delta = (MasterNodes(i+1)-MasterNodes(i))/(lc+1)
IF (lc==0) THEN
extra=0
ELSE
extra=1
END IF
! The fine mesh after a GridLine
IF (Fine<Coarse) THEN
lf = CEILING(delta/Fine) - 1
deltaF = delta/(lf+1)
! The ultrafine mesh after a GridLine
IF (Ultrafine<Fine) THEN
lu = CEILING(deltaF/Ultrafine) - 1
deltaUF = deltaF/(lu+1)
! Loop for the points of the ultrafine mesh
DO k = 1, lu+1
j = j + 1
X(j) = X(j-1) + deltaUF
END DO
ELSE
! The first point of the fine mesh
j = j + 1
X(j) = X(j-1) + deltaF
END IF
! Intermediate points of the fine mesh
DO k = 1, lf-1+extra
j = j + 1
X(j) = X(j-1) + deltaF
END DO
END IF
! Loop for the intermediate points of the coarse mesh
DO k = 1, lc-1!+extra
j = j + 1
X(j) = X(j-1) + delta
END DO
! Loop for the fine mesh before a GridLine
IF (Fine<Coarse) THEN
IF (lc/=0) THEN
DO k = 1, lf
j = j + 1
X(j) = X(j-1) + deltaF
END DO
! Loop for the ultrafine mesh before a GridLine
IF (Ultrafine<Fine) THEN
DO k = 1, lu
j = j + 1
X(j) = X(j-1) + deltaUF
END DO
j = j + 1
ELSE
j = j + 1
END IF
ELSE
IF (lf/=0) THEN
! Loop for the ultrafine mesh before a GridLine
IF (Ultrafine<Fine) THEN
DO k = 1, lu
j = j + 1
X(j) = X(j-1) + deltaUF
END DO
j = j + 1
ELSE
j = j + 1
END IF
END IF
END IF
ELSE
j = j + 1
END IF
END DO
X(j) = MasterNodes(MGrid)
M = j
DO i = 0, M-1
dX(i) = X(i+1)-X(i)
END DO
END SUBROUTINE CreateMesh
!-------------------------------------------------
SUBROUTINE DynamicMesh(Initial)
! External variables
INTEGER :: Initial
! Internal variables
INTEGER :: i, j, k, l, frac, NodesPerRegion(1:MGrid), ilast
REAl(KIND=16) :: Xtemp(0:6000), Dpot, Dmaj, Dpot2, Dmaj2, Dvar, Dvar2, RegionSize(1:MGrid), DGR, DGR2, minSize
REAl(KIND=16) :: psiint, fpint, fnint, nint, pint, Gint, step
LOGICAL :: Join, NotMasterNode(0:6000)
! Temporal material arrays
REAl(KIND=16), DIMENSION(0:6000) :: TempFn, TempFp !Quasi-Fermi potential for electrons and holes (V)
REAl(KIND=16), DIMENSION(0:6000) :: TempPsi !Electrostatic potential (V)
REAl(KIND=16), DIMENSION(0:6000, 0:3000) :: TempAbsProfile!Absorption coefficient as a function of wavelength.
l = 1
RegionSize = 0.0
NotMasterNode(0) = .FALSE.
DO i = 1, M
IF (X(i)>=MasterNodes(l+1)) THEN
NotMasterNode(i) = .FALSE.
RegionSize(l) = MasterNodes(l+1)-MasterNodes(l)
l = l+1
ELSE
NotMasterNode(i) = .TRUE.
END IF
END DO
minSize = 2e-10
l = 1
j = 0
ilast = 0
Xtemp(0) = X(0)
DO i = 1, M-1
!print*, i, ilast
psiint = Interpol(Xtemp(j), X(ilast), Psi(ilast), X(i), Psi(i))
fpint = Interpol(Xtemp(j), X(ilast), Fp(ilast), X(i), Fp(i))
fnint = Interpol(Xtemp(j), X(ilast), Fn(ilast), X(i), Fn(i))
nint = EXP( Interpol(Xtemp(j), X(ilast), LOG(n(ilast) ), X(i), LOG( n(i)) ) )
pint = EXP( Interpol(Xtemp(j), X(ilast), LOG(p(ilast) ), X(i), LOG( p(i)) ) )
! Gint = EXP( Interpol(Xtemp(j), X(ilast), LOG(G(ilast) ), X(i), LOG( G(i)) ) )
Dpot = MAX( MAX( ABS(psiint-Psi(i)), ABS(fnint-Fn(i)) ), ABS(fpint-Fp(i)) )
Dpot2 = MAX( MAX( ABS(psiint-Psi(i+1)), ABS(fnint-Fn(i+1)) ), ABS(fpint-Fp(i+1)) )
Dmaj = MAX( ABS( LOG(nint/n(i)) ), ABS( LOG(pint/p(i)) ) )
Dmaj2 = MAX( ABS( LOG(nint/n(i+1)) ), ABS( LOG(pint/p(i+1)) ) )
! IF (Gint > 1e-7) THEN
! DGR = ABS( LOG(Gint/G(i)) )
! DGR2 = ABS( LOG(Gint/G(i+1)) )
! print*, DGR2, DGR, Dmaj, Growth
! ELSE
! DGR = -1
! DGR2 = -1
! END IF
! Dvar = MAX(Dpot, MAX(Dmaj, DGR)) /2
! Dvar2 = MAX(Dpot2, MAX(Dmaj2, DGR2)) /2
Dvar = MAX(Dpot, Dmaj) / 2
Dvar2 = MAX(Dpot2, Dmaj2) / 2
! Conditions for joining nodes.
Join = Dvar2 < Growth ! Not too much variation of the potentials or the carrier densities
Join = Join.AND.NotMasterNode(i) ! Not a master node
Join = Join.AND.( (X(i+1)-Xtemp(j)) < Growth*(X(i+1)-MasterNodes(l)) ) ! Not too close to the left masternode and
Join = Join.AND.( (X(i+1)-Xtemp(j)) < Growth*(MasterNodes(l+1)-X(i)) ) ! Nor to the rigth one
Join = Join.AND.( (X(i+1)-Xtemp(j)) < Growth*RegionSize(l)/10.0) ! Not too big for the region
! Divide if the variation of the potentials or of the carrier density is too large
IF ( Dvar > Growth ) THEN
frac = CEILING(Dvar/Growth)
IF (CEILING(dX(i-1)/minSize) < frac) frac = CEILING(dX(i-1)/minSize)
DO k = 1, frac-1
j = j+1
Xtemp(j) = X(i-1) + k*dX(i-1)/frac
END DO
j = j+1
Xtemp(j) = X(i)
ilast = i
! Divide if we are too close to the master node on the left
ELSE IF ( dX(i-1) >= Growth*(X(i)-MasterNodes(l)) ) THEN
frac = CEILING(dX(i-1)/Growth/(X(i)-MasterNodes(l)))
IF (CEILING(dX(i-1)/minSize) < frac) frac = CEILING(dX(i-1)/minSize)
DO k = 1, frac-1
j = j+1
Xtemp(j) = X(i-1) + k*dX(i-1)/frac
END DO
j = j+1
Xtemp(j) = X(i)
ilast = i
! Divide if we are too close to the master node on the rigth
ELSE IF ( dX(i-1) >= Growth*(MasterNodes(l+1)-X(i)) ) THEN
frac = CEILING(dX(i-1)/Growth/(MasterNodes(l+1)-X(i)) )
IF (CEILING(dX(i-1)/minSize) < frac) frac = CEILING(dX(i-1)/minSize)
DO k = 1, frac-1
j = j+1
Xtemp(j) = X(i-1) + k*dX(i-1)/frac
END DO
j = j+1
Xtemp(j) = X(i)
ilast = i
! Divide if the element is too big for the region
ELSE IF ( dX(i-1) >= Growth*RegionSize(l)/10.0 ) THEN
frac = CEILING(dX(i-1) / (Growth*RegionSize(l)/10.0) )
IF (CEILING(dX(i-1)/minSize) < frac) frac = CEILING(dX(i-1)/minSize)
DO k = 1, frac-1
j = j+1
Xtemp(j) = X(i-1) + k*dX(i-1)/frac
END DO
j = j+1
Xtemp(j) = X(i)
ilast = i
! If we haven't deleted de node nor divided the element, we keep it as it is
ELSE IF (.NOT.Join) THEN
j = j+1
Xtemp(j) = X(i)
ilast = i
END IF
! Check if we are about to change the region
IF (.NOT.NotMasterNode(i)) l = l+1
END DO
! The last interval
frac = CEILING(dX(M-1)/Growth/(X(M)-X(M-1)) )
DO k = 1, frac-1
j = j+1
Xtemp(j) = X(M-1) + k*dX(M-1)/frac
END DO
j = j+1
Xtemp(j) = X(M)
! Now it's time to interpolate all the other variables.
! We just need to be carful with the masternodes to avoid mixing the properties of the regions.
! First, we update the position of the masternodes
dX(0:M) = 0.0
l = 2
NotMasterNode(0) = .FALSE.
DO i = 1, j
IF (Xtemp(i)>=MasterNodes(l)) THEN
NotMasterNode(i) = .FALSE.
l = l+1
ELSE
NotMasterNode(i) = .TRUE.
END IF
dX(i-1) = Xtemp(i)-Xtemp(i-1)
END DO
! We smooth the position of the nodes to avoid neibourgh elements too different. We smooth 10 times
Do k = 1, 10
DO i = 1, j
IF (NotMasterNode(i)) THEN
Xtemp(i) = (Xtemp(i-1) + Xtemp(i) + Xtemp(i+1)) / 3.0
END IF
dX(i-1) = Xtemp(i)-Xtemp(i-1)
END DO
END DO
k = -1
DO i = 0, j
IF (NotMasterNode(i)) THEN
! Between master nodes, we interpolate
DO WHILE ( Xtemp(i)>X(k+1))
k = k+1
END DO
TempFn(i) = Interpol(Xtemp(i), X(k), Fn(k), X(k+1), Fn(k+1) )
TempFp(i) = Interpol(Xtemp(i), X(k), Fp(k), X(k+1), Fp(k+1) )
TempPsi(i) = Interpol(Xtemp(i), X(k), Psi(k), X(k+1), Psi(k+1) )
DO l = 0, NumWL
TempAbsProfile(i, l) = Interpol(Xtemp(i), X(k), AbsProfile(k, l), X(k+1),AbsProfile(k+1,l) )
END DO
ELSE
k = k + 1
DO WHILE ( Xtemp(i)>X(k))
k = k+1
END DO
! At the masternodes, we keep the same values
TempFn(i) = Fn(k)
TempFp(i) = Fp(k)
TempPsi(i) = Psi(k)
TempAbsProfile(i, 0:NumWL) = AbsProfile(k, 0:NumWL)
END IF
END DO
! And update them with the new values
M = j
X(0:M) = Xtemp(0:M)
Fn(0:M) = TempFn(0:M)
Fp(0:M) = TempFp(0:M)
Psi(0:M) = TempPsi(0:M)
AbsProfile(0:M, 0:NumWL) = TempAbsProfile(0:M, 0:NumWL)
! We fill the arrays with the material properties and doping as a function of position
DO i = 1, MReg ! Loop over the layers
DO j=0,M ! Loop over the nodes
IF ( (X(j)>=DML(i, 1)).AND.(X(j)<=DML(i, 2)) ) THEN
Eg(j) = DML(i, 3)
Xi(j) = DML(i, 4)
Mun(j) = DML(i, 5)
Mup(j) = DML(i, 6)
Nc(j) = DML(i, 7)
Nv(j) = DML(i, 8)
tn(j) = DML(i, 10)
tp(j) = DML(i, 11)
Epsi(j) = DML(i, 12)
Brad(j) = DML(i, 13)
CCn(j) = DML(i, 17)
CCp(j) = DML(i, 18)
ni(j) = SQRT(Nc(j)*Nv(j)*EXP( -b*Eg(j) ) )
Na(j) = DoppingLibrary(i, 1)
Nd(j) = DoppingLibrary(i, 2)
END IF
END DO
END DO
DO i = 0, M
CALL Bandedge(i)
CALL ModPotential(i)
CALL Carriers(i)
Rho(i)=q*( p(i)-n(i)+Nd(i)-Na(i))
END DO
CALL GR_sub
END SUBROUTINE DynamicMesh
!-------------------------------------------------
FUNCTION Interpol(xx, x1, y1, x2, y2)
REAl(KIND=16) :: xx, x1, y1, x2, y2, Interpol
REAl(KIND=16) :: a, b
a = (y2-y1)/(x2-x1)
b = (y1*x2-y2*x1)/(x2-x1)
Interpol = a*xx + b
END FUNCTION Interpol
!-------------------------------------------------
SUBROUTINE Reset()
MGrid = 1
Mreg = 0
NumWL = 2
M = 0
XD = 0
fneq = 1
bneq = 1
X(:) = 0.0
Nd(:) = 0.0
Na(:) = 0.0
Nc(:) = 0.0
Nv(:) = 0.0
ni(:) = 0.0
Eg(:) = 0.0
Xi(:) = 0.0
Epsi(:) = 0.0
Mun(:) = 0.0
Mup(:) = 0.0
Ncc(:) = 0.0
Nvhh(:) = 0.0
Nvlh(:) = 0.0
tn(:) = 0.0
tp(:) = 0.0
Brad(:) = 0.0
alfa(:) = 0.0
CCn(:) = 0.0
CCp(:) = 0.0
Fn(:) = 0.0
Fp(:) = 0.0
Psi(:) = 0.0
AbsProfile(:, :) = 0.0
f(:) = 0
dsol(:) = 0
Jac(:,:) = 0
MasterNodes(:) = 0
AbsLibrary(:, :) = 0
PFspectrum = 0.0
G(:) = 0
clamp = 20
ATol = 3.1622776601683796e-17
RTol = 1e-6
nitermax = 40
Rs = 0
SingleWL = .FALSE.
END SUBROUTINE Reset
!-------------------------------------------------
FUNCTION Get(VarName)
REAl(KIND=8) :: Get (0:6000)
INTEGER:: k
CHARACTER(len=30) :: VarName
SELECT CASE ( VarName )
! Material information (inputs)
CASE ( 'x' )
Get(0:M) = REAL(X(0:M), 8)
CASE ( 'dx' )
Get(0:M-1) = REAL(dX(0:M-1), 8)
CASE ( 'eg' )
Get(0:M) = REAL(Eg(0:M), 8)
CASE ( 'xi' )
Get(0:M) = REAL(Xi(0:M), 8)
CASE ( 'na' )
Get(0:M) = REAL(Na(0:M), 8)
CASE ( 'nd' )
Get(0:M) = REAL(Nd(0:M), 8)
CASE ( 'mun' )
Get(0:M) = REAL(Mun(0:M), 8)
CASE ( 'mup' )
Get(0:M) = REAL(Mup(0:M), 8)
CASE ( 'epsi' )
Get(0:M) = REAL(Epsi(0:M), 8)
CASE ( 'tn' )
Get(0:M) = REAL(tn(0:M), 8)
CASE ( 'tp' )
Get(0:M) = REAL(tp(0:M), 8)
CASE ( 'brad' )
Get(0:M) = REAL(Brad(0:M), 8)
CASE ( 'ccn' )
Get(0:M) = REAL(CCn(0:M), 8)
CASE ( 'ccp' )
Get(0:M) = REAL(CCp(0:M), 8)
CASE ( 'ni' )
Get(0:M) = REAL(ni(0:M), 8)
CASE ( 'nc' )
Get(0:M) = REAL(Nc(0:M), 8)
CASE ( 'nv' )
Get(0:M) = REAL(Nv(0:M), 8)
CASE ( 'ncc' )
Get(0:M) = REAL(ncc(0:M), 8)
CASE ( 'nvhh' )
Get(0:M) = REAL(nvhh(0:M), 8)
CASE ( 'nvlh' )
Get(0:M) = REAL(nvlh(0:M), 8)
! Carrier and charge densites densities
CASE ( 'n' )
Get(0:M) = REAL(n(0:M), 8)
CASE ( 'p' )
Get(0:M) = REAL(p(0:M), 8)
CASE ( 'rho' )
Get(0:M) = REAL(Rho(0:M), 8)
! Generation/Recombination
CASE ( 'gr' )
Get(0:M-1) = REAL(GR(0:M-1)/q/dX(0:M-1), 8)
CASE ( 'rsrh' )
Get(0:M-1) = REAL(Rsrh(0:M-1)/q/dX(0:M-1), 8)
CASE ( 'rrad' )
Get(0:M-1) = REAL(Rrad(0:M-1)/q/dX(0:M-1), 8)
CASE ( 'raug' )
Get(0:M-1) = REAL(Raug(0:M-1)/q/dX(0:M-1), 8)
CASE ( 'g' )
Get(0:M-1) = REAL(G(0:M-1)/q/dX(0:M-1), 8)
! Bandstructure
CASE ( 'fp' )
Get(0:M) = REAL(Fp(0:M)/b, 8)
CASE ( 'fn' )
Get(0:M) = REAL(Fn(0:M)/b, 8)
CASE ( 'vn' )
Get(0:M) = REAL(Vn(0:M)/b, 8)
CASE ( 'vp' )
Get(0:M) = REAL(Vp(0:M)/b, 8)
CASE ( 'cn' )
Get(0:M) = REAL(Cn(0:M)/b, 8)
CASE ( 'cp' )
Get(0:M) = REAL(Cp(0:M)/b, 8)
CASE ( 'efh' )
Get(0:M) = REAL((Fp(0)-Fp(0:M))/b, 8)
CASE ( 'efe' )
Get(0:M) = REAL((Fp(0)-Fn(0:M))/b, 8)
CASE ( 'psi' )
Get(0:M) = REAL(Psi(0:M)/b, 8)
CASE ( 'ev' )
Get(0:M) = REAL( (Fp(0)-Fp(0:M)+LOG( p(0:M)/Nv(0:M) )) /b, 8)
CASE ( 'ec' )
Get(0:M) = REAL( (-LOG( n(0:M)/Nc(0:M) ) +Fp(0)-Fn(0:M) ) /b, 8)
! Voltage and current information
CASE ( 'voc' )
Get(0) = REAL(Voc, 8)
CASE ( 'isc' )
Get(0) = REAL(Isc, 8)
CASE ( 'vmax' )
Get(0) = REAL(Vmax, 8)
CASE ( 'imax' )
Get(0) = REAL(Imax, 8)
CASE ( 'ff' )
Get(0) = REAL(FF, 8)
CASE ( 'volt' )
Get(1:nvolt) = REAL(vpoint(0:nvolt+1), 8)
CASE ( 'jtot' )
Get(1:nvolt) = REAL(jpoint(0:nvolt+1), 8)
CASE ( 'jsrh' )
Get(1:nvolt) = REAL(jsrhpoint(0:nvolt+1), 8)
CASE ( 'jrad' )
Get(1:nvolt) = REAL(jradpoint(0:nvolt+1), 8)
CASE ( 'jaug' )
Get(1:nvolt) = REAL(jaugpoint(0:nvolt+1), 8)
CASE ( 'jsur' )
Get(1:nvolt) = REAL(jsurpoint(0:nvolt+1), 8)
CASE ( 'residual' )
Get(1:nvolt) = REAL(residual(0:nvolt+1), 8)
! Internal quantum efficiency
CASE ( 'iqe' )
Get(0:NumWL) = REAL(iqe(0:NumWL), 8)
CASE ( 'iqesrh' )
Get(0:NumWL) = REAL(iqesrh(0:NumWL), 8)
CASE ( 'iqerad' )
Get(0:NumWL) = REAL(iqerad(0:NumWL), 8)
CASE ( 'iqeaug' )
Get(0:NumWL) = REAL(iqeaug(0:NumWL), 8)
CASE ( 'iqesurf' )
Get(0:NumWL) = REAL(iqesurf(0:NumWL), 8)
CASE ( 'iqesurb' )
Get(0:NumWL) = REAL(iqesurb(0:NumWL), 8)
END SELECT
END FUNCTION Get
!-------------------------------------------------
SUBROUTINE Set(VarName, VarVal, index, index2)
CHARACTER(len=30) :: VarName
REAl(KIND=8) :: VarVal
INTEGER, OPTIONAL :: index, index2
SELECT CASE ( VarName )
CASE ( 't' )
T = REAL(VarVal,16)
! Material information (inputs)
! CASE ( 'sn' )
! Sn = REAL(VarVal,16)
! CASE ( 'sp' )
! Sp = REAL(VarVal,16)
CASE ( 'eg' )
Eg(index) = REAL(VarVal,16)
CASE ( 'xi' )
Epsi(index) = REAL(VarVal,16)
CASE ( 'epsi' )
Mun(index) = REAL(VarVal,16)
CASE ( 'mun' )
Mun(index) = REAL(VarVal,16)
CASE ( 'mup' )
Mup(index) = REAL(VarVal,16)
CASE ( 'ncc' )
ncc(index) = REAL(VarVal,16)
CASE ( 'nvhh' )
nvhh(index) = REAL(VarVal,16)
CASE ( 'nvlh' )
nvlh(index) = REAL(VarVal,16)
CASE ( 'tn' )
tn(index) = REAL(VarVal,16)
CASE ( 'tp' )
tp(index) = REAL(VarVal,16)
CASE ( 'Brad' )
Brad(index) = REAL(VarVal,16)
CASE ( 'ccn' )
CCn(index) = REAL(VarVal,16)
CASE ( 'ccp' )
CCp(index) = REAL(VarVal,16)
CASE ( 'absprofile' )
AbsProfile(index, index2) = REAL(VarVal,16)
! Meshing and convergence
CASE ( 'coarse' )
Coarse = REAL(VarVal,16)
CASE ( 'fine' )
Fine = REAL(VarVal,16)
CASE ( 'ultrafine' )
Ultrafine = REAL(VarVal,16)
CASE ( 'clamp' )
Clamp = REAL(VarVal,16)
CASE ( 'atol' )
ATol = REAL(VarVal,16)
CASE ( 'rtol' )