Resampling Laser Diode Beam
The "M-squared Laser Beam (coherent)" source type is created in FRED as a superposition of TEMmn Hermite-Gauss modes whose composite beam has the requested M2 value.
Because the source is intended to be coherent and FRED treats coherent rays of the same wavelength fully coherent with respect to each other, the coherence between the individual TEMmn modes is broken by making slight changes to the wavelength of each individual mode. The user can retrieve the mode composition by right mouse clicking on the source node in the Object Tree and selecting "Detailed Report" from the context menu.
This collection of wavelengths becomes a problem if the user needs to spatially resample the beam into a new set of coherent rays (Gaussian beamlets), since the resampling routine requires the calculation of the scalar field, which can only be done at a single wavelength.
This example file with Embedded Script automatically traces the rays of an M2 = 1.5 source to a resampling plane located just before an aperture and then loops over each wavelength and spatially resamples each rayset. The results are accumlated in a user-created Ray Buffer.
'#Language "WWB-COM" Option Explicit Sub Main 'step 0. cleanup from previous runs and preperation ARNDeleteAllNodes DeleteRays ClearOutputWindow EnableTextPrinting False Dim i As Long For i = GetRayBufferCount()-1 To 1 Step -1 DeleteRayBuffer(i) Next i Dim resamplSurf As Long, anaSurf As Long resamplSurf = FindFullName( "Geometry.resamplePlane.Surface" ) anaSurf = FindFullName( "Analysis Surface(s).resamplingPlane" ) Dim tempBuffer As Long, resampledBuffer As Long tempBuffer = AddRayBuffer() resampledBuffer = AddRayBuffer() 'step 1. Advanced raytrace to sampling plane Dim adv As T_ADVANCEDRAYTRACE, numRays As Long InitAdvancedRaytrace adv adv.stopSurfID = resamplSurf numRays = AdvancedRaytrace(adv) EnableTextPrinting True Print numRays & " traced to resample plane" Print "" EnableTextPrinting False 'step 2. Get list of wavelengths at sample plane Dim wavelengths() As Double, curWl As Double, haveWl As Boolean, curSize As Long Dim success As Boolean, ray As T_RAY, idx As Long ReDim Preserve wavelengths(0) success = GetFirstRay(i, ray) While success If ray.entity = resamplSurf Then curWl = ray.wavelength haveWl = False curSize = UBound(wavelengths) 'if this ray wavelength is not already stored For idx = 0 To curSize If curWl = wavelengths(idx) Then haveWl = True End If Next idx If Not haveWl Then If wavelengths(0) > 0 Then curSize = curSize + 1 End If ReDim Preserve wavelengths(curSize) wavelengths(curSize) = curWl End If Else DeleteRay(i) End If success = GetNextRay (i, ray) Wend 'Step 3. copy all rays To tempBuffer Dim tRayFilter() As T_RAYFILTEROP CopyFilteredRaysBufferToBuffer( tRayFilter(), 0, tempBuffer, False ) 'for each wavelength resample and move rays to newBuffer Dim count As Long, parms() As Double Dim ent As Long, mat As Long, nRaysDel As Long, meritVal As Double For idx = 0 To UBound(wavelengths) EnableTextPrinting True Print idx & Chr(9) & wavelengths(idx) EnableTextPrinting False curWl = wavelengths(idx) 'delete rays currently in this buffer DeleteRays 'copy full set of rays into this buffer CopyFilteredRaysBufferToBuffer( tRayFilter(), tempBuffer, 0, False ) 'delete all rays that are not at this wavelength, and not on the resampling surface success = GetFirstRay(i, ray) While success If ray.entity <> resamplSurf Then DeleteRay i End If If ray.wavelength <> curWl Then DeleteRay i End If success = GetNextRay (i, ray) Wend 'resample using default parameters count = SpatiallyResampleScalarField( anaSurf, 0, parms, 150, True, 0, resamplSurf, 0, "", "", nRaysDel, meritVal ) EnableTextPrinting True Print count & " new rays created" Print "" EnableTextPrinting False 'move these resampled rays to final buffer CopyFilteredRaysBufferToBuffer( tRayFilter(), 0, resampledBuffer , True ) Next idx 'switch to newBuffer SetActiveRayBufferIndex resampledBuffer EnableTextPrinting True Print GetRayBufferLiveRayCount( resampledBuffer ) & " total rays after resampling" 'now we are ready to trace trough the aperture 'TraceExisting End Sub